我如何才能获得winsock现有的缓冲区内的数据大小??如何才能让控制winsock触发dataarrival事件触发或者不触发呢??
7 个解决方案
#1
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
End Sub
bytesTotal 就是了!!
End Sub
bytesTotal 就是了!!
#2
这个 bytesTotal 是实时更新的吗???
如果我在处理这个dataarrival事件的过程中,又有数据来到了缓冲区,那么 bytesTotal 会继续累加吗???
我怎么才能不让它继续触发dataarrival事件呢???
如果我在处理这个dataarrival事件的过程中,又有数据来到了缓冲区,那么 bytesTotal 会继续累加吗???
我怎么才能不让它继续触发dataarrival事件呢???
#3
你的目的是什么?
控件的好处就在于隐藏实现目的复杂性,代之以简单易用的接口。
从你的要求来看,似乎有意于socket的底层控制,那就别用winsock控件了!
获取socket的缓冲区长度可用下面函数
Private Declare Function getsockopt Lib "ws2_32.dll" (ByVal hsocket As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
用它的前提是你要自己建立socket,并控制,至于事件的产生,可以采用WSAAsyncSelect函数,选择窗体接收socket消息,然后subclass它,通过SOCKET_MESSAGE消息得到事件ID,其中FD_READ就是你要操作的dataarrival事件
控件的好处就在于隐藏实现目的复杂性,代之以简单易用的接口。
从你的要求来看,似乎有意于socket的底层控制,那就别用winsock控件了!
获取socket的缓冲区长度可用下面函数
Private Declare Function getsockopt Lib "ws2_32.dll" (ByVal hsocket As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
用它的前提是你要自己建立socket,并控制,至于事件的产生,可以采用WSAAsyncSelect函数,选择窗体接收socket消息,然后subclass它,通过SOCKET_MESSAGE消息得到事件ID,其中FD_READ就是你要操作的dataarrival事件
#4
对不起!才看到你上面的回复,也看到你的另外几个问题,估计不用控件,你暂时还做不到。
这样说吧,dataarrival事件发生,是自动的,是死的东西,你不用控制它的发生,人是活的,你要等到一定条件后再处理也可以,在dataarrival事件中你只管接收并保存进一个模块级变量中(它相当于你自己的缓冲区),每次接收后检查你的缓冲区是否满足你的长度条件,不满足就等待下次dataarrival事件时再检查,一旦满足再调用你的方法统一处理。
到达数据的总量,在你自己的缓冲中可以直接取得
这样说吧,dataarrival事件发生,是自动的,是死的东西,你不用控制它的发生,人是活的,你要等到一定条件后再处理也可以,在dataarrival事件中你只管接收并保存进一个模块级变量中(它相当于你自己的缓冲区),每次接收后检查你的缓冲区是否满足你的长度条件,不满足就等待下次dataarrival事件时再检查,一旦满足再调用你的方法统一处理。
到达数据的总量,在你自己的缓冲中可以直接取得
#5
你有没有使用api写的连接程序代码??能给我一份看看吗??谢谢啦
#6
如果我在处理这个dataarrival事件的过程中,又有数据来到了缓冲区,那么 bytesTotal 会继续累加吗???不会继续累加。但是如果你使用模块级变量进行Getdata,但是你处理的速度又不够快,可能要丢数据。
#7
转载一个api的
VB设计Win2000下截获IP数据包程序
以下是在VB中截获WIN2000下TCP/IP包的源代码,在VB6.0,win2000下测试通过,需要注意的地方是,1.必须和本地的一块网卡,2.每次获取数据后必须有一段延时。3.数据取到之后放在Buff的数组中。4.把以下的代码放在一个模块中就可以了。
''-----------------------------代码开始--------------------------------------------------
Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As SOCK_ADDR, ByVal namelen As Long) As Long
Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, name As SOCK_ADDR, ByVal namelen As Integer) As Long
Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
Declare Function send Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As Long
Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal type_specification As Long, ByVal protocol As Long) As Long
Declare Function WSACancelBlockingCall Lib "ws2_32.dll" () As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As Long
Declare Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long, ByVal type1 As Long, ByVal protocol As Long, lpProtocolInfo As Long, g As Long, ByVal dwFlags As Long)
Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Long, ByVal cbInBuffer As Long, lpvOutBuffer As Long, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Type WSA_DATA
wVersion As Integer
wHighVersion As Integer
strDescription(WSADESCRIPTION_LEN + 1) As Byte
strSystemStatus(WSASYS_STATUS_LEN + 1) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Type IN_ADDR
S_addr As Long
End Type
Type SOCK_ADDR
sin_family As Integer
sin_port As Integer
sin_addr As IN_ADDR
sin_zero(0 To 7) As Byte
End Type
Type IPHeader
lenver As Byte
tos As Byte
len As Integer
ident As Integer
flags As Integer
ttl As Byte
proto As Byte
checksum As Integer
sourceIP As Long
destIP As Long
End Type
Const AF_INET = 2
Const SOCK_RAW = 3
Const IPPROTO_IP = 0
Const IPPROTO_TCP = 6
Const IPPROTO_UDP = 17
Const MAX_PACK_LEN = 65535
Const SOCKET_ERROR = -1&
Private mwsaData As WSA_DATA
Private m_hSocket As Long
Private msaLocalAddr As SOCK_ADDR
Private msaRemoteAddr As SOCK_ADDR
Sub Main()
Dim nResult As Long
nResult = WSAStartup(&H202, mwsaData)
If nResult <> WSANOERROR Then
MsgBox "Error en WSAStartup"
Exit Sub
End If
m_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP)
If (m_hSocket = INVALID_SOCKET) Then
MsgBox "Error in socket"
Exit Sub
End If
msaLocalAddr.sin_family = AF_INET
msaLocalAddr.sin_port = 0
msaLocalAddr.sin_addr.S_addr = inet_addr("192.168.1.125") ''这里需要你自己的网卡的IP地址
nResult = bind(m_hSocket, msaLocalAddr, Len(msaLocalAddr))
If (nResult = SOCKET_ERROR) Then
MsgBox "Error in bind"
Exit Sub
End If
Dim InParamBuffer As Long
Dim BytesRet As Long
BytesRet = 0
InParamBuffer = 1
nResult = ioctlsocket(m_hSocket, &H98000001, 1)
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
''-----------------------------代码结束--------------------------------------------------
现在应该都是wsock32.dll的DLL,替换一下就行了
VB设计Win2000下截获IP数据包程序
以下是在VB中截获WIN2000下TCP/IP包的源代码,在VB6.0,win2000下测试通过,需要注意的地方是,1.必须和本地的一块网卡,2.每次获取数据后必须有一段延时。3.数据取到之后放在Buff的数组中。4.把以下的代码放在一个模块中就可以了。
''-----------------------------代码开始--------------------------------------------------
Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As SOCK_ADDR, ByVal namelen As Long) As Long
Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, name As SOCK_ADDR, ByVal namelen As Integer) As Long
Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
Declare Function send Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As Long
Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal type_specification As Long, ByVal protocol As Long) As Long
Declare Function WSACancelBlockingCall Lib "ws2_32.dll" () As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As Long
Declare Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long, ByVal type1 As Long, ByVal protocol As Long, lpProtocolInfo As Long, g As Long, ByVal dwFlags As Long)
Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Long, ByVal cbInBuffer As Long, lpvOutBuffer As Long, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Type WSA_DATA
wVersion As Integer
wHighVersion As Integer
strDescription(WSADESCRIPTION_LEN + 1) As Byte
strSystemStatus(WSASYS_STATUS_LEN + 1) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Type IN_ADDR
S_addr As Long
End Type
Type SOCK_ADDR
sin_family As Integer
sin_port As Integer
sin_addr As IN_ADDR
sin_zero(0 To 7) As Byte
End Type
Type IPHeader
lenver As Byte
tos As Byte
len As Integer
ident As Integer
flags As Integer
ttl As Byte
proto As Byte
checksum As Integer
sourceIP As Long
destIP As Long
End Type
Const AF_INET = 2
Const SOCK_RAW = 3
Const IPPROTO_IP = 0
Const IPPROTO_TCP = 6
Const IPPROTO_UDP = 17
Const MAX_PACK_LEN = 65535
Const SOCKET_ERROR = -1&
Private mwsaData As WSA_DATA
Private m_hSocket As Long
Private msaLocalAddr As SOCK_ADDR
Private msaRemoteAddr As SOCK_ADDR
Sub Main()
Dim nResult As Long
nResult = WSAStartup(&H202, mwsaData)
If nResult <> WSANOERROR Then
MsgBox "Error en WSAStartup"
Exit Sub
End If
m_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP)
If (m_hSocket = INVALID_SOCKET) Then
MsgBox "Error in socket"
Exit Sub
End If
msaLocalAddr.sin_family = AF_INET
msaLocalAddr.sin_port = 0
msaLocalAddr.sin_addr.S_addr = inet_addr("192.168.1.125") ''这里需要你自己的网卡的IP地址
nResult = bind(m_hSocket, msaLocalAddr, Len(msaLocalAddr))
If (nResult = SOCKET_ERROR) Then
MsgBox "Error in bind"
Exit Sub
End If
Dim InParamBuffer As Long
Dim BytesRet As Long
BytesRet = 0
InParamBuffer = 1
nResult = ioctlsocket(m_hSocket, &H98000001, 1)
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
''-----------------------------代码结束--------------------------------------------------
现在应该都是wsock32.dll的DLL,替换一下就行了
#1
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
End Sub
bytesTotal 就是了!!
End Sub
bytesTotal 就是了!!
#2
这个 bytesTotal 是实时更新的吗???
如果我在处理这个dataarrival事件的过程中,又有数据来到了缓冲区,那么 bytesTotal 会继续累加吗???
我怎么才能不让它继续触发dataarrival事件呢???
如果我在处理这个dataarrival事件的过程中,又有数据来到了缓冲区,那么 bytesTotal 会继续累加吗???
我怎么才能不让它继续触发dataarrival事件呢???
#3
你的目的是什么?
控件的好处就在于隐藏实现目的复杂性,代之以简单易用的接口。
从你的要求来看,似乎有意于socket的底层控制,那就别用winsock控件了!
获取socket的缓冲区长度可用下面函数
Private Declare Function getsockopt Lib "ws2_32.dll" (ByVal hsocket As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
用它的前提是你要自己建立socket,并控制,至于事件的产生,可以采用WSAAsyncSelect函数,选择窗体接收socket消息,然后subclass它,通过SOCKET_MESSAGE消息得到事件ID,其中FD_READ就是你要操作的dataarrival事件
控件的好处就在于隐藏实现目的复杂性,代之以简单易用的接口。
从你的要求来看,似乎有意于socket的底层控制,那就别用winsock控件了!
获取socket的缓冲区长度可用下面函数
Private Declare Function getsockopt Lib "ws2_32.dll" (ByVal hsocket As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
用它的前提是你要自己建立socket,并控制,至于事件的产生,可以采用WSAAsyncSelect函数,选择窗体接收socket消息,然后subclass它,通过SOCKET_MESSAGE消息得到事件ID,其中FD_READ就是你要操作的dataarrival事件
#4
对不起!才看到你上面的回复,也看到你的另外几个问题,估计不用控件,你暂时还做不到。
这样说吧,dataarrival事件发生,是自动的,是死的东西,你不用控制它的发生,人是活的,你要等到一定条件后再处理也可以,在dataarrival事件中你只管接收并保存进一个模块级变量中(它相当于你自己的缓冲区),每次接收后检查你的缓冲区是否满足你的长度条件,不满足就等待下次dataarrival事件时再检查,一旦满足再调用你的方法统一处理。
到达数据的总量,在你自己的缓冲中可以直接取得
这样说吧,dataarrival事件发生,是自动的,是死的东西,你不用控制它的发生,人是活的,你要等到一定条件后再处理也可以,在dataarrival事件中你只管接收并保存进一个模块级变量中(它相当于你自己的缓冲区),每次接收后检查你的缓冲区是否满足你的长度条件,不满足就等待下次dataarrival事件时再检查,一旦满足再调用你的方法统一处理。
到达数据的总量,在你自己的缓冲中可以直接取得
#5
你有没有使用api写的连接程序代码??能给我一份看看吗??谢谢啦
#6
如果我在处理这个dataarrival事件的过程中,又有数据来到了缓冲区,那么 bytesTotal 会继续累加吗???不会继续累加。但是如果你使用模块级变量进行Getdata,但是你处理的速度又不够快,可能要丢数据。
#7
转载一个api的
VB设计Win2000下截获IP数据包程序
以下是在VB中截获WIN2000下TCP/IP包的源代码,在VB6.0,win2000下测试通过,需要注意的地方是,1.必须和本地的一块网卡,2.每次获取数据后必须有一段延时。3.数据取到之后放在Buff的数组中。4.把以下的代码放在一个模块中就可以了。
''-----------------------------代码开始--------------------------------------------------
Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As SOCK_ADDR, ByVal namelen As Long) As Long
Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, name As SOCK_ADDR, ByVal namelen As Integer) As Long
Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
Declare Function send Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As Long
Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal type_specification As Long, ByVal protocol As Long) As Long
Declare Function WSACancelBlockingCall Lib "ws2_32.dll" () As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As Long
Declare Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long, ByVal type1 As Long, ByVal protocol As Long, lpProtocolInfo As Long, g As Long, ByVal dwFlags As Long)
Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Long, ByVal cbInBuffer As Long, lpvOutBuffer As Long, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Type WSA_DATA
wVersion As Integer
wHighVersion As Integer
strDescription(WSADESCRIPTION_LEN + 1) As Byte
strSystemStatus(WSASYS_STATUS_LEN + 1) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Type IN_ADDR
S_addr As Long
End Type
Type SOCK_ADDR
sin_family As Integer
sin_port As Integer
sin_addr As IN_ADDR
sin_zero(0 To 7) As Byte
End Type
Type IPHeader
lenver As Byte
tos As Byte
len As Integer
ident As Integer
flags As Integer
ttl As Byte
proto As Byte
checksum As Integer
sourceIP As Long
destIP As Long
End Type
Const AF_INET = 2
Const SOCK_RAW = 3
Const IPPROTO_IP = 0
Const IPPROTO_TCP = 6
Const IPPROTO_UDP = 17
Const MAX_PACK_LEN = 65535
Const SOCKET_ERROR = -1&
Private mwsaData As WSA_DATA
Private m_hSocket As Long
Private msaLocalAddr As SOCK_ADDR
Private msaRemoteAddr As SOCK_ADDR
Sub Main()
Dim nResult As Long
nResult = WSAStartup(&H202, mwsaData)
If nResult <> WSANOERROR Then
MsgBox "Error en WSAStartup"
Exit Sub
End If
m_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP)
If (m_hSocket = INVALID_SOCKET) Then
MsgBox "Error in socket"
Exit Sub
End If
msaLocalAddr.sin_family = AF_INET
msaLocalAddr.sin_port = 0
msaLocalAddr.sin_addr.S_addr = inet_addr("192.168.1.125") ''这里需要你自己的网卡的IP地址
nResult = bind(m_hSocket, msaLocalAddr, Len(msaLocalAddr))
If (nResult = SOCKET_ERROR) Then
MsgBox "Error in bind"
Exit Sub
End If
Dim InParamBuffer As Long
Dim BytesRet As Long
BytesRet = 0
InParamBuffer = 1
nResult = ioctlsocket(m_hSocket, &H98000001, 1)
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
''-----------------------------代码结束--------------------------------------------------
现在应该都是wsock32.dll的DLL,替换一下就行了
VB设计Win2000下截获IP数据包程序
以下是在VB中截获WIN2000下TCP/IP包的源代码,在VB6.0,win2000下测试通过,需要注意的地方是,1.必须和本地的一块网卡,2.每次获取数据后必须有一段延时。3.数据取到之后放在Buff的数组中。4.把以下的代码放在一个模块中就可以了。
''-----------------------------代码开始--------------------------------------------------
Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As SOCK_ADDR, ByVal namelen As Long) As Long
Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, name As SOCK_ADDR, ByVal namelen As Integer) As Long
Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
Declare Function send Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As Long
Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal type_specification As Long, ByVal protocol As Long) As Long
Declare Function WSACancelBlockingCall Lib "ws2_32.dll" () As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As Long
Declare Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long, ByVal type1 As Long, ByVal protocol As Long, lpProtocolInfo As Long, g As Long, ByVal dwFlags As Long)
Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Long, ByVal cbInBuffer As Long, lpvOutBuffer As Long, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Type WSA_DATA
wVersion As Integer
wHighVersion As Integer
strDescription(WSADESCRIPTION_LEN + 1) As Byte
strSystemStatus(WSASYS_STATUS_LEN + 1) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Type IN_ADDR
S_addr As Long
End Type
Type SOCK_ADDR
sin_family As Integer
sin_port As Integer
sin_addr As IN_ADDR
sin_zero(0 To 7) As Byte
End Type
Type IPHeader
lenver As Byte
tos As Byte
len As Integer
ident As Integer
flags As Integer
ttl As Byte
proto As Byte
checksum As Integer
sourceIP As Long
destIP As Long
End Type
Const AF_INET = 2
Const SOCK_RAW = 3
Const IPPROTO_IP = 0
Const IPPROTO_TCP = 6
Const IPPROTO_UDP = 17
Const MAX_PACK_LEN = 65535
Const SOCKET_ERROR = -1&
Private mwsaData As WSA_DATA
Private m_hSocket As Long
Private msaLocalAddr As SOCK_ADDR
Private msaRemoteAddr As SOCK_ADDR
Sub Main()
Dim nResult As Long
nResult = WSAStartup(&H202, mwsaData)
If nResult <> WSANOERROR Then
MsgBox "Error en WSAStartup"
Exit Sub
End If
m_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP)
If (m_hSocket = INVALID_SOCKET) Then
MsgBox "Error in socket"
Exit Sub
End If
msaLocalAddr.sin_family = AF_INET
msaLocalAddr.sin_port = 0
msaLocalAddr.sin_addr.S_addr = inet_addr("192.168.1.125") ''这里需要你自己的网卡的IP地址
nResult = bind(m_hSocket, msaLocalAddr, Len(msaLocalAddr))
If (nResult = SOCKET_ERROR) Then
MsgBox "Error in bind"
Exit Sub
End If
Dim InParamBuffer As Long
Dim BytesRet As Long
BytesRet = 0
InParamBuffer = 1
nResult = ioctlsocket(m_hSocket, &H98000001, 1)
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
''-----------------------------代码结束--------------------------------------------------
现在应该都是wsock32.dll的DLL,替换一下就行了