Delphi 3. Библиотека программиста

От редактора перевода
Предисловие Глава 1. 32-разрядные консольные приложения Консольные приложения Фильтры Консольные приложения на Delphi Hello, Delphi Сохранение шаблона программы Консольный ввод/вывод Программа-фильтр на Delphi Базовая программа-фильтр Обработка командной строки Параметры командной строки Универсальный анализатор командных строк Тестирование модуля CmdLine Несколько слов о структуре программы Файловые операции чтения/записи Использование шаблона Filter Критика Глава 2. 32-разрядные DLL в Delphi - когда, зачем и как

Что такое DLL и зачем они нужны? Как это сделать? Создание DLL Вызов функций DLL Присоединение DLL на стадии выполнения Где Windows ищет DLL DLL: недостатки и предостережения Создание форм в DLL Гибкое кодирование Создание текстового редактора Совместное использование памяти в приложениях Переменная DLLProc Продолжаем! Глава 3. Перетаскивание: как это делается в Windows Перетаскивание Что делать с кодом Windows? Обработка сообщений Windows Нестандартные элементы Субклассирование Определение интерфейса Реализация нового интерфейса Снова о субклассировании Глава 4. Перетаскивание: как это делается в OLE Что такое OLE? Наследование OLE и TInterfacedObject Требования к перетаскиванию OLE Обязанности клиента Как работает программа Что дальше? Хочу быть сервером! Обязанности сервера Требования к интерфейсу IDropSource Интерфейс IDataObject хранит данные Реализация сервера OLE! Глава 5. Компонент Winsock в Delphi Что такое Winsock? Изучаем CsSocket Приложение RESOLVER32 Как меня зовут? Какой у тебя адрес? Как тебя зовут? Асинхронное получение адреса Кто находится по этому адресу? Отмена операции WSAAsync Преобразование портов и сервисов Поиск сервиса Преобразование протоколов Использование свойства Tag Стоит ли блокировать? Глава 6. CsShopper: FTP-клиент Вас обслуживают? Компонент CsShopper Организация вывода SHOPPER32 за работой Профили SHOPPER32 Подключение Закрываем соединение Прием и передача файлов Изменение каталогов для пересылки файлов Передача файлов Пересылка нескольких файлов Асинхронная пересылка файлов Положи на место! Заключение Глава 7. FTP-сервер CsKeeper за работой Конфигурирование KEEPER32 на вкладке Options Вопросы безопасности Где и как хранится конфигурация Открываемся! Вывод списка каталогов и файлов Создание прослушивающего сокета Как вас обслуживают? Вход строго по одному Мне, пожалуйста, вот это… Сохраните, пожалуйста… Закрыто на переучет Глава 8. Трехмерные фрактальные ландшафты Разделяй и сгибай Проблема общих сторон Треугольный массив Изгибы Сначала построить, потом выводить Генерация и отображение ландшафта Процедура Project() Каркасный режим Режим с заполнением Режим со светотенью Создавайте собственные миры Глава 9. Проблемы TPersistent и несколько полезных советов Читаем, чтобы записывать? Разумные решения Использование RDTSC для измерения временных интервалов на Pentium Перетаскивание текста в списках Строковые коллекции и списки Установка приложений - дело рук самих приложений Использование inherited с переопределенными свойствами Копирование экрана Группы переключателей с индивидуальной блокировкой Захват системной палитры Работа с буфером как с потоком Оперативное изменение подсказок Использование макросов в редакторе Delphi Потоки и TPersistent Отображение перетаскиваемого объекта в Delphi 2 и 3 Глава 10. Модели, виды и фреймы Практическая реализация видов Шаблоны компонентов и составные компоненты Наследование форм От внедренных форм к видам Почему интерфейсы? Интерфейсные формы Проблемы с подсчетом ссылок в Delphi 3 Абстрактные, контролируемые и неконтролируемые виды Редакторы моделей Пример модели Другие применения Глава 11. Таинственный модуль Math Три веских довода в пользу модуля Math Динамические данные и статические объявления Slice спешит на помощь Создание компонента DBStatistics Получение доступа к данным Локальное хранение данных Извлечение данных Статистическая обработка Тестирование компонента DBStatistics Ошибки в модуле Math второй версии Delphi Пропавшая функция Poly Сводка функций модуля Math Тригонометрические функции и процедуры Арифметические функции и процедуры Финансовые функции и процедуры Статистические функции и процедуры Глава 12. Динамический пользовательский интерфейс Пример приложения «Настрой меня сам» Строим «мини-Delphi» для пользователей Перемещение элементов Масштабирование элементов Работа с контекстным меню Отмена изменений Изменение порядка перебора элементов во время выполнения Изменение других свойств Изменение свойств в инспекторе объектов Сохранение внесенных изменений Загвоздка: компоненты со свойствами-компонентами Другой подход к потокам На пути к гибким пользовательским интерфейсам Глава 13. Иерархические структуры в реляционных базах данных Иерархия «один-ко-многим» Простейший пример иерархических рекурсивных данных Использование TQuery для определения набора подчиненных записей Вложенные рекурсивные иерархические данные Перемещение по иерархии Отображение данных Использование данных Поиск записей Применение иерархических данных в запросах Целостность структуры и циклические ссылки Использование SQL Проблема произвольной вложенности Использование сохраненных процедур Компоненты TreeData Работа со свойствами элементов TreeData Внутреннее строение компонентов TreeData TreeDataComboBox TreeDataListBox TreeDataOutline и TreeDataUpdate Главный секрет иерархий Глава 14. Пропавший оракул Вечером в конторе Мольба о помощи Пропажа На другом краю города Классическое перетаскивание Перетаскивание: как это делается Сброс груза Упаковка таблиц Paradox и dBASE Демонстрационная программа Снова в конторе Эйса Смысловые оттенки Воспроизведение WAV-файла Звук в приложении Упущение Глава 15. Улика, найденная в грязи Масштабирование форм Создание заставок Эйс получает ответ Глобальный доступ к данным в приложении Потрясающее открытие Прогулка по Win95 Внимание, сейчас вылетит птичка… Модуль WalkStuf Итоги Глава 16. Возвращение оракула Совместное использование обработчиков событий Первая попытка Тернистый путь познания И последнее замечание… Использование файлов в памяти Перед началом Запрет выполнения программы Плавающие панели инструментов Эйс выходит победителем Эпилог Глава 17. Нестареющая проблема Сложная ситуация Суть проблемы Конструирование DLL Инициализация Сигналы от семафора Завершение Функции DLL Создание компонента-отправителя Создание компонента-получателя Субклассирование окна-владельца Другие интересные моменты Создание демонстрационной программы Receiver Создание демонстрационной программы Sender Внезапное пробуждение

Сохранение шаблона программы

Создать консольное приложение не так уж сложно, но при этом все же приходится помнить о некоторых нюансах. Поэтому, вместо того чтобы каждый раз строить приложение на пустом месте (и благополучно забывать об этих нюансах), давайте сохраним программу Hello в хранилище объектов, чтобы у нас появилась отправная точка для создания других консольных приложений.

С помощью Windows Exploder (в Windows NT 3.51 мы любили называть эту программу File Mangler) создайте подкаталог ConsoleApp в подкаталоге Objrepos основного каталога Delphi. Если вы установили Delphi со стандарт ными параметрами, полный путь будет выглядеть так:

C:\Program Files\Borland\Delphi 3\Objrepos\ConsoleApp

Затем выполните команду Project <> Save Project As из меню Delphi и сохрани те проект под именем ConsoleApp.dpr (хорошая штука - длинные имена!) в только что созданном каталоге.

После того как проект будет сохранен, включите его в хранилище командой Project д Add to Repository, после чего заполните диалоговое окно Add to Repository (см. рис. 1.1).

Рис. 1.1. Шаблон консольного приложения добавляется в хранилище

После того как проект будет добавлен в хранилище, попробуйте выполнить команду File <> New в меню Delphi, перейдите на вкладку Projects в диалоговом окне New Items и дважды щелкните на значке Console Application. Delphi предложит указать каталог и создаст новый проект с параметрами, заранее настроенными для консольного приложения.

Замечание

Я так и не решил, стоит ли держать свои объекты непосредственно в каталогах хранилища Delphi. Это довольно удобно, но любое обновление версии Delphi может обернуться неприятностями. Скорее всего, при обновлении каталог Objrepos будет удален - вместе со всеми замечательными объектами, которые в нем находятся. Вам придется вручную сохранять их перед каждым обновлением.

Существует и другой вариант - создать собственный каталог-хранилище, не принадлежа щий основному каталогу Delphi. В любом случае при обновлении Delphi вам придется заново включать объекты в хранилище, но отдельный каталог по крайней мере защитит ваши проекты от случайного удаления.

Сохранение внесенных изменений

Теперь мы располагаем средствами для изменения практически любой составляющей пользовательского интерфейса. Желательно найти способ сохране ния этих изменений, чтобы они становились постоянными. Пользователь вряд ли обрадуется, если ему придется заново настраивать интерфейс при каждом запуске приложения! Возникает искушение решить проблему с помощью INI-файлов (или, для самых смелых — системного реестра Windows 95), но оба способа обладают серьезными недостатками. Проблема заключается в том, что каждый компонент обладает множеством свойств различных типов, и вам не удастся написать обобщенный метод Save_This_Component.

Теоретически можно проверять тип каждого компонента и затем сохранять свойства, относящиеся к данному типу. Но, согласитесь, такой вариант не слишком эффективен. С другой стороны, можно сохранять лишь общие свойства всех компонентов. Поскольку тип TComponent — предок всех остальных компонентов — имеет лишь девять свойств (не считая Left, Top, Width и Height), это тоже бесполезно.

Но не все потеряно! Существует несколько очень хороших механизмов сохранения и загрузки свойств компонентов. Нужно лишь покопаться в документации Borland и немного поэкспериментировать.

Конечная цель этих раскопок — семейство объектов TFiler/TWriter/TReader. Согласно справочным файлам Delphi, TFiler — «абстрактный базовый класс для объектов чтения и записи, которые используются Delphi для сохранения (и загрузки) форм и компонентов в DFM-файлах».

В этом определении сказано нечто очень важное для нас, а именно: объекты TWriter и TReader могут использоваться для сохранения и загрузки свойств компонента. Связывая экземпляр класса TWriter или TReader с потоком TFile Stream, мы сможем воспользоваться методами WriteRootComponent и ReadRoot Component для решения своей проблемы.

Сохраните, пожалуйста…

STOR — зеркальное отражение команды RETR. Вместо того чтобы передавать файл клиенту, CsKeeper сохраняет (stores) полученный файл, отсюда и название команды. При получении компонентом CsKeeper команды STOR процедура DecodeFTPCmd анализирует командную строку и переходит к ветви STOR оператора case, в котором обрабатываются различные команды. Если значение FUpLoads равно TRUE (помните, мы можем запретить передачу файлов на сервер, снимая соответствующий флажок на вкладке Options), вызывается метод TCsKeeper.GetFile. В противном случае DecodeFTPCmd посылает отрицательный ответ с кодом 500.

TCsKeeper.GetFile создает для соединения данных локальный сокет с именем LocalSocket; для этого используется вызов функции connect, входящей в Winsock API:

if connect (LocalSocket, DataS, SizeOf(TSockAddrIn))= SOCKET_ERROR then
{ продолжение... }

После открытия файла мы сохраняем поступающие данные в цикле while…do с помощью функций recv (Winsock API) и BlockWrite:

while not Finished do
begin
Response := recv(LocalSocket, Buffer, SizeOf(Buffer), 0);
{ пропуск... }
if Response > 0 then
BlockWrite(F, Buffer, Response);
end;

После того как все данные от клиента будут приняты, TCsKeeper.GetFile закрывает установленное через LocalSocket соединение данных и передает клиенту положительный код ответа 226 с помощью процедуры SendFtpCode.

Совместное использование обработчиков событий

Зловещая фигура склонилась над книгой и продолжала читать.

Дневник №16, 29 марта. В сегодняшней почте среди счетов я нашел приглашение на свадьбу наших старых друзей — пары, с которой мы с Хелен познакомились еще в колледже. Текст гласил: «Приходи и раздели с нами
это радостное событие».

Бросив открытку на стол, я подумал о том, что «разделять события» можно и по-другому — например, за счет использования общих обработчиков для событий, требующих похожих действий.

Я решил написать простое приложение для исследования этой концепции. После некоторых размышлений я придумал программу «Список неотложных дел», которая развивает демонстрационную программу перетаскивания, написанную несколько дней назад.

Новая программа (как и ее предыдущий вариант) содержит текстовое поле для ввода заметок. Но вместо календаря я создал три отдельные сетки — для утренних, дневных и вечерних дел. Эти сетки находятся на отдельных вкладках окна. Модель формы в режиме конструирования изображена на рис. 16.1.

?ис. 16.1. Демонстрационная программа для совместного использования обработчиков

Совместное использование памяти вприложениях

К счастью для нас, программистов, Delphi создает DLL, по умолчанию допускающие существование нескольких экземпляров , так что хотя бы одной заботой становится меньше. Тем не менее возможность создания нескольких экземпляров еще не означает, что вам удастся легко организовать обмен информацией между процессами, использующими одну и ту же DLL. В Windows95 и Windows NT каждый экземпляр DLL обладает собственным сегментом данных, так что вы не сможете воспользоваться простой глобальной переменной Delphi для того, чтобы передать информацию от одного работаю щего приложения другому. Для этого придется создать общий блок памяти в Windows. А для этого в свою очередь необходимо понимать, как происходит загрузка и настройка DLL в Windows и Delphi.

Создание DLL

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

Листинг 2.1. Простейшая DLL

{ BEEPER.DPR — пример простейшей DLL Автор: Джим Мишель Дата последней редакции: 12/05/97 } library beeper; uses Windows; procedure BeepMe; stdcall; begin MessageBeep (0); end; Exports BeepMe index 1 name "BeepMe"; begin end.

DLL начинаются с ключевого слова library вместо привычного program или unit. В них также имеется оператор uses. Также обратите внимание — DLL, как и программы, не имеют отдельных секций interface и implementation. Процедуры и функции DLL пишутся точно так же, как и процедуры/функ ции программ, но их необходимо явным образом экспортировать (используя ключевое слово Exports), чтобы они стали доступны для других программ.

Присутствие ключевого слова stdcall необязательно, но его все же стоит включать. Экспортированные функции DLL, имеющие модификатор stdcall, совместимы с другими языками программирования (например, C++), которые могут обращаться к DLL. Наличие stdcall никак не отражается на работе экспортированных функций. Я рекомендую включать stdcall, если экспортированные функции могут вызываться из программ, написанных на C/C++.

Ключевое слово Exports сообщает компилятору, какие функции должны быть доступны для других программ. В своем примере я экспортировал процедуру BeepMe по имени и порядковому номеру — и то и другое является необязательным. Несколько экспортируемых функций могут разделяться запятыми. Следовательно, если в DLL входит другая функция с именем PageMe, оператор Exports может выглядеть так:

Exports
BeepMe index 1 name "BeepMe",
PageMe index 2 name "PageMe";

Чтобы создать DLL, выполните команду File д New и выберите DLL в диалоговом окне New Items. Введите содержимое листинга 2.1, сохраните его под именем BEEPER.DPR и затем откомпилируйте. Напрямую запустить DLL не удастся — для этого нужна другая (вызывающая) программа.

Создание форм в DLL

Наверное, DLL в программировании на Delphi чаще всего применяются для хранения общих форм. Если вы пишете целый программный комплекс, вероятно, многие формы будут использоваться сразу в нескольких программах. Вместо того чтобы размножать одинаковые формы, их можно вынести в отдельную DLL. При этом вы сэкономите место на диске и (что еще важнее) избавитесь от хлопот по сопровождению. DLL с формами Delphi отягощается кодом runtime-библиотеки (около 100 Кбайт), но если одна DLL будет содержать сразу несколько форм, излишек не так уж страшен.

Обращение к форме, находящейся в DLL, несколько отличается от работы с формой, находящейся в самой программе. Поскольку модуль, содержащий форму, не включается в программу, вы не сможете отобразить форму так, как это делается в обычной программе (то есть вызывая Form1.ShowModal). Вместо этого вам придется создать в DLL функцию-оболочку и затем вызвать ее из основной программы. Функция-оболочка создает форму, отображает ее, получает необходимые данные и уничтожает форму при ее закрытии, после чего возвращает информацию основной программе.

В листингах 2.4 и 2.5 содержатся исходные тексты файлов PICKCLR.DPR и COLORFRM.PAS, которые реализуют форму для выбора цвета в виде DLL.

Листинг 2.4. Файл PICKCLR.DPR

{ PICKCLR.DPR — DLL с формой для выбора цвета Автор: Джим Мишель Дата последней редакции: 12/05/97 } library pickclr; uses SysUtils, Classes, ColorFrm in "colorfrm.pas" {ColorSelectionForm}; Exports ColorFrm.PickColors index 1 name "PickColors"; begin end.

Листинг 2.5. Модуль COLORFRM.PAS

{ COLORFRM.PAS — Выбор цвета с помощью формы, хранящейся в DLL Автор: Джим Мишель Дата последней редакции: 12/05/97 } unit colorfrm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ColorGrd; type TColorSelectionForm = class(TForm) ColorGrid1: TColorGrid; BtnOk: TButton; BtnCancel: TButton; private { Private declarations } public { Public declarations } function Execute : boolean; end; function PickColors (var Foreground, Background : TColor) : boolean; stdcall; export; implementation {$R *.DFM} function TColorSelectionForm.Execute : boolean; begin Result := (ShowModal = mrOk); end; function PickColors (var Foreground, Background : TColor) : boolean; stdcall; var ColorForm : TColorSelectionForm; begin ColorForm := TColorSelectionForm.Create (Application); Result := ColorForm.Execute; if (Result = True) then begin Foreground := ColorForm.ColorGrid1.ForegroundColor; Background := ColorForm.ColorGrid1.BackgroundColor; end; ColorForm.Free; end; end.

Обратите внимание — модуль COLORFRM можно без всяких изменений подключить как к программе, так и к DLL. Это заметно облегчает перенос форм из программ в DLL. Для удобства отладки следует создать форму и отладить ее в программе. Добившись правильной работы, перенесите форму в заранее подготовленную оболочку DLL.

Как видно из листинга 2.4, файл проекта для DLL выглядит очень просто. Главное — правильно написать секцию Exports. Чтобы добавить в DLL другие формы, достаточно включить имена их модулей в секцию uses и добавить определения функций-оболочек в секцию Exports.

Интерфейсный модуль любой DLL с формами должен напоминать BEEPDLL.PAS из листинга 2.3. Как и BEEPDLL, он должен предоставлять возможность выбора между статическим и динамическим импортом. Дляэкономии места я не стал приводить интерфейсный модуль для PICKCLRDLL.

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

Создание компонента DBStatistics

Мы только что научились передавать динамические данные функциям модуля Math с помощью Slice. Теперь нужно придумать способ эффективного применения имеющихся средств для анализа баз данных. Самый простой и удобный выход— «упаковать» нужные функции в компоненте с подходящим именем DBStatistics.

Определение задач компонента

Построение компонента желательно начать с определения тех задач, которые он должен решать. Наверное, вы догадались, что сейчас мы займемся именно этим применительно к DBStatistics.

Главная задача DBStatistics — предоставлять простой доступ к одному, нескольким или всем 13 статистическим показателям после задания имени поля и источника данных. Для этого компоненту понадобится следующее:

Доступ к данным, желательно через стандартный источник данных (DataSource). Место для локального хранения больших объемов данных. Способ извлечения данных из источника. Способ удобного получения любого из 13 статистических показателей.

В следующих четырех разделах мы детально рассмотрим все эти пункты.

Создание прослушивающего сокета

До настоящего момента мы занимались подготовкой, причем вся работа в основном сводилась к созданию текстовых файлов. Теперь настало время воспользоваться Windows Sockets. Прежде всего необходимо вызвать CsSocket.Get Server, чтобы инициализировать структуры данных, необходимые для сервиса FTP. Процедура инициализации приведена в листинге 7.4.

Листинг 7.4. Метод CsSocket.GetServer

procedure TCsSocket.GetServer; begin GetServ; if Status = Failure then Exit; FSockAddress.sin_family := PF_INET; FSockAddress.sin_port := FServ^.s_port; FSockAddress.sin_addr.s_addr := htonl(INADDR_ANY); FRemoteName := LocalName; FSocket := CreateSocket; end;

После того как все необходимые структуры данных инициализированы, GetServer вызывает CreateSocket, чтобы создать прослушивающий сокет FSocket. Далее мы вызываем функцию Winsock API с именем WSAAsyncSelect, чтобы приказать Winsock DLL извещать CsKeeper о событиях сокета посредством отправки сообщений в адрес Wnd (это логический номер окна типа HWND). Для этого используется следующая строка:

if WSAAsyncSelect(FSocket, Wnd, FTP_EVENT, FD_ACCEPT) = SOCKET_ERROR then

Затем мы вызываем bind, еще одну функцию Winsock API, чтобы связать локальное имя с безымянным сокетом FSocket, а также с адресом хоста и номером порта. Это необходимо для прослушивания порта на предмет устанав ливаемых соединений. Функция listen сообщает CsKeeper о необходимости прослушивания порта 21. После вызова этой функции программа KEEPER32 готова к установке соединения через этот порт.

Создание текстового редактора

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

