各位大神帮忙改成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
