Imports System.Runtime.InteropServices Imports System.Text.Encoding ''' <summary> ''' 创建64位远线程调用所需ASM函数。 ''' </summary> ''' <remarks></remarks> Public Class CreateRemoteFunctionASM64 '本程序使用的方法有所不同，参数不是在远线程参数进行传递，而是构建ASM代码实现一个函数，在函数中将参数写入寄存器或栈。 'x64与x86不同，其中第一个参数保存在rcx，第二个参数保存在rdx，第三个参数保存在r8，第四个参数保存在r9。 '其他参数依次保存在栈里，第五个参数保存在rsp+4*8，即rsp+20h，前面的4*8字节是为前四个参数预留的——即使没有使用这些空间，第六个参数保存在rsp+5*8，依此类推。 '但是由于代码中还有一个ret，分配堆栈时需要8字节，所以堆栈应比计算值多8字节。又由于48 83 EC指令后面最多到&H78，所以实际上只能支持&H70字节堆栈，即14个参数。 '基于以上原因，构建汇编代码如下： '0、StackSize=&H78 计算所需栈空间，保留足够的空间（最多支持14个参数） '1、sub rsp,StackSize 移动栈指针 48 83 EC 78 '2、mov rcx,param0 填充参数1 48 B9 1111111111111111 '3、mov rdx,param1 填充参数2 48 BA 1111111111111111 '4、mov r8,param2 填充参数3 49 B8 1111111111111111 '5、mov r9,param3 填充参数4 49 B9 1111111111111111 '当没有更多参数时，忽略6；当参数少于4个只需填充存在的参数。 '6、mov rax,param 填充参数n(n>=5) 48 B8 1111111111111111 '6、mov qword ptr [rsp+20h+8*(n-5)], rax 填充参数n(n>=5) 48 89 84 24 11111111 '7、mov rax,pFunction 把函数地址放在rax中 48 B8 1111111111111111 '8、call rax 调用函数 FF D0 '9、add rsp,StackSize 恢复栈指针 48 83 C4 78 'a、mov rdx,AllocBaseAddress+MEM_SIZE-8 申请的内存最后8字节写入rdx 48 BA 1111111111111111 'a、mov [rdx],rax 返回值写入申请的内存最后8字节 48 89 02 'b、ret 函数返回 C3 '自定义常数 Public Const MEM_SIZE As Integer = &H20000 '申请内存大小 '默认常数 Private Const MEM_COMMIT As Integer = &H1000 '申请/释放远线程内存常数 Private Const MEM_RESERVE As Integer = &H2000 Private Const MEM_RELEASE As Integer = &H8000 Private Const PAGE_EXECUTE_READWRITE As Integer = &H40 '内存权限 Private Code As New List(Of Byte) Private Data As New List(Of Byte) Private ParamAddress As New List(Of IntPtr) Private Const ObjectAddressOffsetDef As Integer = &H2000 '对象存储相对偏移地址 Private ProcessHandle As IntPtr Private AllocBaseAddress As IntPtr '申请的内存基地址 ''' <summary> ''' 构建并向目标进程写入远线程调用函数的ASM代码。 ''' </summary> ''' <param name="RemoteProcessHandle">目标进程句柄</param> ''' <param name="pFunction">远线程调用的函数的基地址</param> ''' <param name="Params"> ''' 远线程调用的函数的参数。可以用于传递以下简单类型： ''' Boolean,Byte,Short,UShort,Integer,UInteger,Long,ULong;Single,Doubl;Byte(),String。 ''' <para>还可以用于SubParam传递复合类型的参数，它按以下规则进行解析：</para> ''' 字段按其类型大小和添加顺序在内存中紧密排列，任何SubParam类型都被解释为8字节指针，没有添加任何字段的SubParam解释为0L。 ''' <para>还可以用类传递复杂的结构类型，其解释方法与SubParam一致。任何类都解析为指针。</para> ''' </param> ''' <returns>ASM代码基地址</returns> ''' <remarks> ''' Params中简单类型额外处理： ''' 1、Boolean,Byte,Short,UShort,Integer,UInteger都转Long再传递。 ''' 2、String类型添加ChrW(0)结尾后用System.Text.Encoding.Unicode.GetBytes转码。 ''' 3、String,Byte()自动8字节对齐。 ''' Params中SubParam： ''' 1、支持类型包括简单类型中的数据类型以及：SubParam。即SubParam是可嵌套的。 ''' 2、除Boolean外都不进行转化Long，而是直接传递。 ''' 3、String类型直接用System.Text.Encoding.Unicode.GetBytes转码。 ''' 4、String,Byte()不再进行自动8字节对齐。 ''' </remarks> Public Function CreateASM(RemoteProcessHandle As IntPtr, pFunction As IntPtr, ParamArray Params() As Object) As IntPtr If AllocBaseAddress <> IntPtr.Zero Then ClearASM() End If ProcessHandle = RemoteProcessHandle AllocBaseAddress = VirtualAllocEx(RemoteProcessHandle, 0, MEM_SIZE, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE) '写入分配堆栈 WriteSubRSP() '写入参数 Dim st As Type If Params IsNot Nothing Then Dim maxidx As Integer = Math.Min(Params.Length, 4) - 1 For i As Integer = 0 To maxidx st = Params(i).GetType If (st Is GetType(Single)) OrElse (st Is GetType(Double)) Then '因为这两个不是转Long也不是指针，是直接传byte()到xmm0-4所以另外处理。 WriteParamDataOnParam1234ToXMM(Params(i), i) Else WriteParamDataOnParam1234(Params(i), i) End If Next If Params.Length > 4 Then For i As Integer = 4 To Params.Length - 1 st = Params(i).GetType If (st Is GetType(Single)) OrElse (st Is GetType(Double)) Then '因为这两个不是转Long也不是指针，是直接传byte()到栈所以另外处理。 WriteParamDataOnParam5ToXMM(Params(i), i) Else WriteParamDataOnParam5(Params(i), i) End If Next End If End If '写入调用 WriteCall(pFunction) '写入回收堆栈 WriteAddRSP() '把真实返回值写入申请的内存的结尾 WriteRaxToAddress() '写入返回 WriteRet() '把ASM实际写入对方内存 WriteProcessMemory(ProcessHandle, AllocBaseAddress, Code.ToArray, Code.Count, 0) WriteProcessMemory(ProcessHandle, AllocBaseAddress.ToInt64 + ObjectAddressOffsetDef, Data.ToArray, Data.Count, 0) Return AllocBaseAddress End Function Public Sub ClearASM() AllocBaseAddress = IntPtr.Zero ProcessHandle = IntPtr.Zero Code.Clear() Data.Clear() '释放为对方申请的内存 VirtualFreeEx(ProcessHandle, AllocBaseAddress, 0, MEM_RELEASE) End Sub Public Function GetParamAddress(index As Integer) As IntPtr If index > ParamAddress.Count - 1 Then Throw New Exception("索引超过函数参数索引最大值") Else Return ParamAddress(index) End If End Function Private Function Obj8ByteAligned(val() As Byte) As Byte() Dim len As Integer = val.Length If (len = 0) OrElse ((len Mod 8) <> 0) Then len += 8 - (len Mod 8) Dim result(len - 1) As Byte Array.Copy(val, result, val.Length) Return result End Function Private Sub WriteSubRSP() Code.AddRange({&H48, &H83, &HEC, &H78}) End Sub Private Shared MoveParam1234()() As Byte = {New Byte() {&H48, &HB9}, New Byte() {&H48, &HBA}, New Byte() {&H49, &HB8}, New Byte() {&H49, &HB9}} Private Sub WriteParamDataOnParam1234(Param As Object, ParamIndex As Integer) Code.AddRange(MoveParam1234(ParamIndex)) '记录参数地址 ParamAddress.Add(AllocBaseAddress.ToInt64 + Code.Count) '写入参数 WriteParamData(Param) End Sub Private Sub WriteParamDataOnParam5(Param As Object, ParamIndex As Integer) 'mov rax,param Code.AddRange({&H48, &HB8}) '记录参数地址 ParamAddress.Add(AllocBaseAddress.ToInt64 + Code.Count) '写入参数 WriteParamData(Param) 'mov qword ptr [rsp+20h+8*(n-5)], rax Dim rspOffset As Integer = &H20 + (ParamIndex - 4) * 8 Code.AddRange({&H48, &H89, &H84, &H24}) Code.AddRange(BitConverter.GetBytes(rspOffset)) End Sub Private MoveValToAddr()() As Byte = {New Byte() {&H48, &H89, &H8}, New Byte() {&H48, &H89, &H10}, New Byte() {&H4C, &H89, &H0}, New Byte() {&H4C, &H89, &H8}} Private MoveValToXMM()() As Byte = {New Byte() {&HF3, &HF, &H10, &H0}, New Byte() {&HF3, &HF, &H10, &H8}, New Byte() {&HF3, &HF, &H10, &H10}, New Byte() {&HF3, &HF, &H10, &H18}} Private Sub WriteParamDataOnParam1234ToXMM(Param As Object, ParamIndex As Integer) '这个函数里面围了兼容参数地址记录，所以先把地址值写入到相应参数的rnx寄存器，这样代码里面就包含了参数地址，可以记录下来。 '实际上只需要把参数值写到申请的内存的最后位置，并把这个位置写到rax，然后movss xmm0,[rax]就可以了。 'mov rax,addr Code.AddRange({&H48, &HB8}) Code.AddRange(BitConverter.GetBytes(CLng(AllocBaseAddress.ToInt64 + MEM_SIZE - 8))) 'mov rnx,val Code.AddRange(MoveParam1234(ParamIndex)) '记录参数地址 ParamAddress.Add(AllocBaseAddress.ToInt64 + Code.Count) Code.AddRange(Obj8ByteAligned(BitConverter.GetBytes(Param))) 'mov [rax],rnx Code.AddRange(MoveValToAddr(ParamIndex)) 'movss xmmn,[rax] Code.AddRange(MoveValToXMM(ParamIndex)) End Sub Private Sub WriteParamDataOnParam5ToXMM(Param As Object, ParamIndex As Integer) 'mov rax,param Code.AddRange({&H48, &HB8}) '记录参数地址 ParamAddress.Add(AllocBaseAddress.ToInt64 + Code.Count) '写入参数 Code.AddRange(Obj8ByteAligned(BitConverter.GetBytes(Param))) 'mov qword ptr [rsp+20h+8*(n-5)], rax Dim rspOffset As Integer = &H20 + (ParamIndex - 4) * 8 Code.AddRange({&H48, &H89, &H84, &H24}) Code.AddRange(BitConverter.GetBytes(rspOffset)) End Sub Private Sub WriteParamData(Param As Object) Dim t As Type = Param.GetType If (t Is GetType(Boolean)) OrElse (t Is GetType(Byte)) OrElse (t Is GetType(Short)) OrElse (t Is GetType(UShort)) OrElse (t Is GetType(Integer)) OrElse (t Is GetType(UInteger)) OrElse (t Is GetType(Long)) Then '写入参数 Code.AddRange(BitConverter.GetBytes(CLng(Param))) ElseIf t Is GetType(ULong) Then '写入参数 Code.AddRange(BitConverter.GetBytes(Param)) ElseIf t Is GetType(String) Then '写入参数——对象指针 Code.AddRange(BitConverter.GetBytes(CLng(AllocBaseAddress.ToInt64 + Data.Count + ObjectAddressOffsetDef))) '写入对象 Data.AddRange(Obj8ByteAligned(Unicode.GetBytes(CStr(Param) & ChrW(0)))) ElseIf t Is GetType(Byte()) Then '写入参数——对象指针 Code.AddRange(BitConverter.GetBytes(CLng(AllocBaseAddress.ToInt64 + Data.Count + ObjectAddressOffsetDef))) '写入对象 Data.AddRange(Obj8ByteAligned(Param)) ElseIf t Is GetType(SubParam) Then DeSubParam(Param) ElseIf t.IsClass Then DeClass(Param) Else Throw New Exception("不支持的参数类型： " & Param.GetType.ToString) End If End Sub Private Sub DeSubParam(Param As SubParam) If CType(Param, SubParam).Data.Count = 0 Then '根对象为空指针 Code.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) Else '根对象不为空 Code.AddRange(BitConverter.GetBytes(CLng(AllocBaseAddress.ToInt64 + Data.Count + ObjectAddressOffsetDef))) '对根对象内容进行解析。 Dim Sps As New Stack(Of KeyValuePair(Of SubParam, Integer)) '将根SubParam压栈，其指针在Data数组中的地址为-1，因为这个指针实际上已经写入Code段。 Sps.Push(New KeyValuePair(Of SubParam, Integer)(CType(Param, SubParam), -1)) Dim CurSubParam As KeyValuePair(Of SubParam, Integer) = Nothing '当前正在处理的SubParam Dim curMemoryAddress As Long '当前实际内存地址（指针应指向的内存地址） Dim curSubParamBytesList As New List(Of KeyValuePair(Of Byte(), Integer)) '当前SubParam中Byte(),String暂存 Dim curSubParamDataElement As Object '当前SubParam中的数组元素 Dim st As Type '当前SubParam中的数组元素的类型 '以下添加的任何数据都在Data中 Do While Sps.Count > 0 '初始化将要使用的变量 curMemoryAddress = IntPtr.Zero st = Nothing curSubParamDataElement = Nothing curSubParamBytesList.Clear() '弹出一个SubParam-OffsetOnData对进行处理 CurSubParam = Sps.Pop '将当前位置的实际内存地址写到从OffsetOnData开始的Data段（为-1的是根SubParam，指针已经写入到Code段） If CurSubParam.Value <> -1 Then '当前实际内存地址 curMemoryAddress = AllocBaseAddress.ToInt64 + Data.Count + ObjectAddressOffsetDef '写入到DATA中从OffsetOnData开始的位置 Data.RemoveRange(CurSubParam.Value, 8) Data.InsertRange(CurSubParam.Value, BitConverter.GetBytes(curMemoryAddress)) End If '遍历SubParam中的数据，依次写入，对于Byte(),String先写入空指针并记录空指针在Code段的地址，等写完全部字段再写入数据到Data，并填写空指针为实际内存地址。 '对于SubParam,也是先写入空指针，然后将SubParam-OffsetOnData对入栈。 If CurSubParam.Key.Data.Count = 0 Then '将空对象解释为空指针 Data.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) Else For i As Integer = 0 To CurSubParam.Key.Data.Count - 1 curSubParamDataElement = CurSubParam.Key.Data(i) st = curSubParamDataElement.GetType If (st Is GetType(Boolean)) Then 'Boolean类型转换为Long添加到数据 Data.AddRange(BitConverter.GetBytes(CLng(curSubParamDataElement))) ElseIf (st Is GetType(Byte)) Then '值类型直接添加到数据 Data.Add(curSubParamDataElement) ElseIf (st Is GetType(Short)) OrElse (st Is GetType(UShort)) OrElse (st Is GetType(Integer)) OrElse (st Is GetType(UInteger)) OrElse (st Is GetType(Long)) OrElse (st Is GetType(ULong)) OrElse (st Is GetType(Single)) OrElse (st Is GetType(Double)) Then '值类型直接添加到数据 Data.AddRange(BitConverter.GetBytes(curSubParamDataElement)) ElseIf st Is GetType(Byte()) Then '数组暂存 curSubParamBytesList.Add(New KeyValuePair(Of Byte(), Integer)(CType(curSubParamDataElement, Byte()), Data.Count)) '暂时写入空指针占位 Data.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) ElseIf st Is GetType(String) Then '字符串暂存 curSubParamBytesList.Add(New KeyValuePair(Of Byte(), Integer)(Unicode.GetBytes(curSubParamDataElement), Data.Count)) '暂时写入空指针占位 Data.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) ElseIf st Is GetType(SubParam) Then 'SubParam入栈 Sps.Push(New KeyValuePair(Of SubParam, Integer)(CType(curSubParamDataElement, SubParam), Data.Count)) '暂时写入空指针占位 Data.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) End If Next '将暂存的Byte(),String写入指针和数据 For i As Integer = 0 To curSubParamBytesList.Count - 1 '和解释SubParam一样，先填充之前的空指针。 '当前实际内存地址 curMemoryAddress = AllocBaseAddress.ToInt64 + Data.Count + ObjectAddressOffsetDef '写入到DATA中从OffsetOnData开始的位置 Data.RemoveRange(curSubParamBytesList(i).Value, 8) Data.InsertRange(curSubParamBytesList(i).Value, BitConverter.GetBytes(curMemoryAddress)) '然后把数据写到当前地址 Data.AddRange(curSubParamBytesList(i).Key) Next End If Loop End If End Sub Private Sub DeClass(mParam As Object) Dim ParamType As Type = mParam.GetType If ParamType.GetFields.Count = 0 Then '根对象为空指针 Code.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) Else '根对象不为空 Code.AddRange(BitConverter.GetBytes(CLng(AllocBaseAddress.ToInt64 + Data.Count + ObjectAddressOffsetDef))) '对根对象内容进行解析。 Dim Sps As New Stack(Of KeyValuePair(Of Type, Integer)) '将根SubParam压栈，其指针在Data数组中的地址为-1，因为这个指针实际上已经写入Code段。 Sps.Push(New KeyValuePair(Of Type, Integer)(ParamType, -1)) Dim CurSubParam As KeyValuePair(Of Type, Integer) = Nothing '当前正在处理的SubParam Dim curMemoryAddress As Long '当前实际内存地址（指针应指向的内存地址） Dim curSubParamBytesList As New List(Of KeyValuePair(Of Byte(), Integer)) '当前SubParam中Byte(),String暂存 Dim curSubParamDataElement As Object '当前SubParam中的数组元素 Dim st As Type '当前SubParam中的数组元素的类型 '以下添加的任何数据都在Data中 Do While Sps.Count > 0 '初始化将要使用的变量 curMemoryAddress = IntPtr.Zero st = Nothing curSubParamDataElement = Nothing curSubParamBytesList.Clear() '弹出一个SubParam-OffsetOnData对进行处理 CurSubParam = Sps.Pop '将当前位置的实际内存地址写到从OffsetOnData开始的Data段（为-1的是根SubParam，指针已经写入到Code段） If CurSubParam.Value <> -1 Then '当前实际内存地址 curMemoryAddress = AllocBaseAddress.ToInt64 + Data.Count + ObjectAddressOffsetDef '写入到DATA中从OffsetOnData开始的位置 Data.RemoveRange(CurSubParam.Value, 8) Data.InsertRange(CurSubParam.Value, BitConverter.GetBytes(curMemoryAddress)) End If '遍历SubParam中的数据，依次写入，对于Byte(),String先写入空指针并记录空指针在Code段的地址，等写完全部字段再写入数据到Data，并填写空指针为实际内存地址。 '对于SubParam,也是先写入空指针，然后将SubParam-OffsetOnData对入栈。 If CurSubParam.Key.GetFields.Count = 0 Then '将空对象解释为空指针 Data.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) Else For i As Integer = 0 To CurSubParam.Key.GetFields.Count - 1 curSubParamDataElement = CurSubParam.Key.GetFields()(i).GetValue(mParam) st = curSubParamDataElement.GetType If (st Is GetType(Boolean)) Then 'Boolean类型转换为Long添加到数据 Data.AddRange(BitConverter.GetBytes(CLng(curSubParamDataElement))) ElseIf (st Is GetType(Byte)) Then '值类型直接添加到数据 Data.Add(curSubParamDataElement) ElseIf (st Is GetType(Short)) OrElse (st Is GetType(UShort)) OrElse (st Is GetType(Integer)) OrElse (st Is GetType(UInteger)) OrElse (st Is GetType(Long)) OrElse (st Is GetType(ULong)) OrElse (st Is GetType(Single)) OrElse (st Is GetType(Double)) Then '值类型直接添加到数据 Data.AddRange(BitConverter.GetBytes(curSubParamDataElement)) ElseIf st Is GetType(Byte()) Then '数组暂存 curSubParamBytesList.Add(New KeyValuePair(Of Byte(), Integer)(CType(curSubParamDataElement, Byte()), Data.Count)) '暂时写入空指针占位 Data.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) ElseIf st Is GetType(String) Then '字符串暂存 curSubParamBytesList.Add(New KeyValuePair(Of Byte(), Integer)(Unicode.GetBytes(curSubParamDataElement), Data.Count)) '暂时写入空指针占位 Data.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) ElseIf st.IsClass Then 'SubParam入栈 Sps.Push(New KeyValuePair(Of Type, Integer)(curSubParamDataElement.GetType, Data.Count)) '暂时写入空指针占位 Data.AddRange({0, 0, 0, 0, 0, 0, 0, 0}) End If Next '将暂存的Byte(),String写入指针和数据 For i As Integer = 0 To curSubParamBytesList.Count - 1 '和解释SubParam一样，先填充之前的空指针。 '当前实际内存地址 curMemoryAddress = AllocBaseAddress.ToInt64 + Data.Count + ObjectAddressOffsetDef '写入到DATA中从OffsetOnData开始的位置 Data.RemoveRange(curSubParamBytesList(i).Value, 8) Data.InsertRange(curSubParamBytesList(i).Value, BitConverter.GetBytes(curMemoryAddress)) '然后把数据写到当前地址 Data.AddRange(curSubParamBytesList(i).Key) Next End If Loop End If End Sub Private Sub WriteCall(pFunction As Long) 'mov rax,pFunction Code.AddRange({&H48, &HB8}) Code.AddRange(BitConverter.GetBytes(pFunction)) 'call rax Code.AddRange({&HFF, &HD0}) End Sub Private Sub WriteAddRSP() 'add rsp,StackSize Code.AddRange({&H48, &H83, &HC4, &H78}) End Sub Private Sub WriteRaxToAddress() 'mov rdx,AllocBaseAddress+MEM_SIZE-8 Code.AddRange({&H48, &HBA}) Code.AddRange(BitConverter.GetBytes(CLng(AllocBaseAddress.ToInt64 + MEM_SIZE - 8))) 'mov [rdx],rax Code.AddRange({&H48, &H89, &H2}) End Sub Private Sub WriteRet() 'ret Code.AddRange({&HC3}) End Sub ''' <summary> ''' 表示结构体等参数的类。这个类用于给CreateRemoteFunctionASM64.CreateASM传递复杂参数，支持多重指针。 ''' 该类支持全部CreateRemoteFunctionASM64.CreateASM所支持的参数类型。 ''' 但不会为String添加ChrW(0)结尾，也不会对byte()和String进行8字节对齐。 ''' 解析时按照添加顺序写入内存，SubParam被解析为指针，若SubParam没有被添加任何字段，则被解释为空指针（8位0）。 ''' </summary> ''' <remarks></remarks> Public Class SubParam Public Data As New List(Of Object) Sub AddData(val As Boolean) Data.Add(val) End Sub Sub AddData(val As Byte) Data.Add(val) End Sub Sub AddData(val As Short) Data.Add(val) End Sub Sub AddData(val As UShort) Data.Add(val) End Sub Sub AddData(val As Integer) Data.Add(val) End Sub Sub AddData(val As UInteger) Data.Add(val) End Sub Sub AddData(val As Long) Data.Add(val) End Sub Sub AddData(val As ULong) Data.Add(val) End Sub Sub AddData(val As Single) Data.Add(val) End Sub Sub AddData(val As Double) Data.Add(val) End Sub Sub AddData(val As String) Data.Add(val) End Sub Sub AddData(val As Byte()) Data.Add(val) End Sub Sub AddData(val As SubParam) Data.Add(val) End Sub Sub AddData(val As Object) Throw New Exception("SubParam不支持参数类型：" & val.GetType.ToString) End Sub End Class End Class
