995 lines
17 KiB
QBasic
995 lines
17 KiB
QBasic
Option Compare Database
|
|
Option Explicit
|
|
|
|
Dim tcpConnectionKeepAlive As Boolean
|
|
Dim tcpConnectionOpen As Boolean
|
|
|
|
Sub WiegenInitialisieren()
|
|
|
|
tcpConnectionOpen = False
|
|
tcpConnectionKeepAlive = True
|
|
|
|
End Sub
|
|
|
|
Sub WiegenBeenden()
|
|
|
|
If tcpConnectionOpen = True Then
|
|
EndWinSocket
|
|
tcpConnectionOpen = False
|
|
End If
|
|
|
|
|
|
End Sub
|
|
|
|
Function Wiegen(Optional Datum As Date, Optional zeit As Date, Optional Gewicht As Long, Optional Waagentext As String, Optional KeineIdentNummernErhöhung As Boolean) As Long
|
|
|
|
Dim waagentyp1
|
|
|
|
waagentyp1 = GetParameter("WAAGENTYP")
|
|
|
|
Wiegen = -1
|
|
|
|
If waagentyp1 = "TOLEDO" Then
|
|
Wiegen = WiegenToledo
|
|
End If
|
|
|
|
If waagentyp1 = "GASSNER" Then
|
|
Wiegen = WiegenGassner(Datum, zeit, Gewicht, Waagentext)
|
|
End If
|
|
|
|
If waagentyp1 = "SCHEMBER" Then
|
|
Wiegen = WiegenSchember
|
|
End If
|
|
|
|
If waagentyp1 = "SYSTEC" Then
|
|
Wiegen = WiegenSystec
|
|
End If
|
|
|
|
If waagentyp1 = "IT3000" Then
|
|
Wiegen = WiegenIt3000(Datum, zeit, Gewicht)
|
|
End If
|
|
|
|
If waagentyp1 = "IT3000A" Then
|
|
Wiegen = WiegenIt3000a(Datum, zeit, Gewicht, Waagentext, KeineIdentNummernErhöhung)
|
|
End If
|
|
|
|
If waagentyp1 = "L320" Then
|
|
Wiegen = L320(Datum, zeit, Gewicht, Waagentext)
|
|
End If
|
|
|
|
If waagentyp1 = "L246" Then
|
|
Wiegen = L246(Datum, zeit, Gewicht, Waagentext, KeineIdentNummernErhöhung)
|
|
End If
|
|
|
|
|
|
|
|
End Function
|
|
|
|
|
|
Function WiegenToledo() As Long
|
|
' Wolkersdorf, Haugsdorf
|
|
|
|
Dim buff(0 To 11) As Integer
|
|
Dim i, c As Integer
|
|
Dim str1 As String
|
|
|
|
' Send command "netto weight": "CP"
|
|
Forms!FÜbernahme.send (Asc("C"))
|
|
Forms!FÜbernahme.TheEvent = 0
|
|
While Forms!FÜbernahme.TheEvent < 1
|
|
DoEvents
|
|
Wend
|
|
Forms!FÜbernahme!XComm.InBufferCount = 0
|
|
Forms!FÜbernahme.send (Asc("P"))
|
|
|
|
' Read whole response word: 12 Bytes
|
|
While i < 12 And c <> -1
|
|
c = Forms!FÜbernahme.Receive()
|
|
buff(i) = c
|
|
i = i + 1
|
|
Wend
|
|
|
|
If c = -1 Then
|
|
WiegenToledo = -1
|
|
Exit Function
|
|
Else
|
|
'Number of read bytes OK
|
|
|
|
'Check if format is OK
|
|
|
|
'First byte: 02
|
|
If buff(0) <> 2 Then
|
|
WiegenToledo = -2
|
|
Exit Function
|
|
End If
|
|
'Bytes 9 and 10: 'kg'
|
|
If buff(8) <> Asc("k") Then
|
|
WiegenToledo = -3
|
|
Exit Function
|
|
End If
|
|
If buff(9) <> Asc("g") Then
|
|
WiegenToledo = -3
|
|
Exit Function
|
|
End If
|
|
'Bytes 11 and 12: 0D 0A (CRLF)
|
|
If buff(10) <> &HD Then
|
|
WiegenToledo = -4
|
|
Exit Function
|
|
End If
|
|
If buff(11) <> &HA Then
|
|
WiegenToledo = -5
|
|
Exit Function
|
|
End If
|
|
|
|
'Convert weight to long value
|
|
str1 = ""
|
|
For i = 1 To 7
|
|
str1 = str1 + Chr(buff(i))
|
|
Next i
|
|
c = CLng(str1)
|
|
|
|
WiegenToledo = c
|
|
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
|
|
Function WiegenGassner(Datum As Variant, zeit As Variant, Gewicht As Long, Waagentext As Variant) As Long
|
|
'im Moment nirgends
|
|
|
|
Dim buff(0 To 99) As Integer
|
|
Dim i, c As Integer
|
|
Dim str1 As String
|
|
Dim str2 As String
|
|
Dim waagennummer As Long
|
|
Dim speichernummer As Long
|
|
|
|
' Send command "ENQ": 05h
|
|
Forms!FÜbernahme!XComm.InBufferCount = 0
|
|
Forms!FÜbernahme.send (&H5)
|
|
Forms!FÜbernahme.TheEvent = 0
|
|
|
|
' Read whole response word: 25 Bytes
|
|
While i < 47 And c <> -1
|
|
c = Forms!FÜbernahme.Receive()
|
|
buff(i) = c
|
|
i = i + 1
|
|
Wend
|
|
|
|
'str1 = ""
|
|
'For i = 0 To 46
|
|
' str1 = str1 + Hex(buff(i)) + " "
|
|
' str2 = str2 + Chr(buff(i))
|
|
'Next i
|
|
'MsgBox (str1 + Chr(10) + Chr(13) + str2)
|
|
|
|
If c = -1 Then
|
|
WiegenGassner = -1
|
|
Exit Function
|
|
Else
|
|
'Number of read bytes OK
|
|
|
|
'Check if format is OK
|
|
|
|
'First byte: 02
|
|
If buff(0) <> 2 Then
|
|
WiegenGassner = -2
|
|
Exit Function
|
|
End If
|
|
|
|
'Second byte: "E"/"S" (" "..OK, "E" for Error)
|
|
If buff(1) <> Asc(" ") Then
|
|
WiegenGassner = -3
|
|
Exit Function
|
|
End If
|
|
|
|
'Third byte: "S"/"M"
|
|
If buff(2) <> Asc("S") Then
|
|
WiegenGassner = -4
|
|
Exit Function
|
|
End If
|
|
|
|
'Convert weight to long value
|
|
str1 = ""
|
|
For i = 0 To 6
|
|
str1 = str1 + Chr(buff(i + 17))
|
|
Next i
|
|
c = CLng(str1)
|
|
Gewicht = c
|
|
WiegenGassner = c
|
|
|
|
'Convert weight to long value
|
|
str1 = ""
|
|
For i = 0 To 6
|
|
str1 = str1 + Chr(buff(i + 17))
|
|
Next i
|
|
c = CLng(str1)
|
|
Gewicht = c
|
|
WiegenGassner = c
|
|
|
|
'Convert Waagennummer
|
|
str1 = ""
|
|
For i = 0 To 1
|
|
str1 = str1 + Chr(buff(i + 24))
|
|
Next i
|
|
c = CLng(str1)
|
|
waagennummer = c
|
|
|
|
'Convert Speichernummer
|
|
str1 = ""
|
|
For i = 0 To 5
|
|
str1 = str1 + Chr(buff(i + 26))
|
|
Next i
|
|
c = CLng(str1)
|
|
speichernummer = c
|
|
|
|
'Convert Datum
|
|
str1 = ""
|
|
For i = 0 To 7
|
|
str1 = str1 + Chr(buff(i + 32))
|
|
Next i
|
|
If IsDate(Mid(str1, 7, 2) + "." + Mid(str1, 5, 2) + "." + Mid(str1, 1, 4)) Then
|
|
Datum = DateValue(Mid(str1, 7, 2) + "." + Mid(str1, 5, 2) + "." + Mid(str1, 1, 4))
|
|
End If
|
|
|
|
'Convert Zeit
|
|
str1 = ""
|
|
For i = 0 To 5
|
|
str1 = str1 + Chr(buff(i + 40))
|
|
Next i
|
|
If IsDate(Mid(str1, 1, 2) + ":" + Mid(str1, 3, 2) + ":" + Mid(str1, 5, 2)) Then
|
|
zeit = TimeValue(Mid(str1, 1, 2) + ":" + Mid(str1, 3, 2) + ":" + Mid(str1, 5, 2))
|
|
End If
|
|
Waagentext = "Waagennummer: " + Format(waagennummer) + " Speichernummer: " + Format(speichernummer)
|
|
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
Function WiegenGassnerAlt() As Long
|
|
'im Moment nirgends
|
|
|
|
Dim buff(0 To 24) As Integer
|
|
Dim i, c As Integer
|
|
Dim str1 As String
|
|
|
|
' Send command "ENQ": 05h
|
|
Forms!FÜbernahme!XComm.InBufferCount = 0
|
|
Forms!FÜbernahme.send (&H5)
|
|
Forms!FÜbernahme.TheEvent = 0
|
|
|
|
' Read whole response word: 25 Bytes
|
|
While i < 25 And c <> -1
|
|
c = Forms!FÜbernahme.Receive()
|
|
buff(i) = c
|
|
i = i + 1
|
|
Wend
|
|
|
|
If c = -1 Then
|
|
WiegenGassnerAlt = -1
|
|
Exit Function
|
|
Else
|
|
'Number of read bytes OK
|
|
|
|
'Check if format is OK
|
|
|
|
'First byte: 02
|
|
If buff(0) <> 2 Then
|
|
WiegenGassnerAlt = -2
|
|
Exit Function
|
|
End If
|
|
|
|
'Second byte: "E"/"S" (" "..OK, "E" for Error)
|
|
If buff(1) <> " " Then
|
|
WiegenGassnerAlt = -3
|
|
Exit Function
|
|
End If
|
|
|
|
'Third byte: "S"/"M"
|
|
If buff(2) <> "S" Then
|
|
WiegenGassnerAlt = -4
|
|
Exit Function
|
|
End If
|
|
|
|
'Byte 25
|
|
'If buff(24) <> &H3 Then
|
|
' WiegenGassner = -5
|
|
' Exit Function
|
|
'End If
|
|
|
|
'Convert weight to long value
|
|
str1 = ""
|
|
For i = 0 To 6
|
|
str1 = str1 + Chr(buff(i + 17))
|
|
Next i
|
|
c = CLng(str1)
|
|
|
|
WiegenGassnerAlt = c
|
|
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
|
|
Function WiegenSchember() As Long
|
|
|
|
' Matzen
|
|
|
|
Dim buff(0 To 24) As Integer
|
|
Dim i, c As Integer
|
|
Dim str1 As String
|
|
|
|
' Send command "27,62"
|
|
Forms!FÜbernahme.send (27)
|
|
Forms!FÜbernahme.TheEvent = 0
|
|
While Forms!FÜbernahme.TheEvent < 1
|
|
DoEvents
|
|
Wend
|
|
Forms!FÜbernahme.XComm.InBufferCount = 0
|
|
Forms!FÜbernahme.send (62)
|
|
|
|
' Read whole response word: 12 Bytes
|
|
While i < 25 And c <> -1
|
|
c = Forms!FÜbernahme.Receive()
|
|
buff(i) = c
|
|
i = i + 1
|
|
Wend
|
|
|
|
If c = -1 Then
|
|
WiegenSchember = -1
|
|
Exit Function
|
|
Else
|
|
'Number of read bytes OK
|
|
|
|
'Check if format is OK
|
|
|
|
'First byte: 02
|
|
If buff(0) <> 2 Then
|
|
WiegenSchember = -2
|
|
Exit Function
|
|
End If
|
|
|
|
'Bytes 11 and 12: 0D 0A (CRLF)
|
|
If buff(24) <> 3 Then
|
|
WiegenSchember = -4
|
|
Exit Function
|
|
End If
|
|
|
|
'Convert weight to long value
|
|
str1 = ""
|
|
For i = 16 To 19
|
|
str1 = str1 + Chr(buff(i))
|
|
Next i
|
|
str1 = str1 + ","
|
|
str1 = str1 + Chr(buff(20))
|
|
c = CDbl(str1)
|
|
|
|
|
|
WiegenSchember = c
|
|
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
Function WiegenSystec() As Long
|
|
|
|
' Matzen
|
|
|
|
Dim buff(0 To 50) As Integer
|
|
Dim i, c As Integer
|
|
Dim str1 As String
|
|
|
|
|
|
Forms!FÜbernahme.XComm.InBufferCount = 0
|
|
|
|
'Wait for STX
|
|
Do
|
|
c = Forms!FÜbernahme.Receive()
|
|
Loop Until c = 2
|
|
buff(0) = c
|
|
|
|
i = 1
|
|
While i < 17 And c <> -1
|
|
c = Forms!FÜbernahme.Receive()
|
|
buff(i) = c
|
|
i = i + 1
|
|
Wend
|
|
|
|
If c = -1 Then
|
|
WiegenSystec = -1
|
|
Exit Function
|
|
Else
|
|
|
|
'Number of read bytes OK
|
|
|
|
'Check if format is OK
|
|
|
|
'First byte: 02
|
|
If buff(0) <> 2 Then
|
|
WiegenSystec = -2
|
|
Exit Function
|
|
End If
|
|
|
|
'Convert weight to long value
|
|
str1 = ""
|
|
For i = 4 To 9
|
|
str1 = str1 + Chr(buff(i))
|
|
Next i
|
|
c = CDbl(str1)
|
|
|
|
WiegenSystec = c
|
|
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
Function WiegenIt3000(Datum As Date, zeit As Date, Gewicht As Long) As Long
|
|
' Röschitz
|
|
|
|
Dim c As Integer
|
|
Dim recordcount As Integer
|
|
Dim record(0 To 20) As String
|
|
|
|
'Receive STX
|
|
While c <> 2 And c <> -1
|
|
c = Forms!FÜbernahme.Receive()
|
|
Wend
|
|
If c = -1 Then
|
|
WiegenIt3000 = -1
|
|
Forms!FÜbernahme.send (&H15) 'NAK
|
|
Exit Function
|
|
End If
|
|
'Receive Buffer and terminating ETX
|
|
recordcount = 0
|
|
record(recordcount) = ""
|
|
While c <> -1 And c <> 3 'ETX
|
|
c = Forms!FÜbernahme.Receive()
|
|
If c = Asc(";") Or c = 3 Then
|
|
recordcount = recordcount + 1
|
|
record(recordcount) = ""
|
|
Else
|
|
If c <> -1 Then
|
|
record(recordcount) = record(recordcount) + Chr(c)
|
|
End If
|
|
End If
|
|
Wend
|
|
If c = -1 Then
|
|
WiegenIt3000 = -2
|
|
Forms!FÜbernahme.send (&H15) 'NAK
|
|
Exit Function
|
|
End If
|
|
|
|
'interpret records
|
|
If recordcount < 4 Then
|
|
'too less records
|
|
WiegenIt3000 = -3
|
|
Forms!FÜbernahme.send (&H15) 'NAK
|
|
Exit Function
|
|
End If
|
|
'record(0) is waagennummer
|
|
Datum = DateValue(record(1))
|
|
zeit = TimeValue(record(2))
|
|
Gewicht = Val(record(3))
|
|
|
|
'send acknowledge
|
|
Forms!FÜbernahme.send (6) 'ACK
|
|
|
|
Forms!FÜbernahme!XComm.InBufferCount = 0
|
|
|
|
|
|
End Function
|
|
|
|
Function WiegenIt3000a(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String, KeineIdentNummernErhöhung As Boolean) As Long
|
|
' Matzen, Wolkersdorf
|
|
|
|
Dim c As Integer
|
|
Dim i As Integer
|
|
Dim Data As String
|
|
Dim record As String
|
|
Dim waagennummer As Long
|
|
Dim speichernummer As Long
|
|
|
|
Forms!FÜbernahme.XComm.InBufferCount = 0
|
|
Forms!FÜbernahme.TheEvent = 0
|
|
|
|
If KeineIdentNummernErhöhung = True Then
|
|
'Send command
|
|
Forms!FÜbernahme.send (Asc("<"))
|
|
Forms!FÜbernahme.send (Asc("R"))
|
|
Forms!FÜbernahme.send (Asc("M"))
|
|
Forms!FÜbernahme.send (Asc(">"))
|
|
Else
|
|
'Send command
|
|
Forms!FÜbernahme.send (Asc("<"))
|
|
Forms!FÜbernahme.send (Asc("R"))
|
|
Forms!FÜbernahme.send (Asc("N"))
|
|
Forms!FÜbernahme.send (Asc(">"))
|
|
End If
|
|
|
|
'Receive record
|
|
i = 0
|
|
Data = ""
|
|
While i < 64 And c <> -1
|
|
c = Forms!FÜbernahme.Receive()
|
|
If c <> -1 Then
|
|
Data = Data + Chr(c)
|
|
End If
|
|
i = i + 1
|
|
Wend
|
|
|
|
'MsgBox (data)
|
|
|
|
'skip < and >
|
|
Data = Mid(Data, 2, 62)
|
|
|
|
|
|
If c = -1 Then
|
|
WiegenIt3000a = -1
|
|
Exit Function
|
|
End If
|
|
|
|
'interpret data
|
|
'1. Fehlercode, Waagenstatus
|
|
record = Left(Data, 4)
|
|
Data = Mid(Data, 5)
|
|
If record <> "0000" Then
|
|
WiegenIt3000a = -2
|
|
Exit Function
|
|
End If
|
|
'2. Date
|
|
record = Left(Data, 8)
|
|
Data = Mid(Data, 9)
|
|
If IsDate(record) Then
|
|
Datum = DateValue(record)
|
|
Else
|
|
WiegenIt3000a = -3
|
|
Exit Function
|
|
End If
|
|
'2. Time
|
|
record = Left(Data, 5)
|
|
record = record + ":00"
|
|
Data = Mid(Data, 6)
|
|
If IsDate(record) Then
|
|
zeit = TimeValue(record)
|
|
Else
|
|
WiegenIt3000a = -4
|
|
Exit Function
|
|
End If
|
|
'4. Identnr
|
|
record = Left(Data, 4)
|
|
Data = Mid(Data, 5)
|
|
speichernummer = Val(record)
|
|
'5. Waagennr
|
|
record = Left(Data, 1)
|
|
Data = Mid(Data, 2)
|
|
waagennummer = Val(record)
|
|
'6. Brutto
|
|
record = Left(Data, 8)
|
|
Data = Mid(Data, 9)
|
|
'7. Tara
|
|
record = Left(Data, 8)
|
|
Data = Mid(Data, 9)
|
|
'8. Netto
|
|
record = Left(Data, 8)
|
|
Data = Mid(Data, 9)
|
|
If IsNumeric(record) Then
|
|
Gewicht = Val(record)
|
|
Else
|
|
WiegenIt3000a = -5
|
|
Exit Function
|
|
End If
|
|
'9. kg
|
|
record = Left(Data, 2)
|
|
Data = Mid(Data, 3)
|
|
If record <> "kg" Then
|
|
WiegenIt3000a = -6
|
|
Exit Function
|
|
End If
|
|
|
|
'rest wird nicht ausgewertet
|
|
|
|
Waagentext = "Waagenr: " + Format(waagennummer) + " ID: " + Format(speichernummer)
|
|
|
|
WiegenIt3000a = Gewicht
|
|
|
|
End Function
|
|
|
|
Sub testl320()
|
|
|
|
Dim Datum As Date
|
|
Dim zeit As Date
|
|
Dim Gewicht As Long
|
|
Dim Waagentext As String
|
|
Dim chk As String
|
|
Dim Data As String
|
|
|
|
Data = " 17.04.14 12:58 2 72kg" + Chr(10)
|
|
|
|
Data = Mid(Data, 2)
|
|
Datum = CDate(Left(Data, 8))
|
|
Data = Mid(Data, 10)
|
|
zeit = CDate(Left(Data, 5))
|
|
Data = Mid(Data, 7)
|
|
Waagentext = Left(Data, 4)
|
|
Data = Mid(Data, 6)
|
|
Gewicht = CLng(Left(Data, 9))
|
|
Data = Mid(Data, 11)
|
|
chk = Left(Data, 2)
|
|
|
|
MsgBox (Datum)
|
|
MsgBox (zeit)
|
|
MsgBox (Gewicht)
|
|
MsgBox (Waagentext)
|
|
|
|
End Sub
|
|
|
|
|
|
Function L320(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String) As Long
|
|
|
|
Dim c As Long
|
|
Dim Data As String
|
|
Dim chk As String
|
|
Dim i As Integer
|
|
Dim str1 As String
|
|
'Receive record
|
|
str1 = ""
|
|
|
|
Data = ""
|
|
|
|
c = Forms!FÜbernahme.Receive()
|
|
str1 = Format(c)
|
|
'Forms!FÜbernahme!XComm.InBufferCount
|
|
If c = 32 Then
|
|
i = 1
|
|
Data = Data + Chr(c)
|
|
Else
|
|
c = Forms!FÜbernahme.Receive()
|
|
str1 = str1 + "," + Format(c)
|
|
c = Forms!FÜbernahme.Receive()
|
|
str1 = str1 + "," + Format(c)
|
|
'MsgBox (str1)
|
|
L320 = -9
|
|
Exit Function
|
|
End If
|
|
|
|
While i < 33 And c <> -1
|
|
c = Forms!FÜbernahme.Receive()
|
|
If c <> -1 Then
|
|
Data = Data + Chr(c)
|
|
End If
|
|
str1 = str1 + "," + Format(c)
|
|
i = i + 1
|
|
Wend
|
|
|
|
'1: 0x20
|
|
'2-9: Date 17.04.14
|
|
'10 0x20
|
|
'11-15: Time 12:58
|
|
'16: 0x20
|
|
'17-20: wiegenr
|
|
'21: 0x20
|
|
'22-30: gewicht
|
|
'31-32: kg
|
|
'33: 0x0A
|
|
'MsgBox (str1 + ":" + Format(Len(data)) + ":" & data)
|
|
If Len(Data) >= 33 Then
|
|
Data = Mid(Data, 2)
|
|
Datum = CDate(Left(Data, 8))
|
|
Data = Mid(Data, 10)
|
|
zeit = CDate(Left(Data, 5))
|
|
Data = Mid(Data, 7)
|
|
Waagentext = Left(Data, 4)
|
|
Data = Mid(Data, 6)
|
|
Gewicht = CLng(Left(Data, 9))
|
|
Data = Mid(Data, 10)
|
|
chk = Left(Data, 2)
|
|
If chk <> "kg" Then
|
|
'MsgBox ("Fehler! Waagenrecord nicht korrekt")
|
|
L320 = -1
|
|
Else
|
|
L320 = Gewicht
|
|
End If
|
|
Else
|
|
L320 = -9
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
Function L246(Datum As Date, zeit As Date, Gewicht As Long, Waagentext As String, KeineIdentNummernErhöhung As Boolean) As Long
|
|
|
|
' 1. open tcp port
|
|
Dim host As String
|
|
Dim tcpport As Long
|
|
Dim result As Long
|
|
|
|
If tcpConnectionOpen = False Then
|
|
host = GetParameter("WAAGEHOST")
|
|
tcpport = GetParameter("WAAGETCPPORT")
|
|
StartWinSocket
|
|
result = ConnectToServer(host, tcpport)
|
|
If result > 0 Then
|
|
tcpConnectionOpen = True
|
|
End If
|
|
End If
|
|
|
|
If tcpConnectionOpen = True Then
|
|
' 2. send command
|
|
If (KeineIdentNummernErhöhung) Then
|
|
SendData "<RM1>"
|
|
Else
|
|
SendData "<RN1>"
|
|
End If
|
|
|
|
' 3. receive data
|
|
Dim response As String
|
|
|
|
response = ReceiveString(65)
|
|
|
|
' 4. parse message
|
|
'MsgBox (response)
|
|
'Dim fehlerS As String
|
|
Dim datumS As String
|
|
Dim zeitS As String
|
|
Dim identNrS As String
|
|
Dim nettoS As String
|
|
Dim waagennummerS As String
|
|
Dim fehlerS As String
|
|
|
|
fehlerS = Mid(response, 2, 2)
|
|
datumS = Mid(response, 6, 8)
|
|
zeitS = Mid(response, 14, 5)
|
|
identNrS = Mid(response, 19, 4)
|
|
waagennummerS = Mid(response, 23, 1)
|
|
nettoS = Mid(response, 40, 8)
|
|
|
|
|
|
If fehlerS <> "00" Then
|
|
MsgBox "Fehlermeldung Waage", vbCritical
|
|
End If
|
|
|
|
Datum = CDate(datumS)
|
|
zeit = CDate(zeitS)
|
|
Waagentext = "Waagenr: " + Format(waagennummerS) + " ID: " + Format(identNrS)
|
|
Gewicht = CLng(nettoS)
|
|
|
|
'MsgBox (datum)
|
|
'MsgBox (zeit)
|
|
'MsgBox (waagentext)
|
|
'MsgBox (Gewicht)
|
|
|
|
|
|
' 5. close port
|
|
If tcpConnectionKeepAlive = False Then
|
|
EndWinSocket
|
|
tcpConnectionOpen = False
|
|
End If
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
Function KippenL246(onoff As Boolean)
|
|
|
|
Dim host As String
|
|
Dim tcpport As Long
|
|
Dim result As Long
|
|
If tcpConnectionOpen = False Then
|
|
host = GetParameter("WAAGEHOST")
|
|
tcpport = GetParameter("WAAGETCPPORT")
|
|
StartWinSocket
|
|
result = ConnectToServer(host, tcpport)
|
|
If result > 0 Then
|
|
tcpConnectionOpen = True
|
|
End If
|
|
End If
|
|
|
|
If tcpConnectionOpen = True Then
|
|
' 2. send command
|
|
If onoff Then
|
|
SendData "<OS02>"
|
|
Else
|
|
SendData "<OC02>"
|
|
End If
|
|
|
|
' 3. receive data
|
|
Dim response As String
|
|
|
|
response = ReceiveString(5)
|
|
|
|
' 4. parse message
|
|
If Left(response, 4) <> "<00>" Then
|
|
MsgBox "Fehler beim Ansteuern des digitalen Ausganges", vbCritical
|
|
End If
|
|
|
|
' 5. close port
|
|
If tcpConnectionKeepAlive = False Then
|
|
EndWinSocket
|
|
tcpConnectionOpen = False
|
|
End If
|
|
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
Function FreigabeL246(onoff As Boolean)
|
|
|
|
Dim host As String
|
|
Dim tcpport As Long
|
|
Dim result As Long
|
|
|
|
If tcpConnectionOpen = False Then
|
|
host = GetParameter("WAAGEHOST")
|
|
tcpport = GetParameter("WAAGETCPPORT")
|
|
StartWinSocket
|
|
result = ConnectToServer(host, tcpport)
|
|
If result > 0 Then
|
|
tcpConnectionOpen = True
|
|
End If
|
|
End If
|
|
|
|
If tcpConnectionOpen = True Then
|
|
' 2. send command
|
|
If onoff Then
|
|
SendData "<OS01>"
|
|
Else
|
|
SendData "<OC01>"
|
|
End If
|
|
|
|
' 3. receive data
|
|
Dim response As String
|
|
|
|
response = ReceiveString(5)
|
|
|
|
' 4. parse message
|
|
If Left(response, 4) <> "<00>" Then
|
|
MsgBox "Fehler beim Ansteuern des digitalen Ausganges", vbCritical
|
|
End If
|
|
|
|
' 5. close port
|
|
If tcpConnectionKeepAlive = False Then
|
|
EndWinSocket
|
|
tcpConnectionOpen = False
|
|
End If
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
Sub TestL246()
|
|
|
|
Dim Datum As Date
|
|
Dim zeit As Date
|
|
Dim Gewicht As Long
|
|
Dim Waagentext As String
|
|
|
|
WiegenInitialisieren
|
|
L246 Datum, zeit, Gewicht, Waagentext, True
|
|
L246 Datum, zeit, Gewicht, Waagentext, True
|
|
L246 Datum, zeit, Gewicht, Waagentext, True
|
|
KippenL246 (True)
|
|
KippenL246 (False)
|
|
WiegenBeenden
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Function Kippen(onoff As Boolean)
|
|
|
|
Dim steuerungtyp1
|
|
Dim extbefehl
|
|
|
|
steuerungtyp1 = GetParameter("STEUERUNGTYP")
|
|
|
|
If steuerungtyp1 = "SERIELL" Then
|
|
KippenSeriell (onoff)
|
|
End If
|
|
|
|
If steuerungtyp1 = "PARALLEL" Then
|
|
KippenParallel (onoff)
|
|
End If
|
|
|
|
|
|
If steuerungtyp1 = "L246" Then
|
|
KippenL246 (onoff)
|
|
End If
|
|
|
|
If steuerungtyp1 = "EXTERN" Then
|
|
extbefehl = GetParameter("STEUERUNGEXTERN")
|
|
If Not IsNull(extbefehl) And onoff = True Then
|
|
Shell extbefehl, vbMinimizedFocus
|
|
Else
|
|
MsgBox "Externes Programm nicht gefunden!", vbCritical
|
|
End If
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
|
|
Function KippenSeriell(onoff As Boolean)
|
|
|
|
' Kippen: RTS Signal von COMx der Steuerung (i.a. COM2)
|
|
' SubD 25: Pin 4, SubD 9: 7
|
|
|
|
Forms!FÜbernahme.XCommSteuerung.RTSEnable = onoff
|
|
|
|
End Function
|
|
|
|
|
|
Function KippenParallel(onoff As Boolean)
|
|
|
|
' Kippen: Über Datenleitungen des Ports
|
|
|
|
|
|
Dim port1
|
|
Dim tport1
|
|
Dim databyte As Byte
|
|
|
|
port1 = GetParameter("STEUERUNGPORT")
|
|
|
|
If Not IsNull(port1) Then
|
|
|
|
Select Case port1
|
|
|
|
Case "1": tport1 = "LPT1"
|
|
|
|
Case "2": tport1 = "LPT2"
|
|
|
|
Case "3": tport1 = "LPT3"
|
|
|
|
End Select
|
|
|
|
End If
|
|
|
|
If onoff = True Then
|
|
databyte = 255
|
|
Else
|
|
databyte = 0
|
|
End If
|
|
|
|
Open tport1 For Binary Access Write As #1
|
|
Put #1, , databyte
|
|
|
|
Close #1
|
|
|
|
End Function
|
|
|
|
|
|
Function Freigabe(onoff As Boolean)
|
|
|
|
Dim steuerungtyp1
|
|
Dim extbefehl
|
|
|
|
steuerungtyp1 = GetParameter("STEUERUNGTYP")
|
|
|
|
If steuerungtyp1 = "L246" Then
|
|
FreigabeL246 (onoff)
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
|
|
Sub testkippen()
|
|
|
|
KippenParallel (True)
|
|
KippenParallel (False)
|
|
|
|
End Sub |