Attribute VB_Name = "ModDXC"
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'定義執行緒句柄
Public VBThreadHandle1 As Long, VBThreadHandle2 As Long
'定義執行緒ID
Public VBThreadID1 As Long, VBThreadID2 As Long, hwnd As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function htonl Lib "Wsock32.dll" (ByVal hostlong As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long '該宣告得到系統開機到現在的時間(單位：毫秒)
'------------------------------
Public 套接字 As Long
Public 資料地址 As String
Public Sub 獲取套接字()
Dim 原始API地址 As Long, 新的API地址 As Long
Dim 匯編指令 As String
原始API地址 = GetProcAddress(LoadLibrary("ws2_32.dll"), "send")
新的API地址 = 程序記憶體地址(AddressOf ModDXC.套接字獲取點)
Form1.Text1 = Hex(原始API地址)
Form1.Text2 = Hex(新的API地址)
匯編指令 = "60 8BC4 83C0 24 8B00 A3 " & 補全函式(Hex$(htonl(VarPtr(套接字)))) & "61 8BFF 55 8BEC BB" & 補全函式(Hex$(htonl(原始API地址))) & "83C3 05 FFE3"
If 寫入記憶體(AddressOf ModDXC.套接字獲取點, 匯編指令) = False Then MsgBox "套接字獲取點HOOK失敗!", 0, "HOOK"
無條件跳轉 -1, 原始API地址, 新的API地址
End Sub
Public Sub 構建發包()
Dim 原始API地址 As Long
Dim 匯編指令 As String
匯編指令 = "6A 00 50 68 " & 補全函式(Hex$(htonl(VarPtr(資料地址)))) & "68 " & 補全函式(Hex$(htonl(套接字)))
原始API地址 = GetProcAddress(LoadLibrary("ws2_32.dll"), "send")
匯編指令 = 匯編指令 & "B8" & 補全函式(Hex$(htonl(原始API地址))) & " FFD0 C3"
If 寫入記憶體(AddressOf ModDXC.發包, 匯編指令) = False Then MsgBox "構建發包失敗!", 0, "構建"
Form1.Text5 = Hex(程序記憶體地址(AddressOf ModDXC.發包))
End Sub
Public Sub Thread1() '子執行緒2
'***********************************（重要！）VB6執行緒環境初始化*************************************************
init ByVal hh 'VB6運行庫初始化
CoInitializeEx ByVal 0&, ByVal (COINIT_MULTITHREADED Or COINIT_SPEED_OVER_MEMORY) 'COM組件初始化
InitVBdll '誘導VB6運行庫內部其他部分的初始化
'***********************************（重要！）VB6執行緒環境初始化*************************************************
Form1.Show 1
CoUninitialize '卸載COM組件（省掉也不會影響穩定性，但可能造成句柄或記憶體泄漏。為了養成好習慣，還是寫上）
End Sub
Function 套接字獲取點(ByVal XX As Long) As Long
MessageBox 0, "DLL 劫持模塊初始化完成！", "提示", 16
End Function
Function 發包(ByVal 資料包長度 As Long) As Long
MessageBox 0, "DLL 劫持模塊初始化完成！", "提示", 16
End Function
Public Function 程序記憶體地址(ByVal XX As Long) As Long
程序記憶體地址 = XX
End Function
Function 無條件跳轉(ByVal pehd As Long, ByVal 跳點 As Long, 終點 As Long)
Dim PeCodeAdr1 As Long
Dim MyCodeAdr1 As Long
Dim TemCha As Long
Dim byte1 As Byte
PeCodeAdr1 = 跳點
MyCodeAdr1 = 終點
TemCha = MyCodeAdr1 - (PeCodeAdr1 + 5)
WriteProcessMemory pehd, ByVal PeCodeAdr1, 233, 1, 0& 'E9 JMP
WriteProcessMemory pehd, ByVal PeCodeAdr1 + 1, TemCha, 4, 0& '正確的
End Function
Function 計算十六進制地址(ByVal 跳點 As Long, 終點 As Long) As String
計算十六進制地址 = Hex$(htonl(終點 - (跳點 + 5)))
End Function
Function 反計算十六進制地址(ByVal 跳點 As Long, 終點 As Long) As String
反計算十六進制地址 = Hex$(跳點 + htonl(終點) + 5)
End Function
Function 十六進制轉字串(InputData As String) As String
Dim mydata As String, X As Long
For X = 1 To Len(InputData)
mydata = mydata & " " & Mid(InputData, X, 2)
X = X + 1
Next
Dim S As String, lib As Variant, i As Integer
Dim a() As Byte
S = Mid(mydata, 2, Len(mydata))
lib = Split(S)
ReDim a(UBound(lib))
For i = 0 To UBound(lib)
a(i) = Val("&h" & lib(i))
Next
十六進制轉字串 = StrConv(a, vbUnicode)
End Function
Function 十六進制轉unicode(InputData As String) As String
Dim a As String
Dim as1() As String
Dim ab() As Byte, i As Long
a = InputData
as1 = Split(a, " ")
ReDim ab(UBound(as1))
For i = 0 To UBound(as1) - 1
ab(i) = CByte(Val("&h" & as1(i)))
Next
十六進制轉unicode = ab
End Function
Function 補全函式(InputData As String) As String
Dim mydata As String, X As Long
For X = 1 To 8 - Len(InputData)
mydata = mydata & "0"
Next
補全函式 = mydata & InputData
End Function
Function 字串轉十六進制(字串 As String) As String
Dim a$, i%, b$
a = 字串
For i = 1 To Len(a)
b = b & Hex(Asc(Mid(a, i, 1)))
Next
字串轉十六進制 = b
End Function
Function 寫入記憶體(ByVal 開始地址 As Long, 十六進制資料 As String) As Boolean
Dim X As Long, 偏移 As Long
Dim 資料組(100) As Byte
十六進制資料 = Replace(十六進制資料, " ", "")
For X = 1 To Len(十六進制資料)
資料組(偏移) = Val("&H0" & Mid(十六進制資料, X, 2))
X = X + 1
偏移 = 偏移 + 1
Next
If WriteProcessMemory(-1, 開始地址, 資料組(0), 偏移, 0) = 1 Then 寫入記憶體 = True
End Function
Public Function Sleep2(T As Long)
Dim Savetime As Long
Savetime = timeGetTime '記下開始時的時間
While timeGetTime < Savetime + T '回圈等待
DoEvents '轉讓控制權
Wend
End Function
給回煙錢 謝謝大佬了 這是一個DLL
uj5u.com熱心網友回復：
貌似沒有聽說過批量轉換的工具，一行一行敲吧，才幾百行。轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/9574.html
標籤：網絡通信/分布式開發
上一篇：RAD Studio, Delphi, C++Builder 10.4 ISO
下一篇：這個圖