{***********************************************************************}
{									}
{ __IdStrUtl  Return a string identifying the process			}
{									}
{ function  __IdStrUtl(ProgSeg : word; var   HomeDir : _Path;		}
{				       var ErrorCode : word): string;	}
{									}
{	      ProgSeg	The program segment whose identification is	}
{			to be returned. 				}
{	      HomeDir	The path (possibly including the drive) of the	}
{			subdirectory from which the process was invoked.}
{	      ErrorCode Returned error status.	The values are: 	}
{			0 - Identification successfully returned.	}
{			1 - DOS version 3.00 or later required. 	}
{			2 - ProgSeg is not a process ID.		}
{			3 - The environment segment cannot be found or	}
{			    the identification cannot be found therein. }
{			    In this case HomeDir is set to the null	}
{			    string and the function value returned is	}
{			    the string 'Unidentified'.			}
{			4 - The environment segment in the program seg- }
{			    ment prefix is set to 0 or is greater than	}
{			    than the ProgSeg.  This is likely DOS or	}
{			    a copy of COMMAND.	HomeDir is returned as	}
{			    the null string, but the function value	}
{			    reflects the possibility.			}
{									}
{ Description __IdStrUtl returns the full path specification for the	}
{	      process specified by ProgSeg.  For example, to determine	}
{	      the value for the program using this routine, specify	}
{	      ProgSeg as PrefixSeg (the program segment prefix).	}
{									}
{	      If ProgSeg is not a valid process identification, both	}
{	      HomeDir and the function value are returned as the null	}
{	      string.  The information is valid for versions of DOS	}
{	      later than 3.00; for earlier versions, the null strings	}
{	      are also returned.					}
{									}
{	      The identification string if placed at the end of the	}
{	      environment by DOS when the program is loaded.  If the	}
{	      string cannot be found, HomeDir is set to the null string }
{	      but the function value reflects a possibility.		}
{									}
{ Version     4.00 (C)Copyright Blaise Computing Inc.  1987		}
{_______________________________________________________________________}

function  __IdStrUtl(ProgSeg : word; var   HomeDir : _Path;
				     var ErrorCode : word): string;

  var
    EnvSeg  : word;
    EnvPtr  : ^_MemoryChar;
    EnvSize : word;
    I,J     : integer;
    HomeLen : integer;
    Found   : boolean;
    TempStr : _Path;

  begin {__IdStrUtl}

 {   Length(HomeDir) := 0;}
    __IdStrUtl	    := '';

    if (_DOSMajorVer < 3) then	       { Valid information is available }
       begin			       { only for DOS 3.00 or later	}
	 ErrorCode := 1;
	 Exit
       end;

    { If the owner of the memory block is not the same as ProgSeg,	}
    { then ProgSeg does not represent a program segment and is not a	}
    { DOS loaded process.  The memory control block is immediately	}
    { before the program segment (ProgSeg), and the owner is at offset	}
    { 1 within the memory control block (see __CtrlMem).		}

    if (MemW[ProgSeg - 1:1] <> ProgSeg) then
       begin
	 ErrorCode := 2;
	 Exit
       end;

    { If ProgSeg is this process, the environment segment is _EnvSeg	}
    { as set by the initialization code for the Support unit, Unit_Sup. }
    { The environment segment is at offset $2C within the program seg-	}
    { ment prefix, but if the environment has been changed using	}
    { __PutEnUtl, the value no longer points to the original area set	}
    { by DOS when the program was loaded.				}

    if (ProgSeg = PrefixSeg) then
       EnvSeg := _EnvSeg
    else
       EnvSeg := MemW[ProgSeg:$2C];

    { When COMMAND is loaded, the environment segment is set to zero	}
    { if it is a secondary copy, but the first copy (the shell) has the }
    { environment segment located after the program segment.  The	}
    { identification string is not present in the environment.		}

    if ((EnvSeg = 0) or (EnvSeg > ProgSeg)) then
       begin
	 ErrorCode  := 4;
	 __IdStrUtl := 'Unidentified - could be COMMAND or DOS';
	 Exit
       end;

    { If the memory block pointed to by the environment segment does	}
    { not belong to the process, then the environment has been		}
    { released.  (PRINT does this).					}

    if (MemW[EnvSeg - 1:1] <> ProgSeg) then
       begin
	 ErrorCode  := 3;
	 __IdStrUtl := 'Unidentified - environment released';
	 Exit
       end;

    { Now we can begin the search through the environment array. The	}
    { identification string is found after the environment table	}
    { entries (that is, after two NUL bytes and a word)  It is a	}
    { NUL terminated string. The size of the environment block is	}
    { stored in the memory control block.  Make sure that no data	}
    { beyond the block is inspected.					}

    EnvSize := 16 * MemW[EnvSeg - 1:3];
    I	    := 0;

    EnvPtr  := Ptr(EnvSeg,0);
    repeat			     { Find the end of the environment	}
      Inc(I);			     { table.				}
      if (I > EnvSize) then
	 begin
	   __IdStrUtl := 'Unidentified';
	   ErrorCode  := 3;
	   Exit
	 end;
    until ((EnvPtr^[I] = #0) and (EnvPtr^[I+1] = #0));

    I := I + 4; 		     { Move to the beginning of the ID. }

    J := 0;
    repeat
      Inc(J);
      TempStr[J] := UpCase(EnvPtr^[I]);
      Inc(I)
    until (EnvPtr^[I] = #0);


{*******************************************************************************************}
    if length(tempstr)<>j then  writeln('LENGTH-tempstr is ',Length(TempStr) ,'and J is', J);
{    Length(TempStr) := J;}
{*******************************************************************************************}


    { Search from the right to find the first occurrence of a backslash }
    { or colon (\ or :) to determine the home subdirectory.		}

    Found := FALSE;
    I	  := J; 		       { Length of TempStr remember	}
    while ((not Found) and (I >= 1)) do
      if ((TempStr[I] = '\') or (TempStr[I] = ':')) then
	 Found := TRUE
      else
	 Dec(I);

    { Now put the directory path in HomeDir and return the file name.	}

    if (Found) then
       begin
	 if (TempStr[I] = '\') then    { Do not include trailing \	}
	    HomeDir := Copy(TempStr,1,I - 1)
	 else
	    HomeDir := Copy(TempStr,1,I);
	 __IdStrUtl := Copy(TempStr,I + 1,255)
       end
    else
       begin
	 HomeDir    := 'Unknown';      { No directory specified 	}
	 __IdStrUtl := TempStr
       end;

    ErrorCode := 0

  end;	{__IdStrUtl}
