когда дела становятся совсем плохи,
Говорят, когда дела становятся совсем плохи, главное — вовремя приготовить кофе. Я заварил целый кофейник и занялся программой, демонстрирующей работу с функциями модуля WalkStuf. На рис. 15.8 показаны результаты ее работы. Исходный текст приведен в листинге 15.8.
Рис. 15.8. Демонстрационная программа для сбора информации о системе
Листинг 15.8. Исходный текст главного модуля программы Walking Demo
{——————————} {Демонстрационная программа для сбора информации} { о системе } { WALKAMIN.PAS : Главный модуль } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Программа демонстрирует некоторые возможности } { для сбора служебной информации в Win95. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 23/4/97 } {————————} unit WalkMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, WalkStuf, Grids, StdCtrls, ExtCtrls; type TForm1 = class(TForm) ModuleGrid: TStringGrid; RefreshBtn: TButton; QuitBtn: TButton; ModuleRBGroup: TRadioGroup; ProcessesLabel: TLabel; ProcessListBox: TListBox; ModulesLabel: TLabel; procedure QuitBtnClick(Sender: TObject); procedure RefreshBtnClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ModuleRBGroupClick(Sender: TObject); procedure ProcessListBoxClick(Sender: TObject); private TheList : TStringList; procedure RefreshForm; procedure DisplayProcessModules; procedure ClearModuleGrid; procedure FillProcessList; procedure FillModuleGrid; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} { Возвращает строку пробелов заданной длины. } function Spaces(Size : Integer) : String; begin Result := ''; while Length(Result) < Size do Result := Result + ' '; end; { Очищает экранные элементы, получает данные и обновляет экран. } procedure TForm1.RefreshForm; begin ClearModuleGrid; ProcessListBox.Clear; TheList := GetSystemProcessList(ws_FullPath, ws_DupesOK); FillProcessList; ProcessesLabel.Caption := 'System processes: ' + IntToStr(TheList.Count); TheList.Free; case ModuleRBGroup.ItemIndex of 0 : begin TheList := GetSystemModuleList (ws_NoDirectory, ws_Unique, ws_InstanceCount); FillModuleGrid; ModulesLabel.Caption := 'System-wide modules: ' + IntToStr(TheList.Count); TheList.Free; end; 1 : begin TheList := GetSystemModuleList (ws_NoDirectory, ws_Unique, ws_InstanceCount); if TheList.Count > 0 then begin ProcessListBox.ItemIndex := 0; DisplayProcessModules; end; end; end; { case } end; { Специальная процедура обновления экрана, которая получает сведения о модулях текущего выбранного процесса. } procedure TForm1.DisplayProcessModules; var Idx : Integer; s : String; p : Integer; begin if ProcessListBox.Items.Count > 0 then begin ClearModuleGrid; Idx := ProcessListBox.ItemIndex; TheList := GetProcessModules (ProcessListBox.Items[Idx], ws_NoDirectory, ws_InstanceCount); if TheList.Count > 0 then for Idx := 1 to TheList.Count do begin s := TheList.Strings[Idx - 1]; p := pos('<', s); ModuleGrid.Cells[0, Idx] := copy(s, 1, p - 1); delete(s, 1, p); s := Spaces(15) + s; ModuleGrid.Cells[1, Idx] := s; ModuleGrid.RowCount := ModuleGrid.RowCount + 1; end; ModulesLabel.Caption := 'Modules for this process: ' + IntToStr(TheList.Count); TheList.Free; end; end; { Очищает все строки в списке модулей и задает количество строк, равное 1. } procedure TForm1.ClearModuleGrid; var Idx : Integer; begin for Idx := 1 to ModuleGrid.RowCount - 1 do begin ModuleGrid.Cells[0, Idx] := ''; ModuleGrid.Cells[1, Idx] := ''; end; ModuleGrid.RowCount := 2; end; { Построчно заполняет список процессов из глобального списка. } procedure TForm1.FillProcessList; var Idx : Integer; begin if TheList.Count > 0 then for Idx := 0 to TheList.Count - 1 do ProcessListBox.Items.Add (TheList.Strings[Idx]); end;
{ Построчно заполняет список модулей из глобального списка. } procedure TForm1.FillModuleGrid; var s : String; p : Integer; Idx : Integer; begin if TheList.Count > 0 then begin for Idx := 1 to TheList.Count do begin s := TheList.Strings[Idx - 1]; p := pos('<', s); ModuleGrid.Cells[0, Idx] := copy(s, 1, p - 1); delete(s, 1, p); s := Spaces(15) + s; ModuleGrid.Cells[1, Idx] := s; ModuleGrid.RowCount := ModuleGrid.RowCount + 1; end; { for } end; end; procedure TForm1.QuitBtnClick(Sender: TObject); begin Close; end; procedure TForm1.RefreshBtnClick(Sender: TObject); begin RefreshForm; end; procedure TForm1.FormCreate(Sender: TObject); begin ModuleGrid.Colwidths[1] := ModuleGrid.Width - ModuleGrid.ColWidths[0] - 22; ModuleGrid.Cells[0, 0] := 'Name'; ModuleGrid.Cells[1, 0] := 'System instances'; ModuleRBGroup.ItemIndex := 0; end; procedure TForm1.ModuleRBGroupClick(Sender: TObject); begin RefreshForm; end; procedure TForm1.ProcessListBoxClick(Sender: TObject); begin if ModuleRBGroup.ItemIndex > 0 then DisplayProcessModules; end; end. В этом листинге нет ничего особенного. В верхнем списке всегда перечисляются все активные процессы. При установке переключателя System-wide в нижнем поле появляется список всех модулей, показывающий и количество экземпляров каждого из них. Если установлен переключатель Selected Process only, в нижнем поле выводятся только модули процесса, выделенного в верхнем списке. Кнопка Refresh делает новый «снимок» и обновляет экран. Главное, что необходимо запомнить, — при вызове любой функции, возвращающей список строк, создается новый объект; позднее его необходимо уничтожить, причем ровно один раз.
Все это было весьма поучительно и к тому же занятно. Однако мое расследование было весьма поверхностным, и предстояло еще многое узнать. В частности, я обнаружил, что функции ToolHelp работают только в Win95, но не вNT (по крайней мере в настоящее время).
У меня сложилось совершенно четкое впечатление, что я смогу воспользо ваться полученными знаниями в приложениях. Конечно, при первой возможности я вернусь к этой теме и расследую ее более подробно.
Конец записи (28 марта).
Когда Эйс и Хелен прибыли в контору, результаты экспертизы ДНК еще не поступили. Эйс достал бутылку и сдул пыль с двух стаканов, найденных в шкафу. Он плеснул в них немного виски и передал один стакан Хелен, но стоило ему поднести стакан к губам, как в дверь громко постучали.
Это была Мардж Рейнольдс. Во время обычного обмена любезностями с Хелен в ее голосе сквозило необычное оживление. Мардж быстро перешла к делу.
— Я знаю, что вы расследуете ограбление, которое произошло вчера вечером, — начала она. — Я видела, как вы сегодня днем копались в грязи на стоянке. Но я тоже держала глаза открытыми и следила за всем подозрительным.
Она сделала паузу, глядя на Эйса и ожидая проявлений интереса.
— Продолжай, — взмолился он.
— Сегодня вечером я проходила мимо телефонной будки на той стороне двора — ну, знаешь, там, куда выходят окна твоей кухни, — и нашла в кустах клочок бумаги, застрявший примерно в футе над землей.
Мардж порылась в кармане мешковатого вязаного свитера.
— Он должен быть где-то здесь. Я его положила… ага, вот он, — сказала она, извлекая бумажку лавандового цвета. — Похоже, почерк женский. Здесь записаны твое имя и номер телефона, и еще два слова — «похищенная наследница». Тебе это о чем-нибудь говорит?
    |
Изгибы
Существует и другая тонкость, которую я обнаружил лишь после написания программы, — при изгибе длинных линий нельзя использовать ту же величину случайных отклонений, что и для коротких. В противном случае получает ся равнина, усеянная кочками, или «гребенка» из сплошных пиков. Амплитуда случайных трансформаций должна увеличиваться для внешних треугольни ков, определяющих общую форму ландшафта, и уменьшаться для внутрен них треугольников, определяющих тонкую структуру поверхности.
В итоге у меня получилась функция, которая генерирует нечто, отдаленно похожее на нормальное распределение:
function Rand(Envelope: integer): integer; { Псевдонормальное распределение в интервале ±Envelope } begin Rand := integer(Random(Envelope)) + integer(Random(Envelope)) - Envelope; end;В нашем случае значение Envelope для каждой итерации равно половине стороны отрезка, полученного на предыдущей итерации. Конечно, в результате получаются вполне приемлемые пейзажи, однако настоящий ландшафт обычно выглядит не так гладко, как нарисованный программой FL3. В настоящих ландшафтах встречаются острые края— скалы, плоскогорья, ущелья и т. д., тогда как FL3 способна сгенерировать разве что крутой склон.
Возможный выход заключается в том, чтобы заменить псевдонормальное распределение Rand экспоненциальным. Для малых отрезков такая функция будет с большей вероятностью порождать близкие к нулю значения, чем для больших, но возможность случайного выброса останется при любом значении параметра Envelope.
Изменение других свойств
Мы вплотную подошли к проблеме изменения других свойств элементов. Например, что делать, если пользователь захочет изменить шрифт или цвет некоторых компонентов DBEdit, чтобы выделить их как обязательные для заполнения? Оказывается, сделать это не так уж сложно. Как мы только что узнали, порядок перебора элементов можно легко изменить. То же самое относится и к другим свойствам элементов.
Изменение каталогов для пересылки файлов
Если двойной щелчок был сделан на имени каталога (например, \DELPHI), то вместо пересылки SetUpFileTransfer вызывает ChangeDir, чтобы обработать переход к другому каталогу. ChangeDir в свою очередь вызывает процедуру FTP Command, которая посылает FTP-серверу команду CWD имя_каталога (скажем, CWD \DELPHI). Если сервер принимает команду, он возвращает код ответа 250. Затем ChangeDir посылает команду LIST (тоже через FTPCommand), чтобы обновить содержимое списка файлов хоста. Наконец, Decode заполняет список содержимым нового каталога.
Изменение порядка перебора элементов во время выполнения
Если пользователи смогут перемещать элементы, скорее всего, они также захотят изменить и порядок их перебора . Более того, наш дизайн «сделай сам» не пройдет тест на простоту использования, если пользователи будут навсегда привязаны к исходному порядку перебора. Перемещение от одного элемента к другому станет крайне запутанным.
В Delphi порядок перебора элементов задается в диалоговом окне Tab Order, главные элементы которого — список и кнопки со стрелками б и в. Раз этот способ успешно работает в Delphi, мы воспользуемся им и в своей системе. На рис. 12.7 изображен наш компонентFrmTabOrder во время выполнения программы.
Тем не менее сама по себе форма FrmTabOrder — не более чем удобный интерфейс. Порядком перебора в действительности управляет фрагмент кода, в котором отображается FrmTabOrder; это происходит в методе TFrmMain.TabOrder1 Click (см. листинг 12.6). Сейчас мы подробно рассмотрим его.
Рис. 12.7. Компонент FrmTabOrder во время выполнения программы
Листинг 12.6. Обработчик события OnClick команды Tab Order
procedure TFrmMain.TabOrder1Click(Sender: TObject); var i : Integer; begin FrmTabOrder.LBControls.Items.Clear; for i := 0 to ComponentCount -1 do begin if ((Components[i] is TWinControl) and not (Components[i] is TSizingRect)) then FrmTabOrder.LBControls.Items.Add (Components[i].Name); end; FrmTabOrder.ShowModal; if FrmTabOrder.ModalResult = mrOK then begin for i := 0 to FrmTabOrder.LbControls.Items.Count -1 do TWinControl(FindComponent( FrmTabOrder.LbControls.Items[i])).TabOrder := i; end; end;А теперь углубимся в детали. Процедура начинает свою работу с очистки списка. Затем она перебирает элементы формы и заносит в список все элементы класса TWinControl, кроме SizingRect:
FrmTabOrder.LBControls.Items.Clear; for i := 0 to ComponentCount -1 do begin if ((Components[i] is TWinControl) and not (Components[i] is TSizingRect)) then FrmTabOrder.LBControls.Items.Add (Components[i].Name); end;Далее процедура отображает форму (упорядочением элементов занимается список FrmTabOrder.LBControls). Если пользователь нажимает кнопку OK, программа перебирает FrmTabOrder.LBControls.Items, определяет порядковый номер каждой строки и назначает его свойству TabOrder соответствующего элемента:
FrmTabOrder.ShowModal; if FrmTabOrder.ModalResult = mrOK then begin for i := 0 to FrmTabOrder.LbControls.Items.Count -1 do TWinControl(FindComponent( FrmTabOrder.LbControls.Items[i])).TabOrder := i; end;Все просто, не правда ли? Для управления порядком перебора компонентов ничего больше и не требуется.
Изменение шрифтов во время выполнения
В нашем приложении-примере пользователи могут изменить шрифт всех элементов командой Adjust All Fonts из главного меню. Как видно из листинга12.7, сделать это не слишком сложно.
Листинг12.7. Изменение шрифта для всех элементов формы
procedure TFrmMain.AdjustMenu2Click(Sender: TObject); var i : Integer; begin { Изменяем шрифт для всех элементов } if FontDialog1.Execute then begin for i := 0 to ComponentCount - 1 do begin try if ((Components[i] is TWinControl) or (Components[i] is TGraphicControl)) and not ((Components[i] is TMenu) and (Components[i] is TMenuItem)) then TMagic(Components[i]).Font := FontDialog1.Font; except Continue; end; end; end; end;Здесь происходит нечто интересное. Обратите внимание на преобразо вание типа в TMagic в операторе присваивания. Вспомогательный класс TMagic определен в модуле TSizingRect, его программный код не делает абсолютно ничего. Единственная причина существования этого класса заключается в том, чтобы перевести в категорию public некоторые protected-свойства (в нашем случае — свойство Font). Поскольку в большинстве элементов свойство Font относится к категории protected, его нельзя непосредственно изменить в режиме выполнения. Однако это удается сделать, предварительно преобразовав тип элемента в TMagic.
В нашем примере можно изменить и шрифт отдельного элемента, воспользовавшись командой Change Font контекстного меню. Это тоже сравнительно просто (см. листинг 12.8).
Листинг 12.8. Изменение шрифта отдельного элемента во время выполнения
procedure TFrmMain.ChangeFont1Click (Sender: TObject); begin if FontDialog1.Execute then try TMagic(PopupMenu1.PopupComponent).Font := FontDialog1.Font; except Exit; end; end;Замечание
Даже применение TMagic не всегда гарантирует успех. При попытке изменить шрифт элементов некоторых классов (например, TMenu) возникает исключение. Следовательно, перед попыткой изменения шрифта желательно проверить тип элемента. Однако в приведенном выше примере нет смысла отфильтровывать «неподдающиеся» элементы, потому что изменение шрифта выполняется через контекстное меню. Элементы, обладающие контекстным меню, допускают изменение шрифта даже в том случае, если в них вообще не отображает ся текст (например, полоса прокрутки).
Изменение свойств в инспекторе объектов
Теперь мы должны предоставить пользователю средства для изменения других свойств — таких как Caption, CharCase или Color. Раз пользователь может менять все остальное, у него может возникнуть желание изменить и эти свойства.
Как мы делаем это в режиме конструирования Delphi? С помощью инспектора объектов. В своем проекте мы воспользуемся собственным инспектором объектов.
Замечание
Поскольку инспектор объектов, представленный в этой главе, ранее распространялся как коммерческий продукт, на CD-ROM находится только его демонстрационная версия (без исходного текста). Она ограничивает типы свойств и элементов, но во всех остальных отношениях вполне работоспособна и не содержит назойливых призывов купить полную версию. Более подробная информация приведена в лицензионном соглашении. Сведения о полной версии класса TMiniInspector, включающей все исходные тексты, можно найти на прилагаемом CD-ROM или щелкнув на свойстве About_This_Component в режиме конструи рования. Обратите внимание: на компакт-диске содержатся две версии мини-инспектора, для Delphi 2 и Delphi 3. Они находятся в каталоге главы 12, в подкаталогах \Delphi2Lib и \Delphi3Lib соответственно.
Чтобы включить класс TMiniInspector в палитру элементов, выполните команду Components|Install и выберите MINIOI.DCU. Кроме того, необходимо проследить, чтобы в одном каталоге с MINIOI.DCU находились еще три файла:
 | OICOMPDEMO.DCU |
