Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  161

•  TDictionary Custom Sort  3 337

•  Fast Watermark Sources  3 089

•  3D Designer  4 847

•  Sik Screen Capture  3 343

•  Patch Maker  3 553

•  Айболит (remote control)  3 658

•  ListBox Drag & Drop  3 015

•  Доска для игры Реверси  81 702

•  Графические эффекты  3 945

•  Рисование по маске  3 249

•  Перетаскивание изображений  2 629

•  Canvas Drawing  2 752

•  Рисование Луны  2 580

•  Поворот изображения  2 189

•  Рисование стержней  2 168

•  Paint on Shape  1 568

•  Генератор кроссвордов  2 235

•  Головоломка Paletto  1 767

•  Теорема Монжа об окружностях  2 229

•  Пазл Numbrix  1 685

•  Заборы и коммивояжеры  2 057

•  Игра HIP  1 282

•  Игра Go (Го)  1 230

•  Симулятор лифта  1 475

•  Программа укладки плитки  1 216

•  Генератор лабиринта  1 548

•  Проверка числового ввода  1 366

•  HEX View  1 497

•  Физический маятник  1 358

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Получение переменных окружения 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: 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 приложение

MozaaEXT DOS Emulator

Драйвер клавиатуры под DOS




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте