{***********************************************************************}
{									}
{ __SpawnPgm  Execute a process 					}
{									}
{ procedure __SpawnPgm(ProgName : _Path;				}
{			CmdLine : string; var ErrorCode : word);	}
{									}
{	      ProgName	The program to execute.  The format for 	}
{			ProgName may optionally contain a full path	}
{			specifier and extension, but need not contain	}
{			either. 					}
{	      CmdLine	The command line to pass to the program.	}
{	      ErrorCode The returned error status code: 		}
{			0 - File successfully loaded and executed.	}
{			2 - File not found. This error is also returned }
{			    if ProgName is the null string (length 0).	}
{			3 - Path not found.  If a path is specified and }
{			    one of the entries is not present, this	}
{			    code is returned.				}
{			5 - Access denied.  A file not suitable for	}
{			    execution was specified.			}
{			8 - Insufficient memory to load the program.	}
{									}
{ Description This procedure invokes ProgName as a child process,	}
{	      passing to the program CmdLine as the command line	}
{	      parameter.						}
{									}
{	      If ProgName does not have a path specification, the	}
{	      current directory is checked first, and if the program	}
{	      is not found, then the paths specified in the PATH=	}
{	      environment string are checked.  If no extension is	}
{	      specified, first a program with a COM extension is	}
{	      assumed, then an EXE extension and finally a BAT exten-	}
{	      sion.  If the ProgName represents a batch file, a 	}
{	      secondary copy of COMMAND is loaded, and the batch file	}
{	      name passed to it as the command line.			}
{									}
{	      The procedure __ExecPgm is used to load the program.	}
{	      The FCBs are formatted as the command line parameters.	}
{	      This procedure (method of loading and directory		}
{	      searching) is precisely the same procedure as used by	}
{	      COMMAND when loading a process.  Consequently,		}
{	      __SpawnPgm behaves exactly as you would expect if you	}
{	      type the ProgName and CmdLine in response to the COMMAND	}
{	      prompt.							}
{									}
{ Version     4.00 (C)Copyright Blaise Computing Inc.  1987		}
{_______________________________________________________________________}

