[轉貼]VB 從零開始編外掛(五)
--------------------------------------------------------------------------------------------------------------------------------------------------------鉤子：喜歡外掛的人都知道，很多外掛都是在遊戲當中才能呼出。這個就用到了鉤子
N多人說：“哎，VB做鉤子想都別想！去學C語言吧！”只要大家遇到這種人，就別理會他。
可以說他是個垃圾。在實現鉤子方面VB可能沒有VC快，但是也不像那種人說的“想都別想”
C語言，我最近幾天看了看。{ } ；這些太多了。腦袋也大了！可能那些學C語言的人是接觸電腦
程式設計的時候就學的它吧！但是呢，我接觸電腦學的就是VB。沒辦法我愛它！
--------------------------------------------------------------------------------------------------------------------------------------------------------
好了下面介紹簡單的鉤子吧！
--------------------------------------------------------------------------------------------------------------------------------------------------------
SetWindowsHookEx定義如下：
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
idHook是鉤子類型，如WH_KEYBOARD捕捉鍵盤消息，而WH_MOUSE捕捉滑鼠消息。
hmod用於全域鉤子，VB要實現鉤子，必須設為0。
dwThreadId用於執行緒鉤子VB中可以設置為App.ThreadID。
lpfn為鉤子函數，在VB中可以使用AddressOf獲得鉤子函數的位址。
這個函數因為鉤子類型不同而有所不同。
--------------------------------------------------------------------------------------------------------------------------------------------------------
如鍵盤鉤子為：
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'如果Code不為0，鉤子函數必須調用CallNextHookEx，將消息傳遞給下面的鉤子。wParam和lParam不是按鍵。
--------------------------------------------------------------------------------------------------------------------------------------------------------
下面給大家一個VB鉤子運用很好的例子！（全域鉤子）
我在論壇上遇到了王者，王者可以說是我見到的VB最棒的一個人。可以說王者是個
VB狂人，很多學C語言的人看來VB不能實現的東西。王者都實現了！這不是在打廣告
這是真的。VB實現全域鉤子前幾年在某某VB學習網站上看見過“VB全域鉤子是根本不能實現的！站長發佈”呵呵！真的有點駭人聽聞！
但是大家看到了下面這個“萬能吃藥”外掛就知道了！
http://www.v2best.com/dispbbs.asp?boardID=6&ID=171&page=1
--------------------------------------------------------------------------------------------------------------------------------------------------------
做外掛的人都知道，目前有兩種辦法製作網路遊戲外掛。一種是封包式另外一種是記憶體式！下面就給大家製作一個抓包器，來研究一下，網路遊戲的資料！
--------------------------------------------------------------------------------------------------------------------------------------------------------
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
--------------------------------------------------------------------------------------------------------------------------------------------------------
彩色的太費時間了，所以就直接貼了！呵呵！
--------------------------------------------------------------------------------------------------------------------------------------------------------
點擊給我留言
--------------------------------------------------------------------------------------------------------------------------------------------------------
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
------------------------------------------------------------------------------------
VB 從零開始編外掛(五)
原作者或上傳者:glasser出處:CSDN環境:VB.NET點擊數:1190
--------------------------------------------------------------------------------------------------------------------------------------------------------
鉤子：喜歡外掛的人都知道，很多外掛都是在遊戲當中才能呼出。這個就用到了鉤子
N多人說：“哎，VB做鉤子想都別想！去學C語言吧！”只要大家遇到這種人，就別理會他。
可以說他是個垃圾。在實現鉤子方面VB可能沒有VC快，但是也不像那種人說的“想都別想”
C語言，我最近幾天看了看。{ } ；這些太多了。腦袋也大了！可能那些學C語言的人是接觸電腦
程式設計的時候就學的它吧！但是呢，我接觸電腦學的就是VB。沒辦法我愛它！
--------------------------------------------------------------------------------------------------------------------------------------------------------
好了下面介紹簡單的鉤子吧！
--------------------------------------------------------------------------------------------------------------------------------------------------------
SetWindowsHookEx定義如下：
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
idHook是鉤子類型，如WH_KEYBOARD捕捉鍵盤消息，而WH_MOUSE捕捉滑鼠消息。
hmod用於全域鉤子，VB要實現鉤子，必須設為0。
dwThreadId用於執行緒鉤子VB中可以設置為App.ThreadID。
lpfn為鉤子函數，在VB中可以使用AddressOf獲得鉤子函數的位址。
這個函數因為鉤子類型不同而有所不同。
--------------------------------------------------------------------------------------------------------------------------------------------------------
如鍵盤鉤子為：
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'如果Code不為0，鉤子函數必須調用CallNextHookEx，將消息傳遞給下面的鉤子。wParam和lParam不是按鍵。
--------------------------------------------------------------------------------------------------------------------------------------------------------
下面給大家一個VB鉤子運用很好的例子！（全域鉤子）
我在論壇上遇到了王者，王者可以說是我見到的VB最棒的一個人。可以說王者是個
VB狂人，很多學C語言的人看來VB不能實現的東西。王者都實現了！這不是在打廣告
這是真的。VB實現全域鉤子前幾年在某某VB學習網站上看見過“VB全域鉤子是根本不能實現的！站長發佈”呵呵！真的有點駭人聽聞！
但是大家看到了下面這個“萬能吃藥”外掛就知道了！
http://www.v2best.com/dispbbs.asp?boardID=6&ID=171&page=1
--------------------------------------------------------------------------------------------------------------------------------------------------------
做外掛的人都知道，目前有兩種辦法製作網路遊戲外掛。一種是封包式另外一種是記憶體式！下面就給大家製作一個抓包器，來研究一下，網路遊戲的資料！
--------------------------------------------------------------------------------------------------------------------------------------------------------
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
--------------------------------------------------------------------------------------------------------------------------------------------------------
彩色的太費時間了，所以就直接貼了！呵呵！
--------------------------------------------------------------------------------------------------------------------------------------------------------
點擊給我留言
--------------------------------------------------------------------------------------------------------------------------------------------------------
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
------------------------------------------------------------------------------------
頁:
[1]