Exported VBA
This commit is contained in:
995
wgmaster/vba/MWaage.bas
Normal file
995
wgmaster/vba/MWaage.bas
Normal file
@ -0,0 +1,995 @@
|
||||
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
|
||||
Reference in New Issue
Block a user