vbcatchnetdata.txt

做外挂的人都知道

VB抓包器
 
----------------------------------------------------------------------------------------------------
做外挂的人都知道，目前有两种办法制作网络游戏外挂。一种是封包式另外一种是内存式！下面就给大家制作一个抓包器，来研究一下，网络游戏的数据！ 

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

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

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