Dim Address_R As String
Dim Address_W As String
Dim Address_B As String
Dim ReadPlc As Boolean
Dim Lenth As Double
Dim SetLenth As Double
Dim Bit As String
Dim Instruction As Byte
Private Sub Combo1_Click ()
Select Case Combo1. Text
Case "IB"
Address_R = "0000"
Lenth = 1
Case "ID"
Address_R = "0000"
Lenth = 4
Case "IW"
Address_R = "0000"
Lenth = 2
Case "QB"
Address_R = "0100"
Lenth = 1
Case" QD "
Address_R = "0100"
Lenth = 4
Case "QW"
Address_R = "0100"
Lenth = 2
Case "MB"
Address_R = "0200"
Lenth = 1
Case " MD "
Address_R = "0200"
Lenth = 4
Case" MW "
Address_R = "0200"
Lenth = 2
Case "VB"
Address_R = "0800"
Lenth = 1
Case "VD"
Address_R = "0800"
Lenth = 4
Case "VW"
Address_R = "0800"
Lenth = 2
End Select
End Sub
Private Sub Combo2_Click ()
Select Case Combo2.Text
Case "IB"
Address_W = "0000"
SetLenth = 1
Case "ID"
Address_W = "0000"
SetLenth = 4
Case "IW"
Address_W = "0000"
SetLenth = 2
Case "QB"
Address_W = "0100"
SetLenth = 1
Case" QD "
Address_W = "0100"
SetLenth = 4
Case "QW"
Address_W = "0100"
SetLenth = 2
Case "MB"
Address_W = "0200"
SetLenth = 1
Case " MD "
Address_W = "0200"
SetLenth = 4
Case" MW "
Address_W = "0200"
SetLenth = 2
Case "VB"
Address_W = "0800"
SetLenth = 1
Case "VD"
Address_W = "0800"
SetLenth = 4
Case "VW"
Address_W = "0800"
SetLenth = 2
End Select
End Sub
Private Sub Combo3_Click ()
Select Case Combo3.Text
Case" Q "
Address_B = "0100"
Case" M "
Address_B = "0200"
Case" V "
Address_B = "0800"
End Select
End Sub
Private Sub Combo4_Click ()
Select Case Combo4.Text
Case" 0 "
Bit = "00"
Case" 1 "
Bit = " 01 "
Case" 2 "
Bit =" 02 "
Case" 3 "
Bit =" 03 "
Case" 4 "
Bit =" 04 "
Case" 5 "
Bit =" 05 "
Case" 6 "
Bit =" 06 "
Case" 7 "
Bit =" 07 "
End Select
End Sub
Private Sub Combo5_Click ()
Select Case Combo5.Text
Case "On"
Instruction = &H11
Case "Off"
Instruction = &H10
End Select
End Sub
Private Sub Command1_Click ()
Dim OutByte (0 To 32) As Byte
Dim Num As Double
Dim Num2 As String
Dim L
Dim Lenth2 As String
Dim ByteXor As Byte
Dim StrXor As String
ReadPlc = True
If Text1.Text = "" Then
MsgBox "Please enter the Register Address", vbOKOnly, "prompted"
Else
Num = Val (Text1.Text)
Num2 = Hex (Num)
Lenth2 = Hex (Lenth)
ByteXor = 0
OutByte (0) = 103 'starting characters
OutByte (1) = 5 'reading and writing instruction
OutByte (2) = Asc (0) 'PLC station address
OutByte (3) = Asc (2)
OutByte (4) = Asc (Mid (Address_R, 1, 1)) 'Register the type of
OutByte (5) = Asc (Mid (Address_R, 2, 1))
OutByte (6) = Asc (Mid (Address_R, 3, 1))
OutByte (7) = Asc (Mid (Address_R, 4, 1))
L = Len (Num2) 'register address
For i = 0 To L - 1
OutByte ( 11 - i) = Asc (Mid (Num2, L - i, 1))
Next i
For i = 0 To 3 - L
OutByte (11 - L - i ) = Asc (0)
Next i
L = Len (Lenth2)' read bytes
If L = 2 Then
OutByte (12) = Asc (Mid (Lenth2, 1, 1))
OutByte (13) = Asc (Mid (Lenth2, 2, 1))
Else
OutByte (12) = Asc (0)
OutByte (13) = Asc (Mid (Lenth2, 1, 1))
End If
For i = 1 To 29 'BCC calculation of parity-check codes
ByteXor = ByteXor Xor OutByte (i)
Next i
StrXor = Hex (ByteXor)
If Len (StrXor) = 2 Then
OutByte (30) = Asc (Mid (StrXor, 1, 1))
OutByte (31) = Asc (Mid (StrXor, 2, 1))
Else
OutByte (30) = Asc (0)
OutByte (31) = Asc (Mid (StrXor, 1, 1))
End If
OutByte (32) = 71
End If
MSComm1.Output = OutByte
End Sub
Private Sub Command2_Click ()
Dim OutByte (0 To 32) As Byte
Dim Num As Double
Dim Num2 As String
Dim L
Dim Lenth2 As String
Dim ByteXor As Byte
Dim StrXor As String
Dim Data_Send As Double
Dim Data_Send2 As String
Dim SetLenth2 As String
Read = False
If Text2.Text = "" Then
MsgBox "Please enter the Register Address", vbOKOnly, "prompted"
Else
Num = Val (Text2.Text)
Num2 = Hex (Num)
SetLenth2 = Hex (SetLenth * 2)
Data_Send = Val (Text4.Text)
Data_Send2 = Hex (Data_Send)
ByteXor = 0
OutByte (0) = 103 'starting characters
OutByte (1) = 6' command to write
OutByte (2) = Asc (0) 'PLC station address
OutByte (3) = Asc (2)
OutByte (4) = Asc (Mid (Address_W, 1, 1)) 'Register the type of
OutByte (5) = Asc (Mid (Address_W, 2, 1))
OutByte (6) = Asc (Mid (Address_W, 3, 1))
OutByte (7) = Asc (Mid (Address_W, 4, 1) )
L = Len (Num2)' register address
For i = 0 To L - 1
OutByte ( 11 - i) = Asc (Mid (Num2, L - i, 1))
Next i
For i = 0 To 3 - L
OutByte (11 - L - i ) = Asc (0)
Next i
L = Len (SetLenth2) 'write data the length of
If L = 2 Then
OutByte (12) = Asc (Mid ( SetLenth2, 1, 1))
OutByte (13) = Asc (Mid (SetLenth2, 2, 1))
Else
OutByte (12) = Asc (0)
OutByte (13) = Asc (Mid (SetLenth2, 1, 1))
End If
'writing PLC data into
L = Len (Data_Send2)
For i = 1 To L
OutByte (14 2 * SetLenth - i) = Asc (Mid (Data_Send2, L - i 1, 1))
Next i
For i = 1 To SetLenth * 2 - L
OutByte (13 i) = Asc (0)
Next i
'writing PLC data into
For i = 1 To 29' BCC calculation of parity-check codes
ByteXor = ByteXor Xor OutByte (i)
Next i
StrXor = Hex (ByteXor)
If Len (StrXor) = 2 Then
OutByte (30) = Asc (Mid (StrXor, 1, 1))
OutByte (31) = Asc (Mid (StrXor, 2, 1))
Else
OutByte (30) = Asc (0)
OutByte (31) = Asc (Mid (StrXor, 1, 1))
End If
OutByte (32) = 71
End If
MSComm1.Output = OutByte
End Sub
Private Sub Command3_Click ()
Dim OutByte (0 To 32) As Byte
Dim Num As Double
Dim Num2 As String
Dim L
Dim Lenth2 As String
Dim ByteXor As Byte
Dim StrXor As String
ReadPlc = False
If Text6.Text = "" Then
MsgBox "Please enter the Register Address", vbOKOnly, "prompted"
Else
Num = Val (Text6.Text)
Num2 = Hex (Num)
Lenth2 = Hex (Lenth)
ByteXor = 0
OutByte (0) = 103' starting characters
OutByte (1 ) = Instruction 'reading and writing instruction
OutByte (2) = Asc (0)' PLC station address
OutByte (3) = Asc (2)
OutByte (4) = Asc (Mid (Address_B, 1, 1))' Register the type of
OutByte (5) = Asc (Mid (Address_B, 2, 1))
OutByte (6) = Asc (Mid (Address_B, 3, 1))
OutByte (7) = Asc (Mid (Address_B, 4, 1))
L = Len (Num2) 'register address
For i = 0 To L - 1
OutByte ( 11 - i) = Asc (Mid (Num2, L - i, 1))
Next i
For i = 0 To 3 - L
OutByte (11 - L - i ) = Asc (0)
Next i
'bit address
OutByte (12) = Asc (Mid (Bit, 1, 1))
OutByte (13) = Asc (Mid (Bit, 2, 1))
For i = 1 To 29 'BCC calculation of parity-check codes
ByteXor = ByteXor Xor OutByte (i)
Next i
StrXor = Hex (ByteXor)
If Len (StrXor) = 2 Then
OutByte (30) = Asc (Mid (StrXor, 1, 1))
OutByte (31) = Asc (Mid (StrXor, 2, 1))
Else
OutByte (30) = Asc (0)
OutByte (31) = Asc (Mid (StrXor, 1, 1))
End If
OutByte (32) = 71
End If
MSComm1.Output = OutByte
End Sub
Private Sub Form_Load ()
Instruction = &H11
Address_R = "0100"
Address_W = "0100"
Address_B = "0100"
Bit = "00"
Lenth = 2
SetLenth = 2
MSComm1. CommPort = 1
MSComm1.Settings = "9600, n, 8,1"
MSComm1.PortOpen = True
If (Err) Then
MsgBox "open port error", vbOKOnly, "System Information"
End If
MSComm1.RThreshold = 20
MSComm1.InputMode = 1
MSComm1.InBufferCount = 0
End Sub
Private Sub MSComm1_OnComm ()
Dim Temp () As Byte
Dim Read ( 0 To 32) As Byte
Dim BBC As Byte
Dim XorByte As Byte
Dim BBC_Temp As Byte
Dim Value As Double
Dim Trans (1 To 8) As Byte
Dim TransValue As Double
Value = 0
XorByte = 0
Temp = MSComm1.Input
If ReadPlc = True Then
If Temp (LBound (Temp)) = 103 And Temp (LBound (Temp) 1) = 1 Then 'If the right start
For i = 0 To 20
Read (i) = Temp (i)
Next i
For i = 2 To 17 'calculation of parity-check codes
XorByte = XorByte Xor Read (i)
Next i
For i = 2 To 19
If Read(i) > &H40 Then
Read(i) = Read(i) - &H37
Else
Read(i) = Read(i) - &H30
End If
Next
BBC_Temp = Read(19) + Read(18) * &H10
If XorByte = BBC_Temp Then
For i = 2 To Lenth * 2 1
Value = Value * &H10 + Read(i)
Next i
Text3.Text = Value
End If
End If
Else
If Temp (0) = 103 And Temp (1) = 2 Then
MsgBox "success parameters ", vbOKOnly," prompted "
End If
End If
End Sub
