使用VB在WIN2000下截获IP数据包(3)

If nResult <> 0 Then
MsgBox "ioctlsocket"
Exit Sub
End If

Dim strData As String
Dim nReceived As Long

'截获来的数据放在BUFF里面
Dim Buff(0 To MAX_PACK_LEN) As Byte
Dim IPH As IPHeader

Do Until False '这个例子里，一直获取
DoEvents
nResult = recv(m_hSocket, Buff(0), MAX_PACK_LEN, 0)
If nResult = SOCKET_ERROR Then
MsgBox "Error in RecvData::recv"
Exit Do
End If
CopyMemory IPH, Buff(0), Len(IPH) '为了访问方便
Select Case IPH.proto
Case IPPROTO_TCP
'frmHookTcpip.Text1.SelText = HexIp2DotIp(IPH.sourceIP)
'frmHookTcpip.Text1.SelText = " -----> "
'frmHookTcpip.Text1.SelText = HexIp2DotIp(IPH.destIP)
'frmHookTcpip.Text1.SelText = vbCrLf
Debug.Print HexIp2DotIp(IPH.sourceIP) & " -----> " & HexIp2DotIp(IPH.destIP)
End Select
Loop

nResult = shutdown(m_hSocket, 2)
nResult = closesocket(m_hSocket)
nResult = WSACancelBlockingCall
nResult = WSACleanup
End Sub

Function HexIp2DotIp(ByVal ip As Long) As String
Dim s As String, p1 As String, p2 As String, p3 As String, p4 As String
s = Right("00000000" & Hex(ip), 8)
p1 = Val("&h" & Mid(s, 1, 2))
p2 = Val("&h" & Mid(s, 3, 2))
p3 = Val("&h" & Mid(s, 5, 2))
p4 = Val("&h" & Mid(s, 7, 2))
HexIp2DotIp = p4 & "." & p3 & "." & p2 & "." & p1
End Function