|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как программно нажать на кнопку "Пуск"?
// Способ первый
SendMessage( GetWindow( FindWindow( 'Shell_TrayWnd', nil ), GW_CHILD ),
WM_LBUTTONDOWN, MK_LBUTTON, LOWORD( 5 ) + HIWORD( 20 ) );
// Способ второй
SendMessage( Self.Handle, WM_SYSCOMMAND, SC_TASKLIST, 0 );
|
Как узнать стиль картинки рабочего стола "По центру/Рядом/Растянуть"?
uses
Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
TileWallpaper: string;
WallpaperStyle: string;
begin
Reg := TRegIniFile.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('Control Panel\Desktop', False);
TileWallpaper := Reg.ReadString('TileWallpaper');
WallpaperStyle := Reg.ReadString('WallpaperStyle');
finally
Reg.CloseKey;
Reg.Free;
end;
case StrToInt(TileWallpaper) of
0: case StrToInt(WallpaperStyle) of
0: Edit1.Text := 'По центру';
2: Edit1.Text := 'Растянуть';
end;
1: if StrToInt(WallpaperStyle) = 0 then
Edit1.Text := 'Рядом';
else
Edit1.Text := 'Без понятия';
end;
end;
|
Как заставить рабочий стол Windows обновится?
// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
Desktop: HWND;
begin
Desktop := FindWindow('Progman', 'Program Manager');
Desktop := FindWindowEx(Desktop, 0, 'SHELLDLL_DefView', '');
Desktop := FindWindowEx(Desktop, 0, 'SysListView32', '');
PostMessage(Desktop, WM_KEYDOWN, VK_F5, 0);
PostMessage(Desktop, WM_KEYUP, VK_F5, 1 shl 31);
end;
// Способ второй
uses
ShlObj, ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
ActiveDesktop: IActiveDesktop;
begin
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;
// Способ третий
uses
ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
begin
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;
|
Как определить размер рабочего стола?
// Размер рабочего стола без Тaskbar'а
procedure TForm1.Button1Click(Sender: TObject);
var
r: TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
Memo1.Lines.Add(IntToStr(r.Top));
Memo1.Lines.Add(IntToStr(r.Left));
Memo1.Lines.Add(IntToStr(r.Bottom));
Memo1.Lines.Add(IntToStr(r.Right));
end;
|
Как спрятать панель задач?
// Убрать панель задач
procedure TForm1.Button1Click(Sender: TObject);
var
TaskBar: HWND;
begin
TaskBar := FindWindow('Shell_TrayWnd', nil);
ShowWindow(TaskBar, SW_HIDE);
end;
// Вернуть панель задач
procedure TForm1.Button2Click(Sender: TObject);
var
TaskBar: HWND;
begin
TaskBar := FindWindow('Shell_TrayWnd', nil);
ShowWindow(TaskBar, SW_SHOW);
end;
|
Как узнать версию Windows?
// Способ первый
// Win95 или выше и NT3.5 или выше
function GetWinVer: string;
var
temp1, temp2, temp3: Integer;
OsVer: OSVERSIONINFO;
begin
OsVer.dwOSVersionInfoSize := SizeOf(OSVERSIONINFO);
GetVersionEx(OsVer);
temp1 := OsVer.dwMajorVersion;
temp2 := OsVer.dwMinorVersion;
temp3 := OsVer.dwPlatformId;
if temp1 = 4 then
if temp2 = 0 then
if temp3 = VER_PLATFORM_WIN32_WINDOWS then
Result := 'Windows 95';
if temp1 = 4 then
if temp2 = 10 then
Result := 'Windows 98';
if temp1 = 4 then
if temp2 = 90 then
Result := 'Windows Me';
if temp1 = 3 then
if temp2 = 51 then
Result := 'Windows NT 3.51';
if temp1 = 4 then
if temp2 = 0 then
Result := 'Windows NT 4.0';
if temp1 = 5 then
if temp2 = 0 then
Result := 'Windows 2000';
if temp1 = 5 then
if temp2 = 1 then
Result := 'Windows XP';
if temp1 = 6 then
if temp2 = 0 then
Result := 'Windows Vista';
if temp1 = 6 then
if temp2 = 1 then
Result := 'Windows 7';
end;
// Способ второй
{True = Win9x, False = NT}
function isWin9x: Bool;
asm
xor eax, eax
mov ecx, cs
xor cl, cl
jecxz @@quit
inc eax
@@quit:
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if isWin9x then
Form1.Caption := 'Win9x'
else
Form1.Caption := 'WinNT';
end;
// Способ третий
procedure TForm1.FormCreate(Sender: TObject);
begin
case Win32Platform of
VER_PLATFORM_WIN32s: ShowMessage('System is Win32s');
VER_PLATFORM_WIN32_WINDOWS: ShowMessage('System is Windows 95');
VER_PLATFORM_WIN32_NT: ShowMessage('System is Windows NT');
end;
end;
// Способ четвертый
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
s := 'Win32Platform = ' + IntToStr(Win32Platform) + #13 +
'Win32MajorVersion = ' + IntToStr(Win32MajorVersion) + #13 +
'Win32MinorVersion = ' + IntToStr(Win32MinorVersion) + #13 +
'Win32BuildNumber = ' + IntToStr(Win32BuildNumber);
ShowMessage(s);
end;
// Способ пятый
procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckWin32Version(6, 1) then
ShowMessage('Windows 7')
else
if CheckWin32Version(6, 0) then
ShowMessage('Windows Vista')
else
if CheckWin32Version(5, 1) then
ShowMessage('Windows XP')
else
if CheckWin32Version(5, 0) then
ShowMessage('Windows 2000');
end;
// Способ шестой
uses
ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
WshShell: Variant;
begin
WshShell := CreateOleObject('WScript.Shell');
try
ShowMessage(WshShell.RegRead('HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName'));
ShowMessage(WshShell.RegRead('HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\EditionID'));
finally
WshShell := Unassigned;
end;
end;
// Способ седьмой
uses
Registry;
procedure TForm1.Button4Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create({KEY_READ or} KEY_WOW64_64KEY);
Reg.RootKey := HKEY_LOCAL_MACHINE;
try
Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion');
ShowMessage(Reg.ReadString('ProductName'));
ShowMessage(Reg.ReadString('EditionID'));
ShowMessage(Reg.ReadString('ProductId'));
finally
Reg.CloseKey;
Reg.Free;
end;
end;
// Способ восьмой
type
SizeZZ = {$IFDEF CPUX64}UInt64{$ELSE}LongWord{$ENDIF}; //NativeUInt;
function GetPEB: SizeZZ;
asm
{$IFDEF CPUX64}
MOV RAX, GS:[60h]
{$ELSE}
MOV EAX, FS:[30h]
{$ENDIF}
end;
//function GetUSD: SizeZZ;
//asm
// {$IFDEF CPUX64}
// MOV RAX, 7FFE0000h
// {$ELSE}
// MOV EAX, 7FFE0000h
// {$ENDIF}
//end;
function GetTEB: SizeZZ;
asm
{$IFDEF CPUX64}
MOV RAX, GS:[30h]
{$ELSE}
MOV EAX, FS:[18h]
{$ENDIF}
end;
function OSinfo: string;
var
dwMajorVersion,
dwMinorVersion,
dwBuildNumber,
wProductType,
dwPlatformId: Cardinal;
Peb, Usd: SizeZZ;
NtSystemRoot: PWideChar;
Is64: string;
begin
{$IFDEF CPUX64}
Is64 := 'x64';
{$ELSE}
if PCardinal(GetTEB+$C0)^ = 0 then
Is64 := 'x32'
else
Is64 := 'x64';
{$ENDIF}
Peb := GetPEB;
{$IFDEF CPUX64}
dwMajorVersion := PCardinal(Peb+$118)^;
dwMinorVersion := PCardinal(Peb+$11C)^;
dwBuildNumber := PCardinal(Peb+$120)^;
dwPlatformId := PCardinal(Peb+$124)^;
{$ELSE}
dwMajorVersion := PCardinal(Peb+$A4)^;
dwMinorVersion := PCardinal(Peb+$A8)^;
dwBuildNumber := PCardinal(Peb+$AC)^;
dwPlatformId := PCardinal(Peb+$B0)^;
{$ENDIF}
// Usd := GetUSD;
// wProductType := PCardinal(Usd+$264)^;
// NtSystemRoot := PWideChar(Usd+$30);
Result := 'Major = ' + IntToStr(dwMajorVersion) + #13 +
'Minor = ' + IntToStr(dwMinorVersion) + #13 +
'Build = ' + IntToStr(dwBuildNumber) + #13 +
'PlatID = ' + IntToStr(dwPlatformId) + #13 +
'CSD = ' + Is64;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(OSinfo);
end;
// Способ девятый
function GetVersionPEB: Word;
asm
{$IFDEF WIN32}
mov edx, fs:[30h]
mov eax, [edx+0A4h]
shl eax, 8
mov al, [edx+0A8h]
{$ELSE IFDEF WIN64}
mov rdx, qword ptr GS:[abs $60]
mov eax, [rdx+118h]
shl eax, 8
mov al, [rdx+11Ch]
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
var
WinVer: Word;
Major, Minor: Byte;
begin
WinVer := GetVersionPEB;
Major := HiByte(WinVer);
Minor := LoByte(WinVer);
ShowMessage(IntToStr(Major) + '.' + IntToStr(Minor));
end;
procedure TForm1.Button2Click(Sender: TObject);
type
TWinVer = record
case Integer of
0: (Version: Word);
1: (Minor, Major: Byte);
end;
var
WinVer: TWinVer;
begin
WinVer.Version := GetVersionPEB;
ShowMessage(IntToStr(WinVer.Major) + '.' + IntToStr(WinVer.Minor));
end;
procedure TForm1.Button3Click(Sender: TObject);
type
TWinVer = record
Minor, Major: Byte;
end;
var
Ver: Word;
WinVer: TWinVer absolute Ver;
begin
Ver := GetVersionPEB;
ShowMessage(IntToStr(WinVer.Major) + '.' + IntToStr(WinVer.Minor));
end;
// Способ десятый
type
TRtlGetVersion = function(var RTL_OSVERSIONINFOEXW): LONG; stdcall;
procedure TForm1.Button1Click(Sender: TObject);
var
RtlGetVersion: TRtlGetVersion;
ver: RTL_OSVERSIONINFOEXW;
begin
@RtlGetVersion := GetProcAddress(GetModuleHandle('ntdll.dll'), 'RtlGetVersion');
if Assigned(RtlGetVersion) then
begin
ZeroMemory(@ver, SizeOf(ver));
ver.dwOSVersionInfoSize := SizeOf(ver);
if RtlGetVersion(ver) = 0 then
ShowMessage(Format('RtlGetVersion: %d.%d'#13'%s',
[ver.dwMajorVersion, ver.dwMinorVersion, ver.szCSDVersion]));
end;
end;
// Способ одиннадцатый
type
NET_API_STATUS = DWORD;
_SERVER_INFO_101 = record
sv101_platform_id: DWORD;
sv101_name: LPWSTR;
sv101_version_major: DWORD;
sv101_version_minor: DWORD;
sv101_type: DWORD;
sv101_comment: LPWSTR;
end;
SERVER_INFO_101 = _SERVER_INFO_101;
PSERVER_INFO_101 = ^SERVER_INFO_101;
LPSERVER_INFO_101 = PSERVER_INFO_101;
function NetServerGetInfo(servername: LPWSTR; level: DWORD; var bufptr): NET_API_STATUS;
stdcall; external 'Netapi32.dll';
function NetApiBufferFree(Buffer: LPVOID): NET_API_STATUS; stdcall; external 'Netapi32.dll';
const
MAJOR_VERSION_MASK = $0F;
procedure TForm1.Button1Click(Sender: TObject);
var
Buffer: PSERVER_INFO_101;
begin
if NetServerGetInfo(nil, 101, Buffer) = NO_ERROR then
try
// Выдает данные реальной ОС из режима совместимости
ShowMessage(Format('NetServerGetInfo: %d.%d',
[Buffer.sv101_version_major and MAJOR_VERSION_MASK, Buffer.sv101_version_minor]));
finally
NetApiBufferFree(Buffer);
end;
end;
// Способ двенадцатый
type
WKSTA_INFO_100 = record
wki100_platform_id: DWORD;
wki100_computername: LPWSTR;
wki100_langroup: LPWSTR;
wki100_ver_major: DWORD;
wki100_ver_minor: DWORD;
end;
LPWKSTA_INFO_100 = ^WKSTA_INFO_100;
function NetWkstaGetInfo(ServerName: LPWSTR; Level: DWORD;
BufPtr: Pointer): Longint; stdcall;
external 'netapi32.dll' Name 'NetWkstaGetInfo';
function GetNetParam(AParam: Integer): string;
var
PBuf: LPWKSTA_INFO_100;
Res: LongInt;
begin
Result := '';
Res := NetWkstaGetInfo(nil, 100, @PBuf);
if Succeeded(Res) then
begin
case AParam of
0: Result := String(PBuf^.wki100_computername);
1: Result := String(PBuf^.wki100_langroup);
2: Result := Format('%d.%d', [PBuf^.wki100_ver_major, PBuf^.wki100_ver_minor]);
end;
end;
end;
function GetComputerName: string;
begin
Result := GetNetParam(0);
end;
function GetDomainName: string;
begin
Result := GetNetParam(1);
end;
function GetWindowsVersion: string;
begin
Result := GetNetParam(2);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Выдает данные реальной ОС из режима совместимости
ShowMessage(GetWindowsVersion);
end;
|
Как получить список всех запущенных приложений?
procedure TForm1.Button1Click(Sender: TObject);
var
Wnd: hWnd;
buff: array [0..127] of Char;
begin
ListBox1.Clear;
// Получаем hWnd первого окна
Wnd := GetWindow(Handle, gw_HWndFirst);
// Цикл поиска окон
while Wnd <> 0 do
begin
// Исключаем невидимые окна
if IsWindowVisible(Wnd) and
// Исключаем дочернии окна
(GetWindow(Wnd, gw_Owner) = 0) and
// Исключаем окна без заголовков
(GetWindowText(Wnd, buff, SizeOf(buff)) <> 0) then
begin
GetWindowText(Wnd, buff, SizeOf(buff));
ListBox1.Items.Add(StrPas(buff));
end;
// Ищем следующее окно
Wnd := GetWindow(Wnd, GW_HWNDNEXT);
end;
ListBox1.ItemIndex := 0;
end;
|
Как узнать, отключена перерисовка окна при его перетаскивании или нет?
// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
b: BOOL;
begin
SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @b, 0);
if b then
ShowMessage('Перерисовка включена')
else
ShowMessage('Перерисовка отключена');
end;
// Способ второй
uses
Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
temp: string;
DragFull: Byte;
begin
with TRegistry.Create do
begin
RootKey := HKEY_CURRENT_USER;
OpenKey('Control Panel\Desktop', False);
DragFull := StrToInt(ReadString('DragFullWindows'));
case DragFull of
0: ShowMessage('Перерисовка отключена');
1: ShowMessage('Перерисовка включена');
end;
CloseKey;
Free;
end;
end;
|
Как узнать, сколько времени работает Windows?
// Вариант первый
// Timer1.Interval = 1000
procedure TForm1.Timer1Timer(Sender: TObject);
var
Time, h, m, s: Integer;
begin
Time := GetMessageTime div 1000;
s := Time mod 60;
m := (Time div 60) mod 60;
h := (Time div 3600);
Form1.Caption := Format('%d:%.2d:%.2d', [h, m, s]);
end;
// Вариант второй
// Timer1.Interval = 1000
procedure TForm1.Timer1Timer(Sender: TObject);
var
Time, h, m, s: Integer;
begin
Time := GetTickCount div 1000;
s := Time mod 60;
m := (Time div 60) mod 60;
h := (Time div 3600);
Form1.Caption := Format('%d:%.2d:%.2d', [h, m, s]);
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|