program Launcher;
{$mode objfpc}{$H+}
uses Windows;
{$R *.res}
type
TIsWOW64Process = function(hProcess:THandle;var IsWOW64:Boolean):Boolean;stdcall;
const
FileName = 'MyProgram.exe';
Dir32 = 'Bin32\';
Dir64 = 'Bin64\';
function Is64Process:Boolean;
var Kernel:HMODULE;IsWOW64Process:TIsWOW64Process;Temp:Boolean;
begin
Result := false;
Kernel := LoadLibrary('kernel32');
if Kernel = 0 then Exit;
IsWOW64Process := TIsWOW64Process(GetProcAddress(Kernel, 'IsWow64Process'));
if not Assigned(IsWow64Process) then Exit;
IsWOW64Process(GetCurrentProcess, Temp);
Result := Temp;
FreeLibrary(Kernel);
end;
function GetCurrentDir:UnicodeString;
var Len:Integer;
begin
Len := GetCurrentDirectoryW(0, nil);
SetLength(Result, Len - 1);
GetCurrentDirectoryW(Len, PWideChar(Result));
end;
type
TParserState = (psFirstSimbol, psFileNameStart, psQoute, psFileNameEnd, psSpace);
function ParseCommandLine:UnicodeString;
var ParserState:TParserState;CmdLine:PWideChar;
begin
ParserState := psFirstSimbol;
CmdLine := GetCommandLineW;
while CmdLine^ <> #0 do begin
case ParserState of
psFirstSimbol:begin
if CmdLine^ = ' ' then begin
Inc(CmdLine);
end
else begin
ParserState := psFileNameStart;
end;
end;
psFileNameStart:begin
if CmdLine^ = '"' then begin
ParserState := psQoute;
end
else begin
ParserState := psFileNameEnd;
end;
Inc(CmdLine);
end;
psQoute:begin
if CmdLine^ = '"' then begin
ParserState := psSpace;
end;
Inc(CmdLine);
end;
psFileNameEnd:begin
if CmdLine^ = ' ' then begin
ParserState := psSpace;
end;
Inc(CmdLine);
end;
psSpace:begin
if CmdLine^ <> ' ' then begin
Break;
end;
Inc(CmdLine);
end;
end;
end;
Result := CmdLine;
end;
var DirName, FilePath:UnicodeString;
StartupInfo:TStartupInfoW;
ProcessInfo:TProcessInformation;
begin
if Is64Process then begin
DirName := Dir64;
end
else begin
DirName := Dir32;
end;
FilePath := DirName + FileName;
GetStartupInfoW(@StartupInfo);
if CreateProcessW(PWideChar(FilePath),
PWideChar('"' + FilePath + '" ' + ParseCommandLine),
nil,
nil,
false,
CREATE_UNICODE_ENVIRONMENT,
nil,
PWideChar(GetCurrentDir),
StartupInfo,
ProcessInfo) then begin
if ProcessInfo.hProcess <> 0 then begin
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
end;
end;
end.