Создайте новый проект, поместите на форму компонент Memo и задайте его свойству Align значение alClient, чтобы он занял всю форму. Затем добавьте на форму компоненты MainMenu, OpenDialog и SaveDialog. В режиме конструирования меню добавьте три команды: Open, Save и Exit. Сохраните модуль формы в виде файла EDITFORM.PAS, а файл проекта — под именем TEXTEDIT.DPR. Готовая форма показана на рис. 2.1, а текст программы содержится в листинге 2.6.

Рис. 2.1. Готовая форма текстового редактора

Листинг 2.6. Форма текстового редактора, EDITFORM.PAS

{ EDITFORM.PAS — Простейший текстовый редактор, демонстрирующий использование DLL Автор: Джим Мишель Дата последней редакции: 12/05/97 } unit editform; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls; type TForm1 = class(TForm) Memo1: TMemo; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; MainMenu1: TMainMenu; File1: TMenuItem; Open1: TMenuItem; Save1: TMenuItem; N1: TMenuItem; Exit1: TMenuItem; procedure Exit1Click(Sender: TObject); procedure Open1Click(Sender: TObject); procedure Save1Click(Sender: TObject); private { Private declarations } FileName : String; procedure OpenFile(Filename: String); procedure SaveFile(Filename: String); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} uses IniFiles; procedure TForm1.Exit1Click(Sender: TObject); begin Close; end; procedure TForm1.Open1Click(Sender: TObject); begin if OpenDialog1.Execute then OpenFile (OpenDialog1.FileName); end; procedure TForm1.Save1Click(Sender: TObject); begin if SaveDialog1.Execute then SaveFile (SaveDialog1.FileName); end; procedure TForm1.OpenFile (Filename: String); begin Memo1.Lines.LoadFromFile(Filename); end; procedure TForm1.SaveFile (Filename: String); begin Memo1.Lines.SaveToFile (Filename); end; end.

Протестируйте программу и убедитесь в том, что она загружает и сохраняет ASCII-файлы (годится любой файл с расширением .TXT, а также .PAS и .DPR).

Мы хотим сделать так, чтобы наша программа читала другие файловые форматы, преобразовывала их в обычный текст и выводила его. Заранее неизвестно, какие форматы придется преобразовывать, поэтому нам потребуется возможность добавлять форматы по мере необходимости. Вероятно, простейший выход заключается в использовании файла инициализации (INI-файла).

Общая идея — поместить в INI-файл описание файлового формата, стандартное расширение и имя DLL, выполняющей преобразование. Пример такого INI-файла приведен в листинге 2.7.

Листинг 2.7. Файл TEXTEDIT.INI

; TEXTEDIT.INI ; Пример интерфейса расширения для файловых преобразований [Text] Extension=.TXT ConvertDLL=textconv.dll [Word for Windows] Extension=.DOC ConvertDLL=wfwconv.dll [WordCruncher] Extension=.WCX ConvertDLL=wcxconv.dll

Нам придется изменить процедуру OpenFile так, чтобы она просматривала расширение имени открываемого файла и затем вызывала функцию преобразования из соответствующей DLL. Функция читает файл, преобразовы вает текст и возвращает результат в виде списка строк. Для выполнения всех преобразований используется функция Convert, вызываемая из текстового редактора. В листинге 2.8 содержится новый вариант функции OpenFile (не забудьте добавить модуль IniFiles в строку uses модуля формы), а в листингах 2.9 и 2.10 — исходный текст DLL текстовых преобразований (TEXTCONV.DLL).

Листинг 2.8. Новая функция OpenFile

procedure TForm1.OpenFile (Filename: String); type ConvertFunc = function (Filename: String; Strings: TStrings): boolean; stdcall; var ConvertIni : TIniFile; ConvertList : TStringList; FileExt : String; Extension : String; DLLName : String; x : Integer; Found : Boolean; LibInstance : HMODULE; Converter : ConvertFunc; IniFileName : String; begin FileExt := UpperCase (ExtractFileExt (Filename)); IniFileName := ExtractFileDir (ParamStr (0)) + "\TEXTEDIT.INI"; ConvertIni := TIniFile.Create (IniFileName); ConvertList := TStringList.Create; { Считываем список возможных преобразований } ConvertIni.ReadSections (ConvertList); { Для каждого преобразования читаем значение Extension и сравниваем его с расширением выбранного файла. } x := 0; Found := False; while ((x < ConvertList.Count) and (Not Found)) do begin Extension := ConvertIni.ReadString ( ConvertList.Strings[x], "Extension", ""); if (UpperCase (Extension) = FileExt) then Found := True else x := x + 1; end; if Found then begin DLLName := ConvertIni.ReadString ( ConvertList.Strings[x], "ConvertDLL", ""); { Загружаем DLL, получаем адрес функции Convert и вызываем ее. } LibInstance := LoadLibrary (PChar(DLLName)); if LibInstance = 0 then begin Application.MessageBox ( PChar ("Can"'t load DLL "+DLLName), "TextEdit", MB_ICONEXCLAMATION or MB_OK); end else begin Converter := GetProcAddress (LibInstance, "Convert"); if Not Assigned (Converter) then begin Application.MessageBox ( PChar ("Can"'t find Convert function in "+DLLName), "TextEdit", MB_ICONEXCLAMATION or MB_OK); end else begin if not Converter (Filename, Memo1.Lines) then begin Application.MessageBox ( "Error loading file", "TextEdit", MB_ICONEXCLAMATION or MB_OK); end; end; FreeLibrary (LibInstance); end; end else begin Application.MessageBox ( PChar("No conversion supplied for file type "+FileExt), "TextEdit", MB_ICONEXCLAMATION or MB_OK); end; ConvertList.Free; ConvertIni.Free; end;

Листинг 2.9. Файл TEXTCONV.DPR

{ TEXTCONV.DPR — DLL текстовых преобразований Автор: Джим Мишель Дата последней редакции: 12/05/97 } library textconv;

{ Важное замечание об управлении памятью в DLL: модуль ShareMem должен стоять на первом месте в секции USES библиотеки, А ТАКЖЕ в секции USES вашего проекта (команда View|Project Source), если ваша DLL экспортирует какие-либо процедуры или функции, использующие строки в качестве параметров или результатов функций. Это относится ко всем строкам, передаваемым вашей DLL или получаемым от нее — даже если эти строки вложены в записи или классы. ShareMem представляет собой интерфейсный модуль для менеджера памяти DELPHIMM.DLL, который должен использоваться вместе с вашей DLL. Чтобы обойтись без использования DELPHIMM.DLL, передавайте строковую информацию в параметрах типа PChar или ShortString. } 1

uses ShareMem, SysUtils, Classes, textc in "textc.pas"; Exports textc.Convert index 1 name "Convert"; begin end.

1Этот комментарий создается средой Delphi автоматически. Поскольку далее в тексте идет его обсуждение, здесь приведен русский перевод. — Примеч. ред.

Листинг 2.10. Модуль TEXTC.PAS

{ TEXTC.PAS — Модуль текстовых преобразований. Загружает текстовые файлы с диска. Автор: Джим Мишель Дата последней редакции: 12/05/97 } unit textc; interface uses Classes; function Convert (Filename: String; Strings: TStrings) : boolean; stdcall; export; implementation function Convert (Filename: String; Strings: TStrings) : boolean; stdcall; begin Strings.LoadFromFile (Filename); Result := True; end; end.

Обратите внимание на примечание в начале листинга 2.9 (TEXTCONV.DPR). Оно автоматически вставляется в файл проекта при выполнении команды File|New DLL. Честно говоря, я не уверен в том, что в данном случае ссылка на модуль ShareMem так уж необходима. Я попытался запустить программу без ShareMem, и она нормально работала. Кроме того, могу выдвинуть следующий аргумент: я передаю функции Convert не сам класс, а лишь указатель на объект TStrings. Впрочем, примечание, скорее всего, относится и к указателям на классы, поэтому на всякий случай я включил ShareMem в секции uses программы и DLL. Если вам придется использовать ShareMem, не забудьте поставлять файл DELPHIMM.DLL вместе с приложением.

Функция OpenFile из листинга 2.8 ни в коем случае не годится для коммерческой программы. Это лишь пример, который иллюстрирует общую концепцию. В коммерческом варианте ваша программа должна читать файл и (по возможности) определять его тип, а затем запрашивать у пользователя разрешение на выполнение преобразования, прежде чем начинать что-либо делать. Данный пример лишь показывает, как можно реализовать интерфейс расширения для вашего продукта.

Создание заставок

Таинственная фигура закрыла дневник и потянулась к телефону. Аппарат с готовностью проглотил семь набранных цифр, а затем выдал серию гудков. Где-то на другом конце линии зазвонил телефон. Раздался щелчок, в трубке послышался уже знакомый нам обворожительный голос, и Мститель заговорил.

— Привет, Крошка… Да, это я. Подумал, что тебе захочется узнать, как прошло дело ночью. Мне удалось вломиться в контору Эйса Брейкпойнта, как и было задумано, и украсть Дневник прямо у него из-под носа. Все прошло почти идеально… А твоя роль в этом дельце была просто бесценной. Без тебя у меня бы ничего не вышло… Что? Да, ждать пришлось долго— но поверь, тем слаще оказалась месть. Верно. Послушай, Крошка, бросай все и встречай меня в 9 часов у мотеля «Гейтс», возле шоссе 101. Точно — прямо на холме, сразу за Нортон Сити. Угу… Сегодня я покажу тебе книгу, которая изменит нашу жизнь и сделает меня самым гениальным программистом в мире. Да, Крошка, меня — Дельфийского Мстителя. Встречаемся в 9 вечера. Не опаздывай. Пока.

Мститель повесил трубку, взял дневник и, громко хихикая, снова принялся перелистывать его.

Дневник №16, 26 марта. Сегодня снова позвонил Торговец. На этот раз он хочет, чтобы я создал компонент-заставку, которым можно будет пользовать ся в разных программах. В общих чертах идея состоит в следующем:
поместить компонент на главную форму приложения, задать значения нескольких свойств и выдать окно заставки перед отображением главной формы.

Я начал думать, что же требуется от обобщенной заставки. Не так уж много. Вероятно, ее стоит сделать модальной, чтобы программа приостановилась на время, пока заставка будет должным образом показана. Необходимо позаботиться о том, чтобы заставка исчезала по тайм-ауту, по щелчку мышью или в обоих случаях. Разумеется, в заставке должно присутствовать графическое изображение. Я сел за компьютер и создал исходную форму (см. рис. 15.4).

Но как превратить ее в компонент? После пары неудачных попыток я решил, что лучший вариант — создать новый компонент, построенный на
основе TForm, но с добавлением промежуточного объекта-оболочки, управляющего работой TForm. Объект-оболочка может ограничиться управлением свойствами, связанными с объектом-заставкой, что позволит наделить заставку простым пользовательским интерфейсом. Кроме того, оболочка может заниматься созданием и уничтожением формы по простой команде,
выданной владельцем объекта-оболочки. Я решил назвать этот класс TSplashDialog.

В рамках исходной спецификации я решил написать несложное тестовое приложение ы— форму, которая содержит всего одну кнопку и которой будет принадлежать TSplashDialog. Исходный текст тестового приложения приведен в листинге 15.2.

Рис. 15.4. Исходная форма заставки

Листинг 15.2. Тестовое приложение для проверки TSplashDialog

{——————————} {Компонент-заставка } {SPLSHMN.PAS : Главная форма } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } {Простейшая программа, демонстрирующая } использование } {компонента TSplashDialog. Попробуйте задать} другие } {временные задержки, размеры, графические } изображения } {и убедитесь в богатстве возможностей. } { } { Написано для *High Performance Delphi 3 } Programming* } {Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 3/5/97 } {————————} unit SplshMn; {$define Test } interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, SplshDlg; type TForm1 = class(TForm) QuitBtn: TButton; procedure QuitBtnClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } {$ifdef Test } SplashDialog1: TSplashDialog; {$endif } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.QuitBtnClick(Sender: TObject); begin Close; end; procedure TForm1.FormCreate(Sender: TObject); begin {$ifdef Test} SplashDialog1 := TSplashDialog.Create (Application); {$endif} SplashDialog1.Execute; end; end.

Здесь есть один момент, на который следует обратить внимание: никогда не тестируйте создаваемый компонент, помещая его в библиотеку Delphi. Ошибки могут привести к неприятным, иногда даже очень неприятным последствиям. Кроме того, обновление библиотеки компонентов — процесс слишком медленный и нудный, чтобы заниматься этим перед каждым запуском программы. Вместо этого следует включить модуль компонента в тестовую программу и затем создать экземпляр компонента программным путем.

Именно это и происходит в данном случае. Использование условной директивы компилятора и константы с именем Test позволяет компилировать эту простую программу в двух режимах. Когда константа определена, условный код активен и в форме объявляется поле типа TSplashDialog с тем же именем (SplashDialog1), которое IDE присваивает компоненту при его помещении на форму. Использование условной проверки в обработчике OnCreate создает экземпляр SplashDialog1. В этом случае программа будет использовать небибли отечный объект TSplashDialog из скомпилированного модуля SplshDlg.

Когда компонент будет закончен и занесен в библиотеку, перед знаком $ в директиве ставится точка. В этом случае $define превращается в обычный комментарий, и программой можно будет пользоваться для тестирования установленной версии компонента.

Как видно из листинга, я решил воспользоваться диалоговым окном с помощью метода Execute — в соответствии с гордыми традициями специализи рованных системных диалоговых окон (например, TOpenDialog).

Сцена для TSplashDialog подготовлена. Теперь следует решить, какие свойства ему необходимы. Программист должен иметь возможность указать размер заставки, хотя я предполагаю, что она всегда будет выводиться в центре экрана. Необходимо передавать информацию о том, есть ли на форме кнопка, и если есть — ее название. Если диалоговое окно должно пропадать
по тайм-ауту, необходимо задать величину задержки. Кроме того, нам понадобится объект TPicture, подключаемый к компоненту TImage. Чтобы работа с
графикой была достаточно гибкой, программист должен иметь возможность задать выравнивание, определить, должен ли компонент TImage автоматически подгоняться под размеры изображения и следует ли растягивать изображе ние до размеров TImage.

Через пару часов у меня появился более или менее готовый компонент. Исходный текст приведен в листинге 15.3.

Листинг 15.3. Исходный текст компонента TSplashDialog

{——————————} { Компонент-заставка } { SPLSHDLG.PAS : Модуль компонента } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Модуль описывает специализированный компонент, } { отображающий окно-заставку в тот момент, когда } { программа захочет это сделать (обычно при запуске } { программы). } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 3/5/97 } {——————————————————————————————————————————————————————} unit SplshDlg; {$define Test } interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type ESplashConflict = class(Exception); TImageAlign = (iaNone, iaTop, iaBottom, iaLeft, iaRight, iaClient, iaAllAboveButton); { TSplashForm - форма, отображаемая на экране. Она содержит TImage, TButton и TTimer, чтобы программист мог гибко использовать заставку. } TSplashForm = class(TForm) CloseBtn: TButton; Image: TImage; DelayTimer: TTimer; procedure CloseBtnClick(Sender: TObject); procedure Button1Click(Sender: TObject); procedure DelayTimerTimer(Sender: TObject); private { Private declarations } public { Public declarations } end; { TSplashDialog - оболочка, окружающая TSplashForm. Форма принадлежит TSplashDialog, поэтому она может "автоматически" создаваться, настраиваться, выполняться и уничтожаться в любой момент. TSplashDialog открывает доступ лишь к тем свойствам, которые используются заставкой, а затем передает их форме TSplashForm при ее создании. } TSplashDialog = class(TComponent) private FAlign : TImageAlign; FAutoSize : Boolean; FButtonCaption : String; FCaption : String; FDelay : Word; FHasButton : Boolean; FHasDelay : Boolean; FHeight : Word; FPicture : TPicture; FStretch : Boolean; FWidth : Word; procedure SetCaption(Value : String); procedure SetDelay(Value : Word); procedure SetHasButton(Value : Boolean); procedure SetHasDelay(Value : Boolean); procedure SetHeight(Value : Word); procedure SetPicture(Value : TPicture); procedure SetWidth(Value : Word); public constructor Create(AOwner : TComponent); override; destructor Destroy; override; function Execute : Boolean; virtual; published property Align : TImageAlign read FAlign write FAlign; property AutoSize : Boolean read FAutoSize write FAutoSize; property ButtonCaption : String read FButtonCaption write FButtonCaption; property Caption : String read FCaption write SetCaption; property Delay : Word read FDelay write SetDelay; property HasButton : Boolean read FHasButton write SetHasButton; property HasDelay : Boolean read FHasDelay write SetHasDelay; property Height : Word read FHeight write SetHeight; property Picture : TPicture read FPicture write SetPicture; property Stretch : Boolean read FStretch write FStretch; property Width : Word read FWidth write SetWidth; end; procedure Register; implementation {$R *.DFM} procedure TSplashDialog.SetCaption(Value : String); begin if Value <> FCaption then FCaption := Value; end; { Задаем значение FHasButton. Если пользователь указал, что в заставке не должно быть ни кнопки, ни таймера, инициируем исключение - без них не удастся очистить экран! } procedure TSplashDialog.SetHasButton(Value : Boolean); begin if not Value and not FHasDelay then raise ESplashConflict.Create('Must have either a button or a delay!') else FHasButton := Value; end; { Задаем значение FHasDelay, защищаясь от аномального случая, описанного выше. } procedure TSplashDialog.SetHasDelay(Value : Boolean); begin if not Value and not FHasButton then raise ESplashConflict.Create('Must have either a button or a delay!') else FHasDelay := Value; end; procedure TSplashDialog.SetHeight(Value : Word); begin if (Value <> FHeight) and (Value > 10) then FHeight := Value; end; procedure TSplashDialog.SetWidth(Value : Word); begin if (Value <> FWidth) and (Value > 20) then FWidth := Value; end; procedure TSplashDialog.SetDelay(Value : Word); begin if (Value <> FDelay) and (Value > 0) then FDelay := Value; end; procedure TSplashDialog.SetPicture(Value : TPicture); begin if Value <> nil then FPicture.Assign (Value); end; constructor TSplashDialog.Create(AOwner : TComponent); begin inherited Create(AOwner); { Задаем значения по умолчанию} FAlign := iaAllAboveButton; FAutoSize := False; FStretch := False; FButtonCaption := 'OK'; FCaption := copy(ClassName, 2, Length(ClassName) - 1); FDelay := 3500; FHasButton := True; FHasDelay := True; FHeight := 200; FWidth := 300; FPicture := TPicture.Create; {$ifdef Test } FPicture.LoadFromFile('splash.bmp'); FAlign := iaClient; FHasDelay := False; {$endif } end; destructor TSplashDialog.Destroy; begin FPicture.Free; inherited Destroy; end; { Самое важное происходит в методе Execute. Он вызывается владельцем TSplashDialog в тот момент, когда необходимо вывести заставку. Execute создает объект SplashForm и изменяет его в соответствии с параметрами, передаваемыми SplashDialog. При закрытии SplashForm уничтожается. } function TSplashDialog.Execute : Boolean; var SplashForm : TSplashForm; begin try SplashForm := TSplashForm.Create(Application); except on E:Exception do begin MessageBeep(MB_ICONERROR); Result := False; Exit; end; end; { try } with SplashForm do begin Position := poScreenCenter; Caption := FCaption; Height := FHeight; Width := FWidth; if FAlign = iaAllAboveButton then begin if FHasButton then begin Image.Align := alTop; Image.Height := ClientHeight - CloseBtn.Height - 15; end else Image.Align := alClient; end else Image.Align := TAlign(Ord(FAlign)); Image.AutoSize := FAutoSize; Image.Stretch := FStretch; if Image.Picture <> nil then Image.Picture.Assign(FPicture); if FHasButton then begin CloseBtn.Caption := FButtonCaption; CloseBtn.Left := (ClientWidth - CloseBtn.Width) div 2; CloseBtn.Top := ClientHeight - CloseBtn.Height - 10; end else CloseBtn.Visible := False; if FHasDelay then begin DelayTimer.Interval := FDelay; DelayTimer.Enabled := True; end; try ShowModal; finally Free; Result := True; end; { try } end; { with } end; procedure TSplashForm.CloseBtnClick(Sender: TObject); begin Close; end; procedure Register; begin RegisterComponents('Ace''s Stuff', [TSplashDialog]); end; procedure TSplashForm.Button1Click(Sender: TObject); begin Close; end; procedure TSplashForm.DelayTimerTimer(Sender: TObject); begin Enabled := False; Close; end; end.

Приведенный фрагмент нуждается в нескольких комментариях. Я снова воспользовался условной директивой, чтобы компонент мог работать в двух режимах. В тестовом режиме (см. листинг 15.3) он автоматически загружает специальный тестовый растр и отключает таймер. Если вставить точку перед знаком $, директива превращается в комментарий, а файл можно будет откомпилировать в виде компонента Delphi и включить его в библиотеку.

Я добавил небольшой фрагмент для предотвращения ситуации, при которой в заставке нет ни кнопки, ни таймера (это означало бы, что модальное диалоговое окно не удастся убрать с экрана!). Кроме того, я объявил перечисляемый тип (TImageAlign), который расширяет возможности типа TAlign, добавляя в него вариант iaAllAboveButton. Он означает, что пользователь желает использовать клиентскую область формы, но лишь ту часть, которая находит ся над кнопкой. Да, чуть не забыл — я также объявил специальный класс
исключения, который обрабатывает все проблемы, обнаруженные в процессе задания свойств.

