Текст книги "Программирование в Delphi. Трюки и эффекты"

Бегущие огни на клавиатуре

В завершение будет рассмотрен довольно любопытный пример, так же, как и предыдущий, основанный на программном нажатии клавиш Caps Lock, Num Lock и ScroLL Lock. Как известно, этим клавишам на клавиатуре соответствуют три индикатора (по крайней мере, на большинстве клавиатур). Суть примера состоит в последовательном включении и выключении упомянутых режимов, которые автоматически сопровождаются включением и выключением соответствующих индикаторов на клавиатуре.

Перед рассмотрением основных процедур примера стоит привести текст процедуры PressKey, которая далее используется практически на каждом шагу (листинг 3.22). Она имитирует нажатие и отпускание одной клавиши. Конкретное наименование программно нажимаемой и отпускаемой клавиши определяется единственным параметром (кодом клавиши), который принимает процедура PressKey.

Листинг 3.22. Нажатие отдельной клавиши

procedurePressKey (keyCode: Byte);

begin

keybd_event(keyCode, 0, 0, 0);

keybd_event(keyCode, 0, KEYEVENTF_KEYUP, 0);

end;

Запуск и остановка мерцания индикаторов на клавиатуре осуществляется при нажатии кнопки на форме (помимо кнопки, на форме должны присутствовать текстовое поле, предназначенное для указания интервала изменения состояния индикаторов, а также таймер со свойством Enabled, равным False) (листинг 3.23).

Листинг 3.23. Запуск и остановка мигания индикаторов

var

init Caps, init Num, init Scroll: Boolean; //Первоначальные состояния

//клавиш

curCaps, curNum, curScroll: Boolean; //Текущие состояния клавиш

procedure TForm1.cmbStartClick(Sender: TObject);

begin

if cmbStart.Caption = 'Старт' then

begin

//Сохраняем первоначальные состояния клавиш

initCaps:= (GetKeyState(VK_CAPITAL) and 1) <> 0;

initNum:= (GetKeyState(VK_NUMLOCK) and 1) <> 0;

initScroll:= (GetKeyState(VK_SCROLL) and 1) <> 0;

//Включаем только 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).

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

Диски

