fixpopen

library fixpopen;

{$mode objfpc}{$H+}

uses
  Classes, lua, lauxlib, lualib, windows;

type
  {$PACKRECORDS 1}
  TThunk = record
    jmp   : byte;
    offset: longword;
  end;
  {$PACKRECORDS DEFAULT}
  TCreateProcess = function (lpApplicationName:LPCSTR; lpCommandLine:LPSTR;
                         lpProcessAttributes:LPSECURITY_ATTRIBUTES;
                         lpThreadAttributes:LPSECURITY_ATTRIBUTES;
                         bInheritHandles:WINBOOL;dwCreationFlags:DWORD;
                         lpEnvironment:LPVOID;lpCurrentDirectory:LPCSTR;
                         lpStartupInfo:LPSTARTUPINFO;
                         lpProcessInformation:LPPROCESS_INFORMATION):WINBOOL;stdcall;

var
  thunk : TThunk = (jmp:$e9; offset:$0);
  save  : TThunk = (jmp:$0;  offset:$0);
  w32CreateProcess : TCreateProcess = nil;
  protect : DWORD = 0;

function patch(L:Plua_State):integer;cdecl;
var
  bret: BOOL;
begin
  //OutputDebugString('patching');
  bret:=VirtualProtect(w32CreateProcess, sizeof(TThunk), PAGE_EXECUTE_READWRITE, @protect);
  CopyMemory(w32CreateProcess, @thunk, sizeof(TThunk));
  VirtualProtect(w32CreateProcess, sizeof(TThunk), protect, nil);
  //OutputDebugString('done');
  result:=1;
end;

function unpatch(L:Plua_State):integer;cdecl;
var
  bret: BOOL;
begin
  //OutputDebugString('unpatching');
  VirtualProtect(w32CreateProcess, sizeof(TThunk), PAGE_EXECUTE_READWRITE, @protect);
  CopyMemory(w32CreateProcess, @save, sizeof(TThunk));
  VirtualProtect(w32CreateProcess, sizeof(TThunk), protect, nil);
  //OutputDebugString('done');
  result:=1;
end;

function libinit(L:Plua_State):integer;cdecl;export;
begin
  lua_register(L, 'fix_popen_patch', @patch);
  lua_register(L, 'fix_popen_unpatch', @unpatch);
  //OutputDebugString('registered');
  result:=0;
end;

function myCreateProcess(lpApplicationName:LPCSTR; lpCommandLine:LPSTR;
                         lpProcessAttributes:LPSECURITY_ATTRIBUTES;
                         lpThreadAttributes:LPSECURITY_ATTRIBUTES;
                         bInheritHandles:WINBOOL;dwCreationFlags:DWORD;
                         lpEnvironment:LPVOID;lpCurrentDirectory:LPCSTR;
                         lpStartupInfo:LPSTARTUPINFO;
                         lpProcessInformation:LPPROCESS_INFORMATION):WINBOOL;stdcall;
begin
  //OutputDebugString('myCreateProcess');
  unpatch(nil);
  lpStartupInfo^.dwFlags:=lpStartupInfo^.dwFlags or STARTF_USESHOWWINDOW;
  lpStartupInfo^.wShowWindow:=SW_HIDE;
  result := w32CreateProcess(lpApplicationName,lpCommandLine,lpProcessAttributes,
         lpThreadAttributes,bInheritHandles,dwCreationFlags,lpEnvironment,
         lpCurrentDirectory,lpStartupInfo,lpProcessInformation);
  patch(nil);
end;

exports
  libinit;

initialization
  if w32CreateProcess = nil then
  begin
     // save API call address
     w32CreateProcess := TCreateProcess(GetProcAddress(GetModuleHandle('kernel32.dll'), 'CreateProcessA'));
     // save API function prelude
     CopyMemory(@save, w32CreateProcess, sizeof(TThunk));
     // fill in the thunk
     thunk.offset:= pointer(@myCreateProcess) - pointer(w32CreateProcess) - 5;
  end
end.