Самой интересной частью проекта оказался выбор объекта TPicture и помещение его в TImage. Получив несколько системных исключений, связанных с нарушением правил доступа, я начал прочесывать исходные тексты VCL и разыскивать все, что связано с выбором и назначением растровых изображений. Когда ответ был найден, я понял, насколько упростился этот процесс благодаря предусмотрительности разработчиков Delphi. Когда вы объявляе те свойство типа TPicture, Delphi IDE заранее знает, как с ним работать. Вы создаете экземпляр Tpicture в конструкторе объекта, а IDE вызывает Picture Editor для редактирования этого свойства. После того как в Picture Editor будет выбрано растровое изображение, оно автоматически сохраняется в потоке при закрытии файла формы. Это означает, что при следующем открытии файла растр окажется в нужном месте.

В полном соответствии с целями проектирования оболочка TSplashDialog управляет важнейшими свойствами формы. При вызове метода Execute объект TSplashDialog создает экземпляр формы, задает значения ее свойств и затем вызывает ShowModal, чтобы приостановить все прочие действия программы. Когда выполнение программы возобновляется, форма уничтожается. Тестовый вариант заставки изображен на рис. 15.5.

Рис. 15.5. Заставка во время выполнения программы

Создавайте собственные миры

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

С первого взгляда трудно понять, что «плазменные» алгоритмы представляют собой разновидность того же алгоритма построения фрактальных ландшафтов: вместо треугольников в них делятся прямоугольники, а третье измерение отображается с помощью цвета, а не перспективы.

Полный исходный текст программы FL3 вместе со всеми файлами Delphi 3, необходимыми для ее компиляции и запуска, находится на CD-ROM в каталоге этой главы.

Статистическая обработка

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

Метод, извлекающий все 13 показателей сразу; Отдельные методы доступа для каждого из 13 результатов, доступ к которым осуществляется с помощью свойств.

В своем компоненте мы реализуем оба подхода.

Для одновременного получения всех показателей используется процедура GetAllStats. Она передает массив Data всем 13 статистическим функциям и сохраняет результаты в переменных, определенных в секции private нашего компонента. Кроме того, флагу DidGetAll присваивается True — это показывает другим методам, что все статистические показатели уже получены.

Разумеется, отдельные методы доступа могут проверять значение DidGetAll. Если оно равно True, метод доступа просто возвращает ранее сохраненную величину. С другой стороны, если флаг DidGetAll равен False, метод доступа может вызвать соответствующую функцию модуля Math напрямую и вернуть полученный результат. В качестве примера типичного метода доступа мы рассмотрим метод GetMean, который возвращает среднее арифметическое для поля DataField из выбранного диапазона записей.

Прежде всего необходимо позаботиться о том, чтобы данные были получены из источника и сохранены в массиве

Data: if not (IsArrayFilled) then FillArray;

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

С другой стороны, если среднее арифметическое еще не вычислялось, мы вызываем соответствующую функцию модуля Math с использованием функций Slice и GetRange. В итоге мы возвращаем значение, полученное от модуля Math:

if not (DidGetAll) then

fMean := Math.Mean(Slice(Data,GetRange));

Result := fMean;

Теперь мы располагаем быстрым и удобным способом получения любого статистического показателя и можем вставить TDBStatistics в любой проект.

Статистические функции и процедуры

MaxIntValue Максимальное значение в наборе целых чисел. Функция по-
явилась в Delphi 3, ее не существует в Delphi 2

MaxValue Максимальное значение в наборе чисел. В Delphi 2 функция
возвращает минимальное значение

Mean Среднее арифметическое для набора чисел

MeanAndStdDev Одновременное вычисление среднего арифметического и
стандартного отклонения для набора чисел. Вычисляется
быстрее, чем обе величины по отдельности

MinIntValue Минимальное значение в наборе целых чисел. Функция по-
явилась в Delphi 3, ее не существует в Delphi 2

MinValue Минимальное значение в наборе чисел. В Delphi 2 функция
возвращает максимальное значение

MomentSkewKurtosis Статистические моменты порядков с первого по четвертый,
а также асимметрия (skew) и эксцесс (kurtosis) для набора
чисел

Norm Норма для набора данных (квадратный корень из суммы
квадратов)

PopnStdDev Выборочное стандартное отклонение. Отличается от обыч-
ного стандартного отклонения тем, что при вычислениях ис-
пользуется выборочное значение дисперсии, PopnVariance (см.
ниже)

PopnVariance Выборочная дисперсия. Использует «смещенную» формулу
TotalVariance/n

RandG Генерация нормально распределенных случайных чисел с за-
данным средним значением и среднеквадратическим от-
клонением

StdDev Среднеквадратическое отклонение для набора чисел

Sum Сумма набора чисел

SumsAndSquares Одновременное вычисление суммы и суммы квадратов для на-
бора чисел. Как и в других функциях модуля Math, обе вели-
чины вычисляются быстрее, чем по отдельности

SumInt Сумма набора целых чисел. Функция появилась в Delphi 3,
ее не существует в Delphi 2

SumOfSquares Сумма квадратов набора чисел

TotalVariance «Полная дисперсия» для набора чисел. Это сумма квадратов
расстояний всех величин от их среднего арифметического

Variance Выборочная дисперсия для набора чисел. Функция ис-
пользует «несмещенную» формулу TotalVariance/(n1)

Стоит ли блокировать?

Если ваше приложение использует локальную систему DNS и целевой хост находится в локальной сети, использование блокирующих функций существенно уменьшает объем накладных расходов. Тем не менее, если приложение подключается к хостам за пределами локальной сети и при этом часто используется удаленная DNS, асинхронные вызовы обладают явным преимуществом — во время ожидания ваше приложение может выполнять полезную работу.

CsSocket не претендует на звание идеального компонента Winsock, и все же он образует неплохую основу для построения других Internet-компонентов. Теперь, после знакомства с CsSocket, мы перейдем к построению более интересных приложений, в которых участвуют дочерние компоненты, созданные на базе CsSocket. В следующей главе мы построим клиентское приложение FTP. Все дальнейшее оставляю вашему воображению.

Строим «мини-Delphi» для пользователей

При проектировании программы в среде Delphi вы используете ряд инструментов для настройки внешнего вида программы и ее поведения. Чтобы пользователи смогли переделать вашу программу на свой лад, им потребует ся следующее:

	средства для перемещения элементов во время выполнения;
	средства для масштабирования элементов во время выполнения;
	средства для изменения порядка перебора элементов после их перемещения;
	средства для изменения некоторых свойств элементов(например, цвета или стиля рамки);
	возможность автоматического сохранения и загрузки внесенных изменений.

Разумеется, все эти средства должны быть быстрыми, простыми и удобными. Желательно, чтобы пользователи располагали почти теми же (если не всеми) возможностями, какие мы, программисты, имеем в режиме констру ирования. В некотором смысле мы предоставляем им во время работы приложения специальную, слегка «урезанную» версию Delphi. В этой главе объясняется, как можно решить каждую задачу из приведенного выше списка.

Строковые коллекции и списки

Когда я переходил с Borland Pascal на Delphi, мне хотелось, чтобы строковые списки (TStringList) были похожи на строковые коллекции (TStringCollection)— ну как можно обойтись без итераторов ForEach?

Но когда я потом попытался перенести приложение Delphi обратно на Turbo Vision, мне сразу захотелось, чтобы строковые коллекции стали похожими на строковые списки.

Добавление и удаление строк в коллекциях по сравнению с удобными операциями списков выглядит как замешивание цемента — в основном из-за простоты и четкости нового синтаксиса Object Pascal.

Сравните код для добавления нового объекта в коллекцию Turbo Vision

AStringColl^.AtInsert(AStringColl^.Count, NewStr(S));
S := PString(AStringColl^.At(Index))^;

с аналогичным кодом для строкового списка Delphi

StringList.Add(S);
S := StringList[Index];

и вы поймете, что я имею в виду. Операции со строковыми коллекциями практически не читаются, а вторая строка приведенного выше фрагмента просто неверна. Если указатель PString равен NIL (то есть в коллекцию добавлена пустая строка), то в строковую переменную S попадет «мусор».

К счастью, на основе TStringCollection можно создать новый объект, облегчающий работу со строковыми коллекциями. Мы добавляем (см. листинг 9.6) безопасный по отношению к указателям метод StrAt и простой метод Add. Теперь можно легко написать код следующего вида:

StrList^.Add(S);
S := StrList^.StrAt(Index);

Знакомый синтаксис облегчает переходы между старым и новым миром — до тех пор, пока с существованием старого мира DOS приходится считаться.

Листинг 9.6. Модуль STRLIST.PAS

{ Создание удобных строковых коллекций в стиле TStringList. } unit StrList; interface uses Objects; type PStrListCollection = ^TStrListCollection; TStrListCollection = object(TStringCollection) function StrAt(Index: Integer): string; procedure Add(const S: string); end; implementation { PtrToStr преобразовывает указатель в строку с отдельной обработкой nil.} function PtrToStr(P: Pointer): string; begin if P = nil then PtrToStr := '' else PtrToStr := PString(P)^; end; { StrAt возвращает строку из строковой коллекции. } function TStrListCollection.StrAt (Index: Integer): string; begin StrAt := PtrToStr(At(Index)); end; { Add добавляет строку в конец строковой коллекции. } procedure TStrListCollection.Add(const S: string); begin AtInsert(Count, NewStr(S)); end; end.

Субклассирование

Проблема нестандартной обработки сообщений Windows не нова — она появилась одновременно с самой системой Windows. Для нее даже придумали специальный термин — субклассирование (subclassing). Строго говоря, наряду с субклассированием следует рассматривать и суперклассирование (superclassing) — отличия между ними заключаются в том, что субклассирование ограничивает стандартную реакцию окна на сообщение, а суперклассирова ние добавляет к ней что-то новое. На мой взгляд, эти два понятия совпадают хотя бы из-за того, что в обоих случаях используется одна и та же методика реализации. Какая методика? На фоне элегантности Delphi она выглядит не особенно изящно (ладно, признаю — выглядит на редкость уродливо), но зато способна творить чудеса. А все отталкивающие детали можно инкапсулиро вать, чтобы они никогда больше не попадались вам на глаза.

Суть субклассирования совершенно проста. С каждым окном связана особая структура данных, используемая Windows. Среди многих замечательных вещей в ней хранится указатель на оконную процедуру (window procedure) — процедуру, которая обрабатывает сообщения Windows. Когда система Windows получает сообщение, предназначенное для некоторого окна, она находит адрес оконной процедуры этого окна и вызывает ее, передавая в виде параметров информацию сообщения. При субклассировании вы заменяете оконную процедуру другой, нестандартной, и сохраняете указатель на старую процедуру, чтобы ей можно было передать сообщение для дальнейшей обработки. Весь этот процесс документирован в руководствах по Windows SDK, по нему имеются неплохие примеры (разумеется, на языке C — нельзя же получить все сразу). Правда, работа идет на очень низком уровне и отдает хакерством, но иногда программисту все же приходится пачкать руки. (Вы никогда не пытались заглянуть в исходные тексты VCL? Просмотрите CONTROLS.PAS, и вы лишитесь многих иллюзий.)

Как бы то ни было, Delphi содержит все необходимые инструменты для субклассирования окон. Мы воспользуемся ими и создадим интерфейс перетаскивания, с которым ваши программы смогут взаимодействовать в привычной для Delphi манере. Как всегда, начнем с требований.

Сводка функций модуля Math

В завершение этой главы я привожу полный список всех функций и процедур модуля Math. При переходе от Delphi 2 к Delphi 3 модуль Math почти не изменился, фирма Borland ввела в него только три новые функции: MaxIntValue, MinIntValue и SumInt. Эти функции отличаются от своих прототипов (MaxValue, MinValue и Sum) лишь тем, что работают исключительно с целыми числами, не принимая и не возвращая величин с плавающей точкой. Что касается остальных функций, то большинство из них вполне очевидно. Если вам покажется иначе — что ж, садитесь за исследования. И не надейтесь, что все тайны Delphi достанутся вам на блюдечке в виде help-файла!

Таинственный модуль Math

Теренс Гоггин

Исследуем новый модуль Delphi, о котором мало кто знает, а заодно попробуем переложить на него всю черную работу по статисти ческой обработке данных.

Вторая и третья версии Delphi содержат первоклассный вспомогательный модуль, которому до сих пор не уделялось должного внимания. Он докумен тирован (в некотором роде), о его существовании знают (по крайней мере некоторые), но почти никто понятия не имеет о том, как им правильно пользоваться. Этот модуль называется Math и содержит превосходный набор финансовых, статистических и общих арифметических и тригонометрических функций.

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

Тернистый путь познания

Но мне показалось, что все слишком просто. Не знаю, в чем тут дело — то ли в каких-то личных качествах, то ли я просто «нерд» по натуре. Я решил пойти дальше и сделать так, чтобы строку из текстового поля можно было переслать в любую из сеток, просто сбрасывая ее на корешке соответствующей вкладки. Пожалуй, сейчас я уже раскаиваюсь в своем решении.

Сначала я узнал, что у компонента TabSet есть метод, который сообщает номер вкладки по координатам x, y. Компонент PageControl в основном выполняет функции оболочки для компонентов TabSheet, так что его собственные
возможности ограничены и он может разве что сообщить номер текущей выбранной вкладки.

Следовательно, я должен был узнать местонахождение каждого корешка, чтобы определить, на какой из них указывает мышь. Обладая этой информа цией, можно легко определить нужную вкладку. Но при этом возникает
другая проблема: компонент PageControl автоматически изменяет ширину каждого корешка в зависимости от длины его названия. Что делать?

Я решил организовать поддержку сбрасывания лишь для тех вкладок,
у которых значение свойств TabHeight и TabWidth было вручную заменено величиной, отличной от нуля. На этом следовало остановиться, но я решил предоставить возможность автоматического назначения корешкам вкладок одной и той же ширины, определяемой длиной самого длинного названия. В результате программа заметно разрослась, ее окончательная версия приведена в листинге 16.2.

Листинг 16.2. Полный исходный текст программы, демонстрирующей
применение общих обработчиков

{——————————————————————————————————————————————————————} { Применение общих обработчиков событий } { (демонстрационная программа) } { SHARMAIN.PAS : Главный модуль } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Программа демонстрирует применение общих } { обработчиков событий в пределах одного приложения } { на примере операции перетаскивания. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} unit SharMain; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, ExtCtrls, ComCtrls; type TShareEventDemoForm = class(TForm) EditBox: TEdit; Label1: TLabel; QuitBtn: TButton; Panel1: TPanel; PageControl: TPageControl; MorningSheet: TTabSheet; AfternoonSheet: TTabSheet; EveningSheet: TTabSheet; MorningGrid: TStringGrid; AfternoonGrid: TStringGrid; EveningGrid: TStringGrid; procedure FormCreate(Sender: TObject); procedure QuitBtnClick(Sender: TObject); procedure EditBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure GridDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure GridDragDrop(Sender, Source : TObject; X, Y : Integer); procedure PageControlDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure PageControlDragDrop(Sender, Source: TObject; X, Y: Integer); private CopyDrag : Boolean; function ManualTabsSet : Boolean; function CurrentGrid : TStringGrid; function TabGrid(X : Integer) : TStringGrid; procedure SetTabSizes; procedure DropEditString(AGrid : TStringGrid); procedure DropGridString(TargetGrid : TStringGrid); public { Public declarations } end; var ShareEventDemoForm: TShareEventDemoForm; implementation {$R *.DFM} { Возвращает длину (в пикселях) отображаемой строки по логическому номеру окна, в котором она выводится, и логическому номеру шрифта. } function StringWidth(WinHnd : HWND; FntHnd : HWND; Text : String) : Integer; var DCHnd : HWND; StrSize : TSize; TextArr : array[0..127] of char; begin Result := -1; DCHnd := GetDC(WinHnd); if GetMapMode(DCHnd) = MM_TEXT then begin SelectObject(DCHnd, FntHnd); StrPCopy(TextArr, Text); if GetTextExtentPoint32(DCHnd, @TextArr, Length(Text), StrSize) then Result := StrSize.Cx end; ReleaseDC(WinHnd, DCHnd); end; { Возвращает высоту шрифта (в пикселях) по логическому номеру окна, в котором он выводится, и логическому номеру шрифта. Высота должна учитывать строчные и подстрочные элементы, а также внутренний интервал. } function FontHeight(WinHnd : HWND; FntHnd : HWND) : Integer; var DCHnd : HWND; TextMex : TTextMetric; begin Result := -1; DCHnd := GetDC(WinHnd); if GetMapMode(DCHnd) = MM_TEXT then begin SelectObject(DCHnd, FntHnd); GetTextMetrics(DCHnd, TextMex); Result := TextMex.tmHeight; end; ReleaseDC(WinHnd, DCHnd); end; procedure TShareEventDemoForm.FormCreate(Sender: TObject); begin PageControl.ActivePage := MorningSheet; SetTabSizes; CopyDrag := False; end; procedure TShareEventDemoForm.QuitBtnClick(Sender: TObject); begin Close; end; procedure TShareEventDemoForm.EditBoxMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin { Перед тем как начинать перетаскивание, необходимо убедиться в том, что нажата левая кнопка мыши, в текстовом поле присутствует текст и щелчок был не двойным. } if (Button = mbLeft) and (EditBox.Text <> '') and not (ssDouble in Shift) then TEdit(Sender).BeginDrag(False); end; { Общий обработчик для события OnMouseDown всех сеток. } procedure TShareEventDemoForm.GridMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var TheGrid : TStringGrid; begin { Инициируем перетаскивание из текущей выбранной сетки. Если нажата клавиша Ctrl, устанавливаем флаг CopyDrag. Перед тем как начинать перетаскивание, убедимся в том, что нажата левая кнопка мыши, в выделенной строке сетки присутствует текст щелчок был не двойным. } TheGrid := CurrentGrid; CopyDrag := ssCtrl in Shift; if (Button = mbLeft) and (TheGrid.Cells[0, TheGrid.Row] <> '') and not (ssDouble in Shift) then TStringGrid(Sender).BeginDrag(False); end; { Общий обработчик для события OnDragOver всех сеток. } procedure TShareEventDemoForm.GridDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin { Принимается все, что угодно, но только из текстового поля. } Accept := Source is TEdit; end; { Общий обработчик для события OnDragDrop всех сеток. } procedure TShareEventDemoForm.GridDragDrop (Sender, Source : TObject; X, Y : Integer); begin { Сбрасываем перетаскиваемый объект на текущую выбранную решетку. } DropEditString(CurrentGrid); end; procedure TShareEventDemoForm.PageControlDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin { Сбрасывание на корешке вкладки принимается лишь в том случае, если перетаскиваемый объект происходит из текстового поля или сетки — при условии, что корешок относится не к той сетке, из которой начато перетаскивание. В любом случае размеры корешков должны быть установлены вручную. } Accept := ManualTabsSet and ( (Source is TEdit) or ((Source is TStringGrid) and (CurrentGrid <> TabGrid(X))) ); end; procedure TShareEventDemoForm.PageControlDragDrop (Sender, Source: TObject; X, Y: Integer); begin { Получаем строку из нужного источника и сбрасываем ее на сетку, связанную со вкладкой в позиции X. } if (Source is TEdit) then DropEditString (TabGrid(X)); if (Source is TStringGrid) then DropGridString (TabGrid(X)); end; { Возвращает True лишь в том случае, если и высота, и ширина вкладки были заданы вручную. } function TShareEventDemoForm.ManualTabsSet : Boolean; begin Result := (PageControl.TabHeight > 0) and (PageControl.TabWidth > 0); end; { Возвращает указатель на сетку, находящуюся на текущей вкладке. } function TShareEventDemoForm.CurrentGrid : TStringGrid; begin Result := nil; if PageControl.ActivePage = MorningSheet then Result := MorningGrid else if PageControl.ActivePage = AfternoonSheet then Result := AfternoonGrid else if PageControl.ActivePage = EveningSheet then Result := EveningGrid; end; { Возвращает указатель на сетку, связанную со вкладкой в позиции X. } function TShareEventDemoForm.TabGrid(X : Integer) : TStringGrid; var Idx : Integer; begin Result := nil; with PageControl do begin Idx := X div TabWidth; case Idx of 0 : Result := MorningGrid; 1 : Result := AfternoonGrid; 2 : Result := EveningGrid; end; { case } end; { with } end; { ?егулирует высоту и ширину корешков, следя за тем, чтобы все корешки имели одинаковые размеры. } procedure TShareEventDemoForm.SetTabSizes; var i : Integer; Len : Integer; MaxWidth : Integer; s : String; begin with PageControl do begin if TabWidth > 0 then begin MaxWidth := -1; for i := 0 to PageCount - 1 do begin s := Pages[i].Caption; Len := StringWidth(Handle, Font.Handle, s); if Len > MaxWidth then MaxWidth := Len; end; if MaxWidth > 0 then TabWidth := MaxWidth + 10; end; if TabHeight > 0 then PageControl.TabHeight := FontHeight (Handle, Font.Handle) + 5; end; { with } end; { Вспомогательная процедура для сброса строки из текстового поля на указанную сетку. Также очищает содержимое текстового поля. } procedure TShareEventDemoForm.DropEditString (AGrid : TStringGrid); begin if AGrid <> nil then with AGrid do begin Cells[0, RowCount - 1] := EditBox.Text; RowCount := RowCount + 1; EditBox.Text := ''; end; { with } end; { Вспомогательная процедура для сброса текста из выделенной строки текущей сетки на другую сетку. Если выполняется операция перемещения, строка удаляется из текущей сетки, которая затем "сжимается". } procedure TShareEventDemoForm.DropGridString (TargetGrid : TStringGrid); var i : Integer; begin if TargetGrid <> nil then begin with TargetGrid do begin Cells[0, RowCount - 1] := CurrentGrid.Cells[0, CurrentGrid.Row]; RowCount := RowCount + 1; end; { with } if not CopyDrag then with CurrentGrid do begin Cells[0, Row] := ''; if Row < RowCount - 1 then for i := Row to RowCount - 1 do Cells[0, i] := Cells[0, i + 1]; RowCount := RowCount - 1; end; { with } end; end; end.

