Получение переменных окружения DOS. Способ 2

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: PCv>
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.
 
« Предыдущая статья   Следующая статья »