如何截获HTTP的数据包？！

fisheep_works 2011-02-23 02:31:08

使用以下代码能查到本机接受到的数据，但我们如何截获发出去的数据呢？！

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.71") '这里需要你自己的网卡的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