以下是在VB中截获WIN2000下TCP/IP包的源代码，在VB6.0,win2000下测试通过，需要注意的地方是，1.必须和本地的一块网卡,2.每次获取数据后必须有一段延时。3.数据取到之后放在Buff的数组中。
以下是在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
'-----------------------------代码结束--------------------------------------------------->
->
