人家的vb winsock 通讯

前端之家收集整理的这篇文章主要介绍了人家的vb winsock 通讯前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

'强人的api winsock

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,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,
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

原文链接:https://www.f2er.com/vb/261408.html

猜你在找的VB相关文章