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

Содержание материала

Code:

procedure GetEnvironmentStrings(ss: TStrings);

{Переменные среды}

var

ptr: PChar;

s: string;

Done: boolean;

begin

ss.Clear;

s := '';

Done := FALSE;

ptr := windows.GetEnvironmentStrings;

while Done = false 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;

Code:

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;

Функция GetEnvironmentStrings возвращает адрес памяти со средой текущего процесса. Все переменные возвращаются в виде строк, оканчивающихся нулем. Набор строк терминируется двумя нулями.

Функция GetEnvironmentVariable возвращает значения переменных среды опрашиваемого процесса. Величина также возвращается в виде строки с завершающим нулем.

Code:

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 объявления }

function GetDosEnvStr(const Name: string): string;

{ Данная функция является измененной версией функции GetEnvVar,

присутствующей в поставляемом с Delphi модуле WinDos. Она

использует паскалевские строки вместо строк с терминирующим нулем.

}

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 {Create};

destructor TDosEnvironment.Destroy;

begin

FDosEnvList.Free;

FDosEnvList := nil;

inherited Destroy

end {Destroy};

procedure TDosEnvironment.DoNothing(const Value: TStringList);

begin

MessageDlg('TDosEnvironment.DosEnvList только для чтения!', mtInformation,

[mbOk], 0)

end {DoNothing};

function TDosEnvironment.GetDosEnvCount: Word;

{ Возвращает количество переменных окружения.

}

begin

if Assigned(FDosEnvList) then {!!}

Result := FDosEnvList.Count

else

Result := 0;

end {GetDosEnvCount};

function TDosEnvironment.GetDosEnvStr(const Name: string): string;

{ Данная функция является измененной версией функции GetEnvVar,

присутствующей в поставляемом с Delphi модуле WinDos. Она

использует паскалевские строки вместо строк с терминирующим нулем.

}

var

i: Integer;

Tmp: string;

Len: Byte absolute Name;

begin

i := 0;

Result := '';

if Assigned(FDosEnvList) then {!!}

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 {GetDosEnvStr};

procedure Register;

begin

RegisterComponents('Dr.Bob', [TDosEnvironment]);

end {Register};

end.

Новые статьи

Как раскрыть строки переменных окружения

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