if visi then begin
//Включение курсора
while CState<0 do CState:=ShowCursor(True);
end else begin
//Выключение курсора
while Cstate >= 0 do Cstate := ShowCursor(False);
end;
End;
//Cache,Cookies,Desktop,Favorites,Fonts,Personal,Programs,SendTo,Start Menu,Startup
function ShellFolder(const folderType:string):string;
var registry:TRegistry;
begin
result:='';
Registry := TRegistry.Create;
try
Registry.RootKey := HKey_Current_User;
Registry.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
result:= Registry.ReadString(folderType);
finally
Registry.Free;
end;
end;
procedure SetWallpaper(const fileName:string;tile:boolean);
var Reg: TRegIniFile;
begin
Reg:=TRegIniFile.Create('Control Panel');
Reg.WriteString('desktop', 'Wallpaper', fileName);
if tile then Reg.WriteString('desktop', 'TileWallpaper', '1')
else Reg.WriteString('desktop', 'TileWallpaper', '0');
Reg.Free;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;
{procedure setWallPaper(fileName:string);
begin
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pChar(fileNAme), 0);
end;}
procedure refreshWindowsDesktop;
begin
SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND, $A065, 0);
end;
procedure mouseEmul(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 or MOUSEEVENTF_MOVE, absPoint.x, absPoint.y, 0, 0);
if down then Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, absPoint.x, absPoint.y, 0, 0);
if up then Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, absPoint.x, absPoint.y, 0, 0);
end;
//просимулировать нажатие клавиши мыши
procedure SendMouseClick(x,y:integer;wHandle:THandle);
begin
sendmessage(wHandle, WM_LBUTTONDOWN, MK_LBUTTON, x+(y shl 16));
sendmessage(wHandle, WM_LBUTTONUP, MK_LBUTTON, x+(y shl 16));
application.processMessages;
end;
procedure monitorState(state:boolean);
begin
if state then SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, -1)
else SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, 0);
end;
procedure execWait(const comLine:string);
var
si:Tstartupinfo;
p:Tprocessinformation;
begin
fillChar(Si, SizeOf(Si), 0);
with Si 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;
procedure shellExec(const fileName:string);
begin
shellExecute(0, Nil, pChar(fileName), Nil, Nil, SW_NORMAL);
end;
procedure Delay(msecs : DWORD);
var
FirstTick : DWORD;
begin
FirstTick:=GetTickCount;
repeat
Application.ProcessMessages;
until GetTickCount-FirstTick >= msecs;
end;
function HDDSerialNum(const drivePath:string{'C:\'}):integer;
var
SerialNum:Pdword;
a,b:Dword;
buffer:array [0..255] of char;
begin
result:=0;
new(SerialNum);
if getVolumeInformation(pChar(drivePath), buffer, sizeof(buffer), SerialNum, a, b, nil, 0) then result:=SerialNum^;
Dispose(SerialNum);
end;
//фактически определяется запущена ли сейчас среда Delphi
function isDelphiRunning:boolean;
var H1, H2, H3, H4 : Hwnd;
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
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) then result:=true;
end;
function getCdromPath:string;
var
w:dword;
Root:string;
i:integer;
begin
result:='';
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 begin
result:=Root;
exit;
end;
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;
function soundCardExists:boolean;
begin
if WaveOutGetNumDevs>0 then result:=true
else result:=false;
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);
SendMessage(HWND_TOPMOST, WM_TIMECHANGE, 0, 0);
end;
//Окно без закладки в TaskBar
procedure noAppInTaskbar;
begin
ShowWindow(Application.Handle, sw_Hide);
end;
//Определение какие приложения уже запущены