Для правильного вычисления высоты и ширины строки, выводимой на корешке, мне пришлось прибегнуть к функциям Win95 API. Попутно я узнал пару интересных вещей. Во-первых, субсвойство Height свойства Font компонента включает высоту символа (вместе со строчными и подстрочными элемента ми), но не внутренний интервал (internal leading), используемый для специальных целей — например отображения диакритических знаков в некоторых символах национальных алфавитов.

Я захотел узнать настоящую высоту, возвращаемую при вызове GetText Metrics. Написанная мной функция FontHeight возвращает высоту по заданным логическим номерам компонента и шрифта. Внутри FontHeight я проверяю, что установлен координатный режим MM_TEXT — это означает, что полученное значение относится к выводу на экран и измеряется в пикселях.

Аналогичная методика используется и во вспомогательной функции String Width, передающей строку функции GetTextExtentPoint32. Возвращаемое значение равно приблизительной длине отображаемой строки (в пикселях). Значение считается приблизительным, поскольку в нем не учитывается возможный кернинг, выполняемый для символов шрифта.

Обработчик OnCreate формы вызывает процедуру SetTabSizes, чтобы узнать, нужно ли изменять размеры корешков. Если процедура определяет, что в режиме конструирования свойствам TabHeight и TabWidth компонента PageControl были присвоены ненулевые значения, она вмешивается в происходящее

и регулирует размеры корешков, учитывая метрики шрифта и длину самого длинного названия.

По свойству TabWidth и координате X, предоставляемой в ходе перетаскива ния, функция TabGrid определяет нужную вкладку и возвращает указатель на связанную с ней сетку. PageControlDragDrop также пользуется TabGrid, чтобы

определить, какая сетка должна получить сбрасываемую строку.

Тестирование компонента DBStatistics

Наш великолепный компонент готов, пора испытать его на практике. В этом разделе мы напишем программу, которая позволяет выбрать любое поле в таблице и получить по нему полный статистический отчет, аккуратно выведенный в Memo-компоненте. На рис. 11.1 показано, как выглядит программа StatsProject.

Все файлы этого проекта находятся на CD-ROM, в подкаталоге главы11. В тексте будет приведен лишь непосредственно обсуждаемый код.

Обратите внимание: эта форма выглядит стандартно — на ней есть несколько самых обычных визуальных элементов, а также компоненты TTable, TDataSource, TOpenDialog и, разумеется, TDBStatistics. При запуске StatsProject пользователь должен прежде всего выбрать таблицу. Это делается с помощью кнопки BtnTableSelect — элемента TButton с надписью «1. Select a table & field». В обработчике события OnClick кнопки BtnTableSelect имя таблицы определяется с помощью компонента OpenDialog1 класса TOpenDialog.

Рис. 11.1. Программа StatsProject во время выполнения

Все начинается с вызова метода Execute. Если был выбран файл с допусти мым именем, работа продолжается:

with OpenDialog1 do begin Execute; if FileName = '' then exit;

Затем мы устанавливаем свойства компонента TTable в соответствии с файлом, выбранного пользователем, и выводим сведения о файле с помощью двух элементов TLabel:

Table1.DatabaseName := ExtractFilePath(FileName); LblDatabase.Caption := ExtractFilePath(FileName); Table1.TableName := ExtractFileName(FileName); LblTable.Caption := ExtractFileName(FileName);

Поскольку TDBStatistics обрабатывает данные лишь из одного поля, мы должны обеспечить пользователя средствами для выбора поля. Для этого мы извлекаем имена всех полей из TTable и включаем их в список:

CBFields.Items.Clear; CBFields.Text := ''; Memo1.Text := ''; Table1.Open; for i := 0 to Table1.FieldDefs.Count-1 do begin Application.ProcessMessages; CBFields.Items.Add(Table1.Fields[i].FieldName); end; Table1.Close;

На этом выбор таблицы и имени поля завершается.

После того как пользователь выбрал анализируемое поле, он может сгенерировать статистический отчет в элементе Memo, нажимая кнопку BtnReports (кнопка с надписью «2. Generate a report»). В обработчике BtnReports.OnClick мы прежде всего задаем соответствующие свойства компонента DBStatistics1:

DBStatistics1.LowerBound := 1; Table1.Open; DBStatistics1.UpperBound := Table1.RecordCount; Table1.Close; DataSource1.DataSet := Table1; DBStatistics1.DataSource := DataSource1; DBStatistics1.DataField := CBFields.Text; {выбранное поле}

Затем мы вызываем DBStatistics1.GetAllStats и выводим результаты в элементе Memo:

