Запись данных в ресурсы своего EXE из "себя" VB6

' Запись данных в ресурсы своего EXE файла
' © Кривоус Анатолий Анатольевич (The trick), 2014
' Запись работает только после закрытия приложения
 
Option Explicit
 
Private Type STARTUPINFO
    cb              As Long
    lpReserved      As Long
    lpDesktop       As Long
    lpTitle         As Long
    dwX             As Long
    dwY             As Long
    dwXSize         As Long
    dwYSize         As Long
    dwXCountChars   As Long
    dwYCountChars   As Long
    dwFillAttribute As Long
    dwFlags         As Long
    wShowWindow     As Integer
    cbReserved2     As Integer
    lpReserved2     As Long
    hStdInput       As Long
    hStdOutput      As Long
    hStdError       As Long
End Type
 
Private Type PROCESS_INFORMATION
    hProcess        As Long
    hThread         As Long
    dwProcessId     As Long
    dwThreadId      As Long
End Type
 
Private Type ThreadData
    hParent         As Long
    lpFileName      As Long
    lpRsrcName      As Long
    lpData          As Long
    dwDataCount     As Long
    lpWFSO          As Long
    lpCH            As Long
    lpBUR           As Long
    lpUR            As Long
    lpEUR           As Long
    lpEP            As Long
End Type
 
