Получение переменных среды

=== Получение переменных среды ===
{ Переменные среды }
procedure GetEnvironmentStrings(ss: TStrings);
var
 ptr: PChar;
 s: string;
 Done: boolean;
begin
 ss.Clear;
 s := ;
 Done := FALSE;
 ptr := windows.GetEnvironmentStrings;
 while not Done do
 begin
 if ptr^ = #0 then
 begin
 Inc(ptr);
 if ptr^ = #0 then
 Done := True
 else
 ss.Add(s);
 s := ptr^;
 end
 else
 s := s + ptr^;
 Inc(ptr);
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02211
----
procedure TForm1.Button5Click(Sender: TObject);
var
 p: PChar;
begin
 Memo1.Lines.Clear;
 Memo1.WordWrap := False;
 {$IFDEF WIN32}
 p := GetEnvironmentStrings;
 {$ELSE}
 p := GetDOSEnvironment;
 {$ENDIF}
 while p^ <> #0 do
 begin
 Memo1.Lines.Add(StrPas(p));
 Inc(p, lStrLen(p) + 1);
 end;
 {$IFDEF WIN32}
 FreeEnvironmentStrings(p);
 {$ENDIF}
end;
Source: http://delphiworld.narod.ru/
ID: 02212
----
Функция GetEnvironmentStrings возвращает адрес памяти со средой текущего процесса. Все переменные возвращаются в виде строк, оканчивающихся нулем. Набор строк терминируется двумя нулями.
Функция GetEnvironmentVariable возвращает значения переменных среды опрашиваемого процесса. Величина также возвращается в виде строки с завершающим нулем.
Source: http://delphiworld.narod.ru/
ID: 02213
----
unit TDosEnv;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs;
type
 TDosEnvironment = class(TComponent)
 public
 { Public объявления класса }
 constructor Create(AOwner: TComponent); override;
 destructor Destroy; override;
 private
 { Объявления Private-полей }
 FDosEnvList: TStringList;
 procedure DoNothing(const Value: TStringList);
 protected
 { Объявления Protected-методов }
 dummy: Word;
 function GetDosEnvCount: Word;
 public
 { Public interface объявления }
 { Данная функция является измененной версией функции GetEnvVar,
 присутствующей в поставляемом с Delphi модуле WinDos. Она
 использует паскалевские строки вместо строк с терминирующим нулем. }
 function GetDosEnvStr(const Name: string): string;
 published
 { Published design объявления }
 property DosEnvCount: Word read GetDosEnvCount write dummy;
 property DosEnvList: TStringList read FDosEnvList write DoNothing;
 end;
procedure Register;
implementation
constructor TDosEnvironment.Create(AOwner: TComponent);
var
 P: PChar;
 i: Integer;
begin
 inherited Create(AOwner);
 FDosEnvList := TStringList.Create;
 P := GetDosEnvironment; { Win API }
 i := 0;
 while P^ <> #0 do
 begin
 Inc(i);
 FDosEnvList.Add(StrPas(P));
 Inc(P, StrLen(P) + 1) { Быстрый переход к следующей переменной }
 end
end;
destructor TDosEnvironment.Destroy;
begin
 FDosEnvList.Free;
 FDosEnvList := nil;
 inherited Destroy
end;
procedure TDosEnvironment.DoNothing(const Value: TStringList);
begin
 MessageDlg('TDosEnvironment.DosEnvList только для чтения!', mtInformation, [mbOk], 0)
end;
{ Возвращает количество переменных окружения. }
function TDosEnvironment.GetDosEnvCount: Word;
begin
 if Assigned(FDosEnvList) then {!!}
 Result := FDosEnvList.Count
 else
 Result := 0;
end;
{ Данная функция является измененной версией функции GetEnvVar,
присутствующей в поставляемом с Delphi модуле WinDos. Она
использует паскалевские строки вместо строк с терминирующим нулем. }
function TDosEnvironment.GetDosEnvStr(const Name: string): string;
var
 i: Integer;
 Tmp: string;
 Len: Byte absolute Name;
begin
 i := 0;
 Result := ;
 if Assigned(FDosEnvList) then
 begin
 while i < FDosEnvList.Count do
 begin
 Tmp := FDosEnvList[i];
 Inc(i);
 if Pos(Name, Tmp) = 1 then
 begin
 Delete(Tmp, 1, Len);
 if Tmp[1] = '=' then
 begin
 Delete(Tmp, 1, 1);
 Result := Tmp;
 i := FDosEnvList.Count; { конец while-цикла }
 end;
 end;
 end;
 end;
end;
procedure Register;
begin
 RegisterComponents('Dr.Bob', [TDosEnvironment]);
end;
end.
Source: http://delphiworld.narod.ru/
ID: 02214