远线程运行API，技术就是：
1、构造远线程调用代码及参数
2、通过线性搜索获取对方进程中的API入口地址
由于2是提取自一个以前的代码，并且调用API的函数中用了多个循环判定，导致……效率低下的很呢
代码中关键部分就是：
1、E8后面偏移地址的计算：E8后面是相对地址……
2、不同类型参数的处理：除了INTEGER以外，都“按指针”传递——调用时采用了字节数组
3、参数反向压栈：注意一下就可以了
4、实现了一个泛接口类，用以把结构转化为字节数组，但未测试，若不成功应自己把参数转化为字节数组后传入
5、有个修改内存页属性的函数，没有用到，其实是给后面程序用的，添加到这里了，要用也可以，只是在这个类里直接调用了API
这个完整的文件就是这样的了：（记得添加上篇那个类到工程才能用……继承并发扬么！）
Imports System.Runtime.InteropServices
Public Class RunRemoteAPI : Inherits RunRemoteASMCode
''' <summary>
''' 远程DLL函数导出函数信息
''' </summary>
''' <remarks></remarks>
Protected avExports() As avExportOrImports
''' <summary>
''' 函数导出信息
''' </summary>
''' <remarks></remarks>
Public Structure avExportOrImports
Dim LibName As String '库名(在导出中未使用)
Dim ExportsIndex As Integer '函数导入/出序号
Dim Name As String '函数名
Dim ExportsRVA As Integer '函数导入/出表RVA
Dim FunctionRVA As Integer '函数入口RVA
End Structure
''' <summary>
''' 基地址
''' </summary>
''' <value></value>
''' <returns>为对方进程申请的内存的基地址</returns>
''' <remarks></remarks>
ReadOnly Property BaseAddress() As Integer
Get
Return MyBase.AllocBaseAddress
End Get
End Property
''' <summary>
''' 对方进程
''' </summary>
''' <value></value>
''' <returns>对方进程对象</returns>
''' <remarks></remarks>
ReadOnly Property RotateProcess() As Process
Get
Return MyBase.RemoteProcess
End Get
End Property
''' <summary>
''' 用ProcessID初始化
''' </summary>
''' <param name="PID"></param>
''' <remarks></remarks>
Sub New(ByVal PID As Integer)
MyBase.New(PID)
End Sub
''' <summary>
''' 根据名称调用对方进程的API
''' </summary>
''' <param name="DllName">API所在DLL名称</param>
''' <param name="FuncName">API函数名称</param>
''' <param name="FuncParams">参数列表</param>
''' <returns>API返回值,此返回值只有当Wait为True时才可信</returns>
''' <remarks></remarks>
Function CallRemoteAPIByName(ByVal DllName As String,
ByVal FuncName As String, ByVal Wait As Boolean, ByVal ParamArray
FuncParams() As mFuncParam) As Integer
If MyBase.RemoteProcess Is Nothing Then
MsgBox("未找到指定进程")
Return -1
End If
'初始化数据
ClearCodeAndData()
Dim DllHandle As Integer = -1
Dim FuncAddress As Integer = -1
'枚举对方进程模块列表，找到对方进程中相应DLL的基地址（Handle）
For Each m As ProcessModule In Process.
GetProcessById(MyBase.RemoteProcess.Id).Modules
If InStr(m.FileName.ToUpper, DllName.ToUpper) > 0 Then
DllHandle = m.BaseAddress
Exit For
End If
Next
If DllHandle = -1 Then
MsgBox("未发现对方进程中的 " & DllName & " 模块", , "进程 : "
& MyBase.RemoteProcess.Id)
Return -1
End If
'枚举对方进程中相应DLL中全部函数信息（暴力搜索）
avExports = GetExports(MyBase.RemoteProcess.Handle, DllHandle)
'遍历信息表，获取我们需要的函数入口地址
For Each e As avExportOrImports In avExports
If Not e.Name Is Nothing AndAlso e.Name.ToUpper =
FuncName.ToUpper Then
FuncAddress = e.FunctionRVA
Exit For
End If
Next
If FuncAddress = -1 Then
MsgBox("未发现 " & DllName & " 模块中的函数 " & FuncName, , "进程 : " & MyBase.RemoteProcess.Id)
Return -1
End If
'以下构造调用API的ASM CODE
'首先将参数依次压栈
Dim Ubound As Integer = FuncParams.Length - 1
For i As Integer = Ubound To 0 Step -1
'参数反向
If FuncParams(i).Ptr Then
'如果需要按指针封送，作为数据处理并添加指针段。否则，直接添加
Dim addr As Integer = MyBase.AddData(FuncParams(i).Obj)
MyBase.AddByte2Code(&H68)
'按4字节对齐 prush
MyBase.AddInt2Code(addr + MyBase.AllocBaseAddress)
'将数据部分的地址写入到为对方申请的内存的代码部分
Else
MyBase.AddByte2Code(&H68)
'按4字节对齐
MyBase.AddBytes2Code(FuncParams(i).Obj)
End If
Next
'向代码添加调用
AddCallToCode(FuncAddress)
'向代码添加RET（RET 10）
MyBase.AddByte2Code(&HC3)
'int3
MyBase.AddByte2Code(&HCC)
Return MyBase.Run(Wait)
End Function
''' <summary>
''' 读BYREF型返回值，例如GETWINDOWSTEXTA，第二个参数
''' </summary>
''' <param name="index">要传回的BYREF参数索引，如GETWINDOWSTEXTA中，第二个参数是第一个BYREF传入值，要返回它则传入1</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function RemoteBytesFromIndex
(ByVal index As Integer) As Byte()
Dim odata As mData = CType(MyBase.DataArraylist
(index - 1), mData)
Dim ret(odata.len - 1) As Byte
ReadProcessMemory(MyBase.RemoteProcess.
Handle, odata.prt, ret, odata.len, 0)
Return ret
End Function
''' <summary>
''' 将CALL语句添加到ASM CODE
''' </summary>
''' <param name="FuncAddr">API函数入口地址</param>
''' <remarks>注意地址偏移计算</remarks>
Protected Sub AddCallToCode(ByVal FuncAddr As Integer)
'E8指令要调用的地址是相对地址
MyBase.AddByte2Code(&HE8)
Dim CallAddress As Integer = Math.Abs
(MyBase.AllocBaseAddress + MyBase.PtrAddressOffset - FuncAddr) - 4
MyBase.AddInt2Code(CallAddress)
End Sub
''' <summary>
''' 获取指定DLL函数的导出函数信息
''' </summary>
''' <param name="pHandle">DLL所在进程句柄</param>
''' <param name="ModuleBaseAddress">DLL句柄（基地址）
</param>
''' <remarks></remarks>
Public Function GetExports(ByVal pHandle As IntPtr,
ByVal ModuleBaseAddress As Integer) As avExportOrImports()
Dim ret() As avExportOrImports = Nothing
Try
Dim lpEXPORT_TABLE As Integer =
ModuleBaseAddress + MemValue(pHandle,
ModuleBaseAddress + MemValue(pHandle,
ModuleBaseAddress + &H3C) + &H78)
Dim lNumberOfNames As Integer =
MemValue(pHandle, lpEXPORT_TABLE + &H18)
Dim lNumberOfFunctions As Integer =
MemValue(pHandle, lpEXPORT_TABLE + &H14)
Dim lBase As Integer = MemValue
(pHandle, lpEXPORT_TABLE + &H10)
Dim lpNamesTable As Integer =
ModuleBaseAddress + MemValue(pHandle,
lpEXPORT_TABLE + &H20)
Dim lpFunctionsTable As Integer =
ModuleBaseAddress + MemValue(pHandle, lpEXPORT_TABLE + &H1C)
Dim lpOrdinalsTable As Integer =
ModuleBaseAddress + MemValue(pHandle, lpEXPORT_TABLE + &H24)
Dim lpFunction As Integer
Dim lNameOrdinal As Integer
ReDim ret(lNumberOfFunctions - 1)
Dim i As Integer
For i = 0 To lNumberOfFunctions - 1 '识别入口
ret(i).ExportsIndex = i + lBase
ret(i).ExportsRVA = lpFunctionsTable + 4 * i
ret(i).FunctionRVA = MemValue(pHandle,
lpFunctionsTable + 4 * i) + ModuleBaseAddress
Next
Do While lNumberOfNames > 0 '从入口识别函数名
lNumberOfNames = lNumberOfNames - 1
lpFunction = ModuleBaseAddress +
MemValue(pHandle, lpNamesTable + lNumberOfNames * 4)
lNameOrdinal = MemValue(pHandle,
(lpOrdinalsTable + lNumberOfNames * 2), True)
If lNameOrdinal >= lNumberOfFunctions Then Exit Do
ret(lNameOrdinal).Name = RemoteStrFromPtr(pHandle, lpFunction)
Loop
Return ret
Catch ex As Exception
'Debug.Print(Err.Description)
Return ret
End Try
End Function
''' <summary>
''' 读取指定内存4,2字节
''' </summary>
''' <param name="lAddress">地址</param>
''' <param name="TooByte">二字节还是四字节</param>
''' <returns></returns>
''' <remarks></remarks>
Protected Function MemValue(ByVal pHandle As IntPtr,
ByVal lAddress As Integer, Optional ByVal TooByte As Boolean = False) As Object
Dim tmpArr() As Byte
If TooByte Then ReDim tmpArr(1) Else ReDim tmpArr(3)
Try
Dim lOldProtect As Integer
VirtualProtectEx(pHandle, lAddress, 1, &H40, lOldProtect)
ReadProcessMemory(pHandle, lAddress, tmpArr, tmpArr.Length, 0)
VirtualProtectEx(pHandle, lAddress, 1, lOldProtect, lOldProtect)
Catch ex As Exception
If Err.Number = 5 Then Return 0
End Try
If TooByte Then
Return BitConverter.ToInt16(tmpArr, 0)
Else
Return BitConverter.ToInt32(tmpArr, 0)
End If
End Function
''' <summary>
''' 根据内存地址指针读字符串
''' </summary>
''' <param name="lpString">地址（指针）</param>
''' <returns></returns>
''' <remarks>最多读会1024个字符</remarks>
Protected Function RemoteStrFromPtr(ByVal
pHandle As IntPtr, ByVal lpString As Integer) As String
Dim b(1023) As Byte
Dim lPosOfZero As Integer
Dim lOldProtect As Integer
Try
VirtualProtectEx(pHandle, lpString, 1, &H40, lOldProtect)
ReadProcessMemory(pHandle, lpString, b, 1024, 0)
VirtualProtectEx(pHandle, lpString, 1, lOldProtect, lOldProtect)
Dim i As Integer
For i = 0 To b.Length - 1
If b(i) = 0 Then
lPosOfZero = i
Exit For
End If
Next
Return System.Text.Encoding.ASCII.GetString(b, 0, lPosOfZero)
Catch ex As Exception
'Debug.Print(Err.Number & " " & Err.Description)
Return String.Empty
End Try
End Function
Enum Protect '内存保护属性枚举
PAGE_NOACCESS = &H1
PAGE_READONLY = &H2
PAGE_READWRITE = &H4
PAGE_WRITECOPY = &H8
PAGE_EXECUTE = &H10
PAGE_EXECUTE_READ = &H20
PAGE_EXECUTE_READWRITE = &H40
PAGE_EXECUTE_READWRITECOPY = &H50
PAGE_EXECUTE_WRITECOPY = &H80
PAGE_GUARD = &H100
PAGE_NOCACHE = &H200
PAGE_WRITECOMBINE = &H400
End Enum
Shared Function SetVirtualProtect(ByVal hProcess As IntPtr,
ByVal lpBaseAddress As Integer, Optional ByVal nSize As Integer =
8, Optional ByVal nProtect As Protect =
Protect.PAGE_EXECUTE_READWRITECOPY) As Integer
Dim lProtect As Integer
If VirtualProtectEx(hProcess, lpBaseAddress,
nSize, nProtect, lProtect) <> 0 Then Return lProtect Else Return -1
End Function
End Class
''' <summary>
''' 函数参数
''' </summary>
''' <remarks></remarks>
Public Class mFuncParam
Public Obj As Byte()
Public Ptr As Boolean
Sub New(ByVal obj As Integer)
Me.Obj = BitConverter.GetBytes(obj)
Me.Ptr = False
End Sub
Sub New(ByVal obj As Byte())
Me.Obj = obj.Clone
Me.Ptr = True
End Sub
End Class
''' <summary>
''' 用于将结构体转化为BYTE类型，只提供了一个共享成员方法
''' </summary>
''' <typeparam name="T">必须传入自定义类型，系统类型将引发错误</typeparam>
''' <remarks>系统类型应自行转化为BYTE数组或INTEGER类型</remarks>
Public Class Param(Of T)
Shared Function GetBytes(ByVal Value As T) As Byte()
Try
Dim size As Integer = Marshal.SizeOf(Value)
Dim ret(size) As Byte
Dim ptr As IntPtr = Marshal.AllocHGlobal(size)
Marshal.StructureToPtr(Value, ptr, True)
Marshal.Copy(ptr, ret, 0, size)
Marshal.FreeHGlobal(ptr)
Return ret
Catch ex As Exception
MsgBox(ex.ToString)
Return Nothing
End Try
End Function
End Class
示例就是这样了：
Dim api As RunRemoteAPI
Private Sub Button1_Click(ByVal sender As System.
Object, ByVal e As System.EventArgs) Handles Button1.Click
ListBox1.Items.Clear()
ListBox2.Items.Clear()
Dim mPathName As String = "G:\HOOKRECV\Debug\HOOKRECV.dll" ' My.Application.Info.DirectoryPath & "\test.dll"
api = New RunRemoteAPI(CInt(TextBox1.Text))
‘’RunRemoteASMCode.SetCPUID() ‘’这个还是注释掉好，因为写HOOK API 的时候出了点小插曲，以为是CPU多核心引起的，实际不然，而且把这个作为上一篇基类当中的一个函数也不恰当了。。。呵呵
TextBox3.Text = Hex(api.CallRemoteAPIByName
("kernel32", "LoadLibraryW", True, New mFuncParam
(System.Text.Encoding.Unicode.GetBytes(mPathName))))
TextBox2.Text = Hex(api.BaseAddress)
'枚举对方进程模块列表
For Each m As ProcessModule In Process.
GetProcessById(api.RotateProcess.Id).Modules
ListBox1.Items.Add(m.FileName)
Next
End Sub
把上面注释掉的那个函数写在这：
Public Shared Sub SetCPUID(Optional ByVal PID As Integer
= -1, Optional ByVal CPUID As Integer = 1)
Dim CPUIDPTR As IntPtr = New IntPtr(CPUID)
Dim Ths As ProcessThreadCollection
If PID = -1 Then Ths = Process.GetCurrentProcess.
Threads Else Ths = Process.GetProcessById(PID).Threads
For Each th As ProcessThread In Ths
th.ProcessorAffinity = CPUIDPTR
Next
End Sub
实际上就是指定一个进程的所有线程都运行在1号CPU核心上，当然也可以指定，2号为2，3号为4（因为同时用1，2时是3嘛！）。
迄今用VC写的那个HOOK API的DLL还是不行呢，准备用点外科手段消灭掉对WriteProcessMemory的调用，也就是不来回切换代码，虽然WriteProcessMemory自行刷新缓存，多核心没问题，可多线程问题就来了，还是不要倒来倒去的，直接改成“一条龙”服务……
另外写DLL实际上主要是为了HOOK某些游戏的封包，如果单是API的话……呵呵，不用这么麻烦，用VB.NET完全可以了。。。前面那个线性搜索就是几年前写的HOOK API里面的函数，当时用的HOOK方法是使用调试函数，在API开头修改一个字节为INT3……然后CONTEXT里面的东东……就都出来了…………
恩……编辑一下，才想起来，用了不少进程操作的函数，有时候没有这个不行：
Public Class SeDebugPrivilege
#Region "常数及结构声明"
Private Const SE_PRIVILEGE_ENABLED As Int32 = 2
Private Const EWX_SHUTDOWN As Int32 = 1
Private Const EWX_REBOOT As Int32 = 2
Private Const EWX_LOGOFF As Int32 = 0
Private Structure LUID_AND_ATTRIBUTES
Public pLuid As LUID
Public Attributes As Integer
End Structure
Private Structure LUID
Dim LowPart As Int32
Dim HighPart As Int32
End Structure
Private Structure TOKEN_PRIVILEGES
Public PrivilegeCount As Integer
Public Privileges As LUID
Public Attributes As Int32
End Structure
#End Region
#Region "API声明"
Private Declare Function LookupPrivilegeValue Lib "
advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName
As String, ByVal lpName As String, ByRef lpLuid As LUID) As Int32
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As IntPtr, ByVal DisableAllPrivileges As Int32, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Int32, ByRef PreviousState As TOKEN_PRIVILEGES, ByRef ReturnLength As Int32) As Int32
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As IntPtr, ByVal DesiredAccess As Integer, ByRef TokenHandle As IntPtr) As Boolean
'Private Declare Function OpenThreadToken Lib "advapi32.dll" (ByVal ThreadHandle As IntPtr, ByVal DesiredAccess As Integer, ByVal OpenAsSelf As Integer, ByVal TokenHandle As IntPtr) As Integer
#End Region
#Region "获取全部权限"
Public Function ToKenPrivileges() As Boolean
Dim hdlTokenHandle As Integer
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Integer
Dim currentProcess As Process = Process.GetCurrentProcess()
If OpenProcessToken(currentProcess.Handle, &HF00FF, hdlTokenHandle) Then
LookupPrivilegeValue("", "SeDebugPrivilege", tmpLuid)
tkp.PrivilegeCount = 1
tkp.Privileges = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED
Return AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)
End If
End Function
#End Region
End Class
工程里添加如下调用即可…………
Dim SeDebug As New SeDebugPrivilege
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If SeDebug.ToKenPrivileges = False Then MsgBox("提升权限失败")
End Sub（本文由控件中国网转载）