Private Declare Function CloseHandle Lib "kernel32" ( _
                         ByVal hObject As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" _
                         Alias "CreateProcessW" ( _
                         ByVal lpApplicationName As Long, _
                         ByVal lpCommandLine As Long, _
                         lpProcessAttributes As Any, _
                         lpThreadAttributes As Any, _
                         ByVal bInheritHandles As Long, _
                         ByVal dwCreationFlags As Long, _
                         lpEnvironment As Any, _
                         ByVal lpCurrentDirectory As Long, _
                         lpStartupInfo As STARTUPINFO, _
                         lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
                         Alias "GetModuleHandleA" ( _
                         ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" ( _
                         ByVal hModule As Long, _
                         ByVal lpProcName As String) As Long
Private Declare Function DuplicateHandle Lib "kernel32" ( _
                         ByVal hSourceProcessHandle As Long, _
                         ByVal hSourceHandle As Long, _
                         ByVal hTargetProcessHandle As Long, _
                         lpTargetHandle As Long, _
                         ByVal dwDesiredAccess As Long, _
                         ByVal bInheritHandle As Long, _
                         ByVal dwOptions As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function VirtualAllocEx Lib "kernel32.dll" ( _
                         ByVal hProcess As Long, _
                         lpAddress As Any, _
                         ByVal dwSize As Long, _
                         ByVal flAllocationType As Long, _
                         ByVal flProtect As Long) As Long
Private 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
Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         src As Any, _
                         dst As Any) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" ( _
                         ByVal hProcess As Long, _
                         lpAddress As Any, _
                         ByVal dwSize As Long, _
                         ByVal dwFreeType As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" ( _
                         ByVal hProcess As Long, _
                         lpThreadAttributes As Any, _
                         ByVal dwStackSize As Long, _
                         ByVal lpStartAddress As Long, _
                         lpParameter As Any, _
                         ByVal dwCreationFlags As Long, _
                         lpThreadId As Long) As Long
Private Declare Function FindResource Lib "kernel32" _
                         Alias "FindResourceW" ( _
                         ByVal hInstance As Long, _
                         ByVal lpName As Long, _
                         ByVal lpType As Long) As Long
Private Declare Function LoadResource Lib "kernel32" ( _
                         ByVal hInstance As Long, _
                         ByVal hResInfo As Long) As Long
Private Declare Function LockResource Lib "kernel32" ( _
                         ByVal hResData As Long) As Long
Private Declare Function SizeofResource Lib "kernel32" ( _
                         ByVal hInstance As Long, _
                         ByVal hResInfo As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
                         Alias "RtlMoveMemory" ( _
                         Destination As Any, _
                         Source As Any, _
                         ByVal Length As Long)
 
Private Const STARTF_USESHOWWINDOW      As Long = &H1
Private Const SW_HIDE                   As Long = 0
Private Const MEM_COMMIT                As Long = &H1000&
Private Const MEM_RESERVE               As Long = &H2000&
Private Const MEM_RELEASE               As Long = &H8000&
Private Const PAGE_EXECUTE_READWRITE    As Long = &H40&
Private Const INFINITE                  As Long = -1&
Private Const MAX_PATH                  As Long = 260
Private Const RT_RCDATA                 As Long = 10&
Private Const CREATE_SUSPENDED          As Long = &H4
Private Const DUPLICATE_SAME_ACCESS     As Long = &H2
Private Const ResName                   As String = "TRICKRESOURCE" & vbNullChar    ' Только заглавные буквы, т.к. XP ищет только по заглавным.
 
' // Процедура загружает данные из EXE
Private Sub LoadFromEXE()
    Dim hRes As Long, hMem As Long, ptr As Long, l As Long, Msg As String
    
    hRes = FindResource(0, StrPtr(ResName), RT_RCDATA)
    
    If hRes Then
        hMem = LoadResource(0, hRes)
        If hMem Then
            l = SizeofResource(0, hRes)
            If l Then
                ptr = LockResource(hMem)
                GetMem4 ByVal ptr, l
                Msg = Space(l \ 2)
                CopyMemory ByVal StrPtr(Msg), ByVal ptr + 4, l
                txtData.Text = Msg
            End If
        End If
    End If
End Sub
 
' // Процедура сохраняет данные в EXE
Private Sub StoreToExe()
    Dim hLib As Long
    Dim td As ThreadData, ts As Long, path As String, pi As PROCESS_INFORMATION, si As STARTUPINFO, hProc As Long, lpDat As Long, pt As Long
    Dim Code() As Byte, Data() As Byte, ret As Long, thr As Long, otd As Long
    
    ' // Получаем описатель Kernel32
    hLib = GetModuleHandle("kernel32")
    If hLib = 0 Then MsgBox "Error": Exit Sub
    
    ' // Получаем адреса API функций
    td.lpWFSO = GetProcAddress(hLib, "WaitForSingleObject")
    td.lpCH = GetProcAddress(hLib, "CloseHandle")
    td.lpBUR = GetProcAddress(hLib, "BeginUpdateResourceW")
    td.lpUR = GetProcAddress(hLib, "UpdateResourceW")
    td.lpEUR = GetProcAddress(hLib, "EndUpdateResourceW")
    td.lpEP = GetProcAddress(hLib, "ExitProcess")
    
    path = App.path & "" & App.EXEName & ".exe" & vbNullChar
    
    ' // Создаем код
    CreateCode Code
    
    ' // Вычисляем размер нужной памяти
    ts = LenB(path) + LenB(ResName) + (UBound(Code) + 1) + LenB(txtData.Text) + Len(td) + 4
    
    si.cb = Len(si)
    si.dwFlags = STARTF_USESHOWWINDOW
    si.wShowWindow = SW_HIDE
    
    ' // Запускаем "жертву" (CMD.EXE)
    If CreateProcess(StrPtr(Environ("ComSpec")), 0, ByVal 0&, ByVal 0&, False, CREATE_SUSPENDED, ByVal 0, 0, si, pi) = 0 Then
        MsgBox "error": Exit Sub
    End If
    
    ' // Получаем описитель нашего процесса для внедряемого процесса
    hProc = GetCurrentProcess() ' Псевдоописатель
    DuplicateHandle hProc, hProc, pi.hProcess, td.hParent, 0, False, DUPLICATE_SAME_ACCESS
    
    td.dwDataCount = LenB(txtData.Text) + 4        ' Размер данных
    
    ' // Выделяем память в чужом процессе
    lpDat = VirtualAllocEx(pi.hProcess, ByVal 0, ts, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE)
    
    If lpDat = 0 Then
        MsgBox "Error": CloseHandle pi.hThread: CloseHandle pi.hProcess
        VirtualFreeEx pi.hProcess, ByVal lpDat, 0, MEM_RELEASE
        Exit Sub
    End If
    
    ' // Ок, все готово для записи в процесс
    ' // Формируем буфер с данными
    ReDim Data(ts - 1)
    
    ' // Копируем имя файла
    CopyMemory Data(pt), ByVal StrPtr(path), LenB(path)
    td.lpFileName = lpDat + pt: pt = pt + LenB(path)
    ' // Копируем имя ресурса
    CopyMemory Data(pt), ByVal StrPtr(ResName), LenB(ResName)
    td.lpRsrcName = lpDat + pt: pt = pt + LenB(ResName)
    ' // Копируем данные
    GetMem4 LenB(txtData.Text), Data(pt)          ' Размер
    CopyMemory Data(pt + 4), ByVal StrPtr(txtData.Text), LenB(txtData.Text)
    td.lpData = lpDat + pt: pt = pt + LenB(txtData.Text) + 4
    ' // Копируем структуру с данными
    CopyMemory Data(pt), td, Len(td): otd = pt: pt = pt + Len(td)
    ' // Копируем код
    CopyMemory Data(pt), Code(0), UBound(Code) + 1
    
    ' // Буфер готов, записываем его в "жертву"
    If WriteProcessMemory(pi.hProcess, lpDat, Data(0), ts, ret) Then
        If ret <> ts Then
            MsgBox "Error": CloseHandle pi.hThread: CloseHandle pi.hProcess
            VirtualFreeEx pi.hProcess, ByVal lpDat, 0, MEM_RELEASE
            Exit Sub
        End If
        ' // Запускаем код инъекции
        thr = CreateRemoteThread(pi.hProcess, ByVal 0, 0, lpDat + pt, ByVal lpDat + otd, 0, 0)
        If thr = 0 Then
            MsgBox "Error": CloseHandle pi.hThread: CloseHandle pi.hProcess
            VirtualFreeEx pi.hProcess, ByVal lpDat, 0, MEM_RELEASE
            Exit Sub
        End If
    End If
    
    ' // Закрываем описатели
    CloseHandle thr
    CloseHandle pi.hThread
    CloseHandle pi.hProcess
    
End Sub
 
Private Sub CreateCode(Code() As Byte)
    ReDim Code(63)
    Code(0) = &H8B: Code(1) = &H74: Code(2) = &H24: Code(3) = &H4: Code(4) = &H31: Code(5) = &HDB: Code(6) = &H53: Code(7) = &H6A
    Code(8) = &HFF: Code(9) = &HFF: Code(10) = &H36: Code(11) = &HFF: Code(12) = &H56: Code(13) = &H14: Code(14) = &HFF: Code(15) = &H36
    Code(16) = &HFF: Code(17) = &H56: Code(18) = &H18: Code(19) = &H53: Code(20) = &HFF: Code(21) = &H76: Code(22) = &H4: Code(23) = &HFF
    Code(24) = &H56: Code(25) = &H1C: Code(26) = &H89: Code(27) = &H4: Code(28) = &H24: Code(29) = &H85: Code(30) = &HC0: Code(31) = &H74
    Code(32) = &H1B: Code(33) = &HFF: Code(34) = &H76: Code(35) = &H10: Code(36) = &HFF: Code(37) = &H76: Code(38) = &HC: Code(39) = &H53
    Code(40) = &HFF: Code(41) = &H76: Code(42) = &H8: Code(43) = &H6A: Code(44) = &HA: Code(45) = &HFF: Code(46) = &H74: Code(47) = &H24
    Code(48) = &H14: Code(49) = &HFF: Code(50) = &H56: Code(51) = &H20: Code(52) = &H53: Code(53) = &HFF: Code(54) = &H74: Code(55) = &H24
    Code(56) = &H4: Code(57) = &HFF: Code(58) = &H56: Code(59) = &H24: Code(60) = &H53: Code(61) = &HFF: Code(62) = &H56: Code(63) = &H28
End Sub
 
Private Sub Form_Load()
    LoadFromEXE
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    StoreToExe
End Sub
 
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Процедура выполняется в другом процессе\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 
' Приблизительный код на VB
 
'Private Sub ThreadProc(dat As ThreadData)
'    Dim hRes As Long
'    ' Ждем завершения процесса
'    WaitForSingleObject dat.hParent, INFINITE
'    ' Процесс завершился, закрываем его описатель
'    CloseHandle dat.hParent
'    ' Получаем описатель
'    hRes = BeginUpdateResource(dat.lpFileName, False)
'    If hRes Then
'       ' Записываем в нужный ресурс
'       UpdateResource hRes, RT_RCDATA, dat.lpRsrcName, 0, ByVal dat.lpData, dat.dwDataCount
'       ' Заканчиваем запись
'       EndUpdateResource hRes, False
'    End if
'      ' Все !!!
'    ExitProcess 0
'End Sub
 
' Код на ассемблере (NASM)
 
'[BITS 32]
'; ThreadProc
'mov esi,dword [esp+0x04]; ESI = &dat
'xor ebx,ebx             ; Const 0&
'push ebx                ; Dim hRes As Long
'push 0xFFFFFFFF         ; INFINITE
'push dword [esi+0x00]   ; dat.hParent
'call [esi+0x14]         ; WaitForSingleObject dat.hParent, INFINITE
'push dword [esi+0x00]   ; dat.hParent
'call [esi+0x18]         ; CloseHandle dat.hParent
'push ebx                ; False
'push dword [esi+0x04]   ; dat.lpFileName
'call [esi+0x1c]         ; BeginUpdateResource(dat.lpFileName, False)
'mov [esp],eax           ; hRes = eax
'test eax,eax            ; IF hRes=0
'je ExtProc              ; GoTo ExtProc
'push dword [esi+0x10]   ; dat.dwDataCount
'push dword [esi+0x0c]   ; dat.lpData
'push ebx                ; 0
'push dword [esi+0x08]   ; dat.lpRsrcName
'push 0x0000000a         ; RT_RCDATA
'push dword [esp+0x14]   ; hRes
'call [esi+0x20]         ; UpdateResource hRes, RT_RCDATA, dat.lpRsrcName, 0, ByVal dat.lpData, dat.dwDataCount
'push ebx                ; False
'push dword [esp+0x04]   ; hRes
'call [esi+0x24]         ; EndUpdateResource hRes, False
'ExtProc:
'push ebx                ; 0
'call [esi+0x28]         ; ExitProcess 0