//Включаем только Caps Lock
if not initCaps then PressKey(VK_CAPITAL);
curCaps := True;
if initNum then PressKey(VK_NUMLOCK);
curNum := False;
if initScroll then PressKey(VK_SCROLL);
curScroll := False;
//Запускаем «бегущие огни»
Timer1.Interval := StrToInt(txtInterval.Text);
Timer1.Enabled := True;
cmbStart.Caption := 'Стоп
end
else
begin
//Останавливаем «бегущие огни»
Timer1.Enabled := False;
cmbStart.Caption := 'Старт
//Восстанавливаем первоначальные состояния клавиш
if initCaps <> curCaps then PressKey(VK_CAPITAL);
if initNum <> curNum then PressKey(VK_NUMLOCK);
if initScroll <> curScroll then PressKey(VK_SCROLL);
end;
end;
В начале листинга 3.23 приведены используемые глобальные переменные:
• initCaps, initNum, initScroll – для сохранения первоначального состояния клавиш Caps Lock, Num Lock и Scroll Lock с целью его восстановления при остановке огней, чтобы не раздражаться необходимостью вручную устанавливать состояния этих клавиш;
• curCaps, curNum, curScroll – для быстрого определения текущего состояния клавиш (вместо постоянного обращения к функциям типа GetKeyboardState).
Перемещение огней происходит при каждом срабатывании таймера Timer1 (листинг 3.24).
...
Листинг 3.24.
Перемещение огней
procedure TForm1.Timer1Timer(Sender: TObject);
begin
//Изменяем состояние лампочек на клавиатуре
if curCaps then
begin
//С Caps Lock на Num Lock
PressKey(VK_NUMLOCK);
PressKey(VK_CAPITAL);
curCaps := False;
curNum := True;
end
else if curNum then
begin
//С Num Lock на Scroll Lock
PressKey(VK_SCROLL);
PressKey(VK_NUMLOCK);
curNum := False;
curScroll := True;
end
else
begin
//С Scroll Lock на Caps Lock
PressKey(VK_CAPITAL);
PressKey(VK_SCROLL);
curScroll := False;
curCaps := True;
end;
end;
...
Примечание
Если у вашей клавиатуры порядок следования лампочек отличается от приведенного в примере (в какую-нибудь сторону), то следует изменить порядок переключения в листинге 3.24, чтобы «бегущие огни» действительно «бежали».
Теперь можно запустить соответствующую заставку и получить неплохое украшение, например, для новогодней елки… из компьютера.
Глава 4 Диски, каталоги, файлы
• Диски
• Каталоги и пути
• Файлы
В этой главе вы познакомитесь с некоторыми возможностями получения полезной информации о файловой системе (и от файловой системы). Примеры главы целиком основаны на использовании API-функций для получения информации, так сказать, из первых рук. Конечно, разработчики Borland не проигнорировали эту тему при написании библиотеки для Delphi: в модуле SysUtils можно найти ряд функций, позволяющих работать с объектами файловой системы. Поэтому в этой главе в основном рассматриваются API-функции, позволяющие получить информацию, недоступную при использовании процедур и функций модуля SysUtils, дабы полностью не дублировать функционал этой библиотеки.
Начнем с получения информации о дисках компьютера. Как вы, наверное, не раз могли убедиться, ряд приложений (хотя бы тот же Internet Explorer) обладают гораздо большей информацией о дисках, нежели их обозначение (буква) или размер. Далее рассмотрено, как определить буквы всех установленных на компьютере дисков, метки дисков, серийные номера томов и другую информацию о файловой системе. Вы также узнаете, как программно поменять метки дисков.
Все рассмотренные ниже функции работы с дисками вы можете найти в модуле DriveTools, расположенном на диске, прилагаемом к книге, в папке с названием раздела.
Сбор информации о дисках
Итак, начнем по порядку. Получить список дисков компьютера (строк вида<буква>: ) поможет функция из листинга 4.1.
...
Листинг 4.1.
Определение букв дисков
function GetDriveLetters(letters: TStrings):Integer;
var
buffer: String;
i, len, start: Integer;
begin
SetLength(buffer, 110);
len := GetLogicalDriveStrings(110, PAnsiChar(buffer));
//Разбираем строку вида 'c:#0d:#0…#0#0',
//возвращаемую функцией GetLogicalDriveStrings
start := 1;
for i := 2 to len do
if (buffer[i] = #0) and (start <> i) then
begin
//Нашли обозначение очередного диска
letters.Append(Copy(buffer, start, i–start));
start := i+1;
end;
GetDriveLetters := letters.Count;
end;
Функция принимает ссылку на список и заполняет его строками с путями корневых папок каждого из дисков (например, с: ). Вся сложность этой функции состоит в необходимости выделения путей из строки, заполняемой API-функцией GetLogicalDriveStrings. Функция GetDriveLetters возвращает количество строк, добавленных в список letters.
Кроме API-функции GetLogicalDriveStrings, для получения информации о том, за какими буквами закреплены диски, можно использовать еще как минимум одну функцию – GetLogicalDrives. Она не имеет аргументов и возвращает значение типа DWORD, представляющее собой битовую маску. Состояние каждого бита маски (от 1 до 26) соответствует наличию либо отсутствию диска под соответствующей номеру буквой латинского алфавита. Выделение информации из маски (и соответственно составление списка дисков) может выглядеть, как в листинге 4.2.
...
Листинг 4.2.
Составление списка дисков
function GetDriveLetters(letters: TStrings):Integer;
var
mask: DWORD;
i: Integer;
letter: Char;
begin
//Получаем маску, характеризующую наличие дисков
mask := GetLogicalDrives();
//Разбираем маску (определяем значения первых 26 битов)
i := 1;
for letter := 'A' to 'Z' do
begin
if mask and i <> 0 then
//Есть диск под текущей буквой
letters.Append(letter + ':\');
i := i * 2; //Переходим к следующему биту
end;
GetDriveLetters := letters.Count;
end;
Теперь напишем несложные функции, позволяющие определить полный размер и размер свободного пространства на диске (листинг 4.3).
...
Листинг 4.3.
Определение полного размера и размера свободного пространства диска
//Функция возвращает полный размер диска в байтах
function GetDriveSize(root: String): Int64;
var
freeToCaller, totalBytes, freeBytes: Int64;
begin
if GetDiskFreeSpaceEx(PAnsiChar(root), freeToCaller,
totalBytes, PLargeInteger(Addr(freeBytes))) <> False
then
GetDriveSize := totalBytes
else
GetDriveSize := -1;
end;
//Функция возвращает размер свободного места на диске (в байтах)
function GetDriveFreeSpace(root: String): Int64;
var
freeToCaller, totalBytes, freeBytes:Int64;
begin
if GetDiskFreeSpaceEx(PAnsiChar(root), freeToCaller,
totalBytes, PLargeInteger(Addr(freeBytes))) <> False
then
GetDriveFreeSpace := freeBytes
else
GetDriveFreeSpace := –1;
end;
В обеих функциях листинга 4.3 для достижения двух разных целей используется API-функция GetDiskFreeSpaceEx:
...
function GetDiskFreeSpaceEx(lpDirectoryName: PChar;
var lpFreeBytesAvailableToCaller,
lpTotalNumberOfBytes;
lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;
Функция принимает путь (любой) файла или папки на интересующем диске и заполняет три параметра:
• lpFreeBytesAvailableToCaller – размер свободного пространства, доступного пользователю, под чьими правами работает поток, вызывающий функцию (в байтах);
• lpTotalNumberOf Bytes – полный размер диска (в байтах);
• lpTotalNumberOf FreeBytes – размер свободного пространства на диске (в байтах).
Все перечисленные значения являются 64-битными, чтобы можно было оперировать размерами дисков более 4 Гбайт. Если вызов функции GetDiskFreeSpaceEx оказывается неудачным, то возвращается значение False. В этом случае функции листинга 4.3 возвращают -1, сигнализируя об ошибке.
Теперь самое интересное – определение детальной информации о файловой системе на дисках. Много интересного о файловой системе на каждом диске можно узнать при помощи API-функции GetVolumelnformation. Она имеет следующий вид:
...
function GetVolumeInformation(lpRootPathName: PChar;
lpVolumeNameBuffer: PChar; nVolumeNameSize: DWORD;
lpVolumeSerialNumber: PDWORD; var lpMaximumComponentLength,
lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: PChar;
nFileSystemNameSize: DWORD): BOOL;
Объявление функции выглядит довольно громоздким за счет большого количества параметров. Однако использовать функцию GetVolumelnformation очень просто. Чтобы не вдаваться в долгое описание ее параметров, рассмотрим ее использование на примере (листинг 4.4).
...
Листинг 4.4.
Определение информации о диске
//Функция определяет информацию о диске
//Возвращает False, если возникла ошибка
function GetDriveInformation(root: String;
var info: DriveInfo):Boolean;
var
bufDriveName, bufFSNAme: String;
SN: DWORD;
maxFileName, fsOptions: Cardinal;
begin
SetLength(bufDriveName, 101);
SetLength(bufFSName, 101);
//Определение информации о диске
if GetVolumeInformation(PAnsiChar(root),
PAnsiChar(bufDriveName), 100,
Addr(SN), maxFileName, fsOptions,
PAnsiChar(bufFSName), 100) <> False
then
begin
//Заполняем структуру информацией о диске
with info do
begin
DriveLabel := bufDriveName;
FileSystemName := bufFSName;
SerialNumber := SN;
MaxFileNameLen := maxFileName;
//..параметры файловой системы
with info.FileSystemOptions do
begin
CaseSensitive := fsOptions and FS_CASE_SENSITIVE <> 0;
SupportCompression := fsOptions and
FS_FILE_COMPRESSION <> 0;
IsCompressed := fsOptions and FS_VOL_IS_COMPRESSED <> 0;
end;
end;
//Функция отработала успешно
GetDriveInformation := True;
end
else
//Ошибка
GetDriveInformation := False;
end;
Если проанализировать приведенный листинг, то можно увидеть, что функции GetVolumelnf ormation, кроме пути, принадлежащего диску, передается также:
• буфер для метки диска (и длина этого буфера);
• указатель на переменную типа DWORD для записи в нее серийного номера тома диска (присваивается при каждом создании файловой системы, например, после форматирования диска);
• ссылка на переменную типа Cardinal для сохранения в ней максимальной длины компонента пути (имени файла или папки);
