home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol6n20.zip / PROFIL.ZIP / ENVIRON.PRF < prev    next >
Text File  |  1987-01-11  |  6KB  |  174 lines
  1. type
  2.   EnvPtr     = ^LongString;   { Used to access the environment string }
  3.   LongString = array[0..maxint] of char;
  4.  
  5. var
  6.   EnvLength  : integer;
  7.   MemStr,
  8.   EnvStr     : EnvPtr;
  9.   Extrabytes : integer;
  10.  
  11. { Get the length of the DOS environment string }
  12. function GetEnvLength : integer ;
  13. var
  14.   Result : integer ;
  15. begin
  16.   Inline(
  17.     $2E/$A1/$2C/$00        {         cs:mov   ax,word [$2C]     ; get environment segment}
  18.     /$8E/$C0               {         mov      es,ax             ; copy it into ES}
  19.     /$BF/$00/$00           {         mov      di,0              ; ES:DI points to first byte}
  20.     /$B9/$00/$80           {         mov      cx,$8000          ; max. length of env. string}
  21.     /$FC                   {         cld                        ; scan upward}
  22.     /$B0/$00               {         mov      al,$00            ; looking for a 0 byte}
  23.     /$F2/$AE               {rpt:     repne scasb}
  24.     /$E3/$0D               {         jcxz     error             ; if cx=0, we're at end of string}
  25.     /$AE                   {         scasb                      ; check next byte}
  26.     /$E3/$0A               {         jcxz     error}
  27.     /$75/$F7               {         jnz      rpt               ; continue looping until we get}
  28.                            {                                    ; 2 sequential zero bytes}
  29.     /$4F                   {         dec      di                ; mov pointer back to end of string}
  30.     /$89/$BE/>RESULT       {         mov      [bp+>Result],di   ; return length of string}
  31.     /$E9/$06/$00           {         jmp      end               ; and exit}
  32.     /$C7/$86/>RESULT/$00/$00{error:   mov      word [bp+>Result],$0   ; return 0}
  33.                            {end:}
  34.   );
  35.   GetEnvLength := Result;
  36. end; { function GetEnvLength  }
  37.  
  38.  
  39. { For an array of char pointed to by OldPtr, find the first array element }
  40. { which is located on a paragraph boundary, and return a pointer with     }
  41. { offset of 0 which points to that element in NewPtr.  We have to be able }
  42. { to do this in order to create a new environment for the called program, }
  43. { since DOS only transmits the segment of the environment string, thus    }
  44. { requiring environment strings to begin on paragraph boundaries.         }
  45.  
  46. procedure ZeroAdjust( var NewPtr : EnvPtr; OldPtr : EnvPtr );
  47. var
  48.   TempOfs,
  49.   TempSeg : integer;
  50. begin
  51.   TempOfs := ofs( OldPtr^ );
  52.   TempSeg := seg( OldPtr^ );
  53.   if ( TempOfs and $0F ) <> 0 then
  54.   begin
  55.     TempOfs := TempOfs and $FFF0;
  56.     TempSeg := succ( TempSeg );
  57.   end;
  58.   TempSeg := TempSeg + ( TempOfs SHR 4 );
  59.   TempOfs := 0;
  60.   NewPtr := ptr( TempSeg, TempOfs );
  61. end; { procedure ZeroAdjust( var NewPtr : EnvPtr; OldPtr : EnvPtr ) }
  62.  
  63.  
  64. { Allocate on the heap enough space to hold the current environment plus a }
  65. { string of length NBytes, and set the global variable EnvStr to point to  }
  66. { the first byte in this space which is on a paragraph boundary.           }
  67.  
  68. procedure AllocEnv( NBytes : integer );
  69. begin
  70.   EnvLength := GetEnvLength;
  71.   If EnvLength > MaxAvail then
  72.   begin
  73.     WriteLn( 'Environment too large.  Program aborted.' );
  74.     Halt;
  75.   end;
  76.   GetMem( MemStr, EnvLength + NBytes + 15 );
  77.   ZeroAdjust( EnvStr, MemStr );
  78. end; { procedure AllocEnv( NBytes : integer ) }
  79.  
  80.  
  81. { Copy the environment string into local storage space }
  82.  
  83. procedure CopyEnv;
  84. var
  85.   OldStr  : EnvPtr;
  86. begin
  87.   OldStr := Ptr( memW[ Cseg:$002C ], 0 );
  88.   move( OldStr^, EnvStr^, EnvLength );
  89. end; { procedure CopyEnv  }
  90.  
  91. { Add the string Str to the local copy of the environment string }
  92.  
  93. procedure CopyString( Str : string255 );
  94. var
  95.   TempPtr : EnvPtr;
  96.   StrLen  : integer;
  97. begin
  98.   StrLen := length( Str );
  99.   TempPtr := ptr( seg( EnvStr^ ), EnvLength );
  100.   move( Str[1], TempPtr^, StrLen );
  101.   EnvStr^[EnvLength + StrLen] := chr(0);  { env. string must be terminated by 2 0-bytes }
  102.   EnvStr^[EnvLength + StrLen + 1] := chr(0);
  103. end; { procedure CopyString( Str : string255 ) }
  104.  
  105.  
  106. { Make a local copy of the environment string and add the string Str to it, }
  107. { storing the address of the local copy in EnvStr.                          }
  108.  
  109. procedure AddEnvStr( Str : string255 );
  110. begin
  111.   Extrabytes := length( Str ) + 2;
  112.   AllocEnv( Extrabytes );
  113.   CopyEnv;
  114.   CopyString( Str );
  115. end; { procedure AddEnvStr( Str : string255 ) }
  116.  
  117.  
  118. { Determine whether the characters in TestString match the characters in }
  119. { Env beginning at Org.                                                  }
  120.  
  121. function match( Env : LongString; Org : integer; TestString : string255 ) : boolean;
  122. var
  123.   Index : integer;
  124. begin
  125.   Index := 0;
  126.   while ( (Index < length( TestString ) ) and
  127.           ( Env[ Org + Index ] = TestString[ succ(Index) ] ) ) do
  128.           Index := succ(Index);
  129.   match := Index = length( TestString );
  130. end; { function match( Env : LongString; Org : integer; TestString : string255 )  }
  131.  
  132.  
  133. { Return the text which follows the first occurence of SearchString in the }
  134. { program's environment string.  Returns an empty string if SearchString   }
  135. { does not occur in the environment string.                                }
  136.  
  137. function GetEnvStr( SearchString : string255 ) : string255;
  138. var
  139.   CurChar,
  140.   Index     : integer;
  141.   found,
  142.   error     : boolean;
  143.   EnvString : ^Longstring;
  144.   OutStr    : string255;
  145. begin
  146.   CurChar := 0;
  147.   found := false;
  148.   error := false;
  149.   EnvString := ptr( memW[ Cseg:$2C ], 0 );
  150.   repeat
  151.     if EnvString^[ CurChar ] = chr(0) then
  152.        error := true        { end of environment string, SearchString not found }
  153.     else if match( EnvString^, CurChar, SearchString) then
  154.     begin
  155.       CurChar := CurChar + length( SearchString );
  156.       found := true;
  157.     end
  158.     else
  159.     begin
  160.       while EnvString^[ CurChar ] <> chr(0) do
  161.             CurChar := succ(CurChar);    { Skip to next 0 }
  162.       CurChar := succ(CurChar);          { Next byte after 0 }
  163.     end;
  164.   until (found or error);
  165.   OutStr := '';
  166.   if found then
  167.      while EnvString^[ CurChar ] <> chr(0) do
  168.      begin
  169.        OutStr := OutStr + EnvString^[ CurChar ];
  170.        CurChar := succ(CurChar);
  171.      end; { while }
  172.   GetEnvStr := OutStr;
  173. end; { function GetEnvStr( SearchString : string255 )  }
  174.