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"
                proudp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
            End If
        End If
    Loop Until res <> 2000
End If
End Sub

''''将 16 进制转换为 IP 地址
Public Function inversaip(ByRef lng As String) As String
Dim ips As String

Select Case Len(lng)
    Case 1
        lng = "0000000" & lng
    Case 2
        lng = "000000" & lng
    Case 3
        lng = "00000" & lng
    Case 4
        lng = "0000" & lng
    Case 5
        lng = "000" & lng
    Case 6
        lng = "00" & lng
    Case 7
        lng = "0" & lng
End Select
For i = 1 To Len(lng) Step 2
    ips = ips & Val("&h" & Mid(lng, Len(lng) - i, 2)) & "."
Next i

inversaip = Mid(ips, 1, Len(ips) - 1)
End Function

Public Function proticmp(saa As String, soc As String) As String
Dim ListTemp As Variant
Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time

CopyMemory icmpHead, buffer(0 + 20), Len(icmpHead)

End Function

Public Sub protcp(saa As String, soc As String)
Dim ListTemp As Variant
CopyMemory tcpHead, buffer(0 + 20), Len(tcpHead)

Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(1) = ntohs(tcpHead.th_sport)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(3) = ntohs(tcpHead.th_dport)
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time
End Sub

Public Sub proudp(saa As String, soc As String)
Dim ListTemp As Variant
CopyMemory udpHead, buffer(0 + 20), Len(udpHead)

Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(1) = ntohs(udpHead.th_sport)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(3) = ntohs(udpHead.th_dport)
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time
End Sub

--------------------------------------------------------------------------------------------------------------------------------------------------------
彩色的太费时间了，所以就直接贴了！呵呵！

--------------------------------------------------------------------------------------------------------------------------------------------------------
点击给我留言

--------------------------------------------------------------------------------------------------------------------------------------------

上一页  [1] [2] [3] [4] [5] [6]  下一页