procedure __SpawnPgm(ProgName : _Path;
		      CmdLine : string; var ErrorCode : word);

  type
    ExtStr  = string[3];
    FileStr = string[8];

  {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  { Xtract - Parse a full path name into its constituent parts; path,	}
  {	     file name and extension.					}
  {_____________________________________________________________________}

  procedure Xtract(PathName : _Path; var Path	  : _Path;
				     var FileName : FileStr;
				     var Ext	  : ExtStr);

    var
      Found   : boolean;
      I       : integer;
      TempStr : string[12];

    begin {Xtract}

      { Search from the end (the right) of PathName to the beginning	}
      { (the left) to find the end of the path component.  The end of	}
      { the path component is indicated by a backslash (\) if it ends	}
      { with a subdirectory or a color (:) if it ends with a drive	}
      { specification.							}

      Found := FALSE;
      I     := Length(PathName);
      while ((not Found) and (I >= 1)) do
	if ((PathName[I] = '\') or (PathName[I] = ':')) then
	   Found := TRUE
	else
	   Dec(I);

      { Store the path and put the remainder of the string in temporary }
      { storage.  The file name and extension will extracted from it.	}

      if (Found) then
	 begin
	   Path    := Copy(PathName,1,I);
	   TempStr := Copy(PathName,I + 1,12)
	 end
      else
	 begin
	   Length(Path) := 0;	       { Path is the null string	}
	   TempStr	:= Copy(PathName,1,12)
	 end;

      { Like the path delimiter, the extension delimiter (.) is 	}
      { searched from starting at the end (right) of the string.	}

      Length(Ext) := 0; 		    { Initialize to null string }
      FileName	  := Copy(TempStr,1,8);     { and the name to the first }
					    { eight characters. 	}
      Found := FALSE;
      I     := Length(TempStr);
      while ((not Found) and (I >= 1)) do
	if (TempStr[I] = '.') then
	   begin
	     Found    := TRUE;
	     Ext      := Copy(TempStr,I + 1,3);
	     FileName := Copy(TempStr,1,I - 1)
	   end
	else
	   Dec(I)

    end;  {Xtract}

  const
    CheckExt : array[1..3] of ExtStr = ('COM','EXE','BAT');

  var
    NextExt,Ext : ExtStr;
    PathName	: _Path;
    FullPath	: _Path;
    LastPos	: integer;
    PathParm	: string;
    FileName	: FileStr;
    I,J,DelPos	: integer;
    Found	: boolean;
    MoreExt	: boolean;
    MorePath	: boolean;
    FileSpec	: SearchRec;

  begin {__SpawnPgm}

    { For convenience, first remove all blanks and convert to upper	}
    { case.								}

    J := 0;
    for I := 1 to Length(ProgName) do
      if (ProgName[I] <> #32) then
	 begin
	   Inc(J);
	   ProgName[J] := UpCase(ProgName[I])
	 end;

    if (J = 0) then		       { ProgName is the null string	}
       begin
	 ErrorCode := 2;	       { File not found 		}
	 Exit
       end
    else
       Length(ProgName) := J;

    Xtract(ProgName,PathName,FileName,Ext);

    if (Length(FileName) = 0) then
       begin
	 ErrorCode := 2;	       { File not found 		}
	 Exit
       end
    else if (Length(PathName) = 0) then
       begin
	 GetDir(0,PathName);	       { Start at the current directory }
	 PathParm := __GetEnUtl('PATH=');
	 MorePath := TRUE
       end
    else
       begin
	 Length(PathParm) := 0;
	 MorePath	  := FALSE
       end;

    { There are two loops in this main part of the procedure.  The	}
    { outside loop moves from directory to directory as long as there	}
    { more directories to search (Length(PathParm) <> 0).  If no path	}
    { is initially specified, the current directory is checked first	}
    { and then the directories specified in the PATH environment	}
    { parameter (PathParm).  If a path is specified, only that		}
    { directory is checked.  Similarly, if no extension is specified,	}
    { for each subdirectory (this is the inner repeat loop), first	}
    { check for a COM file, then an EXE file and finally a BAT file.	}
    { If a file is not found, then the next directory (if necessary)	}
    { is searched.  If the file is found, it is loaded and executed;	}
    { if it is a BAT file, it is executed by loading a secondary copy	}
    { of COMMAND.							}

    repeat			       { Until no more directories need }
				       { to be checked. 		}
      { If the path specifier does not end in a backslash (\) or colon	}
      { (:), then append one.						}

      LastPos := Length(PathName);
      if ((PathName[LastPos] <> ':') and (PathName[LastPos] <> '\')) then
	 PathName := PathName + '\';

      { Now check for an extension.  If one is present, it is the only	}
      { one to check; otherwise all three must be checked.		}

      if (Length(Ext) <> 0) then
	 begin
	   NextExt := Ext;
	   MoreExt := FALSE
	 end
      else
	 begin
	   I	   := 1;
	   MoreExt := TRUE;
	   NextExt := CheckExt[1]
	 end;

      repeat			       { Until no more extensions to	}
				       { check. 			}
	FullPath := PathName + FileName + '.' + NextExt;
	FindFirst(FullPath,
			 ReadOnly + Hidden + SysFile + Archive,FileSpec);
	Found := (DosError = 0);

	if ((not Found) and (I < 3)) then
	   begin
	     Inc(I);
	     NextExt := CheckExt[I];
	   end
	else
	   MoreExt := FALSE;

      until (Found or (not MoreExt));

      { If the file is still not found, get the next directory to check }

      if ((not Found) and (Length(PathParm) <> 0)) then
	 begin
	   DelPos := Pos(';',PathParm);
	   if (DelPos <> 0) then
	      begin
		PathName := Copy(PathParm,1,DelPos - 1);
		PathParm := Copy(PathParm,DelPos + 1,255)
	      end
	   else
	      begin
		PathName	 := PathParm;
		Length(PathParm) := 0
	      end
	 end
      else
	MorePath := FALSE;

    until (Found or (not MorePath));

    if (Found) then
       if (NextExt = 'BAT') then
	  __ExecPgm(__GetEnUtl('COMSPEC='),
			       '/C ' + FullPath + ' ' + CmdLine,
			       TRUE,ErrorCode)
       else
	  __ExecPgm(FullPath,CmdLine,TRUE,ErrorCode)
    else if (DosError = 18) then
       ErrorCode := 2
    else
       ErrorCode := DosError

  end;	{__SpawnPgm}