DBStatistics1.GetAllStats; Memo1.Text := ''; Memo1.Lines.Add('Mean: ' + #09 + #09 + FloatToStr(DBStatistics1.Mean)); { ... и т. д. ... } Memo1.Lines.Add('Kurtosis: ' + #09 + #09 + FloatToStr (DBStatistics1.Kurtosis));

Дело сделано — у нас появился работоспособный генератор статистических отчетов.

Тестирование модуля CmdLine

Теперь мы проверим, как работают функции анализа командной строки, с помощью тестовой программы. Создайте новое приложение на основе шаблона Console Application. Сохраните новый проект под именем FILTER.DPR и скопируйте файл CMDLINE.PAS (листинг1.3) в соответствующий каталог. Затем выполните команду File д Add to Project, чтобы включить модуль CmdLine в созданный проект.

Проект Filter предназначен для проверки модуля CmdLine, а также модуля файлового ввода/вывода, которым мы займемся далее. После завершения работы над модулями их окончательные версии будут помещены в хранили ще, и у нас появится шаблон для создания фильтров.

Для проверки модуля CmdLine нам понадобится массив с информацией о параметрах и фрагмент кода, в котором вызывается ProcessCommandLine. Тестовая программа (файл FILTER.DPR) приведена в листинге 1.4.

Листинг 1.4. Программа FILTER.DPR для тестирования модуля CmdLine

{ FILTER.DPR — основная программа фильтра Автор: Джим Мишель Дата последней редакции: 04/05/97 } {$APPTYPE CONSOLE} program filter; uses Windows, CmdLine; const nOptions = 4; Options : Array [1..nOptions] of OptionRec = ( (OptionChar : "i"; Option : otFilename; Filename : ""), (OptionChar : "o"; Option : otFilename; Filename : ""), (OptionChar : "n"; Option : otInt; Value : 36), (OptionChar : "d"; Option : otBool; OnOff : False) ); var cRslt : Boolean; Rec : pOptionRec; begin cRslt := CmdLine.ProcessCommandLine (@Options, nOptions); WriteLn("ProcessCommandLine returned ", cRslt); Rec := CmdLine.GetOptionsRec (@Options, nOptions, "i"); WriteLn ("i = ", Rec^.Filename); Rec := CmdLine.GetOptionsRec (@Options, nOptions, "o"); WriteLn ("o = ", Rec^.Filename); Rec := CmdLine.GetOptionsRec (@Options, nOptions, "n"); WriteLn ("i = ", Rec^.Value); Rec := CmdLine.GetOptionsRec (@Options, nOptions, "d"); WriteLn ("d = ", Rec^.OnOff); Write("Press Enter..."); ReadLn; end.

После инициализации таблицы параметров (это происходит в секции const) вызывается функция ProcessCommandLine, которая читает аргументы командной строки и сохраняет значения параметров в таблице. Затем программа выводит результат, возвращенный функцией ProcessCommandLine, вместе со значени ями всех параметров.

Попробуйте задавать этой программе различные командные строки. Не ограничивайтесь правильными строками и обязательно введите несколько неправильных, чтобы убедиться в корректной обработке ошибок. Могу предложить несколько вариантов:

-iInFile.txt -oOutFile.txt -n995 -d{правильная строка}

-n8.94 {Error: integer expected}
-x {Invalid option character: x}

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

Требования к интерфейсу IDropSource

Первый из трех интерфейсов, необходимых для работы сервера, — IDrop Source — реализуется проще всего. Реализация IDropSource должна выполнять две задачи:

Следить за состоянием клавиатуры или кнопок мыши и определять, что следует делать дальше — продолжить, завершить или отменить перетаскивание. Реагировать на перемещение курсора мыши, изменяя его внешний вид или предоставляя другие признаки визуальной индикации.

Этим задачам соответствуют два метода IDropSource: QueryContinueDrag и Give Feedback. Их объявления приведены в следующей спецификации:

IDropSource = interface(IUnknown)

['{00000121-0000-0000-C000-000000000046}'] function QueryContinueDrag (fEscapePresed: BOOL; grfKeyState: Longint): HResult; stdcall; function GiveFeedback(dwEffect: Longint): HResult; stdcall; end;

Метод QueryContinueDrag вызывается функцией DoDragDrop при каждом изменении состояния клавиатуры или кнопок мыши во время операции перетаскивания. На основании переменных fEscapePressed и grfKeyState он определяет дальнейшие действия — продолжение, завершение или отмену операции.

Метод GiveFeedback вызывается функцией DoDragDrop при каждом изменении состояния мыши во время перетаскивания. Основная задача GiveFeedback — предоставление визуальной индикации хода операции. Чаще всего такая индикация сводится к изменению внешнего вида курсора. DoDragDrop вызывает GiveFeedback после вызова методов DragEnter, DragLeave или DragOver интерфейса IDropSource и передает ему значение DROPEFFECT, возвращаемое методом IDRopTarget.

Интерфейс IDropSource обычно выглядит очень просто, особенно если учесть, что OLE определяет стандартное поведение, которое несложно реализовать.

Требования к перетаскиванию OLE

Если ваше приложение действует как приемник (другими словами, оно будет получать информацию от брошенных объектов), вы обязаны реализовать лишь интерфейс IDropTarget. Если ваше приложение является источником (то есть поставляет информацию для перетаскивания), оно должно реализовать интерфейсы IDropSource и IDataObject. Интерфейс IDataObject, если он правильно реализован, может также использоваться кодом, выполняющим операции вырезания/вставки с буфером обмена (clipboard).

Мы реализуем все три интерфейса, чтобы наше приложение могло выполнять функции как клиента (приемника), так и сервера (источника).

TreeDataComboBox

С помощью этого элемента можно запомнить объект, выбранный пользова телем. Он сохраняет единственное значение в свойстве LookupIDField. В раскрывающейся части содержится список объектов, причем уровень каждого объекта обозначается с помощью отступа. В текстовом поле приведены описания (descriptions) всех предков текущего объекта, разделенные запятыми. В текстовом поле также можно вводить описания объектов, при этом автоматически выделяется первый объект, в описании которого присутствует введенный текст. Если нужное совпадение будет найдено, двоеточие (или точка с запятой) фиксирует найденный объект, а поиск продолжается по вводимому далее тексту. Благодаря этому вы можете продолжить поиск среди потомков найденного объекта (см. рис.13.5).

Компонент TreeDataComboBox содержит свойства для описания и идентифи катора объекта, а также свойство Item.FullDescription для хранения полной родословной, отображаемой в текстовом поле. Дополнительные свойства возвращают строку с идентификаторами всех предков или потомков выделенного объекта.

Рис. 13.5. Компонент TreeDataComboBox

TreeDataListBox

Этот элемент состоит из TTreeDataComboBox (сверху) и связанного с источником данных элемента TListBox (снизу), как показано на рис. 13.6. Вместо одной текущей записи TListBox работает со всеми записями своего источника. Вы можете воспользоваться комбинированным полем, отобрать несколько объектов и затем включить их в список. При вызове SaveIDs или потере фокуса (если установлен флаг SaveOnExit) элемент заносит все идентификаторы в источник данных, по одному на каждую запись. Источник данных может отобрать нужное подмножество записей с помощью MasterSource или фильтра.

В результате получается что-то вроде элемента TTreeDataComboBox с постоянно раскрытым списком.

Рис. 13.6. Компонент TreeDataListBox

TreeDataOutline и TreeDataUpdate

TreeDataOutline отображает иерархию в виде графической структуры, напоминающей интерфейс программы Windows Explorer. Как и в других элементах этого семейства, вы можете получить идентификатор и описание текущего объекта, Item.FullDescription и строку с идентификаторами всех предков и потомков.

Компонент TreeDataUpdate (см. рис.13.7) выглядит похоже, но в нем предусмотрены дополнительные возможности для управления иерархической структурой данных на уровне таблицы. Он позволяет добавлять, изменять и удалять объекты, а также перемещать их в пределах иерархии.

Рис. 13.7. Компонент TreeDataUpdate

Трехмерные фрактальные ландшафты

Джон Шемитц

Полотна великих сюрреалистов вам не по карману? Тогда создайте виртуальный сюрреалистический пейзаж по своему вкусу (ведь он может быть сколь угодно велик). Для этого потребуется лишь фрактальная технология и немножко старой доброй магии Delphi.

Слово «фрактал» я впервые услышал примерно в 1983году, когда еще занимался программированием больших компьютеров. Мы с коллегой обсуждали только что полученные IBM PC, и он спросил, нет ли у меня программ для расчета фракталов.

«Нет», — ответил я. — «А что такое фракталы?»

Он объяснил, что фрактальное изображение создается применением некоторой геометрической операции к простой фигуре и последующим многократным применением той же операции к полученному результату. Хотя такое объяснение совершенно не затрагивает тех замечательных свойств фракталов, которые так интересуют математиков, оно вполне грамотно описывает, как же фракталы генерируются.

Несомненно, в полной мере это относится и к построению трехмерных фрактальных ландшафтов.

Треугольный массив

При изгибании отрезка мы изменяем лишь z-координату его середины, поэтому теоретически можно использовать пару координат [x, y] как индекс в таблице со значениями z. Однако такой массив получится весьма разреженным, а с нормальным, непрерывным массивом программа работает намного быстрее — ей не приходится тратить время на просмотр списков разреженного массива. Именно по этой причине в листинге 8.1 определена система двумерных логических адресов (тип данных TVertex), в которые «отображаются» фактические трехмерные координаты (тип данных Ttriple).

Листинг 8.1. Модуль GLOBAL.PAS

unit Global; {Fractal Landscapes 3.0 - Copyright © 1987..1996, Джон Шемитц} interface uses WinTypes; type Int16 = {$ifdef Ver80} integer {$else} SmallInt {$endif} ; const MaxPlys = 8; MaxEdgeLength = 1 shl (MaxPlys - 1); UnitLength: LongInt = 5000; ShadesOfGray = 64; type TCoordinate = -30000..30000; TTriple = record X, { Ширина: от 0 (слева) до UnitLength (справа)} Y, { Глубина: от 0 (спереди) до VanishingPoint.Y (сзади)} Z: TCoordinate; { Высота: от 0 (снизу) до UnitLength (сверху)} end; function Triple(X, Y, Z: TCoordinate): TTriple; type TPixel = TPoint; type GridCoordinate = 0..MaxEdgeLength; { Треугольная сетка } TVertex = record AB, BC, CA: GridCoordinate; end; function Vertex(AB, BC, CA: GridCoordinate): TVertex; type DrawModes = (dmOutline, dmFill, dmRender); DrawRates = (drLow, drMedium, drHigh); const Envelope = 3000; SeaLevel: word = 100; { от 0 (снизу) до UnitLength (сверху)} VanishingPoint: TTriple = ( X: 1500 ; Y: 25000 ; { Видимая глубина точки перспективы } Z: 15000 ); LightSource: TTriple = ( X: 2500; Y: +7500; Z: 25000 ); DrawMode: DrawModes = dmOutline; DrawRate: DrawRates = drHigh; const Uninitialized = -30000; var A, B, C: TVertex; Plys: 1..MaxPlys; EdgeLength: Int16; DisplayHeight, DisplayWidth: Int16; implementation function Triple(X, Y, Z: TCoordinate): TTriple; begin Result.X := X; Result.Y := Y; Result.Z := Z; end; function Vertex(AB, BC, CA: GridCoordinate): TVertex; begin Result.AB := AB; Result.BC := BC; Result.CA := CA; end; end.

Вероятно, простейшая схема такого отображения заключается в нумерации всех вершин вдоль каждой из трех сторон внешнего треугольника (см. левую половину рис. 8.6) и использовании всех трех координат для вершин каждой стороны. Хотя в действительности нам нужны лишь две координаты, а третья избыточна, я предпочитаю ссылаться на внешние вершины треугольника в чуть более понятном виде [1, 0, 0], [0, 1, 0] и [0, 0, 1] вместо [1, 0], [0, 1] и [0, 0]. Именно по этой причине тип TVertex определяется в виде тройки координат, несмотря на то что третья координата в принципе не нужна и даже слегка замедляет вычисления.

Рис. 8.6. Сохранение вершин в «квадратном» массиве

Впрочем, когда дело доходит до базы данных вершин, третья координата действительно игнорируется. Как видно из правой половины рис. 8.6, координаты вершин сохранятся и в том случае, если равносторонний треугольник преобразовать в прямоугольный. Поэтому координаты AB и BC можно будет использовать так, словно они относятся к элементу «квадратного» массива.

Однако сохранение нашего «треугольного» массива в «квадратном» означало бы, что почти половина места в массиве пропадает даром. В принципе в этом нет ничего страшного, хотя в 16-разрядной среде мы бы столкнулись с ограничением на размер сегмента (64 Кб). Каждый элемент типа TTriple состоит из трех 16-разрядных чисел с фиксированной точкой, поэтому квадратный массив после восьми итераций деления сторон (рис. 8.7) будет содержать (28-1 + 1)2 вершин, или 99 846 байтов. Если же сохранять только вершины, принадлежащие диагонали или находящиеся под ней, объем сокращается до 50 310 байтов. В этом случае можно воспользоваться простым индексированием вместо huge-указателей и массивов. К тому же вся база данных (по крайней мере в данной демонстрационной программе) помещается в одном сегменте данных, что ускоряет доступ к ней по сравнению с дополнительным выделением блоков из пула и использованием указателей.

Поскольку восемь итераций вряд ли можно назвать слишком мелким делением для экрана 1280?1024, описанная в этой главе программа Fractal Landscapes 3.0 (она же FL3 — переработанная (сначала под Windows, а затем для Delphi) версия DOS-программы, изначально написанной «для души» на Turbo Pascal 4.0) использует «треугольную» структуру базы данных (см. листинг 8.2). Основная идея заключается в том, что каждый ряд вершин хранится в базе после предыдущего ряда. Поскольку первый ряд состоит всего из одной вершины, второй ряд начинается со второй «ячейки». Он состоит из двух вершин, поэтому третий ряд начинается с четвертой ячейки, и так далее.

Рис. 8.7. Процесс многократного деления

Листинг 8.2. Модуль DATABASE.PAS

unit Database; { Fractal Landscapes 3.0 - Copyright © 1987..1997, Джон Шемитц } { База данных и генерация ландшафта } interface uses SysUtils, Global; { Вспомогательные математические функции } function IDIV(Numerator: LongInt; Denominator: Int16): Int16; {$ifdef Ver80} {В Delphi 1.0 еще поддерживаются InLine-функции} InLine( $5B / { POP BX ; Делитель } $58 / { POP AX ; Младшее слово делимого } $5A / { POP DX ; Старшее слово делимого } $F7 / $FB { IDIV BX ; Частное } {$endif} function IMUL(A, B: Int16): LongInt; {$ifdef Ver80} {В Delphi 1.0 еще поддерживаются InLine-функции} InLine( $5B / { POP BX } $58 / { POP AX } $F7 / $EB { IMUL BX } ); {$endif} function Rand(Envelope: integer): integer; { База данных } procedure ResetDB; function GetTriple(const V: TVertex): TTriple; { DB[V] } procedure SwapTriples(var A, B: TTriple); function Midpoint(A, B: TVertex): TVertex; function LoadLandscape(const FileName: TFileName) : boolean; function SaveLandscape(const FileName: TFileName) : boolean; { Вычисления } procedure FractureTriangle(const A, B, C: TVertex; Plys: word); function Unscale(ScaledCoordinate: LongInt): TCoordinate; {$ifdef Ver80} {В Delphi 1.0 еще поддерживаются InLine-функции} InLine( $58 / { POP AX ; младшее слово SC } $5A / { POP DX ; старшее слово SC } $8B / $1E / UnitLength / { MOV BX,[UnitLength] ; младшее слово масштабного коэффициента} $F7 / $FB { IDIV BX ; Обратное масштабирование } ); {$endif} implementation { Вспомогательные математические функции } {$ifNdef Ver80} { В 32-разрядных версиях Delphi InLine-функции не поддерживаются } function IDIV(Numerator: LongInt; Denominator: Int16): Int16; begin Result := Numerator div Denominator; end; {$endif} {$ifNdef Ver80} { В 32-разрядных версиях Delphi InLine-функции не поддерживаются } function IMUL(A, B: Int16): LongInt; begin Result := Longint(A) * B; end; {$endif} function Rand(Envelope: integer): integer; { Псевдонормальное распределение в интервале ±Envelope } begin Rand := integer(Random(Envelope)) + integer(Random(Envelope)) - Envelope; end; {$ifNdef Ver80} {В 32-разрядных версиях Delphi InLine-функции не поддерживаются } function Unscale(ScaledCoordinate: LongInt): TCoordinate; begin Result := ScaledCoordinate div UnitLength; end; {$endif} { База данных } var DB: array[0..8384] of TTriple; { Треугольный массив: (MEL+1) элементов } NumberOfVertices, TopRow: word; Envelopes: array[1..MaxPlys] of word; function Vertices(N: word): word; { Число вершин, содержащихся в равностороннем треугольнике с длиной стороны N-1 } begin Vertices := (Sqr(N) + N) shr 1; end; function Midpoint(A, B: TVertex): TVertex; begin Result := Vertex( (A.AB + B.AB) shr 1, { среднее } (A.BC + B.BC) shr 1, (A.CA + B.CA) shr 1 ); end; function Loc(const V: TVertex): word; begin Loc := NumberOfVertices - Vertices(TopRow - V.AB) + V.BC; { ^^^^^^^^^^^^^^^^^^ На самом деле это не нужно и приводит к напрасным затратам времени, но сохранено для совместимости с .FL-файлами программы FL2. } end; procedure SetTriple(var V: TVertex; var T: TTriple); { DB[V] := T } begin DB[Loc(V)] := T; end; function GetTriple(const V: TVertex): TTriple; { DB[V] } begin Result := DB[Loc(V)]; end; procedure SwapTriples(var A, B: TTriple); var Tmp: TTriple; begin Tmp := A; A := B; B := Tmp; end; procedure SwapZ(var A, B: TTriple); var C: TCoordinate; begin C := A.Z; A.Z := B.Z; B.Z := C; end; const Uninitialized = -30000; procedure ResetDB; var T: TTriple; R, Theta: double; I, Offset: integer; tA, tB, tC: TTriple; const Base_Rotation = - Pi / 2.1; { Поворот против часовой стрелки } RotateBy = Pi * 2 / 3; {120°} begin { Установить параметры, зависящие от числа итераций (Plys) } EdgeLength := 1 shl (Plys - 1); TopRow := EdgeLength + 1; { "Ограничитель" } NumberOfVertices := Vertices(TopRow); for I := Plys downto 1 do Envelopes[I] := Envelope shr Succ(Plys - I); { Сбрасываем в исходное состояние NumberOfVertices вершин в базе данных } T.X := Uninitialized; T.Y := Uninitialized; T.Z := Uninitialized; for I := Low(DB) to High(DB) do DB[I] := T; { Теперь задаем положение "определяющих" (то есть внешних) точек A, B и C } A.AB := 0; A.BC := EdgeLength; \A.CA := 0; B.AB := 0; B.BC := 0; B.CA := EdgeLength; C.AB := EdgeLength; C.BC := 0; C.CA := 0; { Рассчитываем для них тройки координат } Offset := UnitLength div 2; R := UnitLength / 2; Theta := Base_Rotation; tA := Triple( Round(R * Cos(Theta)) + Offset, Round(R * Sin(Theta)) + Offset, SeaLevel + Rand(Envelope) ); Theta := Theta + RotateBy; tB := Triple( Round(R * Cos(Theta)) + Offset, Round(R * Sin(Theta)) + Offset, SeaLevel + Rand(Envelope) ); Theta := Theta + RotateBy; tC := Triple( Round(R * Cos(Theta)) + Offset, Round(R * Sin(Theta)) + Offset, SeaLevel + Rand(Envelope) ); { По крайней мере одна точка должна находиться над уровнем моря } if (tA.Z < SeaLevel) AND (tB.Z < SeaLevel) AND (tC.Z < SeaLevel) then repeat tB.Z := SeaLevel + Rand(Envelope); until tB.Z > SeaLevel; { Сделаем A самой нижней точкой... } if tA.Z > tB.Z then SwapZ(tA, tB); if tA.Z > tC.Z then SwapZ(tA, tC); SetTriple(A, tA); SetTriple(B, tB); SetTriple(C, tC); end; function SaveLandscape(const FileName: TFileName): boolean; var Handle: integer; begin try Handle := FileCreate(FileName); try Result := (FileWrite(Handle, Plys, SizeOf(Plys)) = SizeOf(Plys)) and (FileWrite(Handle, DB, NumberOfVertices * SizeOf(TTriple)) = NumberOfVertices * SizeOf(TTriple)); finally FileClose(Handle); end; except on Exception {любое исключение} do Result := False; end; end; function LoadLandscape(const FileName: TFileName): boolean; var Handle: integer; begin Result := False; try Handle := SysUtils.FileOpen(FileName, fmOpenRead); try if FileRead(Handle, Plys, SizeOf(Plys)) = SizeOf(Plys) then begin ResetDB; LoadLandscape := FileRead( Handle, DB, NumberOfVertices * SizeOf(TTriple)) = NumberOfVertices * SizeOf(TTriple); end; finally FileClose(Handle); end; except on Exception {любое исключение} do Result := False; end; end; { Основные действия } procedure FractureLine( var vM: TVertex; const vA, vB: TVertex; Envelope: integer ); var A, B, M: TTriple; begin vM := Midpoint(vA, vB); M := GetTriple(vM); if M.X = Uninitialized then { Еще не задано } begin A := GetTriple(vA); B := GetTriple(vB); M := Triple( A.X + (B.X - A.X) div 2, A.Y + (B.Y - A.Y) div 2, A.Z + (B.Z - A.Z) div 2 + Rand(Envelope) ); { Средняя высота ± Random(Envelope) } SetTriple(vM, M); end; end; procedure FractureTriangle(const A, B, C: TVertex; Plys: word); var Envelope: word; AB, BC, CA: TVertex; begin if Plys > 1 then begin Envelope := Envelopes[Plys]; FractureLine(AB, A, B, Envelope); FractureLine(BC, B, C, Envelope); FractureLine(CA, C, A, Envelope); Dec(Plys); FractureTriangle(CA, BC, C, Plys); FractureTriangle(AB, B, BC, Plys); FractureTriangle(BC, CA, AB, Plys); FractureTriangle(A, AB, CA, Plys); end; end; end.

Три веских довода в пользу модуля Math

Существует три веских довода в пользу работы с модулем Math. Первый и самый главный — скорость. Процедуры и функции модуля Math работают быстро. Большинство из них написано на языке ассемблера, специально оптимизированном для математического сопроцессора (Floating-Point Unit, FPU) Pentium. Если вы не обладаете процессором Pentium II и большим количеством свободного времени, добиться заметно большей скорости вряд ли удастся!

Во-вторых, использование статистических средств SQL неприемлемо. SQL содержит всего лишь четыре или пять статистических функций — слишком мало для получения полной статистической картины.

В-третьих, выбор модуля Math вместо решений, основанных на SQL или BDE, гарантирует работу компонента TDBStatistics с другими механизмами баз данных (например, Apollo, Titan или Direct Access).

Тригонометрические функции и процедуры

ArcCos Арккосинус

ArcCosh Гиперболический арккосинус

ArcSin Арксинус

ArcSinh Гиперболический арксинус

ArcTahn Гиперболический арктангенс

ArcTan2 Арктангенс с учетом квадранта (функция ArcTan, не учитывающая квадрант, находится в модуле System)

Cosh Гиперболический косинус

Cotan Котангенс

CycleToRad Преобразование циклов в радианы

DegToRad Преобразование градусов в радианы

GradToRad Преобразование градов в радианы

Hypot Вычисление гипотенузы прямоугольного треугольника по дли-
нам катетов

RadToCycle Преобразование радианов в циклы

RadToDeg Преобразование радианов в градусы

RadToGrad Преобразование радианов в грады

SinCos Вычисление синуса и косинуса угла. Как и в случае SumAndSquares
и MeanAndStdDev, одновременная генерация обеих величин
происходит быстрее

Sinh Гиперболический синус

Tan Тангенс

Tanh Гиперболический тангенс

Улика, найденная в грязи

Дон Тейлор

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

В контору Эйса ворвалась Хелен.

— Мне ужасно жаль, что ты потерял свой Дневник. Все будет хорошо, бэби,— сказала она, обнимая Эйса и прижимаясь к нему щекой. — Я бы пришла раньше, но на улицах сейчас небезопасно.

Хелен Хайуотер происходила из вполне обеспеченной семьи, но решила самостоятельно строить свою карьеру. Глядя на ее изящную фигуру и светлые волосы, спадающие до плеч, трудно было предположить, насколько решительной она могла быть в ответственный момент. К настоящему моменту она успела закончить колледж и поступить в магазин на должность менеджера. Но ее заветная(хотя и до сих пор не сбывшаяся) мечта — стать женой Эйса Брейкпойнта.

— Не потерял, Хелен. Дневник был украден. Все это было подстроено, от начала и до конца, а я попался, словно какой-нибудь лопух из Бэйпорта.

Эйс поведал историю о том, что произошло прошлой ночью, и рассказал о своем утреннем разговоре с Мардж Рейнольдс.

— Так что у нас по крайней мере имеется неплохое описание похитителя, — закончил он. — Правда, я не уверен, что это к чему-нибудь приведет. Мы оставили записку на двери управляющего с просьбой позвонить, когда он вернется.

— Разве ты не видишь? — скептически спросила Хелен. — Это наверняка был Мелвин Бохакер. Описание подходит. Я уверена, что он затаил злобу после «Дела о двойной демонстрации» и пытается отомстить нам обоим. Вероятно, он заплатил этой женщине за ложный телефонный звонок. Готова поспорить, что он сейчас сидит дома и злорадствует.

— По-моему, все не так просто, Хелен, — ответил Эйс. — Ты не видела лица Бохакера, когда я…

Внезапно внимание Эйса привлекло что-то, происходящее снаружи. Сквозь жалюзи бокового окна он увидел человека, передвигающегося между кустами. Человек был высокого роста, носил низко надвинутую шляпу и длинный плащ цвета хаки. Он подошел ближе к окну и заглянул в комнату.

— Это он! — закричал Эйс. — Тот человек, которого описала Мардж, — это он украл мой Дневник! Он вернулся, как в «Кошмаре на улице Вязов», — и я сейчас с ним потолкую!

Услышав крик Эйса, пришелец широко раскрыл глаза и бросился в сторону, пересекая стоянку по диагонали. Эйс метнулся к двери и побежал за ним, постоянно увязая в грязи, которая полностью закрывала асфальт.

— Стой! — приказал Эйс, но фигура в плаще лишь побежала быстрее. Эйс рванулся вперед и сбил чужака с ног перед конторой управляющего. Прежде чем остановиться, они успели проехать пару метров по грязи.

— Эй, что тут происходит? — раздался голос сзади. Эйс с трудом повернул голову и увидел приближающегося управляющего, Марвина Гарденса.

— Я поймал чужака, которого Мардж видела прошлой ночью, — ответил Эйс, тщетно пытаясь стряхнуть с ресниц дождевые капли. — Того, кто украл мой Дневник. — Эйс не без труда поднялся на ноги, не ослабляя железной хватки на руке человека в плаще. Оба были покрыты грязью с головы до ног.

— Да, я прочел записку, — сказал Гарденс, пережевывая дешевую сигару кривыми, пожелтевшими зубами, — и как раз собирался позвонить. Но это не чужак, Брейкпойнт. Поздоровайся с моим новым садовником, Сергеем Стакупоповым. Он плохо говорит по-английски, но это поймет.

— Постой, — запротестовал Эйс. — Прошлой ночью этого человека видели с каким-то оружием. Два раза его пытались задержать, и оба раза он убегал. Садовник он или нет, но это говорит о том, что он виновен.

— Там, откуда он приехал, люди живут в страхе перед секретной полицией,— ответил Гарденс, затянувшись сигарой. — Если в этой стране кто-то позовет на помощь, то это может стать его последним криком. Он получил «зеленую карту» и до смерти боится потерять ее — тогда его семье придется возвращаться на родину. Поэтому он много и усердно работает. А прошлым вечером он просто подстригал кусты, наверное, Мардж увидела его с садовыми ножницами, вот и все.

Эйс ослабил хватку, отпустил садовника и извинился. Сергей насторожен но наблюдал за ним, потом вежливо улыбнулся и сказал: «Хэлло».

Сыщик вернулся в контору, где его ждала Хелен с миллионом вопросов. Он пересказал ей события последних минут и задумался.

— Эй, все будет нормально, — заверила Хелен. — Просто временная неудача. А теперь снимай свой грязный плащ, пока не простудился.

Эйс неохотно подчинился.

— Хорошо, если временная, — сказал он, выбирая в шкафу чистые плащ и шляпу.

— Конечно, временная, милый, — ответила она. — Послушай, обед заканчивается, и мне нужно возвращаться в магазин. Днем обязательно позвони мне. Я зайду после работы, чтобы узнать, как дела.

Она поцеловала его в щеку и вышла под проливной дождь.

Универсальный анализатор командных строк

Если меня что и раздражает в программировании, так это необходимость в десятый (или сотый) раз писать код для выполнения одной и той же задачи. С анализом командных строк дело обстоит именно так - он необходим во всех фильтрах без исключения, но после того как вы напишете этот код пару раз, задача становится на редкость скучной . Поэтому я и постарался создать некий обобщенный анализатор, который ценой минимальных усилий с моей стороны обрабатывает командную строку и присваивает нужные значения переменным. Благодаря этому я могу уделить больше внимания самому фильтру (то есть основной задаче), а не второстепенному анализатору.

Обобщенный анализатор командных строк - это вам не фунт изюма, и даже самый тривиальный вариант потребует немалых усилий. Анализатор из нашего примера обладает минимальными возможностями, но во многих приложениях этого будет вполне достаточно.

Основная идея заключается в том, чтобы определить префиксы параметров, указать тип каждого параметра и задать значения по умолчанию. Структура, содержащая всю эту информацию, передается анализатору, который обрабатывает командную строку и присваивает значения найденным параметрам. Если при обработке строки происходит ошибка (скажем, обнаружи вается неизвестный параметр или там, где должен стоять переключатель, оказывается число), анализатор выдает сообщение об ошибке, прерывает работу и уведомляет вызывающую функцию. Ну как, просто? Да, просто сказать… запрограммировать несколько сложнее.

Информация об отдельном параметре хранится в виде записи OptionsRec, описанной в листинге 1.3. В нем приведен полный исходный текст всего модуля CmdLine. Создайте новый файл в редакторе, введите и сохраните код под именем CMDLINE.PAS.

Листинг 1.3. Модуль CmdLine

{ CMDLINE.PAS - Анализатор командной строки Автор: Джим Мишель Дата последней редакции: 04/05/97 } unit cmdline; interface type OptionType = (otBool, otInt, otString, otFilename); pOptionRec = ^OptionRec; OptionRec = record OptionChar : char; case Option : OptionType of otBool : (OnOff : Boolean); otInt : (Value : Integer); otString : (Param : ShortString); otFilename : (Filename : ShortString); end; pOptionsArray = ^OptionsArray; OptionsArray = Array [1..1] of OptionRec; { GetOptionRec - возвращает указатель на запись из передаваемого массива параметров Options, соответствующую заданному префиксу. Возвращает Nil, если префикс отсутствует в массиве. } function GetOptionRec ( Options : pOptionsArray; nOptions : Integer; OptionChar : char ) : pOptionRec; { ProcessCommandLine - обрабатывает командную строку в соответствии со списком параметров, переданным в массиве Options. Возвращает True при успешном завершении и False - в случае ошибки. } function ProcessCommandLine ( Options : pOptionsArray; nOptions : Integer ) : Boolean; implementation uses SysUtils; { GetOptionRec - возвращает указатель на запись из передаваемого массива параметров Options, соответствующую заданному префиксу. Возвращает Nil, если префикс отсутствует в массиве. } function GetOptionRec ( Options : pOptionsArray; nOptions : Integer; OptionChar : char ) : pOptionRec; var i : Integer; begin Result := Nil; for i := 1 to nOptions do begin if (Options^[i].OptionChar = OptionChar) then begin Result := @Options^[i].OptionChar; Break; end; end; end; { ProcessBool Определяет состояние параметра-переключателя (вкл/выкл). Если в Param передается пустая строка, параметр считается включенным (+). В противном случае строка должна начинаться со знака + или -,в соответствии с которым присваивается значение переменной OnOff. } function ProcessBool ( Param : String; var OnOff : Boolean ) : Boolean; begin Result := True; if (Length (Param) = 0) then begin OnOff := True; Exit; end; case Param[1] of "+" : OnOff := True; "-" : OnOff := False; else begin WriteLn ("Error: + or - expected"); Result := False; end; end; end; { ProcessInt Извлекает целое число из переданного параметра командной строки. } function ProcessInt ( Param : String; var Value : Integer ) : Boolean; begin if (Length (Param) = 0) then begin Result := False; WriteLn ("Error: integer expected"); Exit; end; Result := True; try Value := StrToInt (Param); except WriteLn ("Error: integer expected"); Result := False; end; end; { ProcessString Копирует переданную строку в переменную Option. Проверка ошибок не выполняется, а пустая строка считается допустимым параметром. } function ProcessString ( Param : String; var Option : ShortString ) : Boolean; begin Option := Param; Result := True; end; { ProcessFilename Извлекает имя файла из переданного параметра командной строки. В настоящей реализации функция просто вызывает ProcessString и копирует строковый параметр в Filename. Возможно, в будущих версиях она будет проверять, является ли строка допустимым именем файла, или же будет использоваться для преобразования короткого имени в полное, включающее путь. } function ProcessFilename ( Param : String; var Filename : ShortString ) : Boolean; begin Result := ProcessString (Param, Filename); end; { CheckParam Проверяет, принадлежит ли аргумент командной строки Param заданному списку параметров. Если префикс будет признан допустимым, обрабатывает параметр в соответствии с его типом (логическим, целым, строковым или файловым). Возвращает True при правильной обработке и сохранении параметра и False в противном случае. } function CheckParam ( Param : String; Options : pOptionsArray; nOptions : Integer ) : Boolean; var Rec : pOptionRec; Option : String; begin Result := False; if (Param[1] in ["-", "/"]) then begin if (Length (Param) < 2) then begin WriteLn ("Invalid option"); end else begin Rec := GetOptionRec (Options, nOptions, Param[2]); if (Rec <> Nil) then begin Option := Copy (Param, 3, Length (Param) - 2); case Rec^.Option of otBool : Result := ProcessBool (Option, Rec.OnOff); otInt : Result := ProcessInt (Option, Rec^.Value); otString : Result := ProcessString (Option, Rec^.Param); otFilename : Result := ProcessFilename (Option, Rec^.Filename); else WriteLn ("Invalid option specification: ", Param[2]); end; end else begin WriteLn ("Invalid option character: ", Param[2]); end; end; end else begin WriteLn ("Error: options must start with - or /"); end; end; { ProcessCommandLine По заданному списку префиксов и типов параметров проверяет каждый аргумент командной строки и соответствующим образом присваивает значения информационным полям записей массива Options. Возвращает True, если все параметры были успешно обработаны и сохранены. } function ProcessCommandLine ( Options : pOptionsArray; nOptions : Integer ) : Boolean; var ParamNo : Integer; begin Result := True; for ParamNo := 1 to ParamCount do begin if (Not CheckParam (ParamStr (ParamNo), Options, nOptions)) then begin Result := False; Exit; end; end; end; end.

Перечисляемый тип OptionType описывает различные виды параметров, о которых известно функции ProcessCommandLine. Запись OptionRec содержит три поля: префикс, тип параметра и вариантную часть, в которой хранится значение данного параметра (если вы незнакомы с вариантными записями, просмотрите раздел справки с соответствующей информацией или купите простейший учебник по Паскалю в ближайшем книжном магазине).

Запись OptionRec оказывается не слишком эффективным решением, поскольку все записи независимо от типа параметра имеют максимальный размер из всех возможных вариантов. Размер типа ShortString  равен 256 байтам, поэтому большинство записей будет занимать гораздо больше места, чем действительно необходимо. Существует несколько способов решения этой проблемы, самый простой из них - использовать  указатели  на строки (вместо самих строк) для строковых и файловых типов. Я не реализовал эту возможность, поскольку она требует дополнительного кодирования.

Другая проблема тоже связана с типом ShortString. Самая длинная строка, которая может храниться в переменной типа ShortString, состоит из 255 символов, тогда как максимальная длина пути в Windows оказывается несколько длиннее (260 байт). Я рассчитывал воспользоваться типом Delphi AnsiString (то есть «длинной строкой»), но длинные строковые типы не могут входить в вариантную часть записи. И снова самым очевидным решением будет использование указателей.

Несмотря на эти проблемы, модуль CmdLine способен принести немало пользы. Дополнительные расходы памяти не особенно страшны, поскольку в большинстве программ используется совсем немного параметров, и нас уже не страшит дурацкое ограничение в 64 Кбайт на размер статических данных. (Помните, мы живем в обширном 32-разрядном мире!) С ограничением на длину имени дело обстоит посложнее, но лично у меня найдется не так уж много знакомых, которым захотелось бы вводить 256-символьный путь в командной строке (точнее, таких вообще не найдется).

Модуль CmdLine содержит две функции, которые могут вызываться внешними программами: GetOptionRec и ProcessCommandLine. Функция GetOptionRec возвращает указатель на запись с заданным префиксным символом. Если такой записи не существует, GetOptionRec возвращает Nil. Вся настоящая работа выполняется в функции ProcessCommandLine. Вы передаете ей массив структур OptionRec, а она анализирует командную строку и заполняет поля значений для каждого параметра. Если ProcessCommandLine удается без ошибок обработать все аргументы командной строки, она возвращает True. Если в какой-то момент произойдет ошибка, функция немедленно прекращает работу, выдает сообщение об ошибке и возвращает значение False.

Упаковка таблиц Paradox и dBASE

Дневник №16, 20 марта. В детстве мама все время заставляла меня убирать разнообразный хлам, не используемый в проектах, над которыми я тогда работал. Фразу: «Убирай за собой!»мне приходилось слышать по крайней мере раз в день. Наверное, у моего клиента была похожая мама — может быть, именно поэтому он обратился ко мне с просьбой изобрести легкий способ освобождения неиспользуемого места в таблицах Paradox и dBASE из приложений Delphi.

Наверное, мне пришла в голову та же мысль, что и моему странному клиенту — я предположил, что для этого должен существовать специальный метод компонента TTable. Это было бы вполне логично, потому что возможность упаковки предусмотрена и в dBASE, и в Paradox. Однако команда разработ чиков Delphi, видимо, стремилась мыслить глобально и обеспечить поддержку больших баз данных с архитектурой клиент/сервер, которые не воспринимают таких команд.

Хотя разработчики Delphi не предусмотрели непосредственной возможно сти для упаковки таблиц, они все же оставили средства для того, чтобы вы могли «залезть внутрь» и работать со средствами низкого уровня. Речь идет не только о внутреннем сервисе Windows, а о любом старом API, который пожелает стать доступным для программ — в том числе и Borland Database Engine (BDE).

Механизм BDE предоставляет программам множество низкоуровневых услуг. На нем основана работа компонентов Delphi, связанных с базами данных. Модули BDE доступны для любой Delphi-программы.

Небольшой поиск в Internet вознаградил меня процедурой, которая средствами BDE выполняет упаковку таблиц Paradox и dBASE. К сожалению, автор процедуры неизвестен, и я не могу должным образом поблагодарить его. Я слегка изменил код, чтобы преобразовать его в модуль и организовать обработку ошибок. Измененная версия процедуры содержится в файле PAKTABLE.PAS (см. листинг 14.5).

Листинг 14.5.

Модуль для упаковки таблиц Paradox и dBASE {——————————————————————————————————————————————————————} { Упаковка таблиц (демонстрационная программа) } { PAKTABLE.PAS : Главный модуль } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Модуль, содержащий специализированную процедуру } { для упаковки таблиц Paradox и dBASE и удаления } { пустых записей } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 22/4/97 } {————————} unit PakTable; interface uses SysUtils, Dialogs, DBTables, DBiTypes, DBiProcs, DBiErrs; function PackTable(var ATable : TTable) : Boolean; implementation type EDBPackMisc = class(Exception); var ActiveStatus : Boolean; ExclusiveStatus : Boolean; Error : DBiResult; ErrorMsg : DBiMsg; pTableDesc : pCRTblDesc; AHandle : hDBiDB; { PackTable упаковывает записи в таблицах Paradox и dBASE (а в случае таблиц dBASE также производит фактическое удаление записей, ранее помеченных как удаленные). Свойство TableType упаковываемой таблицы должно быть равно либо ttParadox, либо ttDBase; ttDefault не подходит. Кроме того, таблица не должна больше никем использоваться, поскольку ее необходимо перевести в режим монопольного доступа. } function PackTable(var ATable : TTable) : Boolean; begin Result := False; try with ATable do begin { Сохраняем текущее состояние таблицы } ActiveStatus := Active; ExclusiveStatus := Exclusive; { Разрываем связь таблицы с элементами и устанавливаем монопольный режим } DisableControls; Active := False; Exclusive := True; end; { with } try { Упаковываем таблицу в зависимости от ее типа } case ATable.TableType of ttParadox : begin { Создаем таблицу с описанием и готовим ее к использованию } GetMem(pTableDesc, SizeOf(CRTblDesc)); FillChar(pTableDesc^, SizeOf(CRTblDesc), 0); with pTableDesc^ do begin StrPCopy(szTblName, ATable.TableName); StrPCopy(szTblType, szParadox); bPack := True; end; { with } { Получаем логический номер базы данных для таблицы } with ATable do begin Active := True; AHandle := ATable.DBHandle; Active := False; end; { with } try { Попытаемся реструктурировать/упаковать таблицу и обработать ошибки } Error := DBiDoRestructure(AHandle, 1, pTableDesc, nil, nil, nil, False); if Error = DBIERR_NONE then Result := True else begin DBiGetErrorString(Error, ErrorMsg); raise EDBPackMisc.Create(ErrorMsg); end; finally FreeMem(pTableDesc, SizeOf(CRTblDesc)); end; { try } end; ttDBase : with ATable do begin Active := True; Error := DBiPackTable(DBHandle, Handle, nil, nil, True); if Error = DBIERR_NONE then Result := True else raise EDBPackMisc.Create ("Could not pack this dBASE table"); end; else raise EDBPackMisc.Create ("Cannot pack this table type"); end; { case } except on E:EDBPackMisc do MessageDlg(E.Message, mtError, [mbOK], 0); end; { try } finally { Восстанавливаем исходное состояние таблицы } with ATable do begin Active := False; Exclusive := ExclusiveStatus; Active := ActiveStatus; EnableControls; end; { with } end; { try } end; end.

