Получение информации о системе

         Как определить сериальный номер файловой системы

         Как получить значения переменных среды

         Как определить запущено ли приложение под Delphi

         Определение буквы привода CD-ROM

         Как определить готовность дисковода к работе

         Вычисление размера каталога

         Вычисление тактовой частоты процессора

         Поиск звуковой платы

         Как определить дату BIOS

         Определение пути к папкам операционной системы

         Изменение системного времени

Как определить сериальный номер файловой системы

procedure TForm1.Button1Click(Sender: TObject);
var SerialNum: Pdword;
    a,b: Dword;
    buffer: array [0..255] of char;
begin
  new(SerialNum);
  if getVolumeInformation('c:\',buffer,sizeof(buffer),SerialNum,a,b,nil,0) then
    Label1.Caption:=IntToStr(SerialNum^);
  Dispose(SerialNum);
end;

Как получить значения переменных среды

procedure TForm1.Button1Click(Sender: TObject);
var ptr: PChar;
    s: string;
    Done: boolean;
begin
  ptr := GetEnvironmentStrings;
  Done := FALSE;
  s:='';
  while not Done do begin
    if ptr^ = #0 then begin
      inc(ptr);
      if ptr^ = #0 then 
        Done := TRUE
      else
        s:=s+ptr^;
    end else
      s:=s+ptr^;
    inc(ptr);
  end;
  Form1.Label1.Caption:=s;
end;

Как определить запущено ли приложение под Delphi

procedure TForm1.Button1Click(Sender: TObject);
var H1, H2, H3, H4 : Hwnd;
    s: string;
const
  A1 : array[0..12] of char = 'TApplication'#0;
  A2 : array[0..15] of char = 'TAlignPalette'#0;
  A3 : array[0..18] of char = 'TPropertyInspector'#0;
  A4 : array[0..11] of char = 'TAppBuilder'#0;
begin
  H1:=FindWindow(A1, nil);
  H2:=FindWindow(A2, nil);
  H3:=FindWindow(A3, nil);
  H4:=FindWindow(A4, nil);
  s:='No';
  if (H1 <> 0) and (H2 <> 0) and (H3 <> 0) and (H4 <> 0) then 
    s:='Yes';
  Form1.Label1.Caption:=s;
end;
// фактически определяется запущена ли сейчас среда Delphi

Определение буквы привода CD-ROM

procedure TForm1.Button1Click(Sender: TObject);
var w: dword; 
    Root: string;
    i: integer;
begin
  w:=GetLogicalDrives;
  Root:='#:\';
  for i:=0 to 25 do begin
    Root[1] := Char(Ord('A')+i);
    if (W and (1 shl i))>0 then
      if GetDriveType(Pchar(Root)) = DRIVE_CDROM then
        Form1.Label1.Caption:=Root;
  end;
end;

Как определить готовность дисковода к работе

function DiskInDrive(const Drive: char): Boolean;
var DrvNum: byte;
    EMode: Word;
begin
  Result := False;
  DrvNum := ord(Drive);
  if DrvNum >= ord('a') then dec(DrvNum,$20);
  EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if DiskSize(DrvNum-$40) <> -1 then
      Result := True
    else 
      MessageBeep(0);
  finally
    SetErrorMode(EMode);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var s: string;
begin
  if DiskInDrive('A') then 
    s:='Drive is Ready'
  else
    s:='Drive is not Ready';
  Form1.Label1.Caption:=s;
end;

Вычисление размера каталога

uses FileCtrl;

function DirSize(Dir:string): integer;
var SearchRec: TSearchRec;
    Separator: string;
    DirBytes: integer;
begin
  Result:=-1;
  if Copy(Dir,Length(Dir),1)='\' then
    Separator := ''
  else 
    Separator := '\';
  if FindFirst(Dir+Separator+'*.*',faAnyFile,SearchRec) = 0 then begin
    if FileExists(Dir+Separator+SearchRec.Name) then 
      DirBytes := DirBytes + SearchRec.Size
    else if DirectoryExists(Dir+Separator+SearchRec.Name) then begin
      if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
        DirSize(Dir+Separator+SearchRec.Name);
    end;
    while FindNext(SearchRec) = 0 do begin
      if FileExists(Dir+Separator+SearchRec.Name) then 
        DirBytes := DirBytes + SearchRec.Size
      else if DirectoryExists(Dir+Separator+SearchRec.Name) then begin
        if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
          DirSize(Dir+Separator+SearchRec.Name);
      end;
    end;
  end;
  FindClose(SearchRec);
  Result:=DirBytes;
end;

procedure TForm1.Button1Click(Sender: TObject);
var DirBytes: integer;
begin
  DirBytes:=DirSize('c:\windows');
  Form1.Label1.Caption:=IntToStr(DirBytes);
end;

Вычисление тактовой частоты процессора

function GetCPUSpeed: double;
const DelayTime = 500; // время измерения в миллисекундах
var TimerHi, TimerLo: DWORD;
    PriorityClass, Priority: integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  Sleep(10);
  asm
    dw 310Fh // rdtsc
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh // rdtsc
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000.0 * DelayTime);
end;

begin
  LabelCPUSpeed.Caption := Format('CPU speed: %f MHz', [GetCPUSpeed]);
end;

Поиск звуковой платы

uses MMsystem;

begin
  if WaveOutGetNumDevs>0 then 
    Result:='Yes'
  else 
    Result:='No';
end;

Как определить дату BIOS

function GetBIOSDate: string;
type Ts=array[0..8] of char;
var s:TS;
    p:^TS;
begin
  s:='';
  p:=@s;
  asm
    push esi
    push edi
    push ecx
    mov esi,$0ffff5
    mov edi,p
    mov cx,8
@@1:mov al,[esi]
    mov [edi],al
    inc edi
    inc esi
    loop @@1
    pop ecx
    pop edi
    pop esi
  end;
  s[8]:=#0;
  Result:=PChar(s[0]);
end;

Определение пути к папкам операционной системы

uses Registry, Windows;

function GetFolder: string;
var Folder:string;
    Reg: TRegistry;
begin
  Reg:=TRegistry.Create;
  try
    // подставить имя нужной папки
    Folder:='StartUp'; //Cache,Cookies,Desktop,Favorites,Fonts,
                       //Personal,Programs,SendTo,Start Menu,Startp
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion'+
                '\Explorer\Shell Folders', False);
    Result:=Registry.ReadString('StartUp');
  finally
    Reg.Free;
  end;
end;

Изменение системного времени

function SetTime(DateTime:TDateTime): boolean;
var st: TSystemTime;
    ZoneTime: TTimeZoneInformation;
begin
  GetTimeZoneInformation(ZoneTime);
  DateTime:=DateTime+ZoneTime.Bias/1440;
  with st do begin
    DecodeDate(DateTime,wYear,wMonth,wDay);
    DecodeTime(DateTime,wHour,wMinute,wSecond,wMilliseconds);
  end;
  Result:=SetSystemTime(st);
end;