FAQ VCL
Windows

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: 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;


Как вызвать диалог "Завершение работы с Windows"?

SendMessage(FindWindow('Progman', 'Program Manager'),
            WM_CLOSE, 0, 0);


Как спрятать панель задач?

// Убрать панель задач
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;

При использовании материала - ссылка на сайт обязательна