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