sampleform.frm

vb通讯程序 vb 与三菱PLc的通讯程序源码

   End
End
Attribute VB_Name = "SAMPLEForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
          
   Select Case Combo1(2).Text
     Case "Y" '8进制须先转换为10进制
         adr$ = Hex(Val("&O" + Text4.Text) \ 16 + Val("&H" + "0500") + Val("&O" + Text4.Text) Mod 15)
     Case "X" '8进制须先转换为10进制
         adr$ = Hex(Val("&O" + Text4.Text) \ 16 + Val("&H" + "0400") + Val("&O" + Text4.Text) Mod 15)
     Case "S"
         adr$ = Hex(Val(Text4.Text) \ 16 + Val("&H" + "0000") + Val("&O" + Text4.Text) Mod 15)
    End Select
       '以上为地址计算
   If Len(adr$) = 1 Then
        adr = "0" + adr + "00"
      ElseIf Len(adr$) = 2 Then
        adr = adr + "00"
      ElseIf Len(adr$) = 3 Then
        adr = Mid(adr, 2, 2) + "0" + Mid(adr, 1, 1)
      ElseIf Len(adr$) = 4 Then
        adr = Mid(adr, 3, 2) + Mid(adr, 1, 2)
      End If
  o$ = "7" + adr
  ooo$ = SumChk(o$) '计算校验和
  o$ = "7" + adr
  oo$ = Chr(2) + o$ + ooo$
  
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True '打开通讯口
  MSComm1.Output = oo$ '发送命令
           

 t = Timer
 Do
  X% = DoEvents()
 Loop Until MSComm1.InBufferCount >= 1 Or Timer > t + 0.8
   '等待回应
            Dim a$
            Dim l, ascV As Integer
            a = MSComm1.Input
            l = Len(a)
            If l > 0 Then
              ascV = Asc(Mid(a, 1, 1))
            If ascV = 6 Or ascV = 2 Then
               MsgBox "置位成功！"
            End If
           
           End If
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False '关闭通讯口
End Sub


Private Sub Command2_Click()

 Select Case Combo1(2).Text
     Case "Y" '8进制须先转换为10进制
         adr$ = Hex(Val("&O" + Text4.Text) \ 16 + Val("&H" + "0500") + Val("&O" + Text4.Text) Mod 15)
     Case "X" '8进制须先转换为10进制
         adr$ = Hex(Val("&O" + Text4.Text) \ 16 + Val("&H" + "0400") + Val("&O" + Text4.Text) Mod 15)
     Case "S"
         adr$ = Hex(Val(Text4.Text) \ 16 + Val("&H" + "0000") + Val("&O" + Text4.Text) Mod 15)
    End Select
       '以上为地址计算
   If Len(adr$) = 1 Then
        adr = "0" + adr + "00"
      ElseIf Len(adr$) = 2 Then
        adr = adr + "00"
      ElseIf Len(adr$) = 3 Then
        adr = Mid(adr, 2, 2) + "0" + Mid(adr, 1, 1)
      ElseIf Len(adr$) = 4 Then
        adr = Mid(adr, 3, 2) + Mid(adr, 1, 2)
   End If
   
  o$ = "8" + adr
  ooo$ = SumChk(o$) '计算校验和
  o$ = "8" + adr
  oo$ = Chr(2) + o$ + ooo$
  
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True '打开通讯口
  MSComm1.Output = oo$ '发送命令

 t = Timer
 Do
  X% = DoEvents()
 Loop Until MSComm1.InBufferCount >= 1 Or Timer > t + 0.8
   '等待回应
            Dim a$
            Dim l, ascV As Integer
            a = MSComm1.Input
            l = Len(a)
            If l > 0 Then
              ascV = Asc(Mid(a, 1, 1))
            If ascV = 6 Or ascV = 2 Then
               MsgBox "复位成功！"
            End If
           
           End If
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False '关闭通讯口
End Sub

Private Sub Command4_Click()
  Select Case Combo1(1).Text
     Case "D"
         adr$ = Hex(Val(Text1(0).Text) * 2 + Val("&H" + "1000"))
         If Val(Text1(0).Text) >= 8000 Then
           adr$ = Hex((Val(Text1(0).Text) - 8000) * 2 + Val("&H" + "0E00"))
         End If
     Case "C字"
         adr$ = Hex(Val(Text1(0).Text) * 2 + Val("&H" + "0A00"))
          If Val(Text1(0).Text) >= 200 Then
           adr$ = Hex((Val(Text1(0).Text) - 200) * 4 + Val("&H" + "0C00"))
         End If
     Case "T字"
         adr$ = Hex(Val(Text1(0).Text) * 2 + Val("&H" + "0800"))
     Case "M"
         adr$ = Hex(Val(Text1(0).Text) \ 8 + Val("&H" + "0100"))
         If Val(Text1(0).Text) >= 8000 Then
           adr$ = Hex((Val(Text1(0).Text) - 8000) * 2 + Val("&H" + "01E0"))
         End If
     Case "Y" '8进制须先转换为10进制
         adr$ = Hex(Val("&O" + Text1(0).Text) \ 8 + Val("&H" + "00A0"))
     Case "X" '8进制须先转换为10进制
         adr$ = Hex(Val("&O" + Text1(0).Text) \ 8 + Val("&H" + "0080"))
     Case "S"
         adr$ = Hex(Val(Text1(0).Text) \ 8 + Val("&H" + "0000"))
     Case "C位"
           adr$ = Hex(Val(Text1(3).Text) \ 8 + Val("&H" + "01C0"))
     Case "T位"
         adr$ = Hex(Val(Text1(3).Text) \ 8 + Val("&H" + "00C0"))
   End Select
    '以上为地址计算
   If Len(adr$) = 1 Then adr = "000" + adr
   If Len(adr$) = 2 Then adr = "00" + adr
   If Len(adr$) = 3 Then adr = "0" + adr
   ll = Hex$(Val(Text1(1).Text))
   If Len(ll) = 1 Then ll = "0" + ll
     '以上为数据长度计算
   o$ = "1" + adr$ + ll + Text1(2).Text
   oo$ = Chr(2) + o$ + SumChk(o$) '计算校验和
     '以上为命令合成计算
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True '打开通讯口
  MSComm1.Output = oo$ '发送命令
 
 t = Timer
 Do
  X% = DoEvents()
 Loop Until MSComm1.InBufferCount > 1 Or Timer > t + 0.03
    '等待回应
 Dim a$
 Dim l, ascV As Integer
 a = MSComm1.Input
 l = Len(a)
