Текст книги "Delphi. Трюки и эффекты"
Автор книги: Александр Чиртик
Жанр: Программирование, Компьютеры
сообщить о неприемлемом содержимом
Текущая страница: 7 (всего у книги 24 страниц)
В завершение рассмотрим довольно забавный пример, так же, как и предыдущий, основанный на программном нажатии клавиш Caps Lock, Num Lock и ScroLL Lock. Как известно, этим клавишам соответствуют три лампочки (по крайней мере, на большинстве клавиатур). Суть примера состоит в последовательном включении/выключении упомянутых клавиш, которое автоматически сопровождается включением/выключением соответствующих лампочек.
Перед рассмотрением основных процедур примера приведем текст процедуры PressKey, которая далее используется практически на каждом шагу (листинг 3.22). Она имитирует нажатие одной клавиши с переданным кодом.
Листинг 3.22. Нажатие одной клавиши
procedure PressKey(keyCode: Byte);
begin
keybd_event(keyCode, 0, 0, 0 );
keybd_event(keyCode, 0, KEYEVENTF_KEYUP, 0 );
end;
Запуск и остановка огней осуществляется при нажатии кнопки (помимо кнопки, на форме должно быть текстовое поле, в котором вводится интервал между сменой состояния огней, а также таймер со свойством Enabled, равным False) (листинг 3.23).
Листинг 3.23. Запуск и остановка огней
var
initCaps, initNum, initScroll: 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).
Перемещение огней происходит при каждом срабатывании таймера 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 для сохранения в ней максимальной длины компонента пути (имени файла или папки);
• ссылка на переменную типа Cardinal для сохранения в ней набора битовых флагов с некоторыми параметрами файловой системы;
• буфер для названия файловой системы (и его длина).
Как вы могли заметить, результатом работы приведенной в листинге 4.4 функции GetDrivelnf ormation является заполнение структуры (записи) Drivelnf о. Определение этой структуры (а также вложенной в нее структуры, хранящей некоторые извлеченные из битовой маски 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. Она принимает единственный параметр, задающий корневую папку диска (например, С: , причем обратный слэш на конце обязателен). Функция 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 (круговая диаграмма). У этого ряда отключено отображение подписей к диаграмме, чтобы не дублировать данные, приведенные в легенде.
4.2. Каталоги и пути
В этом разделе описываются некоторые полезные примеры, позволяющие узнавать расположение важных каталогов операционной системы Windows. Здесь также рассматриваются вопросы преобразования путей и приводятся некоторые алгоритмы обхода каталогов, применяемые для поиска.
Прежде чем рассматривать решения конкретных задач, следует уточнить, что за магическое число, а точнее, целочисленная константа используется в некоторых примерах, приведенных далее. Речь идет о константе МАХРАТН, равной 260. Она используется явно или неявно (функциями API) в качестве максимально возможной длины пути. Здесь налицо небольшой парадокс: хотя такая файловая система как FAT32, и реализована так, что может поддерживать неограниченную вложенность каталогов, в реальности не получится создать даже два вложенных каталога с именем длиной 255 символов.
Системные папки WINDOWS и systemПримечание
При доскональной проверке вышесказанного выяснилось, что не получится создать даже один каталоге именем длиной 255 символов в корневой папке диска (например, С: ). Каталог может иметь имя длиной максимум 244 символа. С учетом длины имени корневой папки (получается 247) можно предположить, что в таком случае система резервирует оставшиеся 13 символов, чтобы в папке можно было сохранять файлы с именем в формате 8.3 (MS-DOS).
Приходилось ли вам хоть раз писать приложения, работоспособность которых зависела от расположения системных папок Windows? Если да, то вы наверняка хорошо знаете, как неустойчиво предположение о том, что папка WINDOWS всегда C:WIND0WS, a system всегда C:WINDOWSsystem. Ведь при установке операционной системы ничто не мешает поместить ее, например, на диск Е:, а папку для 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 вызывается фyнкцияGetSystemDirectory.
Имена для временных файловДля централизованного хранения временных данных, необходимых при работе приложений, в Windows предусмотрена специальная папка Temp. Ее расположение может варьироваться. Причем в многопользовательских версиях Windows (NT, 2000, ХР) местоположение папки для временных файлов может быть различным для различных пользователей. Итак, расположение папки Temp поможет определить API-функция GetTempPath. Она принимает следующие параметры: строковый буфер и длину этого буфера. Возвращает количество символов, записанных в переданную строку, или 0, если возникла ошибка. Функция-оболочка, скрывающая работу со строковым буфером и преобразование типов, реализуется аналогично двум ранее рассмотренным функциям (листинг 4.12).
Листинг 4.12. Определение расположения папки для временных файлов
function GetTempDir(): String;
var
buffer: String;
len: UINT;
begin
SetLength(buffer, MAX_PATH + 1);
len := GetTempPath(MAX_PATH, PAnsiChar(buffer));
SetLength(buffer, len);
GetTempDir := buffer;
end;
Кроме того, Windows API предусматривает очень полезную функцию, избавляющую программиста от необходимости подбирать имена временных файлов так, чтобы они были уникальными в пределах заданной папки (это не обязательно должна быть папка Temp). Имя этой функции – GetTempFileName. Пример ее использования приведен в листинге 4.13.
Листинг 4.13. Определение имени временного файла
function GetTempFile(prefix: String = '~mytmp'): String;
var
buffer, dir: String;
begin
dir := GetTempDir();
//Получение имени временного файла (система сама определяет
имя,
//уникальное для заданной папки)
SetLength(buffer, MAX_PATH + 1);
GetTempFileName(PAnsiChar(dir), PAnsiChar(prefix), 0,
PAnsiChar(buffer));
GetTempFile := buffer;
end;
Приведенная в листинге 4.13 функция в качестве папки для временных файлов использует папку Temp. Однако функцию GetTempFileName можно использовать для получения имен файлов в пределах любой папки.
Кроме пути папки, в которой необходимо создать временный файл, функция GetTempFileName принимает строку-префикс для имени временного файла и целочисленное значение (третий параметр). Если третий параметр не равен нулю, то его значение в шестнадцатеричной форме просто прибавляется справа к строке prefix. Никаких проверок на уникальность получившегося имени файла при этом не производится. Если же третий параметр установить в 0, то система сама сформирует шестнадцатеричное значение так, чтобы имя файла было уникальным в заданной папке. Кроме того, при этом создается и сам файл.
Буфер (последний параметр функции GetTempFileName) должен вмещать как минимум МАХРАТН символов, так как функция записывает в него полный путь временного файла.
Пример работы функций определения папки для временных файлов, получения имени для временного файла, а также определения системных папок Windows приводится на рис. 4.2.
Рис. 4.2. Папки WINDOWS, system, Temp и имя для временного файла
Правообладателям!
Это произведение, предположительно, находится в статусе 'public domain'. Если это не так и размещение материала нарушает чьи-либо права, то сообщите нам об этом.