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
--------------------------------------------------------------------------------------------------------------------------------------------------------
彩色的太费时间了，所以就直接贴了！呵呵！
--------------------------------------------------------------------------------------------------------------------------------------------------------
点击给我留言
--------------------------------------------------------------------------------------------------------------------------------------------------------
|