' Text3.Text = a
 If l > 0 Then ascV = Asc(Mid(a, 1, 1))
 If ascV = 6 Then
    Shape1(0).Visible = True: Shape1(1).Visible = False '命令已执行
    MsgBox "写数据成功！"
  Else
    Shape1(1).Visible = True: Shape1(0).Visible = False '命令未执行
 End If

 If MSComm1.PortOpen = True Then MSComm1.PortOpen = False '关闭通讯口
End Sub

Private Sub Command5_Click()
   Select Case Combo1(0).Text
     Case "D"
         adr$ = Hex(Val(Text1(3).Text) * 2 + Val("&H" + "1000"))
         If Val(Text1(3).Text) >= 8000 Then
           adr$ = Hex((Val(Text1(3).Text) - 8000) * 2 + Val("&H" + "0E00"))
         End If
     Case "C字"
         adr$ = Hex(Val(Text1(3).Text) * 2 + Val("&H" + "0A00"))
         If Val(Text1(3).Text) >= 200 Then
           adr$ = Hex((Val(Text1(3).Text) - 200) * 4 + Val("&H" + "0C00"))
         End If
     Case "T字"
         adr$ = Hex(Val(Text1(3).Text) * 2 + Val("&H" + "0800"))
     Case "M"
         adr$ = Hex(Val(Text1(3).Text) \ 8 + Val("&H" + "0100"))
         If Val(Text1(3).Text) >= 8000 Then
           adr$ = Hex((Val(Text1(3).Text) - 8000) * 2 + Val("&H" + "01E0"))
         End If
     Case "Y" '8进制须先转换为10进制
         adr$ = Hex(Val("&O" + Text1(3).Text) \ 8 + Val("&H" + "00A0"))
     Case "X" '8进制须先转换为10进制
         adr$ = Hex(Val("&O" + Text1(3).Text) \ 8 + Val("&H" + "0080"))
     Case "S"
         adr$ = Hex(Val(Text1(3).Text) \ 8 + Val("&H" + "0000"))
          Case "C位"
           adr$ = Hex(Val(Text1(3).Text) \ 8 + Val("&H" + "01C0"))
     Case "T位"
         adr$ = Hex(Val(Text1(3).Text) \ 8 + Val("&H" + "00C0"))
    
   End Select
           
           If Len(adr$) = 1 Then adr = "000" + adr
           If Len(adr$) = 2 Then adr = "00" + adr
           If Len(adr$) = 3 Then adr = "0" + adr
           ll = Hex$(Val(Text1(4).Text))
           If Len(ll) = 1 Then ll = "0" + ll
           '以上为数据长度计算
          o$ = "0" + adr$ + ll
          oo$ = Chr(2) + o$ + SumChk(o$) '计算校验和
          '以上为命令合成计算
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True '打开通讯口
  MSComm1.Output = oo$ '发送命令
           
 
 t = Timer
 Do
  X% = DoEvents()
 Loop Until MSComm1.InBufferCount >= 2 * Val(Text1(4).Text) + 3 Or Timer > t + 0.1 * Val(Text1(4).Text)
   '等待回应
            Dim a$
            Dim l, ascV As Integer
            a = MSComm1.Input
            l = Len(a)
        
            Text3.Text = a
            If l > 0 Then
              ascV = Asc(Mid(a, 1, 1))
            If ascV = 6 Or ascV = 2 Then
               MsgBox "读数据成功！"
            End If
           
           End If
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False '关闭通讯口
End Sub

Private Function SumChk(Dats$) As String
    Dim i&
    Dim CHK&
    Dats$ = Dats$ + Chr(3)
    For i = 1 To Len(Dats)
        CHK = CHK + Asc(Mid(Dats, i, 1))
    Next i
    SumChk = Chr(3) + Right(Hex$(CHK), 2)
End Function

Private Sub Form_Load()
     Text1(2).Text = "34127856CDAB"
     For J% = 0 To 1
        Combo1(J%).AddItem "D"
        Combo1(J%).AddItem "C字"
        Combo1(J%).AddItem "T字"
        Combo1(J%).AddItem "M"
        Combo1(J%).AddItem "Y"
        Combo1(J%).AddItem "X"
        Combo1(J%).AddItem "C位"
        Combo1(J%).AddItem "T位"
     Next J%
        Combo1(2).AddItem "Y"
        Combo1(2).AddItem "X"
        Combo1(2).AddItem "S"
     
End Sub