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

Материал из DRKB

Получение переменных среды[править | править код]

{ Переменные среды }
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