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. |
ExpandEnvironmentStrings( LPCTSTR lpSrc, LPTSTR lpDst, DWORD nSize ); |
Procedure settime(hour, min, sec, hundreths : byte); assembler; asm mov ch, hour mov cl, min mov dh, sec mov dl, hundreths mov ah, $2d int $21 end; Procedure setdate(Year : word; Month, Day : byte); assembler; asm mov cx, year mov dh, month mov dl, day mov ah, $2b int $21 end; |
const TIME_ZONE_ID_UNKNOWN = 0; const TIME_ZONE_ID_STANDARD = 1; const TIME_ZONE_ID_DAYLIGHT = 2; |
procedure TForm1.Button1Click(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; |