这个程序为什么只能截取内网封包呢?

[hnlhtwb]

最近从网上找了个VB抓包示例,经过调试发现只能截取内网封包,对外网数据无效.
请高手们指正怎样才能截取全部的封包.包括外网流进本机的的.


模块的;

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 用来返回一个关于主机信息的结构的指针

Public Declare Function WSAstartup Lib "wsock32.dll" Alias "WSAStartup" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSAdata) As Long

Public Declare Function WsACleanup Lib "wsock32.dll" Alias "WSACleanup" () As Long

Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

Public Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long

Public Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long

Public Declare Function gethostname Lib "wsock32.dll" (ByVal name As String, ByVal namelen As Long) As Long

Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As Long

Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long

Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long

Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long

Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long

Public Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Any, ByVal cbInBuffer As Long, lpvOutBuffer As Any, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long

Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long

Public Declare Function bind Lib "wsock32.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer

Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer

Public Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As Long

Public Type WSAdata

wVersion As Integer

wHighVersion As Integer

szDescription As String * 255

szSystemStatus As String * 128

iMaxSockets As Integer

iMaxUdpDg As Integer

lpVendorInfo As Long

End Type



'sock 地址结构

Public Type sockaddr

sin_family As Integer

sin_port As Integer

sin_addr As Long

sin_zero As String * 8

End Type


Public Type HOSTENT

h_name As Long

h_aliases As Long

h_addrtype As Integer

h_length As Integer

h_addr_list As Long

End Type




'ip 头结构

Public 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



'TCP 头结构

Public Type tcp_hdr

th_sport As Integer

th_dport As Integer

th_seq As Long

th_ack As Long

th_lenres As Byte

th_flag As Byte

th_win As Integer

th_sum As Integer

th_urp As Integer

End Type



'UDP 头结构

Public Type udp_hdr

th_sport As Integer

th_dport As Integer

th_len As Integer

th_sum As Integer

End Type



'ICMP 头结构

Public Type icmp_hdr

th_type As Byte

th_code As Byte

th_sum As Integer

th_id As Integer

th_seq As Integer

th_time As Long

End Type


'常量

Public Const PF_INET = 2

Public Const SOCK_RAW = 3

Public Const AF_INET = 2

Public Const FD_READ = &H1

Public Const SIO_RCVALL = &H98000001

Public Const EM_REPLACESEL = &HC2

Public Const PACKMAX = 8192

Public Const IPLEN = 65535

Public host As HOSTENT

Public s As Long

Public sock As sockaddr


Public Header As ipheader

Public tcpHead As tcp_hdr

Public udpHead As udp_hdr

Public icmpHead As icmp_hdr



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

[hnlhtwb]

接上贴:

'获得当前主机的 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地址

'sock.sin_port = "0"

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(IPLEN) '重定义缓冲区大小为 2000



Do

res = recv(s, buffer(0), IPLEN, 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




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
CopyMemory tcpHead, buffer(0 + 20), Len(tcpHead)

End Sub


Public Sub proudp(saa As String, soc As String)

Dim ListTemp As Variant





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

CopyMemory udpHead, buffer(0 + 20), Len(udpHead)
End Sub

[hnlhtwb]

接上贴:窗口部分
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