扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条
'-----------------------------代码开始-------------------------------------------------- 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 '-----------------------------代码结束-------------------------------------------------- |
如果您非常迫切的想了解IT领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。
现场直击|2021世界人工智能大会
直击5G创新地带,就在2021MWC上海
5G已至 转型当时——服务提供商如何把握转型的绝佳时机
寻找自己的Flag
华为开发者大会2020(Cloud)- 科技行者