procedure ApplicationList(formHandle: THandle; var stringList: TStringList);
var
nd : hWnd;
buff: ARRAY [0..127] OF Char;
begin
stringList.Clear;
Wnd := GetWindow(formHandle, gw_HWndFirst);
WHILE Wnd <> 0 DO BEGIN
{Не показываем:}
IF (Wnd <> Application.Handle) AND {-Собственное окно}
IsWindowVisible(Wnd) AND {-Невидимые окна}
(GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}
(GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-Окна без заголовков}
THEN BEGIN
GetWindowText(Wnd, buff, sizeof(buff));
stringList.Add(StrPas(buff));
END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
end;
procedure CDROMOpen;
begin
mciSendString('Set cdaudio door open wait', nil, 0, 0);
end;
procedure CDROMClose;
begin
mciSendString('Set cdaudio door closed wait', nil, 0, 0);
end;
//Запретить/разрешить Ctrl-Alt-Del
procedure CtrlAltDel(state:boolean);
var old:Boolean;
begin
old:=True;
if state then
//Восстановить
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @old, 0)
else
//Убрать
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @old, 0);
end;
procedure StartButton(visi:boolean);
Var
Tray, Child : hWnd;
C : Array[0..127] of Char;
S : String;
Begin
Tray := FindWindow('Shell_TrayWnd', NIL);
Child := GetWindow(Tray, GW_CHILD);
While Child <> 0 do Begin
If GetClassName(Child, C, SizeOf(C)) > 0 Then Begin
S := StrPAS(C);
If UpperCase(S) = 'BUTTON' then begin
If Visi then ShowWindow(Child, 1)
else ShowWindow(Child, 0);
end;
End;
Child := GetWindow(Child, GW_HWNDNEXT);
End;
End;
//убрать/показать TaskBar
procedure TaskBar(visi:boolean);
begin
if visi then ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW) // Показать Taskbar
else ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE); //Скрыть TaskBar
end;
procedure applicationInCtrlAltDelList(visi:boolean);
begin
if visi then begin
//Show
RegisterServiceProcess(GetCurrentProcessID, 0);
end else begin
//Hide
RegisterServiceProcess(GetCurrentProcessID, 1);
end;
end;
procedure applicationInTaskBar(visi:boolean);
begin
if visi then windows.ShowWindow(FindWindow(nil, @Application.Title[1]), SW_SHOW)
else windows.ShowWindow(FindWindow(nil, @Application.Title[1]), SW_HIDE);
end;
procedure RussianKbdLayout;//На русский
var Layout: array[0..KL_NAMELENGTH] of char;
begin
LoadKeyboardLayout(StrCopy(Layout, '00000419'), KLF_ACTIVATE);
end;
procedure EnglishKbdLayout;//На английский
var Layout: array[0..KL_NAMELENGTH] of char;
begin
LoadKeyboardLayout(StrCopy(Layout, '00000409'), KLF_ACTIVATE);
end;
procedure UkrainianKbdLayout;//На украинский
var Layout: array[0..KL_NAMELENGTH] of char;
begin
LoadKeyboardLayout(StrCopy(Layout, pChar(intToHex(LANG_UKRAINIAN+$400, 8))), KLF_ACTIVATE);
end;
//запустить текущий ScreenSaver
procedure RunCurrentScreenSaver;
begin
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
end;
//очистить меню "Документы"
procedure clearDocuments;
begin
SHAddToRecentDocs(SHARD_PATH, nil);
end;
//добавить документ в меню 'Документы'
// Для данного файла должно быть зарегистрировано средство просмотра
procedure addFileToDocuments(const fileName:string);
begin
SHAddToRecentDocs(SHARD_PATH, pchar(fileName));
end;
//Значение функции TRUE если мелкий шрифт
function SmallFonts:Boolean;
var DC:HDC;
begin
DC:=GetDC(0);
Result:=(GetDeviceCaps(DC, LOGPIXELSX) = 96);
{ В случае крупного шрифта будет 120}
ReleaseDC(0, DC);
end;
function DriveExists(Drive : Byte) : Boolean;
begin
Result := Boolean(GetLogicalDrives AND (1 SHL Drive))
end;
//'?';'Path does not exists';'Removable';'Fixed';'Remote';'CD-ROM';'RAMDISK'
function CheckDriveType(Drive : Byte) : String;
var
DriveLetter : Char;
DriveType : UInt;
begin
DriveLetter := Char(Drive + $41);
DriveType := GetDriveType(PChar(DriveLetter + ':\'));
Case DriveType of
0 : Result := '?';
1 : Result := 'Path does not exists';
DRIVE_REMOVABLE : Result := 'Removable';
DRIVE_FIXED : Result := 'Fixed';
DRIVE_REMOTE : Result := 'Remote';
DRIVE_CDROM : Result := 'CD-ROM';
DRIVE_RAMDISK : Result := 'RAMDISK'
Else Result := 'Unknown';
end;
end;
//GetVolumeInformation
function GetFileSysName(Drive : Byte) : String;
var
DriveLetter : Char;
NoMatter : DWORD;
FileSysName : Array[0..MAX_PATH] of Char;
begin
DriveLetter := Char(Drive + $41);
GetVolumeInformation(PChar(DriveLetter + ':\'), Nil, 0, nil, NoMatter, NoMatter, FileSysName, SizeOf(FileSysName));
Result := FileSysName;
end;
function GetVolumeName(Drive : Byte) : String;
var
DriveLetter : Char;
NoMatter : DWORD;
VolumeName : Array[0..MAX_PATH] of Char;
begin
DriveLetter := Char(Drive + $41);
GetVolumeInformation(PChar(DriveLetter + ':\'), VolumeName, SizeOf(VolumeName), nil, NoMatter, NoMatter, Nil, 0);
Result := VolumeName;
end;
procedure StartFromRegistry(appName,appPath:string);
var reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', true{canCreate});
reg.WriteString(appname, appPath);