mdl2.bas

此为交通信号机

Attribute VB_Name = "Mdl2"
   Global instring(1 To 4) As String
   Global steps As Integer
    Global DataMatrix(1 To 40, 1 To 40) As Integer
   Public Function ReadSchemeFromPlc(command As String, AddStart As String, ReadBytes As String) As String
           Dim Sum As Integer
           Dim Num As String
           Dim i, j, col, row As Integer
           Dim sumstring As String
           Dim sumstring2 As String
           Dim time1
           Dim instring As String
           'Dim ReadTimes As Integer
           
           'Dim addstart1 As Integer
           Dim Bytes As Integer
          ' addstart1 = StringToVal(AddStart)     '起始地址（整数）
           Bytes = Val(ReadBytes)        '读数据个数（整数）
           
       
      
        '  AddStart = CStr(Hex(addstart1 + (ReadTimes - 1) * Bytes))
          
        '将地址调整为四位
        If Len(AddStart) <> 4 Then
            Select Case Len(AddStart)
               Case 1
                   AddStart = "0" + "0" + "0" + AddStart
               Case 2
                   AddStart = "0" + "0" + AddStart
               Case 3
                   AddStart = "0" + AddStart
            End Select
       End If
       
       '地址和校验
       Sum = &H30
       For i = 1 To 4
       Sum = Sum + Asc(Mid(AddStart, i, 1))
       Next i
       
       
       '调整位数
       Num = Hex(Bytes)
       If Len(Num) = 1 Then
       Num = "0" + Num
       End If
       
        '数量和校验
       For i = 1 To 2
       Sum = Sum + Asc(Mid(Num, i, 1))
       Next
       
       Sum = Sum + 3
       sumstring = Hex(Sum)
       sumstring2 = Right(sumstring, 2)
       
       
        
       FrmMain.MSComm1.PortOpen = True
      FrmMain.MSComm1.Output = Chr(&H2) + command   'STX  CMD 0
       FrmMain.MSComm1.Output = AddStart
       FrmMain.MSComm1.Output = Num
       FrmMain.MSComm1.Output = Chr(3)            'ETX
      FrmMain.MSComm1.Output = sumstring2        'SUM
       
         
         '接收数据
         '检测是否有NAK!
         i = 0
         time1 = Timer
         Do
         DoEvents
            If FrmMain.MSComm1.InBufferCount = 2 Then
            i = i + 1
            Else
            End If
         Loop Until FrmMain.MSComm1.InBufferCount >= (2 * Bytes + 4) Or i >= 10 Or (Timer - time1) > 10
         
         instring = FrmMain.MSComm1.Input
         
         If (Timer - time1) > 10 Then
           MsgBox "PLC没有响应！"
           GoTo end1:
         Else
            If i >= 10 Then
                If Left(instring, 1) = Chr(&H15) Then
                     MsgBox "PLC不能辨别指令或者数据校验错误！"
                    GoTo end1:
                  
             Else
             End If
         Else
         End If
         End If
        '和校验收到的数据
        
        Sum = 0
        For i = 2 To (2 * Bytes + 2)
            Sum = Sum + Asc(Mid(instring, i, 1))
        Next
        sumstring = Hex(Sum)
        sumstring2 = Right(sumstring, 2)
              If sumstring2 <> Mid(instring, 2 * Bytes + 3, 2) Then
                  MsgBox "数据校验错误！请从新读取数据"
              GoTo end1:
              Else
              
              End If
             
       

End2:     ReadSchemeFromPlc = Mid(instring, 2, Len(instring) - 4)
          GoTo end3:
  
end1:     ReadSchemeFromPlc = ""

end3:     FrmMain.MSComm1.PortOpen = False
   End Function
Public Function StringToVal(Str As String) As Long
         Dim qq() As Integer
         Dim i As Integer
         ReDim qq(1 To Len(Str))
         For i = Len(Str) To 1 Step -1
           Select Case Mid(Str, i, 1)
             Case "1", "0", "2", "3", "4", "5", "6", "7", "8", "9"
             qq(Len(Str) - i + 1) = Mid(Str, i, 1)
                
             Case "A"
               qq(Len(Str) - i + 1) = 10
             Case "B"
               qq(Len(Str) - i + 1) = 11
             Case "C"
               qq(Len(Str) - i + 1) = 12
             Case "D"
               qq(Len(Str) - i + 1) = 13
             Case "E"
               qq(Len(Str) - i + 1) = 14
             Case "F"
               qq(Len(Str) - i + 1) = 15
           End Select
         Next
         StringToVal = 0
        For i = 1 To Len(Str)
           StringToVal = StringToVal + qq(i) * 16 ^ (i - 1)
        Next
End Function

Public Sub TransferDataFromPlc()
          Dim i As Integer
          Dim Mr As Integer
          Dim Mc As Integer
          Dim String4 As String
          Dim String2 As String                        'String4 4个字符，String2 两个字符
          Dim ValString4 As Long
          Dim ValString2 As Long
          Dim HexString4 As String
          Dim HexString2 As String
          Dim BinString4 As String
          Dim BinString2 As String
          Dim HexString4Reverted As String
          Dim HexString2Reverted As String
          Dim DataMatrix1(1 To 40, 1 To 40) As Integer
          MousePointer = 13
          
          '处理第一个方案表
          For Mc = 1 To 20
              
                   String4 = Mid(instring(1), (Mc - 1) * 8 + 1, 4)
                   String2 = Mid(instring(1), (Mc - 1) * 8 + 5, 2)
                   ValString4 = StringToVal(String4)                       '转化为10进制数值
                   ValString2 = StringToVal(String2)
                   HexString4 = Hex(ValString4)
                   If Len(HexString4) <> 8 Then        '调整位数
                         Select Case Len(HexString4)
                            Case 1
                                HexString4 = "0000000" + HexString4
                            Case 2
                                HexString4 = "000000" + HexString4
                            Case 3
                                HexString4 = "00000" + HexString4
                            Case 4
                                HexString4 = "0000" + HexString4
                            Case 5
                                HexString4 = "000" + HexString4
                            Case 6
                                HexString4 = "00" + HexString4
                            Case 7
                                HexString4 = "0" + HexString4
                         End Select
                    End If
                    
                   HexString2 = Hex(ValString2)
                    If Len(HexString2) <> 2 Then          '调整为数
                          HexString2 = "0" + HexString2
                    End If
                    
                   '调整字符排列顺序
                   HexString4Reverted = Mid(HexString4, 2, 1) + Mid(HexString4, 1, 1) + Mid(HexString4, 4, 1) + Mid(HexString4, 3, 1) + Mid(HexString4, 6, 1) + Mid(HexString4, 5, 1) + Mid(HexString4, 8, 1) + Mid(HexString4, 7, 1)
                   HexString2Reverted = Mid(HexString2, 2, 1) + Mid(HexString2, 1, 1)
                   
                   
                   BinString4 = HexStringToBinString(HexString4Reverted)      '转化为2进制数值
                   BinString2 = HexStringToBinString(HexString2Reverted)
               For Mr = 1 To 32                                           '填充数组
                                                                          
                   DataMatrix(Mr, Mc) = Mid(BinString4, 33 - Mr, 1)