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.