1{ 2 Dummy process.inc - the simplest version based on SysUtils.ExecuteProcess 3} 4 5uses 6 Exec, AmigaDos, Utility; 7 8Resourcestring 9 SNoCommandLine = 'Cannot execute empty command-line'; 10 SErrCannotExecute = 'Failed to execute %s : %d'; 11 SErrNoSuchProgram = 'Executable not found: "%s"'; 12 13 14procedure TProcess.CloseProcessHandles; 15begin 16end; 17 18Function TProcess.PeekExitStatus : Boolean; 19begin 20 Result := true; (* Dummy version assumes always synchronous execution *) 21end; 22 23function GetNextWordPos (const S: string): integer; 24const 25 WhiteSpace = [' ', #9, #10, #13]; 26 Literals = ['"', '''']; 27var 28 WStart: integer; 29 InLiteral: boolean; 30 LastLiteral: char; 31begin 32 WStart := 1; 33(* Skip whitespaces at the beginning *) 34 while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do 35 Inc (WStart); 36 InLiteral := false; 37 LastLiteral := #0; 38 while (WStart <= Length (S)) and 39 (not (S [WStart] in WhiteSpace) or InLiteral) do 40 begin 41 if S [WStart] in Literals then 42 if InLiteral then 43 InLiteral := not (S [WStart] = LastLiteral) 44 else 45 begin 46 InLiteral := true; 47 LastLiteral := S [WStart]; 48 end; 49 Inc (WStart); 50 end; 51(* Skip whitespaces at the end *) 52 while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do 53 Inc (WStart); 54 Result := WStart; 55end; 56 57function MaybeQuote (const S: string): string; 58begin 59 if (Pos (' ', S) <> 0) then 60 Result := '"' + S + '"' 61 else 62 Result := S; 63end; 64 65var 66 UID: Integer = 0; 67 68Procedure TProcess.Execute; 69var 70 I: integer; 71 ExecName, FoundName: string; 72 E2: EProcess; 73 OrigDir: string; 74 Params: string; 75 TempName: string; 76 cos: BPTR; 77begin 78 if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then 79 raise EProcess.Create (SNoCommandline); 80 if (FApplicationName <> '') then 81 ExecName := FApplicationName; 82 if (FCommandLine <> '') then 83 begin 84 Params := FCommandLine; 85 if ExecName = '' then 86 begin 87 I := GetNextWordPos (Params); 88 ExecName := Copy (Params, 1, Pred (I)); 89 ExecName := Trim (ExecName); 90 Delete (Params, 1, Pred (I)); 91 end 92 else if Copy (FCommandLine, 1, Length (ExecName)) = ExecName then 93 Delete (Params, 1, Succ (Length (ExecName))) 94 else 95 Delete (Params, 1, Pred (GetNextWordPos (Params))); 96 Params := Trim (Params); 97 end 98 else 99 for I := 0 to Pred (Parameters.Count) do 100 Params := Params + ' ' + MaybeQuote (Parameters [I]); 101 if (FExecutable <> '') and (ExecName = '') then 102 ExecName := Executable; 103 if not FileExists (ExecName) then 104 begin 105 FoundName := ExeSearch (ExecName, ''); 106 if FoundName <> '' then 107 ExecName := FoundName 108 else 109 raise EProcess.CreateFmt (SErrNoSuchProgram, [ExecName]); 110 end; 111 if (FCurrentDirectory <> '') then 112 begin 113 GetDir (0, OrigDir); 114 ChDir (FCurrentDirectory); 115 end; 116 try 117 cos := BPTR(0); 118 repeat 119 Inc(UID); 120 TempName := 'T:PrO_'+ HexStr(FindTask(nil)) + '_' + IntToHex(UID,8); 121 until not FileExists(TempName); 122 //sysdebugln('TProcess start: "' + ExecName + ' ' + Params+'" >' + TempName); 123 cos := AmigaDos.DosOpen(PChar(TempName), MODE_READWRITE); 124 FExitCode := LongInt(amigados.Execute(PChar(ExecName + ' ' + Params), BPTR(0), cos)); 125 DosSeek(cos, 0, OFFSET_BEGINNING); 126 CreateStreams(0, THandle(cos),0); 127 //FExitCode := ExecuteProcess (ExecName, Params); 128 except 129(* Normalize the raised exception so that it is aligned to other platforms. *) 130 On E: EOSError do 131 begin 132 raise EProcess.CreateFmt (SErrCannotExecute, [FCommandLine, E.ErrorCode]); 133 if (FCurrentDirectory <> '') then 134 ChDir (OrigDir); 135 end; 136 end; 137 if (FCurrentDirectory <> '') then 138 ChDir (OrigDir); 139end; 140 141Function TProcess.WaitOnExit : Boolean; 142begin 143 Result:=True; 144end; 145 146Function TProcess.WaitOnExit(Timeout : DWord) : Boolean; 147begin 148 Result:=True; 149end; 150 151Function TProcess.Suspend : Longint; 152begin 153 Result:=0; 154end; 155 156Function TProcess.Resume : LongInt; 157begin 158 Result:=0; 159end; 160 161Function TProcess.Terminate(AExitCode : Integer) : Boolean; 162begin 163 Result:=False; 164end; 165 166Procedure TProcess.SetShowWindow (Value : TShowWindowOptions); 167begin 168end; 169 170 171