标题:各位大神帮忙改成usb通信
只看楼主
ljs168
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2017-12-31
 问题点数:0 回复次数:0 
各位大神帮忙改成usb通信
各位大神帮忙rs232改成usb通信,,,

Public Sub bx_home()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com1.PortOpen = True
com1.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com1.Output = "@16 11 26 1" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                     If InStr(buffer$, "* 10") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop

err_quit:
'com1.PortOpen = False
End Sub
Public Sub Z_home()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com1.PortOpen = True

com2.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com2.Output = "@15 11 26 1" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "* 0F") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 

err_quit:
'com1.PortOpen = False
End Sub

Public Sub bx_at_home()
Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com1.PortOpen = True

com1.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com1.Output = "@16 12 26" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                     If InStr(buffer$, "# 10 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 
err_quit:
'com1.PortOpen = False
End Sub
Public Sub Z_at_home()
Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com2.PortOpen = True
com2.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com2.Output = "@15 12 26" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "# 0F 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 
err_quit:
'com2.PortOpen = False
End Sub
Public Sub bx_move(movd As Long)
Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com1.PortOpen = True

buffer$ = ""
Do
  ' com1.RTSEnable = True
  ' RTSEnable = True
   com1.Output = "@16 11 33 " + Str$(movd) + Chr$(13)
   delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                    If InStr(buffer$, "* 10") > 0 Then GoTo kku1
                End If
                If Timer - delay > 0.05 Then Exit Do
            
       Loop
   Loop
kku1:
 
 buffer$ = ""
Do
  ' com1.RTSEnable = True
  ' RTSEnable = True
   com1.Output = "@16 11 38 " + Str$(Rotate_Speed) + Chr$(13)
   delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                    If InStr(buffer$, "* 10") > 0 Then GoTo kku2
                End If
                If Timer - delay > 0.05 Then Exit Do
            
       Loop
   Loop
kku2:


Do
  ' com1.RTSEnable = True
  ' RTSEnable = True
  com1.Output = "@16 11 27 1" + Chr$(13)
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                    If InStr(buffer$, "* 10") > 0 Then GoTo err_quit
                End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
Loop


err_quit:
'com1.PortOpen = False
End Sub
Public Sub Z_move(movd As Long)
Dim dy As Long
Dim buffer As String
 On Error GoTo err_quit
'com2.PortOpen = True
'Call PLC_IO
'If (x10_17 And 1) <> 1 Then Exit Sub

buffer$ = ""
Do
  ' com2.RTSEnable = True
  ' RTSEnable = True
   com2.Output = "@15 11 33 " + Str$(movd) + Chr$(13)
   delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                    If InStr(buffer$, "* 0F") > 0 Then GoTo kku1
                End If
                If Timer - delay > 0.05 Then Exit Do
            
       Loop
   Loop
kku1:
 
 buffer$ = ""
Do
  ' com2.RTSEnable = True
  ' RTSEnable = True
   com2.Output = "@15 11 38 " + Str$(Move_Speed) + Chr$(13)
   delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                    If InStr(buffer$, "* 0F") > 0 Then GoTo kku2
                End If
                If Timer - delay > 0.05 Then Exit Do
            
       Loop
   Loop
kku2:


Do
  ' com2.RTSEnable = True
  ' RTSEnable = True
  com2.Output = "@15 11 27 1" + Chr$(13)
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                    If InStr(buffer$, "* 0F") > 0 Then GoTo err_quit
                End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
Loop

err_quit:
 'com2.PortOpen = False
End Sub
Public Sub bx_stop()
Dim dy As Long
Dim buffer As String
 On Error GoTo err_quit
'com1.PortOpen = True

   ' com1.RTSEnable = True
   ' RTSEnable = True
  Do
  com1.Output = "@16 12 27" + Chr$(13)
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                     If InStr(buffer$, "# 10 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
Loop


err_quit:
 'com1.PortOpen = False
End Sub
Public Sub Z_stop()
Dim dy As Long
Dim buffer As String
 On Error GoTo err_quit
'com2.PortOpen = True
   ' com2.RTSEnable = True
   ' RTSEnable = True
  Do
  com2.Output = "@15 12 27" + Chr$(13)
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "# 0F 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
Loop
 
err_quit:
'com2.PortOpen = False
End Sub
Public Sub bx_pos()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com1.PortOpen = True
buffer$ = ""
aa:
Do
  buffer$ = ""
  com1.Output = "@16 12 1" + Chr$(13)
  DoEvents
       For dy = 1 To 1000000
   Next dy
  buffer$ = buffer$ & com1.Input
  If (InStr(buffer$, "# 10 000C") > 0) And (InStr(buffer$, Chr$(13)) > 0) Then Exit Do
  If Len(buffer$) > 20 Then buffer$ = ""
   
Loop
'If Len(buffer$) <> 20 Then GoTo aa
jjj = InStr(buffer$, "#")
pos$ = Mid$(buffer$, jjj + 10, 4) + Mid$(buffer$, jjj + 15, 4)
'Stop
Call getdec(pos$)

err_quit:
 ''com1.PortOpen = False
End Sub

Public Sub Z_pos()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com2.PortOpen = True
buffer$ = ""
aa:
Do
  buffer$ = ""
  com2.Output = "@15 12 1" + Chr$(13)
  DoEvents
       For dy = 1 To 1000000
   Next dy
  buffer$ = buffer$ & com2.Input
  If (InStr(buffer$, "# 0F 000C") > 0) And (InStr(buffer$, Chr$(13)) > 0) Then Exit Do
  If Len(buffer$) > 20 Then buffer$ = ""
   
Loop
'If Len(buffer$) <> 20 Then GoTo aa
jjj = InStr(buffer$, "#")
pos$ = Mid$(buffer$, jjj + 10, 4) + Mid$(buffer$, jjj + 15, 4)
'Stop
Call getdec(pos$)

err_quit:
 ''com2.PortOpen = FalseDim dy As Long
End Sub


Public Sub Z_jog()

Dim dy As Long
Dim buffer As String
 On Error GoTo err_quit
'com2.PortOpen = True
 buffer$ = ""
Do
  ' com2.RTSEnable = True
  ' RTSEnable = True
   com2.Output = "@15 11 37 " + Str$(Punch_Time) + Chr$(13)
   delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                    If InStr(buffer$, "* 0F") > 0 Then GoTo kku2
                End If
                If Timer - delay > 0.05 Then Exit Do
            
       Loop
   Loop
kku2:
'Stop
Do
buffer$ = ""
Do
 ' buffer$ = ""
  com2.Output = "@15 11 28 1" + Chr$(13)
  DoEvents
   For dy = 1 To 1000000 * time_factor
   Next dy
  buffer$ = buffer$ & com2.Input
  If InStr(buffer$, "0F") > 0 Then Exit Do
    If Len(buffer$) > 5 Then buffer$ = ""
   
Loop

buffer$ = ""
Do
   com2.Output = "@15 12 28" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "# 0F 000C 0000 0001") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
Loop
err_quit:
 ''com2.PortOpen = False
'Stop

End Sub

Public Sub Z_jog_s()

Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com2.PortOpen = True
com2.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com2.Output = "@15 12 28" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "# 0F 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 
err_quit:
'com2.PortOpen = False


End Sub
Public Sub Z_IO()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com2.PortOpen = True
buffer$ = ""
aa:
Do
  buffer$ = ""
  com2.Output = "@15 21" + Chr$(13)
  DoEvents
       For dy = 1 To 1000000
   Next dy
  buffer$ = buffer$ & com2.Input
  If (InStr(buffer$, "# 0F 0015") > 0) And (InStr(buffer$, Chr$(13)) > 0) Then Exit Do
  If Len(buffer$) > 20 Then buffer$ = ""
   
Loop
'If Len(buffer$) <> 20 Then GoTo aa
jjj = InStr(buffer$, "#")
pos$ = (Mid$(buffer$, jjj + 12, 1))
Call getdec(pos$)

err_quit:
 ''com2.PortOpen = FalseDim dy As Long
End Sub
Public Sub On_O()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com2.PortOpen = True

com2.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com2.Output = "@15 11 29 1" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "* 0F") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 

