FAQ VCL
Windows

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

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

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как определить язык (локализацию) Windows?

// Способ первый
function WhichLanguage: string;
var
  ID: LangID;
  Language: array [0..100] of Char;
begin
  ID := GetSystemDefaultLangID;
  // Другие варианты:
  // ID := GetUserDefaultLangID;
  // ID := GetSystemDefaultLCID;
  VerLanguageName(ID, Language, 100);
  Result := string(Language);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := WhichLanguage;
end;

// Способ второй
function GetSystemDefaultUILanguage: UINT; stdcall;
  external kernel32 name 'GetSystemDefaultUILanguage';

implementation

{...}

function GetSysLang: Integer;
begin
  Result := Lo(GetSystemDefaultUILanguage);
end;

// Таблица языков есть в MSDN: http://msdn.microsoft.com/ru-ru/library/ee491651.aspx
// Ниже приведено частичное описание:
// 00 - LANG_NEUTRAL - Neutral
// 01 - LANG_ARABIC - Arabic
// 02 - LANG_BULGARIAN - Bulgarian
// 03 - LANG_CATALAN - Catalan
// 04 - LANG_CHINESE - Chinese
// 05 - LANG_CZECH - Czech
// 06 - LANG_DANISH - Danish
// 07 - LANG_GERMAN - German
// 08 - LANG_GREEK - Greek
// 09 - LANG_ENGLISH - English
// 0a - LANG_SPANISH - Spanish
// 0b - LANG_FINNISH - Finnish
// 0c - LANG_FRENCH - French
// 0d - LANG_HEBREW - Hebrew
// 0e - LANG_HUNGARIAN - Hungarian
// 0f - LANG_ICELANDIC - Icelandic
// 10 - LANG_ITALIAN - Italian
// 11 - LANG_JAPANESE - Japanese
// 12 - LANG_KOREAN - Korean
// 13 - LANG_DUTCH - Dutch
// 14 - LANG_NORWEGIAN - Norwegian
// 15 - LANG_POLISH - Polish
// 16 - LANG_PORTUGUESE - Portuguese
// 18 - LANG_ROMANIAN - Romanian
// 19 - LANG_RUSSIAN - Russian
// 1a - LANG_CROATIAN - Croatian
// 1a - LANG_SERBIAN - Serbian
// 1b - LANG_SLOVAK - Slovak
// 1c - LANG_ALBANIAN - Albanian
// 1d - LANG_SWEDISH - Swedish
// 1e - LANG_THAI - Thai
// 1f - LANG_TURKISH - Turkish
// 20 - LANG_URDU - Urdu 
// 21 - LANG_INDONESIAN - Indonesian
// 22 - LANG_UKRAINIAN - Ukrainian
// 23 - LANG_BELARUSIAN - Belarusian
// 24 - LANG_SLOVENIAN - Slovenian
// 25 - LANG_ESTONIAN - Estonian
// 26 - LANG_LATVIAN - Latvian
// 27 - LANG_LITHUANIAN - Lithuanian
// 29 - LANG_FARSI - Farsi
// 2a - LANG_VIETNAMESE - Vietnamese
// 2b - LANG_ARMENIAN - Armenian
// 2c - LANG_AZERI - Azeri
// 2d - LANG_BASQUE - Basque
// 2f - LANG_MACEDONIAN - FYRO - Macedonian
// 36 - LANG_AFRIKAANS - Afrikaans
// 37 - LANG_GEORGIAN - Georgian
// 38 - LANG_FAEROESE - Faeroese
// 39 - LANG_HINDI - Hindi
// 3e - LANG_MALAY - Malay
// 3f - LANG_KAZAK - Kazak
// 40 - LANG_KYRGYZ - Kyrgyz
// 41 - LANG_SWAHILI - Swahili
// 43 - LANG_UZBEK - Uzbek
// 44 - LANG_TATAR - Tatar
// 45 - LANG_BENGALI - Bengali.
// 46 - LANG_PUNJABI - Punjabi
// 47 - LANG_GUJARATI - Gujarati
// 48 - LANG_ORIYA - Not - supported.
// 49 - LANG_TAMIL - Tamil
// 4a - LANG_TELUGU - Telugu
// 4b - LANG_KANNADA - Kannada
// 4c - LANG_MALAYALAM - Not - supported.
// 4d - LANG_ASSAMESE - Assamuse
// 4e - LANG_MARATHI - Marathi
// 4f - LANG_SANSKRIT - Sanskrit
// 50 - LANG_MONGOLIAN - Mongolian
// 56 - LANG_GALICIAN - Galician
// 57 - LANG_KONKANI - Konkani
// 58 - LANG_MANIPURI - Not - supported.
// 59 - LANG_SINDHI - Not - supported.
// 5a - LANG_SYRIAC - Syriac
// 5e - LANG_AMHARIC - Amharic
// 60 - LANG_KASHMIRI - Not - supported.
// 61 - LANG_NEPALI - Not - supported.
// 65 - LANG_DIVEHI - Divehi
// 6d - LANG_BASHKIR - Bashkir
// 7e - LANG_BRETON - Breton
// 7f - LANG_INVARIANT - Invariant
// 84 - LANG_ALSATIAN - Alsatian