Начнем со способов определения информации о дисках компьютера. Как вы, наверное, не раз могли убедиться, ряд приложений (тот же 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 (bu ffer[i] = #0) and (start <> i) then

begin

//Нашли обозначение очередного диска

letters.Append(Copy(buffer, start, i–start));

start:= i+1;

end;

GetDriveLetters:= letters.Count;

end;

Функция принимает ссылку на список и заполняет его строками, содежащими пути корневых папок каждого из дисков (например, C:). Вся сложность использования этой функции состоит в необходимости выделения путей из строки, заполняемой API-функцией GetLogicalDriveStrings. Функция GetDriveLetters возвращает количество строк, добавленных в список letters.

Кроме API-функции GetLogicalDriveStrings, для получения информации о том, за какими буквами закреплены диски, можно использовать еще, по меньшей мере, одну функцию – GetLogicalDrives. Эта функция не имеет аргументов и возвращает значение типа DWORD, представляющее собой битовую маску. Состояние каждого бита маски (от первого до 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

//Есть тьдиск кпод текущей йбуквой

lett ers.App end(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

  GetDriveFreeSpaceee:= –1;

end;

В обеих функциях, представленных в листинге 4.3, для достижения двух разных целей используется API-функция GetDiskFreeSpaceEx:

function GetDiskFreeSpaceEx(lpDirectoryName: PChar;

var lpFreeBytesAvailableToCaller,

lpTotalNumberOfBytes;

lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;

Данная функция принимает путь файла или папки на требуемом диске и заполняет три параметра:

• lpFreeBytesAvailableToCaller – содержит размер свободного пространства, доступного пользователю, под правами которого работает поток, вызывающий данную функцию (в байтах);

• lpTotalNumberOfBytes – содержит полный размер диска (в байтах);

• lpTotalNumberOfFreeBytes – содержит размер свободного пространства на диске (в байтах).

Чтобы можно было оперировать размерами дисков более 4 Гбайт, все перечисленные значения являются 64-битными. Если вызов функции 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;

Анализируя приведенный в листинге 4.4 код, можно увидеть, что функции GetVolumelnformation, кроме пути, принадлежащего диску, передаются также:

• буфер для метки диска (и длина этого буфера);

• указатель на переменную типа DWORD для записи в нее серийного номера тома диска, который присваивается при каждом создании файловой системы, например, после форматирования диска;

• ссылка на переменную типа Cardinal для сохранения в ней максимальной длины компонента пути (имени файла или папки);

• ссылка на переменную типа Cardinal для сохранения в ней набора битовых флагов с некоторыми параметрами файловой системы;

• буфер для названия файловой системы (и его длина).

Как вы могли заметить, в результате выполнения приведенной в листинге 4.4 функции GetDriveInformation заполняется структура Drivelnfo. Код определения этой структуры (а также вложенной в нее структуры, хранящей некоторые извлеченные из битовой маски fsOptions флаги) приведен в листинге 4.5.

Листинг 4.5. Определение записей для хранения информации о диске

Type

//Запись некоторых параметров о файловой системе

FSOptions = record

CaseSensitive: Boolean; //При уравнении путей учитывает регистр

SupportCompression: Boolean; //Файловая система поддерживает сжатие

IsCompressed: Boolean; //Диск сжат

end;

//Запись, содержащая информацию о диске

DriveInfo = record

DriveLabel: String; //Метка диска

FileSystemName: String; //Файловая система диска

FileSystemOptions: FSOptions; //Параметры файловой системы

SerialNumber: DWORD; //Серийный номер тома

MaxFileNameLen: Cardinal; //Максимальная длина имени файла

end;

Напоследок будет рассмотрена еще одна полезная возможность – определение типа носителя диска с помощью API-функции GetDriveType. Эта функция принимает единственный параметр, задающий корневую папку диска (например, C:, причем обратный слэш на конце обязателен). Функция GetDriveType возвращает целочисленное значение, идентифицирующее тип диска. Вариант кода получения текстового описания типов дисков с использованием этой API-функции приведен в листинге 4.6.

Листинг 4.6. Определение типа носителя диска

function GetDriveTypeName(root: String): String;

begin

case GetDriveType(PAnsiChar(root)) of

DRIVE_UNKNOWN: GetDriveTypeName:= ' Не определен ';

DRIVE_REMOVABLE: GetDriveTypeName:= ' Сменный';

DRIVE_FIXED: GetDriveTypeName:= ' Фиксированный';

DRIVE_REMOTE: GetDriveTypeName:= 'Удаленный (сетевой)';

DRIVE_CDROM: GetDriveTypeName:= 'Компакт-диск';

DRIVE_RAMDISK: GetDriveTypeName:= 'RAM-диск';

else

GetDriveTypeName:= ''//Возвращается в случае ошибки

end;

end;

Изменение метки диска

Как вы думаете, сложно ли изменить метку диска? Совсем нет: сложность состоит лишь в поиске необходимой функции. В данном случае можно применить API-функцию SetVolumeLabel (листинг 4.7).

Листинг 4.7. Изменение метки диска

function SetDriveLabel(root, newLabel: String): Boolean;

begin

SetDriveLabel:=

SetVolumeLabel(PAnsiChar(root), PAnsiChar(newLabel)) <> False;

end;

В листинге 4.7 приведена функция-оболочка для API-функции изменения метки диска, избавляющая вас от необходимости преобразования типов и интерпретации значения, возвращаемого API-функцией.

Программа просмотра свойств дисков

В завершение темы работы с дисками будет рассмотрен еще один небольшой пример, обобщающий сказанное выше. Для этого будет создано небольшое приложение, отображающее информацию о любом из дисков компьютера. Приложение будет использовать возможности всех рассмотренных выше функций.

Вид окна этого приложения показан на рис. 4.1.

Рис. 4.1. Окно с информацией о дисках

Работа формы, приведенной на рис. 4.1, организована предельно просто. Сначала при создании формы происходит получение списка дисков (а также выделение первого диска и загрузка информации о нем) (листинг 4.8).

Листинг 4.8. Составление списка дисков

procedure TForm1.FormCreate(Sender: TObject);

begin

//Загрузка букв дисков

if GetDriveLetters(cboDrives.Items) > 0 then

begin

//Выделим первый диск

cboDrives.ItemIndex:= 0;

cboDrivesSelect(self);

end

else

Button1.Enabled:= False;

end;

Загрузка информации о дисках происходит при выборе буквы диска из списка (листинг 4.9).

Листинг 4.9. Загрузка информации о выбранном диске

procedure

TForm1.cboDrivesSelect(

Sender: TObject);

var info: DriveInfo;

root: String;

fullSize, freeSize: Int64;

begin

root:= cboDrives.Items[cboDrives.ItemIndex];

//Загружаем информацию о выбранном диске

GetDriveInformation(root, info);

//Общая информация о диске и файловой системе

txtLabel.Text:= info.DriveLabel;

txtDriveType.Text:= GetDriveTypeName(root);

txtFSName.Text:= info.FileSystemName;

txtSN.Text:= IntToHex(Int64(info.SerialNumber), 8);

txtMaxFileName.Text:= IntToStr(Integer(info.MaxFileNameLen));

//Флажки некоторых свойств файловой системы

chkCaseSensitive.Checked:= info.FileSystemOptions.CaseSensitive;

chkCompression.Checked:= info.FileSystemOptions.SupportCompression;

chkCompressed.Checked:= info.FileSystemOptions.IsCompressed;

//Размер диска

fullSize:= GetDriveSize(root);

if fullSize <> –1 then

freeSize:= GetDriveFreeSpace(root)

else

begin //Ошибка при обращении к диску

fullSize:= 0;

freeSize:= 0;

end;

//..формирование диаграммы

driveSize.Series[0].Clear;

driveSize.Series[0].Add(freeSize, 'Свободно');

driveSize.Series[0].Add(fullSize – freeSize, 'Занято')

end;

При нажатии кнопки Изменить производится попытка присвоить диску, выбранному в списке, метку, введенную в соответствующее текстовое поле (txtLabel) (листинг 4.10).

Листинг 4.10. Задание новой метки диска

procedure TForm1.Button1Click(Sender: TObject);

begin

//Изменение метки диска

if not SetDriveLabel(cboDrives.Items[cboDrives.ItemIndex],

txtLabel.Text)

then

MessageBox(self.Handle, 'Не удалось поменять метку диска', 'Ошибка ',

MB_ICONEXCLAMATION)

else

//Перечитаем информацию о диске

cboDrivesSelect(self);

end;

Табличное или иное описание свойств элементов управления не приводится, так как имена элементов управления соответствуют виду информации, помещаемой в них. Следует только уточнить, что в элементе управления TChart создан один ряд типа Pie (круговая диаграмма). У этого ряда отключено отображение подписей к диаграмме, чтобы не дублировать данные, приведенные в легенде.

Папки и пути

В этом разделе описываются некоторые примеры, позволяющие узнавать расположение важных папок операционной системы Windows. Здесь также рассматриваются вопросы преобразования путей и приводятся некоторые алгоритмы обхода папок, применяемые для поиска.

Прежде чем рассматривать решения конкретных задач, следует сказать пару слов о неком магическом числе, а точнее, целочисленной константе, используемой в некоторых примерах, приведенных в этой главе. Речь идет о константе MAX_PATH, равной 260. Она используется явно или неявно (функциями API) в качестве максимальной возможной длины пути. Здесь налицо небольшой парадокс: хотя такая файловая система, как FAT32, и реализована так, что может поддерживать неограниченную вложенность папок, в реальности не получится создать даже две вложенные папки с именами длиной 255 символов.

Примечание

При доскональной проверке вышесказанного выяснилось, что не получится создать даже одну папку с именем длиной 255 символов в корневой папке диска (например, C:). Папка может иметь имя длиной максимум 244 символа. С учетом длины имени корневой папки (в сумме получается уже 247 символов) можно предположить, что система резервирует оставшиеся 13 символов, чтобы в папке можно было сохранять файлы с именем в формате 8. 3 (формат, применявшийся в MS-DOS).

Системные папки WINDOWS и system

Приходилось ли вам хоть раз писать приложения, работоспособность которых зависела бы от места расположения системных папок Windows? Если да, то вы наверняка хорошо знаете, насколько неустойчиво предположение о том, что папка WINDOWS – всегда C:WINDOWS, а system – всегда C:WINDOWSsystem. Ведь при установке операционной системы ничто не мешает поместить ее, например, на диск E:а папку для Windows назвать Linux. Кроме того, системная папка Windows на платформе NT имеет имя system32, и кто знает, какое имя она будет иметь в следующей версии Windows?

В таких и многих других случаях выручают API-функции GetWindowsDirectory и GetSystemDirectory. Они обе принимают в качестве своих параметров строковый буфер и его длину и возвращают количество символов, записанных в переданный буфер, или 0 в случае ошибки.

Для этих функций удобно реализовать функции-оболочки, работающие со стандартными для Delphi строками, что, собственно, и сделано при написании этой главы (все реализованные функции вы можете найти в модуле PathFunctions, расположенном на диске, прилагаемом к книге, в папке с названием подраздела). Итак, код функции определения папки WINDOWS приведен в листинге 4.11.

Листинг 4.11. Определение адреса папки WINDOWS

function GetWinDir(): String;

var

buffer: String;

len: UINT;

begin

SetLength(buffer, MAX_PATH + 1);

len:= GetWindowsDirectory(PAnsiChar(buffer), MAX_PATH);

SetLength(buffer, len);

GetWinDir:= buffer;

end;

Аналогичным образом реализуется функция, позволяющая определить расположение системной папки (только вместо GetWindowsDirectory вызывается функция GetSystemDirectory).