Получение переменных среды
Материал из 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