以下是在VB中截获WIN2000下TCP/IP包的源代码，在VB6.0,win2000下测试通过，需要注意的地方是，1.必须和本地的一块网卡,2.每次获取数据后必须有一段延时。3.数据取到之后放在Buff的数组中。4.把以下的代码放在一个模块中就可以了。

->-----------------------------代码开始--------------------------------------------------
DeclareFunctionbindLib"ws2_32.dll"(ByValsAsLong,addrAsSOCK_ADDR,ByValnamelenAsLong)AsLong
DeclareFunctionclosesocketLib"ws2_32.dll"(ByValsAsLong)AsLong
DeclareFunctionconnectLib"ws2_32.dll"(ByValsAsLong,nameAsSOCK_ADDR,ByValnamelenAsInteger)AsLong
DeclareFunctioninet_addrLib"ws2_32.dll"(ByValcpAsString)AsLong
DeclareFunctionhtonsLib"ws2_32.dll"(ByValhostshortAsInteger)AsInteger
DeclareFunctionrecvLib"ws2_32.dll"(ByValsAsLong,bufferAsAny,ByVallengthAsLong,ByValflagsAsLong)AsLong
DeclareFunctionsendLib"ws2_32.dll"(ByValsAsLong,bufferAsAny,ByVallengthAsLong,ByValflagsAsLong)AsLong
DeclareFunctionshutdownLib"ws2_32.dll"(ByValsAsLong,ByValhowAsLong)AsLong
DeclareFunctionioctlsocketLib"ws2_32.dll"(ByValsAsLong,ByValvAsLong,utAsLong)AsLong
DeclareFunctionsocketLib"ws2_32.dll"(ByValafAsLong,ByValtype_specificationAsLong,ByValprotocolAsLong)AsLong
DeclareFunctionWSACancelBlockingCallLib"ws2_32.dll"()AsLong
DeclareFunctionWSACleanupLib"ws2_32.dll"()AsLong
DeclareFunctionWSAGetLastErrorLib"ws2_32.dll"()AsLong
DeclareFunctionWSAStartupLib"ws2_32.dll"(ByValwVersionRequiredAsInteger,wsDataAsWSA_DATA)AsLong
DeclareFunctionWSASocketALib"ws2_32.dll"(ByValafAsLong,ByValtype1AsLong,ByValprotocolAsLong,lpProtocolInfoAsLong,gAsLong,ByValdwFlagsAsLong)
DeclareFunctionWSAIoctlLib"ws2_32.dll"(ByValsAsLong,ByValdwIoControlCodeAsLong,lpvInBufferAsLong,ByValcbInBufferAsLong,lpvOutBufferAsLong,ByValcbOutBufferAsLong,lpcbBytesReturnedAsLong,lpOverlappedAsLong,lpCompletionRoutineAsLong)AsLong

DeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(DestinationAsAny,SourceAsAny,ByVallengthAsLong)

PublicDeclareSubSleepLib"kernel32"(ByValdwMillisecondsAsLong)

PublicConstWSADESCRIPTION_LEN=256
PublicConstWSASYS_STATUS_LEN=128

TypeWSA_DATA
　wVersionAsInteger
　wHighVersionAsInteger
　strDescription(WSADESCRIPTION_LEN 1)AsByte
　strSystemStatus(WSASYS_STATUS_LEN 1)AsByte
　iMaxSocketsAsInteger
　iMaxUdpDgAsInteger
　lpVendorInfoAsLong
EndType

TypeIN_ADDR
　S_addrAsLong
EndType

TypeSOCK_ADDR
　sin_familyAsInteger
　sin_portAsInteger
　sin_addrAsIN_ADDR
　sin_zero(0To7)AsByte
EndType

TypeIPHeader
　lenverAsByte
　tosAsByte
　lenAsInteger
　identAsInteger
　flagsAsInteger
　ttlAsByte
　protoAsByte
　checksumAsInteger
　sourceIPAsLong
　destIPAsLong
EndType

ConstAF_INET=2
ConstSOCK_RAW=3
ConstIPPROTO_IP=0
ConstIPPROTO_TCP=6
ConstIPPROTO_UDP=17
ConstMAX_PACK_LEN=65535
ConstSOCKET_ERROR=-1&

PrivatemwsaDataAsWSA_DATA
Privatem_hSocketAsLong

PrivatemsaLocalAddrAsSOCK_ADDR
PrivatemsaRemoteAddrAsSOCK_ADDR

SubMain()
　DimnResultAsLong

　nResult=WSAStartup(&H202,mwsaData)
　IfnResult<>WSANOERRORThen
　　MsgBox"ErrorenWSAStartup"
　　ExitSub
　EndIf

　m_hSocket=socket(AF_INET,SOCK_RAW,IPPROTO_IP)
　If(m_hSocket=INVALID_SOCKET)Then
　　MsgBox"Errorinsocket"
　　ExitSub
　EndIf

　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"Errorinbind"
　　ExitSub
　EndIf

　DimInParamBufferAsLong
　DimBytesRetAsLong
　BytesRet=0
　InParamBuffer=1

　nResult=ioctlsocket(m_hSocket,&H98000001,1)

　IfnResult<>0Then
　　MsgBox"ioctlsocket"
　　ExitSub
　EndIf

　DimstrDataAsString
　DimnReceivedAsLong

　截获来的数据放在BUFF里面
　DimBuff(0ToMAX_PACK_LEN)AsByte
　DimIPHAsIPHeader

　DoUntilFalse这个例子里，一直获取
　DoEvents
　nResult=recv(m_hSocket,Buff(0),MAX_PACK_LEN,0)
　IfnResult=SOCKET_ERRORThen
　　MsgBox"ErrorinRecvData::recv"
　　ExitDo
　EndIf
　CopyMemoryIPH,Buff(0),Len(IPH)为了访问方便
　SelectCaseIPH.proto
　　CaseIPPROTO_TCP
　　　frmHookTcpip.Text1.SelText=HexIp2DotIp(IPH.sourceIP)
　　　frmHookTcpip.Text1.SelText="----->"
　　　frmHookTcpip.Text1.SelText=HexIp2DotIp(IPH.destIP)
　　　frmHookTcpip.Text1.SelText=vbCrLf
　　　Debug.PrintHexIp2DotIp(IPH.sourceIP)&"----->"&HexIp2DotIp(IPH.destIP)
　　　EndSelect
　　Loop

　nResult=shutdown(m_hSocket,2)
　nResult=closesocket(m_hSocket)
　nResult=WSACancelBlockingCall
　nResult=WSACleanup
EndSub

FunctionHexIp2DotIp(ByValipAsLong)AsString
　DimsAsString,p1AsString,p2AsString,p3AsString,p4AsString
　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
　EndFunction
-----------------------------代码结束--------------------------------------------------->->

文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!