问RS232通信协议三菱FX3G PLC

EN

'1 form with :
'    1 mscomm control : name=comFX
'    1 command button : name=cmdSend
'    1 textbox        : name=txtShow   multiline=true
Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private mstrData As String
Private mblnBusy As Boolean

Private Sub Form_Load()
  With App
    Caption = .Title & " " & CStr(.Major) & "." & CStr(.Minor) & "." & CStr(.Revision)
  End With 'App
End Sub

Private Sub Form_Resize()
  Dim sngWidth As Single
  Dim sngTxtHeight As Single
  Dim sngCmdWidth As Single, sngCmdHeight As Single
  sngWidth = ScaleWidth
  sngCmdHeight = 315
  sngTxtHeight = ScaleHeight - sngCmdHeight
  txtShow.Move 0, 0, sngWidth, sngTxtHeight
  cmdSend.Move sngCmdWidth, sngTxtHeight, sngWidth, sngCmdHeight
End Sub

Private Sub cmdSend_Click()
  ReadReg "D8013", 7  'sec,min,hr,day,month,year,dayofweek
  ReadReg "R3310", 10 '10 data registers
End Sub

Private Sub ReadReg(strReg As String, intNr As Integer)
  Dim strCmd As String
  If NotBusy Then
    strCmd = "00FFWR0" & strReg & Right$("00" & Hex$(intNr), 2)
    strCmd = Chr$(5) & strCmd & GetSum(strCmd)
    With comFX
      If .PortOpen = False Then CommOpen
      .Output = strCmd
    End With 'comFX
    mblnBusy = True
  End If
End Sub

Private Sub CommOpen()
  With comFX
    If .PortOpen = True Then .PortOpen = False
    .CommPort = 1
    .Settings = "19200,N,8,1"
    .RThreshold = 1
    .PortOpen = True
  End With 'comFX
End Sub

Private Function NotBusy() As Boolean
  Dim lngTimeout As Long
  Dim blnResult As Boolean
  blnResult = True
  lngTimeout = GetTickCount + 1000 'timeout after being busy for 1 second
  Do While mblnBusy
    DoEvents
    If GetTickCount > lngTimeout Then
      blnResult = False
      Exit Do
    End If
  Loop
  NotBusy = blnResult
End Function

Private Sub comFX_OnComm()
  Dim strInput As String
  Select Case comFX.CommEvent
    Case comEvReceive
      strInput = comFX.Input
      mstrData = mstrData & strInput
      ProcessData
  End Select
End Sub

Private Sub ProcessData()
  'answer : ^02 00FF <data registers 4 characters per reg> ^03
  Dim lngStart As Long, lngEnd As Long
  Dim strHead As String, strSum As String
  Dim strEnd As String
  Dim strData As String
  lngStart = InStr(mstrData, Chr$(2))
  If lngStart > 0 Then
    strEnd = Chr$(3)
    lngEnd = InStr(lngStart, mstrData, strEnd)
    If lngEnd > 0 Then
      strHead = Mid$(mstrData, lngStart + 1, 4)
      If strHead = "00FF" Then
        strData = Mid$(mstrData, lngStart + 1, lngEnd - lngStart)
        strSum = Mid$(mstrData, lngEnd + 1, 2)
        If CheckSum(strData, strSum) Then
          mstrData = Mid$(mstrData, lngEnd + 3)
          ShowData Mid$(strData, 5, Len(strData) - 5)
          mblnBusy = False
        End If
      End If
    End If
  End If
End Sub

Private Function CheckSum(strData As String, strSum As String) As Boolean
  If strSum = GetSum(strData) Then
    CheckSum = True
  Else
    CheckSum = False
  End If
End Function

Private Function GetSum(strCmd As String) As String
  Dim intChar As Integer
  Dim lngSum As Long
  lngSum = 0
  For intChar = 1 To Len(strCmd)
    lngSum = lngSum + Asc(Mid$(strCmd, intChar, 1))
  Next intChar
  GetSum = Right$("00" + Hex$(lngSum), 2)
End Function

Private Sub ShowData(strData As String)
  txtShow.SelText = strData & vbCrLf
End Sub