''''将 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

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

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

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

Private Sub Form_Load()
CountID = 0
ExitID = False
ListView1.ColumnHeaders.Add 1, , "源 IP", 1500
ListView1.ColumnHeaders.Add 2, , "源端口", 1500
ListView1.ColumnHeaders.Add 3, , "目标 IP", 1500
ListView1.ColumnHeaders.Add 4, , "目标端口", 1500
ListView1.ColumnHeaders.Add 5, , "协议", 1500
ListView1.ColumnHeaders.Add 6, , "时间", 1500
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call WCleanup(s)
Unload Me
End Sub

Private Sub ListView1_Click()
Dim coun As Long
Dim sar As String, sar3 As String
Dim sar1 As String, sar2 As String

RichTextBox1.Text = ""                      ''''清除 RichTextBox1
Dim buffer() As Byte
buffer = str

If ListView1.SelectedItem Is Nothing Then   ''''如果 ListView1 控件没有数值则提示错误
    Exit Sub
End If

''''将 buffer 的值（即通过 Recibir 接收的数据包）转换为一定格式并在 RichTextBox1 控件下显示出来
For i = 0 To resarray(ListView1.SelectedItem.Index)
    coun = coun + 1
    If Len(Hex(buffer(i))) = 1 Then
        sar = "0" & Hex(buffer(i))
    Else
        sar = Hex(buffer(i))
    End If
    
    sar3 = sar3 & sar
    
    If Asc(Chr("&h" & Hex(buffer(i)))) < 32 Then
        sar1 = "."
    Else
        sar1 = Chr("&h" & Hex(buffer(i)))
    End If
    
    sar2 = sar2 & sar1
    RichTextBox1.Text = RichTextBox1.Text & sar & " "
    
    If coun = 15 Then
        RichTextBox1.Text = RichTextBox1.Text & " |" & sar2 & vbCrLf:
        coun = 0
        sar2 = ""
        sar3 = ""
    End If
Next i

If coun < 15 Then
    r = 44 - (coun * 3) + 1
    es = String(r, Chr(32))
    RichTextBox1.Text = RichTextBox1.Text & es & " |" & sar2
End If
End Sub

Private Sub M_Clear_Click()
ListView1.ListItems.Clear
RichTextBox1.Text = ""
End Sub

''''程序开始捕捉
Private Sub M_Start_Click()
ListView1.ListItems.Clear
RichTextBox1.Text = ""
Connecting ip(hostname), MsgHwnd            ''''开始截取封包
End Sub

Private Sub M_Stop_Click()
ExitID = True                               ''''停止截取封包
End Sub

Private Sub MsgHwnd_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
CountID = CountID + 1
Recibir s, 1
If ExitID = True Then
    Call WCleanup(s)
    ExitID = False
    MsgBox "退出", vbOKOnly, "数据封包截取"
End If
End Sub

模块：

Option Explicit

''''WSAstartup 用来判断 Windows 所支持的 Winsock 版本，也就是初始化 Winsock DLL，其中第一个参数为你所想需要的Winsock版本！低字节为主版本，高字节为副版本！由于目前Winsock有两个版本：1.1和2.2，因此该参数可以是0x101或0x202；第二个参数是一个WSADATA结构，用于接收函数的返回信息！WSAStartup函数调用成功会返回0，否则返回非0值！
''''WSACleanup 用来关闭 Winsock，与 WSAstartup 一起使用，即 WSAstartup 也可以看为启动 Winsock
''''gethostbyname 用来返回一个关于主机信息的

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