hidroela
Member
I am trying to create a df1 RS232 drive to communicate with AB PLC 5 using Visual basic 6 after weeks of searching the only thing that I found to get me and starter is this code from this forum control.com
I have made some modification but I am not able to make it work I know that the ConvertFileType function is missing I contact the author of the code but did not received and answer yet
What really got me lost is the creation of the command to send (QueryBuffer)
I was reading the AB DF1 Protocol but I can not figure it out
If some body has some code to get me started please email it to [email protected]
Any help would be appreciated
Best regard Hidroilio Perez
I have made some modification but I am not able to make it work I know that the ConvertFileType function is missing I contact the author of the code but did not received and answer yet
What really got me lost is the creation of the command to send (QueryBuffer)
I was reading the AB DF1 Protocol but I can not figure it out
If some body has some code to get me started please email it to [email protected]
Any help would be appreciated
Best regard Hidroilio Perez
Dim DestinationNode As Integer
Dim SourceNode As Integer
Dim TransactionNo As Integer
Dim Size As Integer
Dim FileNumber As Integer
Dim FileType As Integer
Dim ElementNumber As Integer
Dim SubElementNumber As Integer
Dim TimeOut As Integer
Public Function MsgCRC(Message As String) As String
'Calculate CRC checksum for message then add
'to end of message. Check for 10h byte 'DLE'
'within message and change to 'DLE DLE'.
'Function to calculate message CRC
Dim xByte As Integer
Dim xResult As Long
xByte = 3
Do
xResult = xResult Xor Asc(Mid(Message, xByte, 1))
RotateResult xResult
'test for 'DLE' and double up to DLE DLE
If Asc(Mid(Message, xByte, 1)) = 16 Then
'add extra DLE
Message = Left$(Message, xByte) + Chr(16) + Right$(Message, Len(Message) - xByte)
xByte = xByte + 1 'don't include in CRC
End If
xByte = xByte + 1
Loop While (xByte <= Len(Message) - 2)
xResult = xResult Xor 3 'ETX byte
RotateResult xResult
'add CRC checksum to message
MsgCRC = Chr(xResult Mod 256) + Chr(Int(xResult / 256))
End Function
Public Sub RotateResult(res&)
Dim bitout%, shift%
'Rotate result 8 times and combine with const.
For shift% = 1 To 8
bitout% = res& Mod 2 'test if bit will be shifted out
res& = Int(res& / 2) 'shift right
If bitout% Then
res& = res& Xor &H1000A001 'xor with constant
res& = res& - &H10000000 'clear top word
End If
Next shift%
End Sub
Private Sub Form_Load()
RS232PLC.CommPort = 1
' 9600 baud, no parity, 8 data, and 1 stop bit.
RS232PLC.Settings = "19200,N,8,1"
' Tell the control to read entire buffer when Input
' is used.
RS232PLC.InputLen = 0
' Open the port.
RS232PLC.PortOpen = True
DestinationNode = 0
SourceNode = 0
TransactionNo = 5
Size = 4
FileNumber = 0
FileType = 7
ElementNumber = 31
SubElementNumber = 14
End Sub
Private Sub Timer1_Timer()
Dim TmpTime As Date
Dim QueryBuffer As String
'2:Clear MsComms Buffer
RS232PLC.InputLen = 0
QueryBuffer = RS232PLC.Input
''3:Create Query (Build the string)
QueryBuffer = Chr$(16) & Chr$(2) & Chr$(DestinationNode) & _
Chr$(SourceNode) & Chr$(15) & Chr$(0) & _
Chr$(TransactionNo) & Chr$(0) & Chr$(162) & _
Chr$(Size * 2) & Chr$(FileNumber) & _
Chr$(FileType + 132) & _
Chr$(ElementNumber) & Chr$(SubElementNumber) & _
Chr$(16) & Chr$(3)
'4:Calculate Crc Check Sum and add to Query
QueryBuffer = QueryBuffer & MsgCRC(QueryBuffer)
'5: Send Message
RS232PLC.Output = QueryBuffer
'5:Wait for acknowledgment Or Time Out
TmpTime = Now
Do
DoEvents
If DateDiff("s", TmpTime, Now) >= 3 And _
RS232PLC.InBufferCount < 2 Then
Exit Do
End If
Loop
'6:Remove acknowledgment from buffer
RS232PLC.InputLen = 2
QueryBuffer = RS232PLC.Input
'7:Check for good acknowledgement
If QueryBuffer <> Chr(16) + Chr(6) Then
MsgBox "Bad Ack"
Exit Sub
End If
'8: Wait for response
TmpTime = Now
Do
DoEvents
If DateDiff("s", TmpTime, Now) >= 3 And _
RS232PLC.InBufferCount < 12 + (Size * 2) Then
Exit Do
End If
Loop
'9:If timeout then exit
If RS232PLC.InBufferCount < 12 + (Size * 2) Then
MsgBox "Timed Out"
Exit Sub
End If
'10: Send acknowledgment
RS232PLC.Output = Chr(16) + Chr(6)
'11:Get response
RS232PLC.InputLen = 0
QueryBuffer = RS232PLC.Input
'12: Remove surplus 'DLE's
TmpTime = 3
Do
If Mid(QueryBuffer, TmpTime, 1) = Chr(16) Then
QueryBuffer = Left(QueryBuffer, TmpTime) + Right(QueryBuffer, Len(QueryBuffer) - 1 - TmpTime)
End If
TmpTime = TmpTime + 1
Loop While TmpTime < Len(QueryBuffer) - 4
End Sub
Public Sub ConvertFileType(FileType As Integer)
End Sub
