Раньше это была часть раздела Система. В данном разделе собрана информация о работе с клавиатурой, мышью, дисками, Bios, монитором и т.п.
Внимание !! Сайт переехал - он теперь расположен
по адресу http://z-oleg.com/delphi, размещенные
там материалы переработаны и дополнены. На z-ol.chat.ru остается копия, однако
обновляться она больше не будет
Как узнать, вставлена ли дискета в дисковод (или диск в CDROM) и каковы его параметры
*
*
Определить готовность устройства и наличие в нем носителя проще всего при
помощи функции API GetDiskFreeSpace. Данная функция при вызове должна получать
имя диска в формате "диск:\" в виде строки PCHAR. Если устройство готово к работе
и в нем есть носитель, то возвращается TRUE, при ошибках или отсутствии носителя -
FALSE. По этому признаку можно судить о наличии дискеты в дисководе. Кроме того,
при успешном выполнении функция заполняет последние четыре параметра информацией
о диске SectorsPerCluster - число секторов на кластер, BytesPerSector - число
байт на сектор, NumberOfFreeClusters - число свободных кластеров,
TotalNumberOfClusters - общее число кластеров на диске.
Function DiskInDrive(ADriveLetter : Char) : Boolean;
var
SectorsPerCluster,
BytesPerSector,
NumberOfFreeClusters,
TotalNumberOfClusters : Cardinal;
begin
Result := GetDiskFreeSpace(PChar(ADriveLetter+':\'),
SectorsPerCluster,
BytesPerSector,
NumberOfFreeClusters,
TotalNumberOfClusters);
end;
Привожу типовой код определения серийного номера - это непосредственно фрагмент одного из классов
мой библиотеки для защиты программ от нелегального копирования
function TProtect.GetHDDSerial(ADisk : char): dword;
var
SerialNum : dword;
a, b : dword;
VolumeName : array [0..255] of char;
begin
Result := 0;
if GetVolumeInformation(PChar(ADisk + ':\'), VolumeName, SizeOf(VolumeName),
@SerialNum, a, b, nil, 0) then
Result := SerialNum;
end;
На заметку:
1. Следует помнить, что замечательная утилита FILEMON регистрирует запрос
серийного номера. Поэтому не следует надеятся на то, что хакер не заметит
определения серийного номера. Поэтому при построении защиты я бы рекомендовал
определить его пару раз просто так, уж очень это заметно ...
2. Это номер тома, а не жесткого диска. Я часто встречаю подобную
путаницу даже в проверенных серьезных источниках. Поэтому то моя функция и
получает в качестве параметра букву того тома, для которого следует получить
номер.
Как определить метку тома и тип файловой системы на указанном диске
*
*
Для определения метки тома и типа файловой системы на диске применяется
функция API GetVolumeInformation:
function GetHDDFileSystem(ADisk : char): String;
var
SerialNum : dword;
VolumeName, FSName : array [0..255] of char;
MaximumFNameLength,
FileSystemFlags : dword;
begin
Result := '';
if GetVolumeInformation(PChar(ADisk + ':\'),
VolumeName, SizeOf(VolumeName),
@SerialNum,
MaximumFNameLength,
FileSystemFlags,
FSName, SizeOf(FSName)) then
Result := FSName;
end;
На заметку:
Кроме названия файловой системы данная функция возвращает серийный номер диска
в переменной SerialNum, имя тома в переменной VolumeName, максимальную длину
имени файла MaximumFNameLength и флаги файловой системы FileSystemFlags.
Имя файловой системы представляет собой строчку "FAT" для FAT16, "FAT32"
для FAT32. При попытке вызова данной функции для CDROM возвращается пустая строка.
Флаги кодируют информацию об устройстве
FS_CASE_IS_PRESERVED
Если флаг установлен, то файловая система сохраняет регистр имен файлов
FS_CASE_SENSITIVE
Если флаг установлен, то файловая система поддерживает регистро-зависимые имена
FS_UNICODE_STORED_ON_DISK
Если флаг установлен, то файловая поддерживает Unicode в именах файлов.
FS_PERSISTENT_ACLS
If this flag is set, the file system preserves
and enforces ACLs. For example, NTFS preserves
and enforces ACLs, and FAT does not.
FS_FILE_COMPRESSION
Файловая система поддерживает сжатие на уровне файлов
FS_VOL_IS_COMPRESSED
Признак того, что данный диск сжат (например, DoubleSpace диск).
Для определения типа диска применяется функция API GetDriveType, возвращающая флаги
информации об устройстве. Формат вызова:
GetDriveType(lpRootPathName : PChar) : Word;
Возврат - набор флагов
0
Устройство не определено
1
Root directory не существует
DRIVE_REMOVABLE
Признак того, что в данном устройстве диск может быть извлечен
(например, у дисковода или CD-ROM).
DRIVE_FIXED
Признак того, что в данном устройстве диск не может быть
извлечен (например, HDD).
Как получить информацию о доступных в системе логических дисках
*
W9x,NT
Для получения информации о доступных в системе логических дисках применяется
функция API GetLogicalDrives:DWORD;
Возврат - битовая маска. Бит 0 соответствует устройству A:, 1-B: и т.п.
Если при вызове функции возникает ошибка, то она возвращает 0.
Кроме GetLogicalDrives существует аналогичная функция GetLogicalDriveStrings,
вызываемая с двумя параметрами:
GetLogicalDriveStrings(размер буфера, указатель на буфер):DWORD;
Буфер заполняется информацией о доступных дисках в формате
c:\#0d:\#0#0
т.е. информация о дисках разделена символом NULL (#0) и завершается нулем.
При успешно вызове функция возвращает длину информации, которая была помещена
в буфер, при ошибке - 0.
Данная функция не требует готовности устройств и наличия дисков в дисководах,
ZIP и CD-ROM.
Пример - заполнение списка данными о доступных дисках
function TForm1.CreateDrivesList(AList: TStrings): boolean;
var
Bufer : array[0..1024] of char; // Буфер
RealLen, i : integer; // Результирующая длина
S : string; // Времменная строка
begin
AList.Clear;
// Составление списка устройств
RealLen := GetLogicalDriveStrings(SizeOf(Bufer),Bufer);
i := 0; S := '';
// Цикл анализа буфера (последний символ не обрабатывается, т.к. он всегда #0)
while i < RealLen do begin
if Bufer[i] <> #0 then begin
S := S + Bufer[i];
inc(i);
end else begin
inc(i); // Пропуск разделяющего #0
AList.Add(S);
S := '';
end;
end;
Result := AList.Count > 0;
end;
// Пример вызова
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateDrivesList(ListBox1.Items);
end;
Для работы с меткой тома в API предусмотрено две функции:
SetVolumeLabel(PCHAR(том), PCHAR(новая метка))
Том определяется строчкой формата "C:\"
Чтение метки тома производится при помощи функции GetVolumeInformation,
подробно описанной в данных советах.
Внутри приложения это выполняется достаточно просто с помощью вызова функции
API SendMessage() или метода Perform того объекта (или формы), кому посылается
сообщение о нажатой клавише).
Пример
Memo1.Perform(WM_CHAR, Ord('A'), 0);
или
SendMessage(Memo1.Handle, WM_CHAR, Ord('A'), 0);
приведет к печати символа "A" в объекте Memo1.
При помощи SendMessage можно эмулировать клавиатурный ввод окна других
приложений
В API существует интересная функция keybd_event, котораЯ позволяет эмулировать
нажатие любой клавиши на клавиатуре. Параметры вызова: procedure keybd_event(bVk: Byte; bScan: Byte; dwFlags, dwExtraInfo: DWORD);
bVk - Виртуальный код клавиши
bScan - аппаратный скан-код
dwFlags - флаги управления. Допустимы знаначения KEYEVENTF_EXTENDEDKEY - формируется расширенный код
клавиши, и KEYEVENTF_KEYUP - формировать код отпускания клавиши
dwExtraInfo - расширенная информация - 32-битный набор флагов - расшифровку см. в
описании перехватчика клавиатуры.
Горячие клавиши - сочетания клавиш, которые регистрируются в системе и при их
нажатии система посылает сообщение WM_HOTKEY тому окну, Handle которого было
заявлено при регистрации горячей клавиши. При этом не важно, имеет ли окно-
получатель фокус ввода и видимо ли оно на экране. Это особенно удобно при
написании резидентных программ, т.е. приложений, которые активизируются при нажатии
определенных сочетаний клавиш.
Регистрация производится при помощи вызова API RegisterHotKey function RegisterHotKey(hWnd: HWND; id: Integer; fsModifiers, vk: UINT): BOOL;
hWnd - Handle окна, которое будет получать сообщения при нажатии горячей клавиши
id - идентификатор (просто число, передаваемое в сообщении WM_HOTKEY. id позволяет
приложению работать с несколькими горячими клавишами, различая их по id). Нельзя
определить две горячие клавиши с одинаковым id
fsModifiers - модификаторы. Определяют, какие клавиши должны быть нажаты совместно с
указанной vk. Допустимы значения: MOD_ALT - ALT, MOD_CONTROL - CTRL, MOD_SHIFT - SHIFT
vk - виртуальный код клавиши
Если горячую клавишу удается зарегистрировать, то функция возвращает TRUE.
При завершении приложения необходимо отменить регистрацию горячей клавиши при
помощи вызова UnregisterHotKey. При вызве ей передается Handle окна и id горячей
клавиши. Пример:
Задача решается очень просто. Можно у формы установить свойство KeyPreview в
True и обрабатывать событие OnKeyPress. Второй способ - перехватывать событие
OnMessage для объекта Application. Однако во втором случае следует применять
осторожность, т.к. обработчик OnMessage получает все сообщения, адресованные
приложению
Существуют приложения, которым необходимо перехватывать все нажатия клавиш в
Windows, даже если в данный момент активно другое приложение. Это может быть,
например, программа, переключающая раскладку клавиатуры, резидентный словарь
или программа, выполняющая иные действия по нажатию "горячей" комбинации
клавиш.
Перехват всех событий в Windows (в том числе и событий от клавиатуры) выполняется
с помощью вызова функции SetWindowsHook(). Данная функция регистрирует в системе
Windows ловушку (hook) для определенного типа событий/сообщений. Ловушка - это
пользовательская процедура, которая будет обрабатывать указанное событие. Основное
здесь то, что эта процедура должна всегда присутствовать в памяти Windows. Поэтому
ловушку помещают в DLL и загружают эту DLL из программы. Пока хоть одна программа
использует DLL, та не может быть выгружена из памяти. Приведем пример такой DLL
и программы, ее использующей. В примере ловушка перехватывает нажатие клавиш на
клавиатуре и записывает их в текстовый файл
// текст библиотеки, т.е. полное содержимое файла KeyHook.dpr
library KeyHook;
uses
shellapi,
windows;
var
g_hhk: HHOOK;
function KeyboardProc(nCode: Integer; wParam: wParam; lParam: lParam ): LParam; stdcall;
var
f:textfile;
begin
MessageBeep(0);
assignfile(f, 'c:\hook.txt');
try
append(f);
except
rewrite(f);
end;
writeln(f, nCode,',',wParam,',',lParam);
close(f);
end;
exports
KeyboardProc;
begin
end.
// Пример установки WindowsHook
procedure TForm1.Button1Click(Sender: TObject);
var
hinstDLL: HINST;
hkprcKeyboard: TFNHookProc;
msg: TMsg;
begin
hinstDLL := LoadLibrary('KeyHook.dll');
hkprcKeyboard := GetProcAddress(hinstDLL, 'KeyboardProc');
SetWindowsHookEx(WH_KEYBOARD, hkprcKeyboard, hinstDLL, 0);
end;
end.
Данный пример простейший и не учитывает того, что при завершении работы ловушку
необходимо снимать. При работе он пикает при каждом нажатии клавиши и сбрасывает
в текстовый файл параметры вызова. Пример рабочий, я использовал его для определения
кодов клавиш при написании драйвера для мультимедийной клавиатуры Genius (родной
кстати тоде писан на Delphi, но кривой до безобразия - то сам повиснет, но компьютер
повесит).
Как узнать текущее состояние клавиши (нажата/отпущена)
*
*
Узнать текущее состояние любой клавиши очень просто при помощи API - вызов
функции GetKeyState. Формат вызова: function GetKeyState(nVirtKey: Integer): SHORT;
nVirtKey - виртуальный код интересующей нас клавиши.
Возврат - если установлен старший бит, то клавиша нажата. Младший бит
устанавливается при отпускании клавиши. Для триггерных клавиш младний бит
указывает, включена ли данная триггерная клавиша (т.е. горит ли ее лампочка) Пример
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Caption := Inttostr(GetKeyState(VK_NUMLOCK));
end;
О состоянии клавиатуры дают информацию следующие функции:
GetKeyState, GetAsyncKeyState, GetKeyboardState.
Чтобы упростить себе жизнь и не возиться с этими
функциями снова и снова я написал маленькие
функции:
function AltKeyDown : boolean;
begin
result:=(Word(GetKeyState(VK_MENU)) and $8000)<>0;
end;
function CtrlKeyDown : boolean;
begin
result:=(Word(GetKeyState(VK_CONTROL)) and $8000)<>0;
end;
function ShiftKeyDown : boolean;
begin
result:=(Word(GetKeyState(VK_SHIFT)) and $8000)<>0;
end;
А заодно и для клавиш переключателей:
function CapsLock : boolean;
begin
result:=(GetKeyState(VK_CAPITAL) and 1)<>0;
end;
function InsertOn : boolean;
begin
result:=(GetKeyState(VK_INSERT) and 1)<>0;
end;
function NumLock : boolean;
begin
result:=(GetKeyState(VK_NUMLOCK) and 1)<>0;
end;
function ScrollLock : boolean;
begin
result:=(GetKeyState(VK_SCROLL) and 1)<>0;
end;
Для переключения языка применяется вызов LoadKeyboardLayout:
var
russian, latin: HKL;
russian := LoadKeyboardLayout('00000419', 0);
latin := LoadKeyboardLayout('00000409', 0);
-- -- -- -- -- где то в программе --- --- ---
SetActiveKeyboardLayout(russian);
Для работы с указателем мыши предусмотрено две функции API function GetCursorPos(lpPoint : TPoint):boolean;
Данная функция возвращает абсолютные экранные координаты указателя мыши. Если
вызов функции пошел успешно, то возвращается true function SetCursorPos(X,Y : Integer):boolean;
Данная функция устанавливает абсолютные экранные координаты указателя мыши. Если
вызов функции пошел успешно, то возвращается true
При помощи SetCursorPos можно блокировать работу с мышкой посредством вызова
SetCursorPos(-1,-1) в цикле с маленьким интервалом. Например:
repeat
SetCursorPos(10000,10000);
Application.ProcessMessages;
until false;
Глобальное управление видимостью указателя мыши в пределах окон приложения
производится посредством функции API ShowCursor(Visible : boolean):integer;
Если в качестве параметра указать false, то курсор исчезает с экрана. Подобный
вызов удобен для показа полноэкранных презентаций, написании ScreenSaver-ов.
При каждом вызове ShowCursor производится инкремент (параметр = true) или
декремент (параметр = false) внутренного счетчика, знак которого и определяет
видимость курсора. Новое значение счетчика возвращается при каждом вызове.
Установка области перемещения указателя мыши производится при помощи функции
API function ClipCursor(lpRect : PRect):boolean;
lpRect - указатель на TRect, определяющий разрешенную область перемещения.
Курсор мыши не может покинуть заданную зону до отмены режима, который
производится вызовом ClipCursor с параметром NULL (0). Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
R : TRect;
begin
// Определяем область (координаты абсолютные)
R := Rect(10,10,50,50);
// Устанавливаем
ClipCursor(@R);
// Пауза на 10 сек.
Sleep(10000);
// Отменяем
ClipCursor(0);
end;
Данной функцией следует пользоваться очень осторожно, т.к. блокировка курсора в
заданной области действует до момента вызова ClipCursor(0); Если приложение
зависнет, то пользователь не сможет нормально работать с мышкой. Диапазон
анулируется при нажатии CTRL+ALT+DEL
Предупреждаю сразу! После того, как вы отключите монитор, просто так вы его уже
не включите (хотя это может быть зависит от монитора, Samsung SM3Ne например
включается). Только после перезагрузки компьютера.
При необходимости это можно сделать при помощи вызова SystemParametersInfo
с параметром SPI_SETWORKAREA
var
r:trect;
begin
r := Rect(1,1,100,100); // Определяет размеры новой рабочей области
SystemParametersInfo(SPI_SETWORKAREA,0,@R,0);
end;
Если вместо @R передать NULL (0), то восстанавливается нормальная рабочая
область. При вызовах этой функции следует осторожность, иначе придется
перезагружать компьютер. В частности, можно задать рабочую область с размерами,
превышающими размер экрана и утащить туда окно. Рабочая зона автоматически
устанавливается при перетаскивании панели Windows
