Home
Location: Home > Source Code > S7-200 Example >

S7-200 freeport example
User Manual

Language:English Size:MB File type.rar Add time:2009-07-14 Count:
document description

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

Download url
Products
Document
Software
Example
Note
Please Use "Adobe Reader" to Open the PDF files.
Usefull
(13)
92.9%
Unusefull
(1)
7.1%
-------------------------------------
Latest Comments view all comment
Post comment view all comment
Please consciously abide by Internet-related policies and regulations, is strictly prohibited publication of pornographic, violent, reactionary remarks.
vote:
Expression:
User Name: Password: SafeCode:
Recommended Document
Rand
  • S7-200 Communication with Visua
  • S7-200 freeport example