procedure TForm1.Button1Click(Sender: TObject);
var
  ID: LangID;
  Language: array [0..100] of Char;
begin
  VerLanguageName(GetSysLang, Language, 100);
  ShowMessage(Language);
end;


Как раскрыть строки с подстановками вида '%SystemRoot%\IOSUBSYS\'?

function RunMacro(const Macro: string): string;
var
  p: array[0..4096] of Char;
begin
  Result := Macro;
  ExpandEnvironmentStrings(PChar(Result), p, SizeOf(p));
  Result := p;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(RunMacro('%SystemRoot%\IOSUBSYS\'));
end;


Как узнать путь к папке где хранятся временные файлы?

// Способ первый
function TempPath: string;
var
  i: Integer;
begin
  SetLength(Result, MAX_PATH);
  i := GetTempPath(Length(Result), PChar(Result));
  SetLength(Result, i);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(TempPath);
end;

// Способ второй
function TempPath: string;
var
  pStr: PChar;
begin
  pStr := StrAlloc(MAX_PATH+1);
  GetTempPath(MAX_PATH+1, pStr);
  Result := pStr;
  if pStr <> nil then
    StrDispose(pStr);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(TempPath);
end;

// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetEnvironmentVariable('TEMP'));
end;


Как получить список процессов?

uses
  {...,} TlHelp32;

procedure TForm1.Button1Click(Sender: TObject);
var
  hSnap: THandle;
  pe: TProcessEntry32;
begin
  ListBox1.Clear;
  pe.dwSize := SizeOf(pe);
  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Process32First(hSnap, pe) then
  begin
    ListBox1.Items.Add(pe.szExeFile);
    while Process32Next(hSnap, pe) do
      ListBox1.Items.Add(pe.szExeFile);
  end;
end;


Как получить переменные среды?

procedure GetEnvironmentStrings(st: TStrings);
var
  ptr: PChar;
  s: string;
  done: Boolean;
begin
  st.Clear;
  s := '';
  done := False;
  ptr := Windows.GetEnvironmentStrings;
  while not done do
  begin
    if ptr^ = #0 then
    begin
      Inc(ptr);
      if ptr^ = #0 then
        done := True
      else
        st.Add(s);
      s := ptr^;
    end
    else
      s := s + ptr^;
    Inc(ptr);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetEnvironmentStrings(Memo1.Lines);
end;


Как узнать, откуда была установлена Windows?

uses
  {...,} Registry;

function GetWindowsSetupPath: string;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\SETUP', False);
    Result := Reg.ReadString('SourcePath');
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetWindowsSetupPath);
end;


Как узнать путь к каталогам Windows?

// Способ первый
uses
  {...,} Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  reg: TRegistry;
  ts: TStrings;
  i: Integer;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CURRENT_USER;
  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
  ts := TStringList.Create;
  reg.GetValueNames(ts);
  for i := 0 to ts.Count-1 do
    Memo1.Lines.Add(ts.Strings[i] + ' = ' + reg.ReadString(ts.Strings[i]));
  ts.Free;
  reg.CloseKey;
  reg.Free;
end;

// Способ второй
uses
  SHFolder;

procedure TForm1.Button1Click(Sender: TObject);
var
  Buffer: array[0..MAX_PATH] of Char;
begin
  if SHGetFolderPath(0, CSIDL_APPDATA, 0, 0, Buffer) = 0 then
    ShowMessage(Buffer);
end;

// Способ третий
uses
  {...,} ShlObj;

function GetSpecialPath(CSIDL: Word): PChar;
var
  s: string;
begin
  SetLength(s, MAX_PATH);
  if not SHGetSpecialFolderPath(0, PChar(s), CSIDL, False) then
    s := '';
  Result := PChar(s);
end;

// или немного иначе
function GetSpecialPath(CSIDL: Word): PChar;
var
  Path: PWideChar;
  PIDL: PItemIDList;
begin
  Result := '';
  Path := StrAlloc(MAX_PATH);
  SHGetSpecialFolderLocation(0, CSIDL_RECENT, PIDL);
  // Возвращает False если папка не является частью файловой системы
  if SHGetPathFromIDList(PIDL, Path) then
    Result := PChar(Copy(Path, 0, Length(Path)));
  StrDispose(Path);
end;

// Функции нужно передать id папки, путь которой хотим получить.
// Нужно учитывать, что не все id будуть работать в разных версиях Windows.
// Например папки 'Documents & Settungs' нет в 98-х и бессмысленно пытаться получить путь к ней.
// Далее идет список id:
{
  // Следующие идентификаторы имеются в модуле ShlObj:
  CSIDL_DESKTOP                       = $0000;
  // Виртуальный каталог, представляющий Рабочий стол. (Корень в проводнике)
  CSIDL_INTERNET                      = $0001;
  // Виртуальный каталог для Internet Explorer.
  CSIDL_PROGRAMS                      = $0002;
  // Меню Пуск -> Программы
  CSIDL_CONTROLS                      = $0003;
  // Виртуальный каталог, содержащий иконки пунктов панели управления
  CSIDL_PRINTERS                      = $0004;
  // Виртуальный каталог, содержащий установленные принтеры
  CSIDL_PERSONAL                      = $0005;
  // Виртуальный каталог, представляющий папку "Мои документы"
  // До Vista ссылался на какталог "Мои документы" на жёстком диске
  CSIDL_FAVORITES                     = $0006;
  // Избранное. (обычно C:\Documents and Settings\username\Favorites)
  CSIDL_STARTUP                       = $0007;
  // Пуск -> Программы -> Автозагрузка
  CSIDL_RECENT                        = $0008;
  // Недавние документы (обычно C:\Documents and Settings\username\My Recent Documents
  // Для добавления ссылки документа используйте SHAddToRecentDocs
  CSIDL_SENDTO                        = $0009;
  // Папка, содержащая ярлыки меню "Отправить" (Sent to...) (обычно C:\Documents and Settings\username\SendTo)
  CSIDL_BITBUCKET                     = $000a;
  // Виртуальный каталог, содержащий файлы в корзине текущего пользователя
  CSIDL_STARTMENU                     = $000b;
  // Элементы меню Пуск текущего пользователя (обычно C:\Documents and Settings\username\Start Menu)
  CSIDL_DESKTOPDIRECTORY              = $0010;
  // Рабочий стол текущего пользователя (обычно C:\Documents and Settings\username\Desktop)
  CSIDL_DRIVES                        = $0011;
  // Виртуальный каталог, представляющий папку "Мой компьютер"
  CSIDL_NETWORK                       = $0012;
  // Виртуальный каталог, представляющий "Сетевое окружение"
  CSIDL_NETHOOD                       = $0013;
  // Папка "My Nethood Places" (обычно C:\Documents and Settings\username\NetHood)
  // В неё ссылки на избранные расшаренные ресурсы
  CSIDL_FONTS                         = $0014;
  // Папка, содержащая установленные шрифты. (обычно C:\Windows\Fonts)
  CSIDL_TEMPLATES                     = $0015;
  // Шаблоны документов. (Обычно Settings\username\Templates)
  CSIDL_COMMON_STARTMENU              = $0016;
  // Элементы меню Пуск для всех пользователей. (обычно C:\Documents and Settings\All Users\Start Menu)
  // Константы, начинающиеся на CSIDL_COMMON_ существуют только в NT версиях
  CSIDL_COMMON_PROGRAMS               = $0017;
  // Меню Пуск -> программы для всех пользователей (обычно C:\Documents and Settings\All Users\Start Menu\Programs)
  CSIDL_COMMON_STARTUP                = $0018;
  // Меню Пуск -> Программы -> Автозагрузка для всех пользователей (обычно C:\Documents and Settings\All Users\Start Menu\Programs\Startup)
  CSIDL_COMMON_DESKTOPDIRECTORY       = $0019;
  // Элементы Рабочего стола для всех пользователей (обычно C:\Documents and Settings\All Users\Desktop)
  CSIDL_APPDATA                       = $001a;
  // Папка, в которой рограммы должны хранить свои данные(C:\Documents and Settings\username\Application Data)
  CSIDL_PRINTHOOD                     = $001b;
  // Установленные принтеры. (обычно C:\Documents and Settings\username\PrintHood)
  CSIDL_ALTSTARTUP                = $001d;         // DBCS
  // user's nonlocalized Startup program group. Устарело.
  CSIDL_COMMON_ALTSTARTUP         = $001e;         // DBCS
  // Устарело
  CSIDL_COMMON_FAVORITES          = $001f;
  // Ссылки "Избранное" для всех пользователей
  CSIDL_INTERNET_CACHE            = $0020;
  // Временные Internet файлы (обычно C:\Documents and Settings\username\Local Settings\Temporary Internet Files)
  CSIDL_COOKIES                   = $0021;
  // Папка для хранения Cookies (обычно C:\Documents and Settings\username\Cookies)
  CSIDL_HISTORY                   = $0022;
  // Хранит ссылки интернет истории IE

  // Следующих идентификаторов нет в ShlObj:
  CSIDL_ADMINTOOLS                = $30;
  // Административные инструменты текущего пользователя (например консоль MMC). Win2000+
  CSIDL_CDBURN_AREA               = $3b;
  // Папка для файлов, подготовленных к записи на CD/DVD
  // (Обычно C:\Documents and Settings\username\Local Settings\Application Data\Microsoft\CD Burning)
  CSIDL_COMMON_ADMINTOOLS         = $2f;
  // Папка, содержащая инструменты администрирования
  CSIDL_COMMON_APPDATA            = $23;
  // Папака AppData для всех пользователей. (обычно C:\Documents and Settings\All Users\Application Data)
  CSIDL_COMMON_DOCUMENTS          = $2e;
  // Папка "Общие документы" (обычно C:\Documents and Settings\All Users\Documents)
  CSIDL_COMMON_TEMPLATES          = $2d;
  // Папка шаблонов документов для всех пользователей (Обычно C:\Documents and Settings\All Users\Templates)
  CSIDL_COMMON_MUSIC              = $35;
  // Папка "Моя музыка" для всех пользователей. (обычно C:\Documents and Settings\All Users\Documents\My Music)
  CSIDL_COMMON_PICTURES           = $36;
  // Папка "Мои рисунки" для всех пользователей. (обычно C:\Documents and Settings\All Users\Documents\My Pictures)
  CSIDL_COMMON_VIDEO              = $37;
  // Папка "Моё видео" для всех пользователей (C:\Documents and Settings\All Users\Documents\My Videos)
  CSIDL_COMPUTERSNEARME           = $3d;
  // Виртуальная папка, представляет список компьютеров в вашей рабочей группе
  CSIDL_CONNECTIONS               = $31;
  // Виртуальная папка, представляет список сетевых подключений
  CSIDL_LOCAL_APPDATA             = $1c;
  // AppData для приложений, которые не переносятся на другой компьютер (обычно C:\Documents and Settings\username\Local Settings\Application Data)
  CSIDL_MYDOCUMENTS               = $0c;
  // Виртуальный каталог, представляющий папку "Мои документы"
  CSIDL_MYMUSIC                   = $0d;
  // Папка "Моя музыка"
  CSIDL_MYPICTURES                = $27;
  // Папка "Мои картинки"
  CSIDL_MYVIDEO                   = $0e;
  // Папка "Моё видео"
  CSIDL_PROFILE                   = $28;
  // Папка пользователя (обычно C:\Documents and Settings\username)
  CSIDL_PROGRAM_FILES             = $26;
  // Папка Program Files (обычно C:\Program Files)
  CSIDL_PROGRAM_FILESX86          = $2a;
  //
  CSIDL_PROGRAM_FILES_COMMON      = $2b;
  // Папка Program Files\Common (обычно C:\Program Files\Common)
  CSIDL_PROGRAM_FILES_COMMONX86   = $2c;
  //
  CSIDL_RESOURCES                 = $38;
  // Папка для ресерсов. Vista и выше (обычно C:\Windows\Resources)
  CSIDL_RESOURCES_LOCALIZED       = $39;
  //
  CSIDL_SYSTEM                    = $25;
  // Папака System (обычно C:\Windows\System32 или C:\Windows\System)
  CSIDL_SYSTEMX86                 = $29;
  //
  CSIDL_WINDOWS                   = $24;
  // Папка Windows. Она же %windir% или %SYSTEMROOT% (обычно C:\Windows)
}


Как убить задачу, зная только имя EXE-файла?

// Способ первый
uses
  {...,} Tlhelp32;

function KillTask( ExeFileName: string ): integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;

  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0 ;
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while Integer(ContinueLoop) <> 0 do
  begin
    if (UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or
       (UpperCase( FProcessEntry32.szExeFile) = UpperCase(ExeFileName)) then
      Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;

  CloseHandle(FSnapshotHandle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  KillTask('calc.exe');
end;

// Способ второй
uses
  {...,} ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellExecute(0, nil, PChar('taskkill'), PChar('/IM calc.exe'), nil, SW_HIDE);
end;

// Способ третий
uses
  {...,} ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellExecute(0, 'open', PChar('cmd.exe'), PChar('/C taskkill.exe /IM calc.exe'), nil, SW_HIDE);
end;


Как перезагрузить Explorer?

// Способ первый
uses
  {...,} ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var
  wnd: HWND;
begin
  wnd := FindWindow('Progman', nil);
  PostMessage(wnd, WM_QUIT, 0, 0);
  ShellExecute(0, 'open', 'Explorer', nil, nil, SW_SHOWNORMAL);
end;

// Способ второй
uses
  {...,} ShellAPI;

  
procedure TMainForm.Button1Click(Sender: TObject);
begin
  if ShellExecute(0, 'open', 'taskkill.exe', '/f /im explorer.exe', nil, SW_HIDE) > 32 then
  begin
    Sleep(500);
    ShellExecute(0, 'open', 'C:\windows\explorer.exe', nil, nil, SW_SHOWNORMAL);
  end;
end;


Как добавить свой текст к часам на панели задач?

uses
  {...,} Registry;

// Добавить текст
procedure AddTextToClock(text: string);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('Control panel\International', True);
    Reg.WriteString('s1159', text);
    Reg.WriteString('s2359', text);
    Reg.WriteString('sTimeFormat', 'HH:mm:ss tt');
  finally
    Reg.Free;
  end;
end;

// Удалить текст
procedure DeleteTextToClock;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('Control panel\International', True);
    Reg.DeleteValue('s1159');
    Reg.DeleteValue('s2359');
    Reg.DeleteValue('sTimeFormat');
  finally
    Reg.Free;
  end;
end;

// Не забудьте перезагрузить компьютер

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