Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

end;

{procedure setWallPaper(fileName:string);

begin

SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pChar(fileNAme), 0);

end;}

procedurerefreshWindowsDesktop;

begin

SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND, $A065, 0);

end;

proceduremouseEmul(absPoint:TPoint; up,down:boolean);

begin

//Положение курсора мыши задается в "абсолютных" координатах ("Mickeys"),

//где 65535 "Mickeys" равно ширине экрана.

absPoint.x := Round(absPoint.x * (65535 / Screen.Width));

absPoint.y := Round(absPoint.y * (65535 / Screen.Height));

{Переместим курсор мыши}

Mouse_Event(MOUSEEVENTF_ABSOLUTE orMOUSEEVENTF_MOVE, absPoint.x, absPoint.y, 0, 0);

ifdown thenMouse_Event(MOUSEEVENTF_ABSOLUTE orMOUSEEVENTF_LEFTDOWN, absPoint.x, absPoint.y, 0, 0);

ifup thenMouse_Event(MOUSEEVENTF_ABSOLUTE orMOUSEEVENTF_LEFTUP, absPoint.x, absPoint.y, 0, 0);

end;

//просимулировать нажатие клавиши мыши

procedureSendMouseClick(x,y:integer;wHandle:THandle);

begin

sendmessage(wHandle, WM_LBUTTONDOWN, MK_LBUTTON, x+(y shl16));

sendmessage(wHandle, WM_LBUTTONUP, MK_LBUTTON, x+(y shl16));

application.processMessages;

end;

proceduremonitorState(state:boolean);

begin

ifstate thenSendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, -1)

elseSendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, 0);

end;

procedureexecWait( constcomLine: string);

var

si:Tstartupinfo;

p:Tprocessinformation;

begin

fillChar(Si, SizeOf(Si), 0);

withSi do begin

cb := SizeOf(Si);

dwFlags := startf_UseShowWindow;

wShowWindow := 4;

end;

Createprocess( nil, pChar(comLine), nil, nil, false, Create_default_error_mode, nil, nil, si, p);

Waitforsingleobject(p.hProcess, infinite);

end;

procedureshellExec( constfileName: string);

begin

shellExecute(0, Nil, pChar(fileName), Nil, Nil, SW_NORMAL);

end;

procedureDelay(msecs : DWORD);

var

FirstTick : DWORD;

begin

FirstTick:=GetTickCount;

repeat

Application.ProcessMessages;

untilGetTickCount-FirstTick >= msecs;

end;

functionHDDSerialNum( constdrivePath: string{'C:\'}):integer;

var

SerialNum:Pdword;

a,b:Dword;

buffer: array[0..255] ofchar;

begin

result:=0;

new(SerialNum);

ifgetVolumeInformation(pChar(drivePath), buffer, sizeof(buffer), SerialNum, a, b, nil, 0) thenresult:=SerialNum^;

Dispose(SerialNum);

end;

//фактически определяется запущена ли сейчас среда Delphi

functionisDelphiRunning:boolean;

varH1, H2, H3, H4 : Hwnd;

const

A1 : array[0..12] ofchar = 'TApplication'#0;

A2 : array[0..15] ofchar = 'TAlignPalette'#0;

A3 : array[0..18] ofchar = 'TPropertyInspector'#0;

A4 : array[0..11] ofchar = 'TAppBuilder'#0;

begin

result:=false;

H1 := FindWindow(A1, nil);

H2 := FindWindow(A2, nil);

H3 := FindWindow(A3, nil);

H4 := FindWindow(A4, nil);

if(H1 <> 0) and(H2 <> 0) and(H3 <> 0) and(H4 <> 0) thenresult:=true;

end;

functiongetCdromPath: string;

var

w:dword;

Root: string;

i:integer;

begin

result:='';

w:=GetLogicalDrives;

Root := '#:\';

fori := 0 to25 do begin

Root[1] := Char(Ord('A')+i);

if(W and(1 shli))>0 then

ifGetDriveType(Pchar(Root)) = DRIVE_CDROM then begin

result:=Root;

exit;

end;

end;

end;

//Определение готовности дисковода к работе

functionDiskInDrive( constDrive: char): Boolean;

var

DrvNum: byte;

EMode: Word;

begin

result := false;

DrvNum := ord(Drive);

ifDrvNum >= ord('a') thendec(DrvNum, $20);

EMode := SetErrorMode(SEM_FAILCRITICALERRORS);

try

ifDiskSize(DrvNum-$40) <> -1 thenresult := true

elsemessagebeep(0);

finally

SetErrorMode(EMode);

end;

end;

functionsoundCardExists:boolean;

begin