VB设计Win2000下截获IP数据包程序

2018-06-17 17:10:15来源:未知 阅读 ()

新老客户大回馈,云服务器低至5折

以下是在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
'-----------------------------代码结束--------------------------------------------------->
->

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:自定义指定文件夹的图标

下一篇:VB6制作Win98风格的工具栏