В Paradox и dBASE используются несколько отличающиеся способы удаления записей. Когда dBASE «удаляет» запись, она не уничтожается на физическом уровне. Запись всего лишь помечается как удаленная, для чего ее первый байт заменяется символом *. Преимущество такого подхода заключается в том, что удаленную запись можно легко «восстановить», а недоста ток — в том, что удаление записи не приводит к освобождению места на диске. С другой стороны, Paradox действительно уничтожает запись физически и повторно использует освободившееся место при добавлении новых записей.

Для упаковки таблиц этих двух видов также применяются различные

механизмы. Таблицы dBASE упаковываются командой DBiPackTable. Упаковка таблиц Paradox выполняется в процессе реструктурирования таблицы (таким образом становится понятно, почему возможность упаковки включена в диалоговое окно Restructure Table программы Paradox).
Большинство махинаций, выполняемых в PackTable, связано с фиксацией состояния таблицы (чтобы при выходе ее можно было восстановить) и приведением таблицы в должный вид перед обращением к BDE API. PackTable различает таблицы двух видов по значению свойства TableType. При установке свойств таблицы необходимо выбрать значение ttParadox или ttDBase; стандарт ное значение ttDefault не подойдет. Не важно, к какому типу относится упаковываемая таблица — она должна находиться в монопольном режиме. Никто не сможет обратиться к ней, пока выполняется операция упаковки.

Упущение

Мститель закрыл Дневник и откинулся на спинку стула, припоминая события последних часов. Ночь была длинной, а операция — рискованной. Однако наживка идеально сработала. Как и ожидалось, Брейкпойнт клюнул на голос беспомощной женщины. Как только сыщик покинул контору, поджидавший этого момента Дельфийский Мститель взломал дверь и украл драгоценный Дневник.

Вероятно, с Брейкпойнтом теперь покончено. Но его судьба никого не интересует. Имеет значение только Дневник и содержащиеся в нем знания. Несомненно, цель оправдывала средства. Если это заодно поможет разделаться с мистером Брейкпойнтом, тем лучше.

Мститель погладил кожаную обложку и любовно похлопал по ней, но вдруг оцепенел. Внезапно он понял, что не все прошло по плану и кое-чего не хватает. Лихорадочные поиски в карманах плаща ничего не дали.

На лбу Мстителя начали проступать капли нервного пота:

«Может быть, она просто выпала из кармана и лежит в машине. А может, осталась на капоте, слетела по дороге и плавает сейчас в какой-нибудь канаве.

Но при этом нельзя исключить — а значит, следовало допустить — что пропавший предмет лежит где-то рядом с конторой Брейкпойнта. В таком случае он может стать… вещественным доказательством. Очень важным доказательством.

Настолько важным, что стоит рискнуть и попытаться вернуть пропажу».

Установка приложений — дело рук самих приложений

Поскольку я занимаюсь написанием shareware-программ на Delphi, мне захотелось создать простейшую установочную программу для тех людей, которые получают мои творения через онлайновые службы или BBS. К сожалению, Delphi почти автоматически «нагружает» любую программу немалым количеством ресурсов, так что даже простейшая установочная программа занимает около 200 Кб (правда, после этой цифры скорость роста программы резко уменьшается). Для Windows-приложения такой размер выглядит вполне нормально, но установочная программа должна быть как можно меньше — особенно если учесть, что пользователь оплачивает каждую секунду времени пересылки и что мне самому приходится платить за отправку зарегистрированной версии по электронной почте.

К счастью, я придумал, как предоставить установочной программе все ресурсы Delphi, обеспечив при этом минимальное увеличение объема пересылаемых файлов: главное приложение само выполняет функции установочной программы. Первоначально файл программы называется SETUP.EXE. При запуске под этим именем приложение устанавливает себя, хотя пользователю может показаться, что он имеет дело с отдельной установочной программой. После завершения установки программа переименовывает себя и перестает быть инсталлятором.

Давайте посмотрим, как это делается. В листинге 9.7 показан основной блок файла проекта (DPR) типичного приложения Delphi. В листинге 9.8 показан тот же блок, но с изменениями, благодаря которым он начинает действовать как установочная программа. Обратите внимание на проверку имени EXE-файла приложения — если имя файла равно SETUP.EXE, мы запускаем форму (или серию форм), в которой пользователь задает каталог, программную группу и прочие параметры установки.

Листинг 9.7. BEFORE.SRC

{ Основной блок DPR-файла приложения до внесения изменений, предназначенных для работы в установочном режиме. } begin Application.Initialize; Application.CreateForm( TMainForm, MainForm ); Application.Run; end

Листинг 9.8. AFTER.SRC

{ Основной блок DPR-файла приложения после внесения изменений, предназначенных для работы в установочном режиме. } { Обратите внимание, что в строку USES модуля необходимо включить SYSUTILS.PAS. } begin Application.Initialize; if UpperCase( ExtractFileName ( Application.ExeName ) ) = 'SETUP.EXE' then begin Application.CreateForm ( TSetupForm, SetupForm ); end else Application.CreateForm ( TMainForm, MainForm ); Application.Run; end.

Перед тем как архивировать свою программу (EXE-файл, справочные файлы и т. д.) для пересылки, я меняю имя EXE-файла на SETUP.EXE. После того как пользователь получит архив, раскроет его и запустит SETUP.EXE, приложение копирует себя и все вспомогательные файлы в указанный каталог и восстанавливает свое нормальное имя. При следующем запуске приложение обнаруживает, что его имя отличается от SETUP.EXE, и ведет себя нормально.

Ценой незначительного увеличения объема программы и времени пересылки пользователь получает полезную установочную программу, а я (хочется верить) — несколько лишних проданных экземпляров.

Вас обслуживают?

По умолчанию FTP-сервер всегда ожидает, что клиент инициирует соедине ние через TCP-порт с номером 21. Это соединение (оно называется управляющим соединением, control connection) остается открытым до тех пор, пока либо клиент, либо сервер не закроет его со своей стороны. Через установлен ное соединение клиент и сервер обмениваются командами FTP и кодами ответов соответственно. В командах Internet-протоколов обычно используется обычный англоязычный текст (чаще всего в верхнем регистре). Это остается справедливым даже при взаимодействиях между программами. Причина заключается в том, что Internet первоначально работал только с 7-разрядной ASCII-кодировкой, которая была (и остается) «наименьшим общим знамена телем» для общения двух систем — компьютерных или любых других.

Это обстоятельство не лучшим образом сказывается на скорости работы, но зато человеку становится значительно легче уследить за взаимодействием двух Internet-программ. На каждую команду, полученную от клиента, сервер обычно посылает код ответа. Код состоит из трех цифр, за которыми следует дефис или пробел, а затем — некоторый текст. Типичные сообщения могут выглядеть следующим образом:

200 PORT command successful.
230-Welcome to your I-SITE Internet server!

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

Диаграмма, изображенная на рис. 6.1, описывает взаимодействие клиента с сервером во время регистрации. FTP-сеанс начинается с посылки клиентом команды USER, за которой следует имя пользователя, и получения со стороны сервера кода ответа, состоящего из трех цифр. Если имя пользовате ля признается допустимым, сервер отвечает кодом 331 или 230. При недопустимом имени пользователя генерируется код 4xx или 5xx, где xx описывает код конкретной ошибки.

Ответ 230 означает, что имя пользователя признано допустимым и для доступа к системе не требуется никакой дополнительной информации. Сервер обычно выдает этот код в ответ при знаменитой «анонимной» регистрации пользователей. Ответ 331 означает, что имя пользователя также признано допустимым, но для доступа к системе необходим пароль. В этом случае клиент посылает команду PASS, за которой следует пароль.

Неверный пароль вызывает ответ 4xx или 5xx, свидетельствующий об ошибке. Если пароль принят, сервер может послать код 230, чтобы сообщить о завершении регистрации. Если для регистрации необходимы сведения об используемых ресурсах (account), сервер снова отвечает кодом 331, чтобы клиент послал команду ACCT и требуемые сведения.

Рис. 6.1. Регистрация FTP-клиента на FTP-сервере

После того как соединение будет успешно установлено, клиент может продолжить посылку команд. Однако при возникновении проблемы (например, посылке команды с неверным синтаксисом) или слишком большом количестве пользователей, работающих в системе, сервер посылает код 4xx или 5xx и закрывает соединение.

Вечером в конторе

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

Я снял шляпу и плащ, швырнул промокшую кобуру на диван. Кобура едва не задела Мьюникса. Утомленный кот даже не пошевелился, а лишь открыл один глаз и презрительно взглянул на меня. Я бухнулся в кресло и включил компьютер. Только что закончилась встреча моей группы координирования проектов под Win95, и мне хотелось немного привести в порядок мысли. Пожалуй, для начала стоит просмотреть почту.

Меня ждала всего одна записка от моей мамы, Куини Брейкпойнт: «Не забудь позвонить сестре и поздравить ее с днем рожденья, обязательно пригласи всех друзей на вечеринку, посвященную годовщине твоего последнего приключения…»

Я тут же набросал e-mail с приглашением, забросил его в список рассылки «друзья» и задумался. Хотя то приключение состоялось всего два года назад, казалось, что прошла целая вечность. Все начиналось достаточно невинно — мы с Мелвином Бохакером соревновались за очередной контракт. Бохакер — высокий парень с длинной шеей, любитель гамбургеров и программирования на C/C++, знавший великое множество различных библиотек. До той поры ему удавалось перехватывать у меня почти всех клиентов.

Поначалу все выглядело, как честная конкуренция. Но когда прошло всего 24 часа и дым немного рассеялся, я был в кошмарном состоянии — избитый, окровавленный и совершенно одуревший. Не знаю, чем бы все кончилось, если бы не друзья.

Мы познакомились в колледже, и наша компания стала неразлучной. Мои самые близкие друзья даже оказались в некоторой степени участниками тех событий. Громила Бакендорф-Рабинович (бывший профессиональный футболист) попал тогда на психологическое обследование. Бифф Мэрфи, специалист по деловой этике, опасался за мою жизнь. Маффи Катц, профессиональный психиатр и по совместительству маникюрша, тоже опасалась… честно говоря, она больше всего опасалась сломать ноготь клиенту.

И еще была Хелен Хайуотер. Почти пять лет Хелен оставалась рядом, деля со мной все радости и беды. Но тогда, во время приключения, я едва не потерял ее. Впрочем, как бы скверно мне ни было, на следующий день мне все же удалось поквитаться с Бохакером. Я так врезал ему, что кровь из его расквашенного носа забрызгала мой плащ. Окровавленная реликвия до сих пор висит где-то в шкафу.

Я невольно усмехнулся. Много воды утекло за прошедший год. Теперь я почти полностью перешел на Delphi 3, моя консультационная практика постоянно расширялась. Бифф все еще стоял на раздаче в «Норвежских жареных цыплятах Бака МакГаука». Хелен работала менеджером в местном магазине. Маффи бросила работу и занялась созданием модной одежды и украшений. История Громилы закончилась трагично. Ему поставили диагноз «мания величия» и поместили в государственное лечебное учреждение (а проще
говоря — в психушку). Через два месяца интенсивного труда он научился настраивать гитару. Однажды ночью он вместе с четырьмя другими обитателя ми этого заведения сбежал и организовал гранж-группу «Крыша поехала». Их первый компакт-диск стал платиновым. На этой неделе должен выйти второй (не собираюсь покупать ни тот, ни другой — даже дружба имеет свои пределы).

Вход строго по одному

Чтобы предотвратить попытки соединения со стороны новых FTP-клиентов, LoginUser вызывает функцию WSAAsyncSelect с последним параметром, равным 0 — при этом Winsock DLL перестает оповещать прослушивающий сокет FSocket. Это происходит в следующей строке:

if WSAAsyncSelect(FSocket, Wnd, FTP_EVENT, 0) = SOCKET_ERROR then
{ продолжение... }

В результате все остальные FTP-клиенты будут получать отказ в обслуживании до тех пор, пока CsKeeper не закончит работу с текущим клиентом.

Затем следует очередной вызов WSAAsyncSelect:

if WSAAsyncSelect(FClientSocket, Wnd, FTP_EVENT, FD_READ OR FD_CLOSE OR FD_OOB OR FD_WRITE) = SOCKET_ERROR then begin

{ продолжение... }

Этот вызов обеспечивает уведомление со стороны Winsock о любых событиях сокета FClientSocket. После завершения регистрации CsKeeper1 ожидает поступления по управляющему соединению других FTP-команд.

Когда FTP-клиент выдает команду (например, RETR), FtpEvent получает ее, перехватывая событие FD_READ, сгенерированное Winsock DLL. В ветви FD_READ оператора case вызывается процедура DecodeFTPCmd, которая обрабатывает команды, посылаемые FTP-клиентом. DecodeFTPCmd декодирует команду и вызывает соответствующую процедуру. Если команда не опознана, CsKeeper1 посылает FTP-клиенту код ошибки. Процесс обработки FTP-команд в процедуре DecodeFTPCmd показан в листинге 7.5. Именно здесь находится «сердце» компонента CsKeeper.

Листинг 7.5. Метод DecodeFTPCmd

