VB远程执行多参函数

夜影小子

顺便贴关键代码（modFxExecuteRemoteFunction.bas）：

Option Explicit
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Long, Source As Long, ByVal Length As Long)

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long

Private Declare Function RtlAdjustPrivilege Lib "NTDLL.DLL" (ByVal Privileges As Long, Optional ByVal NewValue As Long = 1, Optional ByVal Thread As Long, Optional Value As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long


Private Const MEM_FREE = &H10000
Private Const MEM_Private = &H20000
Private Const MEM_COMMIT = 4096
Private Const MEM_RESERVE = &H2000
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000

Private Const PAGE_READONLY = &H2
Private Const PAGE_READWRITE = &H4
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000

Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_CREATE_THREAD = &H2
Private Const PROCESS_SET_SESSIONID = &H4
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_DUP_HANDLE = &H40
Private Const PROCESS_CREATE_PROCESS = &H80
Private Const PROCESS_SET_QUOTA = &H100
Private Const PROCESS_SET_INFORMATION = &H200
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_SUSPEND_RESUME = &H800
Private Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

Private Const INFINITE = &HFFFF


Private Type SECURITY_ATTRIBUTES
     nLength As Long
     lpSecurityDescriptor As Long
     bInheritHandle As Long
End Type

Public Function FxInsertProcessModule(ByVal hProcess As Long, ByRef modPath As String) As Long
    Dim errStr As String
     
    If hProcess = 0 Then errStr = "参数不正确": GoTo errors
'--||将目标DLL插入远程进程||--
    Dim dwRet As Long
     
    Dim strSize As Long
     strSize = LenB(StrConv(modPath, vbFromUnicode)) + 1   'DLL路径的长度
    If strSize = 0 Then errStr = "DLL路径不正确": GoTo errors
    Dim strAddr As Long
     strAddr = VirtualAllocEx(hProcess, 0, strSize, MEM_COMMIT Or MEM_RESERVE, PAGE_READWRITE)
    If strAddr = 0 Then errStr = "分配内存空间失败（To Dll）": GoTo errors
    '将DLL路径写入目标进程的地址空间
     WriteProcessMemory hProcess, ByVal strAddr, ByVal modPath, strSize, dwRet
    If dwRet = 0 Then errStr = "内存写入失败（To Dll）": GoTo errors
     
'--构造shellcode--
    Dim scInsert(10) As Byte
     scInsert(0) = &H68   'push
     CopyMemory ByVal VarPtr(scInsert(1)), strAddr, 4   'push 0x00000000
     
    Dim codeAddr As Long
    '为shellcode分配空间
     codeAddr = VirtualAllocEx(hProcess, 0, 4096, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
     
    Dim hModule As Long
     hModule = GetModuleHandle("kernel32.dll")   '取kernel32.dll模块基址
    Dim hFunc As Long
     hFunc = GetProcAddress(hModule, "LoadLibraryA")   '取LoadLibraryA地址
     hFunc = hFunc - codeAddr - 10   '计算出call的偏移
     
     scInsert(5) = &HE8   'call
     CopyMemory ByVal VarPtr(scInsert(6)), hFunc, 4   'call 0x00000000
     scInsert(10) = &HC3   'ret
     
    '写入shellcode
     WriteProcessMemory hProcess, ByVal codeAddr, ByVal VarPtr(scInsert(0)), 11, dwRet
    If dwRet = 0 Then errStr = "内存写入失败（To shellcode）": GoTo errors
'--创建线程执行shellcode
    Dim sa As SECURITY_ATTRIBUTES
    Dim hThreadRet As Long
     hThreadRet = CreateRemoteThread(hProcess, sa, 0, ByVal codeAddr, ByVal 0, 0, 0)
    If hThreadRet = 0 Then errStr = "创建远程线程失败（To InsertDll）": GoTo errors
     WaitForSingleObject hThreadRet, INFINITE
     GetExitCodeThread hThreadRet, FxInsertProcessModule   '获取线程函数（LoadLibraryA）的返回值
     
     VirtualFreeEx hProcess, strAddr, strSize, MEM_DECOMMIT
Exit Function

errors:
     Debug.Print errStr
     FxInsertProcessModule = 0
End Function

Public Function FxExecuteRemoteFunction(ByVal hProcess As Long, ByRef modPath As String, ByRef funName As String, ParamArray Params()) As Long
'--||初始化||--
    Dim errStr As String
    If hProcess = 0 Then errStr = "参数不正确": GoTo errors
     
    Dim i As Long
    Dim dwRet As Long   '代表参数是否处理成功
    Dim pamCount As Long   '代表参数总数-1的值（因为数组下标是0）
    Dim pamAddr() As Long   '用来记录每个参数的值（String记录地址）
    Dim pamType As Long
     
     pamCount = UBound(Params)
    ReDim pamAddr(pamCount)
     
'--||从右至左（stdcall）将参数分类写入目标进程的地址空间，pamAddr数组记录每个参数的值（对于String是地址）||--
    For i = pamCount To 0 Step -1
         pamType = VarType(Params(i))
        If pamType = vbString Then
            Dim strData As String
             strData = CStr(Params(i))
            If strData = "" Then
                 pamAddr(i) = 0
                 dwRet = 1
            Else
                Dim strSize As Long
                 strSize = LenB(StrConv(strData, vbFromUnicode)) + 1
                 pamAddr(i) = VirtualAllocEx(hProcess, 0, strSize, MEM_COMMIT, PAGE_READWRITE)
                 WriteProcessMemory hProcess, ByVal pamAddr(i), ByVal strData, strSize, dwRet
            End If
        ElseIf pamType = vbBoolean Or pamType = vbByte Or pamType = vbInteger Or pamType = vbLong Then
             pamAddr(i) = CLng(Params(i))
             dwRet = 1
        Else
             errStr = "参数" & CStr(pamCount - i + 1) & "不支持的类型": GoTo errors
        End If
     
        If dwRet = 0 Then
             errStr = "参数" & CStr(pamCount - i + 1) & "写入失败": GoTo errors
        Else
             Debug.Print "参数" & CStr(pamCount - i + 1) & "成功写入，地址" & FormatHex(pamAddr(i))
        End If
    Next i
     
'--||准备工作||--
    '--计算shellcode大小（占用字节）--
    Dim scSize As Long
     scSize = (pamCount + 1) * 5   '每个参数都要push 0x00000000，占5字节
     scSize = scSize + 5 + 1   '调用函数用call 0x0000000，占5字节;call之后要ret，占1字节
    Dim sc() As Byte
    ReDim sc(scSize - 1)
    '--push参数入栈--
    Dim j As Long
     i = 0: j = 0
    For i = pamCount To 0 Step -1
         sc(j) = &H68   'push
         CopyMemory ByVal VarPtr(sc(j + 1)), ByVal VarPtr(pamAddr(i)), 4
         j = j + 5
    Next i

    '--获取函数信息--
    '获取模块基址
    Dim hLocalModule As Long
     hLocalModule = LoadLibrary(modPath)
    If hLocalModule = 0 Then errStr = "加载模块失败（Local）": GoTo errors
    '获取函数地址
    Dim funcAddr As Long
     funcAddr = GetProcAddress(hLocalModule, funName)
    '计算函数偏移
    Dim funcOffset As Long
     funcOffset = funcAddr - hLocalModule
    '卸载模块
     FreeLibrary hLocalModule
    '获取远程模块地址
    Dim hRemoteModule As Long
     hRemoteModule = FxInsertProcessModule(hProcess, modPath)
    If hRemoteModule = 0 Then errStr = "加载模块失败（Remote）": GoTo errors
    '模块基址 + 函数偏移 = 函数地址
     funcAddr = hRemoteModule + funcOffset
     
'--||构造shellcode||--
    '为shellcode分配内存空间
    Dim codeAddr As Long
     codeAddr = VirtualAllocEx(hProcess, 0, scSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    '计算call的偏移
     sc(j) = &HE8   'call
    Dim callOffset As Long
     callOffset = funcAddr - codeAddr - (scSize - 1)
     CopyMemory ByVal VarPtr(sc(j + 1)), ByVal VarPtr(callOffset), 4
     sc(j + 5) = &HC3   'ret
    '--写入shellcode--
     WriteProcessMemory hProcess, ByVal codeAddr, ByVal VarPtr(sc(0)), scSize, dwRet
     Debug.Print "shellcode地址" & FormatHex(codeAddr)
    If dwRet = 0 Then errStr = "写入shellcode失败": GoTo errors
     
'--||创建线程执行shellcode||--
    Dim sa As SECURITY_ATTRIBUTES
    Dim hThreadRet As Long
     hThreadRet = CreateRemoteThread(hProcess, sa, 0, ByVal codeAddr, ByVal 0, 0, 0)
    If hThreadRet = 0 Then errStr = "执行shellcode失败": GoTo errors
     WaitForSingleObject hThreadRet, INFINITE   '等待线程执行结束
     GetExitCodeThread hThreadRet, FxExecuteRemoteFunction   '获取函数的返回值
     
     VirtualFreeEx hProcess, codeAddr, scSize, MEM_DECOMMIT
Exit Function

errors:
     Debug.Print errStr
     FxExecuteRemoteFunction = 0
End Function

人生无戏

这么好的东西，居然没人回，我来顶一下，谢谢楼主。