|
|
Как определить сериальный
номер файловой системы
Как получить значения
переменных среды
Как определить запущено ли
приложение под Delphi
Определение буквы привода
CD-ROM
Как определить готовность
дисковода к работе
Вычисление тактовой частоты
процессора
Определение пути к папкам
операционной системы
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;
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
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;
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;
