home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D1 / DRBOBC.ZIP / TDOSENV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-20  |  2.9 KB  |  107 lines
  1. unit TDosEnv;
  2. interface
  3. uses
  4.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  5.   Forms, Dialogs, DrBob;
  6.  
  7. type
  8.   TDosEnvironment = class(TDrBob)
  9.   public
  10.   { Public class declarations (override) }
  11.     constructor Create(AOwner: TComponent); override;
  12.     destructor Destroy; override;
  13.  
  14.   private
  15.   { Private field declarations }
  16.     FDosEnvList: TStringList;
  17.     procedure DoNothing(Const Value: TStringList);
  18.  
  19.   protected
  20.   { Protected method declarations }
  21.     Dummy: Word;
  22.     function GetDosEnvCount: Word;
  23.  
  24.   public
  25.   { Public interface declarations }
  26.     function GetDosEnvStr(Const Name: String): String;
  27.     { This function is a modified version of the GetEnvVar function that
  28.       appears in the WinDos unit that comes with Delphi. This function's
  29.       interface uses Pascal strings instead of null-terminated strings.
  30.     }
  31.  
  32.   published
  33.   { Published design declarations }
  34.     property DosEnvCount: Word read GetDosEnvCount write Dummy;
  35.     property DosEnvList: TStringList read FDosEnvList write DoNothing;
  36.   end;
  37.  
  38. implementation
  39.  
  40.   constructor TDosEnvironment.Create(AOwner: TComponent);
  41.   var P: PChar;
  42.       i: Integer;
  43.   begin
  44.     inherited Create(AOwner);
  45.     FDosEnvList := TStringList.Create;
  46.     P := GetDosEnvironment; { Win API }
  47.     i := 0;
  48.     while P^ <> #0 do
  49.     begin
  50.       Inc(i);
  51.       FDosEnvList.Add(StrPas(P));
  52.       Inc(P, StrLen(P)+1) { Fast Jump to Next Var }
  53.     end;
  54.     FAbout := 'TDosEnvironment (c) 1996 by Bob Swart (aka Dr.Bob - 100434,2072)'
  55.   end {Create};
  56.  
  57.   destructor TDosEnvironment.Destroy;
  58.   begin
  59.     FDosEnvList.Free;
  60.     FDosEnvList := nil;
  61.     inherited Destroy
  62.   end {Destroy};
  63.  
  64.   procedure TDosEnvironment.DoNothing(Const Value: TStringList);
  65.   begin
  66.     MessageDlg('TDosEnvironment.DosEnvList is read-only!', mtInformation, [mbOk], 0)
  67.   end {DoNothing};
  68.  
  69.  
  70.   function TDosEnvironment.GetDosEnvCount: Word;
  71.   { Returns the number of environment variables.
  72.   }
  73.   begin
  74.     if Assigned(FDosEnvList) then {!!} Result := FDosEnvList.Count
  75.     else
  76.       Result := 0;
  77.   end {GetDosEnvCount};
  78.  
  79.   function TDosEnvironment.GetDosEnvStr(Const Name: String): String;
  80.   { This function is a modified version of the GetEnvVar function that
  81.     appears in the WinDos unit that comes with Delphi. This function's
  82.     interface uses Pascal strings instead of null-terminated strings.
  83.   }
  84.   var i: Integer;
  85.       Tmp: String;
  86.       Len: Byte absolute Name;
  87.   begin
  88.     i := 0;
  89.     Result := '';
  90.     if Assigned(FDosEnvList) then {!!} while i < FDosEnvList.Count do
  91.     begin
  92.       Tmp := FDosEnvList[i];
  93.       Inc(i);
  94.       if Pos(Name,Tmp) = 1 then
  95.       begin
  96.         Delete(Tmp,1,Len);
  97.         if Tmp[1] = '=' then
  98.         begin
  99.           Delete(Tmp,1,1);
  100.           Result := Tmp;
  101.           i := FDosEnvList.Count { end while-loop }
  102.         end
  103.       end
  104.     end
  105.   end {GetDosEnvStr};
  106. end.
  107.