这是一个硬件收发数据的测试软件,原来是用ASCCII收发数据,怎么才能改成用十六进制发送接收,这里有源代码,请各位高手指点。

caoliyong 2002-04-20 11:31:14
模块代码:

Option Explicit
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Declare Function closesocket Lib "wsock32.dll" (ByVal ss As Integer) As Integer
Global Const ASCIICtrl = "<NL><SH><SX><EX><ET><EQ><AK><BL><BS><HT><LF><VT><FF><CR><SO><SI><DL><D1><D2><D3><D4><NA><SY><EB><CA><EM><SU><ES><FS><GS><RS><US>"

Function AB_ErrMsg(ret As Integer) As String
Dim tmpstr As String

Select Case ret
Case -3
tmpstr = "Parameter data is error !"
Case -2
tmpstr = "TCP is not created yet !"
Case -1
tmpstr = "Device ID out of range !"
Case 0
tmpstr = "Closed"
Case 1
tmpstr = "Open"
Case 2
tmpstr = "Listening"
Case 3
tmpstr = "Connection is Pending"
Case 4
tmpstr = "Resolving the host name"
Case 5
tmpstr = "Host is Resolved"
Case 6
tmpstr = "Waiting to Connect"
Case 7
tmpstr = "Connected ok "
Case 8
tmpstr = "Connection is closing"
Case 9
tmpstr = "State error has occurred"
Case 10
tmpstr = "Connection state is undetermined"
Case Else
tmpstr = "Unknown Error Code"
End Select

AB_ErrMsg = tmpstr
End Function

Function MsgBox2(Index As Integer, msg As String)
Dim lst As Object
Dim timestr As String

Set lst = frmTCP.lstMsg(Index)
timestr = Time$

If lst.ListCount >= 100 Then
lst.RemoveItem 0
End If
lst.AddItem timestr & " " & msg
lst.ListIndex = lst.ListCount - 1
End Function

Function MsgBoxT(Index As Integer, msg As String)
Dim lst As Object
Dim timestr As String

Set lst = frmTCP.lstMsgT(Index)
timestr = Time$

If lst.ListCount >= 100 Then
lst.RemoveItem 0
End If
lst.AddItem timestr & " " & msg
lst.ListIndex = lst.ListCount - 1
End Function

Function HexIp0(ip_str As String, op_str As String) As Integer
Dim start As Integer, cnt As Integer
Dim tmpstr As String

op_str = ""
start = 1
cnt = 0
Do
tmpstr = Mid$(ip_str, start, 1)
start = start + 1
If tmpstr = "" Then Exit Do
If tmpstr = "\" Then
tmpstr = "&H"
tmpstr = tmpstr + Mid$(ip_str, start, 2)
start = start + 2
tmpstr = ChrW(Val(tmpstr))
End If
op_str = op_str + tmpstr
cnt = cnt + 1
Loop
HexIp0 = cnt
End Function

Function HexIpB(ip_str As String, op_str() As Byte, op_start As Integer) As Integer
Dim start As Integer, cnt As Integer
Dim tmpstr As String
Dim data As Integer

start = 1
cnt = 0 + op_start
Do
tmpstr = Mid$(ip_str, start, 1)
start = start + 1
If tmpstr = "" Then Exit Do
If tmpstr = "\" Then
If Mid$(ip_str, start, 1) = "\" Then
data = Asc(tmpstr)
start = start + 1
op_str(cnt) = data Mod 256
cnt = cnt + 1
Else
tmpstr = "&H" & Mid$(ip_str, start, 2)
start = start + 2
op_str(cnt) = Val(tmpstr)
cnt = cnt + 1
End If
Else
data = Asc(tmpstr)
op_str(cnt) = data Mod 256
cnt = cnt + 1
If data >= 256 Then
op_str(cnt) = data / 256
cnt = cnt + 1
End If
End If
Loop
HexIpB = cnt

End Function

Function HexOp3(ip_str As Variant, start0 As Integer, cnt As Integer) As String
Dim start As Integer
Dim tmpstr As String
Dim ch As Integer

tmpstr = ""
For start = 1 To cnt
ch = ip_str(start0 + start - 1)
If (ch >= 0) And (ch <= &H20) Then
tmpstr = tmpstr + Mid$(ASCIICtrl, ch * 4 + 1, 4)
Else
tmpstr = tmpstr + ChrW(ch)
End If
Next start
HexOp3 = tmpstr
End Function

Function ldump(ip_str, op_str) As Integer
Dim start As Integer
Dim tmpstr As String

op_str = ""
start = 1
Do
tmpstr = Mid$(ip_str, start, 1)
start = start + 1
If tmpstr = "" Then Exit Do
tmpstr = Hex$(AscW(tmpstr)) + " "
If Len(tmpstr) < 3 Then
tmpstr = "0" & tmpstr
End If
op_str = op_str + tmpstr
Loop

End Function

Function ldump4(ip_str As Variant, start As Integer, cnt As Integer) As String
Dim ret As Integer, i As Integer
Dim tmpstr As String, op_str As String

op_str = ""
For i = 0 To cnt - 1
tmpstr = Hex$(ip_str(start + i)) + " "
If Len(tmpstr) < 3 Then
tmpstr = "0" & tmpstr
End If
op_str = op_str + tmpstr
Next i

ldump4 = op_str
End Function
...全文
35 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