Public resarray() As Long, str As String
Public i As Long, CountID As Long 'i 为临时变量，循环语句用，CountID 用来计算一共有多少个数据包
逆风编程精品
Public protocol As String
Public buffer() As Byte '存放数据包
Public res As Long '返回值，临时变量
Public ExitID As Boolean '退出标识

'开始
Public Sub Wstartup()
Dim Data As WSAdata
Call WSAstartup(&H202, Data) '初始化 Winsock 为 2.2
End Sub

'结束
Public Sub WCleanup(s As Long)
Call WsACleanup '关闭 Winsock
closesocket s
End Sub

'获得当前主机的 IP
Public Function ip(ByRef address As String) As String
Dim pip As Long
Dim uip As Long
Dim s As Long
Dim ss As String
Dim cul As Long

CopyMemory host, ByVal gethostbyname(address), Len(host) '将 gethostbyname 获得的值放到 host
CopyMemory pip, ByVal host.h_addr_list, 4 '将 host.h_addr_list 的值放到 pip
CopyMemory uip, ByVal pip, 4 '将 pip 的值放到 uip
s = inet_ntoa(uip) '将 uip 转换为标准的 IPV4 格式
ss = Space(lstrlen(s)) '去掉空格
cul = lstrcpy(ss, s)
ip = ss '获得 IPV4 格式的地址并将其放如 ip
End Function

'获得当前机器的主机名
Public Function hostname() As String
Dim r As Long
Dim s As String
Dim host As String

Wstartup
host = String(255, 0)
r = gethostname(host, 255) '获得当前主机的主机名

If r = 0 Then
hostname = Left(host, InStr(1, host, VBNullChar) - 1)
End If

End Function

'连接 IP
Public Sub Connecting(ByRef ip As String, pic As PictureBox)
Dim res As Long, buf As Long, bufb As Long
buf = 1

Wstartup '初始化 Winsock

s = socket(AF_INET, SOCK_RAW, 0) '创建套接字，s 是socket功能返回的文件描述符
If s < 1 Then
Call WCleanup(s)
Exit Sub '如果创建失败则退出
End If

sock.sin_family = AF_INET 'socket类型
sock.sin_addr = inet_addr(ip) '所用的IP地址
res = bind(s, sock, Len(sock)) '绑定端口

If res <> 0 Then
Call WCleanup(s)
Exit Sub '如果绑定失败则退出
End If

res = WSAIoctl(s, SIO_RCVALL, buf, Len(buf), 0, 0, bufb, ByVal 0, ByVal 0) '改变Socket IO模式，将其改为混乱模式，即接受与自己无关的数据，则 SIO_RCVALL

If res <> 0 Then
Call WCleanup(s)
Exit Sub
End If

res = WSAAsyncSelect(s, pic.hWnd, &H202, ByVal FD_READ) '设置套接字处于阻塞方式或者非阻塞方式,消息发送的窗口是 pic，即 Form1.Picture1

If res <> 0 Then
Call WCleanup(s)
Exit Sub
End If

End Sub

'接收信息
Public Sub Recibir(s As Long, ByVal RecFormat As Long)
If RecFormat = FD_READ Then
ReDim buffer(2000) '重定义缓冲区大小为 2000
Do
res = recv(s, buffer(0), 2000, 0&) '接收信息
If res > 0 Then

ReDim Preserve resarray(CountID) '改变数组大小，并保留以前的数据
str = buffer()
resarray(CountID) = res

CopyMemory Header, buffer(0), Len(Header) '将 buffer 里面的数据复制到 Header 结构里面

'根据IP头结构的标识来获得是什么类型的数据包，并将 IP 从头结构中分离出来
If Header.proto = 1 Then
protocol = "ICMP"
proticmp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
End If
If Header.proto = 6 Then
protocol = "TCP"
protcp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
End If
If Header.proto = 17 Then
protocol = "UDP"