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
end
end {GetDosEnvStr};
procedure Register;
begin
RegisterComponents('Dr.Bob', [TDosEnvironment]);
end {Register};
end.
|
Получение переменных окружения DOS 2