err_quit:
'com2.PortOpen = False
End Sub
Public Sub On_O_Done()
Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com2.PortOpen = True
com2.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com2.Output = "@15 12 29" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "# 0F 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 
err_quit:
'com2.PortOpen = False
End Sub
Public Sub Off_O()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com2.PortOpen = True

com2.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com2.Output = "@15 11 30 1" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "* 0F") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 

err_quit:
'com2.PortOpen = False
End Sub
Public Sub Off_O_Done()
Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com2.PortOpen = True
com2.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com2.Output = "@15 12 30" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com2.InBufferCount > 0 Then
                    buffer$ = buffer$ + com2.Input
                     If InStr(buffer$, "# 0F 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 
err_quit:
'com2.PortOpen = False
End Sub
Public Sub On_O_X()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com1.PortOpen = True

com1.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com1.Output = "@16 11 29 1" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                     If InStr(buffer$, "* 10") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 

err_quit:
'com1.PortOpen = False
End Sub
Public Sub On_O_Done_X()
Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com1.PortOpen = True
com1.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com1.Output = "@16 12 29" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                     If InStr(buffer$, "# 10 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 
err_quit:
'com1.PortOpen = False
End Sub
Public Sub Off_O_X()
Dim dy As Long
Dim buffer As String
On Error GoTo err_quit
'com1.PortOpen = True

com1.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com1.Output = "@16 11 30 1" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                     If InStr(buffer$, "* 10") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 

err_quit:
'com1.PortOpen = False
End Sub
Public Sub Off_O_Done_X()
Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com1.PortOpen = True
com1.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com1.Output = "@16 12 30" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                     If InStr(buffer$, "# 10 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 
err_quit:
'com1.PortOpen = False
End Sub

Public Sub bx_jog()
Dim dy As Long
Dim buffer As String
 On Error GoTo err_quit
'com1.PortOpen = True

buffer$ = ""
Do
 ' buffer$ = ""
  com1.Output = "@16 11 28 1" + Chr$(13)
  DoEvents
   For dy = 1 To 1000000 * time_factor
   Next dy
  buffer$ = buffer$ & com1.Input
  If InStr(buffer$, "10") > 0 Then Exit Do
    If Len(buffer$) > 5 Then buffer$ = ""
   
Loop

err_quit:
 ''com1.PortOpen = False
End Sub

Public Sub bx_jog_s()

Dim dy As Long
Dim buffer As String
  On Error GoTo err_quit
 'com1.PortOpen = True
com1.RTSEnable = True
RTSEnable = True
buffer$ = ""
Do
   com1.Output = "@16 12 28" + Chr$(13)
' Do
  delay = Timer   ' Set delaystart time.
   buffer$ = ""
        Do
            DoEvents
              If com1.InBufferCount > 0 Then
                    buffer$ = buffer$ + com1.Input
                     If InStr(buffer$, "# 10 000C 0000 0000") > 0 Then GoTo err_quit
                     End If
                If Timer - delay > 0.05 Then Exit Do
         Loop
  Loop
 
err_quit:
'com1.PortOpen = False


End Sub


Public Sub start()
   
    Dim lret As Long
    Dim lData(2) As Long
    Dim strX0_15 As String
    Dim strY0_15 As String
    Dim X(16) As Boolean
    Dim Y(16) As Boolean
    Dim counter As Long
    Dim szDevice As String
   
    Do
    szDevice = "K8X0" & vbLf & "K8Y0"
    lret = ActFXCPU.ReadDeviceRandom(szDevice, 2, lData(0))
    If lret <> 0 Then GoTo ComError
    strX0_15 = DecimalToBinary2(lData(0), 16)
    strY0_15 = DecimalToBinary2(lData(1), 16)
   
    For counter = 0 To 15
        X(counter) = CBool(Mid$(strX0_15, 16 - counter, 1))
       ' If X(counter) Then
       ' LX(counter).FillColor = vbGreen
       ' Else
       ' LX(counter).FillColor = vbRed
       ' End If
   
    If X(10) Then
   
      ' MsgBox ("input 10")
       Exit Sub
      
    End If

   
    Next
   
    For counter = 0 To 11
        Y(counter) = CBool(Mid$(strY0_15, 16 - counter, 1))
       ' If Y(counter) Then
       ' LY(counter).FillColor = vbGreen
       ' Else
       ' LY(counter).FillColor = vbRed
       ' End If
    Next
   
   
    Loop
   
    'Exit Sub
   
ComError:   '通讯出错处理
    MsgBox ("通讯出错!")


End Sub

Public Function DecimalToBinary2(DecimalValue As Long, MinimumDigits As Integer) As String

' Returns a string containing the binary
' representation of a positive integer.

Dim result As String
Dim ExtraDigitsNeeded As Integer

' Make sure value is not negative.
DecimalValue = Abs(DecimalValue)

' Construct the binary value.
Do
    result = CStr(DecimalValue Mod 2) & result
    DecimalValue = DecimalValue \ 2
Loop While DecimalValue > 0

' Add leading zeros if needed.

ExtraDigitsNeeded = MinimumDigits - Len(result)
If ExtraDigitsNeeded > 0 Then
    result = String(ExtraDigitsNeeded, "0") & result
End If

DecimalToBinary2 = result

End Function
搜索更多相关主题的帖子: Dim buffer Do If Then 
2018-01-28 22:05



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-484513-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.100354 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved