Delphi. Трюки и эффекты - Валерий Борисок

//Включаем только 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, дабы полностью не дублировать функционал этой библиотеки.

4.1. Диски

Начнем с получения информации о дисках компьютера. Как вы, наверное, не раз могли убедиться, ряд приложений (хотя бы тот же 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 для сохранения в ней максимальной длины компонента пути (имени файла или папки);