home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / t_power / testenv.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-12  |  1.9 KB  |  87 lines
  1. {$R-,S-}
  2.  
  3. {Demonstration program for TPENV. See TPENV.DOC for more information}
  4.  
  5. {Disable the following define if you don't have Turbo Professional}
  6. {$DEFINE UseTPro}
  7.  
  8. program TestEnv;
  9.   {-Demonstrate the TPENV unit}
  10.  
  11. uses
  12.   {$IFDEF UseTpro}
  13.   TpString,
  14.   Dos,
  15.   TpDos,
  16.   {$ENDIF}
  17.   TpEnv;
  18.  
  19. var
  20.   E : EnvRec;
  21.   SS : string;
  22.   VS : string;
  23.   Status : Integer;
  24.  
  25. begin
  26.   {Get the program name if available}
  27.   SS := ProgramStr;
  28.   if Length(SS) <> 0 then
  29.     WriteLn('Program name: ', SS, ^M^J);
  30.  
  31.   {$IFDEF UseTpro}
  32.   {Demonstrate a DOS shell with a custom prompt}
  33.   Write('Press <Enter> for a prompted DOS shell');
  34.   ReadLn;
  35.   Status := ShellWithPrompt('Type EXIT to return'^M^J'[TpEnv-$p] ');
  36.   if Status <> 0 then begin
  37.     WriteLn('Exec status: ', Status);
  38.     Halt;
  39.   end;
  40.   WriteLn;
  41.   {$ENDIF}
  42.  
  43.   {Dump the current environment}
  44.   CurrentEnv(E);
  45.   if E.EnvSeg = 0 then begin
  46.     WriteLn('Current environment not found');
  47.     Halt;
  48.   end;
  49.   Write('Current environment (', E.EnvLen, ' bytes)'
  50.         {$IFDEF UseTPro}
  51.         , ' at ', HexW(E.EnvSeg)
  52.         {$ENDIF}
  53.         );
  54.   DumpEnv(E);
  55.   WriteLn;
  56.  
  57.   {Dump the master environment}
  58.   MasterEnv(E);
  59.   if E.EnvSeg = 0 then begin
  60.     WriteLn('Master environment not found');
  61.     Halt;
  62.   end;
  63.   Write('Master environment (', E.EnvLen, ' bytes)'
  64.         {$IFDEF UseTPro}
  65.         , ' at ', HexW(E.EnvSeg)
  66.         {$ENDIF}
  67.         );
  68.   DumpEnv(E);
  69.   WriteLn;
  70.  
  71.   {Demonstrate changes to the master environment}
  72.   WriteLn('Change the master environment. Enter empty string to quit');
  73.   repeat
  74.     WriteLn;
  75.     Write('String to set: ');
  76.     ReadLn(SS);
  77.     if Length(SS) <> 0 then begin
  78.       Write('Value: ');
  79.       ReadLn(VS);
  80.       if not SetEnvStr(E, SS, VS) then
  81.         WriteLn('Insufficient environment space')
  82.       else
  83.         DumpEnv(E);
  84.     end;
  85.   until Length(SS) = 0;
  86. end.
  87.