+ working (although very limited) generic TProcess implementation based on SysUtils.CreteProcess for use with GO32v2, etc.

git-svn-id: trunk@19378 -

packages/fcl-process/src/dummy/process.inc

@@ -1,21 +1,13 @@
 {
-  Dummy process.inc
+  Dummy process.inc - the simplest version based on SysUtils.ExecuteProcess
 }
 
-{
+
-  prevent compilation error for the versions mentioned below
+Resourcestring
-}
+  SNoCommandLine        = 'Cannot execute empty command-line';
-{$if defined (go32v2) and defined(VER2_7_1)}
+  SErrCannotExecute     = 'Failed to execute %s : %d';
-  {$define WARN_ONLY}
+  SErrNoSuchProgram     = 'Executable not found: "%s"';
-{$endif}
+
-{$if defined(VER2_4) or defined(VER2_5_1)}
-  {$define WARN_ONLY}
-{$endif}
-{$ifdef WARN_ONLY}
-{$warning Temporary workaround - unit does nothing}
-{$else}
-{$fatal Proper implementation of TProcess for version of this target needed}
-{$endif}
 
 procedure TProcess.CloseProcessHandles;
 begin
@@ -23,15 +15,115 @@ end;
 
 Function TProcess.PeekExitStatus : Boolean;
 begin
+  Result := true; (* Dummy version assumes always synchronous execution *)
+end;
+
+function GetNextWordPos (const S: string): integer;
+const
+  WhiteSpace = [' ', #9, #10, #13];
+  Literals = ['"', ''''];
+var
+  WStart: integer;
+  InLiteral: boolean;
+  LastLiteral: char;
+begin
+  WStart := 1;
+(* Skip whitespaces at the beginning *)
+  while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do
+   Inc (WStart);
+  InLiteral := false;
+  LastLiteral := #0;
+  while (WStart <= Length (S)) and
+                               (not (S [WStart] in WhiteSpace) or InLiteral) do
+   begin
+    if S [WStart] in Literals then
+     if InLiteral then
+      InLiteral := not (S [WStart] = LastLiteral)
+     else
+      begin
+       InLiteral := true;
+       LastLiteral := S [WStart];
+      end;
+     Inc (WStart);
+    end;
+(* Skip whitespaces at the end *)
+  while (WStart <= Length (S)) and (S [WStart] in WhiteSpace) do
+   Inc (WStart);
+  Result := WStart;
+end;
+
+function MaybeQuote (const S: string): string;
+begin
+  if (Pos (' ', S) <> 0) then
+   Result := '"' + S + '"'
+  else
+   Result := S;
 end;
 
 Procedure TProcess.Execute;
+var
+  I: integer;
+  ExecName, FoundName: string;
+  E2: EProcess;
+  OrigDir: string;
+  Params: string;
 begin
+  if (ApplicationName = '') and (CommandLine = '') and (Executable = '') then
+   raise EProcess.Create (SNoCommandline);
+  if (FApplicationName <> '') then
+   ExecName := FApplicationName;
+  if (FCommandLine <> '') then
+   begin
+    Params := FCommandLine;
+    if ExecName = '' then
+     begin
+      I := GetNextWordPos (Params);
+      ExecName := Copy (Params, 1, Pred (I));
+      Trim (ExecName);
+      Delete (Params, 1, Pred (I));
+     end
+    else if Copy (FCommandLine, 1, Length (ExecName)) = ExecName then
+     Delete (Params, 1, Succ (Length (ExecName)))
+    else
+     Delete (Params, 1, Pred (GetNextWordPos (Params)));
+    Trim (Params);
+   end
+  else
+   for I := 1 to Pred (Parameters.Count) do
+    Params := Params + ' ' + MaybeQuote (Parameters [I]);
+  if (FExecutable <> '') and (ExecName = '') then
+   ExecName := Executable;
+  if not FileExists (ExecName) then
+   begin
+    FoundName := ExeSearch (ExecName, '');
+    if FoundName <> '' then
+     ExecName := FoundName
+    else
+     raise EProcess.CreateFmt (SErrNoSuchProgram, [ExecName]);
+   end;
+  if (FCurrentDirectory <> '') then
+   begin
+    GetDir (0, OrigDir);
+    ChDir (FCurrentDirectory);
+   end;
+  try
+   FExitCode := ExecuteProcess (ExecName, Params);
+  except
+(* Normalize the raised exception so that it is aligned to other platforms. *)
+    On E: EOSError do
+     begin
+      raise EProcess.CreateFmt (SErrCannotExecute, [FCommandLine, E.ErrorCode]);
+      if (FCurrentDirectory <> '') then
+       ChDir (OrigDir);
+      end;
+  end;
+  if (FCurrentDirectory <> '') then
+   ChDir (OrigDir);
 end;
 
 Function TProcess.WaitOnExit : Boolean;
 begin
-  Result:=False;
+  Result:=True;
 end;
 
 Function TProcess.Suspend : Longint;
@@ -40,7 +132,6 @@ begin
 end;
 
 Function TProcess.Resume : LongInt;
-
 begin
   Result:=0;
 end;