急急急!!!端口传输数据问题,请各位高手指点谜津

[caoliyong]

我最近要做一个硬件的测试程序,该硬件是用于以太网报文分组转换器.要用十六进制的方式发送数据和接收数据,由于水平有限只实现了ASCCII码收发数据,请问各位高手谁能告诉我代码如何写.由于容量有限只提供模块代码和部分窗体代码
模块代码:
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
部分窗体代码:
Option Explicit
Private Sub cmdClose_Click(Index As Integer)
Dim tmpstr As String
Dim cnt As Integer

On Error GoTo cmdClose99

tcpClient(Index).Close
Exit Sub

cmdClose99:
MsgBox Error
End Sub
Private Sub cmdConnect_Click(Index As Integer)
On Error GoTo cmdConnect99

tcpClient(Index).LocalPort = "0"
tcpClient(Index).RemoteHost = txtIP(Index)
tcpClient(Index).RemotePort = txtPort(Index)
tcpClient(Index).Connect
Exit Sub

cmdConnect99:
MsgBox Error
End Sub
Private Sub cmdSend_Click(Index As Integer)
Dim tmpstr As String
Dim cnt As Integer
Dim tmpbuf() As Byte

On Error GoTo cmdSend99

'cnt = HexIp0(txtSend, tmpstr)
'tcpClient.SendData tmpstr
cnt = Len(txtSend(Index))
ReDim tmpbuf(cnt)
cnt = HexIpB(txtSend(Index), tmpbuf(), 0)
If cnt > 0 Then
ReDim Preserve tmpbuf(cnt - 1)
tcpClient(Index).SendData tmpbuf()
End If
Exit Sub

cmdSend99:
MsgBox Error
End Sub
Private Sub Command1_Click(Index As Integer)
frmABOUT.Show
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()

'Testing Envrionment
txtIP(1) = "192.168.0.126" 'the Factory Value
txtIP(0) = "192.168.0.126"
'txtPort(0) = 4660
'txtPort(1) = 4661
End Sub
Private Sub lstMsg_DblClick(Index As Integer)
MsgBox lstMsg(Index).List(lstMsg(Index).ListIndex)
End Sub
Private Sub lstMsgT_DblClick(Index As Integer)
MsgBox lstMsgT(Index).List(lstMsgT(Index).ListIndex)
End Sub
Private Sub tcpClient_Close(Index As Integer)
MsgBox2 Index, "TCP close ok"
tcpClient(Index).Close
End Sub
Private Sub tcpClient_Connect(Index As Integer)
MsgBox2 Index, "TCP connect ok"
End Sub
Private Sub tcpClient_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strData(512) As Byte ' Max Receiving Data Length
Dim tmpstr As String
Dim cnt As Integer
Dim tmpv As Variant

On Error GoTo DataArrival99

cnt = bytesTotal
tcpClient(Index).GetData tmpv
tmpstr = ldump4(tmpv, 0, CInt(bytesTotal))
MsgBox2 Index, CStr(bytesTotal) & ", " & tmpstr
tmpstr = HexOp3(tmpv, 0, CInt(bytesTotal))
MsgBoxT Index, CStr(bytesTotal) & ", " & tmpstr
Recv = tmpstr

Call RXD

Call delay(0.0125)

Recv = ""

Call StopR

Exit Sub

DataArrival99:
MsgBox Error
End Sub