Search code examples
memorydelphi-7

How to avoid app freeze in memory execute function?


How to avoid app freeze in memory execute function?
After I send resource to memory and when I run this code, my exe in memory runs successfully, but UI form will freeze until process close.

Here's my code:

unit pe;

interface

uses Windows;

//type
//  TByteArray = array of Byte;

Function MemoryExecute(Buffer :Pointer;Parameters: String; Visible: Boolean): TProcessInformation;


implementation


Function MemoryExecute(Buffer :Pointer;Parameters: String; Visible: Boolean): TProcessInformation;
type
  HANDLE        = THandle;
  PVOID         = Pointer;
  LPVOID        = Pointer;
  SIZE_T        = Cardinal;
  ULONG_PTR     = Cardinal;
  NTSTATUS      = LongInt;
  LONG_PTR      = Integer;

  PImageSectionHeaders = ^TImageSectionHeaders;
  TImageSectionHeaders = Array [0..95] Of TImageSectionHeader;
Var
  ZwUnmapViewOfSection  :Function(ProcessHandle: THANDLE; BaseAddress: Pointer): LongInt; stdcall;
  ProcessInfo           :TProcessInformation;
  StartupInfo           :TStartupInfo;
  Context               :TContext;
  BaseAddress           :Pointer;
  BytesRead             :DWORD;
  BytesWritten          :DWORD;
  I                     :ULONG;
  OldProtect            :ULONG;
  NTHeaders             :PImageNTHeaders;
  Sections              :PImageSectionHeaders;
  Success               :Boolean;
  ProcessName           :string;

Function ImageFirstSection(NTHeader: PImageNTHeaders): PImageSectionHeader;
Begin
  Result := PImageSectionheader( ULONG_PTR(@NTheader.OptionalHeader) +
                                 NTHeader.FileHeader.SizeOfOptionalHeader);

End;

Function Protect(Characteristics: ULONG): ULONG;
Const
  Mapping       :Array[0..7] Of ULONG = (
                 PAGE_NOACCESS,
                 PAGE_EXECUTE,
                 PAGE_READONLY,
                 PAGE_EXECUTE_READ,
                 PAGE_READWRITE,
                 PAGE_EXECUTE_READWRITE,
                 PAGE_READWRITE,
                 PAGE_EXECUTE_READWRITE  );
Begin
  Result := Mapping[ Characteristics SHR 29 ];

End;
Begin
  @ZwUnmapViewOfSection := GetProcAddress(LoadLibrary('ntdll.dll'), 'ZwUnmapViewOfSection');
  ProcessName := ParamStr(0);

  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
  FillChar(StartupInfo, SizeOf(TStartupInfo),        0);

  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  if Visible Then
    StartupInfo.wShowWindow := SW_NORMAL
  else
    StartupInfo.wShowWindow := SW_Hide;

  If (CreateProcess(PChar(ProcessName), PChar(Parameters), NIL, NIL,
                    False, CREATE_SUSPENDED, NIL, NIL, StartupInfo, ProcessInfo)) Then
  Begin
    Success := True;
    Result := ProcessInfo;

    Try
      Context.ContextFlags := CONTEXT_INTEGER;
      If (GetThreadContext(ProcessInfo.hThread, Context) And
         (ReadProcessMemory(ProcessInfo.hProcess, Pointer(Context.Ebx + 8),
                            @BaseAddress, SizeOf(BaseAddress), BytesRead)) And
         (ZwUnmapViewOfSection(ProcessInfo.hProcess, BaseAddress) >= 0) And
         (Assigned(Buffer))) Then
         Begin

           NTHeaders    := PImageNTHeaders(Cardinal(Buffer) + Cardinal(PImageDosHeader(Buffer)._lfanew));
           BaseAddress  := VirtualAllocEx(ProcessInfo.hProcess,
                                          Pointer(NTHeaders.OptionalHeader.ImageBase),
                                          NTHeaders.OptionalHeader.SizeOfImage,
                                          MEM_RESERVE or MEM_COMMIT,
                                          PAGE_READWRITE);

           If (Assigned(BaseAddress)) And
              (WriteProcessMemory(ProcessInfo.hProcess, BaseAddress, Buffer,
                                  NTHeaders.OptionalHeader.SizeOfHeaders,
                                  BytesWritten)) Then
              Begin
                Sections := PImageSectionHeaders(ImageFirstSection(NTHeaders));
                For I := 0 To NTHeaders.FileHeader.NumberOfSections -1 Do


                  If (WriteProcessMemory(ProcessInfo.hProcess,
                                         Pointer(Cardinal(BaseAddress) +
                                                 Sections[I].VirtualAddress),
                                         Pointer(Cardinal(Buffer) +
                                                 Sections[I].PointerToRawData),
                                         Sections[I].SizeOfRawData, BytesWritten)) Then
                     VirtualProtectEx(ProcessInfo.hProcess,
                                      Pointer(Cardinal(BaseAddress) +
                                              Sections[I].VirtualAddress),
                                      Sections[I].Misc.VirtualSize,
                                      Protect(Sections[I].Characteristics),
                                      OldProtect);



                If (WriteProcessMemory(ProcessInfo.hProcess,
                                       Pointer(Context.Ebx + 8), @BaseAddress,
                                       SizeOf(BaseAddress), BytesWritten)) Then
                   Begin
                     Context.EAX := ULONG(BaseAddress) +
                                    NTHeaders.OptionalHeader.AddressOfEntryPoint;

                     Success := SetThreadContext(ProcessInfo.hThread, Context);
                   End;
              End;
         End;
    Finally

      If (Not Success) Then
        TerminateProcess(ProcessInfo.hProcess, 0)
      else
        ResumeThread(ProcessInfo.hThread);


        WaitForSingleObject(ProcessInfo.hProcess,INFINITE) ;

      //  GetExitCodeProcess(ProcessInfo.hProcess, Result);

    End;
  End;
End;

end.

Solution

  • Your code freezes because it is calling WaitForSingleObject() to wait for the spawned process to exit, and while it is waiting it is not pumping the calling thread's message queue for new messages. To avoid that, you have three choices:

    1. stop waiting altogether.

    2. stop calling this code in your main thread. Move it to a worker thread.

    3. call WaitForSingleObject() with a non-INFINITE timeout in a loop that pumps the message queue periodically. If you replace WaitForSingleObject() with MsgWaitForMultipleObjects(), it can tell you when new messages are waiting, so you don't need to pump the queue when there is nothing to process.

    Personally, I would opt for #1, especially since the function returns a TProcessInformation describing the spawned process, so let the caller decide what to do with the process. If the caller wants to wait, it will have the process's handles to do so. If the caller does not want to wait, it does not have to.