procedure TCsKeeper.DecodeFTPCmd (SockNo : TSocket; CmdStr : CharArray; S : String); var FtpCmd, Selector : TFtpCmds; DirStr, FileName, Line, Port1Str, Port2Str, S1, TempStr : String; Finished : Boolean; Count : Byte; begin FtpCmd := UNK; Finished := FALSE; Count := 1; S1 := ''; TempStr := StrPas(CmdStr); while not Finished do begin if (TempStr[Count] = ' ') or ((TempStr[Count] = #13) and (TempStr[Count + 1] = #10)) then begin Finished := TRUE; end else begin S1 := ConCat(S1,TempStr[Count]); Inc(Count); end; end; Selector := PWD; Status := Failure; { На всякий случай предположим, что произошла неудача } Finished := FALSE; if S1 = '' then Exit; { Пустые строки не обрабатываются } while not Finished do begin if CompareText(S1, FtpCmdStr[Selector]) = 0 then begin FtpCmd := Selector; Status := Success; break; end else begin if Selector = UNK then begin Status := Failure; Finished := TRUE; end; if not Finished then Inc(Selector); end; end; if Status = Failure then begin Info := Concat('Unrecognised command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 Unrecognised command'); Status := Failure; Exit; end; case FtpCmd of PWD : begin Info := Concat('PWD command received from ', FClientAddrStr); InfoEvent(Info); GetDir(0, DirStr); SendFtpCode(FClientSocket,'257 Working directory is '+ DirStr); end; RETR : begin Info := Concat('RETR command received from ', FClientAddrStr); InfoEvent(Info); FileName := Copy(TempStr, Pos(' ', TempStr)+1, Length(TempStr)); if Pos(#13, FileName) > 0 then FileName := Copy(FileName, 1, Pos(#13, FileName)-1); Info := Concat('Sending file ',FileName, ' to ', FClientAddrStr); InfoEvent(Info); if FFileType = IMAGE then begin Info := Concat('Using IMAGE type'); InfoEvent(Info); SendFtpCode(FClientSocket, '150 Opening BINARY data connection for ' + FileName) end else begin Info := Concat('Using ASCII type'); InfoEvent(Info); SendFtpCode(FClientSocket, '150 Opening ASCII data connection for ' + FileName); end; SendFile(FileName); end; STOR : begin Info := Concat('STOR command received from ', FClientAddrStr); InfoEvent(Info); if FUpLoads then begin FileName := Copy(TempStr, Pos(' ', TempStr)+1, Length(TempStr)); if Pos(#13, FileName) > 0 then FileName := Copy(FileName, 1, Pos(#13, FileName)-1); Info := Concat('Sending file ', FileName, ' to ', FClientAddrStr); InfoEvent(Info); if FFileType = IMAGE then begin Info := Concat('Using IMAGE type'); InfoEvent(Info); SendFtpCode(FClientSocket, '150 Opening BINARY data connection for ' + FileName) end else begin Info := Concat('Using ASCII type'); InfoEvent(Info); SendFtpCode(FClientSocket, '150 Opening ASCII data connection for ' + FileName); end; GetFile(FileName); end else SendFtpCode(FClientSocket, '500 STOR command not executed (not allowed)'); end; USER : begin { Декодируем строку } if Pos('ANONYMOUS',UpperCase(TempStr)) > 0 then begin Info := Concat('USER command received from ', FClientAddrStr); InfoEvent(Info); Info := Concat('Anonymous login received from ', FClientAddrStr); InfoEvent(Info); FUserType := ANONYMOUS; SendFtpCode(FClientSocket, '331- Anonymous user accepted.'); SendFtpCode(FClientSocket, '331 Send in your password, please'); Info := Concat(FClientAddrStr,' logged in as anonymous'); InfoEvent(Info); end else begin FUserType := ACCOUNT; SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[ACCT] + ' command not implemented'); end; end; QUIT : begin Info := Concat('QUIT command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'221 Goodbye from Keeper!'); Info := FClientAddrStr; Info := ConCat(Info, ' logged out'); InfoEvent(Info); closesocket(FClientSocket); FClientSocket := INVALID_SOCKET; if FNoOfUsers >= 1 then Dec(FNoOfUsers); { Переходим к основному устройству и каталогу } GetHome; GetDirList; { Возвращаемся в состояние прослушивания } if WSAAsyncSelect(FSocket, Wnd, FTP_EVENT, FD_ACCEPT) = SOCKET_ERROR then begin Info := Concat('ERROR : 11 [',FClientAddrStr,'] ', WSAErrorMsg); InfoEvent(Info); Status := Failure; Exit; end; end; PASS : begin { Тип пользователя - ? } if FUserType = ANONYMOUS then begin Info := Concat('PASS command received from ', FClientAddrStr); InfoEvent(Info); { Получаем адрес электронной почты пользователя } SendFtpCode(FClientSocket, '230 User logged in. Go ahead!'); end; end; CDUP : begin Info := Concat('CDUP command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[CDUP] + ' command not implemented'); end; CWD : begin Info := Concat('CWD command received from ', FClientAddrStr); InfoEvent(Info); {$I-} { Переходим в каталог, указанный в Edit1 } FileName := Copy(TempStr, Pos(' ', TempStr)+1, Length(TempStr)); if Pos(#13, FileName) > 0 then FileName := Copy(FileName, 1, Pos(#13, FileName)-1); If DirectoryExists(FileName) then ChDir(FileName) else begin Status := Failure; SendFtpCode(FClientSocket,'500 Not a directory'); Exit; end; if IOResult <> 0 then SendFtpCode(FClientSocket,'500 Cannot find directory') else begin SendFtpCode(FClientSocket,'200 Changed directory'); GetDir(0,FDirPath); GetDirList; end; end; LIST : begin Info := Concat('LIST command received from ', FClientAddrStr); InfoEvent(Info); GetDirList; Info := Concat('Sending LIST to ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'150 Opening Ascii connection'); SendFile(DirListFile); end; PORT : begin Info := Concat('PORT command received from ', FClientAddrStr); InfoEvent(Info); Count := Length(TempStr); Port1Str := ''; Port2Str := ''; if (TempStr[Count] = #10) and (TempStr[Count-1] = #13) then Dec(Count,2); { не включать CR/LF!} while TempStr[Count] <> ',' do begin Port2Str := Concat(TempStr[Count], Port2Str); Dec(Count); end; Dec(Count); while TempStr[Count] <> ',' do begin Port1Str := Concat(TempStr[Count], Port1Str); Dec(Count); end; FPort2 := StrToInt(Port2Str); FPort1 := StrToInt(Port1Str); FPortNo := FPort2 + 1024; Info := Concat('Port No received ', IntToStr(FPortNo), ' from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'200 PORT command okay'); FClientSockAddr.sin_port := FPortNo; { Открываем соединение данных } end; SYST : begin Info := Concat('SYST command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'215 Unix Keeper 1.0'); end; HELP : begin Info := Concat('HELP command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket, '211- HELP Commands implemented at this site:'); SendFtpCode(FClientSocket, '211- QUIT RETR USER PASS LIST PORT CWD TYPE PWD'); SendFtpCode(FClientSocket,'211 '); end; FTYPE: begin if Pos('A', UpperCase(TempStr)) > 0 then begin FFileType := ASCII; SendFtpCode(FClientSocket,'200 TYPE ASCII'); end else if Pos('I', UpperCase(TempStr)) > 0 then begin FFileType := IMAGE; SendFtpCode(FClientSocket,'200 TYPE BINARY'); end; end; MODE : begin Info := Concat('MODE command received from ', FClientAddrStr); InfoEvent(Info); if Pos(' S', Uppercase(TempStr)) > 0 then FTransfer := STREAM else if Pos(' B', Uppercase(TempStr)) > 0 then FTransfer := BLOCK else FTransfer := COMPRESSED; end; NLST : begin Info := Concat('NLST command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[NLST] + ' command not implemented'); end; QUOTE : begin Info := Concat('QUOTE command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[QUOTE] + ' command not implemented'); end; PASV : begin Info := Concat('PASV command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[PASV] + ' command not implemented'); end; SITE : begin Info := Concat('SITE command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[SITE] + ' command not implemented'); end; MKD : begin if FCreateDir then begin Info := Concat('MKDIR command received from ', FClientAddrStr); InfoEvent(Info); Delete(TempStr,1,Pos(' ',TempStr)); Delete(TempStr,Pos(#13,TempStr), Length(TempStr)); {$I-} MkDir(TempStr); if IOResult <> 0 then begin Info := Concat('MKDIR command failed to create ', TempStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[MKD] + ' command not implemented'); end else begin Info := Concat('MKDIR command to create ',TempStr, ' executed successfully'); InfoEvent(Info); SendFtpCode(FClientSocket,'200 ' + FtpCmdStr[MKD] + ' command received OK'); end; end else SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[MKD] + ' command not implemented'); end; RMD : begin Info := Concat('RMD command received from ', FClientAddrStr); InfoEvent(Info); if FDeleteDir then begin delete(TempStr,1, Pos(' ',TempStr)); delete(TempStr, Pos(#13,TempStr), Length(TempStr)); {$I-} RmDir(TempStr); if IOResult <> 0 then begin Info := Concat('RMD command failed to delete ',TempStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[RMD] + ' command failed'); end else begin Info := Concat('RMD command to delete ',TempStr, ' executed successfully'); InfoEvent(Info); SendFtpCode(FClientSocket,'200 ' + FtpCmdStr[RMD] + ' command received OK'); end; end else SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[RMD] + ' command not executed'); end; STRU : begin Info := Concat('STRU command received from ', FClientAddrStr); InfoEvent(Info); if Pos(' F', Uppercase(TempStr)) > 0 then FFileStruct := NOREC else if Pos(' R', Uppercase(TempStr)) > 0 then FFileStruct := REC else FFileStruct := PAGE; end; STAT : begin Info := Concat('STAT command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[STAT] + ' command not implemented'); end; ACCT : begin Info := Concat('ACCT command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'500 ' + FtpCmdStr[ACCT] + ' command not implemented'); end; NOOP : begin Info := Concat('NOOP command received from ', FClientAddrStr); InfoEvent(Info); SendFtpCode(FClientSocket,'200 ' + FtpCmdStr[NOOP] + ' command received OK'); end; end; end;

При получении от FTP-клиента команды LIST CsKeeper вызывает SendFile, чтобы передать файл INDEX.TXT через соединение данных. После того как пересылка будет завершена, CsKeeper закрывает соединение данных. Соединение данных всегда является временным, в отличие от постоянного управляющего соединения.

Вложенные рекурсивные иерархические данные

Термин «рекурсивные иерархические данные» означает, что базовые и подчиненные записи находятся в одной таблице: одно неключевое поле записи содержит ключевое значение другой записи, и это означает, что вторая запись принадлежит первой. Неключевое поле называется внешним ключом (foreign key), даже если по нему устанавливается связь с другим полем этой же таблицы. В предыдущем примере использовался всего один уровень принадлежности: каждая запись могла соответствовать либо начальнику, либо подчиненному. Если подчиненный сам может быть для кого-то начальником, таблица становится полностью рекурсивной: любой работник может быть начальником и иметь начальника. Обратите внимание — ключ состоит из одного поля Emp_ID; поле Boss_ID может не быть ключевым, если в таблице имеется вторичный индекс, начинающийся с Boss_ID (см. табл. 13.3).

Теперь данные делятся на три уровня: начальники (Boss), менеджеры (Manager) и подчиненные (Staff). Вместо того чтобы добавлять для нового уровня новый компонент TDBGrid, форма Form2 (см. рис. 13.3) отображает два уровня сразу. Таким образом мы сможем выводить произвольно вложенные данные, не изменяя визуального интерфейса.

Критерий отбора записей для базовой таблицы Table1 можно изменить так, чтобы в ней присутствовали только работники с конкретным значением Boss_ID — подчиненная таблица Table2 послушно отображает только те подчиненные записи, которые связаны с базовой записью (например, список подчиненных конкретного менеджера). Дочерние, подчиненные записи не знают, является ли их базовая запись подчиненной для какой-то другой записи — для них это несущественно. Каждый уровень обладает своим набором базовых и подчиненных записей, и при «раскрытии» конкретной подчиненной записи изменяются только конкретные отображаемые данные.

Таблица 13.3. Рекурсивная таблица

Emp_ID <nil> <nil> <nil> Boss 1 Boss 1 Boss 2 Boss 1 Manager 1 Manager 2 Manager 3 Boss 3 Boss 3

Boss_ID Boss 1 Boss 2 Boss 3 Manager 1 Manager 2 Manager 3 Staff 1 Staff 2 Staff 3 Staff 4 Staff 5 Staff 6

Рис. 13.3. Рекурсивная связь между записями одной таблицы

Такой «пошаговый» интерфейс подходит для небольших деревьев, но в сильно разветвленной иерархии легко заблудиться. Для облегчения ориентации на форму можно поместить надпись (TLabel), в которой перечисляются все предки текущей записи.

Внимание, сейчас вылетит птичка…

Сначала я был удивлен различиями между 16- и 32-разрядной версиями ToolHelp. Некоторые процедуры (в том числе и TaskFirst с TaskNext) в 32-разрядной версии отсутствовали. Что это, просчет со стороны разработчиков?

Как выяснилось — нет. Реализация многопоточной, вытесняющей мультизадачности создала динамическую ситуацию, которая похожа на принцип неопределенности Гейзенберга. Система, которая постоянно управляет задачами, создает и уничтожает потоки, назначает приоритеты и занимается планированием, не может нормально функционировать и одновременно динамически сообщать о своем состоянии. К тому времени, когда вы получите отчет, состояние системы наверняка изменится.

Я мечтал о том, чтобы Win95 на несколько тактов уступила все полномочия моей программе и я получил бы абсолютно точный отчет о состоянии системы. Но при этом стабильность всей системы оказывается на совести одного приложения, что полностью противоречит всем принципам вытесняющей мультизадачности.

Как же решается проблема? Необходимо «сфотографировать» всю систему, причем процесс «фотографирования» планируется по усмотрению Win95. Затем содержимое полученного снимка можно изучить, не вмешиваясь в
работу системы. Решение, что и говорить, не идеальное, но по крайней мере работающее.

«Фотографирование» выполняется функцией CreateToolHelp32Snapshot, входящей в 32-разрядную версию ToolHelp. Функция вызывается с двумя параметрами. Первый из них представляет собой маску, определяющую тип собираемой информации. В табл. 15.1 приведены различные варианты масок и соответствующие им значения. Второй параметр является логическим номером процесса в системе. По этому логическому номеру (он принадлежит объекту, называемому идентификатором процесса , — process ID) можно получить доступ к одному процессу; изучая этот процесс, можно получить определенные сведения. Итак, в принципе необходимо проделать следующее:

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

w используйте процедуры Process32First и Process32Next для перебора процессов из полученного списка и изучайте различные аспекты этих процессов. Сведения о каждом процессе помещаются в переменную, указанную при вызове процедуры перебора.

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

Таблица 15.1. Маски функции CreateToolHelp32Snapshot

Имя TH32CS_SNAPHEAPLIST TH32CS_SNAPPROCESS TH32CS_SNAPTHREAD TH32CS_SNAPMODULE TH32CS_SNAPALL

Значение 1 2 4 8 15

Собираемые данные Пулы (heaps) памяти внутри процесса Все процессы в системе Потоки, принадлежащие заданному процессу Модули, принадлежащие заданному процессу Все перечисленное выше

Внутреннее строение компонентов TreeData

Все компоненты семейства TreeData используют базовый модуль TREEUTIL.PAS, в котором содержатся определения всех внутренних классов, управляющих данными. В TREEUTIL.PAS определен класс TTreeDataItem, содержащий информацию об объекте, и класс TTreeDataItems — потомок класса TList, содержащий информацию о всех объектах TTreeDataItem. Каждый элемент обладает объектом TTreeDataItems, доступ к которому осуществляется через свойство ItemList. С помощью public-методов этого объекта можно загружать, сохранять, находить, перемещать и удалять объекты, входящие в иерархию, а также получить идентификаторы всех предков или потомков и определить идентификатор предка самого верхнего уровня.

Класс TTreeDataItems происходит от класса TStringList и содержит идентификаторы всех объектов. Свойство Objects каждого объекта, входящего в TStringList, указывает на соответствующий объект TTreeDataItem. Указатели на объекты, принадлежащие элементу, хранятся в отдельном списке TList и синхронизируются со списком TTreeDataItems. В методе IndexOf сортированных списков TStringList используется двоичный поиск без учета регистра, поэтому найти нужный идентификатор оказывается несложно. После загрузки всех объектов и сортировки идентификаторов класс TTreeDataItems перебирает и заносит в структуру данных каждого объекта ссылки на первого потомка и следующего родственника (sibling). Это упрощает процесс перемещения по иерархии.

Описав семейство компонентов TreeData в целом, мы кратко рассмотрим каждый элемент в отдельности.

Вопросы безопасности

Безопасность считается одной из самых больших проблем в Internet. В программе KEEPER32 я реализовал лишь самые примитивные меры по обеспечению безопасности доступа. Если вы захотите усовершенствовать KEEPER32, в этой области перед вами открываются великолепные возможности.

В групповом поле gbSecurity можно указать, какие действия разрешаются FTP-клиентам, а какие нет. Например, вы можете запретить клиентам удалять каталоги на сервере, для этого следует лишь снять флажок cbDeleteDir. Если вы не хотите, чтобы программа KEEPER32 разрешала клиентам передаватьFRcvBuffer свои файлы на сервер, снимите флажок cbUpload. Внесенные изменения сохраняются кнопкой Save, при нажатии которой вызывается процедура SaveSecure Settings.

KEEPER32 можно слегка защитить от злонамеренных хакеров посредством ведения списка IP-адресов тех клиентов, которые уже пытались вызвать хаос в вашей системе. Если IP-адрес подключающегося FTP-клиента присутствует в «черном» списке lbBadIPAddrs, CsKeeper1 разрывает соединение. Для добавления, удаления и сохранения «плохих» IP-адресов используются кнопки Add, Remove и Save соответственно. На рис. 7.4 показана вкладка tsOptions после ввода списка нежелательных IP-адресов.

Рис. 7.4. Список нежелательных IP-адресов, которым KEEPER32 отказывает в установлении соединения

Информационные сообщения для клиентов

Иногда бывает нужно сообщить подключающимся FTP-клиентам об изменениях в FTP-услугах, предоставляемых KEEPER32, вывести другие информационные сообщения или инструкции («каталог pub/incoming ликвидирован…»). Такие сообщения обычно передаются пользователям при установлении или разрыве соединения. Они называются «приветственными» (welcome) и «прощальными» (farewell) сообщениями соответственно.

Вы можете ввести такие сообщения, нажимая кнопку Edit в групповом поле gbMessages. При этом на экране появляется форма frmMessages. На ней содержится элемент pcMessages типа TPageControl, имеющий две вкладки, tsWelcome и tsFarewell. На обеих вкладках присутствуют элементы Memo, в которых редактируется текст сообщений. Кнопка Save сохраняет текущее сообщение в текстовом файле. Внешний вид формы frmMessages показан на рис. 7.5. Указывая имена файлов в свойствах Welcome и Farewell компонента CsKeeper1, вы определяете местонахождение хранящихся сообщений. Когда KEEPER32 принимает подключающегося клиента, компонент CsKeeper1 использует свойство Welcome для поиска и открытия файла с текстом сообщения, отображаемого во время регистра ции.

Рис. 7.5. Форма для ввода приветственных и прощальных сообщений

Воспроизведение WAV-файла

Зловещая фигура отвела взгляд от Дневника и затряслась. Из перекошенного рта вырвался пронзительный смех, а усы сотрясались в такт губам: «Теперь я могу поглотить все материалы Дневника— такая информация может служить как Добру, так и Злу. Я стану самым уважаемым и могущественным программистом на Земле. Благодаря Эйсу Брейкпойнту никто больше не осмелится назвать меня "Бохакер" или "Эй, ты!" Все узнают мое новое имя — Дельфий ский Мститель . С обретенными знаниями я смогу править миром!Ха-ха-ха -ха!…»

Приступ истерического смеха продолжался минут десять. Затем Мститель вскрыл новый пакет чипсов и перевернул следующую страницу.

Возвращение оракула

Дон Тейлор

Пока Дельфийский Мститель узнает, как научить приложения Delphi обнаруживать присутствие самих себя и среды Delphi (а заодно получает плавающую панель инструментов), Эйс обнаруживает очень странное уравнение со множеством неизвестных — но в конечном счете приводит дело к потрясающей развязке.

Эйс включил галогеновую настольную лампу и поднес лавандовый обрывок к свету.

— Довольно дорогая бумага, — сказал он. — Виден край водяного знака.

Эйс повернул клочок так, чтобы свет отражался от бумаги. — Почерк действительно женский. Судя по размеру закругленных элементов, принадлежит особе с сильным характером. Очень похоже на женщину, которой хватило смелости позвонить мне вчера вечером. Характерные линии, похоже на ручку с дорогим пером «Хабашер №4374» и чернилами «Ночная тень». Вот, пожалуй, и все.

— Можно посмотреть? — спросила Хелен.

— Конечно, — ответил Эйс, передал записку и добавил: — Да, и еще одно. Бумага пахнет духами.

Хелен понюхала обрывок, и глаза ее расширились.

— Это не просто духи, — сказала она. — Это очень дорогие духи, Chez Monieux.

— Значит, пахнет дорогими духами, — раздраженно заметил Эйс.

— Я не спорю с тобой, милый. Просто женщины иногда замечают мелочи, которых не видят мужчины. Видишь ли, только утонченная, хорошо обеспеченная женщина может позволить себе духи Chez Monieux.

— Ну, хватит об этом. Я ведь уже сказал, что она использовала дорогую бумагу, очень хорошую ручку и чернила, не так ли? В конце концов, я не эксперт по духам, и…

— Думаю, Хелен всего лишь пытается сказать, — вмешалась Мардж, — что эти духи называются Chez Monieux.

Эйс на секунду застыл в задумчивости. Он вдруг вспомнил, что слышал нечто подобное от Маффи.

— Я так и знал, — произнес он осторожно.

— Помнишь? — сказала Хелен. — Эти духи входят в эксклюзивную коллекцию моды Маффи.

— Помню, — ответил Эйс. — Но что это нам дает?

— У меня есть гипотеза, — начала Хелен. — Думаю, Мелвин Бохакер давно мечтал поквитаться с тобой. Наверное, он познакомился с хорошо обеспеченной женщиной, которая ставит собственное достоинство превыше всего.

Она выжидательно посмотрела на своих собеседников. Эйс закатил глаза, но Мардж явно внимала каждому слову Хелен.

— Когда эта женщина — назовем ее «Мадам Икс» — узнала, что Мелвин потерял лицо из-за тебя, она подговорила его свести старые счеты. Они составили план и выполнили его вчера вечером. На ее машине они подъехали к конторе и остановились рядом с твоей машиной. Он вышел и спрятался, а она отправилась к телефонной будке и набрала заранее записанный номер. В это время она могла даже видеть тебя через окно кухни.

— Но как же записка попала туда, где ее нашли? — спросил Эйс.

— Могу предположить и это — ее просто сдуло порывом ветра. Сама телефонная будка освещена, но в нескольких футах от нее записка вполне могла затеряться в темноте. Видимо, она торопилась, а может быть, даже не заметила пропажи.

— А перчатка?

— Конечно, чтобы не оставить отпечатков пальцев, Бохакер взламывал дверь конторы в перчатках. Садясь в машину, он просто выронил одну из них. Может быть, его машина даже проехала по перчатке и вдавила ее в грязь.

— Очень жаль, — сказал Эйс, перебивая ее взмахом руки. — Все это звучит довольно правдоподобно, за исключением одного: Бохакер на такое просто не способен, даже подстрекаемый какой-то богатой дамочкой.

Хелен вздохнула:

— Наверное, стоит подождать результатов экспертизы ДНК. По крайней мере, это докажет, кто из нас прав.

— Экспертиза? — спросила Мардж. — Какая экспертиза? И как насчет перчатки, которую ты нашел?

Эйс поведал историю перчатки. На полное изложение всех подробностей потребовалось не менее получаса.

— Да, интересный денек, — сказала она. — Я бы хотела посидеть с вами и подождать результатов экспертизы. Но сегодня в номер 193 въезжает новый жилец — кстати, холостой, — так что, пожалуй, я узнаю, как он устроился.

Мардж ?ейнольдс неуклюже протиснулась в дверь и закрыла ее за собой.

язык программирования Паскаль стал мишенью

Давным-давно, во второй половине 80-х, язык программирования Паскаль стал мишенью для постоянных нападок со стороны адептов C и (позднее) C++. Они так часто твердили: «Паскаль - игрушечный язык», что пресса поверила им на слово.
Большинство этих людей либо вообще ничего не знали о Паскале, либо прошли начальные курсы под руководством других «попугаев», для которых переносимость кода стала высшим достижением во всей компьютерной науке. Так что в учебных заведениях обычно преподавался выхолощенный Паскаль, пригодный разве что для перебора элементов массива или работы с командной строкой. На самом деле C обладает ничуть не большей переносимостью, чем Паскаль, но…, впрочем, довольно - все эти разговоры попросту смешны, поскольку переносимость была и остается мифом. А ну-ка, вы, знатоки C: кто возьмется написать на C полностью самостоятельную, не пользующуюся никакими библиотеками программу, которая помещает текстовый курсор в точку с координатами 0,0 в любой реализации C на любой платформе? Теперь понятно, что я имел в виду? No es posible. Все споры о переносимости так же бессмысленны, как и дискуссии по поводу происхождения НЛО.
Разумнее оценивать язык по тому, что на нем можно сделать, - и тому, насколько эффективным он делает труд программиста. Было время, когда C++ обладал некоторыми преимуществами. Но потом фирма Borland взялась за Паскаль и добавила в него все самое лучшее из C++. В «игрушечном языке» появились преобразования типов, указатели, объекты, встроенный ассемблер и средства для работы с Windows. Те из нас, кто продолжал работать с Паскалем, немедленно ухватились за эти новые возможности. Прошло совсем немного времени, и вокруг появилась масса чрезвычайно мощных приложений, написанных на Borland Pascal.
Все напрасно. Фанаты C++ фыркнули и отвернулись, а «попугаи» из прессы упорно продолжали именовать Паскаль «игрушечным языком». Дела обстояли настолько скверно, что многие фирмы-разработчики боялись признаться, что их приложения написаны на Паскале.
И тогда фирма Borland поступила совершенно правильно - она просто отказалась от «нехорошего слова из семи букв». Появилась среда Delphi. Это был уже не просто язык, а мощная и производительная «машина для построения программ». Delphi как продукт поражает своей глубиной  - можно месяцами блуждать по справочной системе и не встретить ни одной знакомой темы.
Потенциальные возможности Delphi были оценены не сразу. Только сейчас мы начинаем понимать, как много можно сделать в этой среде. Эта книга была задумана как сборник приемов программирования на Delphi для профессионалов - того, что даже на C++ сделать не так уж просто, а на «игрушечном языке» вообще невозможно. Раз и навсегда доказано, что Delphi справляется с созданием профессиональных Windows-приложений ничуть не хуже, чем любой другой язык.
Введение
Лишившись «нехорошего слова из семи букв», пресса с увлечением взялась за новую байку - будто на Delphi любое приложение делается в пять-шесть раз быстрее, чем на C++. Мне уже приходилось слышать о фирмах, где менеджеры запрещают работать на C++ и заменяют его на Delphi и Visual Basic.
Не обращайте внимания на дураков. Справедливость в конце концов восторжествует.
Джефф Дантеманн KG7JF
Скоттдейл, Аризона
Июль 1997 г.

Вывод списка каталогов и файлов

После запуска сервера вызывается метод GetDirList, который создает текстовый файл INDEX.TXT со списком всех каталогов и файлов, находящихся в основном каталоге. Для построения списка используются функции FindFirst и FindNext (см. листинг7.3).

К сожалению, для представления списка каталогов и файлов не существует стандартного формата. Формат изменяется в зависимости от операционной системы; это одна из проблем, с которыми приходится иметь дело FTP-клиентам. Наш сервер CsKeeper при создании файла INDEX.TXT использует «стандартный» (более или менее) формат Unix. Этот файл пересылается FTP-

клиенту после успешной регистрации, а также при каждом удалении, создании или смене каталога.

Рис. 7.6. Программа KEEPER32 готова к обслуживанию клиентов

Листинг 7.3. Процедура GetDirList

procedure TCsKeeper.GetDirList; var F : TextFile; SearchRec : TSearchRec; SizeStr, FileName, S : String; TDate : TDateTime; Result, K, L : Integer; begin AssignFile(F, DirListFile); Rewrite(F); if Pos('\',FDirPath) = length(FDirPath) then FileName := Concat(FDirPath,'*.*') else if Pos('\',FDirPath) < length(FDirPath) then FileName := Concat(FDirPath,'\*.*'); Result := FindFirst(FileName, faAnyFile, SearchRec); if Result <> 0 then begin Status := Failure; Exit; end; try TDate := FileDateToDateTime(SearchRec.Time); except on EConvertError do begin Status := Failure; Data := '500 Internal error'; closesocket(FSocket); Exit; end; end; S := FormatDateTime('mmm dd hh'':''mm',TDate); if DirectoryExists(SearchRec.Name) then writeln(F, 'drwxrwxrwx 1 noone nogroup ','0',' ',S,' ',SearchRec.Name) else begin { вычисляем длину строки для размера файла } SizeStr := IntToStr(SearchRec.Size); L := Length(SizeStr); for K := 9 - L downto 1 do SizeStr := ConCat(' ',SizeStr); write(F,'-rwxrwxrwx 1 noone nogroup'); writeln(F, SizeStr,' ',S,' ',SearchRec.Name); end; while Result = 0 do begin TDate := FileDateToDateTime(SearchRec.Time); S := FormatDateTime('mmm dd hh'':''mm',TDate); if DirectoryExists(SearchRec.Name) then writeln(F, 'drwxrwxrwx 1 noone nogroup ','0',' ',S,' ',SearchRec.Name) else begin SizeStr := IntToStr(SearchRec.Size); L := Length(SizeStr); for K := 9 - L downto 1 do SizeStr := ConCat(' ',SizeStr); write(F,'-rwxrwxrwx 1 noone nogroup'); writeln(F, SizeStr,' ',S,' ',SearchRec.Name); end; Result := FindNext(SearchRec); end; SysUtils.FindClose(SearchRec); CloseFile(F); end;

Как и в случае с CsShopper, процедура CsKeeper1.OnInfo передает KEEPER32 сообщения, отображаемые затем в Memo-элементе memStatus (см. рис. 7.7). Любые ошибки FTP передаются обработчиком CsKeeper1.OnError на панель pnErrorMsg.

Рис. 7.7. KEEPER32 с сообщениями о FTP-транзакциях после
выполнения команды LIST

Вызов функций DLL

После завершения компиляции сохраните проект и выполните команду File д New Application. Сейчас мы напишем простейшую тестовую программу для вызова DLL.

Поместите кнопку на главную форму и создайте обработчик событий, который должен выглядеть так:

procedure TForm1.Button1Click(Sender: TObject);
begin
BeepMe;
end;

Включите BeepDLL в список, следующий за ключевым словом uses в модуле формы. Не пытайтесь компилировать программу, сначала нужно создать файл BEEPDLL.PAS.

Создайте новый модуль с именем BEEPDLL.PAS и введите содержимое листинга 2.2.

Листинг 2.2. Интерфейсный модуль для BEEPER.DLL

{ BEEPDLL.PAS — интерфейсный модуль для BEEPER.DLL } unit BeepDLL; interface procedure BeepMe; external "beeper.dll"; procedure BeepMeTwo; external "beeper.dll" name "BeepMe"; procedure BeepMeThree; external "beeper.dll" index 1; implementation end.

Если все было сделано правильно, то после компиляции и запуска программы при нажатии кнопки будет раздаваться звуковой сигнал.

Наверное, вы заметили, что для вызова процедуры BeepMe из BEEPER.DLL я указал целых три разных варианта. Если бы обработчик нажатия кнопки вызывал BeepMeThree вместо BeepMe, результат остался бы прежним. Мы работаем с искусственным примером, но в некоторых ситуациях возможность подключения функций DLL по имени (name) или номеру (index) оказывается полезной. Пусть, например, вам требуется вызвать из DLL функцию с именем XY$FORMAT (вполне реальный пример). Поскольку в Паскале XY$FORMAT не является допустимым идентификатором, вам не удастся воспользоваться этой функцией без ее переименования (см. вариант BeepMeTwo). Столь же полезно и ключевое слово index: некоторые функции DLL экспортируются только по номеру, без имени!

Мы рассмотрели пример статического импорта DLL. Интерфейсный модуль BEEPDLL.PAS всего лишь сообщает компилятору о том, что процедуру BeepMe необходимо взять из файла BEEPER.DLL посредством динамической компоновки. Код, содержащийся в BEEPER.DLL, не включается в вашу программу. Если не верите, удалите BEEPER.DLL и попробуйте снова запустить программу. Если программа была запущена из IDE, Delphi выдаст сообщение об ошибке. Если же запустить программу автономно, Windows сообщит о том, что ей не удалось найти библиотеку BEEPER.DLL.

Это сообщение об ошибке подводит нас к другому способу вызова функций DLLАF0;— динамическому импорту.

Загвоздка: компоненты со свойствами-компонентами

Единственное ограничение этих методов заключается в том, что некоторые типы компонентов нельзя сохранить напрямую. Речь идет о компонентах, которые содержат другие компоненты в качестве свойств.

Проблема возникает при попытке загрузить такие компоненты-свойства из файла. Поскольку эти компоненты сохраняются как самостоятельные объекты, попытка загрузить их как свойства другого компонента приводит к возникновению исключения и выдаче сообщения «A component named Widget1 already exists» («Компонент с именем Widget1 уже существует»).

К счастью, эта проблема присуща всего четырем типам компонентов: TMainMenu, TMenuItem, TPopupMenu и TForm.

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

В листинге 12.9 приведен код сохранения свойств формы, выполняемый при обработке события FormCloseQuery. Важнейшие фрагменты этого кода подробно рассматриваются ниже.

Листинг12.9. Обработчик события FormCloseQuery

procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); var Writer : TWriter; FileStream : TFileStream; i : Integer; TempRect : TRect; begin { Расширение файла .HPD == High Performance Delphi } { На всякий случай удалим старый файл с расширением HPD. } DeleteFile(ExtractFilePath (Application.ExeName) + TObject(Self).ClassName + '.HPD'); { Теперь можно записывать его заново: } FileStream := TFileStream.Create(ExtractFilePath (Application.ExeName) +TObject(Self).ClassName + '.HPD',fmOpenWrite or fmCreate); for i := 0 to ComponentCount-1 do begin { Некоторые элементы нежелательно (и даже невозможно) сохранить таким способом. К счастью, нам и не придется их сохранять... } if ((Components[i] is TSizingRect) or (Components[i] is TMenu) or (Components[i] is TMenuItem) or (Components[i] is TPopupMenu) or (not(Components[i] is TControl))) then Continue; Writer := TWriter.Create(FileStream, SizeOf(Components[i])); Writer.WriteRootComponent(Components[i]); Writer.Free; end; { Сохранение свойств формы } TempRect.Top := Self.Top; TempRect.Left := Self.Left; TempRect.Bottom := TempRect.Top + Self.Height; TempRect.Right := TempRect.Left + Self.Width; FileStream.Write(TempRect, SizeOf(TRect)); FileStream.Write(Self.Color, SizeOf(TColor)); FileStream.Free; { Не забудьте разрешить закрытие формы! } CanClose := True; end;

Давайте подробно рассмотрим этот метод. Прежде всего мы для надежно сти удаляем старый файл *.HPD, а затем создаем его заново:

FileStream := TFileStream.Create(ExtractFilePath (Application.ExeName) + TObject(Self).ClassName + '.HPD',fmOpenWrite or fmCreate);

Затем мы отыскиваем те элементы, которые невозможно сохранить, и не пытаемся ничего с ними делать:

for i := 0 to ComponentCount-1 do begin { Некоторые элементы нежелательно (и даже невозможно) сохранить таким способом. К счастью, нам и не придется их сохранять... } if ((Components[i] is TSizingRect) or (Components[i] is TMenu) or (Components[i] is TMenuItem) or (Components[i] is TPopupMenu) or (not(Components[i] is TControl))) then Continue;

Если компонент можно сохранить, мы записываем его в поток:

Writer := TWriter.Create(FileStream, SizeOf(Components[i])); Writer.WriteRootComponent(Components[i]); Writer.Free;

Перебрав все компоненты формы и сохранив те, для которых это возможно, мы сохраняем важные для приложения свойства самой формы:

TempRect.Top := Self.Top; TempRect.Left := Self.Left; TempRect.Bottom := TempRect.Top + Self.Height; TempRect.Right := TempRect.Left + Self.Width; FileStream.Write(TempRect, SizeOf(TRect)); FileStream.Write(Self.Color, SizeOf(TColor)); FileStream.Free;

Наконец, мы устанавливаем флаг, разрешающий закрытие формы:

CanClose := True;

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

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

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

Следовательно, после копирования экрана мы должны создать новую палитру с системными цветами и назначить ее свойству Palette растра. При сохранении растрового изображения значения цветов будут сохранены вместе с ним. Функция GetSystemPalette из листинга 9.13 создает такую палитру и возвращает ее логический номер. Функция CaptureScreenRect из того же листинга показывает, как использовать GetSystemPalette со скопированным изображением.

Листинг 9.13. SYSPAL.SRC

function GetSystemPalette: HPalette; var PaletteSize: Integer; LogSize: Integer; LogPalette: PLogPalette; DC: HDC; Focus: HWND; begin Result := 0; Focus := GetFocus; { ...это необходимо для GetDC } DC := GetDC( Focus ); { ...это необходимо для GetDeviceCaps } try PaletteSize := GetDeviceCaps( DC, SIZEPALETTE ); LogSize := SizeOf( TLogPalette ) + ( PaletteSize - 1 ) * SizeOf( TPaletteEntry ); GetMem( LogPalette, LogSize ); try with LogPalette^ do begin palVersion := $0300; palNumEntries := PaletteSize; GetSystemPaletteEntries( DC, 0, PaletteSize, palPalEntry ); end; Result := CreatePalette( LogPalette^ ); finally FreeMem( LogPalette, LogSize ); end; finally ReleaseDC( Focus, DC ); end; end; { Воспользуемся GetSystemPalette для копирования прямоугольника... } function CaptureScreenRect( ARect: TRect ) : TBitmap; var ScreenDC: HDC; begin Result := TBitmap.Create; with Result, ARect do begin Width := Right - Left; Height := Bottom - Top; ScreenDC := GetDC( 0 ); try BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY ); finally ReleaseDC( 0, ScreenDC ); end; { Также сохраним системную палитру... } Palette := GetSystemPalette; end; end;

Палитра создается функцией API CreatePalette. Функция CreatePalette получает один параметр-запись, в котором указываются версия палитры, количество цветов и массив значений, определяющих каждый цвет.

В типе записи для этой «логической палитры» хватает места для хранения лишь одного элемента палитры. Сначала это может показаться странным, но на самом деле все логично — количество элементов палитры зависит от видеорежима. Следовательно, прежде всего необходимо определить размер палитры для текущего видеорежима. Затем мы используем указатель типа PLogPalette и выделяем область памяти, достаточную для хранения записи и всех элементов. Как видно из листинга 9.13, количество элементов палитры определяется функцией GetDeviceCaps.

Выделение памяти под логическую палитру — дело хлопотное, но зато дальше все просто. Мы получаем сами цветовые значения функцией GetSystem PaletteEntries, а затем передаем информацию о логической палитре функции CreatePalette и получаем необходимый логический номер (handle) палитры.

невизуальный компонент. Он не умеет

FTP-клиент CsShopper — невизуальный компонент. Он не умеет сохранять и загружать имена хостов, имена пользователей, пароли и сведения о ресурсах. Все это остается на совести программистов, которые должны спроектировать эти визуальные средства в соответствии с потребностями конкретного приложения. Тем не менее приложение SHOPPER32 наглядно показывает, как легко можно при необходимости организовать сохранение и загрузку профилей.

Закрыто на переучет

Теперь у вас появился собственный, вполне работоспособный FTP-сервер, и создать его было не так уж сложно. Более того, как показывает мой собственный опыт, написать компонент для FTP-сервера значительно проще, чем для FTP-клиента, особенно если выбросить из рабочего словаря сервера некоторые хитроумные и редко используемые FTP-команды.

Тем не менее существует одно усовершенствование, которое сделает CsKeeper намного более полезным — речь идет о параллельной обработке. Она позволяет одновременно подключать к серверу и обслуживать сразу несколько FTP-клиентов. Практически все современные серверы поддерживают параллельную обработку, особенно если учесть, что на рынке серверов сейчас господствуют операционные системы Windows NT и Unix. Чтобы реализовать параллельную обработку в FTP-сервере, нам пришлось бы изучать реализацию многопоточности (multithreading) в Delphi. Это весьма достойная тема, но она, к сожалению, выходит за рамки этой главы.

Закрываем соединение

Для завершения работы с FTP-сервером необходимо лишь разорвать соединение командой QUIT. Нажатие кнопки Quit приводит к вызову CsShopper1.Finish и завершению сеанса:

procedure TfrmMain.bbtnQuitClick(Sender: TObject); begin bbtnQuit.Enabled := FALSE; bbtnRefresh.Enabled := FALSE; bbtnViewFile.Enabled := FALSE; bbtnFtpCmds.Enabled := FALSE; bbtnAbort.Enabled := FALSE; rgFileType.Enabled := FALSE; sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; gbMoreActions.Visible := FALSE; pbDataTransfer.Visible := FALSE; bbtnConnect.Enabled := TRUE; bbtnExit.Enabled := TRUE; with sbStatus do begin Panels[1].Text := 'Remote Host : '; Panels[3].Text := 'Status : Idle'; end; lbRemoteFiles.Clear; CsShopper1.Finish; Update; end;

Запрет выполнения программы

Дневник №16, 2 апреля. Итак, я узнал, как предотвратить выполнение программы при наличии предыдущего экземпляра. Но что-то продолжало беспокоить меня. А что если приложение должно работать лишь в том случае, если одновременно с ним работает какая-то другая программа?

В некоторых программах могут использоваться демонстрационные версии компонентов — например из VCL-библиотеки Orpheus. Если приложение создается с использованием того, что TurboPower Software называет «пробными» (trial) версиями компонентов, то оно сможет работать лишь одновременно с Delphi IDE. Как это делается?

?ис. 16.4. Программа, обнаруживающая присутствие Delphi во время работы

Ответ был настолько прост, что я не сразу в него поверил. На рис. 16.4 показано, как может выглядеть такая программа. В листинге 16.5 приведен исходный текст главной формы, а в листинге 16.6 — файл проекта.

Листинг 16.5. Исходный текст главной формы приложения,

обнаруживающего присутствие Delphi

{——————————————————————————————————————————————————————} { Демонстрационная программа, } { обнаруживающая присутствие Delphi. } { NRUNMAIN.PAS : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Главная форма приложения, работающего лишь при } { условии одновременной работы 32-разрядной версии } { Delphi. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} unit NRunMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, WalkStuf; type TForm1 = class(TForm) ExitBtn: TButton; Label1: TLabel; procedure ExitBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.ExitBtnClick(Sender: TObject); begin Close; end; end.

Листинг 16.6. Файл проекта для приложения, обнаруживающего

присутствие Delphi

{——————————————————————————————————————————————————————} { Демонстрационная программа, } { обнаруживающая присутствие Delphi. } { NORUN.DPR : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Приложение, работающее лишь при условии } { одновременной работы 32-разрядной версии Delphi. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} program NoRun; uses Forms, Dialogs, NRunMain in 'NRunMain.pas' {Form1}, WalkStuf in 'WalkStuf.pas'; {$R *.RES} begin Application.Initialize; { Если не существует работающего экземпляра 32-разрядной версии Delphi, вывести сообщение об ошибке и завершить работу программы. Если все хорошо, продолжить выполнение. } if ModuleSysInstCount('DELPHI32.EXE') < 1 then MessageDlg('Delphi 32 must be running to execute this program', mtError, [mbOK], 0) else begin Application.CreateForm(TForm1, Form1); Application.Run; end; end.

Основная идея — уничтожить приложение еще до того, как пользователь увидит главную форму. Для решения этой задачи я снова включил код непосредственно в файл проекта. На этот раз функция ModuleSysInstCount из модуля WalkStuf проверяет, работает ли в системе по меньшей мере один экземпляр 32-разрядной версии Delphi (DELPHI32.EXE). Если проверка дает положительный результат, программа продолжает работу, если нет — выводится сообщение об ошибке.

Небольшое замечание: поскольку в модуле WalkStuf используется Tool Help32, описанная методика будет работать лишь в Win95.

Конец записи (2 апреля).

Звук в приложении

Дневник №16, 22 марта. Сегодня я научился воспроизводить WAV-файлы в приложениях, написанных на Delphi. Это оказалось вовсе не сложно. Я подумал, как бы здорово было, если при нажатии на кнопку вдруг зазвучал бы голос одного из моих любимых героев — Хамфри Богарта!

На рис. 14.4 показана форма, которую я использовал для экспериментов. Исходный текст содержится в листинге 14.10.

Рис. 14.4. Форма для воспроизведения WAV-файла

Листинг 14.10. Демонстрационная программа для воспроизведения WAV-файлов

{—————————} {Воспроизведение WAV-файла (демонстрационная программа)} {PLAYMAIN.PAS : Главный модуль } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } {Приложение, демонстрирующее воспроизведение } {WAV-файлов в приложениях, написанных на Delphi } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 3/5/97 } {—————————} unit playmain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MMSystem; type TForm1 = class(TForm) BadgeBtn: TButton; ExitBtn: TButton; Label1: TLabel; Label2: TLabel; procedure BadgeBtnClick(Sender: TObject); procedure ExitBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.BadgeBtnClick(Sender: TObject); begin if not PlaySound("badges.wav", 0, SND_FILENAME) then MessageDlg("Problem playing sound file", mtError, [mbOK], 0); end; procedure TForm1.ExitBtnClick(Sender: TObject); begin Close; end; end.

Сначала мне показалось, что файл обязательно придется воспроизводить с помощью компонента MediaPlayer. Вскоре я обнаружил альтернативное решение — низкоуровневую функцию PlaySound из модуля MMSystem. Вызывая эту функцию, я просто передаю ей имя файла и константу SND_FILENAME, которая показывает, что функция должна воспроизвести звук, хранящийся в файле. Проще не бывает.

Примечание для себя: в эксперименте использовался файл BADGES.WAV с фрагментом знаменитого диалога из классического фильма Богарта «Сокровище Сьерра-Мадре» (1948 г.). Кстати, один из моих любимых.

Конец записи (22 марта).

---

---