| OICOMPDEMO.DFM |
| MINIOI.DCR |
Инспектор в нашем проекте работает точно так же, как и его прототип из Delphi. Пользователь выбирает элемент из верхнего выпадающего списка, а затем изменяет его свойства, непосредственно вводя нужное значение или нажимая кнопку для вызова отдельной формы редактора (если она есть). На рис. 12.8 изображен класс TMiniInspector во время выполнения программы.
Рис. 12.8. Мини-инспектор во время выполнения программы
Когда в нашем примере пользователь выбирает команду Show Properties из главного меню или View Properties из контекстного меню, инспектор объектов отображается простым вызовом метода Show:
MiniInspector1.Show;
Затем, если инспектор был вызван из контекстного меню, мы выводим свойства того элемента, на котором пользователь щелкнул правой кнопкой мыши:
if PopupMenu1.PopupComponent <> nil then MiniInspector1.ShowThisComponent (PopupMenu1.PopupComponent);Метод ShowThisComponent — функция, которая получает параметр типа TComponent и возвращает логическое значение. Если передаваемый компонент присутствует в выпадающем списке, он становится текущим, а функция возвращает True. Если компонент не найден или мини-инспектор не отображается на экране, функция возвращает False.
Изучаем CsSocket
Компонент CsSocket построен на основе невизуального класса TCsSocket, который в свою очередь является потомком TComponent. Невизуальный класс TCsSocket похож на фундамент дома— обычно его никто не видит. Класс TComponent предоставляет самые необходимые методы и свойства, необходимые для работы CsSocket — но не более того. Если бы мы выбрали в качестве предка TGraphicControl, то класс TCsSocket обладал бы большими возможностями, но за счет соответствующего возрастания сложности и накладных расходов. CsSocket создает основу для настройки и поддержания TCP/IP-соединения, а также поддерживает сокеты как потоковые (TCP), так и датаграммные (UDP).
Чтобы упростить задачу построения сетевых компонентов TCP/IP для Internet-приложений, наш идеальный компонент Winsock должен выполнять четыре основные функции. К ним относятся:
| запуск и остановка Winsock; |
| преобразование (resolving) имен хостов; |
| создание, поддержка и уничтожение соединений (как TCP, так и UDP); |
| отправка и прием данных через установленное соединение. |
Наш компонент Winsock, как и все сетевые формы жизни, должен выполнять инициализацию, корректно завершать работу и сообщать о возникающих ошибках. В листинге 5.1 приведен исходный код для класса TCsSocket, выполняющего эти и многие другие функции. Большинство методов находит ся в protected-секции TCsSocket, чтобы они были доступны компонентам -потомкам. Эти методы остаются невидимыми для клиентских приложений.
Листинг 5.1. Определение TCsSocket
(* CsSocket Unit Простейший интерфейсный модуль Winsock Написан для книги High Performance Delphi Programming Джон К.Пенман 1997 *) {$H+} unit CsSocket; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; {$INCLUDE CsSOCKINT.PAS} const winsocket = 'wsock32.dll'; WSockVersionNo : String = '2.0'; WSockBuildDate : String = '7 May 97'; SOCK_EVENT = WM_USER + 1; ASYNC_EVENT = SOCK_EVENT + 1; type TConditions = (Success, Failure, None); THostAddr = (HostAddr, IPAddr); TOperations = (SendOp, RecvOp, NoOp); TAccess = (Blocking, NonBlocking); TSockTypes = (SockStrm, SockDgram, SockRaw); TServices = (NoService, Echo, Discard, Systat, Daytime, Netstat, Qotd, Chargen, ftp, telnet, smtp, time, rlp, nameserver, whois, domain, mtp, tftp, rje, finger, http, link, supdup, hostnames, ns, pop2,pop3, sunrpc, auth, sftp, uucp_path, nntp); TProtoTypes = (IP, ICMP, GGP, TCP, PUP, UDP); TAsyncTypes = (AsyncName, AsyncAddr, AsyncServ, AsyncPort, AsyncProtoName, AsyncProtoNumber); const NULL : Char = #0; CRLF : array[0..2] of char = #13#10#0; MaxBufferSize = MAXGETHOSTSTRUCT; { Строки для расшифровки значения свойства Service } ServiceStrings : array[TServices] of String[10] = ('No Service ', 'echo ', 'discard ', 'systat ', 'daytime ', 'netstat ', 'qotd ', 'chargen ', 'ftp ', 'telnet ', 'smtp ', 'time ', 'rlp ', 'nameserver ', 'whois ', 'domain ', 'mtp ', 'tftp ', 'rje ', 'finger ', 'http ', 'link ', 'supdup ', 'hostnames ', 'ns ', 'pop2 ', 'pop3 ', 'sunrpc ', 'auth ', 'sftp ', 'uucp-path ', 'nntp '); { Строки для расшифровки значения свойства Protocol } ProtoStrings : array[TProtoTypes] of String[4] = ('ip ', 'icmp ', 'gcmp ', 'tcp ', 'pup ', 'udp '); type CharArray = array[0..MaxBufferSize] of char; TAddrTypes = (AFUnspec, { не указан } AFUnix, { локальный для хоста (конвейеры, порталы) } AFInet, { межсетевой: UDP, TCP и т. д. } AFImpLink, { адреса arpanet imp} AFPup, { протоколы pup: например, BSP } AFChaos, { протокол mit CHAOS } AFNs, { протоколы XEROX NS } AFIso, { протоколы ISO } AFOsi, { OSI - ISO } AFEcma, { European computer manufacturers } AFDatakit, { протоколы data kit } AFCcitt, { протоколы CCITT, X.25 и т. д.} AFSna, { IBM SNA } AFDecNet, { DECnet } AFDli, { интерфейс непосредственной передачи данных (data link) } AFLat, { LAT } AFHyLink, { гиперканал NSC } AFAppleTalk,{ AppleTalk } AFNetBios, { адреса NetBios } AFMax); const ServDefault = NoService; ProtoDefault = TCP; SockDefault = SockStrm; AddrDefault = AFINET; PortNoDefault = 0; type {$LONGSTRINGS ON} ECsSocketError = class(Exception); TLookUpOp = (resHostName, resIpAddress, resService, resPort, resProto, resProtoNo); TAsyncOpEvent = procedure(Sender : TObject; sSocket : TSocket) of object; TCleanUpEvent = procedure(Sender : TObject; CleanUp : Boolean) of object; TConnEvent = procedure(Sender : TObject; sSocket : TSocket) of object; TDisConnEvent = procedure(Sender : TObject; sSocket : TSocket) of object; TInfoEvent = procedure(Sender : TObject; Msg : String) of object; TErrorEvent = procedure(Sender : TObject; Status : TConditions; Msg : String) of object; TAbortEvent = procedure(Sender : TObject) of object; TBusyEvent = procedure(Sender : TObject; BusyFlag : Boolean) of object; TStatusEvent = procedure(Sender : TObject; Mode, Status : String) of object; TLookUpEvent = procedure(Sender : TObject; LookUpOp : TLookUpOp; Value : String; Result : Boolean) of object; TSendDataEvent = procedure(Sender : TObject; sSocket : TSocket) of object; TRecvDataEvent = procedure(Sender : TObject; sSocket : TSocket) of object; TTimeOutEvent = procedure(Sender : TObject; sSocket : TSocket; TimeOut : LongInt) of object; TCsSocket = class(TComponent) private { Private declarations } FOnCleanUpEvent : TCleanUpEvent; FOnConnEvent : TConnEvent; FOnDisConnEvent : TDisConnEvent; FOnInfoEvent : TInfoEvent; FOnErrorEvent : TErrorEvent; FOnAbortEvent : TAbortEvent; FOnBusyEvent : TBusyEvent; FOnStatusEvent : TStatusEvent; FOnLookUpEvent : TLookUpEvent; FOnSendDataEvent : TSendDataEvent; FOnRecvDataEvent : TRecvDataEvent; FOnTimeOutEvent : TTimeOutEvent; FOnAsyncOpEvent : TAsyncOpEvent; FValidSocket : u_int; FParent : TComponent; FSockType : TSockTypes; FService : TServices; FProtocol : TProtoTypes; FAddrType : TAddrTypes; FAsyncType : TAsyncTypes; FLookUpOp : TLookUpOp; FCleanUp : Boolean; FData, FRemoteName, FAsyncRemoteName, FAsyncService, FAsyncPort, FAsyncProtocol, FAsyncProtoNo, FLocalName, FInfo : String; FBusy, FCancelAsyncOp, FOKToDisplayErrors : Boolean; FStatus : TConditions; FConnected : Boolean; FTaskHandle : THandle; FHomeHostName : String; FWSALastError, FTimeOut : Integer; FRC : Integer; FVendor, FWSVersion, FMaxNoSockets, FMaxUDPPSize, FWSStatus, FServiceName, FPortName, FProtocolName, FProtocolNo : String; FAsyncBuff : array[0..MAXGETHOSTSTRUCT-1] of char; FNoOfBlockingTasks : Integer; protected { Protected declarations } FAccess : TAccess; FPortNo : Integer; FHost : pHostent; FServ : pServent; FProto : pProtoEnt; FHostEntryBuff, FProtoName, FServName : CharArray; Fh_addr : pChar; FpHostBuffer, FpHostName : array[0..MAXGETHOSTSTRUCT-1] of char; FAddress : THostAddr; FMsgBuff : CharArray; FSocket : TSocket; FSockAddress : TSockAddrIn; FHandle : THandle; FStarted : Boolean; FHwnd, FAsyncHWND : HWND; // Методы procedure ConnEvent; procedure CleanUpEvent; dynamic; procedure DisConnEvent; dynamic; procedure InfoEvent(Msg : String); dynamic; procedure ErrorEvent(Status : TConditions; Msg : String); dynamic; procedure StatusEvent; dynamic; procedure BusyEvent; dynamic; procedure LookUpEvent(Value : TLookUpOp; Msg : String; Result : Boolean); dynamic; procedure SendDataEvent; dynamic; procedure RecvDataEvent; dynamic; procedure TimeOutEvent; dynamic; procedure AbortEvent; dynamic; procedure AsyncOpEvent; dynamic; function GetLocalName : String; procedure SetRemoteHostName(NameReqd : String); function GetDataBuff : String; procedure SetDataBuff(DataReqd : String); function GetDatagram : String; procedure SetDatagram(DataReqd : String); procedure SetUpPort; procedure SetPortName(ReqdPortName : String); procedure SetServiceName(ReqdServiceName : String); { Вызовы Winsock } procedure GetProt(Protocol : PChar); procedure ConnectToHost; function GetOOBData : String; procedure SetOOBData(ReqdOOBData : String); function StartUp : Boolean; procedure CleanUp; procedure SetUpAddr; virtual; procedure SetUpAddress; virtual; procedure GetHost; virtual; procedure GetServ; function CreateSocket : TSocket; function WSAErrorMsg : String; function GetInfo : String; virtual; procedure SetInfo(InfoReqd : String); virtual; procedure SetProtocolName(ReqdProtoName : String); procedure SetProtoNo(ReqdProtoNo : String); procedure WMTimer(var Message : TMessage); message wm_Timer; procedure StartAsyncSelect; virtual; procedure AsyncOperation(var Mess : TMessage); function GetAsyncHostName : String; procedure SetAsyncHostName(ReqdHostName : String); function GetAsyncService : String; procedure SetAsyncService(ReqdService : String); function GetAsyncPort : String; procedure SetAsyncPort(ReqdPort : String); function GetAsyncProtoName : String; procedure SetAsyncProtoName(ReqdProtoName : String); function GetAsyncProtoNo : String; procedure SetAsyncProtoNo(ReqdProtoNo : String); procedure CancelAsyncOperation(CancelOp : Boolean); function CheckConnection : Boolean; public { Public declarations } procedure GetServer; procedure QuitSession; procedure Cancel; constructor Create(AOwner : TComponent); override; destructor Destroy; override; { Public properties } property WSVendor : String read FVendor; property WSVersion : String read FWSVersion; property WSMaxNoSockets: String read FMaxNoSockets; property WSMaxUDPPSize : String read FMaxUDPPSize; property WSStatus : String read FWSStatus; property Info : String read FInfo write FInfo; property WSErrNo : Integer read FWSALastError default 0; property Connected : Boolean read FConnected write FConnected default FALSE; property LocalName : String read GetLocalName write FLocalName; property Status : TConditions read FStatus write FStatus default None; property HostName : String read FRemoteName write SetRemoteHostName; property WSService : String read FServiceName write SetServiceName; property WSPort : String read FPortName write SetPortName; property WSProtoName : String read FProtocolName write SetProtocolName; property WSProtoNo : String read FProtocolNo write SetProtoNo; property Data : String read GetDataBuff write SetDataBuff; property Datagram : String read GetDatagram write SetDatagram; property OOBData : String read GetOOBData write SetOOBData; property CancelAsyncOP : Boolean read FCancelAsyncOp write CancelAsyncOperation; published { Published declarations } property OkToDisplayErrors : Boolean read FOKToDisplayErrors write FOKToDisplayErrors default TRUE; property HomeServer : String read FHomeHostName write FHomeHostName; property SockType : TSockTypes read FSockType write FSockType default SOCKSTRM; property Service : TServices read FService write FService default NoService; property Protocol : TProtoTypes read FProtocol write FProtocol default TCP; property AddrType : TAddrTypes read FAddrType write FAddrType default AFInet; property Access : TAccess read FAccess write FAccess default blocking; property OnConnect : TConnEvent read FOnConnEvent write FOnConnEvent; property OnClose : TDisConnEvent read FOnDisConnEvent write FOnDisConnEvent; property OnCleanUp : TCleanUpEvent read FOnCleanUpEvent write FOnCleanUpEvent; property OnInfo : TInfoEvent read FOnInfoEvent write FOnInfoEvent; property OnError : TErrorEvent read FOnErrorEvent write FOnErrorEvent; property OnLookup : TLookUpEvent read FOnLookUpEvent write FOnLookUpEvent; property OnStatus : TStatusEvent read FOnStatusEvent write FOnStatusEvent; property OnSendData : TSendDataEvent read FOnSendDataEvent write FOnSendDataEvent; property OnRecvData : TRecvDataEvent read FOnRecvDataEvent write FOnRecvDataEvent; property OnTimeOut : TTimeOutEvent read FOnTimeOutEvent write FOnTimeOutEvent; property OnAbort : TAbortEvent read FOnAbortEvent write FOnAbortEvent; property OnAsyncOp : TAsyncOpEvent read FOnAsyncOpEvent write FOnAsyncOpEvent; end; procedure Register; implementation var myWsaData : TWSADATA; function TCsSocket.StartUp : Boolean; var VersionReqd : WordRec; begin with VersionReqD do begin Hi := 1; Lo := 1; end; Result := WSAStartUp(Word(VersionReqD), myWsaData) = 0; if not Result then begin FStatus := Failure; raise ECsSocketError.create ('Cannot start Winsock!'); Exit; end else begin with myWsaData do begin FVendor := StrPas(szDescription); FWSVersion := Concat(IntToStr(Hi(wVersion)),'.', (intToStr(Lo(wVersion)))); FWSStatus := StrPas(szSystemStatus); FMaxNoSockets := IntToStr(iMaxSockets); FMaxUDPPSize := IntToStr(iMaxUDPDg); end; InfoEvent('Started WinSock'); end; end; procedure TCsSocket.CleanUp; begin if FStarted then begin FStarted := False; if WSACleanUp = SOCKET_ERROR then raise ECsSocketError.create('Cannot close Winsock!'); end; end; constructor TCsSocket.Create(AOwner : TComponent); begin inherited Create(AOwner); FParent := AOwner; FValidSocket := INVALID_SOCKET; FSockType := SockDefault; FAddrType := AddrDefault; FService := ServDefault; FProtocol := ProtoDefault; with FSockAddress do begin sin_family := PF_INET; sin_addr.s_addr := INADDR_ANY; sin_port := 0; end; FSocket := INVALID_SOCKET; FLocalName := ''; FInfo := ''; FAccess := Blocking; FStarted := StartUp; if not FStarted then begin inherited Destroy; Exit; end; FHomeHostName := 'local'; Foktodisplayerrors := TRUE; FConnected := FALSE; FWSALastError := 0; FTimeOut := 0; FNoOfBlockingTasks := 0; InfoEvent(Concat('Version ',WSockVersionNo)); FAsyncHWND := AllocateHWND(AsyncOperation); end; destructor TCsSocket.Destroy; begin DeallocateHWND(FAsyncHWND); CleanUp; inherited Destroy; end; procedure TCsSocket.SetUpPort; begin { Теперь необходимо определить номер порта по типу сервиса } case FService of NoService : FPortNo := 0; echo : FPortNo := 7; discard : FPortNo := 9; systat : FPortNo := 11; daytime : FPortNo := 13; netstat : FPortNo := 15; qotd : FPortNo := 17; chargen : FPortNo := 19; ftp : FPortNo := 21; telnet : FPortNo := 23; smtp : FPortNo := 25; time : FPortNo := 37; rlp : FPortNo := 39; nameserver : FPortNo := 42; whois : FPortNo := 43; domain : FPortNo := 53; mtp : FPortNo := 57; tftp : FPortNo := 69; rje : FPortNo := 77; finger : FPortNo := 79; http : FPortNo := 80; link : FPortNo := 87; supdup : FPortNo := 95; hostnames : FPortNo := 101; ns : FPortNo := 105; pop2 : FPortNo := 109; pop3 : FPortNo := 110; sunrpc : FPortNo := 111; auth : FPortNo := 113; sftp : FPortNo := 115; uucp_path : FPortNo := 117; nntp : FPortNo := 119; end;{case} end; function TCsSocket.GetLocalName : String; var LocalName : array[0..MaxBufferSize] of Char; begin if gethostname(LocalName, SizeOf(LocalName)) = 0 then Result := StrPas(LocalName) else Result := ''; end; function TCsSocket.GetInfo : String; begin GetInfo := FInfo; end; procedure TCsSocket.SetInfo(InfoReqd : String); begin FInfo := InfoReqd; end; function TCsSocket.CreateSocket: TSocket; begin case FSockType of SOCKSTRM : FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP); SOCKDGRAM : FSocket := socket(PF_INET, SOCK_DGRAM, IPPROTO_IP); SOCKRAW : FSocket := socket(PF_INET, SOCK_RAW, IPPROTO_IP); end; if FSocket = INVALID_SOCKET then begin { Попытка создать сокет закончилась неудачно } FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); Result := INVALID_SOCKET; if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; FStatus := Success; Result := FSocket; InfoEvent('Socket ' + IntToStr(Result) + ' created...'); end; procedure TCsSocket.SetUpAddress; begin with FSockAddress.sin_addr do begin S_un_b.s_b1 := Fh_addr[0]; S_un_b.s_b2 := Fh_addr[1]; S_un_b.s_b3 := Fh_addr[2]; S_un_b.s_b4 := Fh_addr[3]; end; end; procedure TCsSocket.SetUpAddr; begin with FSockAddress do begin sin_family := AF_INET; sin_port := FServ^.s_port; end; end; procedure TCsSocket.GetServ; var ProtoStr, ServStr : String; begin ProtoStr := Copy(ProtoStrings[TProtoTypes (FProtocol)],1,Pos(' ', ProtoStrings[TProtoTypes (FProtocol)])-1); StrPCopy(FProtoName, ProtoStr); GetProt(FProtoName); if FProto = NIL then begin { Сервис недоступен } FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); InfoEvent(ProtoStr + ' not available!'); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; if FService = NoService then Exit; ServStr := Copy(ServiceStrings[TServices (FService)],1,Pos(' ', ServiceStrings[TServices (FService)])-1); StrPCopy(FServName, ServStr); FServ := getservbyname(FServName,FProtoName); if FServ = NIL then begin { Сервис недоступен } FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); InfoEvent(ServStr + ' not available!'); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; FStatus := Success; end; procedure TCsSocket.GetProt(Protocol : PChar); begin FProto := getprotobyname(Protocol); if FProto = NIL then begin FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); LookUpEvent(resProto, StrPas(Protocol) + ' not available!', FALSE); if FOKToDisplayErrors then raise ECsSocketError.create(StrPas (Protocol) + 'not available!'); Exit; end; FStatus := Success; LookUpEvent(resProto, StrPas(FProto.p_name), TRUE); end; procedure TCsSocket.WMTimer(var Message : TMessage); begin KillTimer(FHandle,10); if WSAIsBlocking then begin if WSACancelBlockingCall <> SOCKET_ERROR then InfoEvent('Timed out. Call cancelled') else begin ErrorEvent(Failure, WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); end; end; end; procedure TCsSocket.ConnectToHost; begin InfoEvent('Connecting to ' + FRemoteName); case SockType of SOCKSTRM : begin if connect(FSocket, FSockAddress, SizeOf(TSockAddrIn)) = SOCKET_ERROR then begin if WSAGetLastError <> WSAEWOULDBLOCK then begin ErrorEvent(Failure, WSAErrorMsg); FConnected := FALSE; closesocket(FSocket); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; end; FStatus := Success; FConnected := TRUE; end; SOCKDGRAM : begin end; end;{case} end; procedure TCsSocket.GetHost; begin if Length(HostName) = 0 then begin MessageDlg('No host name given!', mtError,[mbOk],0); FStatus := Failure; Exit; end; CreateSocket; if FStatus = Failure then Exit; GetServ; if FStatus = Failure then begin raise ECsSocketError.create('Failed to resolve host : ' + HostName); Exit; end; SetUpAddress; if FService = NoService then FSockAddress.sin_family := AF_INET (* для приложений, не требующих порта *) else SetUpAddr; if FStatus = Failure then Exit; FRemoteName := StrPas(inet_ntoa(FSockAddress.sin_addr)); if SockType = SockStrm then ConnectToHost else begin { Поскольку мы работаем с пакетами, предполагается, что соединение уже имеется } FConnected := TRUE; end; end; 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; procedure TCsSocket.QuitSession; begin if FConnected then begin if WSAIsBlocking then WSACancelBlockingCall; closesocket(FSocket); FConnected := FALSE; end; end; function TCsSocket.WSAErrorMsg : String; begin FWSALastError := WSAGetLastError; Result := LoadStr(SWSABASE + FWSALastError); FStatus := Failure; end; procedure TCsSocket.SetRemoteHostName(NameReqd : String); var P : Pointer; IPAddress : LongInt; begin FRemoteName := NameReqd; if Length(NameReqd) = 0 then begin FStatus := Failure; ErrorEvent(FStatus, 'No host name given!'); case FLookUpOp of resHostName : LookUpEvent(resHostName, FRemoteName, FALSE); resIPAddress : LookUpEvent(resIPAddress, FRemoteName, FALSE); end;// case raise ECsSocketError.create('No host name given!'); Exit; end; if FAccess = NonBlocking then SetAsyncHostName(FRemoteName) else begin InfoEvent('Resolving host'); StrPCopy(FpHostName, FRemoteName); { Определяем тип введенного адреса } IPAddress := inet_addr(FpHostName); if IPAddress <>INADDR_NONE then { Это IP-адрес } begin FLookUpOp := resHostName; FAddress := IPAddr; P := addr(IPAddress); case AddrType of AFINET : FHost := gethostbyaddr(P, 4, AF_INET); end; end else { Нет, это больше похоже на символьное имя хоста } begin FLookUpOp := resIPAddress; FAddress := HostAddr; FHost := gethostbyname(FpHostName); end; if FHost = NIL then begin{ Неизвестный хост, отменяем попытку... } LookUpEvent(FLookUpOp, '', FALSE); FStatus := Failure; if FOKToDisplayErrors then raise ECsSocketError.create('Unable to resolve ' + FpHostName); Exit; end; InfoEvent('Host found'); FStatus := Success; Move(FHost^.h_addr_list^, Fh_addr, SizeOf(FHost^.h_addr_list^)); if FAddress = HostAddr then begin SetUpAddress; FRemoteName := StrPas(inet_ntoa(FSockAddress.sin_addr)); end else if FAddress = IPAddr then begin FRemoteName := StrPas(FHost^.h_name); InfoEvent('Host found...'); end; case FLookUpOp of resHostName : LookUpEvent(resHostName, FRemoteName, TRUE); resIPAddress : LookUpEvent(resIPAddress, FRemoteName, TRUE); end;// case end; end; function TCsSocket.GetDataBuff : String; var Response : Integer; Buffer : CharArray; begin Response := recv(FSocket, Buffer, MaxBufferSize, 0); if Response = SOCKET_ERROR then begin if WSAGetLastError <> WSAEWOULDBLOCK then { Это действительно ошибка! } begin FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); Result := ''; if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end else Exit; end else if Response = 0 then { Больше нет данных от хоста} begin Result := ''; Exit; end; Buffer[Response] := NULL; FData := StrPas(Buffer); Result := FData; end; procedure TCsSocket.SetDataBuff(DataReqd : String); var Data : CharArray; Response : Integer; begin FData := DataReqd; StrPCopy(Data, FData); StrCat(Data, CRLF); Response := send(FSocket, Data, StrLen(Data), 0); if Response = SOCKET_ERROR then begin { Ошибка при посылке данных удаленному хосту } if WSAGetLastError <> WSAEWOULDBLOCK then{ Это действительно ошибка! } begin FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end end; end; function TCsSocket.GetDatagram : String; var Size : Integer; Response : Integer; MsgBuff : CharArray; begin Size := SizeOf(TSockAddrIn); Response := recvfrom(FSocket, MsgBuff, SizeOf(MsgBuff), 0, FSockAddress, Size); if Response = SOCKET_ERROR then begin { Ошибка при посылке данных удаленному хосту } if WSAGetLastError <> WSAEWOULDBLOCK then{ Это действительно ошибка! } begin FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end end; Result := StrPas(MsgBuff); end; procedure TCsSocket.SetDatagram(DataReqd : String); var Response : Integer; MsgBuff : CharArray; begin StrpCopy(MsgBuff,DataReqd); StrCat(MsgBuff,@NULL); Response := sendto(FSocket, MsgBuff, SizeOf(MsgBuff), MSG_DONTROUTE, FSockAddress, SizeOf(TSockAddrIn)); if Response = SOCKET_ERROR then begin { Ошибка при посылке данных удаленному хосту } if WSAGetLastError <> WSAEWOULDBLOCK then { Это действительно ошибка! } begin FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end end else InfoEvent('Data sent...'); end; function TCsSocket.GetOOBData : String; var Response: integer; Data : CharArray; begin if FSocket <> INVALID_SOCKET then begin Response := recv(FSocket,Data,255,MSG_OOB); if Response < 0 then begin ErrorEvent(Failure, WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); FStatus := Failure; Exit; end; Data[Response] := NULL; Result := StrPas(Data); end else Result := ''; end; procedure TCsSocket.SetOOBData(ReqdOOBData : String); var Data : CharArray; Response : Integer; begin if WSAIsBlocking then if WSACancelBlockingCall <> SOCKET_ERROR then begin StrPCopy(Data, ReqdOOBData); StrCat(Data, CRLF); Response := send(FSocket, Data, StrLen(Data), MSG_OOB); if Response = SOCKET_ERROR then begin { Ошибка при посылке данных удаленному хосту } FStatus := Failure; ErrorEvent(Failure,WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; end; end; procedure TCsSocket.Cancel; begin if WSAIsBlocking then if WSACancelBlockingCall = SOCKET_ERROR then begin FStatus := Failure; ErrorEvent(FStatus,WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); end; end; { Начало асинхронного кода } procedure TCsSocket.StartAsyncSelect; begin FRC := WSAAsyncSelect(FSocket, FHwnd, SOCK_EVENT, FD_READ or FD_CONNECT or FD_WRITE or FD_CLOSE); if FRC = SOCKET_ERROR then begin FStatus := Failure; ErrorEvent(FStatus,WSAErrorMsg); InfoEvent('Cannot get WSAAsyncSelect'); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; end; procedure TCsSocket.SetPortName(ReqdPortName : String); var ProtocolName : String; ProtoName : CharArray; begin if Length(ReqdPortName) = 0 then begin FStatus := Failure; LookUpEvent(resPort,'',FALSE); raise ECsSocketError.create('No port number given!'); Exit; end; if ReqdPortName[1] in ['a'..'z', 'A'..'Z'] then begin FStatus := Failure; LookUpEvent(resPort,'',FALSE); raise ECsSocketError.create('You must enter a number for a port!'); Exit; end; if FAccess = NonBlocking then SetAsyncPort(ReqdPortName) else begin FPortName := ReqdPortName; ProtocolName := ProtoStrings[FProtocol]; ProtocolName := Copy(ProtocolName,1, Pos(' ', ProtocolName)-1); StrPCopy(ProtoName, ProtocolName); FServ := getservbyport(htons(StrToInt (FPortName)),ProtoName); if FServ = NIL then begin FStatus := Failure; FPortName := 'no service'; LookUpEvent(resPort, '', FALSE); if FOKToDisplayErrors then raise ECsSocketError.create('Cannot get service'); end else begin FStatus := Success; FPortName := StrPas(Fserv^.s_name); LookUpEvent(resPort, FPortName, TRUE); end; end; end; procedure TCsSocket.SetServiceName(ReqdServiceName : String); var ProtoName, ServName : CharArray; ProtocolName : String; begin if Length(ReqdServiceName) = 0 then begin FStatus := Failure; LookUpEvent(resService, '', FALSE); raise ECsSocketError.create('No service name given!'); Exit; end; if FAccess = NonBlocking then SetAsyncService(ReqdServiceName) else begin FServiceName := ReqdServiceName; StrPCopy(ServName, FServiceName); ProtocolName := ProtoStrings[FProtocol]; ProtocolName := Copy(ProtocolName,1, Pos(' ', ProtocolName)-1); StrPCopy(ProtoName, ProtocolName); FServ := getservbyname(ServName,ProtoName); if FServ = NIL then begin FStatus := Failure; LookUpEvent(resService, '', FALSE); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); end else begin FStatus := Success; FPortName := IntToStr(LongInt(abs(ntohs(FServ^.s_port)))); LookUpEvent(resService, FPortName, TRUE); end; end; end; procedure TCsSocket.SetProtocolName (ReqdProtoName : String); var ProtoName : CharArray; begin if Length(ReqdProtoName) = 0 then begin FStatus := Failure; LookUpEvent(resProto,'No protocol number given!',FALSE); raise ECsSocketError.create('No protocol number given!'); Exit; end; if FAccess = NonBlocking then SetAsyncProtoName(ReqdProtoName) else begin StrPCopy(ProtoName, ReqdProtoName); FProto := getprotobyname(ProtoName); if FProto = NIL then begin InfoEvent(StrPas(ProtoName) + ' not available!'); LookUpEvent(resProto, '', FALSE); FStatus := Failure; if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; FStatus := Success; FProtocolNo := IntToStr(FProto^.p_proto); LookUpEvent(resProto, FProtocolNo, TRUE) end; end; procedure TCsSocket.SetProtoNo(ReqdProtoNo : String); var ProtoNo : Integer; begin if Length(ReqdProtoNo) = 0 then begin FStatus := Failure; raise ECsSocketError.create('No protocol number given!'); Exit; end; if FAccess = NonBlocking then SetAsyncProtoNo(ReqdProtoNo) else begin ProtoNo := StrToInt(ReqdProtoNo); FProto := getprotobynumber(ProtoNo); if FProto = NIL then begin InfoEvent(IntToStr(ProtoNo) + ' not available!'); LookUpEvent(resProtoNo, '', FALSE); FStatus := Failure; if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; FStatus := Success; FProtocolName := StrPas(FProto^.p_name); LookUpEvent(resProtoNo,FProtocolName, TRUE); end; end; procedure TCsSocket.CancelAsyncOperation(CancelOP : Boolean); begin if WSACancelAsyncRequest(THandle(FTaskHandle)) = SOCKET_ERROR then begin FStatus := Failure; ErrorEvent(FStatus,WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); end else begin FStatus := Success; InfoEvent('WSAAsync lookup cancelled!'); end; end; procedure TCsSocket.AsyncOperation(var Mess : TMessage); var MsgErr : Word; begin if Mess.Msg = ASYNC_EVENT then begin MsgErr := WSAGetAsyncError(Mess.lparam); if MsgErr <> 0 then begin FStatus := Failure; ErrorEvent(FStatus,WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end else begin FStatus := Success; InfoEvent('WSAAsync operation succeeded!'); case FAsyncType of AsyncName, AsyncAddr : begin FHost := pHostent(@FAsyncBuff); if (FHost^.h_name = NIL) then begin { Неизвестный хост, отменяем попытку...} FStatus := Failure; if FAsyncType = AsyncName then LookUpEvent(resIPAddress,'',FALSE) else LookUpEvent(resHostName,'',FALSE); if FOKToDisplayErrors then raise ECsSocketError.create('Unable to resolve host'); Exit; end; if length(StrPas(FHost^.h_name)) = 0 then begin InfoEvent('Host lookup failed!'); FStatus := Failure; if FAsyncType = AsyncName then LookUpEvent(resIPAddress,'',FALSE) else LookUpEvent(resHostName,'',FALSE); if FOKToDisplayErrors then raise ECsSocketError.create('Unknown host'); Exit; end; case FAddress of IPAddr : begin Move(FHost^.h_addr_list^, Fh_addr, SizeOf(FHost^.h_addr_list^)); FAsyncRemoteName := StrPas(FHost^.h_name); LookUpEvent(resHostName, FAsyncRemoteName, TRUE); end; HostAddr : begin Move(FHost^.h_addr_list^, Fh_addr, SizeOf(FHost^.h_addr_list^)); SetUpAddress; FAsyncRemoteName:= StrPas(inet_ntoa(FSockAddress. sin_addr)); LookUpEvent(resIPAddress,FAsyncRemoteName, TRUE); end; end;{case} end; AsyncServ : begin FServ := pServent(@FAsyncBuff); if FServ^.s_name = NIL then begin { Сервис недоступен } FStatus := Failure; LookUpEvent(resService,'',FALSE); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; FAsyncPort := IntToStr(ntohs(FServ^.s_port)); LookUpEvent(resService, FAsyncPort, TRUE); end; AsyncPort : begin FServ := pServent(@FAsyncBuff); if FServ^.s_name = NIL then begin { Сервис недоступен } FStatus := Failure; LookUpEvent(resPort,'',FALSE); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; FAsyncService := StrPas(FServ^.s_name); LookUpEvent(resPort, FAsyncService, TRUE); end; AsyncProtoName : begin FProto := pProtoEnt(@FAsyncBuff); if FProto^.p_name = NIL then begin FStatus := Failure; LookUpEvent(resProto,'',FALSE); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; FAsyncProtoNo := IntToStr(FProto^.p_proto); LookUpEvent(resProto, FAsyncProtoNo, TRUE); end; AsyncProtoNumber : begin FProto := pProtoEnt(@FAsyncBuff); if FProto^.p_name = NIL then begin FStatus := Failure; LookUpEvent(resProtoNo,'',FALSE); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; FAsyncProtocol := StrPas(FProto^.p_name); LookUpEvent(resProtoNo, FAsyncProtocol, TRUE); end; end; if FNoOfBlockingTasks > 0 then dec(FNoOfBlockingTasks); end; end; end; function TCsSocket.GetAsyncHostName : String; begin InfoEvent('Host resolved'); Result := FAsyncRemoteName; end; procedure TCsSocket.SetAsyncHostName(ReqdHostName : String); var IPAddress : TInaddr; SAddress: array[0..31] of char; begin FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0); FAsyncRemoteName := ReqdHostName; StrPcopy(SAddress, FAsyncRemoteName); IPAddress.s_addr := inet_addr(SAddress); if IPAddress.s_addr <> INADDR_NONE then { Это IP-адрес } begin FAddress := IPAddr; FAsyncType := AsyncAddr; if IPAddress.s_addr <> 0 then FTaskHandle := WSAAsyncGetHostByAddr(FAsyncHWND, ASYNC_EVENT, pChar(@IPAddress), 4, PF_INET, @FAsyncBuff[0], SizeOf(FAsyncBuff)); if FTaskHandle = 0 then begin if FNoOfBlockingTasks > 0 then dec(FNoOfBlockingTasks); FStatus := Failure; ErrorEvent(FStatus,WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end else FStatus := Success; end else { Нет, это больше похоже на символьное имя хоста } begin FAddress := HostAddr; FAsyncType := AsyncName; Inc(FNoOfBlockingTasks); FTaskHandle := WSAAsyncGetHostByName(FAsyncHWND, ASYNC_EVENT, @FpHostName[0], @FAsyncBuff[0], MAXGETHOSTSTRUCT); if FTaskHandle = 0 then begin FStatus := Failure; if FNoOfBlockingTasks > 0 then dec(FNoOfBlockingTasks); ErrorEvent(FStatus,WSAErrorMsg); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end else FStatus := Success; end; end; function TCsSocket.GetAsyncService : String; begin InfoEvent('Service resolved'); Result := FAsyncService; end; procedure TCsSocket.SetAsyncService(ReqdService : String); var ProtoStr, ServStr : String; begin ProtoStr := Copy(ProtoStrings[TProtoTypes (FProtocol)],1,Pos(' ', ProtoStrings[TProtoTypes(FProtocol)])-1); StrPCopy(FProtoName, ProtoStr); FProto := getprotobyname(FProtoName); if FProto = NIL then begin { Сервис недоступен } FStatus := Failure; InfoEvent(ProtoStr + ' not available!'); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end; ServStr := ReqdService; if Length(ServStr) = 0 then begin FStatus := Failure; ErrorEvent(FStatus,WSAErrorMsg); raise ECsSocketError.create('No service name!'); Exit; end; FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0); StrPCopy(FServName, ServStr); Inc(FNoOfBlockingTasks); FAsyncType := AsyncServ; FTaskHandle := WSAAsyncGetServByName (FAsyncHWND, ASYNC_EVENT, FServName, FProtoName, @FAsyncBuff[0], MAXGETHOSTSTRUCT); if FTaskHandle = 0 then begin FStatus := Failure; if FNoOfBlockingTasks > 0 then dec(FNoOfBlockingTasks); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end else FStatus := Success; end; function TCsSocket.GetAsyncPort : String; begin InfoEvent('Port resolved'); Result := FAsyncPort; end; procedure TCsSocket.SetAsyncPort(ReqdPort : String); var ProtoStr, PortStr : String; begin ProtoStr := Copy(ProtoStrings [TProtoTypes(FProtocol)],1,Pos(' ', ProtoStrings[TProtoTypes(FProtocol)])-1); StrPCopy(FProtoName, ProtoStr); FProto := getprotobyname(FProtoName); if FProto = NIL then begin { Сервис недоступен } FStatus := Failure; InfoEvent(ProtoStr + ' not available!'); ErrorEvent(Failure, ProtoStr + ' not available'); raise ECsSocketError.create(ProtoStr + ' not available'); Exit; end; PortStr := ReqdPort; if Length(PortStr) = 0 then begin FStatus := Failure; raise ECsSocketError.create('No port number!'); Exit; end; FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0); FAsyncType := AsyncPort; FTaskHandle := WSAAsyncGetServByPort (FAsyncHWND, ASYNC_EVENT, htons(StrToInt(PortStr)), FProtoName, @FAsyncBuff[0], MAXGETHOSTSTRUCT); if FTaskHandle = 0 then begin FStatus := Failure; if FNoOfBlockingTasks > 0 then dec(FNoOfBlockingTasks); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end else FStatus := Success; end; function TCsSocket.GetAsyncProtoName : String; begin InfoEvent('Protocol resolved'); Result := FAsyncProtocol; end; procedure TCsSocket.SetAsyncProtoName (ReqdProtoName : String); begin if Length(ReqdProtoName) = 0 then begin FStatus := Failure; ErrorEvent(FStatus, 'No protocol name!'); raise ECsSocketError.create('No protocol name!'); Exit; end; FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0); StrPCopy(FProtoName, ReqdProtoName); FAsyncType := AsyncProtoName; FTaskHandle := WSAAsyncGetProtoByName(FAsyncHWND, ASYNC_EVENT, @FProtoName[0], @FAsyncBuff[0], MAXGETHOSTSTRUCT); if FTaskHandle = 0 then begin FStatus := Failure; ErrorEvent(FStatus, WSAErrorMsg); if FNoOfBlockingTasks > 0 then dec(FNoOfBlockingTasks); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end else FStatus := Success; end; function TCsSocket.GetAsyncProtoNo : String; begin InfoEvent('Proto Number resolved'); Result := FAsyncProtoNo; end; procedure TCsSocket.SetAsyncProtoNo(ReqdProtoNo : String); var ProtocolNo : Integer; begin if Length(ReqdProtoNo) = 0 then begin FStatus := Failure; ErrorEvent(FStatus,'No protocol number!'); raise ECsSocketError.create('No protocol number!'); Exit; end; FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0); ProtocolNo := StrToInt(ReqdProtoNo); FAsyncType := AsyncProtoNumber; FTaskHandle := WSAAsyncGetProtoByNumber(FAsyncHWND,ASYNC_EVENT, ProtocolNo, @FAsyncBuff[0], MAXGETHOSTSTRUCT); if FTaskHandle = 0 then begin FStatus := Failure; ErrorEvent(FStatus,WSAErrorMsg); if FNoOfBlockingTasks > 0 then dec(FNoOfBlockingTasks); if FOKToDisplayErrors then raise ECsSocketError.create(WSAErrorMsg); Exit; end else FStatus := Success; end; function TCsSocket.CheckConnection : Boolean; var peeraddr : tsockaddr; namelen : integer; begin namelen := SizeOf(tsockaddr); Result := getpeername(FSocket, peeraddr, namelen) = 0; end; procedure TCsSocket.ConnEvent; begin if Assigned(FOnConnEvent) then FOnConnEvent(Self, FSocket); end; procedure TCsSocket.CleanUpEvent; begin if Assigned(FOnCleanUpEvent) then FOnCleanUpEvent(Self, FCleanUp); end; procedure TCsSocket.DisConnEvent; begin if Assigned(FOnDisConnEvent) then FOnDisConnEvent(Self, FSocket); end; procedure TCsSocket.InfoEvent(Msg : String); begin if Assigned(FOnInfoEvent) then FOnInfoEvent(Self, Msg); end; procedure TCsSocket.ErrorEvent(Status : TConditions; Msg : String); begin if Assigned(FOnErrorEvent) then FOnErrorEvent(Self, Status, Msg); end; procedure TCsSocket.StatusEvent; begin if Assigned(FOnStatusEvent) then FOnStatusEvent(Self, '',''); end; procedure TCsSocket.BusyEvent; begin if Assigned(FOnBusyEvent) then FOnBusyEvent(Self, FBusy); end; procedure TCsSocket.LookUpEvent(Value : TLookUpOp; Msg : String; Result : Boolean); begin if Assigned(FOnLookUpEvent) then FOnLookUpEvent(Self, Value, Msg, Result); end; procedure TCsSocket.SendDataEvent; begin if Assigned(FOnSendDataEvent) then FOnSendDataEvent(Self, FSocket); end; procedure TCsSocket.RecvDataEvent; begin if Assigned(FOnRecvDataEvent) then FOnRecvDataEvent(Self, FSocket); end; procedure TCsSocket.TimeOutEvent; begin if Assigned(FOnTimeOutEvent) then FOnTimeOutEvent(Self, FSocket, FTimeOut); end; procedure TCsSocket.AbortEvent; begin if Assigned(FOnAbortEvent) then FOnAbortEvent(Self); end; procedure TCsSocket.AsyncOpEvent; begin if Assigned(FOnAsyncOpEvent) then FOnAsyncOpEvent(Self, FSocket); end; // Начало кода WinSock - реализация {$INCLUDE CsSOCKIMP.PAS} procedure Register; begin RegisterComponents('CSWinsock', [TCsSocket]); end; end.В Unix сетевые протоколы обычно компилируются прямо в ядро операционной системы. Как следствие, они всегда инициализированы и доступны для приложений. Однако в Windows ситуация выглядит иначе. Перед тем как приложение сможет воспользоваться услугами сетевого протокола, оно сначала должно обратиться с запросом на инициализацию к Winsock DLL. Компонент CsSocket решает эту задачу с помощью своего private-метода StartUp . Конструктор TCsSocket.Create задает значения свойств по умолчанию и затем вызывает StartUp (см. листинг 5.2).
Листинг 5.2. Конструктор TCsSocket.Create
constructor TCsSocket.Create(AOwner : TComponent); begin inherited Create(AOwner); FParent := AOwner; FValidSocket := INVALID_SOCKET; FSockType := SockDefault; FAddrType := AddrDefault; FService := ServDefault; FProtocol := ProtoDefault; with FSockAddress do begin sin_family := PF_INET; sin_addr.s_addr := INADDR_ANY; sin_port := 0; end; FSocket := INVALID_SOCKET; FLocalName := ''; FInfo := ''; FAccess := Blocking; FStarted := StartUp; if not FStarted then begin inherited Destroy; Exit; end; FHomeHostName := 'local'; Foktodisplayerrors := TRUE; FConnected := FALSE; FWSALastError := 0; FTimeOut := 0; FNoOfBlockingTasks := 0; InfoEvent(Concat('Version ',WSockVersionNo)); FAsyncHWND := AllocateHWND(AsyncOperation); end;Метод StartUp проверяет доступность Winsock DLL и ее статус. В нем задаются значения следующих свойств: FVendor, FWSVersion, FMaxNoSocks и FMaxUDPPSize (см. листинг 5.3). Это чисто информационные свойства, которые никак не влияют на работу главного приложения. При желании вы можете вывести данные, возвращаемые методом StartUp. Если методу StartUp не удается инициализировать Winsock DLL, он присваивает полю FStatus код «неудача», отображает сообщение об ошибке и завершает работу. Приложение, вызывающее этот метод, всегда должно проверять значение свойства Status во время инициализации программы, обычно в обработчике OnCreate приложения.
Листинг 5.3. Функция TCsSocket.StartUp
function TCsSocket.StartUp : Boolean; var VersionReqd : WordRec; begin with VersionReqD do begin Hi := 1; Lo := 1; end; Result := WSAStartUp(Word(VersionReqD), myWsaData) = 0; if not Result then begin FStatus := Failure; raise ECsSocketError.create('Cannot start Winsock!'); Exit; end else begin with myWsaData do begin FVendor := StrPas(szDescription); FWSVersion := Concat(IntToStr(Hi(wVersion)),'.', (intToStr(Lo(wVersion)))); FWSStatus := StrPas(szSystemStatus); FMaxNoSockets := IntToStr(iMaxSockets); FMaxUDPPSize := IntToStr(iMaxUDPDg); end; InfoEvent('Started WinSock'); end; end;«Уборка мусора» не менее важна, чем инициализация. Когда клиентское приложение завершает свою работу (и не нуждается более в услугах Winsock), оно должно приказать Winsock DLL освободить используемую память. Процедура CleanUp (см. листинг 5.4) автоматически выполняет эту работу при закрытии Winsock DLL.
Листинг 5.4. Процедура TCsSocket.CleanUp
procedure TCsSocket.CleanUp; begin if FStarted then begin FStarted := False; if WSACleanUp = SOCKET_ERROR then raise ECsSocketError.create('Cannot close Winsock!'); end; end;Наконец, обращение к Winsock DLL может закончиться неудачей по целому ряду причин, обусловленных спецификой сети. Если это происходит, CsSocket сообщает об ошибке, вызывая функцию Winsock WSAGetLastError через WSA ErrorMsg.
Извлечение данных
Два следующих фрагмента TDBStatistics очень тесно связаны, поэтому мы постараемся работать над ними одновременно. Первый— процедура проверки ошибок GetRange. Во время извлечения данных компонентом она должна убедиться в том, что все делается «законно». Обычно это сводится к тому, чтобы компонент не пытался читать за последней записью, и т. д.
Однако в случае TDBStatistics все оказывается несколько сложнее. Так как пользователь может захотеть проанализировать набор записей, превышающий границы нашего массива, мы должны позволить ему выбрать подмножество данных. Для этого используются два свойства: UpperBound и LowerBound. Они предоставляют компоненту информацию о начальной и конечной записях набора. Следовательно, процедура проверки должна следить за этими двумя величинами. Самый простой выход заключается в использовании функции, которая:
Проверяет правильность свойств; Вносит необходимые поправки; Возвращает разность (с учетом поправок) между UpperBound и LowerBound.Прежде всего мы проверяем, что значение LowerBound положительно, а UpperBound не меньше, чем
LowerBound + 1: if (LowerBound < 1) then LowerBound := 1; if (UpperBound < 1) then UpperBound := LowerBound + 1;ALIGN="JUSTIFY">Следующая проверка убеждает в том, что UpperBound больше, чем LowBound. Если выясняется обратное, значения LowBound и UpperBound меняются местами:
if (LowerBound > UpperBound) then begin TempInt := UpperBound; UpperBound := LowerBound; LowerBound := TempInt; end;Затем мы проверяем, не превышают ли UpperBound и LowerBound количество записей в источнике (то есть значение DataSource.DataSet.RecordCount, извлечен ное ранее и сохраненное в переменной Records), и при необходимости исправляем их:
if (LowerBound > Records) then LowerBound := 1; if (UpperBound > Records) then UpperBound := Records;При последней проверке мы убеждаемся в том, что разность между UpperBound и LowerBound не превышает количества элементов в массиве Data. Другими словами, количество сохраняемых элементов не должно превышать размер массива:
if (UpperBound - LowerBound > MaxValues) then UpperBound := LowerBound + MaxValues;Наконец, функция GetRange возвращает разность между проверенными и исправленными значениями
UpperBound и LowerBound: Result := UpperBound - LowerBound;Так в нашем случае выполняется проверка ошибок.
После завершения проверки можно переходить к извлечению данных из источника и их сохранению в массиве Data. Это происходит в процедуре FillArray.
Настоящая работа FillArray начинается с вызова GetRange. Затем, после проверки границ (см. выше), можно извлечь данные и сохранить их в локальном массиве. Сначала мы открываем источник данных и переходим к записи, номер которой задается свойством
LowerBound: fDataSource.DataSet.Open; fDataSource.DataSet.MoveBy(LowerBound);Затем мы проверяем тип fDataField. Если поле содержит числовые значения, мы читаем данные, запись за записью, и помещаем их в массив Data:
if ((fDataSource.DataSet.FieldByName(fDataField) is TCurrencyField) or (fDataSource.DataSet.FieldByName(fDataField) is TFloatField) or (fDataSource.DataSet.FieldByName(fDataField) is TIntegerField) or (fDataSource.DataSet.FieldByName(fDataField) is TSmallIntField))then begin for i := LowerBound to UpperBound do begin if not (fDataSource.DataSet.FieldByName (fDataField).IsNull) then Data[Index] := fDataSource.DataSet.FieldByName (fDataField).Value else Data[Index] := 0; Inc(Index); fDataSource.DataSet.Next; end; endИз символьных полей данные извлекаются несколько иначе. Единственный вид символьных данных, с которыми умеет работать наш компонен т, — это ZIP-коды1. Существует два типа ZIP-кодов: старые, состоящие из пяти цифр, и новые, «пять плюс четыре».
С точки зрения TDBStatistics ZIP-коды из пяти цифр можно преобразовать в числовой тип без дальнейшей обработки. Если значение состоит из девяти цифр и включает дефис, то дефис необходимо предварительно заменить символом «точка» (.), чтобы поле можно было привести к числовому типу:
else if (fDataSource.DataSet.FieldByName (fDataField) is TStringField) then begin for i := LowerBound to UpperBound do begin TempString := fDataSource.DataSet.FieldByName (fDataField).Value; if (Pos('-', TempString) > 0) then TempString[Pos('-', TempString)] := '.'; Data[Index] := StrToFloat(TempString); Inc(Index); fDataSource.DataSet.Next; end; end;Наконец, мы закрываем источник данных и сбрасываем два флага:
fDataSource.DataSet.Close;
IsArrayFilled := True;
DidGetAll := False;
Переменная IsArrayFilled позволяет другим методам компонента узнать, были ли извлечены данные из источника. Если она равна False, другие процедуры могут вызвать FillArray перед тем, как начинать свою работу. Переменная DidGetAll — другой флаг, используемый методами доступа (его смысл разъясняется ниже).
Эйс получает ответ
— Алло, Хелен? Да, детка, это я. Просто хочу сказать, что никаких новостей нет. Глухая стена. Я уже сотню раз перебрал все возможные варианты, но не сдвинулся ни на шаг. Никаких улик, я абсолютно беспомощен. Нечего сказать, хорош сыщик!
— Эйс, ты действительно хороший сыщик — один из лучших, — сказала Хелен. — Просто на этот раз ты не справишься в одиночку.
— Наверное, ты права, — признал он. — Помощь мне бы не помешала.
— Почему бы тебе не поговорить с Автором? — предложила Хелен. — Помнишь, он тебе помогал раньше?
— Хорошая мысль. Надо попробовать. Спасибо, детка, я тебя люблю.
— Взаимно, — ответила она.
Эйс повесил трубку и схватил телефонный справочник. Пробежав пальцем по странице, он нашел нужный номер и быстро набрал его.
— Привет, Эйс, — отозвался голос в трубке.
— Эээ… привет, — ответил Эйс. — Наверное, вы уже знаете, почему я звоню.
— Ты хочешь получить ответы на некоторые вопросы, относящиеся к похищению твоего Дневника.
— Да, я чувствую себя абсолютно беспомощным и решил позвонить вам.
— Я довольно давно не слышал тебя, Эйс, — сказал голос в трубке. — С того самого «Дела о двойной демонстрации». Тогда я помог тебе, не правда ли?
— О, да, — ответил Эйс. — Вы напомнили о том, какой я особенный, и подбодрили меня. Думаю, без вашей помощи у меня бы ничего не получилось.
— Интересно, почему ты так и не поблагодарил меня?
— Так уж получилось, — робко ответил Эйс. — Когда я справился с делом, то подумал, что помощь мне уже не понадобится. — Он на секунду задумался и добавил. — И еще не хотел вас беспокоить. Ведь я всего лишь один из ваших персонажей.
— У меня все персонажи особенные. А ты — один из моих любимых персонажей. Очень жаль, что ты не позвонил. Иногда я огорчаюсь, когда ты пытаешься сделать все сам. Помни, ты можешь звонить мне в любое время дня и ночи, по любому поводу, важному или пустяковому. Но вернемся к твоему вопросу. Ты хочешь знать, кто украл твой Дневник.
— Точно. Хелен думает, что это был Мелвин Бохакер с женщиной-сообщ ницей. Сначала я думал иначе, но теперь начал сомневаться. Дневник украл действительно Бохакер?
— На этот вопрос можно дать три ответа: «Да», «Нет» и тот, который предназначен для тебя: «Не сейчас».
— Но я должен знать, кто забрал мою самую ценную вещь. Не представ ляю, как я обойдусь без Дневника. Кроме того, речь идет о нашей с Хелен репутации частных сыщиков.
— Эйс, жизнь — не коробка с конфетами. Для тебя она скорее похожа на программирование, управляемое событиями: важно не только то, что событие произошло, но и то, когда это случилось. Жизнь — сплошная тайна, а в любой тайне главное — это последовательность событий. К тому же в поисках решения ты узнаешь больше, чем сразу получив готовый ответ.
— Так что же мне делать? — жалобно спросил Эйс.
— Иди на стоянку и тщательно обыщи место рядом с твоей машиной. Ты найдешь ключ ко всей тайне.
— Спасибо, — взволнованно ответил Эйс, — Я этого не забуду.
Он поспешно бросил трубку и рванулся к двери.
Эйс выходит победителем
Дельфийский Мститель оторвался от Дневника. Вокруг явно творилось что-то непонятное. Температура воздуха упала, комната подернулась дымкой, а по полу стелился толстый слой плотного тумана. Яркий белый свет едва проникал сквозь него, отчего все происходящее выглядело очень странно. Вдруг раздался мощный удар, трухлявая дверь слетела с петель и грохнулась на пол. В открытом дверном проеме стоял торжествующий Эйс Брейкпойнт!
* * *
Я шагнул внутрь убогой комнаты, зная, что не только раскрыл дело, но и полностью отнял у Третьего Лица роль повествователя. Всего три прыжка отделяли меня от жалкого существа, прижавшегося к стене напротив — побежденного противника, который осмелился назвать себя Дельфийским Мстителем.
— Брейкпойнт! — прошипел Бохакер и уронил мой Дневник на пол. — Откуда ты узнал?
— Легко, — ухмыльнулся я. — С самого начала было ясно, что здесь что-то нечисто. Просто я не сразу догадался, что имею дело с вами…мисс Бохакер! — закончил я и сорвал фальшивые усы с ее верхней губы.
— Черт! — выдавила она сквозь стиснутые зубы. Ее огромные глаза, как у загнанного в угол животного, мерили меня с головы до ног. Выражение отчаяния полностью исчезло, и на его месте появилась кривая ухмылка, которая мне очень не понравилась.
— Да, это я — Мевлин, сестра-близнец Мелвина Бохакера.
По моей спине пробежал холодок. Внезапно я почувствовал себя так, будто меня заставили участвовать в дешевом и очень скверном фильме категории «Б». Как мне удается попадать в такие ситуации? Я покачал головой.
— Конечно, — заметила она презрительно. — Можешь разыгрывать из себя героя. Но хоть на секунду представь себе, что это такое — с самого детства вечно идти по следам Мелвина Бохакера.
— А заодно и следовать его привычкам в еде, — подумал я, разглядывая многочисленные пакеты от чипсов и сухих завтраков. Но как ни странно, я почувствовал что-то вроде сочувствия — похоже, она собиралась излить душу.
— Мелвин был старше меня ровно на 8 минут, — сказала она, — Поэтому ему всегда доставалось все лучшее. Когда настало время учебы в колледже, у наших родителей хватило денег лишь на одного из нас. Конечно, послали Мел вина, а я осталась дома. Наверное, мне пришлось бы умереть с голоду, если бы я не занялась дизайном одежды.
— Секунду, — перебил я. — Так это вы заправляете фирмой «Бохакер Индастриз»? Той, что выпускает джинсы?
— А ты не сообразил? — спросила она лукаво. — Тогда ты, видимо, и не знаешь, что моя компания производит кое-что и для коллекции твоей подружки, Маффи Катц.
— Наверное, вы стоите целую кучу денег! — воскликнул я.
— О, да, на моем счету несколько миллионов. Наверное, этого достаточно, если не интересоваться ничем иным. Однако вся любовь всегда доставалась Мелвину. Это он стал посвященным и получил образование в колледже. Это он стал одним из самых уважаемых и почитаемых членов всего научного сообщества — программистом для Windows 95.
Ее глаза загорелись ненавистью.
— С самого детства я была никчемной, зависимой жертвой. Я поклялась отомстить Мелвину, чего бы это ни стоило. Всего несколько недель назад у меня созрел план, — произнесла она, мечтательно глядя вдаль. — Я решила украсть твой Дневник, вооружиться хранящимися в нем секретами и стать лучшим в мире программистом для Windows — лучше Мелвина. И, разумеется, лучше тебя, — прибавила она, указывая мне в грудь длинным, изящным пальцем.
— Не надо тыкать в меня пальцем, — предупредил я, — вы можете меня оцарапать.
— А еще приятнее было то, — продолжала она, — что в краже должны были обвинить Мелвина. Я позвонила ему сегодня утром, чтобы подразнить и выманить из города, так что все решили бы, что он ударился в бега. Это был великолепный план. Как жаль, что он не удался. Очевидно, я недооценила тебя.
— Вы забыли, что я был сыщиком, — ответил я. — И оставили такое количество улик, что даже последний «чайник» из Бейпорта смог бы обо всем догадаться.
— Перчатка? — спросила она. — я случайно обронила ее и даже думала о том, чтобы вернуться. Но перчатка должна была указать на Мелвина, а не на меня.
— Несомненно. В грязной перчатке, оставшейся на месте преступления, я нашел пару волосков, ДНК которых почти полностью совпала с ДНК Мелвина. Но в этот момент я уже знал, что это — ловушка, хотя и очень хитроумная. Для такого заключения были две причины. Видите ли, после того удара, который он получил от меня два года назад, Мелвину никогда бы не хватило смелости снова устроить что-нибудь против меня. Я отбил у него охоту.
— А вторая причина? — поинтересовалась она.
— Вряд ли ваш брат стал бы носить женские перчатки, — усмехнулся я. — Они оказались бы ему слишком малы. Поэтому я вышел на компьютер Бюро лицензий и получил копию его водительского удостоверения. У меня появилась дата рождения. Я знал, что он родился в Калифорнии. Поэтому следующим делом я подключился к большой базе данных и выполнил поиск по всем округам Калифорнии.
Она поняла с полуслова.
— Значит, ты нашел наши свидетельства о рождении. — Да. Затем я узнал, что в ту ночь у Честера и Марты Бохакер родились два ребенка — мальчик Мелвин и девочка Мевлин, появившаяся на свет несколькими минутами позже. Близнецы. Вот почему образцы ДНК почти полностью совпали.
— Понятно. Значит, ты узнал о моем существовании. Как же ты выследил меня в этой дыре?
— Я предположил, что для реализации своего плана вы оставались в городе не меньше двух недель. В единственном городском мотеле не было зарегистрировано ни одного нового постояльца, поэтому я просмотрел данные местной телефонной компании и поискал новых клиентов, подключенных за последнюю пару недель. Это маленький город, и очень скоро поиски привели меня сюда. Еще один заход в Калифорнию — и я получил технические данные вашей машины. Они подходили к той машине, которую я видел у своей конторы в тот вечер. Тогда я понял, что добрался до разгадки. Дело оказалось простым и банальным.
— Простым, возможно. Но банальным — нет, не думаю, — сказала Мевлин. Голос прозвучал неожиданно мягко и спокойно. Это внезапное изменение привлекло мое внимание. Ее глаза горели не ненавистью, а холодным огнем. Она сняла шляпу и лениво швырнула ее через всю комнату, потом беспечно встряхнула головой. Шелковистые черные локоны рассыпались по плечам. Я подумал, что с этой женщиной нужно быть осторожным.
Где-то за стеной заиграл саксофон. Мевлин подняла с пола мой Дневник.
— Послушай, Эйс, — сказала она, посылая мне кокетливую улыбку. — Может, мы просто не с того начали? Например, ты бы мог оставить эту книжку мне, и тогда мы бы стали очень близкими друзьями.
Я заметил, как она поглаживает мягкую кожу на переплете Дневника, словно это была любимая собачка. Ситуация с каждым моментом становилась все горячее. Я старался отодвинуться от нее подальше. К одному саксофону присоединились еще три, и теперь они играли так громко, словно находились в этой комнате. «В этих дешевых номерах слишком тонкие стены», — подумалось мне.
— Боюсь, ничего не получится, — сказал я и сделал шаг назад. — У меня уже есть один очень близкий друг. Ее зовут Хелен.
— Знаю, — ответила она, неуклонно приближаясь ко мне. — Я ее видела. Славная девочка, провинциальный цветочек с милой мордашкой и хорошей фигурой. Но скажи мне, — и ее рот заранее искривился торжествующей улыбкой, — есть ли у нее что-нибудь подобное?
Не выпуская из рук Дневника, она одним быстрым движением распахнула полы плаща. Я отшатнулся назад. Мои вытаращенные глаза были прикованы к тому, что виднелось в распахнутом плаще: из внутреннего кармана торчали два билета в первый ряд на концерт «?оллинг Стоунз» в Сиэтле. Она проворно выдернула билеты и вложила их мне в руку.
— Я рада, что могу отдать их тебе.
— Откуда… Как тебе удалось их достать? — потрясенно спросил я, тщетно пытаясь обрести душевное равновесие.
— Деньги все могут, милый, — ответила она. — Ну же, бери, они твои.
Казалось, я целый час не мог оторвать взгляда от билетов, торчащих в моем кулаке.
— Я… извините, я не беру взяток, — сказал я и неохотно бросил билеты на пол. — У меня нет выбора. Я должен отвести вас в полицию.
— По крайней мере стоило попытаться, — довольно спокойно заметила она.— Эйс, а что бы ты сказал насчет… маленького поцелуя? Чтобы доказать, что ты на меня не обижаешься?
С дьявольски обворожительной улыбкой она прижалась ко мне и обняла, не выпуская, однако, из правой руки Дневника.
— Чего… поцелуя? — тупо спросил я в надежде выгадать хоть немного времени и изобрести какой-нибудь план. К саксофонам присоединился еще один, и аккомпанементом к ним зазвучал барабан, гулко отдававшийся у меня в груди.
Лед растаял, и ее серые глаза приблизились к моим.
— Ну конечно, глупый, — игриво ответила она. — Надеюсь, ты знаешь, что это такое? Это когда двое людей соприкасаются губами, а потом прижимают их… вот… так…
До этого момента я не следил за ее ртом. Но когда ее влажные алые губы приблизились к моим и я почувствовал сладкий запах ее дыхания, все остальные мысли куда-то пропали. Я словно застыл в каком-то трансе рядом с оркестром, игравшим лучшие вещи Барри Манилоу. Что я мог сделать? И как же Хелен? ?оскошные, трепещущие губы приближались…
Сзади раздалось приглушенное хлоп! — и в моей голове что-то взорвалось. Мир из TrueColor стал черно-белым, а потом начал медленно расплываться оттенками серого. Губы Мевлин искривились в маниакальном смехе, который отражался от всех стен. Я снова уловил запах ее дорогих духов. Теперь он заполнил мои ноздри и нестерпимо горел в мозгу.
— Chez Monieux, — полушепотом произнес я. Мои колени стали ватными, а потом все провалилось в черноту.
* * *
Когда я пришел в себя, голова раскалывалась, а во рту был противный горький привкус. Я с трудом поднялся на ноги и посмотрел на часы — 19:34. Поблизости не было видно ни Мевлин, ни Дневника, но внизу доносилось характерное тарахтение мотора — ее неповоротливый белый «Бронко» отъезжал со стоянки.
На столе лежал конверт лавандового цвета, а рядом с ним — записка, написанная знакомым женским почерком. Я взял ее, но слова расплывались перед глазами, и только через несколько секунд мне удалось сфокусировать взгляд.
«Дорогой Эйс!
В конверте ты найдешь небольшой подарок от меня.
Наверное, у нас действительно могло что-нибудь получиться. Но мне пришлось сделать то, что было неизбежным. Возможно, мы еще увидимся в будущем.
Наверное, нельзя всегда получать то, что хочешь. Но если постараться, можно получить то, что тебе очень нужно.
Всегда твоя,
Мевлин»
Я вскрыл надушенный конверт и вытряхнул на стол его содержимое — полоску белой бумаги с перфорацией вдоль края.
Я подобрал билет и посмотрел на него, вспоминая всю эту безумную сцену. Сначала меня поразила ее красота, оставившая глубокий след в моей душе. Затем меня поразил мой собственный Дневник, оставивший порядочную шишку на затылке. Шишка со временем пропадет, а пока нужно привести в порядок кое-какие дела.
Наверное, когда мои сентиментальные друзья услышат об этом происшествии, они посоветуют мне понять Мевлин и простить ту боль, которую она причинила. Возможно, когда-нибудь у меня это получится. Но еще довольно долго я не смогу доверять женщинам с кривой усмешкой и маниакальным смехом.
Эпилог
Дневник №17, 13 апреля. За последние 24 часа произошло множество событий. Я пережил приключение, которое ни за что не хотел бы повторить.
Хелен ожидала моего возвращения. По крайней мере отчасти она была права — вор действительно был из семьи Бохакеров. Впрочем, я тоже был прав — сам Бохакер никогда не рискнул бы пойти против меня.
Часы показывали 23:39. Я налил чашку кофе и сделал большой глоток. Теперь я знал, каково это — видеть свою контору вскрытой, а имущество украденным. Мне бы не хотелось снова испытать нечто подобное. Мой папа, Джек Брейкпойнт, всегда говорил мне: «Береги свои пожитки, сынок. Всегда найдется кто-то, кому они нужны больше, чем тебе». А мама добавляла: «И всегда надевай лучшее белье — на случай, если ты попадешь под автобус».
В одном можно не сомневаться: мои Дневники теперь не будут валяться где попало. Вероятно, я никогда не увижу украденный Дневник. К счастью, он был только одним из целой серии. Кто-то говорил мне, что лучшие выдержки из него были включены в новую книгу по программированию на Delphi.
Перед уходом Хелен долго говорила со мной об Авторе. Она убедила меня, что после всего, что Автор сделал для меня, мне следовало бы чаще общаться с ним и рассказывать о нем другим. С учетом всех обстоятельств я обязан сделать хотя бы это.
Вопреки здравому смыслу на пути домой я все же купил последний компакт -диск группы «Крыша поехала». Он называется «Трансцендентальная медитация». Кнопку «стоп» пришлось нажать уже на середине первой композиции — «Сполосни и сплюнь». На мой взгляд, слишком напоминает кабинет стоматолога.
Я сидел на кухне и отхлебывал горькую коричневую жидкость. Снаружи доносился шум дождя, барабанившего по окну. Я достал бумажник, а из него — билет, найденный в конверте. По какой-то причине он не выходил у меня из головы.
Наверное, мне стоит пойти на этот концерт. Это позволит хорошо отдохнуть от суетной жизни этого маленького городка. К тому же я люблю такую музыку. Возможно, это даже станет началом нового приключения.
Ведь никогда не известно заранее, кто окажется в соседнем кресле.
Конец записи (13 апреля).
|
Как это сделать?
Тема DLL включает в себя два вопроса: создание и использование. Вы ежедневно используете DLL при работе под Windows, возможно, даже не подозревая об этом. Почти вся система Windows реализована в виде различных DLL. Например, при вызове функции MessageBox происходит обращение к DLL с именем USER.EXE (или USER32.DLL — Windows 95 порой производит довольно странные манипуляции с автоматическим 32/16-разрядным преобразованием (thunking), поэтому я не всегда понимаю, что именно происходит в системе). Независимо от того, знаете вы это или нет, DLL используются в вашей повседневной работе.
Существуют два способа вызова функций, находящихся в DLL. Вы можете построить интерфейсный модуль, в котором указано имя DLL и вызываемых функций, и связать его со своей программой на Delphi. Это называется статической компоновкой DLL (на мой взгляд, термин неудачен, но его придумал не я) . Также иногда встречается термин «динамическая компоновка на стадии компиляции» 1. Именно так вызываются функции Windows API. Файл WINDOWS.DCU, подключаемый ко всем программам, у которых в операторе uses указан модуль Windows, представляет собой именно такой интерфейсный модуль с определениями функций.
Другой способ вызова функций DLL, как нетрудно догадаться, — динамический. При динамической загрузке DLL вам не придется подключать к своей программе никакие интерфейсные модули. Вместо этого программа во время выполнения вызывает функции LoadLibrary и GetProcAddress, чтобы найти функции DLL и связаться с ними. Это называется «динамическим импортом». Первый из этих двух способов проще в использовании, зато второй оказывается более надежным и гибким.
1Автор использует для обозначения двух способов доступа к функциям из DLL термины «статическая/динамическая компоновка» или «динамическая компоновка на стадии компиляции/выполнения». Первый вариант может ввести читателя в заблуждение, поскольку DLL в любом случае присоединяется динамически, второй же является слишком громоздким. Поэтому далее в этой главе используются термины «статический/динамический импорт». — Примеч. ред.
Как меня зовут?
Программа RESOLVER32 отображает имя, под которым ваш компьютер числится в сети. Это достигается путем присваивания тексту в поле ввода edMachineName значения свойства CsSocket1.LocalName. Метод TCsSocket.GetLocalName является оболочкой для функции gethostname Winsock API. Он извлекает имя вашего компьютера из локального файла хостов (который обычно хранится в каталоге Windows) и возвращает его в свойстве LocalName.
В листинге5.6 приведен метод TCsSocket.GetLocalName из файла CSSOCKET.PAS. Обратите внимание — gethostname, как и все функции Winsock, работает только со строками, завершающимися нулевым символом . Метод Get LocalName использует функцию StrPas, чтобы преобразовать возвращаемый результат в строку Object Pascal. Затем имя компьютера выводится в текстовом поле edMachineName. Если компьютер не имеет имени, GetLocalName просто возвращает пустую строку. Разнообразная информация, собранная методом TCsSocket.StartUp об используемом Winsock DLL, передается RESOLVER32 через свойства WSVendor, WSVersion, WSStatus, WSMaxNoSockets и WSMaxUDPPSize и отобража ется в групповом поле gbWSInfo.
Листинг 5.6. Функция GetLocalName
function TCsSocket.GetLocalName : String; var LocalName : array[0..MaxBufferSize] of Char; begin if gethostname(LocalName, SizeOf(LocalName)) = 0 then Result := StrPas(LocalName) else Result := ''; end;Как работает программа
В листинге 4.1 реализовано сразу два класса. Первый, TDragDropInfo, наверное, покажется вам знакомым по предыдущей главе. Я немного подправил его, потому что для источника требуются кое-какие дополнительные возможности, но в общем он остался тем же объектом, знакомым по примеру с FMDD.
Другой класс, TFileDropTarget, реализует интерфейс IDropTarget. Определение этого класса выглядит так:
TFileDropTarget = class (TInterfacedObject, IDropTarget)
Если вы по уши влюблены в C++, не спешите торжествовать. Если же вы полагаете, что множественное наследование изобрел сам дьявол для искушения начинающих программистов, не торопитесь убегать с воплями ужаса. То, что вы здесь видите, не является множественным наследованием. Этот странный фрагмент говорит: «TFileDropTarget является потомком TInterfaced Object и реализует интерфейс IDropTarget». Один класс действительно может реализовывать несколько интерфейсов, но ситуация не имеет ничего общего со множественным наследованием.
В файле ACTIVEX.PAS, находящемся в каталоге Delphi Source\RTL\WIN, содержится следующее объявление интерфейса IDropTarget:
IDropTarget = interface(IUnknown)
['{00000122-0000-0000-C000-000000000046}'] function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragLeave: HResult; stdcall; function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; end;Первая строка лишь сообщает о том, что интерфейс IDropTarget является наследником IUnknown. Следующая строка определяет глобально-уникальный идентификатор интерфейса (Globally Unique Identifier, GUID). GUID представляет собой 128-битное число, уникальное для каждого типа объекта. Фирма Microsoft назначила GUID всем стандартным интерфейсам OLE. Существуют программы (и даже функция API), генерирующие новые GUID. С точки зрения статистики крайне маловероятно, чтобы два сгенерированных GUID совпали. В любом случае для использования готовых интерфейсов OLE вовсе не обязательно разбираться в механике GUID, но если вы собираетесь создавать собственные интерфейсы, обязательно научитесь генерировать GUID и работать с ними в программах.
Оставшаяся часть кода просто объявляет методы интерфейса. Класс, реализующий интерфейс, должен реализовать все объявленные методы. Если какой-либо из методов классом не поддерживается, необходимо организовать возврат кода ошибки.
Следовательно, интерфейсы чем-то похожи на классы — они тоже описывают поведение объектов. Но в отличие от классов интерфейсы не имеют категорий доступа (private, public, protected и т. д.) и не объявляют переменных или свойств. Кроме того (и опять же в отличие от классов), интерфейсы не имеют обязательных реализаций. Ни в ACTIVEX.PAS, ни в каком другом месте вы не найдете такой строки:
function IDropTarget.DragLeave : HResult;
Во всем листинге 4.1 заслуживает внимания лишь одна часть приемника — метод TFileDropTarget.Drop, вызываемый OLE при сбрасывании файлов пользователем. Эта функция должна получить данные от объекта и передать их окну. Передача происходит в процедуре события FOnFilesDropped, вызываемой Drop после получения данных. Эта функция и принцип ее действия очень напоминают TFMDDEvent из предыдущей главы.
С другой стороны, с получением данных дело обстоит несколько сложнее.
Чтобы получить перетаскиваемые данные, Drop заполняет структуру TFormatETC, которая описывает представление данных, и передает ее вместе со структурой TStgMedium методу GetData объекта данных. GetData форматирует данные в соответствии с содержимым структуры TFormatETC и возвращает их в структуре TStgMedium. Затем Drop может работать с данными, что в нашем случае означает создание структуры TDragDropInfo. Когда метод Drop завершает обработку данных, он должен освободить структуру TStgMedium. Последний момент чрезвычайно важен — особенно если вы занимаетесь реализацией источника. За освобождение данных отвечает клиент , то есть приемник. Это означает, что реализация GetData из объекта данных должна предоставить копию данных, а не сами данные. Возможно, сейчас это кажется вам очевидным. Мне это тоже кажется очевидным… после того, как я потратил почти два дня на отладку программы!
Как ни странно, приведенная реализация приемника оказалась проще, чем вариант из главы 3. Видимо, мы нередко склонны преувеличивать сложность задач. И все же признаюсь, что на освоение COM и TInterfacedObject у меня ушло немало времени — намного больше, чем на обработку WM_DROPFILES.
Как тебя зовут?
RESOLVER32 также умеет определять имя хоста по его числовому IP-адресу. Для этого следует ввести адрес в текстовом поле edIPName (см. рис.5.5). При нажатии кнопки Resolve программа передает адресную строку из edIPName.Text методу SetRemoteHostName через свойство Hostname.
Метод SetRemoteHostName, как и ранее, с помощью функции inet_addr проверяет, является ли строка корректным IP-адресом. Кроме того, перед вызовом этой функции метод присваивает указателю P адрес переменной IPAddress1, используемый функцией gethostbyaddr в качестве параметра.
Рис. 5.5. IP-адрес готов к преобразованию
Если inet_addr возвращает результат, отличный от INADDR_NONE (то есть строка представляет собой корректный числовой IP-адрес), SetRemoteHostName вызывает gethostbyaddr. Данный вызов, как и обращение к gethostbyname, может выполняться в режиме блокировки. Если вызов gethostbyaddr заканчивается успешно, он возвращает указатель на структуру pHostent. Если для заданного IP-адреса не нашлось соответствующего имени, FHost получает значение NIL, а SetRemoteHostName вызывает LookUpEvent, чтобы сообщить о неудачном поиске, устанавливает флаг FStatus и завершается. При успешном поиске свойство Hostname записывает полученное имя хоста обратно в текстовое поле edHostName через процедуру события LookUpEvent, предварительно преобразовав имя в строку Паскаля и присвоив его значение private-полю FRemoteName:
FRemoteName := StrPas(FHost^.h_name);
Как вас обслуживают?
Когда FTP-клиент соединяется с TCP-портом21, Winsock DLL посылает сообщение FTP_EVENT. В результате процедура FtpEvent активизируется и начинает ожидать от сокета информационное сообщение FD_ACCEPT. В ветви FD_ACCEPT оператора case процедура FtpEvent создает сокет FClientSocket с помощью функции accept:
FClientSocket := accept (FSocketNo, @ClientSockAddr), @FAddrSize);
Затем мы вызываем функцию Winsock API с именем getpeername, чтобы узнать IP-адрес клиента. Получив IP-адрес, CsKeeper поочередно сравнивает его со всеми строками адресов «плохих» клиентов, хранящимися в списке CsKeeper.FBadIPs. Если будет найдено совпадение, CsKeeper посылает предупреждающее сообщение, отсоединяет нежелательного FTP-клиента и возвращается в состояние прослушивания. Если же клиент признан добропорядоч ным, CsKeeper вызывает LoginUser для выполнения оставшейся части регистрации.
Какой у тебя адрес?
Преобразование имени хоста является самой распространенной операцией, выполняемой Winsock-приложениями в режиме блокировки. В данном случае «режим блокировки» означает, что приложение ожидает ответа от удаленного компьютера — ответа, который может никогда не прийти. До получения ответа заблокированное приложение не может продолжать работу или реагировать на ввод информации пользователем и часто кажется «мертвым».
В таких операционных системах, как Unix, Windows 95 и Windows NT, такое поведение не представляет особых проблем. Даже если приложение заблокировано, использованный в них принцип вытеснения задач позволяет другим приложениям нормально работать.
Чтобы пользователь не терял возможности взаимодействовать с любым приложением Winsock во время блокировки, Winsock заменяет блокирующие функции псевдоблокирующими асинхронными эквивалентами. Вместо того чтобы осуществлять полноценную блокировку, эти функции при ожидании завершения сетевого события переходят в цикл опроса. Псевдоблокирующие функции можно узнать по префиксу WSAAsync. Например, функция WSAAsyncGet HostByName является асинхронной версией gethostbyname. Используя WSAAsyncGet HostByName, пользователь может в любой момент прервать операцию просмотра. В блокирующих функциях такая возможность отсутствует.
Чтобы изменить поведение RESOLVER32, достаточно сменить значение свойства Access c Blocking на NonBlocking, или наоборот. Значение NonBlocking сообщает CsSocket о том, что для просмотра должны использоваться асинхронные функции.
Обычно хост Internet идентифицируется в сети по уникальному адресу
в виде четверки десятичных чисел, разделенных точками, — например, 127.0.0.1 (обратите внимание на этот специальный адрес обратной связи, с его помощью можно тестировать приложения Winsock на компьютерах, не подключенных к сети). Хотя такие адреса исключительно удобны для компьютеров, на людей они производят угнетающее впечатление. Чтобы уладить эту проблему, была разработана система, которая позволяет задать уникальное символьное имя для каждого IP-адреса. Например, имя slipper109.iaccess.za соответствует IP-адресу 196.7.7.109.
Чтобы преобразовать имя хоста, введите его в текстовом поле edHostName программы RESOLVER32. После нажатия кнопки Resolve RESOLVER32 присваивает имя, введенное в edHostName, свойству Hostname. При этом свойство вызывает метод TCsSocket.SetRemoteHostName. Если строка NameReqd пуста, SetRemote HostName сообщает об ошибке и завершается. В противном случае CsSocket проверяет значение поля FAccess (которое может быть равно Blocking или NonBlocking в зависимости от свойства Access), чтобы определить режим преобразования имени хоста в IP-адрес. Если значение FAccess равно NonBlocking, вызывается SetAsyncHostName. В противном случае функция StrpCopy преобразует FRemoteName из строки Паскаля в строку с нуль-терминатором. В листинге 5.7 показано, как это делается в CsSocket.
Листинг 5.7. Метод TCsSocket.SetRemoteHostName — преобразование
имени хоста в IP-адрес
Затем метод SetRemoteHostName с помощью функции inet_addr проверяет, не содержит ли исходная строка числового IP-адреса. Если не содержит, метод предполагает, что в ней находится имя хоста, и вызывает функцию gethostbyname для преобразования его в IP-адрес. Если имя хоста отсутствует в локальном файле хостов, gethostbyname ищет имя в удаленном файле хостов, хранящемся в сети.
Если имя не найдено, процесс поиска прекращает работу по тайм-ауту и присваивает protected-свойству FHost (которое представляет собой указатель на структуру pHostent) значение NIL. Затем SetRemoteHostName вызывает обработчик события LookUpEvent, чтобы сообщить о неудачном завершении просмотра, присваивает флагу FStatus значение Failure и возвращает управление вызывающему приложению. При удачном завершении поиска функция gethostbyname возвращает указатель на FHost, где содержится найденный адрес. Наконец, SetRemoteHostName возвращает IP-адрес в виде строки Паскаля, для чего используется следующий оператор:
FRemoteName := StrPas(inet_ntoa(FSockAddress.sin_addr));
Функция inet_itoa переводит возвращаемый IP-адрес в строку с нуль-терминатором, а функция StrPas завершает преобразование в строку Паскаля. Адресная информация сокета размещается в поле FSockAddress, откуда она позднее извлекается для установки соединения с хостом. Полученный в результате поиска IP-адрес помещается в текстовое поле edIPName (см. рис. 5.4). Для этого RESOLVER32 использует обработчик события OnLookUp, который вызывается внутри процедуры LookUpEvent. В листинге 5.8 показано, как это делается.
Рис. 5.4. RESOLVER32 после преобразования имени хоста
Листинг 5.8. Метод TfrmMain.CsSocket1Lookup, используемый
программой RESOLVER32 для отображения результатов,
полученных от функции просмотра
Каркасный режим
Из всех режимов отображения проще всего реализован каркасный режим. В нем рисуются лишь контуры треугольников: «земля»— зеленым цветом, а «вода» — синим. Если здесь что и заслуживает внимания, так это простота и изящество реализации DrawPixels() в Delphi. В API-версии DrawPixels() (написанной на C или Borland Pascal) вместо одного простого вызова Canvas.Polyline ([A, B, C, A]) пришлось бы объявлять локальный массив и выполнять четыре присваивания — не говоря уже о хлопотах, связанных с созданием и уничтожением контекстов устройств (DC) Windows и графических перьев.
Классическое перетаскивание
Дневник №16, 19 марта. То, что выглядит самым простым, порой оказывается очень сложным. С другой стороны, иногда бывает и наоборот. По крайней мере это справедливо для внутренних 1 операций перетаскивания в приложениях Delphi.
Во время работы над приложением мне захотелось выделить объект и связать его с определенной датой, перетаскивая и бросая его на календарь, расположенный на той же форме. Сначала я выяснил, что для этого требуется.
Оказалось, любая операция перетаскивания начинается с четырех предвари тельных действий:
Инициализация метода BeginDrag исходного компонента (источника), выполняемая при обработке событий мыши, происходящих в зоне этого компонента. Создание обработчика события OnDragOver компонента-приемника, чтобы указать, в каком месте допускается сбрасывание перетаскиваемого объекта. Создание обработчика события OnDragDrop компонента-приемника, чтобы определить, какие действия должны выполняться при сбрасывании перетаскиваемого объекта. Создание обработчика события OnDragEnd компонента-источника. Если три предыдущих шага необходимы для любой операции перетаскивания, последний шаг выполняется лишь в том случае, если при завершении перетаскивания в исходном компоненте необходимо «убрать мусор» (это событие происходит даже при отмене перетаскивания).Компонент CsShopper
CsShopper происходит от VCL-компонента CsSocket из главы5. В нем класс TCsSocket используется для выполнения повседневных задач — загрузки Winsock DLL, заполнения структур данных для установки соединения с хостом, пересылки данных, разрыва соединения с сервером и последующего закрытия Winsock.
Свойство Service базового VCL-компонента CsSocket имеет значение NoService. Компонент CsShopper всегда выполняет функции FTP-клиента, поэтому в конструкторе TCsShopper.Create свойство Service получает значение FTP. В остальном протокол FTP использует стандартные настройки CsSocket — все-таки отличная штука эти компоненты! Как показано на рис. 6.2, помимо Service CsShopper содержит 10 других свойств: Access, AddrType, Asynchronous, Debug, HomeServer, LogOn, Password, Protocol, SockType и UserName.
Рис. 6.2. Свойства CsShopper в инспекторе
объектов Delphi 3
Свойство Asynchronous определяет режим работы CsShopper — блокирующий или асинхронный . Хотя данное свойство не относится к протоколу FTP, выбор режима может повлиять на скорость пересылки данных, надежность приложения и его гибкость. Например, когда CsShopper работает в асинхронном режиме (то есть свойство Asynchronous равно TRUE), пользователь может прервать чересчур затянувшуюся пересылку файла. В блокирующем режиме такая возможность отсутствует (впрочем, если ChShopper написан как многопоточное приложение, то пересылку файла можно прервать и в блокирующем режиме, но это совсем другая история).
Асинхронный режим устроен несколько сложнее, поэтому сначала мы посмотрим, как CsShopper работает в блокирующем режиме. Асинхронный режим будет описан позднее в этой главе.
Самые полезные FTP-команды (в том числе USER, PASSWORD, RETR и PUT) реализованы в CsShopper в виде свойств. Эти свойства находятся в public-секции TCsShopper и потому доступны для пользователей компонента. В блокирующем режиме соответствующие методы используют процедуру FTPCommand, которая является «сердцем» компонента CsShopper. FTPCommand представляет собой простейший анализатор, реализованный в виде большого оператора case. Недостаток изящества подобной конструкции возмещается ее простотой. В асинхронном режиме CsShopper использует другой подход.
Полный исходный текст компонента, находящийся в файле CSSHOPPER.PAS, занимает около 3000 строк, и я не стал включать его в эту главу. Будут приведены лишь отдельные фрагменты, поясняющие некоторые аспекты его работы. Для более подробного знакомства вы можете распечатать полный файл
с CD-ROM.
Компоненты TreeData
Я написал компоненты TreeData, чтобы облегчить просмотр иерархических данных, перемещение и управление ими. Информация отображается в виде графического дерева, каждый уровень которого обозначается соответствую щим отступом. Для каждого объекта выводятся имена всех его предков, а приложение может получить список идентификаторов всех предков или потомков. В это семейство входит несколько компонентов, перечисленных в табл. 13.4.
Таблица 13.4. Семейство компонентов TreeData
| Элемент
TreeDataComboBox TreeDataOutline |
Описание
Отображает дерево объектов в виде раскрывающегося списка; каждому уровню иерархии соответствует определенный отступ; в текстовом поле отображается список предков Допускает последовательный (incremental) поиск по содержимому текстового поля или списка Выбранные идентификаторы связываются с источником данных Отображает все дерево в графическом виде, допускает раскрытие и сворачивание отдельных ветвей Выбранные идентификаторы связываются с источником данных |
Применение
Выбор отдельного объекта; получение идентификаторов всех предков или потомков объекта Выбор отдельного объекта; получение идентификаторов всех предков или потомков объекта |
| Элемент
TreeDataListBox TreeDataUpdate |
Описание
Комбинация TreeDataComboBox и списка. Все выбранные идентификаторы связываются с источником данных TreeOutline, дополненный функциями редактирования и обновления записей, образующих иерархическую структуру. Немедленное или кэшированное обновление источника данных |
Применение
Выбор произвольного количества объектов, сохранение или загрузка их в виде набора записей Поддержание иерархического набора записей |
В элементах семейства TreeData воплощено многое из того, что обсужда лось в этой главе. К сожалению, исходный текст этих элементов состоит из нескольких тысяч строк (его можно найти на CD-ROM, прилагаемом к книге). В них используется общий набор процедур, загружающих все дерево из таблицы в структуру, расположенную в памяти, и изменяющих поведение базовых элементов для иерархического отображения данных.
Конфигурирование KEEPER32 на вкладке Options
На этой вкладке сосредоточено множество полезных функций. Прежде всего
с ее помощью можно предотвратить «блуждание» клиентов по файловой системе сервера. Мы можем ограничить доступ FTP-клиентов определенным диском и основным каталогом того компьютера, на котором выполняется KEEPER32. Следовательно, FTP-клиент не сможет выйти за пределы каталога, указанного в свойстве CsKeeper1.RootDir, и его подкаталогов.
Чтобы задать диск и основной каталог, выберите диск из списка dcbRootDisk (элемент типа TDriveComboBox). Основной каталог выбирается из списка dlbRootDir (элемент типа TDirectoryListBox). Оба элемента находятся в групповом поле gbServerProperties. Двойной щелчок на dcbRootDisk и dlbRootDir автоматически задает значения свойств RootDisk и RootDir. Например, значение свойства RootDisk задается в обработчике OnDblClick элемента dcbRootDisk следующим образом:
procedure TfrmMain.dcbRootDiskDblClick(Sender: TObject); begin CsKeeper1.RootDisk := dcbRootDisk.Drive; end;Кроме того, новый каталог можно создать, не отходя от вкладки Options,— нажмите кнопку Make Dir, и на экране появится форма frmMkDir для ввода имени создаваемого каталога. Затем двойной щелчок на новом каталоге в списке dlbRootDir задает новое значение свойства RootDir.
Группа переключателей rgTransfer используется для выбора стандартного режима пересылки файлов. По умолчанию выбирается режим Stream, то есть файл передается в виде однородного потока байтов.
Режимы Block и Compressed необходимы для реализации команды REST, которая позволяет возобновить пересылку файла с того места, где она была прервана. Переключатели Block и Compressed, а следовательно, и команда REST недоступны в текущей версии CsKeeper. Во время выполнения программы переключатели Block и Compressed блокируются. Поэтому KEEPER32 не сможет выполнить команду MODE с параметром BLOCK или COMPRESSED. Вероятно, в будущем я добавлю поддержку этих двух режимов — конечно, при желании вы тоже можете этим заняться. Впрочем, эти режимы используются довольно редко.
Протокол FTP позволяет выбрать тип файловой структуры (хотя все значения, кроме File, считаются пережитками прошлого и почти не используются). Тип файловой структуры может принимать три значения — File (то есть однородный файл), Record и Page. По умолчанию CsKeeper устанавливает в группе rgFileStructure переключатель File. Текущая версия CsKeeper не поддерживает работу с файловыми структурами Record и Page и отказывается выполнять полученную от FTP-клиента команду STRU для этих режимов.
Чтобы сохранить параметры, введенные на вкладке Options, нажмите кнопку Save в групповом поле gbServerProperties. При этом вызывается процедура SavePropSettings (см. листинг 7.1). Кнопка Cancel отменяет изменения конфигурации (но лишь в том случае, если они еще не были сохранены в реестре).
Листинг 7.1. Процедура SavePropSettings procedure TfrmMain.SavePropSettings;
var Reg : TRegistry; begin Reg := TRegistry.Create; try Reg.OpenKey(FtpServerKey,TRUE); Reg.WriteString('DRootDisk',dcbRootDisk.Drive); finally Reg.CloseKey; end; try Reg.OpenKey(FtpServerKey,TRUE); Reg.WriteString('DRootDir', dlbRootDir.Directory); finally Reg.CloseKey; end; try Reg.OpenKey(FtpServerKey,TRUE); case rgTransfer.ItemIndex of 0 :Reg.WriteString('DTransferMode', FtpTransferStr[STREAM]); 1 :Reg.WriteString('DTransferMode', FtpTransferStr[BLOCK]); 2 :Reg.WriteString('DTransferMode', FtpTransferStr[COMPRESSED]); end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpServerKey,TRUE); case rgFileStructure.ItemIndex of 0 :Reg.WriteString('DFileStructure', FtpFileStructStr[NOREC]); 1 :Reg.WriteString('DFileStructure', FtpFileStructStr[REC]); 2 :Reg.WriteString('DFileStructure', FtpFileStructStr[PAGE]); end; finally Reg.CloseKey; end; Reg.Free; end;Консольные приложения
В Windows 95 и Windows NT существуют консольные приложения - программы, которые не пользуются услугами GUI, а работают в окне так называемого «сеанса DOS». Хотя эти приложения не обладают собственными окнами, они могут пользоваться всем Windows API и полным 32-разрядным адресным пространством Windows (включая виртуальную память). В Windows 3.1 ситуация была иной - GUI-программы могли работать со всем адресным пространством Windows, а программы DOS ограничивались нижними 640 Кбайт.
В прошлом DOS-приложения обходили ограничение в 640 Кбайт с помощью так называемых расширителей DOS, которые поддерживали такие стандарты, как DPMI (DOS Protected Mode Interface) и VCPI (Virtual Control Program Interface). 16-разрядный расширитель позволял работать с 16 Мбайт памяти. Реже встречались 32-разрядные расширители, которые открывали доступ к полному 32-разрядному адресному пространству, а иногда даже поддерживали виртуальную память. Проблема расширителей DOS заключается в том, что все они (даже в самом лучшем исполнении) остаются «хакерством». На многих компьютерах расширители DOS работали недостаточно надежно, кроме того, некоторые из них отказывались работать в DOS-сеансах Windows.
В свою очередь консольные приложения для Windows 95 - всего лишь Windows-программы, не имеющие окон. Для них не требуются специальные программные расширители, и консольные приложения гарантированно работают на любом компьютере с Windows 95 или Windows NT.
Итак, мы получаем доступ ко всей памяти, но зато лишаемся GUI. Возникает вопрос - что делать дальше?
Консольные приложения на Delphi
Хотя Delphi позволяет создавать консольные приложения, документация хранит подозрительное молчание по поводу того, как именно это делается. Как ни удивительно, среди превосходных примеров, поясняющих многие аспекты программирования на Delphi, нет ни одного консольного приложения. К счастью, создать консольное приложение на Delphi не так уж сложно, хотя при этом желательно знать пару тонких моментов. (Метод проб и ошибок - не самый эффективный способ обучения!)
Простейшее консольное приложение - это, конечно же, программа «Hello World». Выглядит она не особо эффектно, но обычно я начинаю освоение всех новых программных средств именно с нее. Дело в том, что с помощью «Hello World» можно кое-что узнать о новой среде, не заботясь о содержании программы. После того как мы напишем на Delphi простейшее консольное приложение, его код можно будет отправить в хранилище объектов и пользоваться им как отправной точкой для создания других аналогичных проектов.
Консольный ввод/вывод
При запуске консольного приложения с окном консоли автоматически связываются стандартные текстовые файлы Input и Output. В результате процедуры ReadLn и WriteLn работают именно так, как вы ожидаете, - равно как процедуры Eof, Eoln, Read, Write и все остальные средства ввода/вывода для текстовых файлов.
Существует целый ряд консольных функций ввода/вывода, которые время от времени оказываются полезными. К сожалению, эти функции определены в консольном интерфейсе Windows, и в Delphi не существует никакой удобной оболочки, которая скрывала бы от нас все отвратительные техниче ские подробности (кстати, напрашивается отличный shareware-проект для талантливого программиста- класс Delphi, инкапсулирующий консольный интерфейс Windows). Консольный интерфейс Windows сам по себе требует отдельной главы, поэтому сейчас я обойду его деликатным молчанием. Если вы захотите побольше узнать о PeekConsoleInput, WriteConsole и других функциях консольного API, обратитесь к разделу Console Reference файла WIN32.HLP из подкаталога Help Delphi. Программа установки не создает ссылку на этот файл, так что вам придется самостоятельно найти и загрузить его.
Из-за недостатка места для полноценного обсуждения консольного API работа с консолью в нашем приложении будет ограничена стандартными функциями файлового ввода/вывода. Поймите меня правильно - функции консольного API могут принести пользу во многих приложениях, но только не в тех, которые обычно пишутся как консольные. Да, я знаю, что это звучит довольно странно, но, похоже, консольный API больше подходит для GUI-программ, управляющих консольными окнами, а не для обычных консольных приложений, которые работают сами по себе.
Возможности консольных приложений не ограничиваются унылым текстовым интерфейсом. Поскольку у вас имеется полный доступ к Windows API, вы можете отображать окна сообщений и диалоговые окна, управлять работой других окон и даже создавать другие консольные окна из своего приложения.
Копирование экрана
Для копирования изображений, находящихся в клиентской части формы,
в Delphi используется метод GetFormImage. Но иногда бывает нужно «сфотографировать» всю форму вместе с заголовком, рамкой и т. д. или даже весь экран. В крайнем случае можно выдать окно сообщения «НЕМЕДЛЕННО нажмите клавишу Print Screen!» и потом как-нибудь вытащить копию экрана из буфера.
К счастью, дело обстоит не настолько плохо. Совместное использование холстов (canvas) Delphi с несколькими функциями GDI превращает копирова ние экрана в совершенно тривиальную задачу. Функция CaptureScreenRect (см. листинг 9.11) показывает, как это делается. Сначала мы получаем для экрана контекст устройства (DC) функцией GetDC(0), а затем копируем прямоугольную область из DC на холст растрового изображения. Копирование выполняется функцией BitBlt. Чтобы воспользоваться в Delphi функцией BitBlt (или любой другой функцией GDI), необходимо лишь помнить о том, что логический номер (handle) холста — это и есть DC, необходимый для вызова функций Windows.
Листинг 9.11. Модуль SCRNCAP.PAS
{ Функции копирования экрана в Delphi } unit ScrnCap; interface uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls; function CaptureScreenRect( ARect: TRect ): TBitmap; function CaptureScreen: TBitmap; function CaptureClientImage( Control: TControl ) : TBitmap; function CaptureControlImage( Control: TControl ) : TBitmap; implementation { Копирование прямоугольной области экрана... } 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; end; end; { Копирование всего экрана... } function CaptureScreen: TBitmap; begin with Screen do Result := CaptureScreenRect( Rect( 0, 0, Width, Height )); end; { Копирование клиентской области формы или элемента... } function CaptureClientImage( Control: TControl ) : TBitmap; begin with Control, Control.ClientOrigin do Result := CaptureScreenRect( Bounds( X, Y, ClientWidth, ClientHeight )); end; { Копирование всей формы или элемента... } function CaptureControlImage( Control: TControl ) : TBitmap; begin with Control do if Parent = nil then Result := CaptureScreenRect( Bounds( Left, Top, Width, Height )) else with Parent.ClientToScreen( Point( Left, Top )) do Result := CaptureScreenRect( Bounds( X, Y, Width, Height )); end; end.Остальные функции копирования экрана в листинге 9.11 лишь определяют нужные прямоугольники, а всю основную работу оставляют на долю CaptureScreenRect. Функция CaptureScreen определяет прямоугольник для всего экрана, а CaptureClientImage и CaptureControlImage — прямоугольники для клиентской области и всего элемента соответственно.
С помощью этих четырех функций можно «сфотографировать» любую часть экрана — например, получить экранные изображения форм, кнопок, memo-полей, выпадающих списков и т. д. Только не забудьте сказать: «А сейчас вылетит птичка…» и уничтожить растры после того, как надобность в них отпадет.
Краткое содержание
Предисловие
Глава 1. 32-разрядные консольные приложения
Глава 2. 32-разрядные DLL в Delphi- когда, зачем и как
Глава 3. Перетаскивание: как это делается в Windows
Глава 4. Перетаскивание: как это делается в OLE
Глава 5. Компонент Winsock в Delphi
Глава 6. CsShopper: FTP-клиент
Глава 7. FTP-сервер
Глава 8. Трехмерные фрактальные ландшафты
Глава 9. Проблемы TPersistent и несколько полезных советов
Глава 10. Модели, виды и фреймы
Глава 11. Таинственный модуль Math
Глава 12. Динамический пользовательский интерфейс
Глава 13. Иерархические структуры в реляционных базах данных
Глава 14. Пропавший оракул
Глава 15. Улика, найденная в грязи
Глава 16. Возвращение оракула
Глава 17. Нестареющая проблема
Критика
Вам никогда не хотелось вернуться к уже законченному проекту и переделать его заново? Нет, дело даже не в том, что наш шаблон фильтра чем-то плох. Просто сейчас я оглядываюсь назад и думаю о том, что многое можно было сделать по-другому.
В целом шаблон получился вполне приличным, и я уже воспользовался им при написании нескольких программ, от самых примитивных до чрезвычай но полезного потокового редактора.
Пожалуй, требования к командной строке получились излишне строгими - все параметры должны указываться с помощью префиксов, не поддерживается работа с конфигурационными файлами. С одной стороны, это не так уж страшно, зато программирование заметно упрощается. С другой стороны, поддержка конфигурационных файлов была бы нелишней, и благодаря структуре нашей программы реализовать ее не так уж сложно. Единственное, что мне еще хотелось бы изменить (и то из чисто косметических соображений) - использование типа ShortString для строковых параметров и имен файлов. Вероятно, PString или PChar будет работать более эффективно.
С TFilterFile дело обстоит иначе. Этот класс реализует абсолютный минимум функций, необходимых для файлового ввода/вывода. Вероятно, вы уже заметили, что в нем отсутствует механизм блочного чтения/записи, а также возможность произвольного доступа к файлам1. Многие программы-фильтры используют одну или обе из этих возможностей. Блочные операции реализуются довольно просто - следует лишь воспользоваться нетипизиро ванным параметром var и счетчиком байтов по аналогии со стандартными процедурами BlockRead и BlockWrite. Эти процедуры должны выполнять блочный обмен данными между пользовательской структурой и буфером объекта. Не забудьте реализовать чтение и запись в файл в случае необходимости.
1Все перечисленные функции (кроме автоматической буферизации) реализованы в файловом потоке TFileStream, описанном в модуле Classes. - Примеч. ред.
Для операций GetByte и PutByte я воспользовался методами, а не свойства ми. С минимальными изменениями в TFilterFile можно было определить два свойства:
property InByte : byte read GetByte;
property OutByte : byte write PutByte;
а заодно превратить в свойство и Eof. Такое изменение выглядит привлека тельным в некоторых отношениях, но мне не понравилась перспектива остаться без кода возврата при вызове функции вывода. В итоге я решил оставить все три функции в виде методов. Кроме того, можно было организо вать обработку исключений ввода/вывода в блоке try/finally.
Лично меня огорчает, что байтовое значение, возвращаемое GetByte, приходится явно преобразовывать в символьный тип. Конечно, в класс TFilterFile можно было включить методы GetChar и PutChar, но черт побери! Символ - это байт, и я буду обращаться с ним, как с байтом 1. Это один из случаев, когда C ведет себя более разумно, а Object Pascal страдает излишними ограничения ми. Редко, но случается и такое. Наверное, в преобразовании типов нет ничего страшного, но я стараюсь избегать их, потому что в программировании они считаются моветоном. В сущности, вы говорите компилятору: «Да, я и сам знаю, что нарушаю правила. Заткнись и делай, что велено». Я предпочитаю избегать подобных ситуаций.
1Не следует только забывать, что на смену кодировкам OEM и ANSI постепенно приходит система Unicode, где символ - уже не байт, а слово (в Delphi - тип данных WideChar). - Примеч. ред.
|
Кто находится по этому адресу?
Мы поближе познакомимся с асинхронным режимом на примере определения имени хоста по Internet-адресу функцией WSAAsyncGetHostByAddr. Чтобы воспользоваться функцией в приложении RESOLVER32, установите переключатель NonBlocking в групповом поле TypeOfLookUp и введите Internet-адрес в текстовом поле edIPName.
Как и ранее, имя передается свойству HostName для обработки с помощью метода TCsSocket.SetAsyncHostName. Если переданное имя является пустой строкой, SetRemoteHostName присваивает флагу FStatus значение Failure и вызывает процедуру ErrorEvent, которая посылает сообщение об ошибке. Затем вызывается другой обработчик ошибок, LookUpEvent, который сообщает RESOLVER32 о неудачной попытке поиска и завершается. Убедившись, что FRemoteName не является пустой строкой, мы вызываем метод SetAsyncHostName, в котором функция inet_addr определяет, соответствует ли строка символьному имени или IP-адресу с точками-разделителями. Код возврата, отличный от INADDR_NONE, свидетельствует о том, что строка соответствует формату IP-адреса.
Затем эта строка передается WSAAsyncGetHostByAddr, чтобы получить информацию о хосте для данного Internet-адреса. При успешном вызове WSAAsyncGetHostByAddr свойству FTaskHandle присваивается положительное число, но это вовсе не гарантирует, что после завершения WSAAsyncGetHostByAddr также будет получен верный результат. Метод возвращает управление приложению RESOLVER32, и поиск продолжается в фоновом режиме.
Winsock DLL сообщает CsSocket о завершении поиска, инициируя событие ASYNC_EVENT. При этом вызывается метод TCsSocket.AsyncOperation, в котором просматривается значение переменной Mess. Если Mess содержит информацию об ошибке, метод AsyncOperation вызывает ErrorEvent, чтобы выдать сообщение о причине ошибки из WSAErrormsg, присваивает флагу FStatus значение Failure и завершается.
Если переменная Mess не содержит сведений об ошибках, оператор case анализирует поле FAsyncType. В данном случае FAsyncType имеет значение AsyncAddr, поэтому в результате выполняется фрагмент кода, уже знакомый нам по случаю AsyncName. Затем после анализа FAddress выполняется фрагмент, обрабатывающий результат WSAAsyncGetHostByAddr. Значение FAddress автоматически устанавливается методом SetAsyncHostName в соответствии с результатом операции inet_addr. Другими словами, FAddress получает значение IPAddr, если будет найден IP-адрес с точками-разделителями, и HostAddr в противном случае (то есть для символьного имени). Затем имя хоста извлекается с помощью следующего фрагмента кода:
Move(FHost^.h_addr_list^, Fh_addr, SizeOf(FHost^.h_addr_list^));
FAsyncRemoteName:= StrPas(FHost^.h_name));
Результат передается приложению через обработчик события OnLookUp.
Масштабирование форм
Мститель открыл новый пакет чипсов и набил рот. Он решил не возвращаться в контору Брейкпойнта. Это было рискованно, но скорее всего, ничего страшного не произойдет. Шансы на то, что бывший сыщик сможет найти случайно оставленную улику, близки к нулю. Лучше как можно быстрее впитать побольше информации.
Дневник №16, 25 марта. Меня часто интересовало, как некоторые приложения ограничивают минимальный размер масштабируемого окна. Я решил узнать, как это делается. Мне даже в голову не приходило, как это просто. Тем не менее я заподозрил, что это должно иметь какое-то отношение к сообщениям. К тому времени я уже понял, что все, происходящее в Windows, связано с сообщениями.
Кроме того, меня заинтриговала способность некоторых сложных форм сохранять гармонию расположения своих компонентов даже при масштаби ровании формы. Этот вопрос также вошел в программу сегодняшнего расследования.
Мне нужна была форма с четырьмя компонентами как минимум . Я создал набросок формы, содержащей оперативную кнопку (TSpeedButton), поле Memo и две обычные кнопки (см. рис. 15.1). Прежде всего я решил ограничить пределы масштабирования минимальным размером формы, который должен задаваться программистом. Решение скрывалось в сообщении WM_GETMINMAXINFO.
Рис. 15.1. Форма для демонстрации масштабирования, изображенная в режиме конструирования
С помощью сообщения WM_GETMINMAXINFO приложение узнает о том, что система проверяет размер окна, и имеет возможность изменить параметры,
принятые по умолчанию. Среди этих параметров — значения, определяющие интервалы, в которых должен находиться размер окна. По умолчанию минимальный размер совпадает с размером значка (icon), а максимальный — с размером всего экрана.
Фактический параметр, передаваемый обработчику WM_GETMINMAXINFO, представляет собой точку, которая определяет смещения X, Y (в пикселях) от левого верхнего угла окна.
Следовательно, мне потребуется написать свой обработчик и определить в нем точки, описывающие минимальный и максимальный размер окна. Прежде всего я объявил переменные для минимальной высоты и ширины, чтобы упростить манипуляции с этими величинами.
Затем потребовалось определить точку, представляющую правый нижний угол формы. Параметр lParam стандартного обработчика WM_GETMINMAXINFO является указателем на массив из пяти структур-точек. К счастью, волшебники из Borland предусмотрительно создали тип сообщения TWMGetMinMaxInfo, избавляющий вас от многих трудностей.
В листинге 15.1 приведен полный исходный текст программы, в которой я экспериментировал с масштабированием. Листинг содержит обработчик, получившийся после нескольких неудачных попыток (удивительно, какие «интересные» эффекты могут возникнуть, если забыть о некоторых мелочах — например, о вызове унаследованного обработчика). Как видно из листинга, через структуру MinMaxInfo можно получить быстрый и удобный доступ к точкам, определяемым ptMinTrackSize и ptMaxTrackSize. Я вставил в обработчик OnCreate формы небольшой фрагмент для вычисления MinWidth и MinHeight на основании размеров компонентов в момент запуска.
Листинг 15.1. Исходный текст программы для демонстрации
масштабирования формы
Настало время поиграть с взаимным расположением компонентов, чтобы оно сохранялось даже при масштабировании формы, на которой они находятся.
Когда я только начинал работать с панелями, они приносили мне немало хлопот. Но, познакомившись с ними поближе, я просто влюбился в три замечательные возможности, которыми они обладают. Во-первых, с помощью свойства Alignment можно установить абсолютную связь панели с родитель ским объектом; например, если задать свойству Alignment значение alTop, панель будет занимать всю верхнюю часть формы, на которой она находится. Во-вторых, положение прочих компонентов (полей Memo, кнопок и т. д.), находящихся на панели, остается фиксированным по отношению к панели, пока ее размеры остаются прежними. Наконец, панель, расположенная на другой панели, ведет себя так же, как и панель, находящаяся на форме: например, если свойство Alignment имеет значение alBottom, внутренняя панель «приклеивается» к нижней части внешней панели и занимает всю ее ширину.
Такое поведение и позволяет сохранять общий вид формы при масштаби ровании. Создавая форму, изображенную на рис. 15.1, я преследовал несколько целей:
| панель Panel3 должна иметь фиксированную высоту и занимать всю верхнюю часть формы, чтобы ее ширина всегда совпадала с шириной самой формы; |
| оперативная кнопка SB1 должна оставаться в фиксированном положении по отношению к левому краю Panel3 (и, как следствие, к левому верхнему углу окна); |
| панель Panel4 должна выравниваться по правому краю Panel3, чтобы при изменении размера Panel3 она сохраняла постоянный размер, но следовала за правым краем Panel3; |
| панель Panel5 (содержащая поле Memo1) должна выравниваться по левой стороне формы, а ее высота должна зависеть от высоты формы; |
| панель Panel1 (содержащая панель Panel2) должна выравниваться по правому краю формы, а ее высота должна зависеть от высоты формы; |
| панель Panel2 (содержащая кнопки Button1 и Button2) должна выравнивать ся по нижнему краю Panel1, чтобы при масштабировании она сохраняла постоянный размер и следовала за нижним краем Panel1 (а следовательно, и всей формы); |
| кнопки Button1 и Button2 должны находиться в фиксированных позициях панели Panel2Panel2, чтобы сохранялось их положение по отношению к нижнему и правому краю формы. |
Уф! Мне пришлось потрудиться, задавая свойства разных панелей. Работа с панелями может вызвать некоторые трудности, пока вы не усвоите «правила хорошего тона». Значения alTop и alBottom свойства Alignment всегда имеют более высокий приоритет по сравнению с alLeft и alRight. В конце концов для Panel3 я задал значение alTop, для Panel1 и Panel4 — значение alRight, для Panel5 — alLeft, а для Panel2 — alBottom. Свойствам BevelOuter панелей Panel4 и Panel2 были присвоены значения bvNone, чтобы они «исчезли» и не выделялись на форме. Для панелей Panel3 и Panel4 был выбран цвет clGray, это позволило наглядно отделить их от других компонентов. Кроме того, я поместил на Panel4 комбини рованное поле и оперативную кнопку, чтобы убедиться в сохранении их положения. Наконец, я переименовал панели и убрал их заголовки.
Я решил, что ширина внешней панели с кнопками (ранее называвшейся Panel1)останется прежней, а панели с полем Memo нужно позволить заполнять оставшуюся часть формы. Кроме того, я автоматически изменяю размеры поля Memo1, чтобы оно занимало всю площадь внешней панели, оставляя лишь небольшие поля с каждого края. Мне удалось проделать это с помощью простых вычислений в обработчике OnResize формы.
После нескольких попыток все заработало, как надо. На рис. 15.2 изображена демонстрационная форма при запуске программы; на рис. 15.3 показано, как выглядит та же форма после масштабирования.
Конец записи (25 марта).
Рис. 15.2. Форма при запуске программы
Рис. 15.3. Та же форма после масштабирования
Масштабирование элементов
Масштабировать элементы еще проще, чем перемещать их. За образец мы снова возьмем соответствующий механизм режима конструирования Delphi. Чтобы изменить размер выделенного элемента, вы щелкаете на одном из черных квадратиков-маркеров, расположенных по краям элемента, и перетаскиваете его до тех пор, пока измененные размеры элемента вас не устроят.
Аналогичный способ будет использован и в нашем случае. Единственное отличие заключается в том, что для простоты (и для уменьшения объема кода) мы ограничимся лишь одним из восьми возможных маркеров.
Поскольку класс TSizingRect уже используется для перемещения элемента, он поможет нам и при масштабировании. Правый нижний угол TSizingRect назначается «активной областью», на которой пользователь будет щелкать для масштабирования элемента.
Кроме того, для упрощения дизайна мы обозначим «активную область» маленьким белым квадратиком и будем изменять вид курсора всякий раз, когда он проходит над ним. Вся настоящая работа выполняется в обработчике MouseMove, полностью приведенном в листинге12.3. Код обработчика подробно рассматривается в последующем тексте.
Листинг 12.3. Обработчик события MouseMove для объекта SizingRect
procedure TFrmMain.SizingRect1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin { ControlDC и ControlRect - глобальные переменные, используемые в нескольких процедурах. } ControlDC := GetDC(TWinControl(Sender).Handle); GetWindowRect(TWinControl(Sender).Handle, ControlRect); if ((X > TControl(Sender).Width -SizeVal) and (Y > TControl(Sender).Height -SizeVal)) then begin TWinControl(Sender).Cursor := crSizeNWSE; Rectangle(ControlDC, TWinControl(Sender).Width - SizeVal, TControl(Sender).Height -SizeVal, TControl(Sender).Width, TControl(Sender).Height); end else begin TWinControl(Sender).Cursor := crDefault; end; if ((TWinControl(Sender).Cursor = crSizeNWSE) and (ssLeft in Shift)) then begin TWinControl(Sender).Width := X; TWinControl(Sender).Height := Y; end; end;
После подготовки переменных обработчик проверяет, находится ли курсор в пределах области масштабирования. Константа SizeVal, определяющая размеры белого маркера, определена в модуле DynamicForm. Если курсор находится внутри области, обработчик изменяет его внешний вид и, конечно, рисует прямоугольник:
if ((X > TControl(Sender).Width -SizeVal) and (Y > TControl(Sender).Height -SizeVal)) then begin TWinControl(Sender).Cursor := crSizeNWSE; Rectangle(ControlDC, TWinControl(Sender).Width - SizeVal, TControl(Sender).Height -SizeVal, TControl(Sender).Width, TControl (Sender).Height); endЕсли курсор находится за пределами области масштабирования, мы просто восстанавливаем его вид по умолчанию:
else begin TWinControl(Sender).Cursor := crDefault; end;Наконец, мы проверяем, продолжает ли пользователь масштабировать элемент. Если используется курсор crSizeNWSE и нажата левая кнопка мыши, значит, масштабирование продолжается. В этом случае обработчик перемещает правый нижний угол элемента за курсором:
if ((TWinControl(Sender).Cursor = crSizeNWSE) and (ssLeft in Shift)) then begin TWinControl(Sender).Width := X; TWinControl(Sender).Height := Y; end; end;Пока кнопка мыши остается нажатой, а курсор находится над активной областью, угол элемента перемещается вслед за курсором.
Мне, пожалуйста, вот это…
Разумеется, raison d'кtre всего протокола FTP — пересылка файлов, поэтому нет ничего удивительного в том, что из полного набора FTP-команд чаще всего используются команды выборки и сохранения RETR и STOR. Команда RETR предназначена для получения файла с сервера, а STOR— для принятия и сохранения сервером файла, передаваемого клиентом.
При получении команды RETR процедура DecodeFTPCmd анализирует переданную командную строку, и с помощью кода, расположенного в ветви RETR большого оператора case, извлекает из нее имя передаваемого файла. Полученное имя передается процедуре SendFile, которая и выполняет пересылку. Чтобы обеспечить прием файла FTP-клиентом, CsKeeper вызывает SendFTPCode с кодом 150, сообщая тем самым клиенту о необходимости прослушивания данных на ранее заданном порте.
В самой пересылке файла нет ничего сверхъестественного. SendFile создает локальный сокет с именем LocalSocket и затем вызывает функцию connect, чтобы открыть соединение данных. После установки соединения CsKeeper открывает файл, из которого должны читаться передаваемые данные. Процедура BlockRead в цикле repeat…until читает данные блок за блоком, а функция send передает их. Когда данных для пересылки не остается, CsKeeper закрывает файл и уничтожает соединение данных, вызывая closesocket для закрытия сокета LocalSocket. Затем CsKeeper вызывает SendFTPCode, чтобы передать FTP-клиенту код ответа 226, сообщающий о том, что передача файла завершена.
Модели, виды и фреймы
Джон Шемитц
В этой главе развивается творческий подход к функциональности программ, который позволяет внедрять одну форму внутрь другой. Новые интерфейсы Delphi3 заметно упрощают эту задачу.
В число достоинств Delphi входит и упрощение многих аспектов работы с Windows API. В результате объемистый и неуклюжий код сокращается до простого оператора присваивания, а невообразимо сложное становится совсем тривиальным. Вероятно, самым знакомым примером для вас окажется свойство Canvas; кроме того, заслуживает внимания и свойство Parent. Задавая значение свойства Parent, вы сообщаете Windows о том, что элемент становится дочерним окном нового родителя Parent. Отныне он будет появляться на экране одновременно со своим окном-родителем. (Кстати, именно так работают диалоговые окна со вкладками: каждая страница фактически представляет собой панель. Все компоненты, находящиеся на ней, являются дочерними по отношению к вкладке. Когда вкладка переходит на передний план (поверх других вкладок), вместе с ней появляются и все ее компоненты.) Задание свойства Parent во время выполнения программы позволяет добиться разнообразных специальных эффектов — от динамического создания элементов типа вкладок до включения одной формы в пустую область другой.
Когда могут пригодиться внедренные формы? Рассмотрим четыре возможных сценария:
Вы занимаетесь созданием программ-мастеров (wizards), руководящих действиями пользователя при создании объектов. Кроме того, вы хотите предоставить пользователям список свойств объекта в виде диалогового окна со вкладками, чтобы позволить изменять любое свойство объекта, не проходя заново все этапы работы с мастером. Единственное отличие между мастером и списком свойств заключается в том, что мастер разрешает пользователю перейти только от текущей страницы к следующей (и лишь при условии ввода правильных данных), а вкладки списка свойств можно перебирать в произвольном порядке. Следовательно, вкладка списка свойств на рис. 10.1 содержит точно такой же набор данных объекта, как и страница мастера на рис. 10.2. Если страницы мастера будут обслуживаться тем же кодом, что и вкладки списка свойств, поведение этих объектов всегда будет согласованным.
Рис. 10.1. Мастер, использующий код для просмотра данных совместно
со списком свойств на рис. 10.2
Рис. 10.2. Список свойств, использующий код для просмотра
данных совместно с мастером на рис. 10.1
Первые два варианта имеют много общего. У нас имеются объекты и стандартные способы для их просмотра и изменения — модели (models) и виды (views). Все, что вам теперь нужно — это фрейм. Фрейм (frame) может содержать любой вид. При отображении фрейма отображается и находящийся в нем вид. Один и тот же вид можно поместить в несколько фреймов. Виды, в свою очередь могут исполнять функции фрейма для видов внедренных или подчиненных объектов.
Фреймы прекрасно подходят и для третьего сценария. Если на каждой вкладке окна будет находиться отдельный фрейм, у вас получится обобщенное диалоговое окно со вкладками, которое может содержать любые виды по вашему усмотрению. Из громоздкого набора ничем не связанных (по крайней мере потенциально) фрагментов модуль формы превращается в простой контейнер с кодом для заполнения каждого фрейма и, возможно, кодом OnChanging, в котором активный фрейм спрашивает у своего вида, можно ли переключиться на другую вкладку. Большое диалоговое окно со вкладками можно разделить на несколько модулей, чтобы каждый участник команды мог самостоятельно следить за обновлением своего кода. Вы забудете о таких неприятностях, как потеря обновлений или повторное появление уже исправленных ошибок из-за неаккуратного объединения версий.
Аналогично форма для редактирования объектов иерархии из четвертого сценария может содержать несколько элементов для операций, применимых ко всем членам иерархии, и фрейм для размещения вида, специфического для конкретного объекта (можно сделать так, чтобы объект сам сообщал форме, какой вид следует использовать). Чтобы перейти от одного типа объекта к другому, достаточно поместить во фрейм другой вид.
Модуль WalkStuf
После нескольких часов «зависаний» и множества фальстартов я написал модуль, приведенный в листинге15.7. Он содержит несколько процедур общего назначения, заметно упрощающих составление списков модулей и процедур в Win95.
Листинг 15.7. Исходный текст модуля WalkStuf
{——————————————————————————————————————————————————————} { Демонстрационная программа для сбора информации } { о системе } { WALKSTUF.PAS : Служебный модуль } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Модуль содержит процедуры для получения информации } { от модуля TlHelp32. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 23/4/97 } {——————————————————————————————————————————————————————} unit WalkStuf; interface uses Windows, Classes, Dialogs, SysUtils, TLHelp32; const ws_FullPath = True; ws_NoDirectory = False; ws_Unique = True; ws_DupesOK = False; ws_InstanceCount = True; ws_NoInstanceCount = False; function GetSystemProcessList(FullPath : Boolean; Unique : Boolean) : TStringList; function GetSystemModuleList(FullPath : Boolean; Unique : Boolean; IncludeData : Boolean) : TStringList; function GetProcessModules(ProcName : String; FullPath : Boolean; IncludeData : Boolean) : TStringList; function GetLocalModuleList : TStringList; function ModuleSysInstCount (ModuleName : String) : Integer; implementation { Возвращает строку, удаляя из нее информацию о файловом пути. } function ChopPath(PathName : String) : String; var s : String; begin s := PathName; if Length(s) > 0 then begin while Pos(':', s) > 0 do Delete(s, 1, Pos(':', s)); while Pos('\', s) > 0 do Delete(s, 1, Pos('\', s)); Result := s; end else Result := ''; end; { Возвращает список строк с именами всех активных процессов в системе. } function GetSystemProcessList (FullPath : Boolean; Unique : Boolean) : TStringList; var AList : TStringList; ProcHandle : THandle; AProcEntry : TProcessEntry32; begin AList := TStringList.Create; Result := AList; AList.Sorted := True; if Unique then AList.Duplicates := dupIgnore else Alist.Duplicates := dupAccept; ProcHandle := CreateToolHelp32Snapshot (TH32CS_SNAPPROCESS, 0); if ProcHandle = -1 then Exit; AProcEntry.dwSize := sizeof(TProcessEntry32); if Process32First(ProcHandle, AProcEntry) then begin { Добавить первый процесс } if FullPath then AList.Add(AProcEntry.szExeFile) else AList.Add(ChopPath(AProcEntry.szExeFile)); { Добавить все остальные процессы } while Process32Next(ProcHandle, AProcEntry) do if FullPath then AList.Add(AProcEntry.szExeFile) else AList.Add(ChopPath(AProcEntry.szExeFile)); end; CloseHandle(ProcHandle); end; { Возвращает строковый список с именами всех активных модулей во всех процессах. } function GetSystemModuleList(FullPath : Boolean; Unique : Boolean; IncludeData : Boolean) : TStringList; var s : String; AList : TStringList; ProcHandle : THandle; ModHandle : THandle; AProcEntry : TProcessEntry32; AModEntry : TModuleEntry32; begin AList := TStringList.Create; Result := AList; AList.Sorted := True; if Unique then AList.Duplicates := dupIgnore else Alist.Duplicates := dupAccept; ProcHandle := CreateToolHelp32Snapshot (TH32CS_SNAPPROCESS, 0); if ProcHandle = -1 then Exit; AProcEntry.dwSize := sizeof(TProcessEntry32); AModEntry.dwSize := sizeof(TModuleEntry32); if Process32First(ProcHandle, AProcEntry) then begin { Обработка первого процесса } ModHandle := CreateToolHelp32Snapshot (TH32CS_SNAPMODULE, AProcEntry.th32ProcessID); if Module32First(ModHandle, AModEntry) then begin { Обработка первого модуля первого процесса } if IncludeData then s := '<' + IntToStr(AModEntry.GlblcntUsage) else s := ''; if FullPath then s := AModEntry.szExePath + s else s := AModEntry.szModule + s; AList.Add(s); { Обработка остальных модулей первого процесса} while Module32Next(ModHandle, AModEntry) do begin if IncludeData then s := '<' + IntToStr(AModEntry.GlblcntUsage) else s := ''; if FullPath then s := AModEntry.szExePath + s else s := AModEntry.szModule + s; AList.Add(s); end; CloseHandle(ModHandle); { Обработка оставшихся процессов } while Process32Next(ProcHandle, AProcEntry) do begin ModHandle := CreateToolHelp32Snapshot(TH32CS_SNAPMODULE, AProcEntry.th32ProcessID); if Module32First(ModHandle, AModEntry) then begin { Обработка первого модуля текущего процесса } if IncludeData then s := '<' + IntToStr(AModEntry.GlblcntUsage) else s := ''; if FullPath then s := AModEntry.szExePath + s else s := AModEntry.szModule + s; AList.Add(s); { Обработка оставшихся модулей текущего процесса } while Module32Next(ModHandle, AModEntry) do begin if IncludeData then s := '<' + IntToStr(AModEntry.GlblcntUsage) else s := ''; if FullPath then s := AModEntry.szExePath + s else s := AModEntry.szModule + s; AList.Add(s); end; end; CloseHandle(ModHandle); end; { while } end; end; CloseHandle(ProcHandle); end; { Возвращает строковый список с именами всех активных модулей текущего процесса. } function GetLocalModuleList : TStringList; var AList : TStringList; ModHandle : THandle; AModEntry : TModuleEntry32; begin AList := TStringList.Create; AList.Sorted := True; Result := AList; ModHandle := CreateToolHelp32Snapshot (TH32CS_SNAPMODULE, 0); if ModHandle = -1 then Exit; AModEntry.dwSize := sizeof(TModuleEntry32); if Module32First(ModHandle, AModEntry) then begin { Добавляем первый модуль } AList.Add(AModEntry.szModule); { Добавляем остальные модули } while Module32Next(ModHandle, AModEntry) do AList.Add(AModEntry.szModule); end; CloseHandle(ModHandle); end; { Возвращает список строк с именами всех активных модулей процесса с заданным именем. } function GetProcessModules(ProcName : String; FullPath : Boolean; IncludeData : Boolean) : TStringList; var s : String; Found : Boolean; Done : Boolean; AList : TStringList; ProcHandle : THandle; ModHandle : THandle; AProcEntry : TProcessEntry32; AModEntry : TModuleEntry32; begin AList := TStringList.Create; Result := AList; AList.Sorted := True; ProcHandle := CreateToolHelp32Snapshot (TH32CS_SNAPALL, 0); if ProcHandle = -1 then Exit; AProcEntry.dwSize := sizeof(TProcessEntry32); AModEntry.dwSize := sizeof(TModuleEntry32); if Process32First(ProcHandle, AProcEntry) then begin { Просматриваем процессы, пока не будет найдено совпадение } Found := UpperCase(AProcEntry.szExeFile) = UpperCase(ProcName); if not Found then repeat Done := not Process32Next(ProcHandle, AProcEntry); if not Done then Found := UpperCase(AProcEntry.szExeFile) = UpperCase(ProcName); until Done or Found; if Found then begin ModHandle := CreateToolHelp32Snapshot(TH32CS_SNAPMODULE, AProcEntry.th32ProcessID); if Module32First(ModHandle, AModEntry) then begin { Обработка первого модуля первого процесса } if IncludeData then s := '<' + IntToStr(AModEntry.GlblcntUsage) else s := ''; if FullPath then s := AModEntry.szExePath + s else s := AModEntry.szModule + s; AList.Add(s); { Обработка остальных модулей первого процесса } while Module32Next(ModHandle, AModEntry) do begin if IncludeData then s := '<' + IntToStr(AModEntry.GlblcntUsage) else s := ''; if FullPath then s := AModEntry.szExePath + s else s := AModEntry.szModule + s; AList.Add(s); end; end; CloseHandle(ModHandle); end; end; CloseHandle(ProcHandle); end; { Возвращает количество экземпляров заданного модуля во всех процессах системы. } function ModuleSysInstCount(ModuleName : String) : Integer; var Idx : Integer; p : Integer; s : String; ModList : TStringList; MatchFound : Boolean; begin Result := -1; ModList := GetSystemModuleList(ws_NoDirectory, ws_DupesOK, ws_InstanceCount); if ModList = nil then Exit; Idx := 0; p := 0; MatchFound := False; while (Idx < ModList.Count) and not MatchFound do begin s := ModList.Strings[Idx]; p := pos('<', s); MatchFound := Uppercase(copy(s, 1, p - 1)) = Uppercase(ModuleName); if not MatchFound then Inc(Idx); end; { while } if MatchFound then Result := StrToInt(copy(s, p + 1, Length(s) - p)) else Result := 0; end; end.Модуль WalkStuf содержит пять полезных функций, заметно облегчающих дальнейшие исследования. GetSystemProcessList возвращает список строк с именами всех активных процессов в системе. Предусмотрена возможность вывода только имени процесса (без полного пути) и подавления множественных экземпляров одного процесса. GetSystemModuleList возвращает список строк с именами всех модулей во всех процессах. Предусмотрены аналогичные возможности для подавления информации о пути и множественных экземпля рах; кроме того, в каждую строку можно дополнительно включить количество экземпляров каждого модуля, существующих в системе. GetProcessModules возвращает список строк с именами всех модулей заданного процесса. GetLocal ModuleList создает список модулей, принадлежащих только заданному процессу. Наконец, ModuleSystemCount возвращает целое число, равное количеству экземпляров заданного модуля в системе.
Кое-что в функциях модуля WalkStuf заслуживает особых пояснений. GetSystemProcessList показывает, как происходит перебор процессов из списка. Переменной ProcHandle присваивается логический номер области внутри KERNEL32, подготовленной для хранения списка всех процессов. Затем полю dwSize записи TProcessEntry32 (предназначенной для хранения информации о процессе) присваивается размер этого типа данных (на первый взгляд это кажется почти глупым, но на самом деле критически важно для правильной работы!). Затем вызывается Process32First с параметрами ProcHandle (информация из KERNEL32) и AProcEntry (это переменная для хранения данных).
Если Process32First возвращает True, значит, информация о первом процессе из списка была скопирована в поля AProcEntry. Вероятно, наибольший интерес представляют поля szExeFile и th32ProcessID. Первое содержит строку с полным путем к EXE-файлу, создавшему процесс. Второе содержит уникальный идентификатор изучаемого процесса, который можно передавать другим функциям ToolHelp. Вскоре об этом будет рассказано подробнее.
После того как szExeFile попадет в список строк, цикл while используется для многократных вызовов Process32Next. Эта функция вызывается с теми же параметрами, и если она возвращает True, значит, в AProcEntry были помещены данные следующего процесса (если вам приходилось пользоваться функциями FindFirst и FindNext под DOS, эта механика покажется знакомой). Когда перебор закончен, остается лишь выполнить последнюю задачу. Ведь вызов CreateToolHelp32Snapshot создал объект Win95, который необходимо уничтожить. Это делается с помощью вызова CloseHandle.
GetSystemModule представляет собой более сложный вариант перебора. Полный список модулей каждого процесса просматривается функциями Module32 First и Module32Next. Для каждого процесса CreateToolHelp32Snapshot возвращает логический номер. На этот раз при вызове используется уникальный идентификатор текущего изучаемого процесса (AProcEntry.th32ProcessID), благода ря чему полученный логический номер относится к информации о модулях, принадлежащих только указанному процессу. Обратите внимание на использование маски TH32CS_SNAPMODULE, которая ограничивает полученную информа цию сведениями о модулях.
Записи TModuleEntry32 содержат несколько полей. Для наших целей наиболь ший интерес представляют поля szExePath (строка, содержащая полный путь к модулю), szModule (строка с базовым именем модуля) и GlblcntUsage (двойное слово, содержащее количество экземпляров данного модуля в системе).
Снова обратите внимание на то, что в поле dwSize записи AModEntry необходимо указать размер записи TModuleEntry32, и что для каждого вызова CreateTool Help32Snapshot должен присутствовать парный вызов CloseHandle, уничтожаю щий созданный объект.
Все остальные функции в основном являются «вариациями на тему». Get LocalModuleList перебирает модули, принадлежащие только текущему процессу, для чего в качестве идентификатора процесса передается 0. GetProcessModules перебирает список модулей и ищет в нем заданный процесс. Если поиск окажется успешным, функция перебирает модули этого процесса. Наконец, Module SysInstCount с помощью вызова GetSystemModuleList получает список модулей для всей системы, из которого отбирает заданный модуль. Из строки, соответству ющей найденному модулю, она выбирает количество экземпляров и возвращает его в виде целого числа.
Мольба о помощи
Я подошел к телевизору, включил коммерческий канал (немного шума не повредит), взял свой последний Дневник и стал записывать события дня. Я успел записать всего два абзаца, когда зазвонил телефон.
— Брейкпойнт. Чем могу помочь?
— Мистер Брейкпойнт— слава Богу, что вы на месте! — послышалось из трубки. — Даже не знаю, что бы я делала, если бы не застала вас.
Несомненно, голос был женский, и в нем звучало неподдельное отчаяние. Обладательница голоса явно находилась в состоянии, близком к панике.
— Помедленнее, — сказал я. — Успокойтесь и подробно объясните, в чем дело.
— Я наследница, — ответила она почти срывающимся голосом. — Последнюю неделю меня повсюду преследует какой-то очень крупный мужчина. Думаю, он собирается похитить меня и потребовать выкуп. Несколько минут назад я остановилась у светофора, он выпрыгнул из своей машины и попытался силой открыть дверцу. Я тут же набрала скорость, и он потерял меня из виду, но может снова появиться в любую минуту. Ваше имя я нашла в телефонной книге. Мне больше не к кому обратиться.
— Ладно, не волнуйтесь, — сказал я уверенным тоном. — Вы можете описать этого типа? У него есть борода или усы?
— Не могу сказать, — ответила она. — Его лицо закрыто нейлоновым чулком.
— Со швом или без шва? — поинтересовался я.
— Пожалуй, без шва.
— Какого оттенка?
— Телесного. Нет, нет — скорее, песочного. О, я не знаю! Послушайте, мистер Брейкпойн т, — умоляла она. — Вы — моя единственная надежда. Он может появиться в каждую секунду. Приезжайте прямо сейчас.
— Держитесь, — сказал я. — Где вы находитесь?
— В телефонной будке на автостраде, возле «Эспрессо-бара Оле» и шинного магазина. Мне нужна ваша помощь…
Мое сердце дрогнуло — в трубке послышались звуки борьбы, удар, сдавленный крик и шипение пара, выходящего из кофеварки. Затем все стихло.
Часы показывали 22:30. Я швырнул Дневник на стол, схватил ключи, накинул плащ и помчался к машине. Проливной дождь смешался с наползающим туманом, таким густым, что я с трудом нашел свою машину, припаркованную в каких-то двадцати метрах от дома. Даже мощные лучи фар с трудом проникали сквозь водно-туманную завесу. Кусты, посаженные вокруг конторы, напоминали людей, стоящих в очереди на автобус. Я выехал со стоянки и кое-как выбрался на улицу, а затем выжал акселератор до упора.
На другом краю города
А в это время в убогой гостинице на другом краю города неприметная фигура скользнула из коридора в недавно снятый номер и заперла за собой дверь. Мелкими шагами пробираясь сквозь темноту, фигура добралась до небольшого письменного стола в углу. Щелкнул выключатель настольной лампы, и стол озарился теплым светом. Из внутреннего кармана длинного плаща фигура осторожно извлекла книгу в твердом кожаном переплете и, отпихнув в сторону несколько пакетов с гамбургерами, положила ее на стол. В свете, отраженном от поверхности стола, можно было разглядеть лишь часть лица между поднятым воротником и широкими полями грязно-коричневой шляпы: горящие, близко посаженные глаза и острый нос, который едва выступал над густыми, идеально ухоженными усами.
— Значит, это он и есть? — в голосе сквозило явное предвкушение удовольствия. — Ну-ка посмотрим….
Загадочная фигура уселась за стол, перевернула первую страницу и принялась читать выдержки из дневника Эйса Брейкпойнта.
На пути к гибким пользовательским интерфейсам
Для полноценного рассмотрения настраиваемых пользовательских интерфейсов одной главы явно недостаточно. Мы узнали, как предоставить пользователям контроль над большинством стандартных составляющих интерфейса (к ним относятся положение и размеры элементов, шрифты и порядок перебора, а также значения других свойств, отображаемые в коммерческом компоненте, предназначенном для редактирования свойств). Это трудно назвать даже поверхностным знакомством, особенно если учесть, что действительно хорошая система настройки пользовательского интерфейса сама должна обладать хорошим интерфейсом, руководить действиями пользователя и следить за тем, чтобы он случайно не нарушил работы приложения. Считайте эту главу отправной точкой, после которой вы сможете исследовать эту тему настолько глубоко, насколько понадобится вам (и вашим пользователям).
|
Наследование форм
Вместо использования описанной выше методики я создаю самые обычные формы, производные от TEmbeddedForm. Как видно из листинга 10.1 (фрагмент модуля EMBEDDED.PAS), у внедренных форм имеется специальный конструктор, позволяющий рассматривать их как элементы, которые можно разместить на любом элементе-контейнере (панели, вкладке или групповом поле) во время выполнения программы. Поскольку формы сами по себе являются объектами, вы можете по своему усмотрению добавить любые методы, необходимые для придания им функций видов. Поскольку такие элементы являются формами, внедренную форму при необходимости можно так же легко изменить, как и любую другую.
Листинг 10.1. Специальный конструктор для внедренных форм
type EmbeddedFormMode = (efmZoomed, efmTopLeft, efmCentered); function ALZ(Number: integer): Cardinal; // Проверка положительности begin if Number > 0 then Result := Number else Result := 0; end; constructor TEmbeddedForm.CreateEmbedded( _Owner: TComponent; Frame: TWinControl; Mode: EmbeddedFormMode ); begin Inherited Create(_Owner); Parent := Frame; BorderIcons := []; BorderStyle := bsNone; case Mode of efmZoomed: Align := alClient; efmTopLeft: begin Top := 0; Left := 0; end; // efmTopLeft efmCentered: begin Top := ALZ((Frame.Height - Height) div 2); Left := ALZ((Frame.Width - Width) div 2); end; // efmCentered else Assert(False); end; // case Visible := True; end; // TEmbeddedForm.CreateEmbeddedВ листинге 10.1 самой важной является строка Parent := Frame, которая назначает элемент Frame родителем внедренной формы. Именно это происходит «за кулисами» с обычными элементами управления при загрузке формы. Назначение родителя имеет три важных последствия. Во-первых, дочерний элемент отображается тогда, когда отображается его родитель. Следовательно, скрытие фрейма приводит к скрытию вида, а отображение фрейма или перевод его на передний план приводит к отображению вида. Во-вторых, дочерние элементы обрезаются по клиентской области родителя, поэтому большой вид автоматически вписывается в границы фрейма. Втретьих, дочерний элемент позиционируется относительно клиентской области своего родителя; свойства Top и Left для внедренной формы, как и для любого другого элемента, измеряются по отношению к содержащему его контейнеру.
Последнее означает, что при масштабировании внедренной формы установкой свойства Align равным alClient форма ведет себя так же, как и любой другой элемент, выровненный подобным образом: она заполняет собой весь фрейм и автоматически масштабируется (с вызовом обработчика OnResize) при масштабировании фрейма. Без масштабирования вид сохраняет размеры, заданные в режиме конструирования, и даже может быть выровнен по центру или помещен в левый верхний угол фрейма. Начальный размер вида можно привести в соответствие с начальным размером фрейма, для этого следует задать свойства ClientHeight и ClientWidth в режиме конструирования. Можно, наоборот, изменять размеры окна фрейма в соответствии с размерами внедренных форм, как это происходит в мастерах и списках свойств (см. раздел «Редакторы моделей» этой главы).
Пока листинг 10.1 находится под рукой, стоит пояснить смысл строк BorderIcons := [] и BorderStyle := bsNone. Они означают, что во время выполнения отображается лишь клиентская область формы вида — на ней нет ни заголовка, ни рамки, которые бы сообщали о том, что фрейм содержит независимую форму. Как видно из рис. 10.3 и 10.4, свойство Caption внедренной формы в режиме выполнения никак не проявляется.
Рис. 10.3. В режиме конструирования вид ничем
не отличается от обычной формы
Рис. 10.4. Во время выполнения вид не похож на форму От внедренных форм к видам
Несомненно, возможность использования форм как элементов — хорошее начало. Теперь мы можем разместить форму там, где считаем нужным, и сделать сколько угодно копий. В объект формы можно включить методы, благодаря которым форма начинает «вести себя» как вид.
Итак, как же ведут себя виды?
| Вид должен уметь читать данные от объекта модели и записывать их в этот объект. |
| Вид должен уметь проверить свою правильность — мастер обычно не разрешает пользователю перейти к следующей странице при наличии неправильных данных на текущей, а список свойств не позволяет сохранить неверные данные. С другой стороны, это требование не является обязательным — например, Memo-поле Примечания может содержать любую информацию или вообще быть пустым. |
| Вид должен иметь возможность сообщить своему фрейму об изменении свойства Valid, чтобы фрейм мог разрешить или запретить кнопки Next и OK. |
| Виду может понадобиться такое отображение данных, при котором пользователь не сможет их редактировать. Список свойств может быть доступен только для чтения, если текущему пользователю не разрешается редактировать объект модели или просто потому, что пользователь не заблокировал объект и редактирование может привести к возникновению конфликтов. |
Все эти «правила» отражены в листинге 10.2, который представляет собой выдержку из файла MODELS.PAS.
Листинг 10.2. Поведение модели, вида и фрейма
type TModel = TObject; // И IView, и IModelEdit обладают свойством ReadOnly IReadOnly = interface function GetReadOnly: boolean; procedure SetReadOnly(Value: boolean); property ReadOnly: boolean read GetReadOnly write SetReadOnly; end; // Заполнить вид по данным модели и записать изменения обратно; // взаимодействия фрейм/вид IFrame = interface; IView = interface (IReadOnly) procedure ReadFromModel(Model: TModel); procedure WriteToModel(Model: TModel); function GetValid: boolean; procedure SetValid(Value: boolean); property Valid: boolean read GetValid write SetValid; procedure AddNotifiee( Notify: IFrame); procedure RemoveNotifiee(Notify: IFrame); end; IFrame = interface procedure OnValidChanged( ChangingObject: TObject; View: IView ); end; // Мастера и списки свойств являются «редакторами моделей» IModelEdit = interface (IReadOnly) // Процедуры низкого уровня, которые позволяют // приложению один раз подготовить редактор // и несколько раз использовать его. procedure Initialize; function RunEditor(Model: TModel): boolean; procedure Finalize; // Initialize/RunEditor/Finalize function EditModel(Model: TModel): boolean; end;Наверное, вы догадываетесь, что мы имеем дело с достаточно простой архитектурой. Модели представляют собой абсолютно пассивные контейнеры данных, которые обычно создаются, загружаются и сохраняются в модуле данных. Виды могут читать и записывать модели по требованию, а также сообщать своим фреймам о правильности или неправильности ввода данных. Редакторы моделей (мастера и списки свойств) просто инициализируются и запускаются, а после нажатия пользователем кнопки OK сообщают, были ли внесены какие-либо изменения в модель.
Мы не пытаемся воспроизвести здесь полноценную архитектуру «Модель-Вид-Контроллер», где модель при внесении изменений в нее может приказать виду обновить себя, и т. д. Разумеется, реализация таких возможностей будет не столь уж сложной, но она лишь отвлечет нас от основной темы этой главы — внедренных форм. Кроме того, нашу упрощенную архитектуру «Модель-Вид -Фрейм» нельзя назвать слабой или примитивной. Я с большим успехом применял ее в нескольких проектах.
Наследование OLE и TInterfacedObject
Упомянутые выше интерфейсы, как и все интерфейсы Windows OLE, являются производными от интерфейса IUnknown. Интерфейс IUnknown предоставляет объектам OLE две услуги: подсчет ссылок и идентификацию. С помощью функции QueryInterface клиент определяет, какие интерфейсы поддерживаются тем или иным объектом. Функции AddRef и Release позволяют объекту следить за тем, сколько клиентов в данный момент с ним работает. Счетчик ссылок увеличивается каждый раз, когда клиент вызывает AddRef, и уменьшается при вызове Release. Если значение счетчика падает до 0, объект может удалить себя из памяти, потому что с ним никто не работает.
Все объекты OLE наследуют такое поведение от IUnknown. Тем не менее они не обязаны наследовать реализацию этого поведения. Понятие наследования в OLE относится к спецификации интерфейса, а не к реализующему интерфейс коду. Тот факт, что все интерфейсы OLE являются производными от IUnknown, говорит лишь о том, что любой интерфейс OLE должен реализовать три функции, определенные в IUnknown. Это ни в коем случае не означает, что реализации IDropTarget и IDropSource имеют общий код, аналогично тому как объекты TControl и TWinControl совместно пользуются, например, кодом процедуры WMLButtonDown. Если бы вам захотелось реализовать эти два интерфейса на каком-нибудь другом, не объектно-ориентированном языке программирования, для каждой реализации понадобились бы свои собственные функции QueryInterface, AddRef и Release, каждая из которых могла бы при необходимости обратиться к общему коду.
Delphi заметно упрощает работу с интерфейсами OLE (как, впрочем, и со всем остальным, что относится к Windows). В Delphi определен класс TInterfaced Object, который реализует интерфейс IUnknown и может использоваться в качестве базового класса для простых объектов OLE. Конечно, приятно знать, как работает интерфейс IUnknown, и все же, поверьте, — намного приятнее иметь возможность не задумываться об этом. Наши реализации всех четырех интерфейсов, используемых при перетаскивании, будут являться потомками TInterfacedObject.
Замечание
В Delphi 2 интерфейсы OLE были реализованы с помощью модуля OLE2.PAS. В целях совместимости этот модуль был сохранен и в Delphi 3. Однако весь новый код следует писать на основе ACTIVEX.PAS и TInterfacedObject. Конечно, вы можете по-прежнему пользоваться OLE2, но это будет намного сложнее. Работая с таким великолепным инструментом, как Delphi, следует в полной мере использовать все достоинства новых технологий, предусмотренных в нем.
Несколько слов о структуре программы
Перед тем как заняться более сложной программой, давайте перенесем рабочий код из файла проекта (DPR) в отдельный модуль. Как показывает опыт, смысловой код желательно убрать из файла проекта и хранить в отдельных модулях. Для этого есть несколько причин.
Самая главная причина заключается в том, что Delphi время от времени вносит изменения в файл проекта. Я думаю, что это происходит лишь при переименовании проекта или включении в него новых модулей, но полной уверенности у меня нет. Я понятия не имею, что может проделать Delphi с файлом проекта, и мне нигде не попадалась полная документация по этому вопросу. Будет крайне неприятно, если Delphi изменит что-то такое, что я считал неизменным. С другой стороны, я могу случайно убрать из файла проекта то, что Delphi поместит туда по своим личным соображениям. Даже этой причины для меня вполне достаточно. В то же время Delphi редко вносит изменения в модули, не связанные с формами (насколько я знаю, это происходит лишь при переименовании модуля командой File <> Save As), поэтому я предпочитаю держать свой код в отдельных модулях.
Другая причина - усложнение отладки. Почему-то у меня возникали трудности с установкой точек прерывания и пошаговым выполнением кода из DPR-файла.
Наконец, файл проекта - это всего лишь файл проекта. После знакомства со структурой программ-примеров и общим подходом Delphi к созданию проектов у меня сложилось впечатление, что DPR-файл не предназначен для хранения больших объемов выполняемого кода. Файл проекта объединяет модули для менеджера проекта, а во время выполнения программы автоматически создает некоторые формы, после чего запускает приложение. Думаю, с продуктом следует обращаться так, как задумали его разработчики.
Давайте отделим наш рабочий код и сведем файл FILTER.DPRк единствен ной выполняемой строке. В листинге 1.5 содержится новый файл FILTER.DPR, а в листинге 1.6 - модуль FILTMAIN.PAS, где теперь находит ся весь смысловой код.
Листинг 1.5. Новый файл проекта Filter
{$APPTYPE CONSOLE} program filter; uses cmdline in "cmdline.pas", filtmain in "filtmain.pas", fileio in "fileio.pas"; begin DoFilter; end.Листинг 1.6. FILTMAIN: основной рабочий модуль программы Filter
{ FILTMAIN.PAS - основной рабочий модуль программы Filter. Автор: Джим Мишель Дата последней редакции: 04/05/97 } unit filtmain; interface { DoFilter выполняет всю работу } procedure DoFilter; implementation uses CmdLine; procedure DoFilter; 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; end.Теперь файл проекта содержит именно то, что он должен содержать, - информацию о проекте и команду «марш!». Весь код, написанный программистом, вынесен в FILTMAIN.PAS.
Нестандартные элементы
Если у вас имеется элемент, который должен реагировать на определен ное сообщение, просто напишите нестандартную версию этого элемента. Например, если вам потребуется потомок TForm, обрабатывающий сообщение WM_DROPFILES, можно создать нестандартный элемент TFMDDForm (см. листинг3.5).
Листинг 3.5. Нестандартный компонент TFMDDForm
{
FMDDFORM.PAS—форма, обрабатывающая сообщение WM_DROPFILES.
Автор: Джим Мишель
Дата последней редакции: 27/04/97
} unit fmddform; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FMDD1; type TFMDDEvent = procedure (Sender: TObject; DragDropInfo : TDragDropInfo) of object; TFMDDForm = class(TForm) private { Private declarations } FOnFMDD : TFMDDEvent; procedure WMDropFiles (var Message: TMessage); message WM_DROPFILES; protected { Protected declarations } public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Published declarations } property OnFMDD: TFMDDEvent read FOnFMDD write FOnFMDD; end; procedure Register; implementation constructor TFMDDForm.Create(AOwner: TComponent); begin inherited Create (AOwner); FMDD1.AcceptDroppedFiles (Handle); end; destructor TFMDDForm.Destroy; begin FMDD1.UnacceptDroppedFiles (Handle); inherited Destroy; end; procedure TFMDDForm.WMDropFiles (var Message: TMessage); var DragDropInfo : TDragDropInfo; begin if assigned (FOnFMDD) then begin DragDropInfo := FMDD1.GetDroppedFiles (Message.wParam); FOnFMDD (Self, DragDropInfo); DragDropInfo.Free; end; end; procedure Register; begin RegisterComponents("Samples", [TFMDDForm]); end; end.Недостаток такого подхода заключается в том, что вам придется создавать нестандартную версию каждой формы, которая должна обрабатывать сообщения WM_DROPFILES. Даже если у вас хватит смелости влезть в исходный текст TWinControl и создать событие OnFMDD, чтобы все оконные элементы знали о существовании сообщения WM_DROPFILES, из этого все равно ничего не выйдет. Дело в том, что сама среда Delphi использует эти элементы и не поймет, что делать в случае их изменения.
Впрочем, даже если бы вы каким-нибудь чудом смогли изменить TWinControl, это не принесет никакой пользы в ситуации, когда элемент должен реагировать на несколько пользовательских сообщений, значения которых определяются только при выполнении программы. Требуется более универсальное и гибкое решение.
Обязанности клиента
Чтобы окно выполняло функции приемника, оно должно:
Инициализировать библиотеки OLE вызовом OleInitialize. Создать экземпляр объекта, реализующего интерфейс IDropTarget. Заблокировать созданный экземпляр вызовом CoLockObjectExternal. Вызвать процедуру RegisterDragDrop, передав ей логический номер окна-приемника и экземпляр интерфейсного объекта IDropTarget. После завершения работы— снять блокировку с объекта, вызвать Revoke DragDrop, чтобы сообщить OLE о прекращении приема сбрасываемых данных, и вызвать OleUninitialize для завершения работы с библиотеками OLE.Но все перечисленные действия нужны лишь для того, чтобы приложение воспринималось как приемник с точки зрения механизмов OLE. Чтобы реализовать интерфейс IDropTarget, необходимо определить следующие методы, вызываемые OLE во время операций перетаскивания:
Метод DragEnter вызывается в тот момент, когда курсор мыши входит в пределы окна. Метод должен определить тип перетаскиваемых данных и вернуть информацию о том, может ли окно принять данные, и если может, то как. Кроме того, DragEnter может предоставлять пользователю визуальную индикацию (например, изменять внешний вид курсора) и тем самым сообщать, разрешено ли в данный момент сбрасывание данных. Метод DragLeave вызывается, когда курсор мыши покидает пределы окна или пользователь отменяет операцию перетаскивания. Он должен освободить все ссылки на перетаскиваемые данные, а также устранить все признаки визуальной индикации перетаскивания. Метод DragOver вызывается при каждом перемещении курсора мыши внутри окна. Он может использоваться для организации визуальной индикации, а также сообщать OLE о том, разрешается ли сбрасывание данных в определенной точке окна. Метод DragOver многократно вызывается во время перетаскивания, поэтому он должен работать максимально быстро, в нем не должно происходить ничего лишнего. Метод Drop вызывается при завершении перетаскивания. Drop передает данные окну-приемнику, устраняет все признаки визуальной индикации и освобождает объект данных. Кроме того, он должен передать OLE информацию о статусе, чтобы можно было проинформировать объект-источник о завершении операции.Объявления этих четырех методов находятся в интерфейсе IDropTarget из файла ACTIVEX.PAS, а их реализация для объекта — приемника файлов приведена в листинге 4.1.
Листинг 4.1. Реализация класса TFileDropTarget из файла FILEDROP.PAS
{
FILEDROP.PAS -- реализация простейшего приемника OLE.
Автор: Джим Мишель
Дата последней редакции: 28/05/97
} unit FileDrop; interface uses Windows, ActiveX, Classes; type { TDragDropInfo слегка изменился по сравнению с FMDD2.PAS } TDragDropInfo = class (TObject) private FInClientArea : Boolean; FDropPoint : TPoint; FFileList : TStringList; public constructor Create (ADropPoint : TPoint; AInClient : Boolean); destructor Destroy; override; procedure Add (const s : String); property InClientArea : Boolean read FInClientArea; property DropPoint : TPoint read FDropPoint; property Files : TStringList read FFileList; end; TFileDropEvent = procedure (DDI : TDragDropInfo) of object; { TFileDropTarget знает, как принимать сброшенные файлы } TFileDropTarget = class (TInterfacedObject, IDropTarget) private FHandle : HWND; FOnFilesDropped : TFileDropEvent; public constructor Create (Handle: HWND; AOnDrop: TFileDropEvent); destructor Destroy; override; { из IDropTarget } function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint) : HResult; stdcall; function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragLeave: HResult; stdcall; function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; property OnFilesDropped : TFileDropEvent read FOnFilesDropped write FOnFilesDropped; end; implementation uses ShellAPI; { TDragDropInfo } constructor TDragDropInfo.Create ( ADropPoint : TPoint; AInClient : Boolean ); begin inherited Create; FFileList := TStringList.Create; FDropPoint := ADropPoint; FInClientArea := AInClient; end; destructor TDragDropInfo.Destroy; begin FFileList.Free; inherited Destroy; end; procedure TDragDropInfo.Add ( const s : String ); begin Files.Add (s); end; { TFileDropTarget } constructor TFileDropTarget.Create ( Handle: HWND; AOnDrop: TFileDropEvent ); begin inherited Create; _AddRef; FHandle := Handle; FOnFilesDropped := AOnDrop; ActiveX.CoLockObjectExternal(Self, true, false); ActiveX.RegisterDragDrop (FHandle, Self); end; { Destroy снимает блокировку с объекта и разрывает связь с ним } destructor TFileDropTarget.Destroy; var WorkHandle: HWND; begin { Если значение FHandle не равно 0, значит, связь с окном все еще существует. Обратите внимание на то, что FHandle необходимо прежде всего присвоить 0, потому что CoLockObjectExternal и RevokeDragDrop вызывают Release, что, в свою очередь, может привести к вызову Free и зацикливанию программы. Подозреваю, что этот фрагмент не совсем надежен. Если объект будет освобожден до того, как счетчик ссылок упадет до 0, может возникнуть исключение. } if (FHandle <> 0) then begin WorkHandle := FHandle; FHandle := 0; ActiveX.CoLockObjectExternal (Self, false, true); ActiveX.RevokeDragDrop (WorkHandle); end; inherited Destroy; end; function TFileDropTarget.DragEnter ( const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint ): HResult; stdcall; begin dwEffect := DROPEFFECT_COPY; Result := S_OK; end; function TFileDropTarget.DragOver ( grfKeyState: Longint; pt: TPoint; var dwEffect: Longint ): HResult; stdcall; begin dwEffect := DROPEFFECT_COPY; Result := S_OK; end; function TFileDropTarget.DragLeave: HResult; stdcall; begin Result := S_OK; end; { Обработка сброшенных данных. } function TFileDropTarget.Drop ( const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint ): HResult; stdcall; var Medium : TSTGMedium; Format : TFormatETC; NumFiles: Integer; i : Integer; rslt : Integer; DropInfo : TDragDropInfo; szFilename : array [0..MAX_PATH] of char; InClient : Boolean; DropPoint : TPoint; begin dataObj._AddRef; { Получаем данные. Структура TFormatETC сообщает dataObj.GetData, как получить данные и в каком формате они должны храниться (эта информация содержится в структуре TSTGMedium). } Format.cfFormat := CF_HDROP; Format.ptd := Nil; Format.dwAspect := DVASPECT_CONTENT; Format.lindex := -1; Format.tymed := TYMED_HGLOBAL; { Заносим данные в структуру Medium } rslt := dataObj.GetData (Format, Medium); { Если все прошло успешно, далее действуем, как при операции файлового перетаскивания FMDD. } if (rslt = S_OK) then begin { Получаем количество файлов и прочие сведения } NumFiles := DragQueryFile (Medium.hGlobal, $FFFFFFFF, NIL, 0); InClient := DragQueryPoint (Medium.hGlobal, DropPoint); { Создаем объект TDragDropInfo } DropInfo := TDragDropInfo.Create (DropPoint, InClient); { Заносим все файлы в список } for i := 0 to NumFiles - 1 do begin DragQueryFile (Medium.hGlobal, i, szFilename, sizeof(szFilename)); DropInfo.Add (szFilename); end; { Если указан обработчик, вызываем его } if (Assigned (FOnFilesDropped)) then begin FOnFilesDropped (DropInfo); end; DropInfo.Free; end; if (Medium.unkForRelease = nil) then ReleaseStgMedium (Medium); dataObj._Release; dwEffect := DROPEFFECT_COPY; result := S_OK; end; initialization OleInitialize (Nil); finalization OleUninitialize; end.Обратите внимание на то, что функции OleInitialize и OleUninitialize вызываются соответственно в секциях initialization и finalization данного модуля. Тем самым мы гарантируем, что библиотеки OLE будут инициализи рованы до первого обращения к ним из модуля и деинициализированы лишь после того, как работа с ними будет закончена.
Перед тем как переходить к подробному обсуждению реализации, давайте построим простейшую форму, в которой прием сброшенных данных организован с помощью объекта TOleDropTarget. Эта форма во многом похожа на остальные примеры, использованные в предыдущей главе. На ней присутствует всего один компонент — список, на который можно сбрасывать файлы из Windows Explorer. В листинге 4.2 содержатся методы этой формы.
Листинг 4.2. В модуле DRAGFRM1.PAS реализован прием сброшенных файлов
с помощью объекта TFileDropTarget
{
DRAGFRM1.PAS -- Прием файлов средствами OLE
Автор: Джим Мишель
Дата последней редакции: 28/05/97
} unit dragfrm1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileDrop; type TForm1 = class(TForm) ListBox1: TListBox; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } FDropTarget: TFileDropTarget; procedure OnFilesDropped (DropInfo: TDragDropInfo); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin { Создаем приемник } FDropTarget := TFileDropTarget.Create (Listbox1.Handle, OnFilesDropped); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin FDropTarget.Free; end; { OnFilesDropped вызывается при получении файлов объектом TFileDropTarget. } procedure TForm1.OnFilesDropped (DropInfo: TDragDropInfo); var i : Integer; begin { Заносим все файлы в список } for i := 0 to DropInfo.Files.Count-1 do begin Listbox1.Items.Add (DropInfo.Files[i]); end; end; end.Если откомпилировать и запустить эту программу, вы сможете перетаски вать файлы из Windows Explorer или File Manager и бросать их на компонент -список. Имена файлов отображаются в списке, как это происходило в примере из предыдущей главы.
Обязанности сервера
На первый взгляд может показаться, что реализация сервера перетаскивания почти не отличается по сложности от реализации клиентской стороны. Думаю, так и должно быть. К сожалению, разработчики интерфейса перетаскивания OLE не спросили моего мнения. Итак, сервер должен выполнять следующие операции:
На основании действий пользователя определить, что были выделены данные для перетаскивания. Вызвать OleInitialize, чтобы инициализировать библиотеки OLE. Создать экземпляр объекта, реализующего интерфейс IDropSource. Этот объект управляет пользовательским интерфейсом во время операции перетаскивания. Создать экземпляр объекта, реализующего интерфейс IDataObject. Этот объект содержит перетаскиваемые данные. Начать операцию перетаскивания, вызвав функцию OLE DoDragDrop и передав ей объекты IDropSource и IDataObject. DoDragDrop управляет операцией перетаскивания и вызывает методы объектов IDropSource и IDropTarget для всех окон, зарегистрированных функцией RegisterDragDrop, над которыми проходит курсор мыши во время перетаскивания. Сгенерировать признаки визуальной индикации на время перетаски вания — например, изменить внешний вид курсора. Выполнить необходимые действия с исходными данными на основании результатов перетаскивания. Например, результатом операции перемещения (move) является удаление исходных данных. После возврата из DoDragDrop уничтожить экземпляры объектов IDataObject и IDropSource. Вызвать OleUnitialize, чтобы завершить работу с библиотеками OLE.Я перечислил лишь самые основные действия. Заодно вам придется позаботиться о множестве деталей. Со стороны приложения все просто— инициализация, создание пары объектов и вызов DoDragDrop. Стоит перейти к реализации IDropSource, IDataObject и IEnumFormatEtc, как все стремительно усложняется. Перейти к кодированию можно лишь после того, как вы очень хорошо разберетесь со всеми событиями, происходящими на сервере. Давайте посмотрим, как расположены куски этой головоломки и как они взаимодействуют друг с другом.
Обработка командной строки
На первый взгляд в обработке командной строки нет ничего сложного. У вас имеется текстовая строка, из нее нужно выделить имена файлов и параметры, после чего соответствующим образом настроить переменные программы. Не перестаю удивляться, насколько сложной оказывается такая простая задача. К счастью, Object Pascal содержит две стандартные функции, ParamCount и ParamStr, которые немного облегчают работу.
ParamCount просто возвращает количество параметров, переданных в командной строке. Следовательно, для командной строки «MyFilter file1.txt file2.txt» будет возвращено значение 2. Функция не включает в число параметров имя самой программы.
ParamStr получает целое число и возвращает строку, которая соответствует аргументу с заданным номером. Например, для приведенной выше командной строки оператор вида
WriteLn(ParamStr (1));
выведет текст «file1.txt» (разумеется, без кавычек).
Если вызвать ParamStr с параметром 0, возвращается строка с полным путем и именем текущей выполняемой программы.
Программа Params (см. листинг 1.2) показывает, как работать с ParamCount и ParamStr. Чтобы создать эту программу, выполните в меню Delphi команду FileдNew, выберите на вкладке Projects диалогового окна New Items значок Console Application и задайте каталог для нового приложения. Не забудьте сохранить проект под именем Params.dpr, прежде чем приступать к его изменению.
Листинг 1.2. Программа Params
{ PARAMS.PAS - пример использования функций ParamCount и ParamStr. Автор: Джим Мишель Дата последней редакции: 04/05/97 } {$APPTYPE CONSOLE} program Params; uses Windows; Var i : Integer; begin WriteLn ("Program: ", ParamStr (0)); WriteLn ("ParamCount = ", ParamCount); WriteLn ("Parameters"); WriteLn ("-----"); for i := 1 to ParamCount do begin WriteLn (ParamStr (i)); end; Write ("Press Enter..."); ReadLn; end.Если вам захочется протестировать программу из Delphi, выполните команду Run д Parameters и введите командную строку. Для реализации приведен ного выше примера следует ввести в диалоговом окне Run parameters строку «file1.txt file2.txt» (без кавычек).
Не правда ли, просто? К сожалению, не совсем. В старое доброе время DOS и Windows 3.1 все было действительно просто. Но потом появились длинные имена файлов, которые к тому же могли содержать пробелы. Возникает проблема. Видите ли, функции ParamCount и ParamStr предполагают, что аргументы командной строки разделяются пробелами. Все идет замечательно, пока имена файлов не содержат пробелов, но попробуйте-ка ввести такую командную строку:
params c:\program files\borland\delphi 3\readme.txt
Функция ParamCount возвращает 3, а параметры с ее точки зрения выглядят так:
c:\program
files\borland\delphi
3\readme.txt
Получается совсем не то, что мы ожидали увидеть! (Пожалуй, длинные имена файлов не всегда хороши. Иногда они вызывают сплошные огорчения.)
Я не стану углубляться в обсуждение этой темы. Если вам захочется побольше узнать о проблеме и ее возможных решениях (ни одно из которых, кстати говоря, нельзя признать удовлетворительным - спасибо тебе, Microsoft), обратитесь к книге Лу Гринзо (Lou Grinzo) «Zen of Windows 95 Programming». Книга посвящена программированию на C и C++ для Windows 95, но в ней найдется много информации, полезной для всех программистов, особенно о методах написания корректно работающих программ. Эта книга входит в тройку лучших книг по программированию, которые мне приходилось читать, наравне с «Writing Solid Code» и «Debugging the Development Process» - обе книги написаны Стивом Магуайром (Steve Maguire) и опубликованы издательством Microsoft Press.
Единственное работоспособное (хотя и не удовлетворительное) решение - потребовать, чтобы имена файлов, содержащие пробелы, заключались в кавычки. При этом командная строка из предыдущего примера приобретает следующий вид:
params "c:\program files\borland\delphi 3\readme.txt"
Конечно, можно потребовать, чтобы пользователи всегда указывали короткую версию имени, но уж лучше ввести кавычки, чем мучиться со строкой типа
params "c:\progra~1\borland\delphi~1\readme.txt"
Обработка сообщений Windows
В большинстве ситуаций возможностей интерфейса Delphi для обработ ки сообщений Windows — обработчика события OnMessage объекта Application — оказывается вполне достаточно. Программы могут определять свои собственные обработчики OnMessage, и Delphi послушно передает им сообщения. Но Delphi не позволяет задать несколько обработчиков OnMessage в одной программе, поэтому реализация в разных окнах разной обработки сообщений Windows доставляет немало хлопот. В нашем примере мы уже столкнулись с этой проблемой — лишь один элемент во всем приложении может принимать перетаскиваемые файлы.
Первое, что приходит в голову, — написать обработчик, который знает обо всех элементах, обрабатывающих сообщения Windows. Он сравнивает значение Msg.hwnd со свойством Handle каждого элемента и передает сообщение нужному элементу. Конечно, такой вариант возможен, но для этого ваша программа должна уже на стадии компиляции знать все элементы, которым может потребоваться обработка сообщений Windows.
Кроме того, можно создать цепочку обработчиков OnMessage. Каждый элемент, которому потребуется обрабатывать сообщения Windows, подключается к этой цепочке. «Главный» обработчик подключается к событию Application.OnMessage и затем при поступлении нового сообщения просматривает список подключенных элементов, передавая сообщение нужному адресату. В этом случае элементы могут по своему усмотрению присоеди няться к цепочке OnMessage и покидать ее, однако вашей программе придется следить за тем, чтобы цепочка не нарушалась, а элементы не лишались направленных им сообщений.
Оба решения страдают крупным недостатком — все элементы, обрабатывающие сообщения Windows, должны знать о том, как главное приложение организует передачу сообщений. Низкоуровневая часть программы должна знать об устройстве верхнего уровня, тогда как ей об этом знать не положено.
Представьте себе, что ваш программный шедевр почти закончен, осталось лишь дописать элемент для работы с электронными таблицами. Перелистывая последний номер «Hacker Monthly», вы находите статью о Spreadsheet MAX — самом крутом элементе подобного рода. Он идеально подходит для вашего приложения, и вы немедленно посылаете заказ. Когда элемент прибывает, выясняется, что он прекрасно работает, но попутно перехватывает Application.OnMessage и полностью разрушает всю цепочку, построенную вами с таким трудом. А откуда электронной таблице знать о том, что вы организуете цепочечную доставку сообщений?
Может, в природе и существует надежный способ организовать правильную обработку Application.OnMessage несколькими элементами — я его не нашел. Так что советую забыть обо всем сказанном выше и вообще не пользоваться Application.OnMessage, если у вас имеется несколько окон, обрабатывающих сообщения Windows. Укротить свирепого льва можно и по-другому.
OLE!
Теперь вы в общих чертах знаете о том, как программируется перетаскивание. О различных интерфейсах OLE написаны целые книги, и даже о том же перетаскивании можно еще многое рассказать. Но для большинства программистов оказывается труднее всего проникнуться идеей COM и осознать тот факт, что OLE в большинстве случаев определяет лишь интерфейсы, реализацию которых должны обеспечивать программисты (то есть вы и я). Некоторые интерфейсы (например, IStorage) реализованы в Windows, но большинство из них лишь определен о, что позволяет вашим приложениям обмениваться информацией с Windows или другими программами.
В этой главе мы лишь скользнули по поверхности OLE. Если вас заинтересуют стандартные интерфейсы, возьмите любой справочник по OLE из тех, что можно найти в каждом магазине. Кроме того, попробуйте обратиться к Windows SDK, где описаны все интерфейсы и реализованные в Windows функции OLE. Впрочем, если вы не владеете C, SDK вряд ли принесет много пользы.
Чтобы получить дополнительную информацию о создании и использовании интерфейсов OLE, изучите объекты Delphi TComObject и TActiveXControl, а также прочитайте главу 25 из руководства пользователя по Delphi 3 и всю часть IV, «Working with COM and ActiveX», из руководства программиста. Как всегда, обращайтесь к своему надежному другу — электронной документации.
О модели программирования COM можно рассказывать очень долго. Если вам удалось определить для объекта минимальный, но функционально полный интерфейс (в котором клиент полностью изолирован от внутреннего представления данных), то вы, вероятно, очень хорошо представляете себе, что делает ваш объект. Кроме того, тем самым вы проводите четкую границу между «что» и «как». Как показывает опыт, с усложнением программ наиболее важной частью работы становится определение интерфейсов между различными частями программы. Если спроектированные интерфейсы будут просты и удобны, вам будет проще реализовать их и наладить совместную работу компонентов. В результате получится более логичная программа, содержащая меньшее количество ошибок, которую будет проще изменить при необходи мости. Такие интерфейсы можно определять и без COM, но идея взаимодействия между объектами через систему четко определенных интерфейсов уже доказала свою несомненную эффективность.
|
Оперативное изменение подсказок
Иногда для различных частей элемента желательно выводить различные экранные подсказки (hints). Это в наибольшей степени относится к разного рода сеткам (grids), поскольку характер информации может сильно изменяться от ячейки к ячейке. Например, предположим, что в одном столбце сетки содержится имя игрока-бейсболиста, а в другом — название его команды. Мы хотим, чтобы текст подсказки зависел от того, в каком столбце находится курсор мыши.
К сожалению, стандартный механизм подсказок такой возможности не дает. Приложение определяет, какую подсказку следует выводить, лишь при перемещении курсора к другому элементу.
Однако объект Application обладает public-методом CancelHint, который убирает с экрана текущую подсказку и заново запускает таймер. Если изменить свойство Hint после вызова CancelHint, но перед повторным появлением окна подсказки, мы сможем изменить текст подсказки, не перемещаясь за границу элемента.
В листинге 9.15 приведен пример обработчика OnMouseMove для объекта TStringGrid; вы можете использовать эту модель в своих программах. Обработ чик вызывается при каждом перемещении мыши над сеткой, но лишь при переходе к другой ячейке мы убираем окно подсказки и изменяем ее текст.
Листинг 9.15. HINTPROC.SRC
{ Пример изменения подсказок в объекте TStringGrid } procedure TForm1.StringGrid1MouseMove ( Sender: TObject; Shift: TShiftState; X, Y: Integer ); const LastMCol: LongInt = -2; LastMRow: LongInt = -2; var MCol, MRow: LongInt; // Столбец и строка, где находится курсор NewHintText: string; Grid: TStringGrid; begin Grid := Sender as TStringGrid; Grid.MouseToCell( X, Y, MCol, MRow ); if ( MCol <> LastMCol ) or ( MRow <> LastMRow ) then begin Application.CancelHint; if ( MCol = -1 ) or ( MRow = -1 ) then NewHintText := 'Not over cell' else NewHintText := Format( 'Col %d, Row %d', [ MCol, MRow ]); Grid.Hint := NewHintText; end; LastMCol := MCol; LastMRow := MRow; end;Этот код можно использовать во всех трех версиях Delphi, хотя поведение окна подсказки в них несколько отличается. В Delphi 1 и 2 окно подсказки остается в нижней части сетки, независимо от положения курсора. В Delphi 3 окно подсказки следует за курсором и располагается рядом с текущей ячейкой или поверх нее — именно на это вы и рассчитывали.
Определение интерфейса
Желательно, чтобы перетаскивание по возможности работало так же, как стандартные события Delphi. Поскольку мы не создаем новый нестандарт ный элемент, нам не удастся определить событие OnFMDD и организовать его обработку в режиме конструирования. Придется имитировать нечто похожее во время выполнения. Для этого мы должны:
Определить тип TFMDDEvent для обработчика события. Объявить обработчик OnFMDRagDrop в закрытой (private) секции формы. При создании формы передать адрес обработчика интерфейсу FMDD— то есть сообщить ему о том, что наша форма желает принимать брошенные файлы. Когда происходит событие перетаскивания (то есть в тот момент, когда форма получает сообщение WM_DROPFILES), интерфейс FMDD вызывает обработчик OnFMDragDrop и передает ему объект TDragDropInfo. При закрытии формы обратиться к интерфейсу FMDD и сообщить о том, что форма прекращает принимать перетаскиваемые файлы.Описанная схема превращается в интерфейсную секцию, приведенную в листинге 3.6.
Листинг 3.6. Интерфейсная секция нового модуля FMDD
interface uses Windows, Messages, Classes, Controls; type TDragDropInfo = class (TObject) private FNumFiles : UINT; FInClientArea : Boolean; FDropPoint : TPoint; FFileList : TStringList; public constructor Create (ANumFiles : UINT); destructor Destroy; override; property NumFiles : UINT read FNumFiles; property InClientArea : Boolean read FInClientArea; property DropPoint : TPoint read FDropPoint; property Files : TStringList read FFileList; end; TFMDDEvent = procedure (DDI : TDragDropInfo) of object; procedure AcceptDroppedFiles (Control : TWinControl; AOnDrop : TFMDDEvent); procedure UnacceptDroppedFiles (Control : TWinControl);Обратите внимание — класс TFragDropInfo не изменился. Мы удалили функцию GetDroppedFiles и переопределили процедуры AcceptDroppedFiles и UnacceptDroppedFiles. Получившийся интерфейс выглядит намного приятнее — из него исчезли отвратительные подробности типа логических номеров окон или сообщений Windows. Разумеется, кто-то должен помнить обо всем этом. Все детали скрыты в секции реализации (implementation) модуля FMDD.
Организация вывода
Хотя CsShopper и относится к невизуальным компонентам, время от времени ему приходится взаимодействовать с приложением пользователя и отображать сообщения, которыми сервер обменивается с клиентом. Такую возможность предоставляет published-свойство OnInfo класса TCsShopper (унаследован ное от класса TCsSocket) и private-процедура InfoEvent. Процедура InfoEvent выглядит следующим образом:
procedure TCsSocket.InfoEvent(Msg : String);
begin
if Assigned(FOnInfoEvent) then
FOnInfoEvent(Self, Msg);
end;
Когда через управляющее соединение отправляется или принимается сообщение, локальная переменная TempStr в процедуре FTPCommand задает значение свойства Info, после чего FTPCommand вызывает процедуру InfoEvent. Внутри InfoEvent проверка Assignеd возвращает значение True, а процедура CsShopper1Info из приложения отображает Info.
Чтобы такое взаимодействие между CsShopper и клиентским приложением стало возможным, я создал процедуру CsShopper1Info с помощью вкладки Events инспектора объектов. Содержимое окна memLog, в котором отображаются все эти сообщения, обновляется с каждым событием FOnInfoEvent. CsShopper1Info содержит следующий фрагмент кода:
procedure TfrmMain.CsShopper1Info(Sender: TObject; Msg: String);
begin
memLog.Lines.Add(Msg);
end;
Ошибки в модуле Math второй версии Delphi
Хотите верьте, хотите нет, но в модуле Math из поставки Delphi 2 действитель но присутствует ошибка. Лучше услышать о ней сейчас, чем столкнуться с ней во время работы, не правда ли? (А еще лучше — перейти к Delphi 3!)
Дело вот в чем: в модуле Math Delphi 2 перепутаны функции MinValue и Max Value. MinValue возвращает наибольший элемент массива, а MaxValue — наименьший. Хотя эта ошибка не фатальна, о ней все же следует упомянуть (разумеется, компонент DBStatistics исправляет ее в отношении своих свойств MinValue и MaxValue).
Учтите, что эта ошибка была исправлена в модуле Math, включенном в Delphi 3, а компонент DBStatistics — обновлен с учетом этого. Благодаря нескольким разумным директивам {$IFDEF} компонент TDBStatistics правильно работает и с Delphi 2, и с Delphi 3.
От редактора перевода
Книга, которую вы держите в руках, во многом необычна и отличается от других изданий, посвященных Delphi. Прежде всего, она предназначена не для начинающих. Чтобы по достоинству оценить изящество преподносимых здесь примеров, необходимо уметь обращаться с Delphi и разбираться в языке Object Pascal. Кроме того, книга никоим образом не претендует на то, чтобы считаться всеобъемлющей энциклопедией- это скорее хрестоматия, сборник интересных задач, удачных находок и красивых решений. И хотя в названии книги упоминается Delphi 3, большая часть описываемых здесь приемов окажется полезной программистам, работающим со всеми версиями Delphi.
Использовать эту книгу можно по-разному. Можно относиться к ней просто как к «поваренной книге» программиста, где собрано множество рецептов на все случаи жизни (к этому подталкивает как предисловие редактора серии «High Performance», так и название, под которым выходит русская версия). Но программирование - это творчество, и основную ценность здесь представляют не только и не столько готовые решения, а лежащие в их основе идеи и та логика, тот ход мыслей, которые помогли эти идеи реализовать. Ведь рецептом можно всего лишь воспользоваться, а идея - потенциальный источник новых открытий. Так что если вы цените блестящие находки, умеете испытывать удовольствие от собственноручно решенной задачи и способны видеть красоту и гармонию в сухих строках листинга программы - эта книга для вас!
И последнее. Один из авторов этой книги очень верно сказал - нельзя изучить Delphi с помощью одних только книг, какими бы хорошими они ни были. Delphi нужно исследовать. Не забывайте об этом, и да сопутствует вам удача!
Александр Сергиенко
Январь 1998 г.
Открываемся!
После завершения конфигурирования компонента FTP-сервера можно запускать KEEPER32. При нажатии кнопки Start вызывается метод CsKeeper1.Start Server. На рис. 7.6 показан вид приложения, готового к обслуживанию FTP-клиентов.
Метод CsKeeper1.StartServer вызывает процедуру GetHome, чтобы изменить текущий диск и основной каталог в соответствии со значениями FRootDisk и FRootDir, загружаемыми процедурой LoadSettings.
Отмена изменений
Если пользователь не захочет сохранять внесенные изменения и выберет первую команду меню, прямоугольник TSizingRect скрывается, а выделенный элемент остается в прежнем состоянии. Это происходит в процедуре TFrm Main.EscapeClick (см. листинг12.5).
Листинг 12.5. Обработчик события OnClick команды Escape/No changes
procedure TFrmMain.Escape1Click(Sender: TObject); begin if (Adjust.Checked = True) then begin Adjust.Checked := False; SizingRect1.Cursor := crDefault; SizingRect1.Visible := False; SizingRect1.Top := -40; SizingRect1.Left := -40; SizingRect1.Width := 40; SizingRect1.Height := 40; ComponentBeingAdjusted := Self; { т. е. выделенный элемент } { отсутствует. } end; end;Замечание
В проекте STARTER.DPR компонент SizingRect спрятан в левой верхней части формы, чтобы он не был случайно выведен в неподходящий момент. Если вы захотите использовать этот проект как отправную точку для ваших собственных приложений, не забудьте найти компонент SizingRect и после добавления на форму всех элементов перевести его на передний план командой EditдBring To Front из главного меню Delphi. Кроме того, проследите за тем, чтобы свойства PopupMenu всех элементов ссылались на контекстное меню PopupMenu1.
Отмена операции WSAAsync
Поскольку асинхронные операции нарушают нормальную логику работы приложения, отменить их оказывается не так просто. Для прерывания асинхронных операций в Winsock API предусмотрена специальная функция WSACancelAsyncRequest (тем не менее обратите внимание— эта функция не может отменять операции, запущенные функцией WSAAsyncSelect). В листинге 5.11 показана функция WSACancelAsyncRequest в «оболочке» метода CancelAsyncOperation.
Листинг 5.11. Метод TCsSocket.CancelAsyncOperation — отмена
асинхронной операции
Однако метод CancelAsyncOperation определен в секции protected и поэтому недоступен приложению RESOLVER32. Но как же RESOLVER32 отменяет WSAAsyncGetHostByName или WSAAsyncGetHostByAddr? Обращаясь к методу CancelAsyncOperation через логическое public-свойство CancelAsyncOp.
Листинг 5.12 показывает, что происходит при нажатии кнопки Abort в групповом поле gbnameRes приложения RESOLVER32. Поскольку функция вызывается в псевдоблокирующем режиме, мы присваиваем CancelAsyncOp значение True. Тем самым мы приказываем CsSocket через CancelAsyncOperation вызвать WSACancelAsyncRequest и таким образом прервать асинхронную операцию. Обратите внимание — при вызове блокирующих функций кнопка Abort становится недоступной.
Листинг 5.12. Метод TFrmMain.AbortAsyncHostBtnClick — отмена
асинхронной операции
Отображение данных
Перемещения вверх и вниз по иерархическому дереву неизбежны, однако вы можете воспользоваться средствами, которые автоматизируют эту задачу. Подумайте, как пользователи будут работать с данными. Возможно, их вообще не интересует иерархическая структура данных, но они захотят искать объект по его предку. Или они будут искать объект по тому имени, которым он представлен в иерархии, или только среди потомков текущего объекта. Возможно, им потребуется узнать только идентификатор найденного объекта или же получить список всех его потомков или предков.
В частности, вам придется решить основной вопрос — что делать, когда пользователь требует вывести «следующий» объект? Таким объектом может быть: следующий потомок родителя текущего объекта; первый потомок текущего объекта; следующий родитель, если текущий объект является единственным потомком, или даже первый потомок следующего «родственника» (sibling). В визуальном интерфейсе интуитивные ожидания пользователя основаны на положении текущего объекта в иерархии, способе его отображения и действиях самого пользователя, а не только на логическом протоколе, определяемом абстрактной структурой данных приложения.
Помимо компонента TDBGrid, используемого для описанных выше одноуровневых связей, очевидными кандидатами для отображения иерархических данных являются компоненты TOutline и TTreeView. Эти компоненты были созданы специально для отображения древовидных структур, а не традиционных линейных списков. Они могут занимать довольно большую область экрана, поэтому не стоит применять их везде, где пользователь должен выбрать объект иерархии. Кроме того, при работе с этими компонентами желательно загружать в память всю структуру (а это может быть весьма накладно!). Компоненты можно настроить так, чтобы «ветки» загружались по мере надобности, однако такая гибкость достигается ценой снижения производительности.
В листинге 13.4 показано, как могут загружаться такие элементы. Перед тем как разбирать этот фрагмент, необходимо познакомиться с общими принципами работы компонента TOutline.
Листинг 13.4. Заполнение компонента TOutline из списка объектов
procedure LoadItemStringsFromTop(ListOfItems : TListOfItems); var Counter : Integer; procedure LoadOutline(StartIndex : Integer; StartItem : TItem); var NewIndex : Integer; begin NewIndex := MyOutline.AddChildObject(StartIndex, StartItem.Description, StartItem); if StartItem.FirstChildItem <> nil then LoadOutline(NewIndex,StartItem.FirstChildItem); if StartItem.FirstSiblingItem <> nil then LoadOutline(StartIndex,StartItem.FirstSiblingItem); end; begin MyOutline.Clear; for Counter := 0 to ListOfItems.Count - 1 do if ListOfItems[Counter].Level = 1 then LoadOutline(0,ListOfItems[Counter]); end;Заполнение TOutline можно производить сверху вниз, последовательно загружая детей каждого узла (предполагается, что каждый узел знает свой узел верхнего уровня, а также своих детей). Эта информация содержится в объектах классов TListOfItems и TItem, присутствующих в листинге 13.4 (см. раздел «Компоненты TreeData» далее в этой главе).
К сожалению, в стандартной иерархической модели списки детей не ведутся — дети определяются как объекты, для которых данный объект является родителем. Если только вы не загрузите весь набор объектов в память (как TListOfItems) и не установите «родительские» связи, иерархию придется загружать снизу вверх. Другими словами, при добавлении родителя каждого объекта вам придется проверять, не был ли этот родитель загружен ранее для объекта-родственника, и если был — сообщать TOutline о том, что новый объект принадлежит данному родителю.
При перетаскивании объекта из элемента
При перетаскивании объекта из элемента TreeView или ListView вместе с курсором мыши перемещается полупрозрачное изображение объекта. Этот замечательный визуальный признак существует до тех пор, пока изображение не выйдет за пределы элемента. В этот момент — раз! — изображение исчезает и не появляется до тех пор, пока мышь снова не вернется в исходный элемент или не попадет в другой элемент ListView или TreeView.
Почему это происходит? В число факторов, определяющих поведение элемента, входит свойство ControlStyle. В Delphi версий 2 и 3 появился новый стандартный флаг csDisplayDragImage. Если csDisplayDragImage входит в ControlStyle, перетаскиваемое изображение выводится над элементом. В противном случае оно исчезает до тех пор, пока курсор не доберется до более «дружественной» территории. К сожалению, для большинства элементов значение ControlStyle, принятое по умолчанию, не включает флага csDisplayDragImage. Следовательно, если вы хотите, чтобы изображение не пропадало при перемещении, придется настроить все формы вашего проекта и все элементы, находящиеся на них, чтобы в их свойстве ControlStyle присутствовал флаг csDisplayDragImage.
В листинге 9.18 приведена процедура EnableDisplayDragImage, исправляющая значение ControlStyle самого элемента, его дочерних элементов, «внуков» и т. д.
Чтобы каждый элемент формы поддерживал отображение перетаскиваемого объекта, включите в обработчик FormCreate формы следующую строку:
EnableDisplayDragImage( Self, True );
Если ваша программа создает элементы динамически, не забудьте вызвать EnableDisplayDragImage и для них.
Листинг 9.18. Модуль ENABDISP.PAS
unit EnabDisp; interface uses Controls; procedure EnableDisplayDragImage( Control: TControl; ChildrenToo: Boolean ); implementation procedure EnableDisplayDragImage( Control: TControl; ChildrenToo: Boolean ); var Index: Integer; begin with Control do ControlStyle := ControlStyle + [ csDisplayDragImage ]; if ChildrenToo and ( Control is TWinControl ) then with TWinControl( Control ) do for Index := 0 to ControlCount - 1 do begin EnableDisplayDragImage( Controls[ Index ], ChildrenToo ); end; end; end.
|
|
Параметры командной строки
Большинству программ командной строки параметры передаются прямо в строке. Иногда встречаются программы, получающие параметры из переменных окружения или конфигурационных файлов, а также гибриды, получающие параметры из командной строки или конфигурационного файла, имя которого указывается в командной строке. Чтобы не увязнуть в получении
параметров, мы проигнорируем конфигурационные файлы и переменные окружения, сосредоточив все внимание на параметрах командных строк.
Вам наверняка приходилось пользоваться средствами командной строки (скажем, командой DIR), в которых для параметров используется префикс- косая черта (/). Например, чтобы вывести список файлов текущего каталога и всех его подкаталогов, следует ввести DIR /S. Кроме того, во многих программах в качестве префикса используется дефис (он же знак «минус», -). Оба символа распространены достаточно широко, и во многих программах можно указывать любой из них.
С другой стороны, имена файлов задаются множеством способов в зависимости от конкретной программы. Например, COPY позволяет задавать имена входного и выходного файла без префиксов. Следовательно, строка COPY FILE1 FILE2 скопирует содержимое FILE1 в FILE2. Программа MAKE фирмы Borland, напротив, требует задать для имени входного файла префикс -f. Так, для обработки файла BUILD.MAK следует ввести команду MAKE -fbuild.mak.
Система, принятая в MAKE, оказывается более простой - здесь к параметрам относится вс?. Каждый параметр командной строки отделяется от других хотя бы одним пробелом, а имена файлов обрабатываются наравне с прочими параметрами - никаких исключений не предусмотрено. Именно такую модель мы реализуем в своем фильтре.
Параметры командной строки обычно делятся на четыре категории: переключатели, числа, строки и имена файлов. Переключатель просто включает или выключает какой-то режим. Например, в текстовом фильтре может быть предусмотрен переключатель для перевода всех символов в верхний регистр. Числа могут быть как целыми, так и вещественными. Задавать их можно несколькими способами, чаще всего встречается десятичное и шестнадцатеричное представление. Строки похожи на имена файлов, однако для последних часто предусмотрена проверка правильности синтаксиса.
Перед началом
Похоже, многие программисты даже не знают, что в файл проекта можно поместить код, который будет выполняться еще до инициализации приложения. Именно это и происходит в данном случае. Файл проекта для эксперименталь ного приложения приведен в листинге16.4.
Листинг 16.4. Файл проекта для программы, запускаемой лишь
в одном экземпляре
{——————————————————————————————————————————————————————} { Демонстрационная программа, } { запускаемая лишь в одном экземпляре. } { ONEINST.DPR : Файл проекта } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Программа показывает, как предотвратить запуск } { нескольких экземпляров приложения в среде Windows 95.} { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {—————————————————————————————————————————————————————— program OneInst; uses Windows, Forms, InstMain in 'InstMain.pas' {Form1}; const MemFileSize = 1024; MemFileName = 'one_inst_demo_memfile'; var MemHnd : HWND; {$R *.RES} begin { Попытаемся создать файл в памяти } MemHnd := CreateFileMapping(HWND($FFFFFFFF), nil, PAGE_READWRITE, 0, MemFileSize, MemFileName); { Если файл не существовал ранее, запускаем приложение... } if GetLastError <> ERROR_ALREADY_EXISTS then begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end; CloseHandle(MemHnd); end.Дело обстоит так: прежде всего я пытаюсь создать объект отображения файла, вызывая функцию API CreateFileMapping. Независимо от того, существо вал объект ранее или был создан при вызове функции, его логический номер возвращается и присваивается MemHnd. При вызове CreateFileMapping с логическим номером $FFFFFFFF вместо традиционной файловой системы использует ся страничный файл (paging file) операционной системы, поэтому файл может совместно использоваться несколькими процессами; все процессы должны лишь знать имя файла. Хотя файл подготавливается для чтения/записи,
в программу не включен вызов функции MapViewOfFile, с помощью которой программа получает доступ к содержимому файла через указатель. В данном примере достаточно проверить, существует ли файл.
Если в момент вызова CreateFileMapping файл в памяти уже существовал, вызывающая процедура получает его логический номер, а системе возвращается код ошибки ERROR_ALREADY_EXISTS. Если функция GetLastError не находит эту ошибку, значит, предыдущего экземпляра не существует и работу можно продолжать.
Поскольку логический номер возвращается в любом случае (независимо от того, был создан файл или нет), его необходимо закрыть перед завершением приложения. Объект файла в памяти создается первой программой, вызывающей CreateFileMapping; когда логический номер будет закрыт последней программой, система уничтожит объект. Это равносильно удалению файла.
Конец записи (1 апреля).
Эйс нажал кнопку Print, и лазерный принтер ожил, выдав четыре страницы текста. Эйс достал их из лотка и внимательно просмотрел.
— Теперь все ясно, — решительно сказал он.
Хелен хотела напомнить о том, что она с самого начала была права, но вовремя передумала. Кроме того, Эйс уже направлялся к двери.
— Я пойду с тобой, — сказала она и взяла плащ с сумочкой.
— Прости, бэби, — ответил Эйс. — Там может быть опасно, так что ты останешься здесь. Подожди у телефона на случай, если что-нибудь сорвется.
— Наверное, ты прав, — неохотно признала она. — Но будь осторожен, милый.
И Хелен нежно поцеловала его.
— Я вернусь через час или два, — произнес Эйс. — А если не вернусь, вызывай полицию. Скажи им, что я отправился за Бохакером!
Еще один поцелуй, и он вышел.
Передача файлов
С точки зрения внутренней логики процесс передачи файлов похож на их прием. Свойство CsShopper.Put выполняет передачу с помощью метода PutFile. Чтобы упростить передачу файла от клиента к серверу, я создал на главной форме несколько списков, производных от компонентов с вкладки Windows3.1 палитры: dcbLocal — от TDriveComboBox, dlbLocal — от TDirectoryListBox и flbLocal — от TFileListBox.
Все эти списки синхронизированы друг с другом. При выборе в dcbLocal другого дискового устройства немедленно изменяется содержимое dlbLocal и flb Local. Как и в случае списка lbRemoteFiles, я воспользовался вкладкой Events инспектора объектов и создал новый обработчик события OnDblClick — Tfrm Main.flbLocalDblClick — для двойного щелчка на имени файла в списке flbLocal. Таким образом, двойной щелчок на имени передаваемого файла вызывает TfrmMain.flbLocalDblClick, в результате чего имя файла назначается свойству CsShopper1.Put.
