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

Абстрактные, контролируемые инеконтролируемые виды

Как видно из дерева наследования на рис. 10.5, интерфейсные формы используются в проекте EmbeddedForms для создания двух категорий видов: неконтролируемы х (TValidView), для которых свойство Valid всегда равно True, и контролируемы х (TFickleView), для которых свойство Valid может изменять ся. Неконтролируемые виды можно использовать для Memo-полей с произвольным содержимым или, например, начальной или завершающей панелей мастера. Контролируемые виды должны применяться каждый раз, когда пользователь может ввести неверные данные, не подлежащие сохранению, — например, дату 31 февраля, расходы, превышающие общую сумму бюджета, и т. д. Поскольку в обоих случаях реализуется интерфейс IView, можно воспользоваться универсальным кодом для работы с обобщенным набором видов.

Рис. 10.5. Интерфейсные формы в проекте
Обе категории видов происходят от класса TAbstractView (листинг 10.4).
Листинг 10.4. Модуль VIEWS.PAS
unit Views; // Copyright © 1997 by Jon Shemitz, //all rights reserved. // Permission is hereby granted to //freely use, modify, and // distribute this source code PROVIDED //that all six lines of // this copyright and contact notice are //included without any // changes. Questions? Comments? //Offers of work? //mailto:jon@midnightbeach.com // ---------------------------------------------- // Отображает соглашение IView на внедренную //форму. Виды обычно // порождаются от TValidView или TFickleView. interface uses Models, Embedded; type TAbstractView = class(TEmbeddedForm, IView) procedure FormCreate(Sender: TObject); private fReadOnly: boolean; protected function GetValid: boolean; virtual; abstract; procedure SetValid(Value: boolean); virtual; abstract; function GetReadOnly: boolean; virtual; procedure SetReadOnly(Value: boolean); virtual; public procedure ReadFromModel(Model: TModel); virtual; procedure WriteToModel(Model: TModel); virtual; procedure AddNotifiee( Notify: IFrame); virtual; abstract; procedure RemoveNotifiee(Notify: IFrame); virtual; abstract; property Valid: boolean read GetValid write SetValid; property ReadOnly: boolean read fReadOnly write SetReadOnly; end; TViewClass = class of TAbstractView; implementation {$R *.DFM} function TAbstractView.GetReadOnly: boolean; begin Result := fReadOnly; end; // TAbstractView.GetReadOnly procedure TAbstractView.SetReadOnly(Value: boolean); begin fReadOnly := Value; Enabled := not Value; // Вид, доступный только для чтения, отображает // информацию, но не позволяет изменять ее; // вы можете переопределить SetReadOnly, // чтобы изменить визуальное представление таких видов. end; // TAbstractView.SetReadOnly procedure TAbstractView.ReadFromModel(Model: TModel); begin end; // TAbstractView.ReadFromModel procedure TAbstractView.WriteToModel(Model: TModel); begin end; // TAbstractView.WriteToModel procedure TAbstractView.FormCreate(Sender: TObject); begin inherited; _AddRef; // Чтобы Self можно было передавать // как интерфейсную ссылку end; end. TAbstractView разделяет протокол IView на три части — доступность только для чтения, проверка корректности, обмен данными с моделью — и обрабатывает каждую часть отдельно:

	реализация базовой функциональности Read-Only — пользователи не могут изменить данные на заблокированной форме, хотя на практике виды обычно переопределяют метод SetReadOnly, чтобы изменить визуальное представление видов, доступных только для чтения;
	вся реализация проверки возлагается на потомков TValidView и TFickleView;
	для ReadFromModel и WriteFromModel предоставляются фиктивные заглушки. Поскольку эти методы переопределяются в любом реальном объекте вида, желательно, чтобы виды всегда вызывали inherited.

Как нетрудно догадаться по названию, предполагается, что вы не станете непосредственно использовать класс TAbstractView или напрямую наследовать от него. Вместо этого следует пользоваться TValidView и TFickleView.
Разумеется, все «абстрактные», «неконтролируемые» и «контролируемые» виды можно было свалить в единый класс TView. Разделение обладает двумя основными достоинствами: поскольку неконтролируемые виды игнорируют те части протокола IView, которые занимаются проверкой, программа работает немного быстрее и требует меньше памяти. Что еще важнее, при порождении конкретного вида от TValidView вместо TFickleView свойство Valid всегда остается равным True, даже если вы по неосторожности присвоите ему False (сравните листинги 10.5 и 10.6).
Листинг 10.5. Методы проверки корректности из модуля VALIDVIEWS.PAS
function TValidView.GetValid: boolean; begin Result := True; end; // TValidView.GetValid procedure TValidView.SetValid(Value: boolean); begin // TValidView всегда корректен - //игнорируем Value end; // TValidView.SetValid procedure TValidView.AddNotifiee(Notify: IFrame); begin // TValidView всегда корректен - игнорируем запрос на добавление end; // TValidView.AddNotifiee procedure TValidView.RemoveNotifiee(Notify: IFrame); begin // TValidView всегда корректен - игнорируем запрос на удаление end; // TValidView.RemoveNotifiee Листинг 10.6. Фрагмент модуля FICKLEVIEW.PAS
type TFickleView = class(TAbstractView) private { Private declarations } fValid: boolean; fNotify: IFrame; // В данной реализации проверки //корректности поддерживается // всего один получатель уведомлений public { Public declarations } procedure AddNotifiee( Notify: IFrame); override; procedure RemoveNotifiee(Notify: IFrame); override; function GetValid: boolean; override; procedure SetValid(Value: boolean); override; end; implementation {$R *.DFM} procedure TFickleView.AddNotifiee(Notify: IFrame); begin fNotify := Notify; end; // TFickleView.AddNotifiee procedure TFickleView.RemoveNotifiee(Notify: IFrame); begin fNotify := Nil; end; // TFickleView.RemoveNotifiee function TFickleView.GetValid: boolean; begin Result := fValid; end; // TFickleView.GetValid procedure TFickleView.SetValid(Value: boolean); begin if Value <> fValid then begin fValid := Value; if Assigned(fNotify) then fNotify.OnValidChanged(Self, Self); end; // Value <> fValid end; // TFickleView.SetValid

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

Ceil Округление вверх
Floor Округление вниз
Frexp Вычисление мантиссы и порядка заданной величины
IntPower Возведение числа в целую степень. Если вы не собираетесь пользо-
ваться экспонентами с плавающей точкой, желательно исполь-
зовать эту функцию из-за ее скорости
Ldexp Умножение X на 2 в заданной степени
LnXP1 Вычисление натурального логарифма X+1. Рекомендуется для X,
близких к нулю
LogN Вычисление логарифма X по основанию N
Log10 Вычисление десятичного логарифма X
Log2 Вычисление двоичного логарифма X
Power Возведение числа в степень. Работает медленнее IntPower, но для
операций с плавающей точкой вполне приемлемо

Асинхронная пересылка файлов

Познакомившись с протоколом FTP в блокирующем (синхронном) режиме, кратко рассмотрим работу CsShopper в асинхронном режиме. Поскольку процесс регистрации на FTP-сервере подробно описан выше, наше основное внимание будет сосредоточено на пересылке, и особенно— на асинхронном приеме файла с FTP-сервера.
Перед тем как подключаться к FTP-серверу в асинхронном режиме, следует установить переключатель Asynchronous в групповом поле FTP Mode вкладки Options. Этот переключатель управляет режимом всего соединения; после того как SHOPPER32 подключится к FTP-серверу, групповое поле FTP Mode блокируется до окончания сеанса.
Процесс выбора принимаемого файла в асинхронном режиме происходит так же, как и в блокирующем режиме; другими словами, перед вызовом Retrieve мы присваиваем имя файла свойству Get. Отличия начинаются внутри Retrieve. Определив тип файла, мы присваиваем флагу состояния FFtpCmd значение FTP_TYPEI и тем самым приказываем серверу переслать файл как непрерывный поток байтов. Команда TYPE передается через процедуру SendFtpCmd.
Когда Winsock получает событие сокета FD_READ, которое происходит в результате ответа FTP-сервера на команду TYPE, он посылает процедуре FtpEvent сообщение с описанием события. В FtpEvent сообщение анализируется на предмет поиска событий FD_READ, FD_WRITE и FD_CLOSE. Для распознавания события сокета используется оператор case.
При получении события FD_READ процедура InfoEvent отправляет все содержимое буфера FRcvBuffer для вывода в приложении SHOPPER32. В буфере FRcv Buffer, содержащем код ответа от сервера, ищется символ 4 или 5, свидетель ствующий об ошибке FTP. Если поиск окажется успешным, FFtpCmd присваивается значение FTP_FAIL, которое сигнализирует приложению о возникнове нии ошибки.
В противном случае процедура ProcessRecvData обрабатывает FRcvBuffer и флаг состояния FFtpCmd с использованием оператора case. Так как FFtpCmd имеет значение FTP_TYPEI, ProcessRecvData вызывает процедуру ProcessTypeI, в которой выполняется подробный анализ содержимого FRcvBuffer. Следующий фрагмент кода показывает, как это делается:
procedure TCsShopper.ProcessTypeI; begin case GetReplyCode(FRcvBuffer) of 200 : begin if Pos('200-',String(FRcvBuffer)) = 0 then // Сервер ждет, пока мы создадим // соединение данных и пошлем команду USER begin ProcessPort; end; { остаток кода пропущен } end; // case FillChar(FRcvBuffer, SizeOf(FRcvBuffer),#0); end; Если код ответа равен 200, вызывается процедура ProcessPort, из которой в свою очередь вызывается InitDataConn, выполняющая четыре задачи:

	создание сокета для соединения данных;
	вызов WSAAsyncSelect для создания логического номера окна, позволяю щего FtpDataEvent перехватывать события сокета, связанные с соедине нием данных;
	вызов функции Winsock API bind для связывания нового сокета данных;
	вызов listen для перевода сокета данных в состояние «прослушивания» (listening).

Если в результате вызова InitDataConn будет создан допустимый сокет данных, ProcessPort создает для соединения данных уникальный номер порта, который затем передается процедурой SendFtpCmd. Наконец, флагу состояния FFtpCmd присваивается значение FTP_RETR, которое сигнализирует CsShopper о том, что следующее событие сокета FD_READ должно анализироваться в контекс те приема файла.
Когда на управляющем соединении происходит следующее событие FD_READ (при условии отсутствия ошибок сокета или отрицательных кодов ответа), вызывается процедура ProcessRecvData, которая в свою очередь инициирует ProcessGet.
В ProcessGet при получении кода ответа 200 (признак успеха) создается локальный файл, имя которого совпадает с именем файла на сервере. В дальнейшем код ответа 150 сигнализирует FTP-клиенту о том, что сервер приступил к пересылке информации через соединение данных.
Сразу же после того, как FTP-сервер свяжется с клиентом через соединение данных, Winsock уведомляет об этом процедуру FtpDataEvent с помощью события FD_ACCEPT. В ветви FD_ACCEPT оператора case вызывается функция WSAAsyncSelect, которая инициализирует сокет данных для приема только следующих событий: FD_READ, FD_WRITE и FD_CLOSE. Следующий фрагмент процедуры FtpDataEvent показывает, как это делается:
FD_ACCEPT : begin FStartTime := GetTickCount; FIntTime := FStartTime; if FListenSocket <> INVALID_SOCKET then begin nLen := SizeOf(TSockAddr); FDataSocket := accept(FListenSocket, @FRemoteHost, @nLen); if FDataSocket = SOCKET_ERROR then begin InfoEvent(Concat('Error : ',WSAErrorMsg)); FFtpCmd := FTP_FAIL; Exit; end; nStat := WSAAsyncSelect(FDataSocket, FDataWnd, DATA_EVENT, FD_READ or FD_WRITE or FD_CLOSE); if nStat = SOCKET_ERROR then begin InfoEvent(Concat('Error : ',WSAErrorMsg)); FFtpCmd := FTP_FAIL; Exit; end; { остаток кода пропущен } end; end; При приеме первого и последнего пакета данных через соединение данных Winsock уведомляет FtpDataEvent с помощью события FD_READ, что приводит к вызову RecvData для получения и сохранения поступающих данных в локальном файле. После завершения пересылки FTP-сервер закрывает соединение данных со своей стороны, заставляя Winsock послать сообщение FD_CLOSE. На этом пересылку файла логично было бы завершить, но иногда в сокете данных FTP-клиента все еще остаются непрочитанные данные. Чтобы избежать потерь информации, мы присваиваем флагу FTransferDone значение TRUE. Все сказанное демонстрируется следующим фрагментом кода из процедуры FtpDataEvent:
FD_CLOSE : begin FTransferDone := TRUE; case FFTPCmd of FTP_RETR, FTP_LIST, FTP_VIEW : RecvData; FTP_STOR : SendData; end; end; Флаг FTransferDone сообщает о необходимости продолжить чтение оставшихся данных сокета в цикле while, как показано в следующем фрагменте кода процедуры RecvData:
FTP_RETR : begin { часть кода пропущена } if FTransferDone then // Работа с //FTP-сервером закончена, // однако необходимо прочитать // и сохранить данные, оставшиеся // в сокете данных begin Done := FALSE; while not Done do begin BlockWrite(FRetrFile, FDataBuffer, Response); { часть кода пропущена } Response := recv(FDataSocket, FDataBuffer, SizeOf(FDataBuffer), 0); if Response = SOCKET_ERROR then begin Done := TRUE; WSAAsyncSelect(FDataSocket, // Прекратить посылку FDataWnd, 0, 0); // уведомлений CloseSocket(FDataSocket); System.CloseFile(FRetrFile); ChangeBusy(FALSE); ChangeDataDone(TRUE); InfoEvent(Concat('ERROR : ',WSAErrorMsg)); end; if Response = 0 then // Данных не осталось begin { часть кода пропущена } Done := TRUE; WSAAsyncSelect(FDataSocket, FDataWnd, 0, 0); CloseSocket(FDataSocket); System.CloseFile(FRetrFile); ChangeBusy(FALSE); ChangeDataDone(TRUE); GetList; end; end; end else if Response > 0 then // FTP-сервер продолжает // посылать данные, // их необходимо обработать begin BlockWrite(FRetrFile, FDataBuffer, Response); { часть кода пропущена } end; end; Передача файла FTP-серверу в асинхронном режиме выполняется по тому же принципу, что и прием.

Асинхронное получение адреса

Блокирующие функции gethostbyname и gethostbyaddr используются достаточно просто. С асинхронными версиями этих функций, WSAAsyncGetHostByName и WSA AsyncGetHostByAddr, дело обстоит несколько сложнее. Чтобы понять, как работает асинхронный процесс, мы посмотрим, как WSAAsyncGetHostByName вызывается в программе RESOLVER32.
Прежде всего смените значение свойства Access с Blocking на NonBlocking — для этого следует установить переключатель NonBlocking в групповом поле TypeOfLookup (см. рис. 5.6). При нажатии кнопки Resolve имя передается свойству HostName.

Рис. 5.6. Переход от блокирующих функций к псевдоблокирующим
Поскольку FAsync имеет значение NonBlocking, SetRemoteHostName передает его процедуре SetAsyncHostName (см. листинг 5.9).
Листинг 5.9. Метод TCsSocket.SetAsyncHostName — преобразование имени хоста
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; SetAsyncHostName вызывает процедуру WSAAsyncGetHostByName с пятью важными аргументами. FASyncHWND — логический номер окна, которому асинхронная функция должна отправить сообщение о завершении операции просмотра. Он инициализируется в конструкторе TCsSocket.Create вызовом AllocateHWND с параметром-процедурой AsyncOperation. ASYNC_EVENT — константа события, используемая в WSAAsyncGetHostByName. Символьный массив FAsyncBuff содержит результат выполнения операции. Наконец, MAXGETHOSTSTRUCT — константа Winsock, определяющая максимальный размер буфера FAsyncBuff. Процедура WSAAsyncGet HostByName возвращает номер задачи в виде значения типа TaskHandle, которое затем присваивается полю FTaskHandle.
WSAAsyncGetHostByName немедленно завершает работу с нулевым кодом, если вызов был неудачным; в случае удачного вызова она возвращает положительное число. Тем не менее отличное от 0 значение FTaskHandle свидетель ствует лишь об успешном вызове WSAAsyncGetHostByName, но не гарантирует успех последующей операции просмотра (которая продолжает выполняться в фоновом режиме).
После завершения просмотра Winsock DLL инициирует событие ASYNC_EVENT, сообщая процедуре AsyncOperation о том, что она должна обработать сообщение ASYNC_EVENT (см. листинг 5.10).
Листинг 5.10. Процедура AsyncOperation
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; Функция WSAGetAsyncError проверяет значение переменной Mess. Если переменная сообщает о происшедшей ошибке, AsyncOperation вызывает ErrorEvent для вывода причины ошибки из WSAErrorMsg, а затем завершает работу, присваивая флагу FStatus значение Failure. Если ошибки не было, мы анализируем переменную FAsyncType.
При вызове WSAAsyncGetHostByName мы присваиваем FAsyncType значение AsyncName, чтобы установить признак асинхронного поиска имени. Затем оператор case переходит к фрагменту, соответствующему значению AsyncName. Здесь символьный массив FAsyncBuff, содержащий результаты поиска, преобразуется в структуру pHostent и сохраняется в поле FHost. SetUpAddress читает адресную структуру найденного хоста и получает искомый IP-адрес. Наконец, процедура LookUpEvent возвращает IP-адрес программе RESOLVER32.

Базовая программа-фильтр

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

Благодарности

Благодарю Мардж Макрей (Marge McRae), друга и отличного соседа, за первое чтение рукописи и за предложенную идею с персонажем Мардж Рейнольдс (которая, кстати, не имеет ни малейшего отношения к настоящей Мардж).
Дон Тейлор
Выпуск такой книги требует неимоверных усилий- особенно когда в ее написании участвуют столько авторов (причем один из них нередко запаздывает со сдачей материалов). Дениза Константин (Denise Constantine), наш редактор проекта, проделала огромную работу. Ей удалось направить проект по правильному пути и разобраться с бесчисленными мелочами, мешающими выпуску книги. Спасибо Денизе - она заставила-таки меня сдавать работу в срок.
Джим Мишель
Хочу поблагодарить Джеффа Дантеманна (Jeff Duntemann) за то, что он вывел мою писательскую карьеру на орбиту успеха.
Джон Пенман
Хочу поблагодарить мою жену Таню, которая давно примирилась с выпавшим на ее долю тяжким жребием.
Джон Шемитц

Целостность структуры

и циклические ссылки
По иронии судьбы рекурсивная иерархия в одной таблице заметно упрощает обеспечение целостности структуры : одно поле таблицы ссылается на другое, принадлежащее этой же таблице. В пределах одной таблицы каждое значение Boss_ID равно значению Emp_ID другой записи или nil (для объектов верхнего уровня). При этом защищаются все потомки объекта — значение Emp_ID нельзя изменять, если от него зависят другие записи. Если же объединяющие значения находятся в нескольких полях или таблицах, в результате чего становится возможной многоуровневая группировка или установка сложных связей, обеспечить целостность структуры будет сложнее.
Для программы, работающей с иерархией, наибольшую опасность представляют циклические ссылки. Если объект ссылается на несуществующего родителя, проблему можно заметить и исправить. Но, если родитель объекта оказывается одновременно и его потомком (если объекты разделены несколькими промежуточными поколениями, такую ситуацию будет нелегко обнаружить), программа зацикливается.
Где же выход? Можно проверять каждого «кандидата в предки» и смотреть, не присутствуют ли какие-либо из его предков в текущем «семействе» (правда, это будет довольно накладно с точки зрения производительности). Кроме того, в программу можно вставить счетчик-предохранитель, который инициирует исключение после определенного количества циклов поиска. Одно из преимуществ графических иерархических элементов как раз и заключается в том, что пользователь просто не сможет создать циклическую ссылку, так как это противоречит логике работы с элементом.

Читаем, чтобы записывать?

На самом деле происходит следующее: в большинстве случаев действительно применима простая модель, описанная выше. Однако, если свойство является потомком TPersistent (например, TBitmap или TFont), происходит нечто странное. Для потомков TPersistent метод write вызывается в тех случаях, когда свойство задается в режиме конструирования или изменяется в режиме выполнения— но не при создании и загрузке компонента из DFM-потока его формы. Вместо этого runtime-библиотека вызывает метод read данного свойства, чтобы получить указатель на присвоенный ему private-объект, а затем использует полученный указатель для вызова метода чтения из потока. То есть при загрузке компонента метод write не вызывается!
Разумеется, в большинстве случаев это несущественно — свойство все равно загружается и получает в режиме выполнения то же значение, что было задано в режиме конструирования. Тем не менее в некоторых ситуациях это все же может отразиться на вашей программе.
Во-первых, метод read никогда не должен возвращать Nil. Мысль о том, чтобы отложить создание private-объекта до того момента, когда метод write предоставит копируемое значение, выглядит вполне разумно. К сожалению, код загрузки компонентов Delphi недостаточно умен — он просто не замечает, что у него нет объекта TPersistent, которому нужно дать команду загрузиться из потока. Поэтому если метод read возвращает Nil, то при загрузке компонента происходит GPF (General Protection Fault, ошибка защиты). Кстати, именно это обстоятельство привлекло мое внимание, хотя признаюсь, что я не сразу разобрался в сути происходящего.
Во-вторых, не стоит использовать метод write для того, чтобы извлекать информацию из private-объекта свойства и сохранять ее в других runtime-полях вашего компонента. Метод write вызывается при непосредственном задании свойства в режиме конструирования или выполнения, но не при косвенном задании этого свойства, происходящем в момент загрузки компонента. Если воспользоваться методом write для обновления внутреннего состояния компонента, загрузка будет работать неверно.

Что дальше?

Итак, я описал еще один способ получения перетаскиваемых файлов. В большинстве случаев он способен полностью заменить код, предложенный в предыдущей главе. Но важнее другое: мы взяли хорошо знакомый процесс (прием файлов) и реализовали его на основе совершенно новой (для нас) технологии COM/OLE. Заодно мы узнали, как OLE используется в программах. Теперь на основе полученных знаний мы создадим нечто совершенное иное, новое и гораздо более сложное— сервер (то есть источник) перетаскивания.

Что делать с кодом Windows?

Правильный ответ— инкапсулировать. Именно это делает Delphi, и делает очень успешно. Идея Delphi заключается как раз в том, чтобы оградить вас от мелких неприятных деталей Windows-программирования, чтобы все усилия можно было сосредоточить на смысловой части приложения. То же самое мы проделаем и с FMDD — «упакуем» его в одноименный модуль Delphi.
Вместо того чтобы заставлять форму возиться с обработкой WM_DROPFILES, мы определим в модуле FMDD специальную функцию, с помощью которой обработчик OnMessage формы сможет получить объект с полными сведениями о происходящем перетаскивании. Этот объект будет содержать всю информацию, полученную от интерфейса FMDD Windows, но объединенную в простую и удобную структуру:
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; Помимо структуры TDragDrop, в модуле FMDD определены три функции: AcceptDroppedFiles, UnacceptDroppedFiles и GetDroppedFiles. Две первые инкапсулируют функцию DragAcceptFiles, а третья вызывается при получении сообщения WM_DROPFILES и возвращает объект TDragDropInfo. В листинге 3.3 содержится первая версия модуля, FMDD1.PAS.
Листинг 3.3. Первая версия модуля FMDD, инкапсулирующего
интерфейс перетаскивания
{
FMDD1.PAS — Первая версия модуля, инкапсулирующего перетаскивание
файлов из File Manager
Автор: Джим Мишель
Дата последней редакции: 27/04/97
} unit fmdd1; interface uses Windows, Classes; 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; function GetDroppedFiles (hDrop : THandle) : TDragDropInfo; procedure AcceptDroppedFiles (Handle : HWND); procedure UnacceptDroppedFiles (Handle : HWND); implementation uses ShellAPI; constructor TDragDropInfo.Create (ANumFiles : UINT); begin inherited Create; FNumFiles := ANumFiles; FFileList := TStringList.Create; end; destructor TDragDropInfo.Destroy; begin FFileList.Free; inherited Destroy; end; function GetDroppedFiles (hDrop : THandle) : TDragDropInfo; var DragDropInfo : TDragDropInfo; TotalNumberOfFiles, nFileLength : Integer; pszFileName : PChar; i : Integer; begin { hDrop - логический номер внутренней структуры данных Windows с информацией о перетаскиваемых файлах. } { Определяем общее количество брошенных файлов, передавая функции DragQueryFile индексный параметр -1 } TotalNumberOfFiles := DragQueryFile (hDrop , $FFFFFFFF, Nil, 0); DragDropInfo := TDragDropInfo.Create (TotalNumberOfFiles); { Проверяем, были ли файлы брошены в клиентской области } DragDropInfo.FInClientArea := DragQueryPoint (hDrop, DragDropInfo.FDropPoint); for i := 0 to TotalNumberOfFiles - 1 do begin { Определяем длину имени файла, сообщая DragQueryFile о том, какой файл нас интересует ( i ) и передавая Nil вместо длины буфера. Возвращаемое значение равно длине имени файла. } nFileLength := DragQueryFile (hDrop, i , Nil, 0) + 1; GetMem (pszFileName, nFileLength); { Копируем имя файла — сообщаем DragQueryFile о том, какой файл нас интересует ( i ), и передаем длину буфера. ЗАМЕЧАНИЕ: Проследите за тем, чтобы размер буфера на 1 байт превышал длину имени, чтобы выделить место для завершающего строку нулевого символа! } DragQueryFile (hDrop , i, pszFileName, nFileLength); { Заносим файл в список } DragDropInfo.FFileList.Add (pszFileName); { Освобождаем выделенную память... } FreeMem (pszFileName, nFileLength); end; { Вызываем DragFinish, чтобы освободить память, выделенную Shell для данного логического номера. ЗАМЕЧАНИЕ: Об этом шаге нередко забывают, в результате возникает утечка памяти, а программа начинает медленнее работать. } DragFinish (hDrop); Result := DragDropInfo; end; procedure AcceptDroppedFiles (Handle : HWND); begin DragAcceptFiles (Handle, True); end; procedure UnacceptDroppedFiles (Handle : HWND); begin DragAcceptFiles (Handle, False); end; end. Чтобы старая тестовая программа работала с новым интерфейсом, в нее придется внести ряд изменений. Во-первых, замените ссылку на модуль ShellAPI в секции uses ссылкой на FMDD1. Затем исправьте обработ чики событий формы в соответствии с листингом 3.4. Обновленная версия программы содержится в файлах DRAG2.DPR и DRAGFRM2.PAS на прилагаемом компакт-диске.
Листинг 3.4. Использование нового интерфейса для перетаскивания
файлов из File Manager
procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage := AppMessage; FMDD1.AcceptDroppedFiles (Handle); end; procedure TForm1.WMDropFiles (hDrop : THandle; hWindow : HWnd); var DragDropInfo : TDragDropInfo; i : Integer; begin DragDropInfo := FMDD1.GetDroppedFiles (hDrop); { Проверяем, были ли файлы брошены в клиентской области } if DragDropInfo.InClientArea then Label2.Caption := "In client area" else Label2.Caption := "Not in client area"; { Заносим все файлы в список } for i := 0 to DragDropInfo.NumFiles - 1 do begin Listbox1.Items.Add (DragDropInfo.Files[i]); end; { Уничтожаем объект DragDropInfo } DragDropInfo.Free; end; procedure TForm1.FormClose (Sender: TObject; var Action: TCloseAction); begin { Прекращаем прием файлов } FMDD1.UnacceptDroppedFiles (Handle); end; По-моему, новым интерфейсом пользоваться намного проще. В полном соответствии с духом Delphi мы убрали код для работы с Windows API из приложения и вынесли его с глаз долой в отдельный модуль. Модуль FMDD копается во внутренностях Windows и достает оттуда нужный объект, с которым мы умеем работать. В результате код получается компактным и понятным, более простым в написании и сопровождении.

Что такое DLL и зачем они нужны?

DLL (Dynamic Link Library, библиотека динамической компоновки)— разновидность выполняемых файлов Windows, в которых содержится код или данные, используемые другими программами. По своей концепции DLL напоминают модули Delphi, они тоже представляют собой «упакованные» фрагменты кода, с помощью которых ваша программа может выполнять различные действия. Концепция похожа — но с ее реализацией дело обстоит совершенно иначе.
Компоновка модулей Delphi выполняется статически. Это означает, что во время компиляции копия кода всех модулей, используемых вашей программой, помещается в EXE-файл. Каждая программа, использующая тот или иной модуль, содержит отдельную копию этого модуля в своем EXE-файле. Обычно это не так уж плохо — программы должны быть по возможности самостоятельными. Тем не менее есть как минимум две веские причины, по которым статическая компоновка иногда нежелательна.
Если у вас имеется большой модуль, который используется многими программами, ваши программы будут содержать большое количество повторяющегося кода. Хотя дисковое пространство сейчас обходится примерно в 30 центов за мегабайт и проблема стала не столь актуальной, как раньше (здесь мы не будем обращать внимания на минимальный размер сектора), что произойдет, если вам потребуется запустить четыре или пять таких программ одновременно? В итоге код модуля будет дублироваться в памяти. Память тоже не так уж дорога, но и дешевой ее не назовешь — во всяком случае настолько дешевой, чтобы расходовать ее понапрасну.
Вторая причина, по которой статическая компоновка может оказаться нежелательной, — гибкость. Предположим, вы только что написали новейший текстовый редактор, настоящее программное чудо, и теперь хотите научить его импортировать документы из других файловых форматов (это необходимо сделать, чтобы выдержать конкуренцию на рынке текстовых редакторов). Конечно, можно написать специальный модуль для каждого распространенного файлового формата и выбросить продукт на рынок. Но через полгода выходит новая версия какого-нибудь Word Grinder Max (надеюсь, продукта с таким названием в действительности не существует) с новым форматом, и ваша программа устаревает! Единственный способ выйти из положения и научить программу работать с новым форматом — выпустить обновление, на котором вы не заработаете ничего, кроме хлопот. Кроме того, снова возникает проблема размера. При статической компоновке кода для работы с сотнями разных форматов ваша программа будет перегружена огромным количеством балласта — кода, который использу ется очень редко или нужен очень узкому кругу клиентов.
Обе проблемы решаются с помощью динамической компоновки. Вместо того чтобы копировать код модуля в EXE-файл приложения, DLL позволяет вынести многократно используемый код в специальный библиотечный файл, который будет загружаться во время выполнения только при необходимости. Даже если пять разных программ будут пользоваться функциями из DLL, на диске (и, что еще важнее, в памяти) будет храниться всего одна копия кода. В EXE-файл включается не статический фрагмент кода, а лишь инструкция насчет того, где программа должна искать необходимый код. Значит, вам уже не придется набивать свой текстовый редактор бесчисленными функциями для преобразования формата, достаточно предусмот реть возможность подключения новых DLL. Поддержка нового формата сводится, таким образом, к написанию DLL и распространению ее среди тех пользователей, которым это потребуется.
Вот что является подлинной гибкостью.

Что такое OLE?

Термин OLE— сокращение от «Object Linking and Embedding», то есть «связывание и внедрение объектов». С помощью этой технологии ваши приложения могут обмениваться информацией с другими приложениями через стандартные интерфейсы, доступ к которым возможен из множества различных языков программирования. Например, через интерфейс OLE программа Delphi может управлять работой Microsoft Word и заставлять его выполнять любые действия — загружать и печатать файлы, автоматически создавать документы и т. д. В документации Windows это называется «OLE Automation». С помощью OLE также создаются расширения для оболочки Windows 95, файловые ссылки, ярлыки (shortcuts) и вообще почти все, с помощью чего две программы в наши дни могут общаться друг с другом.
За те несколько лет, что прошли с момента выхода первой версии, технология OLE несколько раз подвергалась усовершенствованиям и переимено ваниям. Кроме термина «OLE» использовались термин «OCX» и с недавних пор — «ActiveX». Эта технология, как бы ее ни называли, построена на основе спецификации COM (Component Object Model, многокомпонентная модель объекта), которая и представляет в данном случае наибольший интерес. COM — это просто способ определения интерфейса, который полностью скрывает его реализацию. Спецификация интерфейса COM похожа на интерфейс ную часть модуля Delphi — вы знаете, что делает интерфейс, но не видите, как он это делает.
OLE в Windows — всего лишь набор частично реализованных спецификаций COM. Это нужно твердо усвоить. Например, интерфейс перетаскивания состоит из четырех основных интерфейсов: IDropTarget, IDropSource, IDataObject и IEnumFormatEtc. Но ни один из этих интерфейсов не реализован! Существуют функции, которые вызывают эти интерфейсы, однако вы сами должны написать код, который реализует эти интерфейсы и возвращает функциям Windows необходимые данные. OLE лишь определяет общие контуры — а вся грязная работа по их заполнению достается вам.

Что такое Winsock?

Winsock — сокращение от «Windows Sockets», это интерфейсная прослойка между Windows-приложением и базовой сетью TCP/IP. Интерфейс сокетов впервые появился в Berkeley Unix как API для работы с сетями TCP/IP. Winsock базируется на Berkeley Sockets API и включает большую часть стандартных функций BSD API, а также некоторые расширения, специфические для Windows. Поддержка сетевого взаимодействия через TCP/IP в Windows-программе сводится к вызову функций Winsock API и использованию библиоте ки WINSOCK.DLL, реализующей интерфейс Winsock.
Программисту на Delphi проще всего работать с Winsock API с помощью компонентов. В этой главе мы создадим компонент CsSocket, инкапсулирую щий Winsock API. Он обладает несколькими несомненными достоинствами:

	API становится составной частью Delphi VCL;
	инкапсуляция облегчает многократное использование кода;
	приложение-клиент видит четкий интерфейс, работа с которым происходит через свойства и методы.

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

Создайте новый компонент, производный от CsSocket.

В конструкторе нового компонента задайте свойству Service значение HTTP.

Добавьте методы и свойства, необходимые для работы с HTTP.

В следующей главе мы посмотрим, как это делается, на примере компонента для клиентского приложения FTP.

CsKeeper за работой

Приложение KEEPER32 (находится на CD-ROM в каталоге этой главы) показывает, как компонент CsKeeper используется в приложении. Форма приложения содержит три элемента-вкладки (TabSheet). Вся основная работа выполняется на первой вкладке, tsKeeper (см. рис. 7.1). Также присутствуют вкладки tsOptions и tsAbout (о них будет рассказано ниже).

Рис. 7.1. KEEPER32 в режиме конструирования (отображается вкладка tsKeeper)
Но перед тем, как запускать приложение KEEPER32, необходимо выполнить некоторые подготовительные действия. Конечно, можно определить поведение компонента CsKeeper1, изменяя значения его свойств в инспекторе объектов в режиме конструирования (см. рис. 7.2).
Однако работа со свойствами в режиме конструирования удобна для разработчика приложения, но никак не для пользователя — например FTP-администратора, который может вообще не быть программистом и не иметь доступа к исходным текстам программы и к среде Delphi. Администратор наверняка предпочтет работать с информацией о конфигурации FTP-сервера на вкладке tsOptions (обратите внимание: любые изменения в конфигурации учитываются только при загрузке и запуске приложения, поэтому, чтобы они подействовали, придется перезапустить FTP-сервер). Эта вкладка показана на рис. 7.3.

Рис. 7.2. Свойства CsKeeper1 в инспекторе объектов

Рис. 7.3. Вкладка Options в режиме конструирования

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

Авторы: Д. Тейлор, Дж. Мишель, Дж. Пенман
(c) Издательство "Питер", 1998

Демонстрационная программа

Мне потребовалась простая программа, которая бы демонстрировала возможности модуля PakTable. На рис. 14.2 показано, как она выглядит при работе. Исходный текст программы приведен в листинге 14.6.

Рис. 14.2. Программа Packing Demo
Листинг 14.6. Демонстрационная программа для упаковки
{————————} { Упаковка таблиц (демонстрационная программа) } { PackMain.PAS : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Программа, демонстрирующая применение модуля } { PakTable для упаковки таблиц Paradox и dBASE.} { } { Написано для *High Performance Delphi 3 } Programming* } { Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 3/5/97 } {————————} unit PackMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB, DBTables, StdCtrls, Grids, DBGrids, PakTable, ExtCtrls; type TForm1 = class(TForm) AddBtn: TButton; RemoveBtn: TButton; PackBtn: TButton; QuitBtn: TButton; Table1: TTable; DataSource1: TDataSource; DBGrid1: TDBGrid; Label1: TLabel; TableNameLabel: TLabel; Label2: TLabel; FileSizeLabel: TLabel; Label3: TLabel; NumRecsLabel: TLabel; Bevel1: TBevel; Table1MessageString: TStringField; Table1ID: TAutoIncField; procedure QuitBtnClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure AddBtnClick(Sender: TObject); procedure RemoveBtnClick(Sender: TObject); procedure PackBtnClick(Sender: TObject); procedure FormActivate(Sender: TObject); private TablePathName : ShortString; procedure UpdateFileLabels; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.QuitBtnClick(Sender: TObject); begin Close; end; procedure TForm1.FormCreate(Sender: TObject); var s : ShortString; begin Table1.Active := True; s := Application.ExeName; TablePathName := Copy(s, 1, pos(".", s)) + "DB"; TableNameLabel.Caption := TablePathName; end; procedure TForm1.UpdateFileLabels; var f : File of Byte; begin { При открытой таблице доступ к ее файлу невозможен } Table1.Close; AssignFile(f, TablePathName); {$I-} Reset(f); {$I+} if IOResult = 0 then begin FileSizeLabel.Caption := IntToStr(FileSize(f)); CloseFile(f); end else FileSizeLabel.Caption := "I/O error!"; { Снова открываем таблицу } Table1.Open; NumRecsLabel.Caption := IntToStr(Table1.RecordCount); end; procedure TForm1.AddBtnClick(Sender: TObject); var i : Integer; begin with Table1 do begin for i := 1 to 100 do begin Append; Table1.FieldByName ("MessageString").AsString := IntToStr(i) + ": Hello. My name is Mister Ed."; Post; end; { for } end; { with } UpdateFileLabels; end; procedure TForm1.RemoveBtnClick(Sender: TObject); begin with Table1 do begin First; while not EOF do begin Edit; Delete; MoveBy(3); end; { while } end; { with } UpdateFileLabels; end; procedure TForm1.PackBtnClick(Sender: TObject); begin if not PackTable(Table1) then MessageDlg("Error packing the table", mtError, [mbOK], 0); UpdateFileLabels; end; procedure TForm1.FormActivate(Sender: TObject); begin UpdateFileLabels; end; end. Это простое приложение демонстрирует процесс упаковки файлов Paradox. При нажатии кнопки Add в таблицу добавляются 100 новых записей; кнопка Remove удаляет каждую третью запись. Если несколько раз нажать Add и Remove и при этом следить за отображаемой информацией, становится очевидно, что операция удаления освобождает не все неиспользуемое место. Нажатие кнопки Pack Table не изменяет количества записей, но может заметно сократить общий размер файла.
Конец записи (20 марта).

Динамические данные и статические объявления

Модуль Math быстро работает и обладает широким набором функций, но таит в себе и ловушки. Чтобы получить максимум пользы от статистических функций, необходимо знать пару фокусов. Видите ли, многие функции модуля Math получают параметр, объявленный в виде
const Data: array of Double
Использование таких функций осложняется тем, что массив, передаваемый подобным образом, должен быть объявлен статическ и. С первого взгляда кажется, что передать этим функциям динамические данные невозможно. Большинство программистов находят для дилеммы динамических данных два обходных пути. Они:

«Зашивают» данные в программу (жесткое кодирование).

Создают огромный массив и надеются, что пользователь не выйдет за его пределы.

Иногда жесткое кодирование неизбежно, но чаще всего о нем даже не стоит думать. В нашем случае дело обстоит именно так. Рассмотрим следующий вызов функции Mean:
Mean([3, 2, 1, 5, 6]);
Фактически эта строка представляет собой калькулятор, который всегда выдает один и тот же результат. Не слишком полезный вариант, не правда ли1?
Понятно, что жесткое кодирование не решает проблем. Остается объявление массива «с запасом». Хотя в некоторых ситуациях такая методика чрезвычайно полезна (а иногда даже необходима), она может приводить к непредвиденным осложнениям.
Это особенно справедливо для модуля Math. Снова рассмотрим функцию Mean. «Среднее арифметическое» определяется как сумма N чисел, деленная на N. Предположим, у нас имеется массив из 10 000 элементов, который мы собираемся передать функции Mean. Если пользователь введет значения только для 50 элементов, знаменатель (N) будет по-прежнему равен 10 000 и превысит правильное значение на 9 950! Как говорится, приплыли…

Динамический пользовательский интерфейс

Теренс Гоггин
Если пользователям не нравится тот интерфейс, который вы им предлагаете, то почему бы не позволить им самостоятельно переделать его во время работы программы? Имитировать режим конструирования во время выполнения оказывается проще, чем вы думаете, причем это может радикально сказаться на привлекательности вашего приложения.
Признаем очевидный факт: люди смотрят на одни и те же вещи по-разному. Если бы мнения пользователей насчет представления данных совпадали, существовала бы всего одна персональная информационная система (Personal Information Manager, PIM). Но этого не происходит— рынок забит PIM'ами всех размеров и мастей.
Некоторым разработчикам удается отыскать удачные интерфейсные решения, и их продукты немедленно обретают всеобщее признание. Другие программы сложны и кажутся интуитивно понятными разве что своим создателям. Похоже, третьего не дано.
Иногда сложная в использовании программа оказывается настолько полезной, что пользователи заставляют себя работать с ней, как бы трудно им ни было. Но не стоит рассчитывать на это при проектировании новой программы, лучше сразу приготовиться к жалобам.
Идеальный пример — панель инструментов MS Word 6.0. Возможно, вам всегда было понятно, зачем нужны эти кнопочки с кривыми стрелочками. С другой стороны, вы могли решить, что панель слишком загромождена и непонятна. Промежуточных вариантов опять же не бывает: интуиция говорит либо «да», либо «нет».
Поскольку любая компания в конечном счете стремится продать как можно больше своих продуктов, разработчики графических интерфейсов не могут просто игнорировать клиентов, живущих под девизом «все не так» — но они не могут и менять весь дизайн проекта в угоду прихотям отдельных пользователей.
До сих пор никто толком не занимался этой проблемой. Никто не пытался разработать для конечного пользователя интерфейс, построенный по принципу «сделай сам». Но достаточно взять Delphi 2 или Delphi 3, добавить немного изобретательности — и перед вами инспектор объектов, встроенный прямо в программу!
Сначала мы посмотрим, как может выглядеть простейшее приложение для работы с базой данных, поддерживающее динамическое конструирование. Затем мы обсудим некоторые механизмы, которые делают подобный интерфейс возможным.

DLL: недостатки и предостережения

Большинство программистов после знакомства с новой концепцией начинают вести себя, как маньяк с новой бензопилой— им не терпится опробовать новинку в деле. Порой они проявляют чудеса извращенной изобретатель ности, чтобы оправдать ее применение в конкретной ситуации. Как бы трудно вам ни было, постарайтесь удержаться. Несомненно, DLL — классная штука, но она может легко превратиться в источник сплошных бед.
Даже не пытайтесь вынести в DLL какие-либо обязательные возможности вашей программы. Например, подсистема форматирования текста в редакторе должна относиться к программе, а не к внешней DLL. DLL следует приберечь для необязательных возможностей (в том числе и дополнений, написанных посторонними фирмами) и общих библиотек. Вс?! Применяя DLL для других целей, вы сами напрашиваетесь на неприятности.
Самый большой недостаток DLL — проверка типов (а вернее, ее отсутствие). Обращаясь к функции DLL при любом способе импорта, вы фактически приказываете компилятору вызвать функцию, о которой он ничего не знает. Например, в модуле BEEPDLL.PAS содержится следующее объявление:
procedure BeepMe; external "beeper.dll";
Данное объявление просто сообщает компилятору о том, что существует некая процедура BeepMe и она находится в указанной DLL. Замечательно. Компилятор верит вам на слово. Он никак не может найти файл BEEPER.DLL, дизассемблировать его и убедиться, что в нем действительно есть процедура с именем BeepMe и что она вызывается без параметров. Если процедура BeepMe в DLL должна получать один или несколько параметров (или в случае процедуры с параметрами — параметры другого типа), при вызове BeepMe разверзнется сущий ад: процедура получит неверное количество параметров или они будут иметь неверный тип. Гарантирую, что это когда-нибудь случится и с вами. По своему опыту знаю, что найти подобную ошибку очень сложно. Стыдно признаваться, но я и сам столкнулся с этой проблемой вскоре после того, как написал предыдущую фразу, во время работы над программой для следующего раздела.
Если вас интересует более подробное (и устрашающее) описание проблем, связанных с DLL, почитайте книгу Лу Гринзо (Lou Grinzo) «Zen of Windows 95 Programming» (Coriolis Group Books, 1995). Эта превосходная книга содержит массу полезной информации о программировании для Windows, а также ряд хороших советов по поводу программирования вообще. Для программирования необходима паранойя (в разумных дозах) и твердая вера в справедливость законов Мерфи. Даже если вы не верите в это сейчас, то после прочтения книги Лу непременно поверите.
Я заканчиваю выступление и слезаю с трибуны, и не говорите потом, что вас не предупреждали. Теперь вы знаете, как создавать DLL, так давайте посмотрим, что можно сделать с их помощью.

Другие применения

EMBEDDEFORMS.DPR демонстрирует лишь два первых сценария из четырех, описанных в начале этой главы, — использование одной и той же формы для мастера и списка свойств, а также использование форм как компонентов. Я не привел ни одного реального примера для двух последних сценариев, связанных с использованием внедренных форм для совместной разработки диалогового окна со вкладками или с построением универсального редактора, способного работать с любым объектом иерархии. Тем не менее я продемонстрировал всю методику, необходимую для реализации этих, более редких сценариев.
Чтобы построить диалоговое окно из нескольких независимых форм, достаточно породить каждую из них от TEmbeddedForm. Создайте вкладку для каждой страницы и в обработчике OnCreate диалогового окна вызовите Create Embedded для формы каждой страницы. Обычно я стараюсь соблюдать общее правило «Сам создал — сам уничтожай» и аккуратно уничтожаю страницы в обработчике OnDestroy, но, строго говоря, без этого можно обойтись, так как при уничтожении диалогового окна уничтожаются все его дочерние компоненты. Если вам потребуется постраничная проверка корректности (например, чтобы пользователь не мог покинуть страницу с неверными данными), используйте TFickleView вместо TEmbeddedForm.
Универсальный редактор можно построить на основе абстрактного редактора моделей — объект-контейнер содержит все стандартные элементы, а пустая панель-фрейм предназначена для размещения специализированных элементов. Для каждого члена иерархии объектов можно создать функцию класса (class function), которая возвращает TViewClass. Это позволит универсальному редактору заполнить фрейм правильным видом, соответствующим редактируемому объекту.
За последний год мне пришлось довольно много возиться с внедренными формами. Они помогают существенно упростить программу, сделать ее более надежной и гибкой. Такая возможность всегда присутствовала в Windows, но она оставалась невероятно сложной до тех пор, пока среда Delphi не сделала ее простой.

Другой подход к потокам

Возможно, вы заметили, что класс TFileStream тоже содержит методы для сохранения и загрузки свойств компонента. Хотя TFileStream содержит целых два набора методов для сохранения и загрузки компонентов, эти методы выполняют лишнюю работу, что снижает эффективность такого варианта по сравнению с выбранной нами реализацией TReader/TWriter.
Методы WriteComponentRes и ReadComponentRes сохраняют и загружают компоненты в формате стандартных ресурсов Windows. Это связано с лишней вычислительной нагрузкой. К тому же многие данные, сохраняемые этими методами, просто не представляют для нас интереса и лишь увеличивают размер файла свойств.
Методы WriteComponents и ReadComponents приводят к тому же конечному результату, что и в нашем случае, но при этом вызывается пара лишних функций. Наш способ работает эффективнее и немного быстрее.

Файловые операции чтения/записи

Разобравшись с анализом командных строк, мы приступаем к следующей крупной подзадаче- файловому вводу/выводу. Разумеется, при простейших посимвольных (или построчных) преобразованиях текстовых файлов можно пользоваться функциями Read и Write (или ReadLn и WriteLn) в сочетании с Eof и Eoln. Например, процедура DoFilter из листинга 1.7 копирует символы из входного файла в выходной, преобразуя их к верхнему регистру.
Листинг 1.7. Перевод символов в верхний регистр
procedure DoFilter; const nOptions = 2; Options : Array [1..nOptions] of OptionRec = ( (OptionChar : "i"; Option : otFilename; Filename : ""), (OptionChar : "o"; Option : otFilename; Filename : "") ); var cRslt : Boolean; iRec : pOptionRec; oRec : pOptionRec; InputFile : Text; OutputFile : Text; c : char; begin cRslt := CmdLine.ProcessCommandLine (@Options, nOptions); if (not cRslt) then Halt; { Убедимся в том, что были заданы имена входного и выходного файлов } iRec := CmdLine.GetOptionRec (@Options, nOptions, "i"); if (iRec^.Filename = "") then begin WriteLn ("Error: input file expected"); Halt; end; oRec := CmdLine.GetOptionRec (@Options, nOptions, "o"); if (oRec^.Filename = "") then begin WriteLn ("Error: output file expected"); Halt; end; { Открываем входной файл - без проверки ошибок} Assign (InputFile, iRec^.Filename); Reset (InputFile); { Создаем выходной файл - без проверки ошибок} Assign (OutputFile, oRec^.Filename); Rewrite (OutputFile); { Читаем и преобразуем каждый символ } while (not Eof (InputFile)) do begin Read (InputFile, c); c := UpCase (c); Write (OutputFile, c); end; Close (InputFile); Close (OutputFile); end; У данной версии программы FILTER есть два недостатка. Во-первых, она еле ползает - словно змея, пробуждающаяся от зимней спячки. Если у вас найдется мегабайтовый текстовый файл и несколько свободных минут, убедитесь сами. Во-вторых, она работает только с текстовыми файлами. Для одноразового приложения сойдет и так, но мы пишем шаблон для различных
программ, которым может понадобиться работать и с двоичными файлами. Да и скорость работы не мешало бы повысить. Поэтому необходимо найти более универсальный и быстрый способ чтения символов (или байтов) из файла. Нам придется самостоятельно организовать буферизацию; программа при этом усложняется, но результат стоит затраченных усилий.
Класс TFilterFile из листинга 1.8 предназначен для организации быстрых побайтовых операций с файлами в программах-фильтрах. Он инкапсулирует все детали буферизации и по возможности избавляет программиста от необходимости помнить о многочисленных житейских проблемах работы с файлами (вам остается лишь вызвать Open и Close).
Листинг 1.8. Реализация класса TFilterFile из файла FILEIO.PAS
{ FILEIO.PAS - Файловый ввод/вывод для программ-фильтров Автор: Джим Мишель Дата последней редакции: 04/05/97 } {$I+} { Использовать исключения для обработки ошибок } unit fileio; interface type FileIOMode = (fioNotOpen, fioRead, fioWrite); BuffArray = array[0..1] of byte; pBuffArray = ^BuffArray; TFilterFile = class (TObject) private FFilename : String; F : File; FBufferSize : Integer; FBuffer : pBuffArray; FBytesInBuff : Integer; FBuffIndx : Integer; FFileMode : FileIOMode; function ReadBuffer : boolean; function WriteBuffer : boolean; public constructor Create (AName : String; ABufSize : Integer); destructor Destroy; override; function Open (AMode : FileIOMode) : Boolean; procedure Close; function Eof : Boolean; function GetByte : byte; function PutByte (b : byte) : boolean; end; implementation { TFilterFile } { Create - подготавливает, но не открывает файл } constructor TFilterFile.Create ( AName : String; ABufSize : Integer ); begin inherited Create; FFilename := AName; FBufferSize := ABufSize; FBytesInBuff := 0; FBuffIndx := 0; FFileMode := fioNotOpen; { Назначаем, но не открываем } Assign (F, FFilename); { Выделяем память для буфера } GetMem (FBuffer, FBufferSize); end; { Destroy - закрывает файл (если он открыт) и уничтожает объект } destructor TFilterFile.Destroy; begin { Если файл открыт, закрываем его } if (FFileMode <> fioNotOpen) then begin Self.Close; end; { Если был выделен буфер, освобождаем его } if (FBuffer <> Nil) then begin FreeMem (FBuffer, FBufferSize); FBuffer := Nil; end; inherited Destroy; end; { Open - открыть файл в нужном режиме } function TFilterFile.Open ( AMode : FileIOMode ) : Boolean; var SaveFileMode : Byte; begin Result := True; SaveFileMode := FileMode; { переменная FileMode определена в модуле System } { Пытаемся открыть файл } try case AMode of fioRead : begin FileMode := 0; Reset (F, 1); end; fioWrite : begin FileMode := 1; Rewrite (F, 1); end; end; FFileMode := AMode; except Result := False; end; FBytesInBuff := 0; FBuffIndx := 0; FileMode := SaveFileMode; end; { Close - закрывает файл, при необходимости сбрасывая буфер } procedure TFilterFile.Close; begin { Если буфер записи не пуст, записываем его } if ((FFileMode = fioWrite) and (FBytesInBuff > 0)) then begin WriteBuffer; end; try { Закрываем файл } System.Close (F); finally FFileMode := fioNotOpen; end; end; { ReadBuffer - читает блок из файла в буфер } function TFilterFile.ReadBuffer : Boolean; begin Result := True; if (Self.Eof) then begin Result := False; end else begin try BlockRead (F, FBuffer^, FBufferSize, FBytesInBuff); except Result := False; end; end; end; { GetByte - возвращает следующий байт из файла. При необходимости читает из файла в буфер } function TFilterFile.GetByte : byte; begin if (FBuffIndx >= FBytesInBuff) then begin if (not ReadBuffer) then begin Result := 0; Exit; end else begin FBuffIndx := 0; end; end; Result := FBuffer^[FBuffIndx]; Inc (FBuffIndx); end; { WriteBuffer - записывает блок из буфера в файл } function TFilterFile.WriteBuffer : Boolean; begin Result := True; try BlockWrite (F, FBuffer^, FBytesInBuff); except Result := False; end; if (Result = True) then begin FBytesInBuff := 0; end; end; { PutByte - заносит байт в буфер. При необходимости записывает буфер в файл } function TFilterFile.PutByte (b : byte) : Boolean; begin if (FBytesInBuff = FBufferSize) then begin if (not WriteBuffer) then begin Result := False; Exit; end else begin FBytesInBuff := 0; end; end; FBuffer^[FBytesInBuff] := b; Inc (FBytesInBuff); Result := True; end; { Eof - возвращает True, если был достигнут конец входного файла } function TFilterFile.Eof : Boolean; begin Result := (FBuffIndx >= FBytesInBuff); if Result then begin try Result := System.Eof (F); except Result := True; end; end; end; end. Поскольку класс TFilterFile почти все делает сам, использовать его вместо стандартного текстового файла ввода/вывода оказывается очень просто. Тем не менее скорость работы меняется прямо на глазах. Новая процедура DoFilter из листинга 1.9 использует класс TFilterFile для выполнения файловых операций. Получившаяся программа работает намного быстрее первоначальной версии. А самое приятное заключается в том, что прочесть или понять ее оказывается ничуть не сложнее, чем предыдущий, медленный вариант.
Листинг 1.9. Использование класса TFilterFile вместо
стандартного файлового ввода/вывода
{ FILTMAIN.PAS - основной рабочий модуль программы Filter. Автор: Джим Мишель Дата последней редакции: 04/05/97 } unit filtmain; interface { DoFilter выполняет всю работу } procedure DoFilter; implementation uses CmdLine, FileIO; procedure DoFilter; const nOptions = 2; Options : Array [1..nOptions] of OptionRec = ( (OptionChar : "i"; Option : otFilename; Filename : ""), (OptionChar : "o"; Option : otFilename; Filename : "") ); BigBufferSize = 65536; var cRslt : Boolean; iRec : pOptionRec; oRec : pOptionRec; InputFile : TFilterFile; OutputFile : TFilterFile; c : char; begin cRslt := CmdLine.ProcessCommandLine(@Options, nOptions); if (not cRslt) then Halt; { Убедимся в том, что были заданы имена входного и выходного файлов } iRec := CmdLine.GetOptionRec (@Options, nOptions, "i"); if (iRec^.Filename = "") then begin WriteLn ("Error: input file expected"); Halt; end; oRec := CmdLine.GetOptionRec (@Options, nOptions, "o"); if (oRec^.Filename = "") then begin WriteLn ("Error: output file expected"); Halt; end; { Создаем и открываем входной файл } InputFile := TFilterFile.Create (iRec.Filename, BigBufferSize); if (not InputFile.Open (fioRead)) then begin WriteLn ("Error opening input file"); Halt; end; { Создаем и открываем выходной файл } OutputFile := TFilterFile.Create (oRec.Filename, BigBufferSize); if (not OutputFile.Open (fioWrite)) then begin WriteLn ("Error opening output file"); Halt; end; { Обрабатываем каждый символ } while (not InputFile.Eof) do begin c := char (InputFile.GetByte); c := UpCase (c); if (not OutputFile.PutByte (byte (c))) then begin WriteLn ("Write error"); Halt; end; end; InputFile.Close; InputFile.Free; OutputFile.Close; OutputFile.Free; end; end.

Фильтры

Вероятно, из всех средств командной строки на персональных компьютерах чаще всего встречаются программы, принадлежащие к широкой категории «фильтров». Фильтром может быть все, что угодно, -от простейшего счетчика строк до сложного компилятора (например, компилятора языка Паскаль из Delphi), утилиты сортировки или программы пакетных вычислений.
Все фильтры построены на одном принципе: они вызываются из командной строки и получают аргументы, в которых задаются параметры их работы, а также имена входных и выходных файлов. Фильтр читает входные данные, выполняет некоторые вычисления (зависящие от параметров, указанных в командной строке) и записывает результат в выходной файл.
Фильтры обычно не работают с мышью и вообще очень редко взаимодействуют с пользователем. Если же фильтр все-таки получает информацию от пользователя, то для этого применяется простейший текстовый интерфейс. Вывод, как правило, ограничивается информацией о ходе процесса («Working, please wait…»), сообщениями об ошибках и завершающим сообщением «Done».
В этой главе мы напишем на Delphi относительно простую программу -фильтр, построив при этом «каркас», на основе которого можно будет легко создавать другие фильтры. Попутно мы узнаем кое-что о хранилище объектов Delphi, многократном использовании кода и (содрогнитесь от ужаса) процессно-ориентированном программировании.
Замечание
Ирония судьбы - всего три года назад я преподавал программирование для Windows DOS-программистам и рассказывал им о том, как отказаться от традиционного процессно-ориен тированного мышления и войти в широкий мир управляемых событиями Windows-программ. С появлением визуальных средств разработки - таких как Visual Basic и Delphi - многие новички сразу начинают с событийного программирования и даже не умеют писать процессно-ориентированные средства командной строки. А теперь я рассказываю вам о том, как от событийного программирования вернуться к процессно-ориентированному. Plus зa change.
Единственный «плюс» заключается в том, что программист, привыкший работать с событиями, без особых трудностей поймет процессно-ориентированный код. Обратное, к сожалению, неверно.

Финансовые функции и процедуры

DoubleDecliningBalance Вычисление амортизации методом двойного баланса
FutureValue Будущее значение вложения
InterestPayment Вычисление процентов по ссуде
InterestRate Норма прибыли, необходимая для получения заданной
суммы
InternalRateOfReturn Вычисление внутренней скорости оборота вложения для
ряда последовательных выплат
NetPresentValue Вычисление чистой текущей стоимости вложения для
ряда последовательных выплат с учетом процентной
ставки
NumberOfPeriods Количество периодов, за которое вложение достигнет
заданной величины
Payment Размер периодической выплаты, необходимой для пога-
шения ссуды, при заданном числе периодов, процентной
ставке, а также текущем и будущем значениях ссуды
PeriodPayment Платежи по процентам за заданный период
PresentValue Текущее значение вложения
SLNDepreciation Вычисление амортизации методом постоянной нормы
SYDepreciation Вычисление амортизации методом весовых коэф-
фициентов

Где и как хранится конфигурация

Все параметры конфигурации, не считая текстовых файлов с приветственным и прощальным сообщениями, хранятся в системном реестре Windows 95 или NT4.0. Для загрузки и сохранения этих сообщений используется класс Delphi TRegistry. При запуске приложения KEEPER32 обработчик frmMain.OnCreate вызывает процедуру LoadSettings для чтения параметров из реестра Windows. Листинг 7.2 показывает, как это делается. После чтения из реестра LoadSettings обновляет свойства CsKeeper1 в соответствии с полученными значениями.
Листинг7.2. Процедура LoadSettings
procedure TfrmMain.LoadSettings; var Reg : TRegistry; Count : Integer; IPName : String; begin Reg := TRegistry.Create; // Чтение параметров try Reg.OpenKey(FtpServerKey, TRUE); if Reg.ValueExists('DRootDisk') then CsKeeper1.RootDisk := Reg.ReadString('DRootDisk') else CsKeeper1.RootDisk := ''; if Reg.ValueExists('DRootDir') then CsKeeper1.RootDir := Reg.ReadString('DRootDir') else CsKeeper1.RootDir := ''; finally Reg.CloseKey; end; try Reg.OpenKey(FtpServerKey, TRUE); if Reg.ValueExists('DTransferMode') then begin OldTransferMode := Reg.ReadString('DTransferMode'); if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[STREAM]) then begin CsKeeper1.Transfer := STREAM; rgTransfer.ItemIndex := 0; end; if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[BLOCK]) then begin CsKeeper1.Transfer := BLOCK; rgTransfer.ItemIndex := 1; end; if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[COMPRESSED]) then begin CsKeeper1.Transfer := COMPRESSED; rgTransfer.ItemIndex := 2; end; end else begin OldTransferMode := UpperCase(FtpTransferStr[STREAM]); CsKeeper1.Transfer := STREAM; end; finally Reg.CloseKey; end; // Свойство файловой структуры try Reg.OpenKey(FtpServerKey, TRUE); if Reg.ValueExists('DFileStructure') then begin OldFileStruct := Reg.ReadString('DFileStructure'); if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[NOREC]) then begin CsKeeper1.FileStruct := NOREC; rgFileStructure.ItemIndex := 0; end; if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[REC]) then begin CsKeeper1.FileStruct := REC; rgFileStructure.ItemIndex := 1; end; if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[PAGE]) then begin CsKeeper1.FileStruct := PAGE; rgFileStructure.ItemIndex := 2; end; end else begin OldFileStruct := UpperCase(FtpFileStructStr[NOREC]); CsKeeper1.FileStruct := NOREC; rgFileStructure.ItemIndex := 0; end; finally Reg.CloseKey; end; // Разрешение на создание новых каталогов try Reg.OpenKey(FtpServerKey, TRUE); if Reg.ValueExists('DCreateNewDir') then begin OldMkDir := Reg.ReadBool('DCreateNewDir'); CsKeeper1.CreateDir := OldMkDir; if OldMkDir then cbAllowMkDir.State := cbChecked else cbAllowMkDir.State := cbUnChecked; end else begin OldMkDir := FALSE; CsKeeper1.CreateDir := OldMkDir; end; finally Reg.CloseKey; end; // Разрешение на удаление каталогов try Reg.OpenKey(FtpServerKey, TRUE); if Reg.ValueExists('DDeleteDir') then begin OldDeleteDir := Reg.ReadBool('DDeleteDir'); CsKeeper1.DeleteDir := OldDeleteDir; if OldDeleteDir then cbDeleteDir.State := cbChecked else cbDeleteDir.State := cbUnChecked; end else begin OldDeleteDir := FALSE; CsKeeper1.DeleteDir := OldDeleteDir; cbDeleteDir.State := cbUnChecked; end; finally Reg.CloseKey; end; // Разрешение на передачу файлов try Reg.OpenKey(FtpServerKey, TRUE); if Reg.ValueExists('DUpLoads') then begin OldUpLoads := Reg.ReadBool('DUpLoads'); CsKeeper1.UpLoads := OldUpLoads; if OldUpLoads then cbUpLoad.State := cbChecked else cbUpLoad.State := cbUnChecked; end else begin OldUpLoads := FALSE; CsKeeper1.UpLoads := OldUpLoads; cbUpLoad.State := cbUnChecked; end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpServerKey, TRUE); if Reg.ValueExists('DNoBannedIPs') then NoOfBannedIPs := Reg.ReadInteger ('DNoBannedIPs') else NoOfBannedIPs := 1; finally Reg.CloseKey; end; // Список запрещенных IP-адресов for Count := 0 to NoOfBannedIPs - 1 do begin IPName := Concat('IPName', IntToStr(Count)); try Reg.OpenKey(FtpServerKey + '\IPs' + '\ ' + IPName, TRUE); if Reg.ValueExists('IPName') then lbBadIPAddrs.Items.Add(Reg.ReadString ('IPName')) else lbBadIPAddrs.Items.Add(''); OldBannedIPsList.Add(lbBadIPAddrs.Items.Strings [Count]); finally Reg.CloseKey; end; end; // цикл for with CsKeeper1 do begin if Length(RootDisk) > 0 then dcbRootDisk.Drive := Char(RootDisk[1]) else dcbRootDisk.Drive := 'C'; if Length(RootDir) > 0 then dlbRootDir.Directory := RootDir; for Count := 0 to NoOfBannedIPs - 1 do BadIPs.Add(lbBadIPAddrs.Items.Strings[Count]); end; Reg.Free; end;

Где Windows ищет DLL

Если в вашем приложении используется DLL, установочная программа обычно помещает ее в один каталог с исполняемым файлом программы. В этом случае у Windows не возникнет никаких проблем с поиском DLL при загрузке программы (или при вызове LoadLibrary, если вы выбрали динамический импорт). Если приложение помещает несколько исполняемых файлов в различные каталоги, вы можете либо скопировать DLL в каждый из этих каталогов (что отчасти противоречит главной цели DLL), либо поместить DLL в один общий каталог, просматриваемый Windows по умолчанию при загрузке DLL.
Итак, Windows ищет DLL в следующих местах (и в следующем порядке):

Каталог, из которого было загружено приложение.

Текущий каталог.

Системный каталог Windows.

Только для Windows NT: системный каталог 16-разрядной Windows.

Каталог Windows.

Каталоги, перечисленные в переменной окружения PATH.
В случае динамического импорта при вызове LoadLibrary можно указать для DLL полный путь, тогда Windows просмотрит только заданный каталог. Если вы хотите, чтобы Windows автоматически загружала DLL при запуске (статический импорт), такой возможности уже не будет.

Генерация и отображение ландшафта

После такого внушительного пролога код для генерации ландшафта выглядит на удивление просто. Процедура FractureTriangle() (см.листинг 8.2) получает треугольник и количество остающихся итераций Plys. Если Plys превышает 1, FractureTriangle() вызывает FractureLine() для расчета (или получения готовых) высот середин отрезков, а затем вызывает себя для каждого из четырех треугольников, которые получаются после разделения. FractureLine() вызывает Midpoint() (обе процедуры приведены в листинге 8.2), чтобы вычислить среднюю точку отрезка, образованного двумя вершинами, и затем смотрит, была ли ее высота задана ранее. Если середина еще не инициализирована, FractureLine() изгибает отрезок, поднимая или опуская его середину.
После того как ландшафт будет рассчитан, FL3 отображает его в текущем окне и в текущем режиме отображения с помощью кода, приведенного в листинге 8.3. При изменении размеров окна или режима отображения FL3 перерисовывает ландшафт.
Листинг 8.3. Модуль DISPLAY.PAS
unit Display; { Fractal Landscapes 3.0 - Copyright © 1987..1997, Джон Шемитц } interface uses WinTypes, WinProcs, SysUtils, Graphics, Forms, Global, Database; const DrawingNow: boolean = False; AbortDraw: boolean = False; type EAbortedDrawing = class (Exception) end; procedure ScreenColors; procedure PrinterColors; procedure DrawTriangle( Canvas: TCanvas; const A, B, C: TVertex; Plys: word; PointDn: boolean); procedure DrawVerticals(Canvas: TCanvas); {$ifdef Debug} const DebugString: string = ''; {$endif} implementation uses Main; type Surfaces = record Outline, Fill: TColor; end; const scrnLand: Surfaces = (Outline: clLime; Fill: clGreen); scrnWater: Surfaces = (Outline: clBlue; Fill: clNavy); scrnVertical: Surfaces = (Outline: clGray; Fill: clSilver); prnLand: Surfaces = (Outline: clBlack; Fill: clWhite); prnWater: Surfaces = (Outline: clBlack; Fill: clWhite); prnVertical: Surfaces = (Outline: clBlack; Fill: clWhite); var Land, Water, Vertical: Surfaces; procedure ScreenColors; begin Land := scrnLand; Water := scrnWater; Vertical := scrnVertical; end; procedure PrinterColors; begin Land := prnLand; Water := prnWater; Vertical := prnVertical; end; function Surface(Outline, Fill: TColor): Surfaces; begin Result.Outline := Outline; Result.Fill := Fill; end; { $define Pascal} {$define Float} {$ifdef Pascal} {$ifdef Float} type TFloatTriple = record X, Y, Z: double; end; function FloatTriple(T: TTriple): TFloatTriple; begin Result.X := T.X / UnitLength; Result.Y := T.Y / UnitLength; Result.Z := T.Z / UnitLength; end; function Project(const P: TTriple): TPixel; { Перспективное преобразование координат точки } var Delta_Y: double; Tr, V: TFloatTriple; begin Tr := FloatTriple(P); V := FloatTriple(VanishingPoint); Delta_Y := Tr.Y / V.Y; Result.X := Round( DisplayWidth * ((V.X - Tr.X) * Delta_Y + Tr.X)); Result.Y := DisplayHeight - Round( DisplayHeight * ((V.Z - Tr.Z) * Delta_Y + Tr.Z)); end; {$else} function Project(const Tr: TTriple): TPixel; { Перспективное преобразование координат точки } var Delta_Y: integer; begin Delta_Y := MulDiv(Tr.Y, UnitLength, VanishingPoint.Y); Result.X := MulDiv( MulDiv ( VanishingPoint.X - Tr.X, Delta_Y, UnitLength) + Tr.X, DisplayWidth, UnitLength); Result.Y := DisplayHeight - MulDiv( MulDiv( VanishingPoint.Z - Tr.Z, Delta_Y, UnitLength) + Tr.Z, DisplayHeight, UnitLength ); end; {$endif} {$else} function Project(const Tr: TTriple): TPixel; assembler; { Перспективное преобразование координат точки } asm {$ifdef Ver80} {Delphi 1.0; 16-bit} les di,[Tr] mov si,word ptr UnitLength { Масштабный коэффициент } mov ax,[TTriple ptr es:di].Y{ Tr.Y } imul si { Умножаем на LoWord(UnitLength) } idiv VanishingPoint.Y { Scaled(depth/vanishing.depth) } {DeltaY equ bx } mov bx,ax { Сохраняем Delta.Y } mov ax,VanishingPoint.Z sub ax,[TTriple ptr es:di].Z{ Delta.Z } imul bx { Delta.Z * Delta.Y } idiv si { Unscale(Delta.Z * Delta.Y) } add ax,[TTriple ptr es:di].Z { Tr.Z + Unscale(Delta.Z * Delta.Y) } mov cx,[DisplayHeight] { Используем дважды... } imul cx { (Tr.Z+Delta.Z*Delta.Y)*Screen.Row } idiv si { Unscale } sub cx,ax { Px.Y } mov ax,VanishingPoint.X sub ax,[TTriple ptr es:di].X { Delta.X } imul bx { Delta.X * Delta.Y } idiv si { Unscale(Delta.X * Delta.Y) } add ax,[TTriple ptr es:di].X { Tr.X + Unscale(Delta.X * Delta.Y) } imul [DisplayWidth] { (Tr.X+Delta.X*Delta.Y)*Screen.Col} idiv si { Px.X := Unscale(см. выше) } mov dx,cx {Возвращаем (X,Y) в ax:dx} {$else} {Delphi 2.0 or better; 32-bit} push ebx { Delphi 2.0 требует, чтобы } push esi { значения этих регистров } push edi { были сохранены } mov edi,eax { lea edi,[Tr]} push edx { Сохраняем @Result } mov si,word ptr UnitLength { Масштабный коэффициент } mov ax,TTriple[edi].Y { Tr.Y } imul si { Умножаем на } { LoWord(UnitLength) } idiv VanishingPoint.Y { отношение глубины текущей точки к глубине точки перспективы} {DeltaY equ bx } mov bx,ax { Сохраняем Delta.Y } mov ax,VanishingPoint.Z sub ax,TTriple[edi].Z { Delta.Z } imul bx { Delta.Z * Delta.Y } idiv si { Unscale(Delta.Z * Delta.Y) } add ax,TTriple[edi].Z { Tr.Z + Unscale(Delta.Z * Delta.Y) } mov cx,[DisplayHeight] { Используем дважды... } imul cx { (Tr.Z+Delta.Z*Delta.Y)*Screen.Row } idiv si { Unscale } sub cx,ax { Px.Y } mov ax,VanishingPoint.X sub ax,TTriple[edi].X { Delta.X } imul bx { Delta.X * Delta.Y } idiv si { Unscale(Delta.X * Delta.Y) } add ax,TTriple[edi].X { Tr.X + Unscale(Delta.X * Delta.Y) } imul [DisplayWidth] { (Tr.X+Delta.X*Delta.Y)*Screen.Col } idiv si { Px.X := Unscale(см. выше) } // Теперь ax=x, cx=y; мы хотим превратить //их в longint // и сохранить в Result mov ebx,$0000FFFF and eax,ebx { Очищаем старшее слово} and ecx,ebx pop edx { Восстанавливаем результат } mov TPixel[edx].X,eax mov TPixel[edx].Y,ecx pop edi pop esi pop ebx {$endif} end; {$endif} procedure DrawPixels(const Canvas: TCanvas; const A, B, C, D: TPixel; const N: word; const Surface: Surfaces); begin if AbortDraw then raise EAbortedDrawing.Create(''); Canvas.Pen.Color := Surface.Outline; if DrawMode = dmOutline then if N = 3 then Canvas.PolyLine( [A, B, C, A] ) else Canvas.PolyLine( [A, B, C, D, A] ) else begin Canvas.Brush.Color := Surface.Fill; if N = 3 then Canvas.Polygon( [A, B, C] ) else Canvas.Polygon( [A, B, C, D] ) end; end; procedure CalcCrossing(var Low, High, Crossing: TTriple; SetLow: boolean); var CrossOverRatio: LongInt; begin CrossOverRatio := (SeaLevel - Low.Z) * UnitLength div (High.Z - Low.Z); { Расстояние от точки пересечения до A рассчитывается как отношение } { длины отрезка к полной длине AB, умноженное на UnitLength } Crossing := Triple( Low.X + Unscale ((High.X - Low.X) * CrossOverRatio), Low.Y + Unscale((High.Y - Low.Y) * CrossOverRatio), SeaLevel ); if SetLow then Low.Z := SeaLevel; end; procedure DrawVertical(Canvas: TCanvas; const A, B: TTriple; var pA, pB: TPixel); var pC, pD: TPixel; tC, tD: TTriple; begin tC := A; tC.Z := SeaLevel; pC := Project(tC); tD := B; tD.Z := SeaLevel; pD := Project(tD); DrawPixels(Canvas, pA, pB, pD, pC, 4, Vertical); end; procedure DrawVerticals(Canvas: TCanvas); type Triad = record T: TTriple; V: TVertex; P: TPixel; end; var Work: Triad; procedure Step( const Start: TVertex; var Front: Triad; var StepDn: GridCoordinate ); var Idx: word; Back, Interpolate: Triad; begin Back.V := Start; Back.T := GetTriple(Back.V); if Back.T.Z > SeaLevel then Back.P := Project(Back.T); for Idx := 1 to EdgeLength do begin Front.V := Back.V; Inc(Work.V.BC); Dec(StepDn); Front.T := GetTriple(Front.V); if Front.T.Z > SeaLevel then Front.P := Project(Front.T); case (ord(Back.T.Z > SeaLevel) shl 1) + ord(Front.T.Z > SeaLevel) of 1: begin { Задняя точка ниже уровня моря, передняя - выше } CalcCrossing(Back.T, Front.T, Interpolate.T, False); Interpolate.P := Project (Interpolate.T); DrawVertical(Canvas, Interpolate.T, Front.T, Interpolate.P, Front.P); end; 2: begin { Задняя точка выше уровня моря, передняя - ниже } CalcCrossing(Front.T, Back.T, Interpolate.T, False); Interpolate.P := Project(Interpolate.T); DrawVertical(Canvas, Back.T, Interpolate.T, Back.P, Interpolate.P); end; 3: DrawVertical(Canvas, Back.T, Front.T, Back.P, Front.P); { Обе точки выше уровня моря } end; Back := Front; end; end; begin Step(C, Work, Work.V.AB ); Step(B, Work, Work.V.CA ); end; function InnerProduct({const} A, B: TTriple): LongInt; begin InnerProduct := IMUL(A.X, B.X) + IMUL(A.Y, B.Y) + IMUL(A.Z, B.Z) ; end; function Delta(A, B: TTriple): TTriple; begin Result := Triple(A.X - B.X, A.Y - B.Y, A.Z - B.Z); end; function LandColor(const A, B, C: TTriple): TColor; var Center, ToA, ToLight: TTriple; Cos, Angle: double; GrayLevel: integer; begin Center := Triple( (A.X + B.X + C.X) div 3, (A.Y + B.Y + C.Y) div 3, (A.Z + B.Z + C.Z) div 3 ); ToA := Delta(A, Center); ToLight := Delta(Center, LightSource); {$ifopt R-} {$define ResetR} {$endif} {$R+} try Cos := InnerProduct(ToA, ToLight) / (Sqrt({Abs(}InnerProduct(ToA, ToA){)}) * Sqrt({Abs(}InnerProduct(ToLight, ToLight){)}) ); try Angle := ArcTan (Sqrt (1 - Sqr (Cos)) / Cos); except on Exception do Angle := Pi / 2; {ArcCos(0)} end; {$ifdef HighContrast} GrayLevel := 255 - Round(255 * (Abs(Angle) / (Pi / 2))); {$else} GrayLevel := 235 - Round(180 * (Abs(Angle) / (Pi / 2))); {$endif} except on Exception {любое исключение} do GrayLevel := 255; { Деление на 0... } end; {$ifdef ResetR} {$R-} {$undef ResetR} {$endif} Result := PaletteRGB(GrayLevel, GrayLevel, GrayLevel); end; procedure Draw3Vertices( Canvas: TCanvas; const A, B, C: TVertex; Display: boolean); var Color: TColor; pA, pB, pC, pD, pE: TPixel; tA, tB, tC, tD, tE: TTriple; aBelow, bBelow, cBelow: boolean; begin tA := GetTriple(A); tB := GetTriple(B); tC := GetTriple(C); {$ifdef FloatingTriangles} ta.z := ta.z + random(Envelope shr Plys) - random(Envelope shr Plys); tb.z := tb.z + random(Envelope shr Plys) - random(Envelope shr Plys); tc.z := tc.z + random(Envelope shr Plys) - random(Envelope shr Plys); {$endif} aBelow := tA.Z <= SeaLevel; bBelow := tB.Z <= SeaLevel; cBelow := tC.Z <= SeaLevel; case ord(aBelow) + ord(bBelow) + ord(cBelow) of 0: if Display then { Все вершины выше уровня моря } begin pA := Project(tA); pB := Project(tB); pC := Project(tC); if DrawMode = dmRender then begin Color := LandColor(tA, tB, tC); DrawPixels( Canvas, pA, pB, pC, pC, 3, Surface(Color, Color)); end else DrawPixels( Canvas, pA, pB, pC, pC, 3, Land); end; 3: if Display then { Все вершины ниже уровня моря } begin tA.Z := SeaLevel; tB.Z := SeaLevel; tC.Z := SeaLevel; pA := Project(tA); pB := Project(tB); pC := Project(tC); DrawPixels( Canvas, pA, pB, pC, pC, 3, Water); end; 2: begin { Одна вершина над водой } { Сделаем так, чтобы это была вершина tA } if aBelow then if bBelow then SwapTriples(tA, tC) else SwapTriples(tA, tB); CalcCrossing(tB, tA, tD, True); CalcCrossing(tC, tA, tE, True); pA := Project(tA); pB := Project(tB); pC := Project(tC); pD := Project(tD); pE := Project(tE); DrawPixels( Canvas, pD, pB, pC, pE, 4, Water); if Drawmode = dmRender then begin Color := LandColor(tD, tA, tE); DrawPixels( Canvas, pD, pA, pE, pE, 3, Surface(Color, Color)); end else DrawPixels( Canvas, pD, pA, pE, pE, 3, Land); end; 1:begin { Одна вершина под водой } { Сделаем так, чтобы это была вершина tA } if bBelow then SwapTriples(tA, tB) else if cBelow then SwapTriples(tA, tC); CalcCrossing(tA, tB, tD, False); CalcCrossing(tA, tC, tE, True); pA := Project(tA); pB := Project(tB); pC := Project(tC); pD := Project(tD); pE := Project(tE); DrawPixels( Canvas, pD, pA, pE, pE, 3, Water); if DrawMode = dmRender then begin Color := LandColor(tD, tB, tC); DrawPixels( Canvas, pD, pB, pC, pE, 4, Surface(Color, Color)); end else DrawPixels( Canvas, pD, pB, pC, pE, 4, Land); end; end; end; procedure DrawTriangle( Canvas: TCanvas; const A, B, C: TVertex; Plys: word; PointDn: boolean); var AB, BC, CA: TVertex; begin if Plys = 1 then Draw3Vertices(Canvas, A, B, C, (DrawMode <> dmOutline) OR PointDn) else begin AB := Midpoint(A, B); BC := Midpoint(B, C); CA := Midpoint(C, A); if Plys = 3 then FractalLandscape.DrewSomeTriangles(16); Dec(Plys); if PointDn then begin DrawTriangle(Canvas, CA, BC, C, Plys, True); DrawTriangle(Canvas, AB, B, BC, Plys, True); DrawTriangle(Canvas, BC, CA, AB, Plys, False); DrawTriangle(Canvas, A, AB, CA, Plys, True); end else begin DrawTriangle(Canvas, A, CA, AB, Plys, False); DrawTriangle(Canvas, BC, CA, AB, Plys, True); DrawTriangle(Canvas, CA, C, BC, Plys, False); DrawTriangle(Canvas, AB, BC, B, Plys, False); end; end; end; begin ScreenColors; end. Отображение ландшафта может выполняться в трех режимах: каркасном (Outline), c заполнением (Filled) и со светотенью (rendered). В любом из этих режимов ландшафт рисуется как набор треугольников, при этом координаты отдельных вершин TTriple с помощью простого перспективного преобразования пересчитываются в экранные пиксели TPixel, а затем получившийся треугольник рисуется с помощью функции PolyLine или Polygon. Единственное отличие между режимами заключается в том, что в каркасном режиме рисуется обычная «проволочная сетка» без отсечения невидимых линий, а в двух последних режимах порядок вывода и заполнение прямоугольников обеспечивают отсечение невидимых линий методом «грубой силы» (иногда это называется «алгоритмом маляра»). В свою очередь режим со светотенью отличается тем, что цвет каждого треугольника в нем зависит от угла, под которым данная грань расположена по отношению к «солнцу».
Чтобы увеличить правдоподобие изображения, в Draw3Vertices() реализована упрощенная концепция «уровня моря». Любой треугольник, полностью находящийся над уровнем моря, рисуется нормально, а любой треугольник, полностью погруженный в воду, рисуется синим цветом на уровне моря. Если треугольник пересекает уровень моря, FL3 интерполирует точки пересечения, после чего отдельно рисует надводную и подводную части. Хотя для «побережий» такая методика вполне приемлема, с «озерами» дело обстоит сложнее: FL3 рисует воду лишь в тех местах, которые находятся ниже уровня моря.
После завершения прорисовки всех треугольников FL3 рисует вертикальные линии вдоль двух передних краев от уровня моря до всех вершин, которые находятся над водой. Эти линии особенно полезны в заполненном и светотеневом режимах — непрозрачные вертикальные грани будут скрывать «внутреннюю» структуру поверхности.

Гибкое кодирование

Многие продукты содержат специальные «точки входа» (hooks), через которые к ним можно подключить дополнительные модули, выпущенные независимыми фирмами. Например, в Windows Help определен интерфейс, с помощью которого разработчики могут включать в справочные файлы Windows нестандартные макросы и вспомогательные окна, добиваясь очень интересных эффектов. Интегрированная среда Borland C++5.0 также содержит интерфейс, с помощью которого в нее можно добавлять новые возможности. В комплект BC++ 5.0 входят модуль поддержки групповой разработки (контроля версий файлов) и дополнение для работы на Java, реализованные в виде DLL и подключенные через интерфейс расширения.
В этой главе я приводил пример с преобразованием форматов текстового редактора как один из возможных вариантов использования DLL. Давайте разовьем эту идею и напишем мини-редактор с интерфейсом расширения для таких преобразований. Сам редактор будет чрезвычайно простым — всего лишь компонент Memo с командами меню для открытия и сохранения файлов. Этого будет вполне достаточно, ведь в первую очередь нас интересует интерфейс форматных преобразований.

разрядные консольные приложения

Джим Мишель
Высушенное чучело DOS красуется ныне на стенке Win32 в качестве второстепенного API. Как же теперь бедному хакеру создать текстовый фильтр, запускаемый из командной строки? Добрая фея POSIX взмахивает волшебной палочкой… Дзынь! DOS на глазах превращает ся в консольное приложение, вызывая мучительное ощущение deja vu.
В течение многих лет Windows, OS/2, Macintosh и другие графические пользовательские интерфейсы (GUI) оставались излюбленной темой компьютерной прессы. Когда основное внимание уделяется разработке приложений для GUI, бывает трудно вспомнить о том, что существует и другой мир - мир средств командной строки, которые выполняют пакетные вычисления с минималь ным вводом информации от пользователя. Пусть такие программы выглядят не слишком эффектно - несомненно, они приносят немалую пользу. Скажем, банки обрабатывают сведения о ваших чеках, вкладах и ссудных платежах ночью, в пакетном режиме. Страховые и кредитные компании, а вместе с ними и другие бесчисленные учреждения тоже обновляют информацию по ночам. Нужны ли им для этого красивые среды GUI? Спросите своего кассира в банке. Или попробуйте угадать сами.
Возможности средств командной строки отнюдь не ограничиваются финансовыми расчетами на «крутом железе». Несколько таких программ входит в комплект Windows95, среди них - ATTRIB, DISKCOPY, FORMAT, FDISK, SORT и XCOPY. Они присутствуют даже в Delphi - при самом поверхностном просмотре каталога BIN там можно найти компиляторы ресурсов (BRC32.EXE и BRCC32.EXE), компилятор языка Паскаль (DCC32.EXE) и другие программы.

разрядные DLL в Delphi— когда, зачем и как

Джим Мишель
VCL-компоненты открывают новые возможности для многократного использования кода, но даже древние механизмы — такие как Windows DLL — при разумном применении способны творить чудеса.
Весна началась интересно. В феврале было холодно — здесь, в Остине, даже пошел снег. Дороги заледенели, машины разбивались буквально на каждом углу. Неплохое развлечение, если только в нем не участвует твоя машина. Вскоре после снегопада у нашего старенького «Бронко» забарахлил водяной насос и прохудился уплотнитель, и мы решили, что настало время подумать о новой машине. Вы не приценивались к так называемым «недорогим машинам»? Просто ужас!
Следующим вопросом на повестке дня оказался фильтр плавательного бассейна. В апреле у нас уже купаются, поэтому я открыл эту штуковину (какой странный оттенок зеленого…) и включил насос. Ни капли. Пришел спец по бассейнам и все исправил, но в итоге я стал заметно беднее. Потом засорилась система очистки воды, потому что идиот подрядчик сэкономил 20 долларов и поставил между домом и резервуаром ненадежную трубу. Водопроводчик содрал еще больше, чем спец по бассейнам. Короче, обитателям chez Mischel эти два месяца обошлись довольно дорого.
Я не прошу вашего сочувствия, а просто пытаюсь объяснить, что нельзя заранее предусмотреть всего, что может случиться, поэтому нужно проявлять гибкость, иначе цепочка несчастливых событий перевернет вашу жизнь вверх дном. То же самое относится и к программам — если вы не заложите в них определенную долю гибкости, это сделает кто-то другой, и в итоге вы лишитесь покупателей.
В жизни гибкость обычно обеспечивается денежными затратами. При программировании для Windows гибкость достигается с помощью DLL.

Перетаскивание: как это делается в Windows

Джим Мишель
С перетаскиванием в Windows дело обстоит сложнее, чем кажется на первый взгляд,— но если бы все было просто, кто стал бы читать книги по программированию?
Программы на Delphi поддерживают как минимум три разных интерфейса перетаскивания. В классе TControl, являющемся общим предком для всех управляющих элементов Delphi, определен межэлементный интерфейс перетаскивания. Включая в программу на Delphi обработчики для OnDragDrop, OnDragOver и других аналогичных событий, вы сможете наделить ее поддержкой внутренних операций перетаскивания. Если приложить некоторые усилия и использовать общую область памяти, метод можно расширить и организовать взаимодействие двух программ, написанных на Delphi. Тем не менее он не подойдет для перетаскивания между приложением, написанным на Delphi, и посторонней программой. Данный интерфейс наглядно поясняется документацией Delphi и программами-примерами.
Интерфейс перетаскивания также определен в OLE — интерфейсе связывания и внедрения Windows 1. Программы, написанные на Delphi, могут поддерживать этот интерфейс с помощью встроенных элементов OLE. Эти элементы позволяют построить клиентское или серверное приложение OLE, обладающее полноценной поддержкой перетаскивания OLE-объектов. В «чистой» Windows-программе нормально использовать OLE оказывается непросто. В Delphi существуют классы, которые поддерживают OLE и в некоторой степени облегчают OLE-программирование. В следующей главе я покажу, как реализовать перетаскивание средствами OLE с помощью таких классов.
1Когда-то сокращение OLE действительно расшифровывалось как Object Linking and Embedding, но сейчас рамки OLE значительно расширились, и сокращение официально признано самостоятельным термином. — Примеч. перев.
Третья разновидность перетаскивания, поддерживаемая в Delphi, — перетаскивание файлов из File Manager (Windows NT 3.5) или Windows Explorer (Windows 95 и NT 4.0). Этот интерфейс обладает минимальными возможностями (допускается лишь перетаскивание файлов), но оказывается на удивление полезным. Именно этот интерфейс, совершенно не упоминающийся в документации по Delphi, станет темой данной главы. Я использую для него термин FMDD (File Manager Drag and Drop).

Перетаскивание: как это делается вOLE

Джим Мишель
Оказывается, перетаскивание файлов из File Manager — всего лишь частный случай более общего интерфейса перетаскивания OLE. С помощью интерфейса OLE ваше приложение может превратиться в сервер перетаскивания, способный передавать другим приложени ям не только файлы, но и данные других типов.
Знания — забавная штука. Точнее, даже не сами знания, а то, как они нам достаются. Мне почти всегда приходится изучать что-то новое методом проб и ошибок, хотя, если бы у меня был выбор (или, возможно, всего лишь чуть лучшая подготовка), я бы охотно предпочел другой метод. Тот, кто попытает ся написать приложение с поддержкой перетаскивания OLE на основе скудной информации, содержащейся в документации OLE и Windows Software Development Kit (SDK), пройдет полноценный курс выживания в экстремаль ных условиях. Я могу предъявить шрамы, доказывающие справедливость этих слов.

Компонент Winsock в Delphi

Объекты хороши… но компоненты лучше. Чтобы наши программы могли мгновенно обращаться к Internet, мы упакуем весь багаж Winsock в один VCL-компонент.
Internet (и распределенные среды вообще) с каждым днем становится все популярнее, поэтому сетевая поддержка в приложениях выглядит вполне естественно. Lingua francaдля работы с Internet в Microsoft Windows является Winsock API. Описанный в этой главе компонент Winsock1 станет отправной точкой, позволяющей вам самостоятельно написать многие знакомые программы на базе TCP/IP— такие, как FINGER, FTP, SMTP, POP3 и ECHO.

CsShopper: FTP-клиент

Джон Пенман
Отправляйтесь в Internet за бесплатным барахлом! В этом вам поможет компонент, выполняющий функции FTP-клиента, и полноцен ное приложение для пересылки файлов, построенное на его основе.
Популярность Internet в немалой степени обусловлена возможностью обмена информацией между компьютерами. Такой обмен становится возможным благодаря протоколу пересылки файлов FTP (File Transfer Protocol)— одному из самых старых протоколов, используемых в Internet. Формальная спецификация используемого в настоящее время протокола FTP содержится в документе RFC959.
Протокол FTP, как и другие Internet-протоколы, берет свое начало в классической модели клиент/сервер. FTP-сервер иногда представляется мне в виде старомодного продавца, который снимает товар с полки и передает его покупателю (FTP-клиенту). В этой главе мы реализуем компонент Delphi с весьма подходящим именем CsShopper, выполняющий функции FTP-клиента.
Компонент CsShopper построен на основе CsSocket — простейшего компонента-оболочки для функций Winsock API, созданного в главе 5. CsSocket обеспечивает базовые возможности, необходимые для работы протокола FTP в сети TCP/IP. Таким образом, о мелочах есть кому позаботиться, и мы можем сразу же прейти к более пристальному рассмотрению процесса FTP глазами клиента.

FTP-сервер

Джон Пенман
Как известно, в FTP участвуют две стороны. Создание нестандартного компонента, выполняющего функции FTP-сервера, позволит вам полностью контролировать операции пересылки файлов между Internet-приложениями.
В главе6 я описал компонент CsShopper, в котором инкапсулируются функции клиентской стороны при пересылке файлов с использованием протокола FTP. Более того, компонент, выполняющий функции FTP-клиента, даже входит в число примеров Delphi 3. И все же для осуществления полноценного обмена файлами недостаточно иметь только клиентское приложение. Сейчас в Сети появляется все больше пользователей с круглосуточным доступом (за которым закрепился термин 24?7), и все больше людей желает создавать на Delphi свои собственные программы-серверы. Итак, знакомьтесь — CsKeeper!
CsKeeper — потомок компонента CsSocket из главы 5. В этом VCL-компоненте инкапсулируется серверная сторона FTP-протокола. CsKeeper чем-то похож на продавца маленького магазинчика — он «берет с полки» те файлы, которые затребованы, и передает их клиенту «через прилавок». Впрочем, в отличие от продавца сервер является конечным автоматом, строго соблюдающим правила протокола FTP (и к тому же не пытается болтать на посторонние темы).
Большая часть того, что было сказано о компоненте CsShopper в главе 6, относится и к CsKeeper. Если вы еще не читали главу 6, я настоятельно вам рекомендую начать именно с нее. В сложном танце под аккомпанемент FTP-протокола участвуют две стороны, и понимание одной из них невозможно без определенного понимания другой.
Если вы считаете, что достаточно хорошо разобрались с клиентской стороной, мы можем продолжать. Сервер FTP обычно ожидает установки клиентского соединения на TCP-порте с номером 21. При соединении сервер инициирует процесс регистрации, посылая клиенту команду USER. Поскольку процесс регистрации был достаточно подробно рассмотрен в главе 6 при описании CsShopper, я не стану задерживаться на его подробностях. После успешной регистрации сервер готов к выполнению любого FTP-запроса, поступившего от клиента. Магазин открылся! К тому что происходит дальше, стоит присмотреться повнимательнее.
В компоненте CsKeeper воплощен простой и полезный FTP-сервер, который соответствует минимальным требованиям, формально изложенным в документе RFC959. Следовательно, некоторые команды FTP (такие как ACCT, NLIST и PASV) в настоящее время отсутствуют в словаре CsKeeper. В таблице 7.1 приведен список всех FTP-команд. Команды, не реализованные в текущей версии CsKeeper, помечены звездочкой. При получении неподдерживаемой команды CsKeeper возвращает клиенту код ошибки с содержательным сообщением.
Обратите внимание: CsKeeper не является FTP-сервером с параллельной обработкой. Это означает, что в каждый момент времени он может обслужи вать лишь одного пользователя.
Таблица 7.1. Набор команд FTP

ABOR ACCT* ALLO* APPE* CDUP CWD DELE HELP LIST MKD MODE NLIST* NOOP PASS PASV* PORT PWD QUIT REIN* RMD RNFR* RNTO* REST* RETR SITE SMNT* STAT* STOR STOU* STRU* SYST TYPE USER*

Прерывание текущей пересылки файла Передача информации о ресурсах пользователя Выделение места под новый файл Добавление данных в существующий файл Переход в родительский каталог Переход в другой каталог Удаление файла, выбранного пользователем Запрос справочной информации о FTP-команде Запрос списка файлов текущего каталога Создание нового каталога Использование режима пересылки, выбранного клиентом Запрос потока с именами файлов Передача сервером ответа «OK» Передача пароля во время регистрации Прослушивание сервером конкретного порта данных Использование сервером порта данных, выбранного клиентом Запрос имени текущего каталога Завершение FTP-сеанса Повторная инициализация сеанса Удаление каталога Передача имени файла, который следует переименовать Передача нового имени файла. Команда должна передаваться после RNFR Возобновление прерванной пересылки файла Получение файла с сервера Получение информации о специфических услугах сервера Монтирование другой файловой системы на сервере Запрос информации о статусе Запрос на сохранение файла Сохранение файла с уникальным именем на сервере Запрос на использование файловой структуры, выбранной клиентом Запрос типа операционной системы Выбор типа пересылаемого файла Передача имени пользователя во время регистрации команда не реализована в текущей версии CsKeeper

Главный секрет иерархий

При работе с иерархиями используется «семейная» терминология (родители, внуки, предки, потомки), поскольку семья является самым распространенным примером объектов (в данном случае — людей), объединенных иерархиче скими отношениями. Этот пример напомнит вам одну простую истину — хотя вы можете построить систему, предназначенную для обобщенной обработки рекурсивных иерархий, ценность каждого объекта определяется той уникальной информацией, которая в нем хранится. В то же время место объекта в иерархическом дереве — не более чем условное обозначение связи с другими объектами. Иерархическая структура всего лишь помогает сохранить и найти объект; ваша задача — сделать так, чтобы этот объект оправдал затрачен ные усилия.

Глобальный доступ к данным в приложении

Тем временем Мститель снова погрузился в чтение похищенного Дневника.
Дневник №16 (27 марта). В Delphi 1.0 совместное использование таблиц несколькими формами было крайне хлопотным делом. Хотя возможности не ограничивались размещением таблиц и источников данных на всех формах, работавших с данными, неуклюжее альтернативное решение требовало временного создания дополнительных источников данных с их последующим удалением. Мне часто хотелось отыскать более простой способ. В последую щих версиях Delphi появились объекты, которые назывались модулями данных и заметно упрощали эту задачу. Я решил побольше узнать о них.
Как выяснилось, модуль данных представляет собой специализированную форму, на которой можно разместить только стандартные объекты из палитры Data Access. В приложении можно построить целую базу данных, с таблицами, источниками, запросами и всем остальным— и разместить ее в одном модуле данных. Чтобы результатами трудов могли воспользоваться другие формы, необходимо включить модуль данных в их секции implementation (не в секции interface!). При этом компоненты и поля модуля данных становятся доступными для компонентов формы, связанных с данными (а также для самого инспектора объектов).
Я решил создать простой пример с данными одного из моих клиентов, фирмы «Чичен-Итца Пицца». Данные хранятся в виде таблицы Paradox, в файле PIZADAT.DB. Таблица состоит из трех полей: название, цена продажи и себестоимость лучших продуктов фирмы. Я решил добавить вычисляемое поле для отображения прибыли по каждой позиции (в процентах).

Рис. 15.6. Модуль данных в режиме конструирования
Сначала я создал (для последующего использования в свойстве DatabaseName) псевдоним с именем Pizza, определяющий каталог с таблицей. Затем создал новый модуль данных и присвоил ему имя PizzaData. В этот модуль (см. рис. 15.6) я поместил таблицу и источник данных, присвоив им имена ProductTable и ProductSource соответственно. Я подключил ProductSource
к ProductTable и задал свойству AutoEdit значение False. Затем открыл для таблицы Fields Editor и добавил в него все возможные поля. Наконец, я создал новое вычисляемое поле для хранения процента прибыли и написал обработ чик события OnCalcFields таблицы ProductTable. Окно модуля данных показано на рис. 15.6. Исходный текст модуля PizzaData приведен в листинге 15.4.
Листинг 15.4. Исходный текст модуля данных
{——————————} {Демонстрация работы с модулями данных } {PIZADAT.PAS : Модуль данных } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } { Модуль данных содержит простейшую комбинацию } { таблица/источник данных,подключаемую к таблице} { Paradox. Для пользователей модуля создано } { вычисляемое поле. } { } { Написано для *High Performance Delphi 3 } Programming* } { Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 23/4/97 } {—————————} unit PizaDat; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB, DBTables; type TPizzaData = class(TDataModule) ProductTable: TTable; ProductSource: TDataSource; ProductTableName: TStringField; ProductTablePrice: TCurrencyField; ProductTableCost: TCurrencyField; ProductTablePctProfit: TFloatField; procedure ProductTableCalcFields(DataSet: TDataSet); private { Private declarations } public { Public declarations } end; var PizzaData: TPizzaData; implementation {$R *.DFM} procedure TPizzaData.ProductTableCalcFields (DataSet: TDataSet); begin ProductTablePctProfit.Value := 100.0 * ((ProductTablePrice.Value - ProductTableCost.Value) / ProductTableCost.Value); end; end. С данными все понятно. Настало время писать демонстрационную
программу. Я решил поиграть с двумя формами. Первая форма просто обращается к данным через источник, расположенный в модуле данных. Эта фор ма отображает имя продукта и вычисляемое поле. Я поместил на нее компонент-навигатор для перемещения по таблице.
На второй (главной) форме приложения находятся собственные компонен ты таблицы и источника данных, а также два других компонента: сетка TDBGrid и навигатор. Кроме того, я поместил на нее группу переключателей, позволяющих динамически переключаться между модулем данных и локальным источником. При выборе локального источника данных навигаторы на обеих формах (см. рис. 15.7) работают независимо, поскольку в них используются разные объекты-таблицы.
На рис. 15.7 изображены обе формы во время работы. В листинге 15.5 приведен исходный текст главной формы, а в листинге 15.6 — исходный текст вспомогательной формы.

Рис. 15.7. Программа, демонстрирующая использование модуля данных
Листинг 15.5. Исходный текст главной формы
{——————————————————————————————————————————————————————} { Демонстрация работы с модулями данных } { PIZAMAIN.PAS : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Демонстрационная программа показывает, как } { происходит подключение формы к модулю данных, } { созданному для данного проекта. Форма } { содержит переключатель для смены источника данных - } { модуль или локальная пара таблица/источник данных. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 23/4/97 } {——————————————————————————————————————————————————————} unit PizaMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, ExtCtrls, DBCtrls, DBTables, DB, StdCtrls; type TForm1 = class(TForm) DBGrid: TDBGrid; Navigator: TDBNavigator; DataSourceRBGroup: TRadioGroup; QuitBtn: TButton; LocalTable: TTable; LocalDataSource: TDataSource; LocalTableName: TStringField; LocalTablePrice: TCurrencyField; LocalTableCost: TCurrencyField; Bevel1: TBevel; procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); procedure DataSourceRBGroupClick(Sender: TObject); procedure QuitBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses PizaDat, PizaFrm2; {$R *.DFM} procedure TForm1.FormShow(Sender: TObject); begin Form2.Show; end; procedure TForm1.FormCreate(Sender: TObject); begin DataSourceRBGroup.ItemIndex := 0; end; procedure TForm1.DataSourceRBGroupClick(Sender: TObject); begin if Tag > 0 then case DataSourceRBGroup.ItemIndex of 0 : begin DBGrid.DataSource := PizzaData.ProductSource; Navigator.DataSource := PizzaData.ProductSource; end; 1 : begin DBGrid.DataSource := LocalDataSource; Navigator.DataSource := LocalDataSource; end; end { case } else Tag := 1; end; procedure TForm1.QuitBtnClick(Sender: TObject); begin Close; end; end. Листинг 15.6. Исходный текст вспомогательной формы
{——————————————————————————————————————————————————————} { Демонстрация работы с модулями данных } { PIZAFRM2.PAS : Вспомогательная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Демонстрационная программа показывает, как } { происходит подключение формы к модулю данных, } { включенному в проект. Эта форма получает данные } { из модуля данных проекта. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 23/4/97 } {——————————————————————————————————————————————————————} unit PizaFrm2; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DBCtrls, ExtCtrls, DB; type TForm2 = class(TForm) NameDBText: TDBText; PctDBText: TDBText; Label1: TLabel; Label2: TLabel; Navigator: TDBNavigator; Bevel1: TBevel; private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation uses PizaDat; {$R *.DFM} end. Перед компиляцией я задаю свойствам Active всех объектов-таблиц значение True. Наверное, сказывается сила привычки.
В секциях implementation обеих форм указывается PizaDat (имя модуля данных). После этого поля модуля данных становятся доступными в инспекторе объектов для любого компонента, связанного с данными.
Как видно из листинга, переключение между двумя источниками данных с помощью переключателей не вызывает никаких проблем. Вернее, почти не вызывает…
Похоже, обработчик OnClick для переключателей вызывается во время создания формы. К этому моменту источники данных еще не были полностью сконструированы и подключены, и в результате возникает исключение. Я решил предотвратить эту ситуацию с помощью свойства Tag формы. Во время инициализации оно равно 0, поэтому попытка подключения источников не производится. Однако следующий вызов обработчика — совсем другое дело, поскольку значение Tag было заменено на 1.
Демонстрационная программа работает именно так, как я планировал. Когда главная форма подключается к модулю данных, на ней отображается процент прибыли, и обе формы синхронизированы независимо от того, какая из них управляет перемещением по таблице. Когда главная форма переключается на локальный источник данных, обе формы начинают действовать независимо. Обратное переключение на модуль данных мгновенно синхрони зирует их.
Разумеется, возможности модулей данных отнюдь не ограничиваются вычисляемыми полями. Ведь в конце концов модуль данных является полноценным модулем Object Pascal, который может содержать новые объекты и методы, а также обработчики для любых событий, связанных с таблицами, источниками данных, SQL-запросами и т.д. В сущности, программист может реализовать полный набор логических правил для работы с данными компании. Довольно круто — и открывает очень, очень широкие возможности.
Конец записи (27 марта).

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

Ничто так не радует во время конструирования форм, как элементы, которые автоматически выравниваются, масштабируются и выстраивают свое содержимое в аккуратные столбики. Возникает впечатление, будто у вас появились надежные союзники. Однако достоинства «умных» элементов вовсе не исчерпываются психологическим комфортом— подумайте, сколько строк программного кода вам сэкономило свойство Align панелей? Десятки, сотни? Теперь вы понимаете, почему мне так не хочется отказываться от удобного элемента TRadioGroup, когда возникает необходимость в блокировке отдельных переключателей. Класс TRadioGroup автоматически располагает переключатели в виде столбцов, выравнивает расстояния между ними и позволяет задать их имена в виде одного строкового списка.
Однако он не позволяет обращаться к отдельным переключателям группы — и наверняка для этого есть веские причины. Но я уверен в своей способности разумно блокировать тот или иной переключатель и поэтому написал улучшенный вариант TRadioGroup (см. листинг 9.12). Класс TRadioBtnGrp содержит новое свойство ItemEnabled, с помощью которого можно получать и задавать состояние блокировки для отдельных кнопок.
Листинг 9.12. Модуль RBTNGRPS.PAS
{ Группа переключателей с возможностью блокировки отдельных кнопок } unit RBtnGrps; interface uses StdCtrls, ExtCtrls, Classes; type TRadioBtnGroup = class( TRadioGroup ) private function GetItemEnabled( Index: Integer ) : Boolean; procedure SetItemEnabled( Index: Integer; Value: Boolean ); function GetButtons( Index: Integer ) : TRadioButton; protected function CheckAnyBut( NotThisIndex: Integer ): Boolean; property Buttons[ Index: Integer ] : TRadioButton read GetButtons; public property ItemEnabled[ Index: Integer ] : Boolean read GetItemEnabled write SetItemEnabled; end; procedure Register; implementation function TRadioBtnGroup.CheckAnyBut; var Index: Integer; begin Result := True; for Index := NotThisIndex + 1 to Items.Count - 1 do if Buttons[ Index ].Enabled then begin Buttons[ Index ].Checked := True; Exit; end; for Index := 0 to NotThisIndex - 1 do if Buttons[ Index ].Enabled then begin Buttons[ Index ].Checked := True; Exit; end; Result := False; end; function TRadioBtnGroup.GetItemEnabled; begin Result := Buttons[ Index ].Enabled; end; procedure TRadioBtnGroup.SetItemEnabled; begin if ( not Value ) and ( Index = ItemIndex ) and Buttons[ Index ].Checked and ( not CheckAnyBut( Index )) then ItemIndex := -1; Buttons[ Index ].Enabled := Value; end; function TRadioBtnGroup.GetButtons; begin Result := Components[ Index ] as TRadioButton; end; procedure Register; begin RegisterComponents('HP Delphi 3', [ TRadioBtnGroup ]); end; end. Во внутренней реализации TRadioBtnGroup метод GetButtons используется для получения доступа к отдельным переключателям. GetButtons использует тот факт, что входящие в группу переключатели хранятся в массиве Components. Все, что требуется от GetButtons — индексировать массив Components и выполнить безопасное преобразование типа для результата.
Новый элемент стремится работать как можно разумнее. При блокировке установленного переключателя он пытается установить другой переключатель; если заблокированы все переключатели, он ничего не устанавливает. Если такое поведение вас не устраивает, его можно изменить.

Hello, Delphi

Прежде всего создайте новое приложение (File <>New Application). Для начала нужно изменить некоторые параметры проекта и сообщить Delphi о том, что мы создаем именно консольное приложение. Выполните команду Projectд Options и затем на вкладке Linker диалогового окна Project Options установите флажок Generate Console Application, после чего сохраните внесенные изменения кнопкой OK.
Поскольку у консольного приложения нет главной формы (и, если уж на то пошло, вообще никаких форм), необходимо удалить форму Form1, которая автоматически появилась при создании нового приложения. Выполните команду FileдRemove From Project; когда появится диалоговое окно Remove From Project, выделите строку, содержащую имена Unit1 и Form1, и нажмите кнопкуOK. Если откроется окно сообщения с предложением сохранить изменения в модуле Unit1, нажмите кнопку No. В оставшемся окне Delphi нет ничего, кроме инспектора объектов, - нет ни форм, ни модулей. Где же писать код программы?
Остается лишь файл с исходным текстом проекта. Выполните команду ViewдProject Source. Delphi откроет окно текстового редактора с файлом PROJECT1.DPR. Именно этот файл мы модифицируем, чтобы создать первое консольное приложение. Перед тем как продолжать работу над программой, выполните команду File <>Save и сохраните проект под именем HELLO.DPR.
В редакторе измените исходный текст проекта в соответствии с листингом 1.1 и сохраните свою работу. Нажмите клавишу F9, чтобы откомпилировать и запустить программу.
Листинг 1.1. Программа Hello, Delphi
{ HELLO.DPR - Простейшее консольное приложение Delphi Автор: Джим Мишель Дата последней редакции: 04/05/97 } {$APPTYPE CONSOLE} program Hello; uses Windows; begin WriteLn ("Hello, Delphi"); Write ("Press Enter..."); ReadLn; end. Строка {$APPTYPE CONSOLE} в листинге 1.1 является директивой компилято ра и сообщает Delphi о том, что создаваемое приложение является консольным. Она должна присутствовать в начале любого консольного приложения. Эта директива включается только в программы - она не нужна в модулях или библиотеках динамической компоновки (DLL). Ключевое слово uses нашей программе, вообще говоря, не нужно (мы здесь не обращаемся к функциям Windows API), но по какой-то загадочной причине Delphi не любит сохранять проекты без секции uses (см. мое замечание о методе проб и ошибок). Включение модуля Windows не принесет никакого вреда и говорит вовсе не о том, что модуль подключается к программе, а лишь о том, что Delphi просмотрит его, если не сможет найти какой-нибудь идентификатор в текущем модуле.
Оставшаяся часть программы проста до очевидного. Строка «Hello, Delphi» выводится на консоль (то есть на экран), после чего вам будет предложено нажать Enter. Я включил сюда ожидание ввода лишь потому, что без него Delphi на долю секунды выведет окно консоли (сеанса DOS), запустит программу и сразу же закроет окно. Ожидание нажатия Enter позволяет убедиться в том, что программа действительно работает.

Хочу быть сервером!

С приемником у меня не было особых проблем — стоило понять общую концепцию интерфейса COM, и дальше все прошло относительно безболезнен но. Построение сервера, напротив, сопровождалось сплошными неудачами. На первых порах казалось, что мне придется реализовать всю «кухню» перетаскивания лишь для того, чтобы наладить работу простейшего сервера. Чтобы создать сервер перетаскивания, необходимо реализовать три интерфейса, причем ни один из них нельзя протестировать до того, как будут готовы остальные. В результате при отладке создается занятная ситуация — совершенно непонятно, в какой же части программы возникает проблема.
Замечание
Конечно, мои трудности отчасти были обусловлены недостатком опыта работы с OLE и COM, но я твердо убежден в том, что больше всего проблем вызвали излишняя сложность интерфейса и совершенно неудовлетворительная документация. Я достаточно хорошо владею C и C++, так что меня уже не пугает документация Windows SDK, качество которой варьируется от нулевого до условно-полезного. С другой стороны, примеры из SDK не назовешь понятными или полезными даже для опытного программиста на C++. Вместо изощренных примеров OLE, которые пытаются объяснить все сразу и в итоге не объясняют толком ничего, гораздо больше пользы принесли бы простые программы, просто и наглядно поясняющие конкретные концепции. Изучение файла OLECTNRS.PAS (из каталога Delphi Source\VCL) дало мне больше, чем все примеры Microsoft SDK.

И последнее замечание…

В листинге16.2 реализована еще одна дополнительная возможность, перед которой я не смог устоять. Объект можно перетащить из сетки и скопировать /переместить его в другую сетку, сбрасывая на нужном корешке. Для этого мне пришлось написать общий обработчик OnMouseDown для всех сеток, а также расширить обработчики OnDragOver и OnDragDrop для компонента PageControl. Кроме того, я добавил флаг CopyDrag, устанавливаемый в том случае, если в начале перетаскивания из любой сетки была нажата клавиша Ctrl.
При перетаскивании из сетки на корешок вкладки основную долю работы выполняет процедура DropGridString. Если во время перетаскивания не была нажата клавиша Ctrl, DropGridStringвыполняет дополнительные действия и превращает обычное копирование в перемещение, убирая выделенный объект из сетки-источника и затем удаляя пустую строку.
?абочая версия программы изображена на рис. 16.2. Это маленькое приложение получилось довольно забавным. Вы можете перетаскивать объекты между вкладками, копировать и перемещать их. Это гораздо веселее, чем сидеть на свадьбе (особенно на своей собственной).
Конец записи (29 марта).

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

Иерархические структуры вреляционных базах данных

Ричард Хейвен
Данные не всегда удается представить в виде таблицы, состоящей из строк и столбцов. В этой главе приведены рекомендации по работе с иерархическими структурами в базах данных Delphi и описаны некоторые VCL-компоненты, снимающие с вас часть забот.
Окружающий мир переполнен иерархическими данными. В это широкое понятие входят компании, состоящие из дочерних компаний, филиалов, отделов и рабочих групп; детали, из которых собираются узлы, входящие затем в механизмы; специальности, специализации и рабочие навыки; начальники и подчиненные и т. д. Любая группа объектов, в которой один объект может быть «родителем» для произвольного числа других объектов, организована в виде иерархического дерева. Очевидным примером может послужить иерархия объектов VCL — класс TEdit представляет собой частный случай TControl, потому что TControl является его предком. С другой стороны, TEdit можно рассматривать и как потомка TWinControl или TCustomControl, потому что эти классы являются промежуточными уровнями иерархии VCL.
Подобные связи не имеют интуитивного представления в рамках модели реляционных баз данных. Нередко иерархические связи являются рекурсив ными (поскольку любая запись может принадлежать любой записи) и произвольными (любая запись может принадлежать другой записи независимо от того, кому принадлежит последняя). В двумерной таблице даже отображение иерархического дерева становится непростым делом, не говоря уже о запросах. Иногда в критерий запроса входит родословная (lineage) объекта (то есть его родители, родители его родителей и т. д.) или его потомство (progeny — сюда входят дочерние объекты и все их потомство). В этой главе описаны некоторые механизмы работы с иерархическими связями в модели реляционных баз данных, хорошо знакомой программистам на Delphi.

Иерархия «один-ко-многим»

Delphi обладает удобными средствами для работы с реляционными базами данных. Такие базы данных представляют собой таблицы (иногда также называемые отношениями— relations), состоящие из строк (записей) и столбцов (полей), которые связываются друг с другом по совпадающим значениям полей (см. рис. 13.1). В теории баз данных используются и другие представ ления. До появления реляционной модели стандартными были иерархическая (hierarchical) и сетевая (network) модели, а сейчас появился еще один тип — объектно-ориентированные (object-oriented) базы данных.

Рис. 13.1. Базовая и подчиненная таблицы
Любую модель следует оценивать по тому, насколько она облегчает труд разработчика при создании базы данных. Реляционная модель хорошо подходит для многих реальных структур данных: нескольких счетов для одного клиента, нескольких деталей для нескольких поставщиков, нескольких объектов с несколькими характеристиками, и т. д. С помощью свойств TTable.MasterSource и TQuery.DataSource можно выделить из таблицы некоторое подмножество записей или построить запрос, основанный на связанных значениях полей из другой таблицы. Это один из способов установить отношение между базовой (master) и подчиненной (detail) таблицами, где из базовой таблицы берется одна запись, а из подчиненной — несколько.

Интерфейс IDataObject хранит данные

Интерфейс IDataObject управляет содержанием перетаскиваемых данных, а также представлением их в формате, понятном для запрашивающего объекта IDropTarget. Он используется при перетаскивании, а также при обмене данными с буфером (clipboard). После того как вы наладите работу интерфейса IDataObject с первым типом передачи данных, со вторым особых проблем не возникнет. Впрочем, трудность (как правило) заключается в том, чтобы заставить IDataObject работать хотя бы в одном варианте. И что еще хуже, возникающие проблемы оказываются на редкость изощренными.
Интерфейс IDataObject предоставляет средства для передачи данных и сообщений об изменениях. Его методы предназначены для занесения данных в объект, представления их в различных (как правило, зависящих от конкретного устройства) форматах, возврата информации о поддерживаемых форматах и уведомления других объектов об изменении данных. Хотя для перетаскивания файлов в окно Windows Explorer или File Manager необходимо полностью реализовать лишь три метода IDataObject, в совокупности эти три метода оказываются весьма объемными.
Итак, чтобы создать сервер для перетаскивания файлов, нужно реализовать три метода IDataObject: QueryGetData, GetData и EnumFormatEtc. А чтобы реализовать метод EnumFormatEtc, понадобится реализовать и интерфейс IEnumFormatEtc. Я же говорил, что с реализацией интерфейсов все стремительно усложняется.
Метод QueryGetData вызывается приемником перетаскивания. Ему передается структура TFormatEtc, которая описывает формат данных, желательный для приемника. QueryGetData должен сообщить приемнику о том, может ли объект представить данные в требуемом формате. Он возвращает S_OK в том случае, если последующий вызов GetData с большой долей вероятности закончится успешно. В некоторых случаях (например, при нехватке памяти) последующий вызов GetData все равно может закончиться неудачей.
Когда приемник хочет получить данные, он вызывает метод GetData. Приемник передает структуру TFormatEtc с описанием желательного формата данных и структуру TStgMedium, в которую GetData поместит запрашиваемые данные. Вызывающая сторона (то есть приемник) должна освободить структуру TStgMedium после того, как обработка данных будет завершена. Этот момент чрезвычайно важен. Поскольку клиент уничтожает данные, возвращаемые GetData, метод должен передавать копию данных объекта. Если GetData передаст настоящие данные, клиент благополучно уничтожит их, и следующая попытка клиента (или самого объекта-источника) обратиться к данным приведет к катастрофе.
Метод EnumFormatEtc сообщает о том, в каких форматах объект может воспроизвести свои данные. Информация передается в виде объекта IEnum FormatEtc, а это означает, что для реализации IDataObject нам придется реализовать и интерфейс IEnumFormatEtc. Среди примеров OLE SDK приведено немало реализаций IEnumFormatEtc— но все они написаны на C или C++ и выглядят, мягко говоря, устрашающе. К счастью, классы TOleForm и TOleContainer из OLECNTNRS.PAS содержат более простой вариант, которым я воспользовался как шаблоном для своей реализации. После этого примеры IEnumFormatEtc из OLE SDK начали обретать для меня смысл, но без OLECTRNS.PAS я бы до сих пор рвал на себе волосы от отчаяния.
Интерфейс IEnumFormatEtc содержит четыре метода: Next, Skip, Reset и Clone, с помощью которых приложения могут перебирать и просматривать поддержи ваемые форматы данных, а также копировать список этих форматов. Универсальная реализация IEnumFormatEtc выглядит очень сложно, поскольку она должна уметь динамически выделять память под структуры TFormatEtc и копировать внутренние данные, содержащиеся в этих структурах. Такие сложности нам не нужны, поэтому предполагается, что рабочий массив TFormatEtc содержит статические данные. Для наших целей сойдет и так, но во многих приложениях это условие приведет к излишне строгим ограничениям. Предлагае мая реализация IEnumFormatEtc приведена в листинге 4.3.
Листинг 4.3. ENUMFMT.PAS: простейшая реализация интерфейса IEnumFormatEtc
{
ENUMFMT.PAS -- реализация интерфейса IEnumFormatEtc.
Автор: Джим Мишель
Дата последней редакции: 30/05/97
Приведенная реализация IEnumFormatEtc недостаточно надежна.
Она предполагает, что список FormatList, поддерживаемый объектом
TEnumFormatEtc, хранится в виде статического массива. Для простых
объектов наподобие сервера для перетаскивания файлов этого достаточно, но во многих
приложениях такое ограничение оказывается неприемлемым.
} unit EnumFmt; interface uses Windows, ActiveX; type { TFormatList -- массив записей TFormatEtc } PFormatList = ^TFormatList; TFormatList = array[0..1] of TFormatEtc; TEnumFormatEtc = class (TInterfacedObject, IEnumFormatEtc) private FFormatList: PFormatList; FFormatCount: Integer; FIndex: Integer; public constructor Create (FormatList: PFormatList; FormatCount, Index: Integer); { IEnumFormatEtc } function Next (celt: Longint; out elt; pceltFetched: PLongint): HResult; stdcall; function Skip (celt: Longint) : HResult; stdcall; function Reset : HResult; stdcall; function Clone (out enum : IEnumFormatEtc) : HResult; stdcall; end; implementation constructor TEnumFormatEtc.Create ( FormatList: PFormatList; FormatCount, Index : Integer ); begin inherited Create; FFormatList := FormatList; FFormatCount := FormatCount; FIndex := Index; end; { Next извлекает заданное количество структур TFormatEtc в передаваемый массив elt. Извлекается celt элементов, начиная с текущей позиции в списке. } function TEnumFormatEtc.Next ( celt: Longint; out elt; pceltFetched: PLongint ): HResult; var i : Integer; eltout : TFormatList absolute elt; begin i := 0; while (i < celt) and (FIndex < FFormatCount) do begin eltout[i] := FFormatList[FIndex]; Inc (FIndex); Inc (i); end; if (pceltFetched <> nil) then pceltFetched^ := i; if (I = celt) then Result := S_OK else Result := S_FALSE; end; { Skip пропускает celt элементов списка, устанавливая текущую позицию на (CurrentPointer + celt) или на конец списка в случае переполнения. } function TEnumFormatEtc.Skip ( celt: Longint ): HResult; begin if (celt <= FFormatCount - FIndex) then begin FIndex := FIndex + celt; Result := S_OK; end else begin FIndex := FFormatCount; Result := S_FALSE; end; end; { Reset устанавливает указатель текущей позиции на начало списка } function TEnumFormatEtc.Reset: HResult; begin FIndex := 0; Result := S_OK; end; { Clone копирует список структур } function TEnumFormatEtc.Clone ( out enum: IEnumFormatEtc ): HResult; begin enum := TEnumFormatEtc.Create (FFormatList, FFormatCount, FIndex); Result := S_OK; end; end.

Интерфейсные формы

Когда я занялся реализацией интерфейсов из листинга 10.3, неожидан новозникли проблемы — моя система «зависала» при каждом вызове AddNotifiee(Self) из формы, реализующей IFrame. Хотя решение оказалось простым, мне пришлось в течение многих часов изобретать и проверять различные гипотезы. Чтобы вы лучше поняли суть происходившего, потребуется некоторая дополнительная информация.
Документация Delphi 3 достаточно четко объясняет, что каждый объект, реализующий какой-то интерфейс, должен также реализовать интерфейс IUnknown, в котором производятся подсчет ссылок и запросы поддерживаемых интерфейсов. Если компилятор встретит следующее объявление:
type IFoo = interface procedure Foo; end; TFoo = class (TObject, IFoo) procedure Foo; end; procedure TFoo.Foo; begin end;
он пожалуется на наличие необъявленных идентификаторов QueryInterface, _AddRef и _Release. Вам придется явным образом реализовать IUnknown или создавать свой объект на базе TInterfaced, а не TObject. С другой стороны, следующий фрагмент не вызовет у компилятора никаких проблем:
type
TFoo = class (TForm, IFoo) procedure Foo; end; procedure TFoo.Foo; begin end;
Это означает, что фирма Borland реализовала IUnknown где-то в недрах VCL и у нас стало одной заботой меньше, не так ли?
Нет, не так. При передаче TForm в качестве интерфейсной ссылки VCL выдает ошибку защиты (GPF). Хотя класс TComponent и реализует методы IUnknown, это вряд ли поможет тем из нас, кто захочет воспользоваться интерфейсами в приложении. Вызовы IUnknown передаются FVCLComObject — указателю, значение которого задается лишь при вызове GetComObject для получения интерфейсной ссылки объекта. Более того, GetComObject задает значение FVCLComObject лишь в том случае, если вы использовали VCLCom в своем проекте. Если сделать это, GetComObject начинает жаловаться на то, что фабрика класса (class factory) не была зарегистрирована, и… на этом я прекратил свои исследования. Возможно, все это очень здорово, если вы собираетесь использовать COM-объекты совместно с другими приложениями, но совершенно не подходит, если нужно всего лишь добавить интерфейсы к формам.
Намного проще будет заглянуть в реализацию TInterfacedObject и включить в TForm простую, независимую реализацию IUnknown, а затем порождать формы от TInterfacedForm вместо TForm.
Листинг 10.3. Модуль INTERFACEDFORMS.PAS
unit InterfacedForms; // Copyright © 1997 by Jon //Shemitz, all rights reserved. // Permission is hereby granted to freely //use, modify, and // distribute this source code PROVIDED //that all six lines of // this copyright and contact notice are //included without any // changes. Questions? Comments? Offers of work? //mailto:jon@midnightbeach.com // -------------------------------------------- // Добавление в TForm функциональной реализации IUnknown. interface uses Classes, Forms; type TInterfacedForm = class (TForm, IUnknown) private fRefCount: integer; protected function QueryInterface( const IID: TGUID; Obj): Integer; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; public property RefCount: integer read fRefCount write fRefCount; end; implementation uses Windows; // для E_NOINTERFACE // Код IUnknown основан на исходном тексте TInterfacedObject function TInterfacedForm.QueryInterface ( const IID: TGUID; out Obj): Integer; begin if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE; end; function TInterfacedForm._AddRef: Integer; begin Inc(fRefCount); Result := fRefCount; end; function TInterfacedForm._Release: Integer; begin Dec(fRefCount); Result := fRefCount; if fRefCount = 0 then Destroy; end; end. Как видите, все очень просто. Оглядываясь назад, я не могу понять, почему мне потребовалось на это так много времени. Наверное, меня сбило с толку предположение о том, что программа, полученная при добавлении интерфейсов к форме, не будет компилироваться из-за своей потенциальной ненадежности. Впрочем, во время своих экспериментов я обнаружил еще одну проблему, связанную с реализацией интерфейсов в Delphi. О ней тоже следует рассказать перед тем, как идти дальше.

Использование данных

Цель любого пользовательского интерфейса — организация эффективного взаимодействия с пользователем. Пользователь должен видеть достаточно данных, чтобы принять и реализовать решение (или по крайней мере понять, что на основании представленных данных это сделать невозможно). В графических деревьях объект удобно выбирать двойным щелчком или клавишей «пробел».
После того как пользователь выберет какой-либо объект, ваше приложение должно идентифицировать его. Текст, отображаемый в элементе, не всегда однозначно определяет объект (он может повторяться в других объектах), поэтому каждый объект обычно снабжается уникальным идентификатором. Такие идентификаторы должны быть короткими, чаще всего— числовыми. Чтобы обеспечить уникальность нового идентификатора, достаточно прибавить 1 к максимальному существующему значению.
Замечание
Хотя мы используем свойство Index для организации иерархии в элементе, это вовсе не означает, что оно остается постоянным для каждого объекта. Свойство Index класса TOutline изменяется при каждом изменении содержимого TOutline; это относительное значение, не связанное с конкретными объектами.
Идентификатор связывается с самим объектом. В дальнейшем по нему можно узнать, какой объект выбрал пользователь. В большинстве элементов, содержащих строковые объекты, также хранятся и связанные со строками объектные указатели. Эта часть интерфейса TString используется многими элементами. Вы можете сохранить указатель на любой объект или просто значение, похожее на указатель. Можно взять положительное целое число (тип данных cardinal), преобразовать его в TObject и сохранить в этом свойстве (обычно оно называется Objects). Если идентификатор не является целочисленным значением, придется создать специальный класс для хранения данных:
type TMyClass = class(TObject) public ID : String; end; begin ... NewIDObject := TMyClass.Create; NewIDObject.ID :=ItemTable.FieldByName ('ID').AsString; MyOutline.AddChildObject(0, ItemTable.FieldByName('Description').AsString, NewIDObject); В компоненте TOutline эти указатели можно получить через Items[Index].Data, вместо того чтобы обращаться к свойству Objects, как это делается в большинстве элементов (и еще одно отклонение от нормы: значения Index начинаются с 1, а не с 0, как в большинстве списков). Указатель связывает объект, порожденный от TObject (то есть экземпляр любого класса), с объектом иерархии. Вам придется определить новый класс для хранения идентификатора, а затем создавать экземпляр этого класса для каждого загружаемого объекта, заносить в него идентификатор и правильно устанавливать указатель.
Чтобы добраться до идентификатора, можно воспользоваться следующим фрагментом кода:
with MyOutline do ThisID := (Items[SelectedItem].Data as TMyIDClass).ID; Возможно, вашему приложению будет недостаточно одного идентификатора и потребуется дополнительная информация. По значению идентификатора можно найти нужную информацию в таблице. Кроме того, можно расширить определение TMyIDClass и сохранять дополнительную информацию в самих объектах.
Помните, что свойство Objects или Data не будет автоматически уничтожать эти объекты. Поэтому либо сделайте их потомками TComponent, чтобы их мог уничтожить владелец компонента, либо переберите элементы списка в деструкторе или обработчике FormDestroy и уничтожьте их самостоятельно. Если вы корректно используете свойство Count, в одном фрагменте кода можно спокойно уничтожать объекты, которые были (или не были) созданы в другом фрагменте.
with MyOutline do for Counter := Count downto 1 do (Items[Counter].Data as TMyIDClass).Free; Обратите внимание на то, что в этом фрагменте уничтожение объектов в порядке «снизу вверх» в цикле for..downto оказывается чуть более эффектив ным, потому что списку при этом не приходится перемещать объекты для заполнения пустых мест.

Использование файлов в памяти

Дневник №16 (1 апреля): Один из самых частых вопросов о Delphi — как написать приложение, существование которого в системе ограничивается одним экземпляром. За последний год я обнаружил несколько решений этой задачи. Одно из них оказалось таким интересным, что я решил описать его здесь.
Чтобы приложение могло обнаружить факт существования другого своего экземпляра, оно должно как-то обратиться c запросом к системным данным. В Windows 3.1 приложение могло узнать о существовании предыдущего экземпляра по значению hPrevInst, однако в Windows 95 все изменилось.
Один из способов заключается в использовании модуля WalkStuf, разработанного мной раньше. Функция ModuleSysInstCount возвращает значение, равное количеству выполняемых копий программы. Приложение может воспользоваться этой функцией и, если возвращаемое значение отлично от нуля, просто завершить работу. К сожалению, этот способ не работает в NT.
Для обмена информацией между приложениями обычно применяется
уникальный глобальный ключ, доступный для всех экземпляров программы. Классический пример — использование уникального файла. При запуске
приложение проверяет, существует ли файл с заданным именем (например, FOOBAR99.DAT). Если такой файл существует, значит, в настоящее время уже работает другой экземпляр программы. Если файл не найден, новый экземпляр программы создает его. Завершая свою работу, программа удаляет файл.
Одна из проблем подобного подхода связана с возможными аномалиями (например, «зависанием» системы или сбоем питания). Поскольку «флаг» (в данном случае — файл) хранится на постоянном носителе, он сохранится и после перезагрузки. В этом случае первый запущенный экземпляр программы «увидит» файл, решит, что в системе уже работает другой экземпляр, и немедленно завершится. В итоге программа вообще перестанет работать. Вам придется наводить порядок, удалять файл и возвращать систему к нормальному состоянию.
Win95 предоставляет более приятную альтернативу — общие файлы в памяти. При этом файл представляет собой временную область памяти (или по крайней мере трактуется как область памяти, даже если он временно выгружается на диск). В отличие от многих ресурсов Win95 файлы в памяти могут совместно использоваться несколькими процессами.
Я создал простейшее приложение для проверки теории о том, что файлы в памяти могут применяться для поиска других экземпляров программы.
На рис. 16.3 изображено рабочее окно приложения, а в листинге 16.3 приведен его исходный текст.
s
?ис. 16.3. Программа, запускаемая в единственном экземпляре
Листинг 16.3. Простейшая программа, запускаемая лишь в одном экземпляре
{——————————————————————————————————————————————————————} { Демонстрационная программа, } { запускаемая лишь в одном экземпляре. } { INSTMAIN.PAS : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Программа показывает, как предотвратить запуск } { нескольких экземпляров приложения в среде Windows 95.} { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} unit InstMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) ExitBtn: TButton; Label1: TLabel; procedure ExitBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.ExitBtnClick(Sender: TObject); begin Close; end; end. ?азумеется, сама форма ничего не делает. Каждый последующий экземпляр программы должен обнаруживать присутствие предыдущего экземпляра и автоматически прекращать работу. И хотя эту ситуацию можно перехватить в стартовом коде формы, намного разумнее делать так, чтобы новый экземпляр вообще не отображался на экране. Следовательно, проверка должна выполняться еще до запуска приложения.

Использование inheritedс переопределенными свойствами

Предположим, вы разрабатываете VCL-компонент Delphi (например, потомок TDrawGrid)и хотите предпринять некоторые особые действия в тот момент, когда пользователь (в нашем случае — программист) изменяет свойство ColCount. Это можно сделать двумя способами; выбор зависит от того, хотите вы получить простое уведомление об изменении или вам необходимо ограничить набор возможных значений ColCount.
Свойство ColCount определяет количество столбцов в сетке. Его значение, как и значение большинства свойств, хранится в private-поле (в нашем случае — FColCount) и изменяется private-методом (SetColCount). Следовательно, когда в программе встречается строка
ColCount := AValue;
или значение ColCount изменяется в инспекторе объектов в режиме конструи рования, вызывается метод SetColCount, который с помощью других private-методов изменяет значение переменной FColCount и вносит необходимые изменения в сетку. Все это инкапсулировано и недоступно для вмешательства извне.
Однако разработчики исходной версии TDrawGrid предусмотрели, что при создании компонентов-потомков может потребоваться уведомление об изменении количества столбцов — поэтому после внесения изменений, но перед их отображением, вызывается метод SizeChanged. Метод SizeChanged является динамическим, то есть его можно переопределить, и после этого при каждом изменении количества столбцов (или строк) будет вызываться новая версия SizeChanged. См. листинг 9.9.
Листинг 9.9. SIZECHAN.SRC
{ Потомок TDrawGrid с переопределенным методом SizeChanged. Это позволяет компоненту-потомку узнавать об изменении количества столбцов или строк. } { В секции interface... } type TMyGrid = class(TDrawGrid) protected procedure SizeChanged(OldColCount, OldRowCount: Longint); override; end; { В секции implementation... } procedure TMyGrid.SizeChanged(OldColCount, OldRowCount: Longint); begin { Выполняем любые необходимые действия } end; Переопределение SizeChanged позволит получать необходимые уведомления, но плохо подходит для контроля за количеством столбцов (скажем, если число столбцов в нашей сетке не должно превышать 3). К моменту вызова SizeChanged (обратите внимание на прошедшее время — Changed — в названии метода) изменения уже внесены. Лучшее, что мы можем сделать, если свойство ColCount стало равно 4, — заменить его на 3 и повторить весь процесс.
Чтобы как можно раньше узнавать об изменениях, мы можем переопределить само свойство ColCount, задав для него новые методы доступа (см. объявление TMyGrid в листинге 9.10). Такое переопределение скрывает свойство ColCount предка. Если теперь в программе встретится строка:
ColCount := AValue;
будет вызван наш, невиртуальный метод SetColCount. Как видно из текста метода (см. листинг 9.10), мы сначала проверяем, не превышает ли новое количество столбцов 3, и если не превышает — вносим изменения.
Листинг 9.10. SETCOLCT.SRC
{ Потомок TDrawGrid, переопределяющий свойство ColCount
с новыми методами доступа. Это позволяет компоненту-потомку
управлять количеством столбцов. }
{ В секции interface... }
type TMyGrid = class(TDrawGrid) private function GetColCount: LongInt; procedure SetColCount(Value: LongInt); published property ColCount: LongInt read GetColCount write SetColCount default 0; end; { В секции implementation... } function TMyGrid.GetColCount: LongInt; begin Result := inherited ColCount; end; procedure TMyGrid.SetColCount(Value: LongInt); begin if Value <= 3 then inherited ColCount := Value; end; Но, вероятно, самое интересное в переопределяемых свойствах — способ их изменения. Мы не можем непосредственно модифицировать значение private-поля FColCount. Впрочем, прямая модификация привела бы к нежелательным эффектам из-за пропуска ряда необходимых действий, сопровожда ющих изменение числа столбцов. Мы не можем вызвать метод SetColCount предка, потому что он определен в разделе private. А попытка вставить в наш метод SelColCount строку вида
ColCount := Value;
приведет к бесконечной рекурсии и переполнению стека.
Правильный ответ заключается в использовании ключевого слова inherited с именем свойства:
inherited ColCount := Value;
Возможность использования inherited с именем свойства предка не так хорошо документирована, как его применение к унаследованным public- и protected-методам. Для кого-то такая возможность станет приятной неожиданностью, но она вполне в духе Object Pascal.

Использование макросов в редакторе Delphi

В редакторе Delphi можно записывать макросы, автоматизирующие ввод повторяющихся фрагментов— но узнать об этом можно разве что случайно; в справочных файлах Delphi это средство не документировано1.
Во время редактирования текста программы можно записать последовательность нажатий клавиш в виде макроса и потом воспроизвести ее. Чтобы начать запись макроса, нажмите Ctrl+Shift+R и введите нужную последовательность клавиш. Запись прекращается повторным нажатием Ctrl+Shift+R. Макрос воспроизводится клавишами Ctrl+Shift+P.
Редактор Delphi — не WinWord и не WordPerfect, и поддержка макросов в нем ограничена: запоминается лишь один набор клавиш. Кроме того, нажатие во время записи макроса любых клавиш, вызывающих переход к другому окну, отменяет процесс записи. Например, если последняя операция Find представляла собой простой поиск, то при нажатии F3 диалоговое окно не выводится (при успешном поиске) и клавиша F3 включается в макрос. Но если ранее выполнялся поиск с заменой, F3 выведет диалоговое окно с запросом подтверждения, и запись макроса прервется.
Даже при таких ограничениях макросы могут принести немалую пользу — вы можете определять закладки и переходить к ним, выполнять поиск с изменением критерия, копировать и вставлять фрагменты текста.
Например, после ввода заголовка метода в объявлении класса мне часто приходится копировать этот заголовок в секцию implementation модуля, вставлять перед ним имя класса с точкой и вводить пару begin..end. Если тщательно продумать последовательность операций, все эти действия можно записать в одном универсальном макросе. В листинге 9.16 приведен возможный набор клавиш, которые выполняют эту задачу при условии, что текстовый курсор находится в строке с заголовком метода.
Кстати, в моем примере использованы стандартные (Default) настройки клавиатурных комбинаций редактора. Если у вас установлен другой режим, возможно, макрос придется изменить.
Листинг 9.16. HEADING.TXT
{ Ниже приведена последовательность нажатий клавиш для вставки заголовка
метода в секцию implementation модуля и добавления пары begin..end.
Управляющие сочетания клавиш заключены в фигурные скобки.
После двойного символа "косая черта" следует комментарий.
Предполагается, что модуль заканчивается ключевым словом "end."}
{Ctrl+Shift+R} // Начало записи {HOME} // Перейти к началу строки {Shift+DOWN} // Выделить строку {Ctrl+C} // Скопировать выделенную строку {Ctrl+END} // Перейти в конец модуля {Ctrl+LEFT} // Перейти в позицию слева от "end." {Ctrl+V} // Вставить скопированную строку {UP} // Перейти к началу вставленной строки {Ctrl+T} // Удалить отступ {Ctrl+RIGHT} // Перейти к имени метода TMyClass. // Ввести имя класса с точкой {END} // Перейти к концу строки {ENTER} // Вставить новую строку begin // Ввести "begin" {ENTER}{ENTER} // Вставить две новые строки после "begin" end; // Ввести "end;" {ENTER} // Вставить новую строку после метода {UP}{UP} // Вернуться к телу метода {RIGHT}{RIGHT} // Создать отступ в два пробела // и приготовиться к вводу {Ctrl+Shift+R} // Остановить запись

Использование RDTSC для измерения временных интервалов на Pentium

В доисторическую эпоху написание быстрых программ не сводилось к правильному выбору алгоритма; программисту приходилось помнить временные характеристики различных команд и измерять время выполнения различных вариантов. Поскольку системный таймер «тикает» лишь каждые 55миллисекунд, при измерениях приходилось повторять одни и те же вычисления сотни тысяч раз или же пускаться на хакерские ухищрения вроде чтения внутренних регистров таймера, чтобы получить значение времени с точностью до 838 наносекунд.
В наши дни появились хорошие компиляторы и быстрые процессоры, в результате чего стало довольно трудно написать какой-нибудь «предельно тупой» код, существенно замедляющий работу программы. Однако по иронии судьбы средство для измерения временных интервалов появилось лишь в процессоре Pentium. Команда RDTSC (Read Time Stamp Counter) возвращает количество тактов, прошедших с момента подачи напряжения или сброса процессора. Где была эта команда, когда мы действительно нуждались в ней?
И все же лучше поздно, чем никогда. Команда RDTSC состоит из двух байтов: $0F 31. Она возвращает в регистрах EDX:EAX 64-битное значение счетчика. Поскольку сопроцессорный тип данных comp представляет собой 64-битное целое, мы можем прочитать текущее значение с помощью кода Delphi, приведенного в листинге 9.3.
Листинг 9.3. RDTSC.SRC
const D32 = $66; function RDTSC: comp; var TimeStamp: record case byte of 1: (Whole: comp); 2: (Lo, Hi: LongInt); end; begin asm db $0F; db $31; // BASM не поддерживает команду RDTSC {$ifdef Cpu386} mov [TimeStamp.Lo],eax // младшее двойное слово mov [TimeStamp.Hi],edx // старшее двойное слово {$else} db D32 mov word ptr TimeStamp.Lo,AX {mov [TimeStamp.Lo],eax - младшее двойное слово} db D32 mov word ptr TimeStamp.Hi,DX {mov [TimeStamp.Hi],edx - старшее двойное слово} {$endif} end; Result := TimeStamp.Whole; end; Одна из проблем, с которой вы столкнетесь при использовании команды RDTSC, заключается в том, что функции IntToStr и Format('%d') могут работать только со значениями типа LongInt, а не comp. Если этим функциям передается значение типа comp, оно не может превышать High(LongInt), то есть 2147483647. Возможно, эти цифры производят впечатление, если они определяют сумму в долларах, но на Pentium с тактовой частотой 133 МГц это соответствует всего лишь 16 секундам. Если вам потребуется сравнить время работы двух длительных процессов, разность между показаниями таймера в начале и конце работы легко может превысить High(LongInt).
Проблема решается просто. Хотя тип comp соответствует 64-битному целому, на самом деле это тип данных сопроцессора 80х87. Чтобы отформатировать comp функцией Format(), необходимо воспользоваться форматами с плавающей точкой. Функция CompToStr в листинге 9.4 скрывает все хлопотные подробности, причем с ней сгенерированный компилятором объектный код получается более компактным, нежели при непосредственном использовании нескольких вызовов Format().
Листинг 9.4. COMP2STR.SRC
function CompToStr(N: comp): string; begin Result := Format('%.0n', [N]); end; Напоследок скажу лишь следующее. Потребность в измерении временных интервалов сейчас возникает намного реже, чем в былые времена. В то же время с появлением команды RDTSC такое измерение становится удобным и надежным.
На этом замечании я передаю повествование своему соавтору, Эду Джордану. Продолжай, Эд!

Использование шаблона Filter

Если вам захочется поместить фильтр в хранилище, создайте новый подкаталог в каталоге ObjRepos и сохраните в нем файлы FILTER.DPR, FILTMAIN.PAS, CMDLINE.PAS и FILEIO.PAS. Затем выполните команду Projectд Add to Repository и введите необходимую информацию. Когда вам в следующий раз придется писать фильтр, вся скучная работа уже будет сделана заранее - возьмите шаблон, подправьте параметры и перепрограммируйте рабочий цикл.

Использование сохраненных процедур

Сохраненные процедуры (stored procedures) напоминают SQL с добавлением условных операторов и циклов. На языке InterBase можно написать так называемые процедуры выборки (select procedures), которые аналогично SQL-запросам возвращают некоторое количество записей из набора. С помощью процедурного языка можно перебрать записи, входящие в набор (полученный с помощью запроса или другой, вложенной процедуры выборки), и выполнить с ними необходимые действия. Пример, написанный на командном языке InterBase, приведен в листинге13.7 (нумерация строк используется в последующих комментариях).
Листинг 13.7. Процедуры выборки в InterBase
1. CREATE PROCEDURE GETCHILDREN (STARTING_ITEM_ID SMALLINT, THISLEVEL SMALLINT) 2. RETURNS(ITEM_ID SMALLINT, DESCRIPTION CHAR(30), ITEMLEVEL SMALLINT) AS 3. BEGIN 4. FOR 5. SELECT T1.ITEM_IDM T1.DESCRIPTION 6. FROM ITEMS T1 7. WHERE T1.PARENT_ID = :STARTING_ITEM_ID 8. INTO :ITEM_ID, :DESCRIPTION 9. DO BEGIN 10. ITEMLEVEL = THISLEVEL + 1; 11. SUSPEND; 12. FOR 13. SELECT T1.ITEM_ID, T1.DESCRIPTION, T1.ITEMLEVEL 14. FROM GETCHILDREN(:ITEM_ID, :ITEMLEVEL) T1 15. INTO :ITEM_ID, :DESCRIPTION, :ITEMLEVEL 16. DO BEGIN 17. SUSPEND; 18. END 19. END 20. END; Подобные итерации идеально подходят для просмотра иерархических данных в обоих направлениях, потому что сохраненные процедуры рекурсивны. Такую процедуру можно вызывать из нее самой, чтобы определить детей текущего объекта, затем получить их детей и т. д. Вместо того чтобы сразу получить все записи одного поколения и переходить к следующему, при этой стратегии мы сначала определяем первого потомка объекта, затем — его первого потомка (т. е. первого внука исходного объекта) и т. д. до нахождения последнего потомка.
На языке InterBase SUSPEND означает, что возвращаемая по RETURNS информация должна заноситься в результирующий набор в виде очередной записи. Первый оператор SUSPEND (строка 11) возвращает значения из первой записи запроса, определяющего непосредственных потомков STARTING_ITEM_ID (строки 5_8). Следующий SUSPEND (строка 17) возвращает результат рекурсив ного вызова процедуры выбора GETCHILDREN. До тех пор пока этот второй вызов находит записи (то есть до тех пор, пока у объекта находятся потомки), второй SUSPEND возвращает их исходной вызывающей процедуре. Когда объекты кончаются, вызывающий код продолжает свою работу и с помощью первого SUSPEND возвращает вторую запись исходного запроса. Если не сбросить переменную ITEMLEVEL во внешнем цикле (строка 10), в ней будет храниться значение из последней итерации внутреннего цикла (строка 15).
Для вызова процедур выборки InterBase следует пользоваться компонентом TQuery, а не TStoredProc. Синтаксис выглядит просто:
with Query1 do begin SQL.Clear; SQL.Add('SELECT * FROM GetChildren(' + IntToStr(CurrentItemID) + ',0)'); Open; end; Полученный набор будет содержать всех потомков текущего объекта с указанием их уровня.

Использование SQL

Если ваша иерархия слишком велика и ее не удается полностью загрузить в память, подумайте о решении, основанном на SQL. Если количество уровней рекурсии известно заранее, для установления связи между «поколениями» можно воспользоваться вложенными запросами SQL, как показано в листинге 13.6:
Листинг13.6. Использование SQL для просмотра трех поколений иерархии
SELECT * FROM Items T1 WHERE T1.Parent_ID IN (SELECT T2.Item_ID FROM Items T2 WHERE T2.Parent_ID IN (SELECT T3.Item_ID FROM Items T3 WHERE T3.Parent_ID = 'Fred')) В этом SQL-запросе участвуют ровно три поколения; возвращаются только те записи, которые являются «правнуками» записи Fred. Чтобы получить, например, детей и внуков одновременно, придется выполнить два запроса, а затем воспользоваться SQL-конструкцией UNION или объединить результаты с помощью INSERT INTO или временных таблиц.
Чтобы отыскать родителя объекта, найдите запись, у которой Item_ID совпадает с Parent_ID текущего объекта. Чтобы отыскать всех детей объекта, необходимо найти все записи, у которых Parent_ID совпадает с Item_ID текущего объекта. Чтобы отыскать всех родственников, найдите все объекты с тем же значением Parent_ID (обратите внимание: исходный объект также войдет в этот набор, если специально не исключить его). Чтобы определить всех потомков объекта, следует найти всех его детей, затем перебрать объекты полученного набора и определить их детей, затем перебрать объекты следующего полученного набора и т. д.

Использование свойства Tag

Наверное, вас давно интересует вопрос— как RESOLVER32 определяет, какое из введенных значений необходимо обработать? Все очень просто: у каждого элемента есть свойство Tag, по нему можно выделить текстовое поле, которое получает строку для преобразования. Свойствам Tag текстовых полей назначаются целые числа, начиная с 1 для текстового поля edIPName и заканчивая 6 для edProtoNo. Затем обработчики событий OnClick этих текстовых полей используются для изменения свойства Tag формы. Следующий фрагмент показывает, как это делается, на примере текстового поля edIPName1:
procedure TfrmMain.edIPNameClick(Sender: TObject);
begin
frmMain.tag := edIpName.tag;
end;
При нажатии кнопки Resolve RESOLVER32 анализирует frmMain.tag в операторе case и присваивает значение нужному свойству. В листинге 5.13 показано, как это делается.
Листинг 5.13. Использование свойства tag для определения того, какое из введенных значений следует преобразовать
procedure TfrmMain.btnResolveClick(Sender: TObject); begin btnResolve.Enabled := FALSE; Screen.Cursor := crHourGlass; if CsSocket1.Access = NonBlocking then btnAbortRes.Enabled := TRUE; pnStatus.Color := clBtnFace; pnStatus.UpDate; case tag of begin edHostName.Text := ''; edHostName.Update; pnStatus.Caption := Concat('Resolving ',edIPName.Text); pnStatus.UpDate; CsSocket1.HostName := edIPName.Text; end; begin edIPName.Text := ''; edIPName.UpDate; pnStatus.Caption := Concat('Resolving ',edHostName.Text); pnStatus.UpDate; CsSocket1.HostName := edHostName.Text end; begin edPortName.Text := ''; edPortName.UpDate; pnStatus.Caption := Concat('Resolving ', edServiceName.Text); pnStatus.UpDate; CsSocket1.WSService := edServiceName.Text end; begin edServiceName.Text := ''; edServiceName.UpDate; pnStatus.Caption := Concat('Resolving ', edServiceName.Text); pnStatus.UpDate; CsSocket1.WSPort := edPortName.Text end; begin edProtoNo.Text := ''; edProtoNo.UpDate; pnStatus.Caption := 'Resolving protocol name.'; pnStatus.UpDate; CsSocket1.WSProtoName := edProtoName.Text; end; begin edProtoName.Text := ''; edProtoName.UpDate; pnStatus.Caption := 'Resolving protocol number.'; pnStatus.UpDate; CsSocket1.WSProtoNo := edProtoNo.Text; end; end; end;

Использование TQuery для определения набора подчиненных записей

С помощью TQuery можно определить набор подчиненных записей, для этого базовый набор данных (TTable или TQuery) передает свои значения свойству SQL в качестве параметров динамического запроса. В приведенном выше примере свойство SQL подчиненного объекта TQuery выглядит примерно так:
SELECT * FROM Employee T1 WHERE T1.Boss_ID = :Emp_ID Свойство TQuery.DataSource показывает, откуда берется значение параметра. В приведенном выше SQL-запросе значение Emp_ID берется из TQuery.DataSource. DataSet.FieldByName('Emp_ID') (имя параметра должно совпадать с именем поля источника). При каждом изменении базового поля запрос выполняется заново с новым значением параметра.
Подчиненные TQuery используют динамический SQL-запрос вместе со свойством DataSource. Запрос называется динамическим, потому что он использует параметр вместо того, чтобы заново строить весь SQL-текст запроса при каждом изменении критерия. Однако, если критерий запроса может иметь различную структуру, вам придется воссоздавать весь SQL-оператор в текстовом виде; в этом случае параметры не помогут.
Если вы захотите в большей степени контролировать процесс отображения записей или пожелаете передать измененный SQL-запрос через TQuery (не позволяя свойству TQuery.DataSource сделать это за вас), можно воспользоваться программным кодом вместо задания свойства MasterSource. Например, можно добавить некоторые записи к тем, которые были отобраны в соответствии с критерием. Желательно делать это в тот момент, когда обработчик OnDataChanged подключается к базовому TDataSource (см. листинг13.2).
Листинг 13.2. Добавление записей, не удовлетворяющих основному критерию
procedure TForm1.DataSource1DataChange (Sender : TObject; Field : TField); begin if (Field = nil) or (Field.FieldName = 'Emp_ID') then begin Query2.DisableControls; Query2.Close; with Query2.SQL do begin Clear; Add('SELECT *'); Add('FROM employees T1'); Add('WHERE T1.Boss_ID = ' + Table1.FieldByName('Emp_ID').AsString); Add('OR T1.Boss_ID IS NULL'); { // дополнительный код } end; Query2.Open; Query2.EnableControls; end; end; При этом будут извлечены записи, принадлежащие текущему Boss_ID, а также те, которые не принадлежат никакому Boss_ID (работники, у которых вообще нет начальника).

когда дела становятся совсем плохи,

Говорят, когда дела становятся совсем плохи, главное — вовремя приготовить кофе. Я заварил целый кофейник и занялся программой, демонстрирующей работу с функциями модуля 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-адрес
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; Затем метод 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 для отображения результатов,
полученных от функции просмотра
procedure TfrmMain.CsSocket1Lookup (Sender: TObject; LookUpOp: TLookUpOp; Value: String; Result : Boolean); begin btnResolve.Enabled := TRUE; btnAbortRes.Enabled := FALSE; Screen.Cursor := crDefault; if Result then begin pnStatus.Color := clLime; case LookUpOp of resHostName : begin edHostName.Text := Value; pnStatus.Caption := 'IP address resolved'; end; resIPAddress : begin edIpName.Text := Value; pnStatus.Caption := 'Host name resolved'; end; resService : begin edPortName.Text := Value; pnStatus.Caption := 'Service resolved'; end; resPort : begin edServiceName.Text := Value; pnStatus.Caption := 'Port number resolved'; end; resProto : begin edProtoNo.Text := Value; pnStatus.Caption := 'Protocol resolved'; end; resProtoNo : begin edProtoName.Text := Value; pnStatus.Caption := 'Protocol number resolved'; end; end;// case end else begin pnStatus.Color := clRed; case LookUpOp of resHostName : begin edHostName.Text := ''; pnStatus.Caption := 'IP address resolution failed.'; end; resIPAddress : begin edIpName.Text := ''; pnStatus.Caption := 'Host name resolution failed'; end; resService : begin edPortName.Text := ''; pnStatus.Caption := 'Service resolution failed'; end; resPort : begin edServiceName.Text := ''; pnStatus.Caption := 'Port number resolution failed.'; end; resProto : begin edProtoNo.Text := ''; pnStatus.Caption := 'Protocol resolution failed.'; end; resProtoNo : begin edProtoName.Text := ''; pnStatus.Caption := 'Protocol number resolution failed.'; end; end;// case end; end;

Каркасный режим

Из всех режимов отображения проще всего реализован каркасный режим. В нем рисуются лишь контуры треугольников: «земля»— зеленым цветом, а «вода» — синим. Если здесь что и заслуживает внимания, так это простота и изящество реализации 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;

Консольные приложения на Delphi

Хотя Delphi позволяет создавать консольные приложения, документация хранит подозрительное молчание по поводу того, как именно это делается. Как ни удивительно, среди превосходных примеров, поясняющих многие аспекты программирования на Delphi, нет ни одного консольного приложения. К счастью, создать консольное приложение на Delphi не так уж сложно, хотя при этом желательно знать пару тонких моментов. (Метод проб и ошибок - не самый эффективный способ обучения!)
Простейшее консольное приложение - это, конечно же, программа «Hello World». Выглядит она не особо эффектно, но обычно я начинаю освоение всех новых программных средств именно с нее. Дело в том, что с помощью «Hello World» можно кое-что узнать о новой среде, не заботясь о содержании программы. После того как мы напишем на Delphi простейшее консольное приложение, его код можно будет отправить в хранилище объектов и пользоваться им как отправной точкой для создания других аналогичных проектов.

Консольные приложения

В 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. Возникает вопрос - что делать дальше?

Консольный ввод/вывод

При запуске консольного приложения с окном консоли автоматически связываются стандартные текстовые файлы 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-полей, выпадающих списков и т. д. Только не забудьте сказать: «А сейчас вылетит птичка…» и уничтожить растры после того, как надобность в них отпадет.

Критика

Вам никогда не хотелось вернуться к уже законченному проекту и переделать его заново? Нет, дело даже не в том, что наш шаблон фильтра чем-то плох. Просто сейчас я оглядываюсь назад и думаю о том, что многое можно было сделать по-другому.
В целом шаблон получился вполне приличным, и я уже воспользовался им при написании нескольких программ, от самых примитивных до чрезвычай но полезного потокового редактора.
Пожалуй, требования к командной строке получились излишне строгими - все параметры должны указываться с помощью префиксов, не поддерживается работа с конфигурационными файлами. С одной стороны, это не так уж страшно, зато программирование заметно упрощается. С другой стороны, поддержка конфигурационных файлов была бы нелишней, и благодаря структуре нашей программы реализовать ее не так уж сложно. Единственное, что мне еще хотелось бы изменить (и то из чисто косметических соображений) - использование типа 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. Исходный текст программы для демонстрации
масштабирования формы
{——————————} {Масштабирование формы (демонстрационная программа) } RS.PAS : Главная форма } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } {Приложение показывает, как с помощью панелей } { с заданным типом выравнивания и обработки } сообщений } { Windows создаются гибкие формы, которые } ограничивают } { возможности масштабирования и учитывают } { их последствия. } { Написано для *High Performance Delphi 3 } Programming* } { Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 23/4/97 } {————————} unit Rs; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons; type TRSMainForm = class(TForm) ControlPanel: TPanel; RSMemoPanel: TPanel; RSMemo: TMemo; BtnPanel: TPanel; SBPanel: TPanel; QuitSB: TSpeedButton; QuitBtn: TButton; SBComboPanel: TPanel; ComboBox1: TComboBox; SpeedButton1: TSpeedButton; Button1: TButton; procedure QuitBtnClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); private { Private declarations } procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO; public { Public declarations } end; var RSMainForm: TRSMainForm; MinWidth : Integer; MinHeight : Integer; implementation {$R *.DFM} procedure TRSMainForm.QuitBtnClick(Sender: TObject); begin Close; end; procedure TRSMainForm.FormCreate(Sender: TObject); begin MinWidth := RSMemoPanel.Width + BtnPanel.Width + 10; MinHeight := RSMainForm.Height - (RSMainForm.ClientHeight - (RSMemo.Top + RSMemo.Height)) + 10; end; procedure TRSMainForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); begin inherited; with Msg.MinMaxInfo^ do begin with ptMinTrackSize do begin X := MinWidth; Y := MinHeight; end; { with } with ptMaxTrackSize do begin X := Screen.Width; Y := Screen.Height; end; { with } end; { with } end; procedure TRSMainForm.FormResize(Sender: TObject); begin RSMemo.Height := RSMemoPanel.Height - (2 * RSMemo.Top); RSMemoPanel.Width := RSMainForm.ClientWidth - BtnPanel.Width; RSMemo.Width := RSMemoPanel.Width - (2 * RSMemo.Left); end; end. Настало время поиграть с взаимным расположением компонентов, чтобы оно сохранялось даже при масштабировании формы, на которой они находятся.
Когда я только начинал работать с панелями, они приносили мне немало хлопот. Но, познакомившись с ними поближе, я просто влюбился в три замечательные возможности, которыми они обладают. Во-первых, с помощью свойства 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 — отмена
асинхронной операции
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; Однако метод CancelAsyncOperation определен в секции protected и поэтому недоступен приложению RESOLVER32. Но как же RESOLVER32 отменяет WSAAsyncGetHostByName или WSAAsyncGetHostByAddr? Обращаясь к методу CancelAsyncOperation через логическое public-свойство CancelAsyncOp.
Листинг 5.12 показывает, что происходит при нажатии кнопки Abort в групповом поле gbnameRes приложения RESOLVER32. Поскольку функция вызывается в псевдоблокирующем режиме, мы присваиваем CancelAsyncOp значение True. Тем самым мы приказываем CsSocket через CancelAsyncOperation вызвать WSACancelAsyncRequest и таким образом прервать асинхронную операцию. Обратите внимание — при вызове блокирующих функций кнопка Abort становится недоступной.
Листинг 5.12. Метод TFrmMain.AbortAsyncHostBtnClick — отмена
асинхронной операции
procedure TfrmMain.btnAbortResClick(Sender : TObject); begin CsSocket1.CancelAsyncOp := TRUE; pnStatus.Color := clYellow; pnStatus.Caption := 'Operation aborted'; btnAbortRes.Enabled := FALSE; btnResolve.Enabled := TRUE; Screen.Cursor := crDefault; end;

Отображение данных

Перемещения вверх и вниз по иерархическому дереву неизбежны, однако вы можете воспользоваться средствами, которые автоматизируют эту задачу. Подумайте, как пользователи будут работать с данными. Возможно, их вообще не интересует иерархическая структура данных, но они захотят искать объект по его предку. Или они будут искать объект по тому имени, которым он представлен в иерархии, или только среди потомков текущего объекта. Возможно, им потребуется узнать только идентификатор найденного объекта или же получить список всех его потомков или предков.
В частности, вам придется решить основной вопрос — что делать, когда пользователь требует вывести «следующий» объект? Таким объектом может быть: следующий потомок родителя текущего объекта; первый потомок текущего объекта; следующий родитель, если текущий объект является единственным потомком, или даже первый потомок следующего «родственника» (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.

Переменная DLLProc

При загрузке DLL прежде всего выполняется код запуска (расположенный между begin и end в конце DLL). Если ваша DLL должна загрузить ресурсы, выделить область памяти или выполнить другие действия во время загрузки и перед вызовом других функций, такой код следует расположить именно здесь. Он выполняется каждым приложением, в котором загружается DLL.
Кроме того, Windows сообщает DLL о факте присоединения или отсоеди нения процесса или программного потока (thread), но чтобы извлечь из этого пользу, придется немного потрудиться. Для этого следует подготовить специальную процедуру и присвоить ссылку на нее переменной DLLProc (определенной в модуле System). Процедура определяется так:
procedure DLLHandler (Reason: Integer);
Параметр Reason может быть равен одной из четырех констант: DLL_PROCESS_ ATTACH, DLL_PROCESS_DETACH, DLL_THREAD_ATTACH или DLL_THREAD_DETACH.
Вам придется организовать обработку сообщений DLL_PROCESS_ATTACH и вызвать CreateFileMapping, чтобы создать общий блок памяти (или получить указатель на уже имеющийся блок). Ваша DLL должна также обрабатывать сообщения DLL_PROCESS_DETACH и освобождать блок памяти, чтобы Windows могла удалить его, когда блок не будет использоваться ни одним процессом.
В проекте SHAREME.DPR (листинг 2.11) реализован общий блок памяти. В данном примере общая память представляет собой целое число, которое увеличивается с присоединением и уменьшается с отсоединением очередного процесса.
Листинг 2.11. Реализация общей памяти в DLL
{ SHAREME.DPR — Пример использования общей памяти для организации межпроцессного взаимодействия Автор: Джим Мишель Дата последней редакции: 12/05/97 } library shareme; uses Windows, SysUtils, Classes; const pCounter: ^Longint = nil; function GetProcessCount : Longint; stdcall; export; begin Result := pCounter^; end; procedure MyDLLHandler (Reason: Integer); const hMapObject : THandle = 0; var fInit : Boolean; begin case Reason of DLL_PROCESS_ATTACH : begin { Создаем именованный объект для совместного доступа } hMapObject := CreateFileMapping ( $FFFFFFFF,{ использовать страничный файл } nil,{ без атрибутов безопасности } PAGE_READWRITE,{ доступ по чтению/ записи } 0,{ старшие 32 бита размера } sizeof (longint),{ младшие 32 бита размера } "SharedMem"{ имя объекта } ); { Память инициализируется первым присоединенным процессом } fInit := (GetLastError <> ERROR_ALREADY_EXISTS); { Получаем указатель на общую область памяти, отображаемую на файл } pCounter := MapViewOfFile ( hMapObject, { отображаемый объект } FILE_MAP_WRITE, { доступ по чтению/записи } 0, { старшие 32 бита смещения } 0, { младшие 32 бита смещения } 0 { по умолчанию: отображение на весь файл } ); { Инициализируем или увеличиваем счетчик } if (fInit) then pCounter^ := 1 else pCounter^ := pCounter^ + 1; end; DLL_PROCESS_DETACH : begin { Уменьшаем счетчик } pCounter^ := pCounter^ - 1; { Разрываем связь между общей памятью и адресным пространством процесса } UnmapViewOfFile (pCounter); { Закрываем логический номер объекта } CloseHandle (hMapObject); end; (* Присоединение и отсоединение потоков не обрабатывается DLL_THREAD_ATTACH : DLL_THREAD_DETACH : *) end; end; Exports GetProcessCount index 1 name "GetProcessCount"; begin DLLProc := @MyDLLHandler; MyDLLHandler (DLL_PROCESS_ATTACH); end. Особое внимание следует обратить на две строки из секции инициализации DLL. Первая строка инициализирует переменную DLLProc из модуля System и заносит в нее ссылку на управляющую процедуру DLL (MyDLLHandler). Я думал, что ничего больше не потребуется, но оказалось, что при загрузке DLL почему-то не производится вызов этой процедуры с параметром DLL_PROCESS_ATTACH, поэтому такой вызов приходится организовывать в секции инициализации DLL. Видимо, в библиотеках Delphi допущена какая-то ошибка при генерации кода инициализации DLL.
Чтобы проверить, как работает общая память, создайте форму, при инициализации которой вызывается функция DLL GetProcessCount, и выведите значение переменной-счетчика с помощью компонента TLabel. Если запустить несколько экземпляров приложения, счетчик будет увеличиваться с присоединением каждой новой копии. Если закрыть один или несколько экземпляров приложения, а потом снова открыть их, соответственно изменится и значение счетчика (то есть если запустить три экземпляра, закрыть один, а потом запустить еще один, то итоговое значение счетчика процессов будет равно 3).
Глобальные области памяти (вроде той, что используется в SHAREME) поглощают драгоценные ресурсы Windows, так что старайтесь разумно подходить к их выделению. Если вы работаете со множеством различных полей из одной DLL, сгруппируйте их в общем блоке памяти (то есть в записи) и выделите один общий блок для всей информационной структуры. При этом объем ресурсов Windows, используемых программой, сводится к минимуму. Также проследите за тем, чтобы DLL правильно освобождали свою память. Если DLL аварийно завершится или по другой причине закончит работу, не освободив свои блоки памяти, то распределенная память и ресурсы Windows будут числиться занятыми до перезагрузки Windows. Если логический номер блока будет потерян, освободить память уже не удастся.

Перемещение элементов

Хотя перемещать элементы во время выполнения программы можно несколькими способами, для наших целей лучше всего подойдет трюк с почти недокументированным сообщением WM_SYSCOMMAND. Для перемещения элемента класса TWinControl следует вызвать ReleaseCapture и послать элементу сообщение WM_SYSCOMMAND, указав в качестве параметра wParam шестнадцатеричное значение $F012. А теперь то же самое на языке программы:
ReleaseCapture;
SendMessage(TWinControl(SizingRect1).Handle, WM_SysCommand,
$F012, 0);

Рис. 12.2. Перемещение кнопки Windows
Результат этого фрагмента с точки зрения пользователя изображен на рис. 12.2.
Внешне все выглядит, как при перемещении модального диалогового окна — тонкий пунктирный контур элемента следует за курсором, пока не будет отпущена кнопка мыши.
Возможно, вы уже заметили, что этот способ обладает одним ограниче нием — для него необходим логический номер окна. У потомков TWinControl он имеется, у потомков TGraphicControl — нет. Следовательно, для компонентов типа TGraphicControl (например, TLabel) он работать не будет. Чтобы наши динамические формы были действительно полезными и полноценными, необходимо найти способ перемещения потомков TGraphicControl.
Только что описанный механизм WM_SYSCOMMAND придется усовершенствовать. Конечно, его нельзя использовать для потомков TGraphicControl напрямую, но обходной путь все же существует — мы создадим прозрачный TWinControl и расположим его над перемещаемым элементом.
Когда пользователь выбирает из контекстного меню команду Adjust Size & Position, мы накладываем прозрачный TWinControl поверх выделенного элемента. Пользователь сможет перетащить прозрачный элемент (с помощью сообщения WM_SYSCOMMAND с параметром $F012) так, словно это и есть «выделенный» элемент. Другими словами, когда пользователь щелкает на выделенном элементе и начинает перетаскивать его, на самом деле он перетаскивает наш прозрачный TWinControl. Затем, когда пользователь решит сохранить внесенные изменения (повторно выбрав команду Adjust Size & Position), мы прячем прозрачный TWinControl и программным способом перемещаем «выделенный» элемент в новое место.
В сущности, именно это происходит в Delphi в режиме конструирования. Если присмотреться повнимательнее, вы увидите, что при перетаскивании элемента на самом деле перемещается прозрачный прямоугольник в толстой рамке (см. рис. 12.3).

Рис. 12.3. Перетаскивание в режиме конструирования Delphi
Прозрачный прямоугольник появляется только над перемещаемым элементом. С того момента, когда вы щелкнули на «выделенном» элементе, и до отпускания кнопки мыши прозрачный прямоугольник следует за курсором. При отпускании кнопки мыши прозрачный прямоугольник исчезает, а перемещаемый элемент оказывается в новом месте.
Наш прозрачный потомок TWinControl называется SizingRect и принадлежит классу TSizingRect. Объект класса TSizingRect заменяет элемент на время перетаскивания.
Важнейшие методы класса TSizingRect — CreateParams и Paint. Метод Create Params определяет некоторые аспекты поведения элемента еще до его создания. Мы воспользуемся этим методом, чтобы сделать наш элемент прозрачным (см. листинг 12.1).
Листинг 12.1. Метод TSizingRect.CreateParams
procedure TSizingRect.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT; end; Метод Paint (см. листинг 12.2) рисует толстую рамку, которую видят наши пользователи при перетаскивании SizingRect. При рисовании прямоугольника толщиной в 3 пикселя мы задаем свойству Pen.Mode холста значение pmNot. Тем самым гарантируется, что цвет нарисованного прямоугольника будет отличаться от цвета формы (как и при масштабировании элементов в Delphi).
Листинг 12.2. Метод TSizingRect.Paint
procedure TSizingRect.Paint; begin inherited Paint; if fVisible = False then Exit; Canvas.Pen.Mode := pmNot; Canvas.Pen.Width := 3; Canvas.Brush.Style := bsClear; Canvas.Rectangle(0, 0, Width, Height); end;

Перемещение по иерархии

Для перемещения вверх и вниз по иерархии потребуются две дополнитель ные функции. В рассматриваемом примере пользователь перемещается вниз, когда он делает двойной щелчок на подчиненной записи (справа). При этом фильтр левой таблицы изменяется, и в нее включаются строки из правой таблицы. Затем новый фильтр меняет содержимое правой таблицы— теперь в ней отображаются «дети» выбранной записи. Все это довольно трудно объяснить на словах, поэтому в листинге 13.3 приведен исходный текст обработ чика OnDoubleClick, поясняющий сказанное. Внимательно просмотрите его и убедитесь, что вы поняли принцип его работы.
Листинг 13.3. Обработчик OnDoubleClick для перемещения по иерархии
procedure TForm2.DBGrid2DblClick(Sender : TObject); var NewRangeID, SelectedEmployeeID : String; begin { Выводим информацию о текущей записи } if Table1.FieldByName('Boss_ID').AsString = '' then Label1.Caption := Table2.FieldByName ('Boss_ID').AsString else Label1.Caption := Label1.Caption + ':' + Table2.FieldByName ('Boss_ID').AsString; { Предполагается, что свойство Table1.IndexFieldNames все еще равно 'Boss_ID;Emp_ID' } SelectedEmployeeID := Table2.FieldByName ('Emp_ID').AsString; NewRangeID := Table2.FieldByName ('Boss_ID').AsString; Table1.SetRange([NewRangeID],[NewRangeID]); Table1.FindKey([NewRangeID, SelectedEmployeeID]); end; procedure TForm2.UpOneLevelButtonClick(Sender : TObject); var PrevPos : Integer; NewRangeID : String; begin { Записи фильтруются по Boss_ID выбранного работника. } NewRangeID := Table1.FieldByName ('Boss_ID').AsString; Table1.CancelRange; Table1.IndexFieldNames := 'Emp_ID'; Table1.FindKey([NewRangeID]); NewRangeID := Table1.FieldByName ('Boss_ID').AsString; Table1.IndexFieldNames := 'Boss_ID'; { Восстанавливаем синхронизацию Table2. } Table1.SetRange([NewRangeID],[NewRangeID]); if Table1.FieldByName('Boss_ID').AsString = '' then Label1.Caption := ''; else begin PrevPos := 0; while Pos(':', Copy(Label1.Caption, PrevPos + 1, 999))<>0 do PrevPos := Pos(':',Copy(Label1.Caption, PrevPos +1, 999)) + PrevPos; Label1.Caption := Copy(Label1.Caption, 1, (PrevPos - 1)); end; end; Когда пользователь нажимает кнопку Up One Level, записи левой таблицы фильтруются по значению Boss_ID текущего фильтра. Хотя этот способ и допускает бесконечную рекурсию, вы все равно не сможете легко получить список всех подчиненных текущего начальника вместе с их подчиненными и так далее, вниз по иерархии. Кроме того, вам также не удастся получить всю цепочку вышестоящих начальников. Для этого придется перемещаться по ссылкам в нужном направлении, причем заранее неизвестно, через сколько уровней иерархии потребуется пройти.
Но и такие иерархии приносят пользу — они позволяют выбрать объект любого уровня и при этом снабжают приложение адекватными данными. Например, вы можете последовательно разделять географический регион на более мелкие области, но приложение всегда сможет узнать, к какому региону относятся эти области (кто является родителем самого верхнего уровня).
Кроме того, общие категории можно разделить на отдельные специали зации, но так, чтобы выбор общей категории приводил к включению всех специализаций. Например, при выборе категории «художники» в нее будут автоматически включены художники-портретисты, художники-баталисты, художники-маринисты и т. д. В этом случае для получения списка объектов общей категории вам не придется составлять отдельные списки для членов каждой специализации.

Пересылка нескольких файлов

Второй способ позволяет переслать сразу несколько файлов (пакет). Перед тем как начинать прием, мы выделяем файлы в списке lbRemoteFiles, щелкая на их именах. При этом в обработчике TfrmMain.lbRemoteFilesClick имена файлов заносятся в строковый список RemoteFiles. Это демонстрирует следующий фрагмент кода:
procedure TfrmMain.lbRemoteFilesClick (Sender: TObject); begin CsShopper1.RemoteFiles.Add (lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]); end; На рис. 6.6 видно несколько файлов, выделенных в каталоге удаленного хоста и готовых к приему. После того как будут выделены все принимаемые файлы, начинайте пересылку с помощью кнопки , расположенной вверху рядом со списком lbRemoteFiles. При этом будет вызван метод CsShopper.MGet. Соответствующий код выглядит так:
procedure TfrmMain.sbbtnRetrClick(Sender: TObject); begin pbDataTransfer.Visible := TRUE; bbtnAbort.Enabled := TRUE; CsShopper1.MGet; end;

Рис. 6.6. Выделенные файлы готовы к пакетному приему
Однако для того, чтобы описанная схема работала, нам придется изменить два свойства списка lbRemoteFiles в инспекторе объектов: во-первых, измените значение ExtendedSelect с FALSE на TRUE, а во-вторых, измените значение MultiSelect также с FALSE на TRUE. Если теперь щелкнуть на имени файла в списке lbRemoteFiles, оно заносится в строковый список CsShopper1.RemoteFiles (относящийся к типу TStringList). Аналогично в случае пакетной передачи вам придется изменить те же два свойства для списка flbLocal.
Замечание
Учтите, что возможность пакетной пересылки отсутствует в асинхронном режиме — это обусловлено трудностями с синхронизацией файловых операций.

Перетаскивание: как это делается

Прежде всего потребовалось выбрать компонент для календаря. Хотя вместе с Delphi поставляется неплохой календарь, в нем трудно связать дату с координатами внутри календаря. Поскольку этот компонент-пример отображает только дни текущего месяца (оставляя все остальные ячейки пустыми), мне пришлось бы писать специальный код для вычисления дат, соответствующих пустым ячейкам. Некрасивое решение.
Я остановил свой выбор на компоненте OvcCalendar, входящем в пакет VCL-компонентов Orpheus фирмы TurboPower Software. Этот мощный маленький компонент заполняет датами все ячейки, отображая при необходимости дни предыдущего и/или следующего месяца. Удаляя стандартный заголовок календаря, я могу быть уверен, что каждая ячейка соответствует какой-нибудь дате. Поскольку все ячейки имеют одинаковые размеры, вычислить абсолют ную дату по координатам мыши в OvcCalendar оказывается несложно.
Примечание
Компонент OvcCalendar вместе с остальными компонентами семейства Orpheus (специаль ная пробная версия) находится в каталоге \ORPHEUS прилагаемого CD-ROM. Последнюю пробную версию пакета всегда можно получить на Web-узле TurboPower по адресу http://www.turbopower.com.
Для своего расследования я создал приложение с единственной формой, на которой находятся текстовое поле, строковая сетка TStringGrid и календарь (и, разумеется, вездесущая кнопка для выхода из приложения). Общая идея такова: вы вводите строку в текстовом поле, затем перетаскиваете и бросаете ее на календарь, где она ассоциируется с определенной датой. Затем строка, содержащая дату и введенный текст, заносится в TStringGrid. Внешний вид формы для рабочей версии этого приложения показан на рис. 14.1.

Рис.14.1. Эксперимент с перетаскиванием
Я начал с шага 1. Было бы вполне логично перехватывать сообщения о нажатии кнопки мыши, поступающие от текстового поля. Идея оказалась удачной — но лишь в определенной степени. Перетаскивание из текстового поля приводит к непредвиденным последствиям — событие OnMouseEvent в контексте текстового поля уже имеет стандартный смысл, оно применяется для выделения текста. Используя это событие для перетаскивания, я тем самым теряю возможность выделить часть текста, перетаскивая над ней курсор.
Обработчик события OnMouseDown получает некоторые сведения — ссылку на объект, от которого поступило сообщение; параметр, идентифицирующий нажатую кнопку мыши; другой параметр, определяющий состояние клавиш Shift, Ctrl и Alt; и, наконец, координаты x и y курсора. В нашем случае сообщение поступает от текстового поля, поскольку именно в нем начинается операция перетаскивания. Координаты курсора можно игнорировать — меня не интересует, из какой именно точки поля начинается перетаскивание. Наконец, перетаскивание должно начинаться только при нажатии левой кнопки мыши (позднее выяснилось, что необходимо дополнительно отфильтровать двойные щелчки, поскольку их использование для перетаскивания приводит к странным побочным эффектам).
Все просто. Окончательный вид кода приведен в листинге 14.1.
Листинг 14.1. Обработчик события для инициализации перетаскивания
procedure TDDDemoForm.EditBoxMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and (EditBox.Text <> "") and not (ssDouble in Shift) then TEdit(Sender).BeginDrag(False); end; При тестировании исходной версии обработчика я обнаружил, что перетаскивание можно начать двумя способами. Если аргумент метода BeginDrag равен True, перетаскивание начинается сразу же после нажатия кнопки мыши, а если False — откладывается до тех пор, пока мышь не сдвинется на несколько пикселей. Второй вариант показался мне более естественным. Кроме того, я добавил проверку, которая блокировала попытки перетащить пустую строку. Преобразование типа, используемое при вызове метода BeginDrag, почти всегда необходимо при работе со ссылками на объекты Sender и Source, которые передаются обработчикам событий.
Настало время заняться шагом 2. Обработчику события OnDragOver передается несколько параметров. Параметр Source определяет объект, в котором началось перетаскивание (в нашем случае — текстовое поле). Параметр Sender обозначает объект, вызвавший событие, потенциальный приемник для операции перетаскивания (в нашем случае — календарь). Параметры X и Y
содержат относительные координаты курсора мыши внутри Sender, а State определяет состояние перетаскиваемого объекта (объект входит в границы Sender, покидает их или перемещается внутри Sender). Хотя для процесса перетаски вания предоставляется курсор по умолчанию, информация о состоянии позволяет легко выбрать собственный курсор для каждой стадии процесса. Наконец, присутствует логический параметр Accept, передаваемый по ссылке.
Цель игры — на основании представленной информации принять решение о том, можно ли завершить операцию перетаскивания. Ситуация выглядит так, словно пилот маленького самолета (Source) обращается к наземному наблюдателю: «Сообщаю свои координаты относительно поля, где вы находитесь. Можно ли сбрасывать груз?»
Как оказалось, выбор OvcCalendar сделал мою работу тривиальной: для сбрасывания подходит любая точка внутри клиентской области календаря. Исходный текст приведен в листинге 14.2.
Листинг 14.2. Проверка допустимости сбрасывания
procedure TDDDemoForm.CalendarDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := True; end;

Перетаскивание текста в списках

Спасибо, Джон. При перетаскивании объекта в Delphi вид курсора изменяется; по умолчанию курсор принимает вид стрелки, к которой присоединена небольшая рамка. Такое визуальное обозначение перетаскивания выглядит вполне нормально — раз уж курсор присутствует на экране, почему бы ему не выглядеть именно так?
Тем не менее вы можете придать пользователям еще больше уверенности в происходящем. Например, при перетаскивании одной из строк списка курсорможет выглядеть как прозрачное изображение текста, окруженное пунктирным прямоугольником. Оказывается, в Delphi 3 сделать это несложно.В листинге 9.5 приведен полный исходный текст компонента-списка, обладающего такой возможностью.
В отличие от Delphi 1 версии Delphi 2 и Delphi 3 обладают встроенной поддержкой для перетаскивания графических элементов; все, что от вас требуется — предоставить нужное изображение. Для этого следует нарисовать его в растровом виде, поместить растр в компонент TImageList и передать этот объект Delphi. После этого за перерисовку изображения при перемещении мыши будет отвечать код Delphi из модуля Controls.
Как видно из листинга 9.5, для хранения графики используется private-поле типа TImageList. Его следует создать как можно раньше, но не заносить в него изображение до начала перетаскивания. Чтобы обнаружить начало операции перетаскивания, мы переопределяем метод DoStartDrag. Кроме того, необходимо переопределить и метод GetDragImages, поскольку список изображе ний передается Delphi именно при вызове этого метода.
Почему мы не рисуем изображение сразу, а ждем до последней секунды? Потому что это позволяет синхронизировать перетаскиваемое изображение с перетаскиваемым элементом. Как узнать, какой текст следует вывести в растре, если еще неизвестно, какой элемент списка перетаскивается?
Листинг 9.5. Модуль TXTDRGBX.PAS
unit TxtDrgBx; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TTextDragListBox = class( TListBox ) private FDragImage: TImageList; protected procedure CreateDragImage; procedure DoStartDrag( var DragObject: TDragObject ); override; public constructor Create( AnOwner: TComponent ); override; destructor Destroy; override; function GetDragImages: TCustomImageList; override; end; procedure Register; implementation constructor TTextDragListBox.Create( AnOwner: TComponent ); begin inherited Create( AnOwner ); ControlStyle := ControlStyle + [ csDisplayDragImage ]; FDragImage := TImageList.CreateSize ( 32, 32 ); end; destructor TTextDragListBox.Destroy; begin FDragImage.Free; inherited Destroy; end; procedure TTextDragListBox.CreateDragImage; var Bitmap: TBitmap; // Перетаскиваемое изображение AnItemRect: TRect; // Прямоугольник, в котором находится // элемент списка MousePt: TPoint; // Положение курсора begin // Очищаем список изображений //и заканчиваем работу, // если в списке нет выделенных элементов FDragImage.Clear; if ItemIndex = -1 then Exit; // Создаем растр, масштабируем его //до размеров // выделенного элемента и выводим //в нем текст AnItemRect := ItemRect( ItemIndex ); Bitmap := TBitmap.Create; try with Bitmap do begin Width := AnItemRect.Right - AnItemRect.Left; Height := AnItemRect.Bottom - AnItemRect.Top; Canvas.Font := Font; Canvas.DrawFocusRect( Rect( 0, 0, Width, Height ) ); Canvas.Brush.Style := bsClear; Canvas.TextOut ( 1, 1, Items[ ItemIndex ] ); // Задаем размер списка изображений, заносим //в него // изображение и устанавливаем прозрачный цвет FDragImage.Width := Width; FDragImage.Height := Height; FDragImage.AddMasked( Bitmap, clWhite ); // ... задаем положение активной точки GetCursorPos( MousePt ); with ScreenToClient( MousePt ), AnItemRect do FDragImage.SetDragImage ( 0, X - Left, Y - Top ); end; finally Bitmap.Free; end; end; procedure TTextDragListBox.DoStartDrag ( var DragObject: TDragObject ); begin inherited DoStartDrag( DragObject ); CreateDragImage; end; function TTextDragListBox.GetDragImages: TCustomImageList; begin Result := nil; if FDragImage.Count > 0 then Result := FDragImage; end; procedure Register; begin RegisterComponents('HP Delphi 3', [ TTextDragListBox ]); end; end. Основную часть листинга 9.5 занимает процедура CreateDragImage для работы со списком изображений. После создания и прорисовки растра размер списка изображений приводится в соответствие с размером растра (не забывайте это делать!), после чего метод AddMasked заносит растр в список и назначает прозрачный цвет.
Метод SetDragImage, вызываемый двумя строками ниже, задает положение активной точки (hotspot) перетаскиваемого изображения. Мышь «держит» перетаскиваемое изображение в активной точке. В нашем случае вызов SetDragImage гарантирует, что текстовый прямоугольник будет перетаскиваться за точку его первоначального «захвата».
Конечно, запрограммировать этот прием в Delphi 2 и 3 оказывается сложнее, чем просто рисовать на экране, но зато перед вами открываются широкие возможности для организации визуального взаимодействия компонентов. Например, при перетаскивании изображения между списками второй список может скрыть перетаскиваемое изображение, выделить свой элемент-приемник и затем вернуть скрытое изображение на экран.

Перетаскивание

В системе Windows FMDD реализуется через интерфейс Shell из библиотеки SHELL32.DLL. При этом используются четыре функции API — DragAcceptFiles, DragQueryFile, DragQueryPoint и DragFinish, а также одно сообщение Windows, WM_DROPFILES. В Delphi сообщение WM_DROPFILES определено в модуле Messages, а функции API — в модуле ShellAPI. Документированный интерфейс относится к клиентам , но не серверам FMDD. Ваша программа сможет принимать файлы, перетаскиваемые из File Manager, но ей не удастся отправить файлы в другую программу.
Типичная реализация FMDD в программе для Windows требует выполнения следующих действий:

При запуске программы вызовите функцию DragAcceptFiles с логическим номером окна и флагом True, чтобы окно могло принимать перетаскивае мые файлы.

При получении окном сообщения WM_DROPFILES выполните следующие действия (поле Msg.wParam в структуре сообщений Object Pascal соответствует логическому номеру области памяти, используемой сообщением WM_DROPFILES): a) вызовите функцию DragQueryPoint, чтобы узнать, был ли перетаскивае мый объект брошен в клиентской области окна;
б) вызовите функцию DragQueryFile с параметром $FFFFFFFF, чтобы определить количество брошенных файлов;
в) для каждого файла вызовите DragQueryFile, чтобы скопировать его имя во внутренний буфер;
г) выполните с каждым файлом необходимые действия;
д) освободите всю внутреннюю память, выделенную при обработке перетаскивания;
е) вызовите функцию DragFinish, чтобы освободить память, занятую сервером FMDD (то есть File Manager).

При завершении программы вызовите функцию DragAcceptFiles с логическим номером окна и флагом False, чтобы прервать прием файлов окном.

В листингах 3.1 и 3.2 содержится черновой набросок программы, поддерживающей FMDD. На рис. 3.1 показано, как выглядит окно готовой программы.

Рис. 3.1. Готовая программа Drag1
Листинг 3.1. Файл DRAG1.DPR
{
DRAG1.DPR — Первый эксперимент с перетаскиванием
Автор: Джим Мишель
Дата последней редакции: 27/04/97
} program drag1; uses Forms, dragfrm1 in "dragfrm1.pas" {Form1}; {$R *.RES} begin Application.CreateForm(TForm1, Form1); Application.Run; end. Листинг 3.2. Модуль DRAGFRM1.PAS
{
DRAGFRM1.PAS — Первая реализация перетаскивания
Автор: Джим Мишель
Дата последней редакции: 27/04/97
} unit dragfrm1; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, { Функции перетаскивания определены в ShellAPI. Они реализованы в библиотеке SHELL32.DLL. } ShellAPI; type TForm1 = class(TForm) ListBox1: TListBox; Button1: TButton; Button2: TButton; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); procedure AppMessage(var Msg: TMsg; var Handled: Boolean); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } procedure WMDropFiles (hDrop : THandle; hWindow : HWnd); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage := AppMessage; { Вызываем DragAcceptFiles, чтобы сообщить менеджеру перетаскивания о том, что наша программа собирается принимать файлы. } DragAcceptFiles (Handle, True); end; procedure TForm1.WMDropFiles (hDrop : THandle; hWindow : HWnd); Var TotalNumberOfFiles, nFileLength : Integer; pszFileName : PChar; pPoint : TPoint; i : Integer; InClientArea : Boolean; Begin { hDrop — логический номер внутренней структуры данных Windows с информацией о перетаскиваемых файлах. } { Проверяем, были ли файлы брошены в клиентской области } InClientArea := DragQueryPoint (hDrop, pPoint); if InClientArea then Label2.Caption := "In client area" else Label2.Caption := "Not in client area"; { Определяем общее количество сброшенных файлов, передавая функции DragQueryFile индексный параметр -1 } TotalNumberOfFiles := DragQueryFile (hDrop , $FFFFFFFF, Nil, 0); for i := 0 to TotalNumberOfFiles - 1 do begin { Определяем длину имени файла, сообщая DragQueryFile о том, какой файл нас интересует ( i ) и передавая Nil вместо длины буфера. Возвращаемое значение равно длине имени файла. } nFileLength := DragQueryFile (hDrop, i , Nil, 0) + 1; GetMem (pszFileName, nFileLength); { Копируем имя файла — сообщаем DragQueryFile о том, какой файл нас интересует ( i ) и передавая длину буфера. ЗАМЕЧАНИЕ: Проследите за тем, чтобы размер буфера на 1 байт превышал длину имени, чтобы выделить место для завершающего строку нулевого символа! } DragQueryFile (hDrop , i, pszFileName, nFileLength); Listbox1.Items.Add (StrPas (pszFileName)); { Освобождаем выделенную память... } FreeMem (pszFileName, nFileLength); end; { Вызываем DragFinish, чтобы освободить память, выделенную Shell для данного логического номера. ЗАМЕЧАНИЕ: Об этом шаге нередко забывают, в результате возникает утечка памяти, а программа начинает медленнее работать. } DragFinish (hDrop); end; { AppMessage получает сообщения приложения. Этот обработчик следует назначить свойству Application.OnMessage в FormCreate. } procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean); begin case Msg.Message of WM_DROPFILES : begin WMDropFiles (Msg.wParam, Msg.hWnd); Handled := True; end; else Handled := False; end; end; procedure TForm1.FormClose (Sender: TObject; var Action: TCloseAction); begin { Прекращаем прием файлов } DragAcceptFiles (Handle, False); end; procedure TForm1.Button1Click(Sender: TObject); begin Listbox1.Clear; end; procedure TForm1.Button2Click(Sender: TObject); begin Close; end; end. Во всей программе по-настоящему заслуживает внимания всего одна строка из TForm1.FormCreate:
Application.OnMessage := AppMessage;
Она докладывает программе о том, что сообщения Windows должны передаваться процедуре TForm1.AppMessage. Так в Delphi организуется традиционная обработка сообщений. Нам пришлось это сделать из-за того, что ни класс TControl, ни его потомки (например, TForm) ничего не знают о сообщении WM_DROPFILES, поэтому поступающее сообщение не будет «упаковано» в какое-нибудь приятное событие Delphi типа OnDropFiles. Неприятно, однако ничего не поделаешь.
И все же листинг 3.2 не радует. Конечно, программа работает (а это самое главное), но она получилась большой, чреватой ошибками, а самое главное — уродливо й. Как хотите, но в программе на Delphi весь этот кошмарный код Windows неуместен.
Существует и другая проблема, обусловленная механизмом обработки сообщений Delphi. Предположим, у вас имеются две формы, каждая из которых должна реагировать на сообщение WM_DROPFILES. Если каждая форма назначит событию OnMessage объекта Application свой собственный обработчик, то сообщения будут поступать лишь во вторую форму. Первый обработчик будет попросту перекрыт вторым. Эту проблему можно обойти несколькими способами, и мы рассмотрим некоторые из них после того, как расправимся с уродливым кодом Windows.

Первая попытка

Общий сценарий выглядит так: я выбираю нужную вкладку и перетаскиваю строку с описанием задачи на сетку. Для всех трех страниц при этом выполняются практически одинаковые операции. Единственное отличие заключается в том, какая сетка получает строку. Следовательно, необходимо придумать способ совместного использования обработчиков OnDragOver и OnDrag Drop всеми тремя сетками.
Наверное, это вопрос личного вкуса, но я предпочитаю, чтобы совместно используемые обработчики событий имели более внятные имена, чем генерирует Delphi. Я решил назвать их GridDragOver и GridDragDrop.
Перед тем как следовать дальше, опишу алгоритм для создания нестандарт ных имен обработчиков1:

Дважды щелкните на имени обрабатываемого события в инспекторе объектов.

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

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

Отредактируйте имя процедуры, затем выделите его двойным щелчком и нажмите Ctrl+C, чтобы скопировать в буфер.

Перейдите в начало файла и найдите объявление исходного обработ чика среди прочих объявлений формы. Выделите исходное имя и нажмите Ctrl+V, чтобы заменить его новым.

В какой-то момент Delphi пожалуется, что исходное имя (все еще присутствующее в инспекторе объектов) не найдено. Подтвердите его удаление.

Переместите курсор в пустую строку инспектора объектов. Вставьте в нее новое имя, нажимая Ctrl+V.

Сохраните файл.

Исходный текст написанных мной процедур приведен в листинге16.1.
Листинг 16.1. Общие обработчики событий OnDragOver и OnDragDrop
{ Общий обработчик для события OnDragOver всех сеток. }
procedure TShareEventDemoForm.GridDragOver(Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
{ Принимается все, что угодно, но только из текстового поля. }
Accept := Source is TEdit;
end;
{ Общий обработчик для события OnDragDrop всех сеток. }
procedure TShareEventDemoForm.GridDragDrop(Sender, Source : TObject;
X, Y : Integer);
1 Визуальные среды таят в себе серьезную опасность — люди начинают забывать, что у компьютера кроме мыши есть еще и клавиатура. Вот и Эйс Брейкпойнт (или Дон Тейлор?), судя по всему, даже не догадывался, что оставлять создание имен обработчиков на усмотре ние Delphi вовсе не обязательно. Просто введите желаемое имя в поле нужного события на вкладке Events и нажмите клавишу Enter. — Примеч. ред.
begin { Сбрасываем перетаскиваемый объект на текущую сетку. } DropEditString(CurrentGrid); end; { Вспомогательная процедура для сброса строки из текстового поля на указанную сетку. Также очищает содержимое текстового поля. } procedure TShareEventDemoForm.DropEditString (AGrid : TStringGrid); begin if AGrid <> nil then with AGrid do begin Cells[0, RowCount - 1] := EditBox.Text; RowCount := RowCount + 1; EditBox.Text := ''; end; { with } end; { Возвращает указатель на сетку, расположенную на текущей вкладке. } function TShareEventDemoForm.CurrentGrid : TStringGrid; begin Result := nil; if PageControl.ActivePage = MorningSheet then Result := MorningGrid else if PageControl.ActivePage = AfternoonSheet then Result := AfternoonGrid else if PageControl.ActivePage = EveningSheet then Result := EveningGrid; end; Процедура OnDragOver выглядит очень просто. Объект, перетаскиваемый из текстового поля, может быть принят любой сеткой. Я решил разбить обработку OnDragDrop на две части: главный обработчик и вспомогательную процедуру. Обработчик ограничивается вызовом вспомогательной процедуры
с использованием функции, возвращающей указатель на сетку текущей вкладки1. Здесь проявляется способность Delphi скрывать работу с указателями, благодаря чему можно выполнить нужные операции и сохранить «четкость» программы. Получив указатель, процедура DropEditString заносит строку
из текстового поля в соответствующую сетку, добавляет в нее новую строку и стирает содержимое текстового поля.
Для сетки на первой вкладке (MorningGrid) обработчик делал именно то, что требовалось. Я вернулся к инспектору объектов и присоединил те же обработ чики к двум другим решеткам — и снова все идеально работало.
1 ?ешение, использующее для распознавания нужной сетки параметр Sender, является намного более элегантным. — Примеч. ред.

Плавающие панели инструментов

Дневник №16 (3 апреля): Я всегда любил программы с панелями инструментов, свободно перемещаемыми по экрану. Такие панели особенно удобны
в графических редакторах и программах компьютерной верстки, так как палитру с необходимыми инструментами можно расположить вблизи от того места, над которым вы работаете.
В поисках основы для «плавающей» панели инструментов я перебрал различные компоненты, поставляемые вместе с Delphi. Наверное, можно было бы воспользоваться дополнительной формой, но я не стремился к экзотическим решениям. Меня вполне устроило бы нечто, перемещаемое в пределах клиентской области главной формы.
Обычный компонент TPanel прекрасно подходил на эту роль, за исключением одного: панели нельзя перемещать во время выполнения. Однако небольшое исследование показало, что они способны обрабатывать события мыши. После нескольких неудачных попыток у меня получилась демонстрационная программа, приведенная в листинге16.7.
Листинг 16.7. Исходный текст программы с плавающей панелью инструментов
{——————————————————————————————————————————————————————} { Демонстрационная программа } { для работы с плавающими панелями инструментов. } { TOOLMAIN.PAS : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Приложение, демонстрирующее возможность применения } { перемещаемых объектов TPanel в качестве плавающих } { панелей инструментов. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} unit ToolMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtrl, ExtCtrls, Buttons; type TDirection = (otHorizontal, otVertical); TForm1 = class(TForm) Toolbar: TPanel; ExitSB: TSpeedButton; ZoomInSB: TSpeedButton; ZoomOutSB: TSpeedButton; ControlPanel: TPanel; GranRBGroup: TRadioGroup; MarginRBGroup: TRadioGroup; OrientRBGroup: TRadioGroup; ExitBtn: TButton; LEDSB: TSpeedButton; procedure ExitBtnClick(Sender: TObject); procedure ToolbarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ToolbarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ToolbarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure GranRBGroupClick(Sender: TObject); procedure MarginRBGroupClick(Sender: TObject); procedure ExitSBClick(Sender: TObject); procedure OrientRBGroupClick(Sender: TObject); private DraggingPanel : Boolean; DragStartX : Integer; DragStartY : Integer; GridSize : Integer; MarginSize : Integer; procedure OrientToolBar(Direction : TDirection); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.ExitBtnClick(Sender: TObject); begin Close; end; procedure TForm1.ToolbarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin DraggingPanel := True; DragStartX := X; DragStartY := Y; end; end; procedure TForm1.ToolbarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin DraggingPanel := False; end; procedure TForm1.ToolbarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var DeltaX : Integer; DeltaY : Integer; SafetyMargin : Integer; begin if DraggingPanel then with Toolbar do begin DeltaX := X - DragStartX; DeltaY := Y - DragStartY; if GridSize > MarginSize then SafetyMargin := GridSize else SafetyMargin := MarginSize; if (abs(DeltaX) > GridSize - 1) then if DeltaX > 0 then begin if (ControlPanel.Left - Left) > SafetyMargin then Left := Left + DeltaX else Left := ControlPanel.Left - SafetyMargin; end else begin if (Left + Width) > SafetyMargin then Left := Left + DeltaX else Left := SafetyMargin - Width; end; if (abs(DeltaY) > GridSize - 1) then if DeltaY > 0 then begin if (Form1.ClientHeight - Top) > SafetyMargin then Top := Top + DeltaY else Top := Form1.ClientHeight - SafetyMargin; end else begin if Top + Height > SafetyMargin then Top := Top + DeltaY else Top := SafetyMargin - Height; end; end; { with } end; procedure TForm1.FormCreate(Sender: TObject); begin GranRBGroup.ItemIndex := 0; MarginRBGroup.ItemIndex :=0; OrientRBGroup.ItemIndex := 0; end; procedure TForm1.GranRBGroupClick(Sender: TObject); begin case GranRBGroup.ItemIndex of 0 : GridSize := 1; 1 : GridSize := 10; 2 : GridSize := 20; end; { case } end; procedure TForm1.MarginRBGroupClick(Sender: TObject); begin case MarginRBGroup.ItemIndex of 0 : MarginSize := 5; 1 : MarginSize := 10; 2 : MarginSize := 15; end; { case } end; procedure TForm1.ExitSBClick(Sender: TObject); begin Close; end; procedure TForm1.OrientRBGroupClick(Sender: TObject); begin case OrientRBGroup.ItemIndex of 0 : OrientToolBar(otHorizontal); 1 : OrientToolBar(otVertical); end; { case } end; procedure TForm1.OrientToolbar(Direction : TDirection); begin with Toolbar do begin Left := 20; Top := 20; case Direction of otHorizontal : begin Width := (4 * ExitSB.Width) + 20;; Height := ExitSB.Height + 10; ExitSB.Top := 6; ZoomInSB.Top := 6; ZoomOutSB.Top := 6; LEDSB.Top := 6; ExitSB.Left := 11; ZoomInSB.Left := ExitSB.Left + ExitSB.Width; ZoomOutSB.Left := ZoomInSB.Left + ZoomInSB.Width; LEDSB.Left := ZoomOutSB.Left + ZoomOutSB.Width; end; otVertical : begin Width := ExitSB.Width + 10; Height := (4 * ExitSB.Height) + 20; ExitSB.Left := 6; ZoomInSB.Left := 6; ZoomOutSB.Left := 6; LEDSB.Left := 6; ExitSB.Top := 11; ZoomInSB.Top := ExitSB.Top + ExitSB.Height; ZoomOutSB.Top := ZoomInSB.Top + ZoomInSB.Height; LEDSB.Top := ZoomOutSB.Top + ZoomOutSB.Height; end; end; { case } end; { with } end; end. Как видно из листинга, панель должна обрабатывать три события мыши — OnMouseDown, OnMouseMove и OnMouseUp. Обработчик OnMouseDown проверяет, была ли нажата левая кнопка мыши. Если это так, он запоминает исходное положение курсора и устанавливает флаг статуса в состояние, которое обозначает перетаскивание.
Обработчик OnMouseMove выглядит сложнее — в основном потому, что ему приходится следить, чтобы панель не вышла за пределы клиентской области и не потерялась из вида. Обработчик ToolbarMouseMove вычисляет разность между исходным и текущим положениями мыши и прибавляет ее к первоначаль ным значениям свойств Left и Top панели, чтобы переместить ее в новое место. Я предусмотрел возможность перемещения панели с шагом в 1, 10 или 20 пикселей. Внешне это выглядит похожим на перемещение компонентов в режиме конструирования Delphi при включенной привязке к сетке. Кроме того, я позаботился о том, чтобы участок панели всегда можно было захватить мышью, даже если пользователь по неосторожности уведет ее слишком далеко.
Обработчик OnMouseUp выглядит тривиально; все, что от него требуется — сбросить флаг статуса.

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

Почему интерфейсы?

Перед тем как следовать дальше, я хотел бы объяснить, почему я пользуюсь интерфейсами Delphi3, вместо того чтобы просто определить классы вида и фрейма и создавать объекты на их основе. Не вызвано ли применение интерфейсов обычным желанием воспользоваться новой эффектной возможностью Delphi 3?
Вовсе нет. Начнем с того, что виды и фреймы связаны циклической зависимостью. Фрейм должен сообщать виду о необходимости чтения или записи в модель; вид должен сообщать фрейму об изменении свойства Valid. Разумеется, подобную циклическую зависимость можно было бы реализовать с помощью опережающего объявления классов вместо опережающего объявления интерфейсов, но мне кажется, что интерфейсы делают эти взаимосвязи более понятными и избавляют их от груза посторонних свойствиметодов. Кроме того, хотя я и не использую такую возможность вEMBEDDEDFORMS.PAS, применение интерфейсов означает, что вид можно реализовать несколькими различными способами — он не обязан быть потомком TEmbeddedForm. Однако самая важная причина заключается в том, что вид сам может быть фреймом.
Например, объект Employee (работник) может содержать ссылки на объекты типа People для самого работника и его руководителя, каждый из которых в свою очередь содержит сведения об имени и адресе. Вид объекта Employee может содержать внутренние виды для соответствующих полей. В Delphi не поддерживается множественное наследование, поэтому объект не может одновременно быть TView и TFrame, однако он легко может реализовать интерфейсы IView и IFrame.
Перед тем как в Delphi появилась поддержка интерфейсов, для реализации чего-то наподобие протокола INotify обычно применялись процедурные типы:
type TOnValidChanged = procedure(ChangingObject: TObject) of object; procedure TViewAddNotifiee(Callback: TOnValidChanged); Такая схема работала, но TOnValidChanged — это практически то же самое, что и TNotifyProc, и в каждой Delphi-программе такие процедурные типы встречаются в избытке. Вы можете передать процедуре AddNotifiee любой объект TNotifyProc, и компилятор никак не сможет предотвратить ошибочную передачу неверного параметра. При использовании интерфейсов процедура косвенного вызова (callback) фрейма должна иметь правильное имя и правильную сигнатуру, и притом она должна принадлежать объекту, реализующему протокол IFrame — это намного снижает вероятность случайных ошибок.

Подключение

Пользуясь введенной информацией, метод CsShopper.Start вызывает GetHost, чтобы открыть соединение с удаленным хостом. Если вызов функции завершится неудачно, WSAErrorMsg отображает возможную причину неудачи и присваивает Status значение Failure. В противном случае Status присваивается значение Success. При успешной установке соединения CsShopper вызывает процедуру события ConnEvent (унаследованную от CsSocket), чтобы сообщить SHOPPER32 о необходимости изменения состояния кнопок. Например, кнопка Quit блокируется до момента установления соединения, а затем становится доступной. Start вызывает FTPCommand для посылки команд USER, PASS, SYST и PWD (именно в таком порядке) с соответствующими аргументами. Затем Start устанавливает соединение данных (data connection) для пересылки списка каталогов и файлов удаленного хоста, при этом порт данных для соединения задается функцией GetPort.
Чтобы получить список каталогов, Start посылает команду LIST с помощью FTPCommand. Результат сохраняется, а последующий вызов Decode анализирует полученные данные и ищет в них информацию о каталогах и файлах.
Замечание
Механизм анализа несложен, однако описание каталогов и файлов на разных системах может выглядеть по-разному. Анализатор CsShopper работает с серверами, использующими Unix и Unix-подобные системы. Для других операционных систем он иногда выдает неверную информацию о каталогах.
Decode сравнивает первый символ каждой строки файла FTPFILE.TMP с «d» (для каталогов) или два начальных символа — с «-r» (для файлов). Если будет найден символ «d», Decode удаляет его, проверяет оставшуюся часть строки и преобразует ее в знакомый формат \ddd. Обратная косая черта сообщает SHOPPER32 о том, что строка содержит имя каталога. Аналогично в случае файлов Decode удаляет символы «-r» и ищет в строке имя, время, дату и размер файла, выделяя их в подстроки. Затем эти составные части переставляются так, чтобы получившаяся строка подходила для просмотра в окне списка SHOPPER32 (см. рис. 6.5).
Метод FRemFiles.Add, используемый внутри Decode, читает каждую сформатированную строку и заносит ее в FRemFiles. Свойство FRemFiles представляет собой список строк, производный от класса TStringList и созданный в конструкторе TCsShopper.Create.
После того как процедура Decode завершит построение списка, CsShopper передает FRemFiles процедуре TCsShopper.ChangeList, вызывающей обработчик
OnList: procedure TCsShopper.ChangeList(List : TStringList);
begin
if Assigned(FUpDateList) then
FUpDateList(Self, List);
end;

Рис. 6.5. Отображение файлов и каталогов в SHOPPER32
Обработчик события OnList в программе SHOPPER32 обновляет содержимое списка lbRemoteFiles:
procedure TfrmMain.CsShopper1List(Sender: TObject; List:TStringList);
begin
lbRemoteFiles.Items := List;
lbRemoteFiles.UpDate;
gbRemote.Caption := CsShopper1.RemoteDir;
end;

Поиск сервиса

Процесс преобразования номера порта в соответствующий ему тип сервиса почти не отличается от только что описанного, за исключением того, что на этот раз используется блокирующая функция Winsock getservbyport. Вместо того чтобы подробно рассматривать весь процесс, мы лучше рассмотрим WSAAsyncGetServByPort, асинхронную версию getservbyport.
Чтобы воспользоваться асинхронным режимом, необходимо сначала изменить свойство Access установкой переключателя Non-blocking в групповом поле TypeOfLookup. Затем введите имя порта в текстовом поле edPortName и нажмите кнопку Resolve.

Рис.5.7. Результат преобразования имени сервиса
Когда мы присваиваем номер порта, хранящийся в edPortName.Text, свойству WSPort, он передается методу TCsSocket.SetPortName в качестве параметра ReqdPortName. Убедившись в том, что строка номера порта не пуста, SetPortName вызывает SetAsyncPort. Метод SetAsyncPort копирует номер порта в поле FPortNo — строку с нуль-терминатором. Затем вызов WSAAsyncGetServByPort извлекает номер порта.
Результат этого вызова сохраняется в поле FTaskHandle. Если значение FTaskHandle равно нулю, вызов закончился неудачей. В противном случае он прошел успешно, и тогда SetAsyncPort возвращает управление приложению, оставляя процесс просмотра выполняться в фоновом режиме. После его завершения посредством сообщения от Winsock DLL инициируется AsyncOperation. Переменная Mess проверяется на предмет ошибки. Если ошибки не было, метод возвращает номер порта. В противном случае он вызывает ErrorEvent, чтобы вывести причину ошибки, присваивает флагу FStatus значение Failure и возвращает управление приложению.

Поиск записей

Мы узнали, как определить объект, выбранный пользователем. Но этого недостаточно — необходимо научиться искать объекты на программном уровне. В зависимости от типа элемента вам, возможно, придется просмотреть всю структуру данных, прежде чем вы найдете нужный объект. Если в границах иерархии сортированный список делится на несколько сортированных групп (например, родительский объект соответствует определенной букве алфавита, а дети — всем объектам, описание которых начинается с этой буквы), вы сможете воспользоваться группировкой и ускорить поиск, находя нужного родителя и ограничиваясь поиском среди его потомков.
Потенциальная проблема заключается в многократном просмотре одних и тех же объектов во время поиска. Если поиск производится в направлении от объекта к родителю, один и тот же родитель будет просматриваться для каждого из его детей. Если только содержимое объектов не создает некоторой сужающей поиск группировки, поиск почти всегда безопаснее всего выполнять линейным просмотром полного списка объектов.
В некоторых случаях можно создать индекс или таблицу перекрестных ссылок и воспользоваться ими в программе. Компонент TTreeView работает очень медленно, даже простой перебор узлов занимает много времени. Если заменить его сортированным списком TStringList, будет выполняться очень быстрый двоичный поиск без учета регистра. Найденный идентификатор объекта может ассоциироваться с указателем на объект TTreeNode (список может быть заполнен идентификаторами и указателями на соответствующие им объекты после загрузки всех узлов).
Result := nil; Index := LookupStringList.IndexOf (IntToStr(FindThisValue)); if Index > -1 then Result := TTreeNode(LookupStringList.Objects[Index]);

Положи на место!

В асинхронном режиме в отличие от блокирующего можно легко прервать затянувшуюся пересылку файла — достаточно нажать кнопку Abort на вкладке Connect (обратите внимание на то, что в блокирующем режиме эта кнопка недоступна). При нажатии кнопки Abort вызывается метод CsShopper.Abort, который посылает серверу через управляющее соединение команду ABOR. Рассмотрим следующий фрагмент кода:
procedure TCsShopper.Abort; begin ChangeBusy(TRUE); SendFtpCmd(LoadStr(SFtpAbor)); FFtpCmd := FTP_ABORT; ChangeBusy(FALSE); end; При получении кода ответа 226, означающего успешную отмену пересылки, CsShopper.ProcessAbort закрывает соединение данных, а в случае приема файла — стирает локальный файл.

Получение доступа к данным

Чтобы новый класс TDBStatistics мог извлечь анализируемые данные, он должен прежде всего подключиться к компоненту TTable или TQuery. Для этого проще и удобнее всего снабдить наш компонент свойством DataSource. Именно это мы и сделаем. Секция private содержит следующее объявление:
fDataSource : TDataSource;
Свойство DataSource, предоставляющее доступ к этому полю, конечно, становится доступным в режиме разработки благодаря ключевому слову published.
Кроме того, DBStatistics необходимо сообщить о том, какое поле следует анализировать. Это легко достигается с помощью свойства DataField. Во всем этом нет ничего нового, эти свойства можно найти в любом компоненте на вкладке Data Controls. Поскольку эти свойства так часто встречаются, включение их в DBstatistics помогает создать более знакомую обстановку в режиме разработки. Локальное хранение данных
После получения доступа к данным нам потребуется место для их хранения. Процедуры модуля Math работают со статически объявленными массивами; следовательно, нам понадобится такой массив. Мы назовем его Data.
Остается вопрос: каким должно быть максимальное количество элементов в Data? При выборе этого значения приходится учитывать два фактора. Первый фактор — количество записей в таблице среднего (для ваших приложений) размера. Если объем таблицы обычно не превышает 4000 записей, то максимальное количество элементов вполне можно выбрать равным 4500.
Второй фактор — объем доступной памяти. Если расход памяти непринци пиален, массив можно сделать сколь угодно большим. В противном случае оптимальный размер приходится искать методом проб и ошибок.
В нашем примере объявляется массив Data, состоящий из 10 000 элементов (разумеется, значение 10 000 объявлено в виде константы — MaxValues). Для большинства типичных приложений этого вполне достаточно.

Потоки и TPersistent

«Устойчивостью» (persistence) называется способность объекта продолжать свое существование в течение некоторого времени. В Delphi имя TPersistent было присвоено классу, специально разработанному так, чтобы его объекты сохранялись при нескольких запусках программы. Чтобы объект мог пережить завершение программы, важнейшая информация о нем записывается в поток и загружается позднее.
Потоки Delphi умеют работать с классом TPersistent, так что чтение и запись объектов происходит почти автоматически. Однако не все объекты TPersistent равноценны. Компоненты , являющиеся потомками TPersistent, можно сохранять и загружать удобными методами TStream.WriteComponent и ReadComponent. Но другие потомки TPersistent сохраняются в потоках лишь в том случае, если они представляют собой published-свойства компонентов — то есть теряют самостоятельность.
Это становится неудобным, если мы захотим сохранить в потоке, например, шрифтовой объект. Сначала придется объявить новый тип компонента с published-свойством TFont, затем создать экземпляр этого компонента, присвоить шрифтовому свойству наш объект и записать компонент в поток.
Но если все, что вам нужно — это «рабочая лошадка», которая возит на себе TPersistent, необязательно каждый раз объявлять новый класс. Необходим всего один класс для компонента с published-свойством TPersistent; полиморфизм позволяет назначить этому свойству объект любого класса-потомка TPersistent, и он будет сохраняться и загружаться вместе с компонентом.
Компонент TCarrier (см. листинг 9.17) как раз и является таким «вьючным животным». Он спрятан в секции implementation модуля StrmPers, а процедуры WritePersistent и ReadPersistent занимаются созданием, использованием и уничтожением временных экземпляров его объектов. Не забудьте создать свой TPersistent перед тем, как использовать его при вызове ReadPersistent; к этому моменту объект уже должен существовать.
Листинг 9.17. Модуль STRMPERS.PAS
unit StrmPers; interface uses Classes; procedure WritePersistent( Stream: TStream; Persistent: TPersistent ); { ЗАМЕЧАНИЕ: Объект TPersistent должен быть создан до его передачи этой процедуре... } procedure ReadPersistent( Stream: TStream; Persistent: TPersistent ); implementation type TCarrier = class( TComponent ) private FPersistent: TPersistent; published property Persistent: TPersistent read FPersistent write FPersistent; end; procedure WritePersistent( Stream: TStream; Persistent: TPersistent ); var Carrier: TCarrier; begin Carrier := TCarrier.Create( nil ); try Carrier.Persistent := Persistent; Stream.WriteComponent( Carrier ); finally Carrier.Free; end; end; procedure ReadPersistent( Stream: TStream; Persistent: TPersistent ); var Carrier: TCarrier; begin Carrier := TCarrier.Create( nil ); try Carrier.Persistent := Persistent; Stream.ReadComponent( Carrier ); finally Carrier.Free; end; end; end.

Потрясающее открытие

Эйс Брейкпойнт набрал рабочий номер Хелен. Она подняла трубку после второго гудка.
— Алло, чем могу помочь?
— Хелен — у меня есть потрясающие новости. Хочу, чтобы ты узнала их первой».
— Отлично, милый, — ответила Хелен. — А что случилось?
— Я нашел важную улику — вернее, я хотел сказать, что Автор помог мне отыскать важное вещественное доказательство.
— Хорошо, что ты связался с ним, Эйс. И что же ты нашел?
— Кожаную перчатку. Она валялась на земле рядом со стоянкой и почти полностью ушла в грязь. Торчал только кончик большого пальца. Если бы я не знал, где искать, то никогда бы не нашел ее.
— Может быть, ее выронил кто-то из машины, припаркованной рядом с твоей, — заметила Хелен.
— Черт возьми! — воскликнул он. — Ты знаешь, той ночью там действи тельно стояла машина. Я запомнил это только потому, что обычно это место остается пустым. Даже не могу вспомнить, как она выглядела. Помню только, что большая и грязно-белого цвета. Но сейчас наверняка не осталось ни единого отпечатка шин.
— А как насчет перчатки? Что ты можешь сказать о ней? — спросила Хелен.
Эйс внимательно осмотрел улику.
— Не стоит и говорить, она вся перепачкана грязью. Снять отпечатки пальцев не удастся. Посмотрим, что там внутри… все промокло… подкладки нет… Постой! Здесь застряла пара волосков. Наверное, с руки вора.
— Это Бохакер , Эйс, — взволнованно прошептала Хелен.
— Дорогая, это невозможно. Какое-то время я действительно думал, что это он. Но я несколько раз пытался дозвониться до него, и к телефону никто не подходил. К тому же теперь, когда у нас есть перчатка…
— Называй это женской интуицией или как хочешь, — прервала его Хелен, — но я просто знаю, что эта перчатка принадлежит Бохакеру.
— Если бы у меня был хоть один волосок, который точно принадлежит ему, то мы бы могли провести анализ ДНК, — заметил Эйс.
— Наверное, нам никогда не удастся это сделать. Дело в том… Эйс! У тебя сохранился плащ с кровью Мелвина Бохакера? Не подойдет ли он для анализа ДНК?
— Конечно, сохранился! — воскликнул он. — Висит у меня в шкафу. Я отнесу его вместе с перчаткой в Крайм-сити.
— Куда?
— Это сеть круглосуточных лабораторий для обслуживания частных детективов. Они проанализируют ДНК и сообщат результаты по факсу через пару часов. Думаю, у меня даже завалялся купон, дающий право на скидку в 2 доллара. Сделаем так: я заброшу вещи в лабораторию и встречу тебя после работы. Мы где-нибудь перекусим, и к тому времени результаты экспертизы уже будут готовы. Как ты к этому относишься?
— Можешь рассчитывать на меня, — ответила она.

Практическая реализация видов

До настоящего момента эта глава выглядела несколько абстрактно. День за днем вы работаете с объектами, компонентами, формами и обработчиками событий — никаких моделей, видов или фреймов. Однако эти абстракции полезны и даже необходимы. Стандартная абстракция «модель/вид» помогает избежать «ловушки RAD» (RAD — Rapid Application Development, быстрое создание приложений), то есть размазывания смыслового кода по многочислен ным обработчикам событий, которые трудно понять, изменить или повторно использовать. Концепция фрейма помогает избежать похожей ловушки и не привязывать вид к конкретному объекту-контейнеру (форме, панели или вкладке диалогового окна). И все-таки теорию следует оценивать по программам, написанным с ее помощью — итак, как же реализовать вид, который можно использовать в нескольких фреймах?

особенно начинающие) любят задавать вопросы

Программисты ( особенно начинающие) любят задавать вопросы типа: «Скажи, на чем ты пишешь?..» Когда-то этот вопрос выглядел вполне логично. Компиляторы, отладчики, серверы, системы управления базами данных и все остальное только-только выходило из каменного века. Программные инструменты разительно отличались друг от друга по качеству и возможностям. Стоило сделать ставку на неудачный инструментарий, и работа становилась излишне тяжкой, а качество результата - низким.
Сегодня стал актуальным другой вопрос: «А чего стоишь ты сам?» Благодаря непрерывной конкуренции современные средства разработчика стали невероятно мощными и качественными, так что среднему программисту вряд ли удастся выжать из них все возможное. Скорее всего, вы спасуете намного раньше, чем ваш инструментарий - если только не узнаете о нем абсолютно все и не доведете свое мастерство программиста до подлинного совершенства.
Книги этой серии предназначены для углубленного изучения программных инструментов. В них рассматриваются нетривиальные возможности, которые невозможно описать в простейшем учебнике. Полноценные проекты заставляют читателя мыслить на уровне эксперта - напрягать серое вещество, лежащее в основе всего, что мы называем «мастерством».
Конечно, это не единственный путь - например, можно добросовестно набивать шишки обо все острые углы новых технологий и наобум пробовать все подряд, пока что-нибудь не заработает. А можно воспользоваться опытом наших авторов, которые уже прошли стадию обучения и попутно сделали кое-какие заметки на память. Мы тщательно отобрали темы, авторов и методику изложения, чтобы читатель не путался в ненужных вступлениях или редких технологиях, которые ему все равно не понадобятся.
Наша главная цель - поднять ваше мастерство настолько, насколько вы сами захотите. Классные инструменты у вас уже есть, осталось лишь стать классным программистом.
Джефф Дантеманн
Моему благодетелю, Иисусу из Назарета. Ты подарил мне то, чего я не заслужил бы и за тысячу жизней.
Дон Тейлор
Дину Беннету (Dean Bennett) и Рэнди Шаферу (Randy Schafer), хорошим друзьям и коллегам.
Джим Мишель
Моей дорогой жене Джоси и прекрасным детям, Дэвиду и Диане, за их поддержку. Маме и папе - за любовь и непрестанные усилия, благодаря которым я стал таким, какой есть.
Джон Пенман
Тиму, брату и другу.
Теренс Гоггин
Моим мальчикам, Сэму и Арту, и их маме Тане. Не могу представить лучшей побудительной причины для продолжения работы.
Джон Шемитц

Преобразование портов и сервисов

Преобразование имен сервисов и портов, как и символьных имен с IP-адресами, может выполняться в блокирующем или псевдоблокирующем (асинхронном) режиме. В блокирующем режиме для этого используются функции getservbyname и getservbyport.
Поиск порта, связанного с определенным сервисом, во многом похож на процесс получения имени хоста. Например, если мы захотим определить номер порта для FTP, следует ввести строку FTP в текстовом поле edServiceName и затем присвоить ее свойству WSService. При этом имя сервиса передается методу TCsSocket.SetServiceName для преобразования. После копирования строки Паскаля ReqdServiceName в строку с нуль-терминатором ServName с помощью функции StrPCopy в строку протокола заносится текст «TCP», один из обязательных параметров для getservbyname. По умолчанию используется протокол TCP, а это означает, что при попытке определить номер порта для сервиса, основанного на другом протоколе (обычно UDP), функция getservbyname вернет указатель NIL. Некоторые сервисы используют либо TCP, либо UDP, либо оба протокола сразу. Чтобы определить, доступен ли сервис для протокола UDP, следует установить переключатель UDP в групповом поле rgProtocol и затем нажать кнопку Resolve.
Метод SetServiceName вызывает функцию getservbyname для получения соответствующего номера порта. Если сервис найден, функция getservbyname
присваивает полю FServ указатель на структуру типа pServent. После этого структура будет содержать номер порта. В противном случае функция возвращает пустой указатель; тогда метод вызывает ErrorEvent, чтобы вывести причину ошибки из WSAErrorMsg, присваивает флагу FStatus значение Failure и возвращает управление вызывающему приложению. Номер порта определяется с помощью следующего оператора:
FPortName := IntToStr(LongInt(abs(ntohs(FServ^.s_port))));
На рис. 5.7 показано, как выглядит результат преобразования.

Преобразование протоколов

Получение имени и номера протокола требуется несколько реже других функций преобразования, но для полноты картины CsSocket поддерживает и их. Эти преобразования выполняются функциями API getprotobyname, getprotobyno, WSAAsyncGetProtoByName и WSAAsyncGetProtoByNo. По своей структуре и использованию эти функции похожи на те, что рассматривались выше.

Прием и передача файлов

Прием и передача могут осуществляться как по отдельности, так и пакетами, состоящими из нескольких файлов, Сначала мы рассмотрим пересылку отдельных файлов. Она начинается двойным щелчком на имени принимаемого или передаваемого файла в списке.
Ключевым моментом при этом является создание нового события. После того как вы поместите список lbRemoteFiles на вкладку Connect, создайте обработчик для его события ObDblClick на вкладке Events инспектора объектов. Это событие обрабатывается процедурой TfrmMain.lbRemoteFilesDblClick. Как показано в следующем фрагменте, в результате имя файла присваивается свойству
CsShopper.Get: procedure TfrmMain.lbRemoteFilesDblClick(Sender: TObject); begin
pbDataTransfer.Visible := TRUE;
if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.Get := lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]
else
pbDataTransfer.Visible := FALSE; end;
Внутри компонента CsShopper свойство Get передает имя файла в виде параметра Name процедуре Retrieve. Чтобы обеспечить правильную пересылку и сохранение файла, SetUpFileTransfer проверяет расширение файла. Для двоичных файлов (например, EXE, DLL и ZIP) SetUpFileTransfer приказывает FTP Command выдать команду TYPE IMAGE, в результате чего сервер будет пересылать файл в виде непрерывного потока байтов. Для недвоичных файлов SetUp FileTransfer выдает команду TYPE A. После того как FTP-сервер подтвердит получение команды TYPE, SetUpFileTransfer через FTPCommand посылает команду RETR имя_файла.

Программа RESOLVER32 использует ряд интересных

Программа RESOLVER32 использует ряд интересных методов и свойств объекта TCsSocket. RESOLVER32 может преобразовывать символьное имя хоста в его IP-адрес (то есть адрес в Internet), и наоборот. Кроме того, программа определяет взаимное соответствие между номером порта и типом сервиса, а также между номером протокола и его именем. Все эти примеры взяты из практики, поскольку преобразование имен хостов и имен сервисов — самые распространенные операции, выполняемые приложениями Winsock.

На рис. 5.1 показано, как выглядит приложение в Delphi IDE. Щелкните на компоненте CsSocket1, и в окне инспектора объектов появится перечень его свойств (см. рис. 5.2). Содержащиеся в нем стандартные значения хорошо подходят для выполнения преобразований с помощью блокирующих функций. Свойство Service по умолчанию имеет значение NoService, поскольку в нашем приложении не предусмотрено конкретного сервиса для выполнения преобразований.

На рис. 5.3 изображена вкладка Events с несколькими обработчиками событий. При любом изменении статуса Winsock DLL обработчик CsSocket1OnInfo передает информацию от CsSocket к приложению. Аналогично, процедура CsSocket1LookUp передает информацию при завершении работы функции просмотра. Также заслуживает внимания процедура CsSocket1Error, которая сообщает приложению об ошибках, случившихся во время работы CsSocket.

Рис. 5.1. Приложение RESOLVER32

Рис. 5.2. Свойства CsSocket

Рис. 5.3. События CsSocket

При запуске приложения RESOLVER32 процедура Application.CreateForm из файла RESOLVER32.DPR вызывает конструктор TCsSocket.Create, чтобы задать свойствам CsSocket значения по умолчанию. После того как конструктор инициализирует компоненты и успешно обратится к Winsock DLL, процедура TFrmMain.FormCreate (см. листинг 5.5) выполняет ряд других задач.

В частности, метод TMainForm.FormCreate должен проверить свойство Status, обновляемое в CsSocket. Если свойство Status сообщает о наличии сбоев, RESOLVER32 блокирует кнопку Resolve и текстовые поля, устанавливает цвет компонента pnStatus (элемента типа TPanel) в значение clRed и выводит в панели pnStatus сообщение об ошибке. Если же все прошло гладко, RESOLVER32 обновляет элементы в групповом поле gbWSInfo в соответствии со значениями, полученными от Winsock.

Листинг 5.5. Процедура FormCreate главной формы

procedure TfrmMain.FormCreate(Sender: TObject); begin tag := 1; memErrorLog.Clear; memErrorLog.Visible := FALSE; if CsSocket1.Status = Failure then begin pnStatus.Color := clRed; pnStatus.Caption := 'Winsock not available!'; btnResolve.Enabled := FALSE; gbNameRes.Enabled := FALSE; gbServiceRes.Enabled := FALSE; gbProtoRes.Enabled := FALSE; gbTypeOfLookUp.Enabled := FALSE; edMachineName.Text := ''; edVendorName.Text := ''; edVersionNo.Text := ''; edMaxNoSockets.Text := ''; edMaxUDPacketSize.Text := ''; edWSStatusInfo.Text := ''; end else begin with CsSocket1 do begin edMachineName.Text := LocalName; edVendorName.Text := WSVendor; edVersionNo.Text := WSVersion; edMaxNoSockets.Text := WSMaxNoSockets; edMaxUDPacketSize.Text := WSMaxUDPPSize; edWSStatusInfo.Text := WSStatus; Access := Blocking; rgProtocol.ItemIndex := 0; // По умолчанию выбирается TCP end; if CsSocket1.Access = Blocking then begin btnAbortRes.Enabled := FALSE; rbBlocking.Checked := TRUE; end; cbHint.Checked := TRUE; frmMain.ShowHint := TRUE; end; end;

Применение иерархических данных в запросах

Возможности иерархических и реляционных моделей по части запросов сильно расходятся. Реляционная модель хорошо подходит для поиска записей по атрибутам (полям) или объединения таблиц по общим значениям. На SQL такие запросы часто записываются в виде коротких, очевидных выражений.
Однако SQL плохо подходит для описания концепций типа «найти где-то среди потомков объект с зеленым маркером». Возможно, SQL без проблем найдет зеленый маркер, но при этом он понятия не имеет, что такое «потомки объекта». В разделе этой главы, посвященном SQL (см. ниже), приведены некоторые возможные варианты итерационного поиска записей, но, если иерархия находится в памяти, можно получить список потомков в виде набора идентификаторов и использовать его в критерии запроса типа IN. Запрос будет искать значение поля в ограниченном списке вариантов. В листинге13.5 показано, как SQL-запрос создается программой в свойстве TQuery.SQL. При этом SQL выполняет лишь часть работы; сначала иерархический объект вычисляет потомков, пользуясь своими собственными средствами.
Листинг 13.5. Использование SQL для поиска среди потомков
procedure TForm1.FindColoredBoxes (ColorName : String; StartingID : Integer); var DescendantString : String; begin DescendantString := HierarchyObject.GetDescendants(StartingID); with Query1 do begin DisableControls; Close; with SQL do begin Clear; Add('SELECT *'); Add('FROM BoxList T1'); Add('WHERE T1.BoxColor = "' + ColorName + '"'); { Предполагается, что идентификаторы в DescendantString разделяются запятыми } if DescendantString <> '' then Add('AND T1.BoxID IN (' + DescendantString ')'); end; Open; EnableControls; end; end; Пример: если вас интересуют художники всех специализаций, можно найти в иерархии родителя всех художников, на программном уровне получить идентификаторы всех потомков этого объекта и использовать их в критерии. Запись однозначно определяется по ее идентификатору, каким бы специали зированным он ни был. Когда вам потребуется выбрать общую категорию, данная запись будет извлечена среди прочих. Благодаря иерархической структуре данных вам даже не нужно знать, сколько потомков имеет объект «Художник» — вы автоматически получаете их все.
Если иерархия представлена компонентом TOutline или TTreeView, вы можете воспользоваться навигационными средствами этих компонентов для перебора потомков любого объекта. В противном случае объект придется загружать в память и установить связи-указатели между родителями и детьми или же воспользоваться итерационными или рекурсивными методиками, описываемыми ниже.

Пример модели

Хотя файл EMBEDDEDFORMS.PAS прежде всего демонстрирует, как внедренные формы применяются на практике, и предоставляет работоспособную основу для построения мастеров и списков свойств, в нем также присутству ет упрощенная модель данных и четыре вида — как для того, чтобы научить вас пользоваться мастерами, так и в качестве примера внедрения видов друг в друга.
Модуль Data представляет собой «скелет» модуля данных с методами для создания, «загрузки» и «сохранения» объектов Employee (см. листинг 10.10). Вероятно, в реальном приложении эти методы будут представлять собой оболочки для процедур, работающих с базами данных; в нашем случае метод загрузки лишь извлекает «зашитые» в программе фиктивные данные, а метод сохранения вообще ничего не делает. Объект Employee содержит ссылки на два объекта People с личными данными работника и его начальника. Вид Employee View, изображенный на рис. 10.1 и 10.2, позволяет выбрать начальника из раскрывающегося списка, а также отредактировать имя и налоговый код (TaxID) работника.
Самое интересное заключается в том, что для отображения сведений о работнике и начальнике применяется один и тот же вид — для этого создается две различные копии одного объекта вида. В режиме конструирования оба вида выглядят как пустые панели (см. рис. 10.6). При создании формы мы создаем два экземпляра вида PersonIdView (см. листинг 10.7) и размещаем их на соответствующих панелях формы EmployeeIdview.

Рис. 10.6. Вид, одновременно являющийся фреймом

Рис. 10.7. PersonIdView в режиме конструирования
Листинг 10.10. Модуль EMPLOYEEIDVIEWS.PAS
unit EmployeeIdViews; // Copyright © 1997 by Jon Shemitz, //all rights reserved. // Permission is hereby granted to freely use, //modify, and // distribute this source code PROVIDED that //all six lines of // this copyright and contact notice are //included without any // changes. Questions? Comments? Offers of work? // mailto:jon@midnightbeach.com // ---------------------------------------- // Это достаточно правдоподобная реализация вида Employee ID. // Она позволяет вводить имя и налоговый код, а также // указывать начальника. interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Models, Embedded, FickleViews, PersonIdViews; type TEmployeeIdView = class(TFickleView, IFrame) SupervisorPnl: TPanel; SupervisorCaptionPnl: TPanel; SupervisorFrame: TPanel; SelectSupervisor: TComboBox; SupervisorLbl: TLabel; EmployeeIdFrame: TPanel; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure SelectSupervisorChange(Sender: TObject); private SupervisorView, EmployeeView: TPersonIdView; protected procedure ReadFromModel(Model: TModel); override; procedure WriteToModel(Model: TModel); override; procedure SetReadOnly(Value: boolean); override; procedure OnValidChanged( ChangingObject: TObject; View: IView ); end; implementation {$R *.DFM} uses Data; // Создание/уничтожение procedure TEmployeeIdView.FormCreate(Sender: TObject); var Index: integer; begin inherited; SupervisorView := TPersonIdView.CreateEmbedded( Self, SupervisorFrame, efmCentered ); SupervisorView.ReadOnly := True; SupervisorView.AddNotifiee(Self); EmployeeView := TPersonIdView.CreateEmbedded( Self, EmployeeIdFrame, efmCentered ); EmployeeView.AddNotifiee(Self); with DataModel do for Index := 0 to SupervisorCount - 1 do SelectSupervisor.Items.Add( GetEmployeeName(Supervisor[Index]) ); end; // TEmployeeIdView.FormCreate procedure TEmployeeIdView.FormDestroy(Sender: TObject); begin inherited; SupervisorView.RemoveNotifiee(Self); SupervisorView.Free; EmployeeView.RemoveNotifiee(Self); EmployeeView.Free; end; // TEmployeeIdView.FormDestroy // Переопределения IView procedure TEmployeeIdView.ReadFromModel(Model: TModel); begin Assert(Model is TEmployee); with TEmployee(Model) do begin SupervisorView.ReadFromModel(Supervisor); EmployeeView.ReadFromModel(Employee); SelectSupervisor.ItemIndex := DataModel.IndexOfSupervisor(Supervisor.ID); end; // with end; // TEmployeeIdView.ReadFromModel procedure TEmployeeIdView.WriteToModel(Model: TModel); begin Assert(Model is TEmployee); with TEmployee(Model) do begin SupervisorView.WriteToModel(Supervisor); EmployeeView.WriteToModel(Employee); end; // with end; // TEmployeeIdView.WriteToModel procedure TEmployeeIdView.SetReadOnly(Value: boolean); begin inherited; EmployeeView.ReadOnly := ReadOnly; SelectSupervisor.Color := ShowReadOnly_EditColors[ReadOnly]; end; // TEmployeeIdView.SetReadOnly // Изменение начальника procedure TEmployeeIdView.SelectSupervisorChange (Sender: TObject); var ID: TPersonID; Supervisor: TPerson; begin inherited; ID := DataModel.Supervisor [SelectSupervisor.ItemIndex]; Supervisor := DataModel.LoadPerson(ID); try SupervisorView.ReadFromModel(Supervisor); finally Supervisor.Free; end; end; // TEmployeeIdView.SelectSupervisorChange // Уведомление фрейма procedure TEmployeeIdView.OnValidChanged( ChangingObject: TObject; View: IView ); begin Valid := SupervisorView.Valid and EmployeeView.Valid; end; // TEmployeeIdView.OnValidChanged end. Процедура FormCreate создает два вида TPersonIDView и регистрируется как их фрейм. Вид начальника доступен только для чтения, однако начальника можно сменить с помощью раскрывающегося списка. FormDestroy отменяет регистрацию (то есть освобождает интерфейсную ссылку) и уничтожает внедренные формы.
ReadFromModel и WriteToModel, в сущности, перепоручают свою работу внедренным видам. Обычно рекомендуется, чтобы все функции ввода/вывода моделей следовали этому примеру и с помощью Assert проверяли, относится ли аргумент-модель к ожидаемому типу. В этом случае при передаче неверного типа модели редактору (или неверного типа вида — процедуре настройки редактора модели) возникает runtime-ошибка.

Пример приложения «Настрой меня сам»

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

	Adjust All Fonts (выбрать новый шрифт для всех элементов);
	Tab Order (изменить порядок перебора элементов);
	Show Properties (вызвать инспектор объектов).

Имеется также контекстное меню, с помощью которого можно изменить фоновый цвет формы.
Наконец, есть еще одно контекстное меню с четырьмя командами:

	Escape/No changes (отменить возможные изменения);
	Adjust Size & Position (изменить размеры и положение элемента);
	Change Font (изменить шрифт отдельного элемента);
	View Properties (вызвать инспектор объектов).

На это контекстное меню ссылается свойство PopupMenu каждого элемента.
В левой части экрана находится инспектор объектов, доступный во время выполнения. С его помощью пользователи могут просматривать и изменять некоторые дополнительные свойства элементов.
А самое замечательное в этом динамическом интерфейсе «сделай сам» — то, что на прилагаемом CD-ROM имеется простой проект STARTER.DPR для его создания. Вы можете поместить этот проект в хранилище и при необходимости просто использовать его в качестве шаблона. Все очень просто!
Как видно из первого примера, мы взяли многие средства Delphi, доступные только в режиме конструирования, и перенесли их в режим выполнения.

Рис. 12.1. Средства настройки пользовательского интерфейса

Присоединение DLL на стадии выполнения

Иногда программа может прекрасно работать без некоторых DLL. Вспомним пример с DLL для преобразования файлов в текстовом редакторе. Пользователи не так уж часто занимаются преобразованием файлов. Скорее всего, большинству из них вообще никогда не придется этим занимать ся. Со стороны программы было бы прямо-таки преступно требовать наличия этих DLL для обычного редактирования файлов. Но именно это и происходит при статическом импорте! Если Windows не сможет найти DLL при загрузке программы, она выдаст сообщение об ошибке и завершит программу.
Кроме того, статический импорт DLL не обладает достаточной гибкостью. Если компилятор должен заранее знать, какие DLL потребуются программе, мы возвращаемся к старой проблеме — чтобы работать с новым форматом, придется исправлять исполняемый файл программы. Нехорошо.
На помощь приходит динамический импорт. Вместо того чтобы заставлять Windows автоматически загружать и подключать DLL при загрузке программы, почему бы не позволить самой программе при необходимости загрузить DLL и подключиться к ней? В этом случае программа будет работать даже без DLL, хотя и не сможет выполнять некоторые функции. Утакого подхода есть еще одно достоинство — программа может сообщить пользователю о причине возникшей проблемы. Если у пользователя где-нибудь сохранилась копия DLL, он сможет скопировать ее в нужное место и попробовать снова— при этом ему даже не придется перезапускать программу.
Глава 2•32-разрядные DLL в Delphi — когда, зачем и как
В листинге 2.3 содержится новая версия интерфейсного модуля BEEPER.DLL. Директивы условной компиляции позволяют выбрать тип импорта — статический или динамический.
Листинг 2.3. Динамический импорт DLL на стадии выполнения
{ BEEPDLL.PAS — интерфейсный модуль для BEEPER.DLL Автор: Джим Мишель Дата последней редакции: 12/05/97 } unit BeepDLL; {$DEFINE DYNAMIC} { закомментируйте эту строку, чтобы реализовать статический импорт } interface {$IFDEF DYNAMIC} { Объявления процедур для динамического импорта } procedure BeepMe; procedure BeepMeTwo; procedure BeepMeThree; {$ELSE} { Объявления процедур для статического импорта } procedure BeepMe; external "beeper.dll"; procedure BeepMeTwo; external "beeper.dll" name "BeepMe"; procedure BeepMeThree; external "beeper.dll" index 1; {$ENDIF} implementation {$IFDEF DYNAMIC} uses Windows; type BeepMeProc = procedure; var LibInstance : HMODULE; { Логический номер модуля DLL } BeepMePtr : BeepMeProc; procedure BeepMe; begin if (LibInstance = 0) then begin { если DLL еще не загружена, попытаемся загрузить } LibInstance := LoadLibrary("beeper.dll"); { Если LoadLibrary возвращает 0, произошла ошибка } if (LibInstance = 0) then begin MessageBox (0, "Can"'t load BEEPER.DLL', "Error", MB_ICONEXCLAMATION or MB_OK); Exit; end; { DLL загружена, теперь попытаемся найти функцию } BeepMePtr := BeepMeProc (GetProcAddress (LibInstance, "BeepMe")); { Если GetProcAddress возвращает Nil, у нас возникли проблемы} if (Not Assigned (BeepMePtr)) then begin { Предварительно выгрузим DLL, чтобы пользователь заменил ее, если это возможно } FreeLibrary (LibInstance); LibInstance := 0; MessageBox (0, "Can"'t find BeepMe function in DLL.', "Error", MB_ICONEXCLAMATION or MB_OK); Exit; end; end; BeepMePtr; end; procedure BeepMeTwo; begin BeepMe; end; procedure BeepMeThree; begin BeepMe; end; initialization LibInstance := 0; BeepMePtr := Nil; finalization { Если DLL была загружена, ее обязательно нужно выгрузить } if (LibInstance <> 0) then begin FreeLibrary (LibInstance); LibInstance := 0; end; end. {$ELSE} end. {$ENDIF} Я же предупреждал, что этот вариант сложнее!
Да, динамический импорт действительно получается более сложным. Вам приходится вручную программировать те действия, которые Windows автоматически выполняет при запуске программы в случае статического импорта. С другой стороны, этот код более устойчив к ошибкам. Давайте потратим несколько минут и посмотрим, как он работает.
Прежде всего, имена процедур не связываются с функциями DLL непосредственно в интерфейсной (interface) секции модуля, а соответствуют обычным процедурам, определенным в секции реализации (implementation). Именно ключевое слово external вызывает автоматическую загрузку DLL при запуске программы; если удалить его, Windows не станет загружать DLL.
Затем мы определяем процедурный тип и две переменные:
type
BeepMeProc = procedure;

var
LibInstance : HMODULE; { Логический номер экземпляра DLL }
BeepMePtr : BeepMeProc;
Процедурный тип BeepMeProc похож на типы обработчиков событий Delphi. Переменная этого типа (в данном случае BeepMePtr) содержит указатель на процедуру, не имеющую параметров. После того как мы загрузим библиотеку BEEPER.DLL и найдем в ней процедуру BeepMe, ее адрес присваивается переменной BeepMePtr.
LibInstance — логический номер (handle) экземпляра BEEPER.DLL, который возвращается функцией LoadLibrary, если загрузка DLL прошла успешно.
Процедуры BeepMeTwo и BeepMeThree являются псевдонимами для BeepMe, поэтому в версии с динамическим импортом они просто вызывают процедуру BeepMe модуля.
Все волшебство происходит внутри BeepMe. Прежде всего процедура проверяет, загружена ли DLL. Если DLL еще не загружена, процедура вызывает функцию API LoadLibrary, которая ищет DLL и пытается загрузить ее, а также выполняет код запуска DLL (об этом подробно рассказано ниже), после чего возвращает логический номер модуля, который однозначно определяет DLL. Если DLL не найдена или при загрузке произошла ошибка, LoadLibrary возвращает 0, а BeepMe выдает сообщение об ошибке.
Если функция LoadLibrary успешно загрузила DLL, мы вызываем функцию GetProcAddress, которая пытается найти в загруженной DLL функцию с именем BeepMe. Адрес найденной функции присваивается переменной BeepMePtr. Если GetProcAddress не может найти заданную функцию, она возвращает Nil, в результате чего BeepMe выдает сообщение об ошибке и выгружает DLL из памяти.
Если все прошло нормально, то есть DLL была успешно загружена, а процедура BeepMe — найдена, она вызывается через указатель BeepMePtr.
Последнее замечание — ваша программа должна явно выгрузить (используя процедуру FreeLibrary) все DLL, загруженные с помощью LoadLibrary. Для этого используются секции initialization и finalization. При запуске модуля секция initialization присваивает переменным LibInstance и BeepMePtr стандартные значения, означающие, что DLL не загружена. При выходе из программы секция finalization выгружает DLL, если она была загружена ранее.

Проблема общих сторон

Конечно, в действительности генерация фрактальных ландшафтов не сводится к примитивному рецепту «изогнуть, разделить, повторить по вкусу». Вам придется проследить за тем, чтобы каждая линия изгибалась только один раз; к тому же ландшафт еще необходимо отобразить на экране, но это уже подробности.
Первая и самая важная деталь заключается в том, что вы должны следить за своими действиями. Если процедура FractureTriangle() будет просто изгибать все грани подряд, у вас получится что-то вроде рис.8.4. Треугольники не будут образовывать сплошную сетчатую поверхность; появятся «плавающие» группы из четырех треугольников, высота вершин которых не будет совпадать с высотой вершин соседей.

Рис. 8.4. Вот что получается, когда стороны не совпадают
Возможно, рис. 8.5 поможет разобраться в происходящем. Внутренние стороны принадлежат сразу двум треугольникам, мнения которых насчет величины изгиба могут не совпасть. Вершина I является серединой отрезка DF, который принадлежит треугольникам CDF и DEF. Если оба треугольника попытаются самостоятельно задать высоту этой точки, то вершина I в треугольниках 1, 2 и 3 будет находиться на иной высоте, чем она же в треугольниках 4, 5 и 6!
Очевидно, нам потребуется база данных вершин, чтобы положение вершины I можно было задать при обработке треугольника CDF и затем использовать ту же величину смещения для этой вершины при обработке треугольника DEF. Можно попытаться объявить DEF «внутренним» треугольником, рассматривать его в последнюю очередь и использовать «внешние» значения для вершин G, H и I — но взгляните на треугольники GEH и LMN. Отрезки GE и EH принадлежат и «внешним» треугольникам, поэтому для вершин L и M следует использовать «внешние» значения, но отрезок GH находится «полностью внутри», поэтому его необходимо изогнуть. Несомненно, схему с внешними и внутренними треугольниками можно усовершенствовать для правильной обработки таких «внешне-внутренних субтреугольников», но в итоге получится нечитаемый код с высокой вероятностью возникновения ошибок при любых изменениях.

Рис. 8.5. Так треугольники «спорят» из-за вершин
Намного проще определить специальное значение координаты, которое будет присутствовать только у неинициализированных вершин, и заставить FractureTriangle() проверять, не было ли положение середины отрезка задано ранее. Если положение уже задано, FractureTriangle() использует готовое значение; если нет, FractureTriangle() генерирует новую высоту. Возможно, вычисление и просмотр середин внутренних треугольников работают несколько медленнее, чем простая передача аргументов, но программа получается более компактной и наглядной. К тому же на отображение ландшафта неизбеж но уйдет намного больше времени, чем на его расчет.

Проблема произвольной вложенности

При произвольной глубине вложенности и неизвестном количестве поколений потомства начинаются трудности. В SQL нет условных операторов; подзапрос либо находит записи, либо нет. Джо Селко (Joe Celko) посвятил две главы своей книги «SQL for Smarties» (Morgan Kaufman Publishers, 1995) деревьям и графам, а точнее — данным, представляемым в виде визуальных графов, в том числе и в виде иерархических деревьев. Пользуясь нетривиальными приемами, он показывает, как правильно ассоциировать один объект (или узел) с другим.
Если вас устроит простое, но менее эффективное (и заведомо менее элегантное) решение, воспользуйтесь двумя временными таблицами: первая (Final) применяется для накопления результатов нескольких запросов, а вторая (Working) — для хранения результатов последнего запроса. Возможно, в зависимости от используемого SQL-сервера вам придется работать с двумя таблицами Working и переключаться между ними. Алгоритм выглядит так:

Выполнить запрос для поиска детей исходного объекта.

Скопировать идентификаторы найденных объектов в таблицу Working.

Выполнить запрос для поиска детей объектов, идентификаторы которых хранятся в таблице Working.

Если не будет найден ни один объект, прекратить работу.

Добавить содержимое таблицы Working в таблицу Final.

Очистить таблицу Working и занести в нее все идентификаторы объектов, найденных в результате запроса.

Вернуться к шагу 3.

Каждый цикл находит объекты следующего поколения, а таблица Final будет содержать все найденные объекты в порядке следования поколений.

и ссылки на длинные строки,

Ссылки на интерфейсы, как и ссылки на длинные строки, подсчитываются. Каждый раз, когда вы создаете копию переменной, содержащей интерфейсную ссылку (непосредственным присваиванием или при передаче параметра процедуре), вызывается метод _AddRef объекта, который увеличивает значение счетчика ссылок. При каждом уничтожении ссылки на интерфейс (непосредственным присваиванием или при выходе за пределы области видимости) вызывается метод _Release объекта, который уменьшает значение счетчика ссылок. Когда значение счетчика достигает 0, объект удаляет себя. «Обычные» объектные ссылки никак не влияют на процесс подсчета ссылок.

Данная схема прекрасно работает — если вы взаимодействуете с объектом только с помощью интерфейсных ссылок. Например, для следующего фрагмента:

type IFoo = interface procedure Foo; end; TFoo = class (TObject, IFoo) procedure Foo; end; procedure TFoo.Foo; begin end; prcedure Bar(InterfaceReference: IFoo); begin end; begin Bar(TFoo.Create); end. ALIGN="JUSTIFY">объект TFoo, созданный вызовом Bar, автоматически уничтожается при выходе из Bar. Но давайте рассмотрим слегка измененный сценарий, в ором интерфейсные ссылки смешиваются со ссылками на объекты:

var ObjectReference: TFoo; begin ObjectReference := TFoo.Create; try Bar(ObjectReference); finally ObjectReference.Free; end; end. Проблема заключается в том, что присваивание ObjectReference := TFoo.Create не влияет на счетчик ссылок объекта. Свойство RefCount продолжает оставаться равным 0, как и при создании объекта. Тем не менее при вызове процедуры Bar происходит неявное присваивание ее параметру InterfaceReference. При этом генерируется вызов _AddRef, в результате которого RefCount становится равным 1. При выходе из Bar заканчивается область видимости параметра InterfaceReference, поэтому генерируется вызов _Release. В результате RefCount снова обнуляется, что приводит к уничтожению объекта. Ссылка Object Reference становится недействительной! При следующем обращении к ней (в нашем случае — при вызове Free) возникает GPF.

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

В подобных случаях следует принудительно увеличить счетчик ссылок объекта на 1 еще до получения первой интерфейсной ссылки на него. Например, класс TAbstractView из следующего раздела содержит следующий обработчик OnCreate:

procedure TAbstractView.FormCreate (Sender: TObject); begin inherited; _AddRef; // теперь Self можно передавать // в качестве интерфейсной ссылки end; Явный вызов _AddRef означает, что при создании первой интерфейсной ссылки RefCount увеличится до 2 и в дальнейшем никогда не станет равным 0. Следовательно, объект никогда сам не уничтожится и не разрушит ваших объектных ссылок; он будет жить до тех пор, пока вы не освободите его с помощью Free.

Разумеется, явный вызов _AddRef необходим лишь при смешивании объектных и интерфейсных ссылок. Если вы собираетесь взаимодействовать с объектом только через интерфейсные ссылки, к явным вызовам _AddRef следует относиться с большой осторожностью — вы можете нарушить всю систему подсчета ссылок и ваш объект не будет уничтожаться. И наоборот, при работе с «чисто интерфейсным» объектом никогда не создавайте объектных ссылок на него, иначе они станут недействительными после того, как счетчик интерфейсных ссылок упадет до 0 и объект самоуничтожится. Одна из простейших мер предосторожности состоит в том, чтобы поместить все интерфейсные методы в секцию protected — они останутся доступными через интерфейс, но раз вы не сможете обратиться к ним через объектные ссылки, исчезнет и повод эти ссылки создавать.

Проблемы TPersistent и несколько полезных советов

Джон Шемитц и Эд Джордан
Иногда можно обнаружить, что Delphi присваивает значение свойству компонента, используя метод read, а не write. Неосторожность при написании таких методов может привести к большим неприятностям! Джон и Эд поделятся своими соображениями о том, как избежать подобных бед и получить максимум пользы от работы с Delphi.
Свойства объектов Delphi просты и функциональны: они похожи на переменные, но весь процесс их чтения и записи находится под вашим контролем. Вы можете разрешить прямое считывание свойств, словно это обычные переменные, или же указать метод read, вызываемый при каждом чтении данного свойства. Можно разрешить прямую запись свойств или же указать метод write, который вызывается при задании значения этого свойства.
Верно?
Нет, неверно.

Процедура Project()

Проекционная процедура Project() — «рабочая лошадка», от которой зависят все операции графического вывода. Она преобразует трехмерные координаты TTriple в плоские TPixel с использованием одноточечной перспективы и текущих размеров окна.
Фактически эта процедура проводит линию между двумя точками — текущей и точкой перспективы — и определяет, где эта линия пересекается с плоскостью экрана. Сложность листинга 8.3 обусловлена использованием вычислений с фиксированной точкой. (В основном это наследство, доставшееся программе FL3 от ее первых версий, появившихся в те дни, когда вычисления с плавающей точкой были очень медленными. С другой стороны, вычисления с фиксированной точкой сокращают размер базы данных вершин и позволяют разместить всю базу в одном сегменте данных.) Если отказаться от математики с фиксированной точкой, мы получим следующее:
function Project(const P: TTriple): TPixel; { Трехмерное преобразование точки } var Delta_Y: double; Tr, V: TFloatTriple; begin Tr := FloatTriple(P); V := FloatTriple(VanishingPoint); Ratio := Pt.Y / V.Y; Result.X := Round( DisplayWidth * ((V.X - Pt.X) * Ratio + Pt.X)); Result.Y := DisplayHeight - Round( DisplayHeight * ((V.Z - Pt.Z) * Ratio + Pt.Z)); end; Процедура вычисляет отношение глубины точки к глубине точки перспективы и умножает его на разности координат этих точек по осям x и z. Поскольку координаты TTriple принадлежат интервалу 0…1, для получения экранных координат можно просто умножить спроектированные координаты на размер окна.

Продолжаем!

Если тема вас заинтересовала, о DLL можно узнать еще много интересно го. В этой главе я привел достаточно информации, чтобы вы могли заняться самостоятельными исследованиями. Если у вас есть компакт-диски из серии Microsoft Developer's Network, проведите поиск по ключевому слову «DLL» в предметном указателе и прочитайте все, что найдете. Кроме того, почитайте о CreateFileMapping и аналогичных функциях, обращая особое внимание на отличия Windows 95 от Windows NT. С помощью DLL можно сделать много классных штук, но при этом следует проявлять осторожность. Желаю удачи!

Программа-фильтр на Delphi

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

Эйс проглотил последний кусок гамбургера

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

— Пока ты занимаешься результатами, мне нужно кое-куда зайти, — сказала Хелен, изящно выпархивая из-за стола.

— Ладно,— рассеянно произнес Эйс. Он машинально проследил за тем, как она проследовала к соседнему ресторану. Maison de Mort Rouge Viande был одним из самых шикарных местных заведений. Хелен обожала такие места — еще бы, ведь она привыкла к ним с детства.

Эйс частично вышел из транса.

«Если это действительно Бохакер, — подумал он, — я должен узнать об этом сейчас же. Пока Хелен не слышит, надо связаться с моим Человеком-На-Ули це и узнать, что происходит».

Он извлек из кармана плаща верный сотовый телефон и набрал номер «Норвежских жареных цыплят Бака МакГаука» — далеконе самой шикарной забегаловки.

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

— Это ты, Бифф? — спросил Эйс.

— Эйс, как дела, дружище?

— Мне нужна кое-какая информация, и побыстрее. Ты давно видел Мелвина Бохакера?

— Забавно, что ты спрашиваешь о нем. Сегодня произошло нечто очень странное.

— Выкладывай.

— Не помню, говорил я тебе или нет, что Бохакер по вторникам и пятницам всегда заказывает «Особо Жирную Курицу». Обычно он сам приходит за своим обедом.

— Ну?

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

— Что еще? — торопил Эйс.

— Было довольно шумно, все время проезжали машины. Но мне показалось, что он упомянул о какой-то женщине, с которой собирается встретить ся в Нортон-Сити. Что ты об этом думаешь? Может, его наконец кто-нибудь прикончит?

— Не знаю, Бифф, — ответил Эйс. — Слушай, мне нужно идти. Потом поговорим.

Эйс выключил телефон, сунул его в карман и направился к кассе.

Тем временем изучение похищенного Дневника продолжалось…

Дневник №16, 28 марта. С момента выхода самой первой версии Delphi мне не раз приходилось слышать, что этот пакет отличается от других средств визуального программирования тем, что сильно упрощает работу со всеми трудными аспектами Windows, но при этом позволяет программисту работать на сколь угодно низком уровне, вплоть до самых мелких «болтов и гаек». Я решил исследовать некоторые детали внутреннего устройства Windows 95 и узнать, как добраться до них из приложения, написанного на Delphi.

Одно из главных отличий Windows 3.1 от Windows 95 — вытесняющая мультизадачность и те изменения, которые из нее следуют. В Windows 3.1 мультизадачность была кооперативной (cooperative); это означало, что в любой момент может выполняться только одна задача, и пока она добровольно не отдаст управление, все остальные задачи выполняться не будут. В частности, из этого следует, что одна программа всегда могла заблокировать доступ к системным структурам данных до тех пор, пока не считала нужным разрешить его. Однако в Win95 с ее многопоточностью и вытесняющей (preemptive) мультизадачностью сценарий выглядит иначе — операционная система, наделенная абсолютными полномочиями, сама распределяет кванты процессор ного времени на основании системы приоритетов.

Фирма Microsoft тайком включила в Windows 3.1 библиотеку TOOLHELP.DLL. Хотя в книгах и журналах эта библиотека почти не рассмат ривалась (адокументации к ней практически не существовало), в Delphi 1.0 был включен интерфейсный модуль для работы с ней. Модуль ToolHelp содержал несколько интересных низкоуровневых процедур, в том числе процедуры TaskFirst и TaskNext, с помощью которых программист мог «пройтись» по текущему списку активных задач в системе. Я обрадовался, когда узнал о том, что в последующие версии Delphi был включен аналогичный интерфейсный
модуль, TLHELP32, ориентированный на 32-разрядное окружение. Я решил сконцентрировать свое сегодняшнее расследование на этой теме.

Пропавшая функция Poly

При подготовке полного списка функций модуля Math, приведенного в конце главы, я намеренно пропустил одну из функций. Почему? Потому что фирма Borland тоже не документировала ее! Непонятно, должна эта функция присутствовать в модуле Math или нет. Более того, найти ее можно только при просмотре исходного текста модуля Math во время подготовки главы для этой книги…
Что же делает эта загадочная функция? Выглядит она так:
function Poly(X: Extended; const Coefficients: array of Double):
Extended;
Функция Poly предназначена для вычисления полиномов. Единственное ограничение состоит в том, что это должны быть полиномы лишь одной переменной. Функция Poly получает переменную X, для которой вычисляется полином, и массив коэффициентов. Коэффициенты должны быть упорядочены по возрастанию степеней X.
Следовательно, для следующего полинома:
4x4 [+ 0x3] _ x2 + 3x + 34
массив коэффициентов должен быть упорядочен так:
34, 3, _1, 0, 4
Если бы вам потребовалось снабдить функцию Poly пользовательским интерфейсом, вероятно, получилось бы что-то наподобие программы PolyProject (см. рис.11.2).

Рис. 11.2. Графическое представление
Программа PolyProject (она находится на CD-ROM в подкаталоге этой главы) как раз и является таким интерфейсным приложением. Она позволяет задать полином, а затем выводит его график. Обратите внимание — в главном окне программы PolyProject наряду с надписями имеется несколько текстовых полей для ввода коэффициентов полинома. Однако вся основная работа PolyProject выполняется в обработчике события OnClick кнопки Solve!:
procedure TForm1.SolveButtonClick(Sender: TObject); var i : Integer; XCoes : array[0..4] of double; X,Y, OffsetX, OffsetY : Integer; NewRect: TRect; Прежде всего мы заполняем массив XCoes введенными значениями коэффициентов:
begin XCoes[0] := StrToFloat(TxtX0.Text); XCoes[1] := StrToFloat(TxtX1.Text); XCoes[2] := StrToFloat(TxtX2.Text); XCoes[3] := StrToFloat(TxtX3.Text); XCoes[4] := StrToFloat(Tx1tX4.Text); После этого необходимо задать начало координат для построения графика. Обычно я использую центр элемента TImage, но при желании можно выбрать любую другую точку:
OffsetX := Image1.Width div 2; OffsetY := Image1.Height div 2; Затем мы инициализируем координату X и очищаем график, заполняя Image1 сплошным белым прямоугольником. Присваивание соответствующего значения свойству Image1.Canvas.Brush.Color гарантирует, что график будет выводиться черным цветом:
X := 0; { Для надежности инициализируем X }
NewRect := Rect(0, 0, Image1.Width, Image1.Height);
Image1.Canvas.Brush.Color := clWhite;
Image1.Canvas.FillRect(NewRect);
Image1.Canvas.Brush.Color := clBlack;
Пора заняться вычислениями. Сначала мы определяем положение начальной точки графика. До входа в цикл for мы ничего не рисуем, просто перед любым серьезным рисованием необходимо установить «перо» в исходную позицию. Затем мы вызываем функцию Poly, передавая ей значение из текстового поля с нижней границей диапазона (TxtRangeStart) и массив XCoes:
with Image1.Canvas do begin Y := Trunc(Poly(StrToInt(TxtRangeStart.Text), XCoes)); ... Возможно, вы удивитесь тому, что я округляю результат функции Poly. Это делается исключительно для рисования: функция Poly возвращает значение с плавающей точкой (тип Extended), а Windows API работает только с целыми координатами.
Полученный результат преобразуется в пару (X, Y), которая соответствует нашей центральной точке, после чего «перо» перемещается в эту точку:
X := StrToInt(TxtRangeStart.Text) + OffsetX; Y := OffsetY - Y; MoveTo(X,Y); Затем мы перебираем значения X из заданного интервала, начиная с нижней границы +1 (я только что упоминал о нижней границе) и вплоть до значения верхней границы из соответствующего текстового поля (TxtRangeEnd):
for i := StrToInt(TxtRangeStart.Text) + 1 to StrToInt(TxtRangeEnd.Text) do begin Y := Trunc(Poly(I, XCoes)); X := I + OffsetX; Y := OffsetY - Y; LineTo(X,Y); MoveTo(X,Y); end; Хотя функция Poly является единственной общедоступной , но недокумен тированной функцией модуля Math, в секции implementation можно найти еще несколько интересных процедур (одна из них, например, определяет, является ли величина A «бесконечно малой» по отношению к B!). Ограниченный объем главы не позволяет мне рассказать о них подробнее, но я бы порекомендовал изучить эти функции, если у вас есть исходные тексты и, конечно, терпение!
То, чего не было в Паскале
В модуле Math появилось то, чего никогда не было в Паскале — «официаль ная» функция для возведения в степень. Более того, модуль Math содержит сразу две такие функции.
Первая из них, Power, получает два параметра типа Extended — основание и показатель степени. Вторая функция, IntPower, получает один параметр типа Extended (основание) и один целый параметр (показатель степени).
Отличия между ними заключаются в том, что функция IntPower, как и многие функции модуля Math, написана целиком на оптимизированном ассемблере для работы с Pentium FPU, что делает ее достаточно быстрой.
Если вы не знаете, какую функцию следует использовать в вашем приложении, не огорчайтесь.
Хотя это нигде не объясняется и не документируется, функция Power сама определяет, является ли показатель степени целым числом. Если это так, Power вызывает IntPower. Если же показатель является числом с плавающей точкой, Power вычисляет результат каноническим способом, через натуральный логарифм и экспоненту.

Пропавший оракул

Дон Тейлор
Эйс Брейкпойнт вернулся… но его дневник пропал, скорее всего— был похищен. Эйс начинает охоту за Таинственным незнакомцем, который в свою очередь охотится за тайнами Delphi. Интрига закручивается!
Путешествие, которое вам предстоит, многие назовут странным. Наверное, я первым соглашусь с ними.
Прошло лишь три года с той поры, когда на сцене появились Delphi и Эйс Брейкпойнт. Как известно, среда Delphi была создана на редкость талантли вой командой разработчиков из Borland International. Эйс был создан… в общем, по необходимости.
При изучении Delphi мне стало ясно, что никакое количество слов не сможет передать все аспекты этого невероятного продукта. Нельзя научиться программировать на Delphi, просто прочитав описание — Delphi нужно прежде всего исследоват ь. И эта доля выпала мне — написать путеводитель, возглавить экспедицию и привести подробный пример использования Delphi в реальных ситуациях. Не говоря уже о том, чтобы удерживать внимание читателей на протяжении 200 с лишним страниц!
У меня возникла идея — написать приключенческий сюжет, проходящий через весь учебник, и представить в нем одного из самых необычных консультантов в области программирования всех времен. Я выложил идею Джеффу Дантеманну и затаил дыхание. На всякий случай поясню, что Джефф — не только великолепный специалист; в душе он авантюрист и любитель приключений. Он «дал добро», и я создал Эйса Брейкпойнта, крутого частного сыщика, переквалифицировавшегося в программисты…
Детство Эйса прошло в Хакензаке. Он мечтал стать частным сыщиком, похожим на героев классических фильмов 40-х годов — Фила Марлоу, Сэма Спэйда и Эллери Куина. Но после многих лет учебы и тяжких усилий, затраченных на изучение детективного дела, Эйс обнаружил, что в современном мире частные сыщики 40-х уже не пользуются спросом.
Не падая духом, Эйс решил круто изменить свою карьеру. На сей раз он выбрал профессию, которая наверняка прокормит его, — он стал программи ровать для Windows. Но Эйсу хотелось быть не просто современным профессионалом, а настоящим «человеком 90-х годов». Эйс переехал в Пулсбо, штат Вашингтон, и в течение двух долгих лет посещал вечерние курсы по программированию. Закончив их, он быстро арендовал контору и повесил вывеску.
У Эйса, как и у большинства героев, есть мелкие недостатки. Несмотря на все полученное образование, он бывает подчас грубоват. Хотя он, как может, старается проявлять внимание к нуждам других людей, временами вся его чуткость как-то съеживается, будто дешевый пиджак после стирки. Эйс часто ошибается, но его упорство заслуживает уважения. Столкнувшись с проблемой, он упрямо преследует ее, пока не докопается до ответа.
И последнее замечание. Хотя все приключения Брейкпойнта вымышлены, кое-что остается истинным. Пулсбо — вполне реальный город, находящийся в 15 милях (прямо через залив) к западу от Сиэтла. Когда-то это была рыбачья деревушка, основанная группой норвежских иммигрантов. В наши дни Пулсбо стал в основном туристским городом, его набережные и извилистые улицы забиты сувенирными лавками и ресторанами. Впрочем, я бы не советовал вам переезжать — там уже и так слишком много народа. К тому же в Пулсбо почти все время идет дождь. Честное слово.
Во всем остальном приключения Брейкпойнта имеют очень мало отношения к реальности. И конечно, если в тексте не сказано обратного, все персонажи являются чисто вымышленными и не изображают никаких конкретных людей, живых или умерших.
Возьмите свою любимую закуску, выключите свет, пододвиньтесь поближе к экрану и приготовьтесь к приключению, которое я назову…
Эйс Брейкпойнт и…
«Дело о пропавшем Дневнике»!

Пропажа

В 22:57 я вернулся на стоянку возле конторы. Грязь стала настолько густой, что машина скользила по ней, будто слон на коньках. Она остановилась лишь тогда, когда колеса уперлись в поребрик рядом с парковкой номер 132.
Женщина, звонившая по телефону, обманула меня. Когда я приехал к телефонной будке, там никого не было. Оле сказал, что за весь вечер к телефону никто не подходил. Какая-то странная история. Единственное, что я получил за эту дикую гонку, — бесплатную проверку шин, пока ожидал заказанного кофе.
На каждом шагу поскальзываясь и спотыкаясь, я с трудом доковылял до края стоянки, свернул за угол и пошел к двери.
И тут мое сердце замерло.
Дверь в контору была широко открыта. Пробегая несколько оставшихся шагов, я совершенно точно вспомнил, что, уходя, запер дверь. Тем не менее сейчас она была открыта, а внутри горел свет. Я переступил через порог, молниеносно обшаривая глазами комнату. Ничего не пропало, подумал я. Впрочем, нет — Мьюникса не было видно, но он, наверное, просто отправился погулять через открытую дверь. Тут мой взгляд упал на стол, и у меня перехватило дыхание: пропал Дневник!
Я быстро подошел к столу, переворошил бумаги, обшарил все ящики и в полном отчаянии осмотрел пол. Дневника нигде не было.
Я рухнул в кресло. Телефонный звонок был всего лишь наживкой, выманившей меня из конторы. Благодаря этой женщине (и, судя по всему, еще какому-то сообщнику) меня только что произвели в Болваны Первой Степени.
Мое внимание было настолько занято поисками Дневника, что я не заметил, как в комнату вползло темное облако смога. Сейчас оно покрывало весь пол на уровне чуть выше моих промокших ботинок. В комнате стало темно, а единственное освещение, казалось, идет сквозь туман на полу. Тут в дверном проеме появилась загадочная фигура, притянувшая мой взгляд подобно магниту. Это было призрачное существо; определенно человек, но с первого взгляда не скажешь, мужчина или женщина. Существо заметило мой взгляд и заговорило звучным голосом телеведущего (причем его слова отдавались гулким эхом, что отнюдь меня не успокаивало).
— C возвращением, мистер Брейкпойн т. Вас ждали.
— Погодите минутку, — потребовал я. — Кто вы… или что?
— Начнем с главного. Как вы уже обнаружили, ваш Дневник похищен. Сейчас его читает кто-то другой — причем не только технические заметки, но и все личные записи. Автор решил, что в этой истории вам необходима помощь. По этой причине он предоставил в ваше распоряжение повествова теля.
Я снял шляпу и почесал макушку. — Повествователя?
— Третье Лицо.
— Политически выдержанный, современный вариант Гарри Лайма, знаменитого детектива по прозвищу «Третий человек»? — спросил я.
— Нет. Просто Третье Лицо. То, что проходили на уроках литературы в колледже. Припоминаете?
— В общих чертах, — ответил я. — Я не знаю вашего имени, мистер… или миссис… Послушайте, а вы мужчина или женщина?
— У Третьих Лиц не бывает имени. Третье Лицо — всего лишь литературный прием, и пола у него быть не может. По этой же причине Третье Лицо вообще не обладает собственной жизнью.
— Понятно, — заметил я. — Но ответьте мне на такой вопрос: почему эту историю теперь рассказываете вы, а не я?
— Это временное явление. К концу этой истории контроль над происходящим снова вернется к вам. А пока описывать ход событий — дело повествователя. Представьте, будто вы смотрите по телевизору очередную серию «Меня зовут Коломбо».
— Не знаю, понравится ли мне это.

Простейший пример иерархических рекурсивных данных

Реляционная модель хорошо работает для базовых/подчиненных записей в пределах одной таблицы, если в ней существует лишь один уровень принадлежности — другими словами, если каждая запись либо принадлежит другой записи, либо владеет другой записью. В табл. 13.1 приведен список персонала (состоящий из начальников и подчиненных), который при одном уровне принадлежности можно было бы разделить на две таблицы.
Таблица 13.1. Простейший пример рекурсивных иерархических данных
Emp_ID Boss_ID Emp_Name Boss 1 Frank Eng Boss 2 Sharon Oakstein Boss 3 Charles Willings Staff 1 Boss 1 Roger Otkin Staff 2 Boss 1 Marylin Fionne Staff 3 Boss 1 Judy Czeglarek Staff 4 Boss 2 Sean O'Donhail Staff 5 Boss 3 Karol Klauss Staff 6 Boss 3 James Riordan В табл. 13.2 перечислены все значения свойств для двух наборов компонентов TTable, TDataSource и TDBGrid, связанных с одной и той же физической таблицей. Первый набор свойств предназначен для вывода родительских записей, а второй — для вывода дочерних записей, принадлежащих текущему выбранному родителю. Свойства MasterSource и MasterFields подчиненного компонента TTable автоматически ограничивают его набором записей, подчиненных текущей записи родительской таблицы.
Таблица 13.2. Значения свойств для отображения записей-родителей и записей-детей

Свойства компонентов для родительских записей Table1.TableName = 'employees' Table1.IndexFieldName = 'Boss_ID;Emp_ID' Table1.SetRange([''],['']); DataSource1.DataSet = 'Table1' DBGrid1.DataSource = 'DataSource1'

Свойства компонентов для дочерних записей Table2.TableName = 'employees' Table2.IndexFieldName = 'Boss_ID;Emp_ID' Table2.MasterSource = 'DataSource1' Table2.MasterFields = 'Emp_ID' DataSource2.DataSet = 'Table2' DBGrid2.DataSource = 'DataSource2'

Чтобы ограничить родительский компонент TTable и не выводить в нем дочерние записи, задайте условие-фильтр, пропускающий лишь записи с пустым полем Boss_ID (это и есть родительские записи).
Замечание
Вместо свойства Filter можно использовать метод SetRange. С помощью этого метода мы заставим Table1 выводить только записи о начальниках (то есть записи с Boss_ID = nil). Вызов Table1.SetRange можно включить в обработчик Table1.AfterOpen, чтобы метод гарантированно вызывался независимо от того, оставлена ли таблица открытой в режиме конструирования или она открывается во время выполнения.
На рис. 13.2 изображена форма Delphi с двумя компонентами TDBGrid, свойства которых настроены в соответствии с табл. 13.2. Слева перечислены записи о начальниках (родительские записи), справа — записи о подчиненных (дочерние записи). Все эти записи взяты из одной физической таблицы.
При каждом изменении DataSource1 (связанного с Table1) происходит автоматическое обновление Table2, как будто выполняется код из листинга 13.1.

Рис. 13.2. Отношения master/detail между записями одной таблицы
Листинг 13.1. Эквивалентный код для автоматического выбора записей
при изменении состояния MasterSource
procedure TForm1.DataSource1DataChange (Sender : TObject; Field : TField); begin if (Field = nil) or (Field.FieldName = 'Emp_ID') then Table2.SetRange([Table1.FieldByName ('Emp_ID').AsString]), [Table1.FieldByName('Emp_ID').AsString]); end; Замечание
Этот способ сработает лишь в том случае, если в Table2 имеется индекс для поля Boss_ID, чтобы в одной таблице можно было отфильтровать все записи, где в Table1.Boss_ID находится пустая строка, а в другой — записи, для которых выполняется условие Table2.Boss_ID = Table1.Emp_ID. Индекс может содержать дополнительные поля, определяющие порядок записей в отфильтрованном наборе. В нашем случае в Table2 выводятся лишь подчиненные одного начальника, причем их список сортируется по полю Emp_ID. Если таблицей управляет SQL Server, то все столбцы, не относящиеся к категории BLOB (больших двоичных объектов, Binary Large Objects), считаются индексированными, хотя при использовании столбцов, не имеющих физических индексов, производительность работы снижается. Свойство Filter не требует наличия индексов, но по возможности старается использовать их.

Работа с буфером как с потоком

До своего знакомства с Delphi я пользовался для записи и чтения данных двоичного файла методами BlockWrite и BlockRead. Теперь наступили просвещен ные времена, и я предпочитаю работать с потоками и методами Write и Read. Одна из причин заключается в том, что компоненты Delphi сохраняются в потоках. Следовательно, объект, который умеет сохранять и загружать себя методами TStream.Write и TStream.Read, заметно облегчит процесс программирования.
А вот и другая причина — если объект умеет записываться в поток, он способен перенести себя на любое устройство, представленное в виде потока. Такой объект с одинаковой легкостью записывается как в память (через TMemoryStream), так и на диск.
Создавая поток для нового устройства, вы делаете свой код более гибким и универсальным— и зачастую упрощаете работу с данным устройством. Например, обмен информацией с буфером (clipboard) — занятие на любителя. Конечно, объект Delphi TClipboard вам поможет, но для копирования и вставки нестандартных форматов или больших объемов данных все равно придется вызывать загадочные функции API, имена которых начинаются с Global. Поток из листинга 9.14, напротив, позволяет работать с буфером с помощью знакомых методов Write и Read.
Листинг 9.14. Модуль CLIPSTRM.PAS
unit ClipStrm; interface uses Classes, Clipbrd, Consts, WinProcs, WinTypes; type TClipboardMode = ( cmRead, cmWrite ); TClipboardStream = class( TMemoryStream ) private FMode: TClipboardMode; FFormat: Word; public constructor Create( Format: Word; Mode: TClipboardMode ); destructor Destroy; override; end; implementation constructor TClipboardStream.Create; var Handle: THandle; MemPtr: Pointer; begin inherited Create; FMode := Mode; FFormat := Format; { В "режиме чтения" немедленно читаем данные буфера в поток... } if ( FMode = cmRead ) and Clipboard.HasFormat ( FFormat ) then begin Clipboard.Open; try Handle := Clipboard.GetAsHandle( FFormat ); MemPtr := GlobalLock( Handle ); try Write( MemPtr^, GlobalSize( Handle )); finally GlobalUnlock( Handle ); end; Position := 0; finally Clipboard.Close; end; end; end; destructor TClipboardStream.Destroy; var P: PChar; begin { В "режиме записи" копируем в буфер все содержимое потока... } if FMode = cmWrite then begin P := GlobalAllocPtr( HeapAllocFlags, Size ); try Position := 0; Read( P^, Size ); Clipboard.SetAsHandle( FFormat, GlobalHandle( P )); except GlobalFreePtr( P ); end; end; inherited Destroy; end; end. Поток TClipboardStream работает чрезвычайно просто. При его создании необходимо указать формат, а также выполняемую операцию — чтение или запись. Поток, созданный в «режиме чтения», немедленно загружает все содержимое буфера, чтобы данные можно было получить методом Read. Поток, созданный в «режиме записи», ожидает своего уничтожения, а дождавшись, копирует в буфер все, что мы успели в него занести.
В результате получается, что объект может с помощью одного и того же кода сохранить себя на диске (TFileStream), в памяти (TMemoryStream) или в буфере; код для его последующей загрузки из разных источников тоже будет одинаковым.

Работа с контекстным меню

В нашем приложении компонент TSizingRect активизируется с помощью меню PopupMenu1, которое назначено контекстным меню для каждого элемента на форме. На рис. 12.4 изображено меню PopupMenu1 во время выполнения программы, после того как пользователь щелкнул правой кнопкой мыши на компоненте DBImage.
При этом у пользователя есть следующие варианты:

	ничего не делать (Escape/No changes);
	масштабировать или переместить элемент (Adjust Size & Position);
	изменить шрифт элемента (Change Font);
	вызвать мини-инспектора (View Properties).

Команда Adjust Size & Position вызывает процедуру TFrmMain.AdjustClick (см. листинг 12.4).

Рис. 12.4. Контекстное меню, вызываемое правой кнопкой мыши
Листинг 12.4. Обработчик события OnClick команды Adjust Size & Position
procedure TFrmMain.AdjustClick(Sender: TObject); begin if (Adjust.Checked = True) then begin if ((PopupMenu1.PopupComponent <> ComponentBeingAdjusted) and (PopupMenu1.PopupComponent <> SizingRect1)) then begin MessageDlg( 'You can only adjust one element at a time.' + #13#10 + 'Please unselect the current element before continuing.', mtWarning, [mbOK], 0); Exit; end; Adjust.Checked := False; With TWinControl(ComponentBeingAdjusted) do begin Top := SizingRect1.Top; Left := SizingRect1.Left; Width := SizingRect1.Width; Height := SizingRect1.Height; end; SizingRect1.Cursor := crDefault; SizingRect1.Visible := False; SizingRect1.Top := -40; SizingRect1.Left := -40; SizingRect1.Width := 40; SizingRect1.Height := 40; MiniInspector1.ShowThisComponent (ComponentBeingAdjusted); ComponentBeingAdjusted := Self; { т. е. выделенный элемент } { отсутствует. } end else begin if ((ComponentBeingAdjusted <> Self) and (PopupMenu1.PopupComponent <> ComponentBeingAdjusted)) then begin MessageDlg( 'You can only adjust one element at a time.' + #13#10 + 'Please unselect the current element before continuing.', mtWarning, [mbOK], 0); Exit; end; Adjust.Checked := True; ComponentBeingAdjusted := PopupMenu1.PopupComponent; With TWinControl (PopupMenu1.PopupComponent) do begin SizingRect1.Top := Top; SizingRect1.Left := Left; SizingRect1.Width := Width; SizingRect1.Height := Height; end; SizingRect1.Visible := True; MiniInspector1.ShowThisComponent (ComponentBeingAdjusted); end; end; После выполнения различных проверок TSizingRect совмещается с изменяемым элементом (переменная ComponentBeingAdjusted была создана для тех процедур, которые не могут использовать значение PopupMenu1.PopupComponent). Делается это так:
ComponentBeingAdjusted := PopupMenu1.PopupComponent; With TWinControl(PopupMenu1.PopupComponent) do begin SizingRect1.Top := Top; SizingRect1.Left := Left; SizingRect1.Width := Width; SizingRect1.Height := Height; end; SizingRect1.Visible := True; MiniInspector1.ShowThisComponent (ComponentBeingAdjusted); При этом компонент SizingRect остается активным. Его можно перемещать и масштабировать мышью, как показано на рис. 12.5.
Завершив настройку элемента, пользователь снова щелкает правой кнопкой мыши, чтобы сохранить или отменить изменения (см. рис. 12.6).

Рис. 12.5. Прямоугольник SizingRect

Рис. 12.6. Сохранение или отмена изменений
Если пользователь захочет сохранить результаты настройки и выберет вторую команду (Adjust Size & Position), то изменяемый элемент перемещается и масштабируется в соответствии с новыми параметрами, а прямоугольник SizingRect снова скрывается (этот код также входит в TFrmMain.AdjustClick):
With TWinControl(ComponentBeingAdjusted) do begin Top := SizingRect1.Top; Left := SizingRect1.Left; Width := SizingRect1.Width; Height := SizingRect1.Height; end; SizingRect1.Cursor := crDefault; SizingRect1.Visible := False; SizingRect1.Top := -40; SizingRect1.Left := -40; SizingRect1.Width := 40; SizingRect1.Height := 40; {...}

Работа со свойствами элементов TreeData

Некоторые свойства чрезвычайно важны для работы элементов TreeData. Все элементы этого семейства получают информацию из следующих свойств режима конструирования: LookupDatabaseName, LookupTableName, LookupSQL (взаимоисключающее по отношению к LookupTableName), LookupDisplayField, LookupIDField, LookupParentIDField и в случае использования в Delphi2 — LookupSessionName (см. рис. 13.4). Пользуясь значениями этих свойств, элемент TreeData загружает все данные в память, отображает их в виде иерархического дерева и затем закрывает соединение с источником.

Рис. 13.4. Свойства компонентов TreeData
Существует и другой вариант — элементы TreeData также обладают свойством LookupDataSource, с помощью которого можно получить данные через открытый ранее источник. Это позволяет фильтровать и отбирать данные, входящие в элемент, с помощью свойства DataSource.DataSet. Свойство LookupAuto Refresh показывает, нужно ли перезагружать данные при изменении LookupData Source.

Разделяй и сгибай

Чтобы сгенерировать ландшафт, достаточно присвоить случайные высоты трем вершинам равностороннего треугольника, а затем «изогнуть» каждое ребро, поднимая или опуская его середину на случайную величину. Соедините линиями середины трех сторон — исходный треугольник разделится на четыре треугольника. Если теперь применить операции изгиба и деления к каждому из получившихся треугольников, то вскоре у вас получится нечто, невероятно похожее на реальный ландшафт (см. рис. 8.1, 8.2 и 8.3).

Рис. 8.1. Каркасный фрактальный ландшафт

Рис. 8.2. Фрактальный ландшафт с заполнением

Рис. 8.3. Фрактальный ландшафт со светотенью

Разумные решения

Несмотря на то что это странное поведение (чтение вместо записи) наблюдается уже в трех версиях Delphi, нельзя исключить возможность, что Borland когда-нибудь все же сочтет его ошибочным и исправит. Следовательно, вы должны избегать любых решений проблемы GPF при полной или частичной загрузке, которые перестанут работать, если метод write все же будет вызван в ходе загрузки компонента.
В случае GPF при полной загрузке обеспечить «совместимость с будущими версиями» оказывается несложно. Нам известно, что при загрузке объекта TPersistent из потока Delphi вызывает его метод read. Следовательно, как показано в листинге 9.1, конструктор Create объекта должен создать объект соответствующего типа и присвоить его private-полю данного свойства. Это выглядит несколько расточительным, если свойство не всегда должно задавать ся или сохраняться, но пара сотен лишних байт на диске или дополнитель ных команд кода Create несущественны для современных Pentium с 16 или 32 Мб памяти.
Листинг 9.1. PERSIST.SRC
{interface} type DemoComponent = class(TComponent) private fGlyph: TBitmap; fGlyphWritten: boolean; procedure SetGlyph(Glyph: TBitmap); { снаружи не видно } protected constructor Create(Owner: TComponent); override; procedure Loaded; override; public published property Glyph: TBitmap read fGlyph write SetGlyph; end; {implementation} constructor DemoComponent.Create(Owner: TComponent); begin inherited Create(Owner); fGlyph := TBitmap.Create; { Обязательно создайте для данного поля пустой объект } end; procedure DemoComponent.SetGlyph(Glyph: TBitmap); begin if fGlyph <> Glyph then { fGlyph = Glyph, когда SetGlyph } begin { вызывается процедурой Loaded } fGlyph.Free; { Assign может закончиться неудачно, } { если целевое поле не пусто: } fGlyph := TBitmap.Create; { Free/Create/Assign намного надежнее } fGlyph.Assign(Glyph); end; { Извлекаем все необходимые данные и устанавливаем флаг PropertyWritten} fGlyphWritten := True; end; procedure DemoComponent.Loaded; begin inherited Loaded; { Не забывайте сделать это! } if (not fGlyphWritten) and (not fGlyph.Empty) then SetGlyph(fGlyph); { Извлекаем все необходимые данные } end; С частичной загрузкой дело обстоит несколько сложнее. К счастью, компоненты Delphi содержат метод Loaded, который можно переопределить для выполнения любых завершающих действий. С помощью метода Loaded и незначительных изменений в программе проблему частичной загрузки удается решить.
Первое, что необходимо сделать, — добавить флаг fPropertyWritten для каждого свойства TPersistent, которое может сохраняться (см. листинг 9.1). При создании объекта флагу присваивается значение False, и лишь в методе write оно может измениться на True.
Затем следует переопределить (с помощью ключевого слова override) метод Loaded вашего компонента и добавить в него строку примерно такого вида:
if not fPropertyWritten then
SetProperty(fProperty)
чтобы метод write вызывался из Loaded в том (и только в том!) случае, если он не был вызван при загрузке компонента.
Наконец, представьте себе, что произойдет при попытке присвоить свойству типа TPersistent тот же самый объект, который в нем уже содержится. Вы уничтожаете имеющееся значение (Free), создаете новый «пустой» экземпляр (Create) и затем присваиваете (Assign) ему новое значение, которое указывает на первоначальный (уже уничтоженный вами) экземпляр. Вряд ли это то, что вы хотели получить! Избежать такой ситуации можно, воспользовавшись фрагментом кода, приведенным в листинге 9.2. При этом private-объект уничтожается лишь в том случае, если новое значение не совпадает с существую щим. Дополнительная проверка гарантирует, что SetProperty(fProperty) больше не приведет к возникновению GPF и не станет причиной особых накладных расходов, если «чтение вместо записи» все же исчезнет из Delphi.
Листинг 9.2. PERSIST2.SRC
if fProperty <> NewPropertyValue then begin fProperty.Free; { Assign 'через' TPersistent } fProperty := TPropertyType.Create; { может и не пройти: } fProperty.Assign(NewPropertyValue); { Free/Create/Assign надежнее } end; { Извлекаем все необходимые данные из NewPropertyValue } fPropertyWritten := True; Перспективы
Подозреваю, что «чтение вместо записи» возникло в результате слишком усердной оптимизации. На первый взгляд оправдать его довольно трудно, но каждый раз, когда в Delphi обнаруживается ошибка или неудачное решение, я спрашиваю себя — а часто ли мне приходилось создавать или использовать приложения, которые работали бы устойчивее Delphi или обладали лучшим соотношением удачных и неудачных решений? Ответ всегда один: крайне редко… если вообще приходилось.
Наконец, следует помнить и о том, что метод write вызывается во время загрузки простых типов (например, целых, перечисляемых типов и строк), а проблема с объектами TPersistent и их потомками не представляет особых сложностей.

Реализация нового интерфейса

Как всегда, самое ужасное спрятано в реализации. За кулисами FMDD происходит немалая работа. Обработка FMDD распадается на три отдельные, но взаимосвязанные подзадачи:

Процедура AcceptDropFiles должна сохранить логический номер окна передаваемого элемента и обработчик OnDrop для будущего использования. Кроме того, процедура должна вызвать DragAcceptFiles, чтобы разрешить обработку сообщений WM_DROPFILES данным окном, и субклассировать окно, чтобы оно могло обрабатывать сообщения.

Нам потребуется обработчик сообщений Windows, который при получении WM_DROPFILES конструирует объект TDragDropInfo и передает его соответствующему элементу.

Процедура UnacceptDroppedFiles должна прекратить субклассирование окна и вызвать DragAcceptFiles, чтобы в дальнейшем сообщения WM_DROPFILES окну уже не посылались.

Поскольку брошенные файлы могут приниматься сразу несколькими окнами, нам придется вести список логических номеров окон и соответ ствующих им обработчиков. При вызове AcceptDroppedFiles информация об элементе заносится в такой список. Процедура, обрабатывающая сообщение WM_DROPFILES, просматривает логические номера окон в списке и определяет, какому объекту следует направить событие OnFMDragDrop. Наконец, процедура UnacceptDroppedFiles удаляет информацию об элементе из списка. К счастью, в Delphi существует компонент TList, предназначенный именно для работы со списками. С его помощью операции добавления, удаления и просмотра элементов выполняются проще простого.
Самой сложной частью реализации является субклассирование — в основном из-за того, что оно требует знания многих внутренних механизмов Windows. Ранее я в общих чертах рассказал о субклассировании, но намерен но не стал говорить о том, как оно выполняется, пока мы не добрались до реализации. Этот момент наступил, снимайте белые перчатки.

Реализация сервера

Приемники OLE-перетаскивания, работающие с файлами, рассчитывают получить данные в формате буфера обмена CF_HDROP. Этот формат используется в первом примере этой главы, он же присутствует и в реализации WM_DROPFILES, хотя этот факт скрыт за DragQueryFile и другими функциями API. Поскольку мы реализуем сервер перетаскивания, нам потребуется способ преобразования списка файлов в данные формата CF_HDROP. У нас уже есть класс TDragDropInfo, который ведет учет файлов из списка, поэтому такой метод было бы разумно включить в этот класс. Новый метод TDragDropInfo.CreateHDrop приведен в листинге 4.4.
Листинг 4.4. TDragDropInfo.CreateHDrop преобразует информацию
о перетаскиваемых файлах
function TDragDropInfo.CreateHDrop : HGlobal;
var RequiredSize : Integer; i : Integer; hGlobalDropInfo : HGlobal; DropFiles : PDropFiles; c : PChar; begin { Построим структуру TDropFiles в памяти, выделенной через GlobalAlloc. Область памяти сделаем глобальной и совместной, поскольку она, вероятно, будет передаваться другому процессу. } { Определяем необходимый размер структуры } RequiredSize := sizeof (TDropFiles); for i := 0 to Self.Files.Count-1 do begin { Длина каждой строки, плюс 1 байт для терминатора } RequiredSize := RequiredSize + Length (Self.Files[i]) + 1; end; { 1 байт для завершающего терминатора } inc (RequiredSize); hGlobalDropInfo := GlobalAlloc ((GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT), RequiredSize); if (hGlobalDropInfo <> 0) then begin { Заблокируем область памяти, чтобы к ней можно было обратиться } DropFiles := GlobalLock (hGlobalDropInfo); { Заполним поля структуры DropFiles } { pFiles -- смещение от начала структуры до первого байта массива с именами файлов. } DropFiles.pFiles := sizeof (TDropFiles); DropFiles.pt := Self.FDropPoint; DropFiles.fNC := Self.InClientArea; DropFiles.fWide := False; { Копируем каждое имя файла в буфер. Буфер начинается со смещения DropFiles + DropFiles.pFiles, то есть после последнего поля структуры. } c := PChar (DropFiles); c := c + DropFiles.pFiles; for i := 0 to Self.Files.Count-1 do begin StrCopy (c, PChar (Self.Files[i])); c := c + Length (Self.Files[i]); end; { Снимаем блокировку } GlobalUnlock (hGlobalDropInfo); end; Result := hGlobalDropInfo; end; Данная функция вычисляет требуемый размер данных (он равен размеру записи TDropFiles, определенной в модуле ShlObj, плюс общая длина всех имен файлов), выделяет область памяти и заполняет структуру. Память выделяет ся из глобального пула (global heap) Windows с атрибутом «общая» (GMEM_SHARE), чтобы ее можно было передавать другим приложениям. Обращения к выделенной памяти осуществляются через логический номер типа HGlobal. Имен
но его мы возвращаем вызывающей стороне, которая обязана освободить данные (функцией API GlobalFree) после завершения работы с ними.
Интерфейсы IDropSource и IDataObject реализуются в файле DRAGDROP.PAS (листинг 4.5) объектами TFileDropSource и THDropDataObject соответственно. Объект TFileDropSource выглядит очень просто. Его конструктор просто вызывает конструктор TInterfacedObject, а затем задает начальное значение счетчика ссылок функцией _AddRef. Функция GiveFeedback просто приказывает DoDragDrop использовать стандартные варианты курсора, а QueryContinueDrag проверяет флаг клавиши Escape и состояние кнопок мыши, определяя по ним, следует ли завершить, продолжить или отменить операцию перетаскивания. В общем, ничего необычного.
THDropDataObject выглядит посложнее. Конструктор создает объект TDragDrop Info, который представляет собой пустой список файлов. Затем вызывающая сторона заносит файлы в список методом Add. Деструктор объекта освобожда ет объект TDragDropInfo, если он существует. Из всех методов интерфейса IData Object реализованы только GetData, QueryGetData и EnumFormatEtc. Другие методы возвращают коды, показывающие, что они (методы) не поддерживаются объектом.
QueryGetData просматривает переданную запись TFormatEtc и проверяет, поддерживается ли формат запрашиваемых данных. Если формат поддержи вается, код возврата показывает, что GetData, вероятно, сможет воспроизвес ти данные. EnumFormatEtc создает и возвращает объект IEnumFormatEtc по статическому массиву структур TFormatEtc. Функция GetData проверяет, допустим ли запрашиваемый формат (для чего снова вызывает QueryGetData), убеждается в наличии данных для воспроизведения и затем вызывает TDragDropInfo.Create HDrop. Последний метод создает глобальную область памяти, которая возвращается вызывающей стороне через передаваемую запись TStgMedium. За освобождение данных отвечает вызывающая сторона (то есть клиент перетаски вания).
Листинг 4.5. DRAGDROP.PAS: интерфейсы, необходимые
для работы сервера перетаскивания
{
DRAGDROP.PAS -- реализация OLE-перетаскивания.
Автор: Джим Мишель
Дата последней редакции: 30/05/97
} unit DragDrop; interface uses Windows, ActiveX, Classes, FileDrop; type { TFileDropSource - источник для перетаскивания файлов } TFileDropSource = class (TInterfacedObject, IDropSource) constructor Create; function QueryContinueDrag (fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall; function GiveFeedback(dwEffect: Longint): HResult; stdcall; end; { THDropDataObject - объект данных с информацией о перетаскиваемых файлах } THDropDataObject = class(TInterfacedObject, IDataObject) private FDropInfo : TDragDropInfo; public constructor Create(ADropPoint : TPoint; AInClient : Boolean); destructor Destroy; override; procedure Add (const s : String); { из IDataObject } function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall; function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall; function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall; function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult; stdcall; function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall; function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall; function DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall; function DUnadvise(dwConnection: Longint): HResult; stdcall; function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall; end; implementation uses EnumFmt; { TFileDropSource } constructor TFileDropSource.Create; begin inherited Create; _AddRef; end; { QueryContinueDrag определяет необходимые действия. Функция предполагает, что для перетаскивания используется только левая кнопка мыши. } function TFileDropSource.QueryContinueDrag ( fEscapePressed: BOOL; grfKeyState: Longint ): HResult; begin if (fEscapePressed) then begin Result := DRAGDROP_S_CANCEL; end else if ((grfKeyState and MK_LBUTTON) = 0) then begin Result := DRAGDROP_S_DROP; end else begin Result := S_OK; end; end; function TFileDropSource.GiveFeedback ( dwEffect: Longint ): HResult; begin case dwEffect of DROPEFFECT_NONE, DROPEFFECT_COPY, DROPEFFECT_LINK, DROPEFFECT_SCROLL : Result := DRAGDROP_S_USEDEFAULTCURSORS; else Result := S_OK; end; end; { THDropDataObject } constructor THDropDataObject.Create ( ADropPoint : TPoint; AInClient : Boolean ); begin inherited Create; _AddRef; FDropInfo := TDragDropInfo.Create (ADropPoint, AInClient); end; destructor THDropDataObject.Destroy; begin if (FDropInfo <> nil) then FDropInfo.Free; inherited Destroy; end; procedure THDropDataObject.Add ( const s : String ); begin FDropInfo.Add (s); end; function THDropDataObject.GetData ( const formatetcIn: TFormatEtc; out medium: TStgMedium ): HResult; begin Result := DV_E_FORMATETC; { Необходимо обнулить все поля medium на случай ошибки} medium.tymed := 0; medium.hGlobal := 0; medium.unkForRelease := nil; { Если формат поддерживается, создаем и возвращаем данные } if (QueryGetData (formatetcIn) = S_OK) then begin if (FDropInfo <> nil) then begin medium.tymed := TYMED_HGLOBAL; { За освобождение отвечает вызывающая сторона! } medium.hGlobal := FDropInfo.CreateHDrop; Result := S_OK; end; end; end; function THDropDataObject.GetDataHere ( const formatetc: TFormatEtc; out medium: TStgMedium ): HResult; begin Result := DV_E_FORMATETC; { К сожалению, не поддерживается } end; function THDropDataObject.QueryGetData ( const formatetc: TFormatEtc ): HResult; begin Result := DV_E_FORMATETC; with formatetc do if dwAspect = DVASPECT_CONTENT then if (cfFormat = CF_HDROP) and (tymed = TYMED_HGLOBAL) then Result := S_OK; end; function THDropDataObject.GetCanonicalFormatEtc ( const formatetc: TFormatEtc; out formatetcOut: TFormatEtc ): HResult; begin formatetcOut.ptd := nil; Result := E_NOTIMPL; end; function THDropDataObject.SetData ( const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL ): HResult; begin Result := E_NOTIMPL; end; { EnumFormatEtc возвращает список поддерживаемых форматов } function THDropDataObject.EnumFormatEtc ( dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc ): HResult; const DataFormats: array [0..0] of TFormatEtc = ( ( cfFormat : CF_HDROP; ptd : Nil; dwAspect : DVASPECT_CONTENT; lindex : -1; tymed : TYMED_HGLOBAL; ) ); DataFormatCount = 1; begin { Поддерживается только Get. Задать содержимое данных нельзя } if dwDirection = DATADIR_GET then begin enumFormatEtc := TEnumFormatEtc.Create (@DataFormats, DataFormatCount, 0); Result := S_OK; end else begin enumFormatEtc := nil; Result := E_NOTIMPL; end; end; { Функции Advise не поддерживаются } function THDropDataObject.DAdvise ( const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint ): HResult; begin Result := OLE_E_ADVISENOTSUPPORTED; end; function THDropDataObject.DUnadvise ( dwConnection: Longint ): HResult; begin Result := OLE_E_ADVISENOTSUPPORTED; end; function THDropDataObject.EnumDAdvise ( out enumAdvise: IEnumStatData ): HResult; begin Result := OLE_E_ADVISENOTSUPPORTED; end; initialization OleInitialize (Nil); finalization OleUninitialize; end. Последнее, что осталось сделать, — создать форму, которая сможет воспользоваться этим новым модулем. Я взял форму из предыдущего примера и добавил на нее компонент-метку (TLabel) с текстом "D:\TESTO.TXT". Если щелкнуть на этом компоненте, начинается операция перетаскивания OLE. Вы можете перетащить и бросить файл на список в форме или в окно Windows Explorer. В первом случае имя файла просто отображается в списке, а во втором файл копируется в указанное место1. Текст процедуры TForm1.Label1MouseDown, инициирующей перетаскивание, приведен в листинге 4.6.
Листинг 4.6. Начало операции перетаскивания
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var DropSource : TFileDropSource; DropData : THDropDataObject; rslt : HRESULT; dwEffect : DWORD; DropPoint : TPoint; begin if (Button = mbLeft) then begin { Создаем объект-источник... } DropSource := TFileDropSource.Create; { ...и объект данных } DropPoint.x := 0; DropPoint.y := 0; DropData := THDropDataObject.Create (DropPoint, True); DropData.Add (Label1.Caption); { DoDragDrop управляет операцией и по мере надобности
1 Разумеется, чтобы Windows было что копировать, следует предварительно создать файл с указанным именем в корневом каталоге диска D:. — Примеч. ред.
вызывает методы IDropSource и IDropTarget.
} rslt := DoDragDrop (DropData, DropSource, DROPEFFECT_COPY, dwEffect); if ((rslt <> DRAGDROP_S_DROP) and (rslt <> DRAGDROP_S_CANCEL)) then begin case rslt of E_OUTOFMEMORY : ShowMessage ('Out of memory'); else ShowMessage ('Something bad happened'); end; end; { Освобождаем использованные ресурсы после завершения работы } DropSource.Free; DropData.Free; end; end;

Редакторы моделей

Мастера и списки свойств являются редакторами моделей— вы передаете им объект модели, они выполняются и затем возвращают управление. Если пользователь нажал кнопку OK и изменил модель, возвращаемый результат равен True; в противном случае — False. Абстрактные шаблоны из проекта EMBEDDEDFORMS.DPR позволяют создавать реальных мастеров и списки свойств, которые могут совместно использовать объекты моделей и виды. От вас требуется следующее:

	создайте новую форму путем наследования от TAbstractWizard или TAbstract PropertySheet;
	задайте ее заголовок;
	для мастеров — выберите изображение и отрегулируйте ширину графической панели.
	напишите небольшую процедуру Initialize, которая поставляет информацию о заголовках страниц и классах вида, как показано в следующем фрагменте файла TESTSHEET.PAS: procedure TPropertySheet.Initialize; begin InitializeSheet( ['Name/Supervisor', 'Birthday', 'Address'], [TEmployeeIdView, TBirthdayView, TAddressView] ); end; // TPropertySheet.Initialize

Абстрактный мастер и абстрактный список свойств делают все остальное; оба автоматически масштабируются, чтобы вместить наибольший вид. Мастер управляется стандартными кнопками Prev/Next/OK; список свойств блокирует кнопку OK при наличии неверных данных на странице за исключением ситуации, при которой хотя бы одна страница была неверной еще до вызова EditModel. В обоих случаях на входе вызывается метод ReadFrom Model для всех видов, а на выходе — метод WriteToModel для всех видов, если пользователь нажал кнопку OK. Список свойств обладает свойством ReadOnly, поэтому вы можете разрешить пользователям просматривать объекты без возможности их изменения. И мастер, и список свойств являются «чисто интерфейсными» объектами, не имеющими public-методов, так что вам не придется беспокоиться о Free или try..finally. Например, в листинге 10.7 приведен фрагмент модуля MAIN.PAS, в котором создаются и запускаются примеры мастера и списка свойств.
Листинг 10.7. Запуск редакторов моделей
procedure TTestForm.EditModel(Editor: IModelEdit; Model: TModel); begin {$ifdef ReadOnly} Editor.ReadOnly := True; {$endif} // ReadOnly if Editor.EditModel(Model) then ShowMessage('OK!') else ShowMessage('Abort ...'); end; // TTestForm.EditModel procedure TTestForm.RunWizard(Sender: TObject); var Employee: TEmployee; begin Employee := DataModel.NewEmployee; try EditModel(TWizard.Create(Self), Employee); finally Employee.Free; end; end; procedure TTestForm.RunSheet(Sender: TObject); var Employee: TEmployee; begin Employee := DataModel.LoadEmployee(3); try EditModel(TPropertySheet.Create(Self), Employee); finally Employee.Free; end; end; Лично меня в реализации мастера и списка свойств поражает, как просто выглядит такой обобщенный код на Delphi. Ключевым здесь является аргумент-массив array of TViewClass, передаваемый InitializeSheet() и Initialize Wizard() (см. листинг 10.8).
Листинг 10.8. Метод TAbstractPropertySheet.InitializeSheet
// из файла PropertySheets.pas
procedure TAbstractPropertySheet.InitializeSheet( Captions: array of string; Views: array of TViewClass ); var MaxSpan: TSpan; Index: integer; Sheet: TTabSheet; ActualView: TAbstractView; begin Assert( fViews.Count = 0, 'Should only call ' + Name + '.InitializeSheet once' ); Assert( High(Captions) >= Low(Captions), // можно использовать 'Must have at least one tab' ); // Slice() для передачи // пустых массивов Assert( High(Captions) = High(Views), 'Must have same number of Captions as of Views' ); MaxSpan := Point(0, 0); for Index := Low(Captions) to High(Captions) do begin Sheet := TTabSheet.Create(Self); with Sheet do begin PageControl := Self.PageControl; Caption := Captions[Index]; end; // with Sheet ActualView := Views[Index].CreateEmbedded ( Self, Sheet, efmTopLeft ); fViews.Add(ActualView); ActualView.AddNotifiee(Self); MaxSpan := UnionSpan(MaxSpan, ActualView.Span); end; // for Sheet := PageControl.ActivePage; Width := (Width - Sheet.Width) + MaxSpan.X; Height := (Height - Sheet.Height) + MaxSpan.Y; end; // TAbstractPropertySheet.InitializeSheet Три оператора Assert проверяют, что список свойств еще не настроен, что в нем имеется хотя бы один заголовок и что количество заголовков совпадает с количеством классов вида. Обожаю Assert — лишь после того, как необходимость в конструкции {$IfOpt D+} {$Endif} отпала, я понял, как громоздко она выглядит. Assert проще ввести, он компактен и легко читается.
Габариты (spans) определяются в файле EMBEDDED.PAS. Они представляют собой обычную пару «ширина/высота», то есть BottomRight прямоугольника TRect, у которого Top и Left равны 0:
function TEmbeddedForm.Span: TSpan; begin Result.X := Width; Result.Y := Height; end; // TEmbeddedForm.Span Функция UnionSpan очень похожа на функцию Windows API UnionRect за исключением того, что она работает с габаритами, а не с прямоугольниками. Присваивая MaxSpan пару (0, 0), мы готовимся к определению минимального прямоугольника, вмещающего все виды из массива Views.
Вся настоящая работа выполняется в цикле при переборе элементов массива Captions. Для каждого элемента массива мы создаем новую вкладку (TTabSheet), размещаем ее на элементе-странице (TPageControl) и задаем текст заголовка. Затем аргумент Views используется для создания нового вида. Мы добавляем новый вид в общий список (Tlist), приказываем ему обращаться к фрейму при каждом изменении Valid и настраиваем MaxSpan.
После того как все виды будут включены в список, мы определяем, сколько места следует выделить «вокруг» MaxSpan для фрейма, заголовка, кнопок и корешков вкладок. Для этого мы вычисляем разность между габаритами формы и габаритами PageControl.ActivePage.
TAbstractWizard выглядит почти так же, но оказывается чуть более сложным, потому что вместо вкладок мы используем три панели: внешнюю панель, панель заголовка (прижатую к верхнему краю — top-aligned) и панель фрейма (заполняющую клиентскую область — client-aligned). При активизации конкретной страницы мы просто переводим на передний план нужную внешнюю панель (листинг 10.9).
Листинг 10.9. Метод TAbstractVizard.SetCurrentPage
// из файла Wizards.pas
property CurrentPage: integer read fCurrentPage write SetCurrentPage; procedure TAbstractWizard.SetCurrentPage (Value: integer); var LastPage, PageIsValid: boolean; begin Assert(TObject(fPanels[Value]) is TPanel); Assert(TObject(fViews[Value]) is TAbstractView); // Сочетание Assert(is) со 'слепыми' преобразованиями типов // обеспечивает отладочную безопасность конструкции "as" // без (особой) потери производительности fCurrentPage := Value; TPanel(fPanels[Value]).BringToFront; LastPage := Value = fPageCount; PageIsValid := TAbstractView(fViews[Value]).Valid; PrevBtn.Enabled := Value > 0; NextBtn.Enabled := PageIsValid and (not LastPage); OkBtn.Enabled := PageIsValid and LastPage; end; // TAbstractWizard.SetCurrentPage Как видно из листинга 10.9, еще одна приятная особенность Assert заключается в том, что пара «Assert/слепое преобразование типа» обеспечивает полноценную проверку на совместимость типов при отладке, но не отражается на производительности окончательной (поставляемой заказчику) версии. Во всем остальном код несложен: мы задаем fCurrentPage и переводим соответствующую панель на передний план. Затем проверяем, является ли данная страница первой или последней и корректно ли она заполнена (Valid), после чего соответствующим образом задаем состояние кнопок Prev, Next и OK.
Оставшийся код в файлах WIZARDS.PAS и PROPERTYSHEETS.PAS не содержит никаких хитростей. Хотя я буду рад и польщен, если вы сочтете его достойным изучения, для успешного использования в нем совершенно не обязательно разбираться. Поэтому я не буду переводить на него бумагу; если этот код вас действительно заинтересует, найдите его на CD-ROM.

Режим с заполнением

Каркасный режим работает относительно быстро и неплохо обрисовывает общую структуру поверхности, но обладает большим недостатком: сетка получается прозрачной. Другими словами, задний склон холма виден сквозь передний.
В серьезных графических приложениях используются сложные алгоритмы «отсечения скрытых линий», но FL3 не является серьезным приложением и убирает скрытые линии методом «грубой силы», рисуя поверх них (см. рис. 8.2).
Другими словами, DrawTriangle() сначала рисует задние треугольники, чтобы передние треугольники рисовались позже и закрывали их. При исходном вызове DrawTriangle() этой процедуре передается треугольник, расположенный «вершиной вниз» — вершина A расположена спереди, в нижней части окна, а вершины B и С — сзади, ближе к верхней части окна (см. рис. 8.8). Следовательно, фрагмент
DrawTriangle(Canvas, CA, BC, C, Plys, True); DrawTriangle(Canvas, AB, B, BC, Plys, True); DrawTriangle(Canvas, BC, CA, AB, Plys, False); DrawTriangle(Canvas, A, AB, CA, Plys, True); сначала рисует левый субтреугольник, а затем — правый. Ориентация этих «внешних» субтреугольников совпадает с ориентацией треугольника ABC, а порядок перечисления параметров в рекурсивных вызовах DrawTriangle() гарантирует, что новая точка A будет расположена спереди, а точки B и C — сзади.
Третья строка вызов рисует «внутренний» субтреугольник, который визуально находится перед вторым (правым верхним) треугольником. Внутренний субтреугольник всегда перевернут по отношению к своему внешнему треугольнику, поэтому при вызове DrawTriangle() он располагается «вершиной вверх». Порядок перечисления параметров гарантирует, что при таком вызове вершина A остается сзади, а B и C — спереди, в нижней части экрана. Если вы просмотрите набор рекурсивных вызовов, соответствующих ветви not PointDn в процедуре DrawTriangle(), то увидите, что расположенные «вершиной вверх» треугольники рисуются в порядке «сзади вперед, справа налево»1.
Четвертый вызов DrawTriangle() рисует последний, передний субтреугольник.

Рис. 8.8. Порядок рисования и ориентация треугольников

Режим со светотенью

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

Сброс груза

Я перешел к шагу 3. Задача заключалась в том, чтобы определить номера столбца и строки для первого дня месяца и для положения курсора. С помощью несложных вычислений я получаю разность между двумя датами (в днях), которую затем можно прибавить к дате начала месяца для получения абсолютной даты.
Разумеется, первый день месяца всегда выводится в первой строке, каким бы днем недели он ни был. Со строкой все ясно. Поскольку я не изменял стандартного порядка дней недели (с воскресенья до субботы), день недели для первого числа месяца дает мне базовый номер столбца. Дальше остается лишь переместиться в календаре на нужное количество дней. К счастью, пакет Orpheus включает мощные процедуры для арифметических вычислений и преобразования дат, заметно облегчающие мою задачу. Функция вычисления даты приведена в листинге 14.3.
Листинг 14.3. Вычисление даты по положению курсора
function DatePointedTo : TOvcDate; var Idx : Longint; DOW : Integer; Day1 : TOvcDate; begin { Вычисляем первый день как Row = 1, Col = день недели, затем вычисляем смещение для даты под курсором и складываем. } Day1 := DMYToDate(1, Calendar.Month, Calendar.Year); DOW := Ord(DayOfWeek(Day1)) + 1; Idx := (RNum - 1) * 7; if CNum < DOW then Idx := Idx - (DOW - CNum) else if CNum > DOW then Idx := Idx + (CNum - DOW);1 Result := IncDate(Day1, Idx, 0, 0); end; { DatePointedTo } Осталось выполнить тривиальную работу — преобразовать дату и содержимое текстового поля в строку и занести ее в TStringGrid. Кроме того, мне показалось, что текстовое поле после завершения перетаскивания стоит очистить. Поддержка перетаскивания несколько снизила возможности редактирования в текстовом поле, поэтому очищать его вручную было бы утомительно.
Примечание для себя: в данном случае текстовое поле следует очищать в обработчике события перетаскивания, поскольку эта операция должна выполняться лишь в случае успешного завершения. Если бы я захотел очищать текстовое поле независимо от того, состоялось перетаскивание или нет, это следовало бы делать в обработчике OnEndDrag текстового поля.
Заметки на память: 1) проследить за тем, чтобы свойство Initialize компонента OvcCalendar было равно True. В противном случае календарь окажется в неопределенном состоянии! 2) свойство DrawHeader должно иметь значение False, чтобы в календаре не выводилось ничего, кроме дат.
В листинге 14.4 приведен исходный текст всего модуля.
Листинг 14.4. Демонстрационная программа для перетаскивания
{——————————} {Перетаскивание (демонстрационная программа)} {DRAGMAIN.PAS : Главный модуль } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } { Приложение, демонстрирующее } основные принципы } { внутреннего перетаскивания. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 3/5/97 } {————————} unit DragMain; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, OvcBase, OvcCal, OvcData, OvcDT, ExtCtrls; type TDDDemoForm = class(TForm) Calendar: TOvcCalendar; OvcController1: TOvcController; EditBox: TEdit; StringGrid: TStringGrid; Label1: TLabel; Bevel1: TBevel; QuitBtn: TButton; Panel1: TPanel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Panel2: TPanel; procedure QuitBtnClick(Sender: TObject); procedure EditBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure CalendarDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure CalendarDragDrop(Sender, Source: TObject; X, Y: Integer); private { Private declarations } public { Public declarations } end; var DDDemoForm: TDDDemoForm; implementation {$R *.DFM} procedure TDDDemoForm.QuitBtnClick(Sender: TObject); begin Close; end; procedure TDDDemoForm.EditBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and (EditBox.Text <> "") and not (ssDouble in Shift) then TEdit(Sender).BeginDrag(False); end; procedure TDDDemoForm.CalendarDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := True; end; procedure TDDDemoForm.CalendarDragDrop(Sender, Source: TObject; X, Y: Integer); var RHeight : Integer; CWidth : Integer; RNum : Integer; CNum : Integer; s : String; function DatePointedTo : TOvcDate; var Idx : Longint; DOW : Integer; Day1 : TOvcDate; begin { Вычисляем первый день как Row = 1, Col = день недели, затем вычисляем смещение для даты под курсором и складываем. } Day1 := DMYToDate(1, Calendar.Month, Calendar.Year); DOW := Ord(DayOfWeek(Day1)) + 1; Idx := (RNum - 1) * 7; if CNum < DOW then Idx := Idx - (DOW - CNum) else if CNum > DOW then Idx := Idx + (CNum - DOW); Result := IncDate(Day1, Idx, 0, 0); end; { DatePointedTo } begin RHeight := Calendar.ClientHeight div 6; RNum := Y div RHeight + 1; CWidth := Calendar.ClientWidth div 7; CNum := X div CWidth + 1; { Заносим дату и описание задачи в список строк } s := DateTimeToStr(OvcDateToDateTime (DatePointedTo)) + " - " + EditBox.Text; StringGrid.Cells[0, StringGrid.RowCount - 1] := s; { Добавляем в список пустую строку } StringGrid.RowCount := StringGrid.RowCount + 1; EditBox.Text := ""; end; end. Конец записи (19 марта).
Зловещая фигура наклонилась вперед, внимательно читая похищенный Дневник. Взгляд скользнул на следующую страницу.

Шаблоны компонентов и составные компоненты

Возможное решение заключается в использовании такой новинки Delphi3, как шаблоны компонентов (component templates). Шаблоны позволяют объединить в группу взаимосвязанные компоненты (вместе с именами и обработчиками событий) и поместить ее в палитру компонентов для повторного использования. Превосходная идея — но не совсем то, что требуется в нашем случае, потому что в итоге мы получим просто набор компонентов на форме. Если нам потребуется разместить один и тот же вид на двух различных формах, станет ясно, что набор компонентов не является самостоятельным объектом и не может иметь своих методов — как же тогда приказать виду прочитать или записать свою модель?
Например, если в виде Employee должны присутствовать два внутренних вида с информацией о разных людях, то попытка размещения двух экземпляров шаблона на одной форме приведет к тому, что элементы второго экземпляра потеряют свои сохраненные имена и будут переименованы в Label1, Edit1 и т. д. В сценарии со сложным диалоговым окном все вкладки окажутся в одном модуле, а изменение шаблона не приведет к изменению созданного на его основе экземпляра.
Похожий, но более «мощный» подход — превратить вид в составной (compound) компонент, который включает в себя другие визуальные компоненты в виде private-полей. Но если вам уже приходилось это делать, вы наверняка знаете, что создание и масштабирование такого компонента превращается в сущий кошмар. Вместо того чтобы просто разместить компоненты на форме, как мы все привыкли делать, приходится создавать каждый внутренний компонент на программном уровне. Вместо того чтобы перетаскивать объекты мышью и задавать их свойства в инспекторе объектов, пока не получится что-то приличное, приходится вручную задавать значения всех свойств. Конечно, теоретически это возможно, но программирование становится очень медленным, нудным и чреватым ошибками. В итоге получается большой объем кода, который очень трудно прочитать и/или изменить. Существует и другой, худший аспект — поскольку это занятие настолько тягостно, программист пытается ограничиться минимальным количеством свойств, и в результате на форме возникает уродливая и неудобная мешанина компонентов. Возможно, построенный подобным образом вид содержит все необходимые «фишки», но пользы от него оказывается немного.
Мы могли бы избежать всех трудностей, связанных с ручным построением компонентов, если бы визуально сконструированную форму можно было преобразовать в компонент. На самом деле Delphi позволяет сделать это, однако не слишком простым или очевидным способом. Вам придется купить или построить специальный компонент, работающий только в режиме констру ирования, который задает недокументированное свойство формы IsControl, включить в форму нужный код и вручную исправить DFM-файл, чтобы изменить базовый класс объекта формы. Если вас заинтересует такая возможность, прочитайте книгу Рея Лишнера (Ray Lischner) «Secrets of Delphi 2» (Waite Group Press, 1996) — в ней приведен специальный компонент для работы с IsControl, а также содержатся подробные инструкции. Впрочем, хотя этот раздел книги произвел на меня огромное впечатление, я никогда не пользовался такой методикой, да и вам не рекомендую. Почему? Потому что вам придется повторять одни и те же действия при каждом создании нового вида или изменении существующего. Возможно, подобное превращение формы в компонент имеет смысл для создания истинно новых компонентов — например, объединения TMemo или TRichEdit с панелью инструментов — но не для видов.

SHOPPER32 за работой

SHOPPER32— базовое FTP-приложение, созданное с помощью компонента CsShopper, оно изображено на рис. 6.3. Создайте новый проект с именем SHOPPER32, вызовите главную форму frmMain и сохраните в модуле MAIN.PAS содержимое листинга 6.1.
Листинг 6.1. Модуль MAIN.PAS (* Модуль Main Написан для книги High Performance Delphi Programming - Джон К.Пенман 1997 За дополнительной информацией и помощью обращайтесь по адресу info@craiglockhart.com *)
unit main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, FileCtrl, ComCtrls, CsSocket, CsShopper, MkDirFrm, CsFtpMsg, ToolWin, Registry, ExtCtrls;

Рис. 6.3. Приложение SHOPPER32
type TfrmMain = class(TForm) CsShopper1: TCsShopper; pcShopper: TPageControl; tsConnect: TTabSheet; tsOptions: TTabSheet; tsAbout: TTabSheet; gbLocal: TGroupBox; gbRemote: TGroupBox; gbActions: TGroupBox; dcbLocal: TDriveComboBox; dlbLocal: TDirectoryListBox; flbLocal: TFileListBox; sbStatus: TStatusBar; pbDataTransfer: TProgressBar; lbRemoteFiles: TListBox; bbtnExit: TBitBtn; bbtnConnect: TBitBtn; bbtnAbort: TBitBtn; gbUserName: TGroupBox; gbPassword: TGroupBox; gbDefLocalDir: TGroupBox; gbDefTextEditor: TGroupBox; edDefUserName: TEdit; edDefPassword: TEdit; edDefLocalDir: TEdit; edDefTextEditor: TEdit; bbtnFtpCmds: TBitBtn; bbtnLocateTxtEditor: TBitBtn; bbtnLocateDefLocalDir: TBitBtn; gbMoreActions: TGroupBox; bbtnRefresh: TBitBtn; bbtnFTPHelp: TBitBtn; bbtnSite: TBitBtn; bbtnNewDir: TBitBtn; bbtnDelDir: TBitBtn; bbtnViewFile: TBitBtn; memLog: TMemo; rgFileType: TRadioGroup; bbtnRestart: TBitBtn; bbtnQuit: TBitBtn; tsProfiles: TTabSheet; gbSetProfile: TGroupBox; gbPrName: TGroupBox; gbPrHostName: TGroupBox; gbPrUserName: TGroupBox; gbPrPassWord: TGroupBox; gbPrRemDir: TGroupBox; gbPrLocDir: TGroupBox; edPrName: TEdit; edPrHostName: TEdit; edPrUserName: TEdit; edPrPassword: TEdit; edPrRemDir: TEdit; edPrLocDir: TEdit; gbPrList: TGroupBox; lbPrList: TListBox; bbtnPrNew: TBitBtn; bbtnPrSave: TBitBtn; bbtnPrDelete: TBitBtn; rgFTPMode: TRadioGroup; sbbtnRetr: TSpeedButton; sbbtnStor: TSpeedButton; Panel1: TPanel; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; bbtnStat: TBitBtn; gbHints: TGroupBox; cbHints: TCheckBox; gbFTPOptions: TGroupBox; BitBtn2: TBitBtn; rgFileStructure: TRadioGroup; rgTransfer: TRadioGroup; bbtnAddNew: TBitBtn; procedure bbtnConnectClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure bbtnFtpCmdsClick(Sender: TObject); procedure CsShopper1Info(Sender: TObject; Msg: String); procedure CsShopper1UpDateList(Sender: TObject; List: TStringList); procedure lbRemoteFilesDblClick(Sender: TObject); procedure CsShopper1List(Sender: TObject; List: TStringList); procedure bbtnSiteClick(Sender: TObject); procedure bbtnFTPHelpClick(Sender: TObject); procedure CsShopper1Busy(Sender: TObject; BusyFlag: Boolean); procedure CsShopper1Progress(Sender: TObject; Position: Integer); procedure rgFileTypeClick(Sender: TObject); procedure CsShopper1FileType(Sender: TObject; FileType: TFileTypes); procedure CsShopper1Error(Sender: TObject; Status: TConditions; Msg: String); procedure bbtnNewDirClick(Sender: TObject); procedure bbtnDelDirClick(Sender: TObject); procedure CsShopper1Connect(Sender: TObject; sSocket: Integer); procedure bbtnQuitClick(Sender: TObject); procedure rgFTPModeClick(Sender: TObject); procedure bbtnRefreshClick(Sender: TObject); procedure sbbtnRetrClick(Sender: TObject); procedure sbbtnStorClick(Sender: TObject); procedure CsShopper1DataDone(Sender: TObject; Done: Boolean); procedure bbtnStatClick(Sender: TObject); procedure bbtnRestartClick(Sender: TObject); procedure flbLocalDblClick(Sender: TObject); procedure lbRemoteFilesClick(Sender: TObject); procedure flbLocalClick(Sender: TObject); procedure lbPrListDblClick(Sender: TObject); procedure bbtnConnectMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure bbtnViewFileClick(Sender: TObject); procedure bbtnAbortClick(Sender: TObject); procedure bbtnPrSaveClick(Sender: TObject); procedure bbtnExitClick(Sender: TObject); procedure lbPrListClick(Sender: TObject); procedure bbtnPrNewClick(Sender: TObject); procedure bbtnAddNewClick(Sender: TObject); procedure edPrNameExit(Sender: TObject); procedure edPrHostNameExit(Sender: TObject); procedure edPrUserNameExit(Sender: TObject); procedure edPrPasswordExit(Sender: TObject); procedure edPrRemDirExit(Sender: TObject); procedure edPrLocDirExit(Sender: TObject); procedure bbtnPrDeleteClick(Sender: TObject); procedure bbtnLocateDefLocalDirClick(Sender : TObject); procedure bbtnLocateTxtEditorClick(Sender: TObject); procedure BitBtn2Click(Sender: TObject); private { Private declarations } public { Public declarations } HelpCmd : String; UsedProfile, UsedQFTP, NewProfile : Boolean; OldTransferMode, OldFileStruct : String; OldProfiles, HostNameList, UsernameList, PasswordList, RemoteDirList, LocalDirList, CurrentProfiles, ProfileNameList : TStringList; NoOfUsers, LastProfileUsed, NoProfiles : Integer; procedure LoadSettings; procedure SaveOptions; procedure SaveProfiles; end; var frmMain: TfrmMain; implementation uses RMDirFrm, HelpFrm, QuickFTPfrm, LocateDirFrm, LocateEdFrm; {$R *.DFM} const FtpClientKey = 'Software\High Performance Delphi\Shopper32'; procedure TfrmMain.LoadSettings; var Reg : TRegistry; Count : Integer; ProfileName : String; begin Reg := TRegistry.Create; // Считываем имя пользователя по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('UserName') then edDefUserName.Text := Reg.ReadString('UserName') else edDefUserName.Text := 'anonymous'; finally Reg.CloseKey; end; // Считываем пароль по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('Password') then edDefPassword.Text := Reg.ReadString('Password') else edDefPassword.Text := 'guest'; finally Reg.CloseKey; end; // Считываем локальный каталог по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('DefLocalDir') then edDefLocalDir.Text := Reg.ReadString('DefLocalDir') else edDefLocalDir.Text := 'C:\'; finally Reg.CloseKey; end; // Считываем редактор, используемый по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('Editor') then edDefTextEditor.Text := Reg.ReadString('Editor') else edDefTextEditor.Text := 'NOTEPAD '; finally Reg.CloseKey; end; // Задаем свойства try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('Asynchronous') then begin with CsShopper1 do begin Asynchronous := Reg.ReadBool('Asynchronous'); if Asynchronous then rgFTPMode.ItemIndex := 0 else rgFTPMode.ItemIndex := 1; end; end else begin CsShopper1.Asynchronous := FALSE; rgFTPMode.ItemIndex := 0; end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('Hints') then cbHints.Checked := Reg.ReadBool('Hints') else cbHints.Checked := FALSE; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('DTransferMode') then begin OldTransferMode := Reg.ReadString('DTransferMode'); if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[STREAM]) then begin CsShopper1.Transfer := STREAM; rgTransfer.ItemIndex := 0; end; if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[BLOCK]) then begin CsShopper1.Transfer := BLOCK; rgTransfer.ItemIndex := 1; end; if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[COMPRESSED]) then begin CsShopper1.Transfer := COMPRESSED; rgTransfer.ItemIndex := 2; end; end else begin OldTransferMode := UpperCase(FtpTransferStr[STREAM]); CsShopper1.Transfer := STREAM; rgTransfer.ItemIndex := 0; end; finally Reg.CloseKey; end; // Свойство файловой структуры try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('DFileStructure') then begin OldFileStruct := Reg.ReadString('DFileStructure'); if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[NOREC]) then begin CsShopper1.FileStruct := NOREC; rgFileStructure.ItemIndex := 0; end; if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[REC]) then begin CsShopper1.FileStruct := REC; rgFileStructure.ItemIndex := 1; end; if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[PAGE]) then begin CsShopper1.FileStruct := PAGE; rgFileStructure.ItemIndex := 2; end; end else begin OldFileStruct := UpperCase(FtpFileStructStr[NOREC]); CsShopper1.FileStruct := NOREC; rgFileStructure.ItemIndex := 0; end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('LastProfileUsed') then LastProfileUsed := Reg.ReadInteger('LastProfileUsed') else LastProfileUsed := 0; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('NoProfiles') then NoProfiles := Reg.ReadInteger('NoProfiles') else NoProfiles := 1; finally Reg.CloseKey; end; // Список профилей for Count := 0 to NoProfiles - 1 do begin ProfileName := Concat('ProfileName', IntToStr(Count)); try Reg.OpenKey(FtpClientKey + '\Profiles' + '\ ' + ProfileName, TRUE); if Reg.ValueExists('ProfileName') then ProfileNameList.Add(Reg.ReadString ('ProfileName')) else ProfileNameList.Add('PROFILE'); OldProfiles.Add(Reg.ReadString('ProfileName')); if Reg.ValueExists('Host') then HostNameList.Add(Reg.ReadString('Host')) else HostNameList.Add('HOST'); if Reg.ValueExists('User') then UserNameList.Add(Reg.ReadString('User')) else UserNameList.Add('ANONYMOUS'); if Reg.ValueExists('Password') then PasswordList.Add(Reg.ReadString('Password')) else PasswordList.Add('GUEST'); if Reg.ValueExists('RemoteDir') then RemoteDirList.Add(Reg.ReadString('RemoteDir')) else RemoteDirList.Add('\'); if Reg.ValueExists('LocalDir') then LocalDirList.Add('LocalDir') else LocalDirList.Add('\'); finally Reg.CloseKey; end; end; // цикл for Reg.Free; lbPrList.Items := ProfileNameList; lbPrList.ItemIndex := LastProfileUsed; edPrName.Text := ProfileNameList.Strings[lbPrList.ItemIndex]; edPrHostName.Text := HostNameList.Strings[lbPrList.ItemIndex]; edPrUserName.Text := UserNameList.Strings[lbPrList.ItemIndex]; edPrPassword.Text := PasswordList.Strings[lbPrList.ItemIndex]; edPrRemDir.Text := RemoteDirList.Strings[lbPrList.ItemIndex]; edPrLocDir.Text := LocalDirList.Strings[lbPrList.ItemIndex]; CsShopper1.UserName := edPrUserName.Text; CsShopper1.Password := edPrPassword.Text; lbPrList.Refresh; end; procedure TfrmMain.SaveProfiles; var Reg : TRegistry; Count : Integer; ProfileName : String; begin Reg := TRegistry.Create; try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteInteger('LastProfileUsed', LastProfileUsed); finally Reg.CloseKey; end; NoProfiles := lbPrList.Items.Count; try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteInteger('NoProfiles',NoProfiles); finally Reg.CloseKey; end; for Count := 0 to NoProfiles - 1 do begin ProfileName := Concat('ProfileName', IntToStr(Count)); try Reg.OpenKey(FtpClientKey + '\Profiles' + '\ ' + ProfileName, TRUE); Reg.WriteString('ProfileName', lbPrList.Items.Strings[Count]); Reg.WriteString('ProfileName', ProfileNameList.Strings[Count]); Reg.WriteString('Host', HostNameList.Strings[Count]); Reg.WriteString('User', UserNameList.Strings[Count]); Reg.WriteString('Password', PasswordList.Strings[Count]); Reg.WriteString('RemoteDir', RemoteDirList.Strings[Count]); Reg.WriteString('LocalDir', LocalDirList.Strings[Count]); finally Reg.CloseKey; end; end; Reg.Free; end; procedure TfrmMain.SaveOptions; var Reg : TRegistry; begin Reg := TRegistry.Create; // Сохраняем имя пользователя по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteString('UserName', edDefUserName.Text); finally Reg.CloseKey; end; // Сохраняем пароль по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteString('Password', edDefPassword.Text); finally Reg.CloseKey; end; // Сохраняем локальный каталог по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteString('DefLocalDir', edDefLocalDir.Text); finally Reg.CloseKey; end; // Сохраняем редактор, используемый по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteString('Editor', edDefTextEditor.Text); finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey,TRUE); case rgFTPMode.ItemIndex of 0 : Reg.WriteBool('Asynchronous',TRUE); 1 : Reg.WriteBool('Asynchronous',FALSE); end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if cbHints.Checked then Reg.WriteBool('Hints',TRUE) else Reg.WriteBool('Hints',FALSE); finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey,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(FtpClientKey,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; procedure TfrmMain.bbtnConnectClick(Sender: TObject); begin if (not UsedQFtp) and (not UsedProfile) then begin with CsShopper1 do begin HostName := HomeServer; if Status = Success then Start; end; end else if UsedQFtp then CsShopper1.Start else if UsedProfile then begin with CsShopper1 do begin UserName := edPrUserName.Text; Password := edPrPassword.Text; RemoteDir:= edPrRemDir.Text; LocalDir := edPrLocDir.Text; EditName := edDefTextEditor.Text; HostName := edPrHostName.Text; if Status = Success then Start; end; end; end; procedure TfrmMain.FormCreate(Sender: TObject); begin bbtnQuit.Enabled := FALSE; bbtnRefresh.Enabled := FALSE; bbtnViewFile.Enabled := FALSE; bbtnFtpCmds.Enabled := FALSE; bbtnAbort.Enabled := FALSE; rgFileType.Enabled := FALSE; gbMoreActions.Visible := FALSE; pbDataTransfer.Visible := FALSE; sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; OldProfiles := TStringList.Create; ProfileNameList := TStringList.Create; HostNameList := TStringList.Create; UserNameList := TStringList.Create; PasswordList := TStringList.Create; RemoteDirList := TStringList.Create; LocalDirList := TStringList.Create; LoadSettings; if CsShopper1.Asynchronous then begin sbStatus.Panels[2].Text := Concat('Mode : ', 'Asynchronous'); rgFTPMode.ItemIndex := 0; end else begin sbStatus.Panels[2].Text := Concat('Mode : ', 'Non-Asynchronous'); rgFTPMode.ItemIndex := 1; end; sbStatus.Panels[0].Text := Concat('Local Host : ', CsShopper1.LocalName); sbStatus.Panels[3].Text := Concat('Status : ', 'Idle'); pcShopper.ActivePage := tsProfiles; UpDate; end; procedure TfrmMain.bbtnFtpCmdsClick(Sender: TObject); begin gbMoreActions.Visible := not gbMoreActions.Visible; if gbMoreActions.Visible then begin bbtnFtpCmds.Hint := 'Click here to close the panel of FTP commands'; bbtnFtpCmds.Caption := 'Close'; end else begin bbtnFtpCmds.Hint := 'Click here to get more FTP commands'; bbtnFtpCmds.Caption := 'FTP Cmds'; end; end; procedure TfrmMain.CsShopper1Info(Sender: TObject; Msg: String); begin memLog.Lines.Add(Msg); end; procedure TfrmMain.CsShopper1UpDateList(Sender: TObject; List: TStringList); begin LbRemoteFiles.Items := List; lbRemoteFiles.UpDate; gbRemote.Caption := Concat('Files on ', CsShopper1.HostName); sbStatus.Panels[1].Text := Concat('Remote Host : ',CsShopper1.HostName); end; procedure TfrmMain.lbRemoteFilesDblClick (Sender: TObject); begin pbDataTransfer.Visible := TRUE; if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.Get := lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex] else pbDataTransfer.Visible := FALSE; end; procedure TfrmMain.CsShopper1List (Sender: TObject; List: TStringList); begin lbRemoteFiles.Clear; lbRemoteFiles.Items := List; lbRemoteFiles.UpDate; gbRemote.Caption := CsShopper1.RemoteDir; end; procedure TfrmMain.bbtnSiteClick(Sender: TObject); begin CsShopper1.SiteFtp; end; procedure TfrmMain.bbtnFTPHelpClick(Sender: TObject); var Counter : Integer; begin frmHelp := TfrmHelp.Create(Application); for Counter := SFtpUser to SFtpNoop do frmHelp.lbHelpFtpCmds.Items.Add (LoadStr(Counter)); frmHelp.ShowModal; CsShopper1.FtpHelp := HelpCmd; HelpFtpCmdList.Free; frmHelp.Free; end; procedure TfrmMain.CsShopper1Busy (Sender: TObject; BusyFlag: Boolean); begin if BusyFlag then begin lbRemoteFiles.Enabled := FALSE; sbStatus.Panels[3].Text := Concat('Status : ','Busy'); end else begin lbRemoteFiles.Enabled := TRUE; sbStatus.Panels[3].Text := Concat('Status : ','Idle'); end; Update; end; procedure TfrmMain.CsShopper1Progress (Sender: TObject; Position: Integer); begin pbDataTransfer.Position := Position; pbDataTransfer.UpDate; end; procedure TfrmMain.rgFileTypeClick (Sender: TObject); begin with CsShopper1 do case rgFileType.ItemIndex of 0 : FileType := ASCII; 1 : FileType := IMAGE; 2 : FileType := AUTO; end; end; procedure TfrmMain.CsShopper1FileType (Sender: TObject; FileType: TFileTypes); begin case FileType of ASCII : rgFileType.ItemIndex := 0; IMAGE : rgFileType.ItemIndex := 1; AUTO : rgFileType.ItemIndex := 2; end; end; procedure TfrmMain.CsShopper1Error (Sender: TObject; Status: TConditions; Msg: String); begin memLog.Lines.Add(Msg); end; procedure TfrmMain.bbtnNewDirClick (Sender: TObject); begin frmMkNewDir := TfrmMkNewDir.Create(Application); frmMkNewDir.ShowModal; if Length(NewDirName) > 0 then CsShopper1.MkDirName := NewDirName; frmMkNewDir.Free; end; procedure TfrmMain.bbtnDelDirClick(Sender: TObject); begin if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.RmDirName := emoteFiles.Items.Strings[lbRemoteFiles.ItemIndex]; CsShopper1.FilesList; end; procedure TfrmMain.CsShopper1Connect(Sender: TObject; sSocket: Integer); begin bbtnQuit.Enabled := TRUE; bbtnRefresh.Enabled := TRUE; bbtnViewFile.Enabled := TRUE; bbtnFtpCmds.Enabled := TRUE; rgFileType.Enabled := TRUE; if rgFTPMode.ItemIndex = 1 then begin sbbtnRetr.Enabled := TRUE; sbbtnStor.Enabled := TRUE; end else begin sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; end; bbtnConnect.Enabled := FALSE; bbtnExit.Enabled := FALSE; rgFTPMode.Enabled := FALSE; gbRemote.Caption := 'Remote : ' + CsShopper1.RemoteDir; sbStatus.Panels[1].Text := 'Remote Host : ' + CsShopper1.HostName; sbStatus.Panels[3].Text := 'Status : Connected'; Update; end; procedure TfrmMain.bbtnQuitClick(Sender: TObject); begin bbtnQuit.Enabled := FALSE; bbtnRefresh.Enabled := FALSE; bbtnViewFile.Enabled := FALSE; bbtnFtpCmds.Enabled := FALSE; bbtnAbort.Enabled := FALSE; rgFileType.Enabled := FALSE; sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; gbMoreActions.Visible := FALSE; pbDataTransfer.Visible := FALSE; bbtnConnect.Enabled := TRUE; bbtnExit.Enabled := TRUE; rgFTPMode.Enabled := TRUE; with sbStatus do begin Panels[1].Text := 'Remote Host : '; Panels[3].Text := 'Status : Idle'; end; lbRemoteFiles.Clear; Update; CsShopper1.Finish; end; (* procedure TfrmMain.Exit1Click(Sender: TObject); begin Close; end; *) procedure TfrmMain.rgFTPModeClick(Sender: TObject); begin if rgFTPMode.ItemIndex = 0 then begin CsShopper1.Asynchronous := TRUE; sbStatus.Panels[2].Text := 'Mode : ' + 'Asynchronous'; sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; end else begin CsShopper1.Asynchronous := FALSE; sbStatus.Panels[2].Text := 'Mode : ' + 'Non-Asynchronous'; sbbtnRetr.Enabled := TRUE; sbbtnStor.Enabled := TRUE; end; sbStatus.Update; end; procedure TfrmMain.bbtnRefreshClick(Sender: TObject); begin CsShopper1.FilesList end; procedure TfrmMain.sbbtnRetrClick(Sender: TObject); begin pbDataTransfer.Visible := TRUE; bbtnAbort.Enabled := TRUE; CsShopper1.MGet; end; procedure TfrmMain.sbbtnStorClick(Sender: TObject); begin pbDataTransfer.Visible := TRUE; bbtnAbort.Enabled := TRUE; CsShopper1.MPut; end; procedure TfrmMain.CsShopper1DataDone(Sender: TObject; Done: Boolean); begin if Done then begin pbDataTransfer.Visible := FALSE; bbtnAbort.Enabled := FALSE end else begin pbDataTransfer.Visible := TRUE; bbtnAbort.Enabled := TRUE end; pbDataTransfer.Update; end; procedure TfrmMain.bbtnStatClick(Sender: TObject); begin CsShopper1.Stat; end; procedure TfrmMain.bbtnRestartClick(Sender: TObject); begin ShowMessage('Not implemented in this version'); end; procedure TfrmMain.flbLocalDblClick(Sender: TObject); begin pbDataTransfer.Visible := TRUE; if flbLocal.ItemIndex <> -1 then CsShopper1.Put := flbLocal.Items.Strings[flbLocal.ItemIndex] else pbDataTransfer.Visible := FALSE; end; procedure TfrmMain.lbRemoteFilesClick(Sender: TObject); begin CsShopper1.RemoteFiles.Add (lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]); end; procedure TfrmMain.flbLocalClick(Sender: TObject); begin CsShopper1.LocalFiles.Add (flbLocal.Items.Strings[flbLocal.ItemIndex]); end; procedure TfrmMain.lbPrListDblClick(Sender: TObject); begin UsedProfile := TRUE; pcShopper.ActivePage := tsConnect; ActiveControl := bbtnConnect; bbtnConnect.Click; end; procedure TfrmMain.bbtnConnectMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbRight then // Выполняем упрощенный ftp begin UsedQFtp := TRUE; UsedProfile := FALSE; frmQuickFtp := TfrmQuickFTP.Create(Application); frmQuickFtp.ShowModal; with CsShopper1 do begin UserName := frmQuickFtp.edUserName.Text; Password := frmQuickFtp.edPassword.Text; HostName := frmQuickFtp.edHostName.Text; end; frmQuickFtp.Free; ActiveControl := bbtnConnect; bbtnConnect.Click; end else UsedQFtp := FALSE; end; procedure TfrmMain.bbtnViewFileClick(Sender: TObject); begin if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.View := lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]; end; procedure TfrmMain.bbtnAbortClick(Sender: TObject); begin CsShopper1.Abort; bbtnAbort.Enabled := FALSE; end; procedure TfrmMain.bbtnPrSaveClick(Sender: TObject); begin SaveProfiles; end; procedure TfrmMain.bbtnExitClick(Sender: TObject); begin OldProfiles.Free; ProfileNameList.Free; HostNameList.Free; UserNameList.Free; PasswordList.Free; RemoteDirList.Free; LocalDirList.Free; end; procedure TfrmMain.lbPrListClick(Sender: TObject); begin if lbPrList.ItemIndex <> -1 then begin LastProfileUsed := lbPrList.ItemIndex; edPrName.Text := ProfileNameList.Strings[LastProfileUsed]; edPrHostName.Text := HostNameList.Strings[LastProfileUsed]; edPrUserName.Text := UserNameList.Strings[LastProfileUsed]; edPrPassword.Text := PasswordList.Strings[LastProfileUsed]; edPrRemDir.Text := RemoteDirList.Strings[LastProfileUsed]; edPrLocDir.Text := LocalDirList.Strings[LastProfileUsed]; Update; end; end; procedure TfrmMain.bbtnPrNewClick(Sender: TObject); begin NewProfile := TRUE; edPrName.Text := ''; edPrHostName.Text := ''; edPrUserName.Text := edDefUserName.Text; edPrPassword.Text := edDefPassword.Text; edPrLocDir.Text := edDefLocalDir.Text; edPrRemDir.Text := '\'; lbPrList.Visible := FALSE; end; procedure TfrmMain.bbtnAddNewClick(Sender: TObject); begin ProfileNameList.Add(edPrName.Text); HostNameList.Add(edPrHostName.Text); UserNameList.Add(edPrUserName.Text); PasswordList.Add(edPrPassword.Text); RemoteDirList.Add(edPrRemDir.Text); LocalDirList.Add(edPrLocDir.Text); lbPrList.Items.Add(edPrName.Text); lbPrList.Visible := TRUE; lbPrList.refresh; NewProfile := FALSE; end; procedure TfrmMain.edPrNameExit(Sender: TObject); begin if (edPrName.Modified) and (not NewProfile) then begin lbPrList.Items.Strings[lbPrList.ItemIndex] := edPrName.Text; lbPrList.Refresh; ProfileNameList.Strings[lbPrList.ItemIndex] := edPrName.Text; end; end; procedure TfrmMain.edPrHostNameExit(Sender: TObject); begin if (edPrHostName.Modified) and (not NewProfile) then HostNameList.Strings[lbPrList.ItemIndex] := edPrHostName.Text; end; procedure TfrmMain.edPrUserNameExit(Sender: TObject); begin if (edPrUserName.Modified) and (not NewProfile) then UserNameList.Strings[lbPrList.ItemIndex] := edPrUserName.Text; end; procedure TfrmMain.edPrPasswordExit(Sender: TObject); begin if (edPrPassword.Modified) and (not NewProfile) then PasswordList.Strings[lbPrList.ItemIndex] := edPrPassword.Text; end; procedure TfrmMain.edPrRemDirExit(Sender: TObject); begin if (edPrRemDir.Modified) and (not NewProfile) then RemoteDirList.Strings[lbPrList.ItemIndex] := edPrRemDir.Text; end; procedure TfrmMain.edPrLocDirExit(Sender: TObject); begin if (edPrLocDir.Modified) and (not NewProfile) then LocalDirList.Strings[lbPrList.ItemIndex] := edPrLocDir.Text; end; procedure TfrmMain.bbtnPrDeleteClick(Sender: TObject); var Reg : TRegistry; Profile : String; begin Reg := TRegistry.Create; Profile := Concat('ProfileName',IntToStr (lbPrList.ItemIndex)); if Reg.DeleteKey(FtpClientKey + '\Profiles\' + Profile) then begin ProfileNameList.Delete(lbPrList.ItemIndex); HostNameList.Delete(lbPrList.ItemIndex); UserNameList.Delete(lbPrList.ItemIndex); PasswordList.Delete(lbPrList.ItemIndex); RemoteDirList.Delete(lbPrList.ItemIndex); LocalDirList.Delete(lbPrList.ItemIndex); lbPrList.Items.Delete(lbPrList.ItemIndex); edPrName.Clear; edPrHostName.Clear; edPrUserName.Clear; edPrRemDir.Clear; edPrLocDir.Clear; NoProfiles := lbPrList.Items.Count; lbPrList.Refresh; end; Reg.Free; end; procedure TfrmMain.bbtnLocateDefLocalDirClick (Sender: TObject); begin frmLocateDir := TfrmLocateDir.Create(Application); frmLocateDir.ShowModal; edDefLocalDir.Text := frmLocateDir.LocateDir; frmLocateDir.Free; end; procedure TfrmMain.bbtnLocateTxtEditorClick(Sender: TObject); begin frmLocateEditor := TfrmLocateEditor.Create (Application); frmLocateEditor.ShowModal; edDefTextEditor.Text := frmLocateEditor.EditorPath; frmLocateEditor.Free; end; procedure TfrmMain.BitBtn2Click(Sender: TObject); begin SaveOptions; end; end. Не забудьте предварительно включить CsSocket и CsShopper в палитру компонентов. Поместите компонент CsShopper на главную форму. Создайте на форме кнопку для каждой команды FTP. Например, кнопка Connect вызывает процедуру
CsShopper1.Start: procedure TfrmMain.bbtnConnectClick(Sender: TObject); begin
if (not UsedQFtp) and (not UsedProfile) then begin
with CsShopper1 do
begin
HostName := HomeServer;
if Status = Success then
Start;
end;
end else
if UsedQFtp then
CsShopper1.Start
else
if UsedProfile then
begin
with CsShopper1 do
begin
UserName := edPrUserName.Text;
Password := edPrPassword.Text;
RemoteDir:= edPrRemDir.Text;
LocalDir := edPrLocDir.Text;
EditName := edDefTextEditor.Text;
HostName := edPrHostName.Text;
if Status = Success then
Start;
end;
end;
end;
Профили SHOPPER32
Перед тем как подключаться к FTP-серверу с помощью программы SHOPPER32, вы должны создать на вкладке Profiles некий «профиль», включающий имя FTP-сервера, а также пользовательское имя и пароль для регистрации (см. рис. 6.4).
Профили сохраняются в системном реестре Windows и извлекаются из него перед регистрацией, чтобы вам не пришлось всякий раз вводить информацию для доступа к FTP-серверу.
Чтобы добавить новый профиль, нажмите кнопку New; при этом стирается содержимое всех текстовых полей на вкладке Profiles. Затем введите имя профиля, имя FTP-сервера, имя пользователя и пароль в текстовых полях edPrName, edPrHostName, edPrUserName и edPrPassword соответственно. Для анонимной регистрации следует ввести в поле edPrUserName строку anonymous, а в поле edPrPassword — ваш адрес электронной почты.

Рис. 6.4. Типичный вид профиля на вкладке Profiles
Нажмите кнопку Add, чтобы внести профиль в список, и затем сохраните новые данные в реестре кнопкой Save. Если потребуется удалить профиль из реестра, выделите его имя в списке Profiles и нажмите кнопку Delete. Чтобы подключиться к FTP-серверу, щелкните на имени профиля в списке Profiles, перейдите на вкладку Connect и нажмите кнопку Connect. Существует и другой, более удобный способ — дважды щелкнуть на имени профиля в списке. При этом автоматически активизируется вкладка Connect, и на ней нажимается кнопка Connect, как показано в следующем фрагменте обработчика события OnDblClick для списка
lbPrList: procedure TfrmMain.lbPrListDblClick(Sender: TObject);
begin
UsedProfile := TRUE;
pcShopper.ActivePage := tsConnect; ActiveControl := bbtnConnect; bbtnConnect.Click;
end;
Чтобы процесс регистрации стал еще проще, мы сохраняем информацию о локальном и удаленном каталогах в текстовых полях edPrLocDir и edPrRemDir соответственно. CsShopper пользуется этой информацией для автоматиче ского, не требующего вмешательства пользователя, перехода к нужному каталогу.
Чтобы обратиться к редко используемому FTP-серверу, для которого нет смысла заводить специальный профиль, активизируйте кнопку Connect (на вкладке Connect) и щелкните на ней правой кнопкой мыши — на экране появится диалоговое окно Quick FTP. В нем следует ввести имя пользователя и пароль. Значения по умолчанию берутся с вкладки Options. Если они окажутся подходящими, вы сразу же начинаете сеанс работы кнопкой OK.
Замечание
Для получения доступа к некоторым FTP-серверам и выполнения некоторых FTP-команд (например, удаления каталога командой RMD) необходимо ввести информацию об используемом ресурсе (она посылается серверу командой ACCT). Если вы хотите работать с таким сервером, придется добавить на вкладку Profiles дополнительное текстовое поле и изменить компонент CsShopper для посылки команды ACCT с соответствующей информацией.

Slice спешит на помощь

Похоже, объявление «с запасом» нас не спасет. Так как же передать динамические данные этим, во всех остальных отношениях замечательным функциям? Ответ кроется в малоизвестной функции Slice, спрятанной в модуле System:
function Slice(var A: array; Count: Integer): array;
Slice получает массив любого размера и тип и возвращает Count элементов так, словно они являются отдельным и независимым массивом. С помощью Slice можно объявить очень большой массив и использовать в нем лишь
нужное количество элементов.
Функция Slice возрождает идею объявления «с запасом», но на этот раз нам уже не придется заботиться о неправильном знаменателе. А это в свою очередь позволит передавать функциям динамические данные.
Вооружившись новыми знаниями, мы переходим к созданию быстрого и удобного компонента для статистической обработки данных.

Смысловые оттенки

А где-то на другом конце города в разбитое окно убогой комнаты занесло выхлопные газы последнего автобуса, отъезжающего в Бэйпорт. Не обращая внимания на уличный шум, загадочная фигура потянулась к уголку Дневника и перевернула очередную страницу.
Дневник №16, 21 марта. Сегодня ко мне обратился новый клиент — человек по имени Барри Маунтбенк. Он занимается «раскруткой» перспектив ного политика и хочет, чтобы я написал специальный текстовый редактор, который мог бы создавать различные описания для одних и тех же событий в зависимости от того, откуда подует ветер.
Я решил, что было бы полезно написать демонстрационную программу, которая покажет, как в Delphi-приложении организовать фильтрацию и преобразование нажатых клавиш, чтобы преобразовать их к требуемому виду. Когда я предложил это клиенту, он загорелся энтузиазмом.
Методика чрезвычайно проста. Объект Application умеет обрабатывать событие OnMessage, с помощью которого можно подключиться непосредственно к цепочке сообщений для всех компонентов приложения.
Я решил создать несложную программу, которая бы демонстрировала три основных положения:

Подменить одну нажатую клавишу другой несложно.

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

Замену клавиш можно включать и выключать «на ходу».

На рис. 14.3 изображен созданный мной пример с двумя формами. При установке соответствующего переключателя режим фильтрации включается или выключается. При включенной фильтрации прописная буква «a» меняется на строчную, и наоборот, клавиша Backspace работает как Delete, а клавиши Delete и Shift+F5 выполняют прежнюю функцию клавиши Backspace. Исходный текст программы содержится в файлах KSMAIN.PAS и KSFORM2.PAS (см. листинги 14.7 и 14.8).

Рис. 14.3. Фильтрация нажатых клавиш
Листинг 14.7. Главная форма демонстрационной программы для замены символов
{——————————} {Замена символов (демонстрационная программа)} {KSMAIN.PAS : Главная форма } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } { Приложение, демонстрирующее возможности } {избирательной фильтрации и замены символов, } { вводимых с клавиатуры. } { } { Написано для *High Performance Delphi 3 } Programming* } { Copyright (c) 1997 The Coriolis } Group, Inc. } { Дата последней редакции 22/4/97 } {————————} unit KsMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, KSForm2, ExtCtrls; type TForm1 = class(TForm) ExitBtn: TButton; ShowBtn: TButton; Form1Memo: TMemo; Bevel1: TBevel; KeyHandlerRBGroup: TRadioGroup; procedure FormCreate(Sender: TObject); procedure ExitBtnClick(Sender: TObject); procedure ShowBtnClick(Sender: TObject); private procedure OnAppMessage(var Msg : TMsg; var Handled : Boolean); public { Public declarations } end; const Shifted : Boolean = False; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.OnAppMessage(var Msg : TMsg; var Handled : Boolean); begin if KeyHandlerRBGroup.ItemIndex = 1 then with Msg do begin case Message of WM_KEYDOWN : begin case WParam of VK_SHIFT : Shifted := True; VK_F5 : if Shifted then WParam := VK_BACK; VK_DELETE : WParam := VK_BACK; VK_BACK : WParam := VK_DELETE; end; { case } end; WM_CHAR : begin case chr(WParam) of "a" : WParam := ord("A"); "A" : WParam := ord("a"); end; { case } end; WM_KEYUP : begin case WParam of VK_SHIFT : Shifted := False; end; { case } end; end; { case } end; { with } end; procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage := OnAppMessage; KeyHandlerRBGroup.ItemIndex := 0; end; procedure TForm1.ExitBtnClick(Sender: TObject); begin Close; end; procedure TForm1.ShowBtnClick(Sender: TObject); begin Form2.Show; end; end. Листинг 14.8. Вспомогательная форма демонстрационной программы
для замены символов
{—————————} {Замена символов (демонстрационная программа) } {KSFORM2.PAS : Вспомогательная форма } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } {Приложение, демонстрирующее возможности } {избирательной фильтрации и замены символов, } {вводимых с клавиатуры. } { } {Написано для *High Performance Delphi 3 } {Programming* } {Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 22/4/97 } {————————} unit KsForm2; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm2 = class(TForm) CloseBtn: TButton; Bevel1: TBevel; Form2Memo: TMemo; procedure CloseBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.DFM} procedure TForm2.CloseBtnClick(Sender: TObject); begin Close; end; end. Кроме того, я заглянул в исходный текст объекта TApplication и посмотрел, как в нем организована обработка сообщений по умолчанию и как написан ный мной обработчик события OnMessage участвует в этом процессе. Точнее, меня интересовало, что я должен делать с переменной Handled, передаваемой обработчику событий? В листинге 14.9 приведен исходный текст метода ProcessMessage класса TApplication, вызываемого в бесконечном цикле обработ ки сообщений приложения.
Листинг 14.9. Исходный текст метода ProcessMessage класса TApplication
function TApplication.ProcessMessage: Boolean; var Handled: Boolean; Msg: TMsg; begin Result := False; if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin Result := True; if Msg.Message <>WM_QUIT then begin Handled := False; if Assigned(FOnMessage) then FOnMessage (Msg, Handled); if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then begin TranslateMessage(Msg); DispatchMessage(Msg); end; end else FTerminate := True; end; end; Из листинга 14.9 становится ясно, откуда взялась переменная Handled. Как нетрудно убедиться, метод ProcessMessage вызывается для обнаружения и обработки сообщений, находящихся в очереди. Обнаруженное сообщение удаляется из очереди. Если это сообщение WM_QUIT, переменной FTerminate присваивается значение True; в противном случае Handled присваивается False и вызывается обработчик OnMessage (если он был определен). Если при возвращении из него переменная Handled остается равной False и сообщение не относится к некоторым категориям (сообщения подсказок, сообщения MDI, уведомляющее сообщение от элемента или диалоговое сообщение), для обработки вызываются стандартные процедуры TranslateMessage и DispatchMessage. Очевидно, если переменной Handled в обработчике события OnMessage присвоить значение True, дальнейшая обработка сообщения прекращается. Я хочу заменить одну нажатую клавишу другой и продолжить обработку. Следовательно, значение переменной Handled не должно изменяться.
Мой обработчик OnMessage устроен достаточно просто. Если установлен переключатель Filtered, оператор case отбирает нужные сообщения и заменяет клавиши, при этом для управляющих символов используются константы виртуальных клавиш, определенные в Windows. Следует обратить внимание на один момент: клавиши, нажимаемые в сочетании с Alt, Ctrl и Shift, опознаются в два этапа. Поскольку процедура получает всего одну клавишу, она не знает, какие из управляющих клавиш были при этом нажаты. Мне пришлось отдельно обрабатывать нажатия и отпускания управляющих клавиш. Для этого я ищу константу VK_SHIFT в параметре wParam, передаваемом с сообщениями WM_KEYDOWN и WM_KEYUP, и в случае ее обнаружения — сохраняю информацию о регистре в логической переменной.
Обработчик OnMessage принадлежит приложению, а не главной форме, так что он не задается в виде свойства в режиме конструирования. Вместо этого он подключается во время выполнения в обработчике OnCreate главной формы.
Конец записи (21 марта).

Сначала построить, потом выводить

В первом воплощении этой программы за отображение ландшафта отвечала та же рекурсивная функция, в которой он рассчитывался. Если аргумент Plys (число итераций) превышал 1, функция разбивала полученный в качестве параметра треугольник на четыре новых, затем уменьшала Plys и вызывала себя для каждого из полученных треугольников. Когда аргумент Plys достигал 1, вызывалась функция, которая рисовала треугольник на экране.
Такой алгоритм выглядит достаточно просто, но при переходе от «каркасного» отображения к заполненным треугольникам приходилось заново генерировать весь ландшафт. Кроме того, применение этого алгоритма в Windows-программе означает, что ландшафт будет заново генерироваться при каждом изменении размеров окна. Очевидно, более разумный подход — сначала рассчитать ландшафт, а затем вывести его на экран. Это потребует проведения двух независимых рекурсий от внешнего треугольника до самых внутренних (которые, собственно, и отображаются на экране), но вторая рекурсия обходится достаточно дешево по сравнению с процессом отображения, так что цена подобной гибкости оказывается вполне приемлемой.

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

Чтобы субклассировать окно, необходимо получить и сохранить указатель на существующую оконную процедуру, а затем занести в структуру данных окна указатель на новую оконную процедуру. Для этого использу ются функции Windows API GetWindowLong и SetWindowLong, реализующие доступ к информации, хранящейся во внутренней структуре данных окна.
Если субклассирование пройдет успешно, Windows будет посылать все сообщения, предназначенные для данного окна, новой оконной процедуре. Процедура должна обработать те сообщения, которые ее интересуют (в нашем случае WM_DROPFILES), и передать все остальные сообщения старой оконной процедуре, адрес которой был сохранен при субклассировании. При этом вы не можете просто вызвать старую процедуру — вместо этого
придется вызвать функцию API CallWindowProc, передав ей адрес старой оконной процедуры вместе с параметрами, полученными от Windows.
Субклассирование следует завершить десубклассированием — то есть вернуть все в прежнее состояние. Десубклассирование сводится к повторному вызову SetWindowLong, но на этот раз новая оконная процедура заменяется старой.
На самом деле все не так страшно, как может показаться. После того как вы изрядно поломаете голову над примерами и несколько раз «подвесите» Windows, все становится просто и понятно (насколько вообще может быть понятным программирование для Windows).
В листинге 3.7 содержится новый модуль FMDD с поддержкой субкласси рования.
Листинг 3.7. Новый вариант модуля FMDD
с поддержкой субклассирования
{
FMDD2.PAS — Полностью инкапсулированный модуль FMDD
Автор: Джим Мишель
Дата последней редакции: 27/04/97
} unit fmdd2; 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); implementation uses ShellAPI; type { В TSubclassItem хранится информация о субклассированном окне } TSubclassItem = class (TObject) private Handle : HWND; { Логический номер окна } WindowProc : TFNWndProc; { Старая оконная процедура } FOnDrop : TFMDDEvent; { Обработчик события OnFMDragDrop элемента } public constructor Create (AHandle : HWND; AWndProc : TFNWndProc; AOnDrop : TFMDDEvent); end; var SubclassList : TList; constructor TSubclassItem.Create (AHandle : HWND; AWndProc : TFNWndProc; AOnDrop : TFMDDEvent); begin inherited Create; Handle := AHandle; WindowProc := AWndProc; FOnDrop := AOnDrop; end; { WMDragDrop создает объект TDragDropInfo и вызывает обработчик FOnDrop. } procedure WMDragDrop (hDrop : THandle; FOnDrop : TFMDDEvent); var DragDropInfo : TDragDropInfo; TotalNumberOfFiles, nFileLength : Integer; pszFileName : PChar; i : Integer; begin if not assigned (FOnDrop) then exit; { hDrop - логический номер внутренней структуры данных Windows, содержащей информацию о брошенных файлах. } { Определяем общее количество брошенных файлов, передавая DragQueryFile индексный параметр -1 } TotalNumberOfFiles := DragQueryFile (hDrop , $FFFFFFFF, Nil, 0); DragDropInfo := TDragDropInfo.Create (TotalNumberOfFiles); { Проверяем, были ли файлы брошены в клиентской области } DragDropInfo.FInClientArea := DragQueryPoint (hDrop, DragDropInfo.FDropPoint); for i := 0 to TotalNumberOfFiles - 1 do begin { Определяем длину имени файла — сообщаем DragQueryFile о том, какой файл нас интересует ( i ), и передаем Nil вместо длины буфера. Возвращаемое значение равно длине имени файла. } nFileLength := DragQueryFile (hDrop, i , Nil, 0) + 1; GetMem (pszFileName, nFileLength); { Копируем имя файла — сообщаем DragQueryFile о том, какой файл нас интересует ( i ), и передаем длину буфера. ЗАМЕЧАНИЕ: Проследите за тем, чтобы размер буфера на 1 байт превышал длину имени, чтобы выделить место для завершающего строку нулевого символа! } DragQueryFile (hDrop , i, pszFileName, nFileLength); { Заносим файл в список } DragDropInfo.FFileList.Add (pszFileName); { Освобождаем выделенную память... } FreeMem (pszFileName, nFileLength); end; { Вызываем DragFinish, чтобы освободить память, выделенную Shell для данного логического номера. ЗАМЕЧАНИЕ: Об этом шаге нередко забывают, в результате возникает утечка памяти, а программа начинает медленнее работать. } DragFinish (hDrop); { Вызываем обработчик события... } FOnDrop (DragDropInfo); { ...и уничтожаем объект TDragDropInfo } DragDropInfo.Free; end; { FindItemInList находит и возвращает элемент списка, соответствующий передаваемому логическому номеру окна } function FindItemInList (Handle : HWND) : TSubclassItem; var i : Integer; Item : TSubclassItem; begin for i := 0 to SubclassList.Count - 1 do begin Item := SubclassList.Items[i]; if Item.Handle = Handle then begin Result := Item; exit; end; end; Result := Nil; end; { FMDDWndProc обрабатывает сообщения WM_DROPFILES, вызывая WMDragDrop. Все прочие сообщения передаются старой оконной процедуре. } function FMDDWndProc ( Handle : HWND; Msg : UINT; wparam: WPARAM; lparam: LPARAM) : LRESULT; stdcall; var Item : TSubclassItem; begin Item := FindItemInList (Handle); if Item <> Nil then begin if Msg = WM_DROPFILES then begin WMDragDrop (wparam, Item.FOnDrop); Result := 0; end else Result := CallWindowProc (Item.WindowProc, Handle, Msg, wparam, lparam) end else Result := 0; end; { AcceptDroppedFiles субклассирует окно элемента и сохраняет информацию для последующего использования. } procedure AcceptDroppedFiles (Control : TWinControl; AOnDrop : TFMDDEvent); var WndProc : TFNWndProc; begin DragAcceptFiles (Control.Handle, True); { Получаем старую оконную процедуру } WndProc := TFNWndProc(GetWindowLong (Control.Handle, GWL_WNDPROC)); { Подключаем новую оконную процедуру... } SetWindowLong (Control.Handle, GWL_WNDPROC, Longint (@FMDDWndProc)); { ... и добавляем ее в список } SubclassList.Add ( TSubclassItem.Create (Control.Handle, WndProc, AOnDrop)); end; { UnacceptDroppedFiles прекращает субклассирование окна и удаляет его из списка. } procedure UnacceptDroppedFiles (Control : TWinControl); var Item : TSubclassItem; begin { Прекращаем прием файлов } DragAcceptFiles (Control.Handle, False); Item := FindItemInList (Control.Handle); if Item <> Nil then begin { Восстанавливаем старую оконную процедуру } SetWindowLong (Control.Handle, GWL_WNDPROC, Longint (Item.WindowProc)); { Удаляем элемент из списка... } SubclassList.Remove (Item); { ... и уничтожаем его } Item.Free; end; end; { TDragDropInfo } constructor TDragDropInfo.Create (ANumFiles : UINT); begin inherited Create; FNumFiles := ANumFiles; FFileList := TStringList.Create; end; destructor TDragDropInfo.Destroy; begin FFileList.Free; inherited Destroy; end; initialization SubclassList := TList.Create; finalization SubclassList.Free; end. Если вам уже приходилось заниматься субклассированием, может возникнуть вопрос — почему я не сохранил старую оконную процедуру (или хотя бы указатель на объект TSubclassItem) в поле GWL_USERDATA структуры данных окна? Такая возможность приходила мне в голову, но я отверг ее из тех же соображений, из которых критиковал цепочечную обработку Application.OnMessage, — никогда нельзя предсказать, как поведет себя другая программа. Если FMDD будет работать с GWL_USERDATA, то любой элемент, которому понадобится FMDD, не сможет использовать это поле для своих нужд. Это ограничение мне не понравилось, и я перешел к списку структур TList. Он позволяет создать более гибкую реализацию ценой небольшого снижения производительности (за счет времени, необходимо го для поиска объекта в списке). Обработка сообщений Windows обычно не относится к числу операций, критичных по скорости, поэтому небольшие расходы времени на просмотр списка никак не скажутся на работе программы. Оставьте GWL_USERDATA для пользовательских данных, а для хранения указателя на оконную процедуру поищите другой способ.
С готовым модулем FMDD можно создавать приложения, в которых бросаемые файлы принимаются несколькими формами, или даже формы, в которых файлы принимаются двумя или несколькими различными элементами. Программа Drag3 (см. рис. 3.2) демонстрирует одну из таких форм. Сама по себе форма не принимает бросаемые файлы — это делают отдельные компоненты-списки, находящиеся на ней. Запустите программу и проверьте все сами. Исходный текст модуля DRAGFRM3.PAS приведен в листинге 3.8.

Рис. 3.2. Форма с двумя списками, которые принимают сбрасываемые файлы
Листинг 3.8. Модуль DRAGFRM3.PAS
{
DRAGFRM3.PAS — Прием файлов несколькими элементами
Автор: Джим Мишель
Дата последней редакции: 27/04/97
} unit dragfrm3; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, { FMDD определяет интерфейс перетаскивания } FMDD2; type TForm1 = class(TForm) ListBox1: TListBox; Button1: TButton; Button2: TButton; Label1: TLabel; Label2: TLabel; ListBox2: TListBox; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } procedure OnListbox1FMDragDrop (DragDropInfo : TDragDropInfo); procedure OnListbox2FMDragDrop (DragDropInfo : TDragDropInfo); procedure ProcessDroppedFiles (lb : TListBox; DragDropInfo : TDragDropInfo); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin FMDD2.AcceptDroppedFiles (Listbox1, OnListbox1FMDragDrop); FMDD2.AcceptDroppedFiles (Listbox2, OnListbox2FMDragDrop); end; procedure TForm1.ProcessDroppedFiles (lb : TListBox; DragDropInfo : TDragDropInfo); var i : Integer; begin { Проверяем, были ли файлы брошены в клиентской области } if DragDropInfo.InClientArea then Label2.Caption := "In client area" else Label2.Caption := "Not in client area"; { Заносим все файлы в список } for i := 0 to DragDropInfo.NumFiles - 1 do begin lb.Items.Add (DragDropInfo.Files[i]); end; end; procedure TForm1.OnListbox1FMDragDrop (DragDropInfo : TDragDropInfo); begin ProcessDroppedFiles (Listbox1, DragDropInfo); end; procedure TForm1.OnListbox2FMDragDrop (DragDropInfo : TDragDropInfo); begin ProcessDroppedFiles (Listbox2, DragDropInfo); end; procedure TForm1.FormClose (Sender: TObject; var Action: TCloseAction); begin { Прекращаем прием файлов } FMDD2.UnacceptDroppedFiles (Listbox1); FMDD2.UnacceptDroppedFiles (Listbox2); end; procedure TForm1.Button1Click(Sender: TObject); begin Listbox1.Clear; Listbox2.Clear; end; procedure TForm1.Button2Click(Sender: TObject); begin Close; end; end. Вот теперь это похоже на Delphi-программу — никакой возни с логическими номерами и оконными процедурами. Все делается с помощью компонентов и обработчиков событий, как и положено программам, написанным в Delphi. Все страшные подробности спрятаны в FMDD — вне поля зрения прикладного программиста, который хочет получить брошенные файлы, но совершенно не желает возиться с циклом сообщений Windows.
Поймите меня правильно — я твердо верю в силу знаний, и по мере знакомства с тем, что происходит «под капотом» Windows и Delphi, вы наверняка придумаете и другие решения этой проблемы. Но если задача уже решена, стоит ли повторять все заново? На проектирование и реализацию хорошей «упаковки» для какого-либо средства Windows (в нашем случае — перетаски вания) потребуется некоторое время, но зато потом вы сможете пользоваться ей в любом приложении, избавившись от необходимости снова залезать в дебри Windows.

Снова в конторе Эйса

Эйс был настолько поглощен пропажей Дневника, что даже не заметил, как сквозь жалюзи начал пробиваться утренний свет. Расхаживая по маленькой комнате, Эйс едва не протер в ковре дыру, но так и не приблизился к разгадке ни на шаг.
В полном отчаянии он рухнул в кресло. «Если я действительно хороший сыщик, то почему не могу решить такую простую загадку?»— подумал он. За последние девять часов он тысячу раз вспоминал, как все произошло, но ответы упорно не появлялись. Сплошные вопросы. Он даже обшарил комнату в поисках отпечатков пальцев, но не нашел ничьих следов, кроме собственных. Ни единой зацепки.
Эйс больше часа просидел в кресле, погруженный в уныние. Пропал его Дневник, хранилище всех технических знаний, накопленных за время работы с Delphi. Кто-то неизвестный читает сейчас плоды его тайного вдохнове ния, его самые сокровенные мысли. Эйс почувствовал себя абсолютно беспомощным. По всей вероятности, ему уже никогда не суждено увидеть свой дневник. «Хоть бы какой-нибудь проблеск надежды…» — подумал он.
И вдруг его глаза широко раскрылись. Проблеск действительно был. Он видел его прошлой ночью, когда фары скользнули по кустам во время поспешного отъезда из офиса. Эйс вспомнил два крошечных отражения, которые могли означать лишь одно — человеческие глаза!
Бывший сыщик вскочил на ноги. Если там действительно кто-то стоял, на мягкой, влажной земле могли остаться следы! Он помчался наружу, однако во время тщательного осмотра земли вокруг кустов его отвлек знакомый голос.
— Привет, сосед.
Эйс повернулся.
— Ммм… привет, Мардж, — ответил он. — Я не слышал, как ты подошла.
Мардж Рейнольдс — сварливая вдова средних лет, активный сторонник движения «Сохраним искусство вязания!» Она уже два года жила по соседству с Эйсом, а ее кошка Чармин была одной из самых страстных поклонниц Мьюникса. Мардж была в курсе всех местных сплетен, а ее взгляд был постоянно прикован к щелке между занавесками, которые она никогда не задергивала полностью. От ее внимания не ускользало ничего.
— Ищешь что-нибудь конкретное? — спросила она, стрельнув глазами из-под накидки болотного цвета.
Эйс решил довериться ей и поведал свою печальную историю. Мардж особенно заинтересовалась тем человеком, которого вроде бы видел Эйс.
— Знаешь, — сказала она задумчиво, — когда прошлым вечером я открыла дверь и выпустила Чармин на улицу, в кустах рядом с дверью стоял какой-то человек. Когда я спросила его, что он здесь делает в такое время, он тут же сбежал. Наверняка это был тот, которого ты заметил.
— Во сколько это было? — поинтересовался Эйс.
— Думаю, часов в десять или полодиннадцатого, — ответила она.
— Ты можешь описать его?
— Довольно высокий и худой. Носит длинный плащ и шляпу, полностью закрывающую лицо. Он что-то держал в руке — то ли инструмент, то ли оружие. Знаешь, его мог видеть кто-нибудь еще. Думаю, стоит спросить управляющего.
— Превосходная мысль!
Они пересекли стоянку и подошли к конторе управляющего. Однако дверь была широко распахнута, а внутри никого не было! После обмена вопросительными взглядами Мардж выразила вслух мысль, тревожившую их обоих.
— Я бы хотела, чтобы здесь сейчас оказались Фрэнк и Джо Харди, — сказала она озабоченно.

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

Создать консольное приложение не так уж сложно, но при этом все же приходится помнить о некоторых нюансах. Поэтому, вместо того чтобы каждый раз строить приложение на пустом месте (и благополучно забывать об этих нюансах), давайте сохраним программу Hello в хранилище объектов, чтобы у нас появилась отправная точка для создания других консольных приложений.
С помощью Windows Exploder (в Windows NT 3.51 мы любили называть эту программу File Mangler) создайте подкаталог ConsoleApp в подкаталоге Objrepos основного каталога Delphi. Если вы установили Delphi со стандарт ными параметрами, полный путь будет выглядеть так:
C:\Program Files\Borland\Delphi 3\Objrepos\ConsoleApp
Затем выполните команду Project <> Save Project As из меню Delphi и сохрани те проект под именем ConsoleApp.dpr (хорошая штука - длинные имена!) в только что созданном каталоге.
После того как проект будет сохранен, включите его в хранилище командой Project д Add to Repository, после чего заполните диалоговое окно Add to Repository (см. рис. 1.1).

Рис. 1.1. Шаблон консольного приложения добавляется в хранилище
После того как проект будет добавлен в хранилище, попробуйте выполнить команду File <> New в меню Delphi, перейдите на вкладку Projects в диалоговом окне New Items и дважды щелкните на значке Console Application. Delphi предложит указать каталог и создаст новый проект с параметрами, заранее настроенными для консольного приложения.
Замечание
Я так и не решил, стоит ли держать свои объекты непосредственно в каталогах хранилища Delphi. Это довольно удобно, но любое обновление версии Delphi может обернуться неприятностями. Скорее всего, при обновлении каталог Objrepos будет удален - вместе со всеми замечательными объектами, которые в нем находятся. Вам придется вручную сохранять их перед каждым обновлением.
Существует и другой вариант - создать собственный каталог-хранилище, не принадлежа щий основному каталогу Delphi. В любом случае при обновлении Delphi вам придется заново включать объекты в хранилище, но отдельный каталог по крайней мере защитит ваши проекты от случайного удаления.

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

Теперь мы располагаем средствами для изменения практически любой составляющей пользовательского интерфейса. Желательно найти способ сохране ния этих изменений, чтобы они становились постоянными. Пользователь вряд ли обрадуется, если ему придется заново настраивать интерфейс при каждом запуске приложения! Возникает искушение решить проблему с помощью INI-файлов (или, для самых смелых — системного реестра Windows 95), но оба способа обладают серьезными недостатками. Проблема заключается в том, что каждый компонент обладает множеством свойств различных типов, и вам не удастся написать обобщенный метод Save_This_Component.
Теоретически можно проверять тип каждого компонента и затем сохранять свойства, относящиеся к данному типу. Но, согласитесь, такой вариант не слишком эффективен. С другой стороны, можно сохранять лишь общие свойства всех компонентов. Поскольку тип TComponent — предок всех остальных компонентов — имеет лишь девять свойств (не считая Left, Top, Width и Height), это тоже бесполезно.
Но не все потеряно! Существует несколько очень хороших механизмов сохранения и загрузки свойств компонентов. Нужно лишь покопаться в документации Borland и немного поэкспериментировать.
Конечная цель этих раскопок — семейство объектов TFiler/TWriter/TReader. Согласно справочным файлам Delphi, TFiler — «абстрактный базовый класс для объектов чтения и записи, которые используются Delphi для сохранения (и загрузки) форм и компонентов в DFM-файлах».
В этом определении сказано нечто очень важное для нас, а именно: объекты TWriter и TReader могут использоваться для сохранения и загрузки свойств компонента. Связывая экземпляр класса TWriter или TReader с потоком TFile Stream, мы сможем воспользоваться методами WriteRootComponent и ReadRoot Component для решения своей проблемы.

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

STOR — зеркальное отражение команды RETR. Вместо того чтобы передавать файл клиенту, CsKeeper сохраняет (stores) полученный файл, отсюда и название команды. При получении компонентом CsKeeper команды STOR процедура DecodeFTPCmd анализирует командную строку и переходит к ветви STOR оператора case, в котором обрабатываются различные команды. Если значение FUpLoads равно TRUE (помните, мы можем запретить передачу файлов на сервер, снимая соответствующий флажок на вкладке Options), вызывается метод TCsKeeper.GetFile. В противном случае DecodeFTPCmd посылает отрицательный ответ с кодом 500.
TCsKeeper.GetFile создает для соединения данных локальный сокет с именем LocalSocket; для этого используется вызов функции connect, входящей в Winsock API:
if connect (LocalSocket, DataS, SizeOf(TSockAddrIn))= SOCKET_ERROR then
{ продолжение... }
После открытия файла мы сохраняем поступающие данные в цикле while…do с помощью функций recv (Winsock API) и BlockWrite:
while not Finished do
begin
Response := recv(LocalSocket, Buffer, SizeOf(Buffer), 0);
{ пропуск... }
if Response > 0 then
BlockWrite(F, Buffer, Response);
end;
После того как все данные от клиента будут приняты, TCsKeeper.GetFile закрывает установленное через LocalSocket соединение данных и передает клиенту положительный код ответа 226 с помощью процедуры SendFtpCode.

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

Зловещая фигура склонилась над книгой и продолжала читать.
Дневник №16, 29 марта. В сегодняшней почте среди счетов я нашел приглашение на свадьбу наших старых друзей — пары, с которой мы с Хелен познакомились еще в колледже. Текст гласил: «Приходи и раздели с нами
это радостное событие».
Бросив открытку на стол, я подумал о том, что «разделять события» можно и по-другому — например, за счет использования общих обработчиков для событий, требующих похожих действий.
Я решил написать простое приложение для исследования этой концепции. После некоторых размышлений я придумал программу «Список неотложных дел», которая развивает демонстрационную программу перетаскивания, написанную несколько дней назад.
Новая программа (как и ее предыдущий вариант) содержит текстовое поле для ввода заметок. Но вместо календаря я создал три отдельные сетки — для утренних, дневных и вечерних дел. Эти сетки находятся на отдельных вкладках окна. Модель формы в режиме конструирования изображена на рис. 16.1.

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

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

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

Создание DLL

По своей концепции DLL больше похожи на модули, но их код скорее напоминает программы. В этом нет ничего удивительного, ведь DLL— всего лишь особая разновидность программ, предоставляющих код или данные для работы других программ. В листинге 2.1 приведена простейшая DLL с единственной функцией BeepMe. При вызове этой функции компьютер всего лишь выдает звуковой сигнал.
Листинг 2.1. Простейшая DLL
{ BEEPER.DPR — пример простейшей DLL Автор: Джим Мишель Дата последней редакции: 12/05/97 } library beeper; uses Windows; procedure BeepMe; stdcall; begin MessageBeep (0); end; Exports BeepMe index 1 name "BeepMe"; begin end. DLL начинаются с ключевого слова library вместо привычного program или unit. В них также имеется оператор uses. Также обратите внимание — DLL, как и программы, не имеют отдельных секций interface и implementation. Процедуры и функции DLL пишутся точно так же, как и процедуры/функ ции программ, но их необходимо явным образом экспортировать (используя ключевое слово Exports), чтобы они стали доступны для других программ.
Присутствие ключевого слова stdcall необязательно, но его все же стоит включать. Экспортированные функции DLL, имеющие модификатор stdcall, совместимы с другими языками программирования (например, C++), которые могут обращаться к DLL. Наличие stdcall никак не отражается на работе экспортированных функций. Я рекомендую включать stdcall, если экспортированные функции могут вызываться из программ, написанных на C/C++.
Ключевое слово Exports сообщает компилятору, какие функции должны быть доступны для других программ. В своем примере я экспортировал процедуру BeepMe по имени и порядковому номеру — и то и другое является необязательным. Несколько экспортируемых функций могут разделяться запятыми. Следовательно, если в DLL входит другая функция с именем PageMe, оператор Exports может выглядеть так:
Exports
BeepMe index 1 name "BeepMe",
PageMe index 2 name "PageMe";
Чтобы создать DLL, выполните команду File д New и выберите DLL в диалоговом окне New Items. Введите содержимое листинга 2.1, сохраните его под именем BEEPER.DPR и затем откомпилируйте. Напрямую запустить DLL не удастся — для этого нужна другая (вызывающая) программа.

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

Наверное, DLL в программировании на Delphi чаще всего применяются для хранения общих форм. Если вы пишете целый программный комплекс, вероятно, многие формы будут использоваться сразу в нескольких программах. Вместо того чтобы размножать одинаковые формы, их можно вынести в отдельную DLL. При этом вы сэкономите место на диске и (что еще важнее) избавитесь от хлопот по сопровождению. DLL с формами Delphi отягощается кодом runtime-библиотеки (около 100 Кбайт), но если одна DLL будет содержать сразу несколько форм, излишек не так уж страшен.
Обращение к форме, находящейся в DLL, несколько отличается от работы с формой, находящейся в самой программе. Поскольку модуль, содержащий форму, не включается в программу, вы не сможете отобразить форму так, как это делается в обычной программе (то есть вызывая Form1.ShowModal). Вместо этого вам придется создать в DLL функцию-оболочку и затем вызвать ее из основной программы. Функция-оболочка создает форму, отображает ее, получает необходимые данные и уничтожает форму при ее закрытии, после чего возвращает информацию основной программе.
В листингах 2.4 и 2.5 содержатся исходные тексты файлов PICKCLR.DPR и COLORFRM.PAS, которые реализуют форму для выбора цвета в виде DLL.
Листинг 2.4. Файл PICKCLR.DPR
{ PICKCLR.DPR — DLL с формой для выбора цвета Автор: Джим Мишель Дата последней редакции: 12/05/97 } library pickclr; uses SysUtils, Classes, ColorFrm in "colorfrm.pas" {ColorSelectionForm}; Exports ColorFrm.PickColors index 1 name "PickColors"; begin end. Листинг 2.5. Модуль COLORFRM.PAS
{ COLORFRM.PAS — Выбор цвета с помощью формы, хранящейся в DLL Автор: Джим Мишель Дата последней редакции: 12/05/97 } unit colorfrm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ColorGrd; type TColorSelectionForm = class(TForm) ColorGrid1: TColorGrid; BtnOk: TButton; BtnCancel: TButton; private { Private declarations } public { Public declarations } function Execute : boolean; end; function PickColors (var Foreground, Background : TColor) : boolean; stdcall; export; implementation {$R *.DFM} function TColorSelectionForm.Execute : boolean; begin Result := (ShowModal = mrOk); end; function PickColors (var Foreground, Background : TColor) : boolean; stdcall; var ColorForm : TColorSelectionForm; begin ColorForm := TColorSelectionForm.Create (Application); Result := ColorForm.Execute; if (Result = True) then begin Foreground := ColorForm.ColorGrid1.ForegroundColor; Background := ColorForm.ColorGrid1.BackgroundColor; end; ColorForm.Free; end; end. Обратите внимание — модуль COLORFRM можно без всяких изменений подключить как к программе, так и к DLL. Это заметно облегчает перенос форм из программ в DLL. Для удобства отладки следует создать форму и отладить ее в программе. Добившись правильной работы, перенесите форму в заранее подготовленную оболочку DLL.
Как видно из листинга 2.4, файл проекта для DLL выглядит очень просто. Главное — правильно написать секцию Exports. Чтобы добавить в DLL другие формы, достаточно включить имена их модулей в секцию uses и добавить определения функций-оболочек в секцию Exports.
Интерфейсный модуль любой DLL с формами должен напоминать BEEPDLL.PAS из листинга 2.3. Как и BEEPDLL, он должен предоставлять возможность выбора между статическим и динамическим импортом. Дляэкономии места я не стал приводить интерфейсный модуль для PICKCLRDLL.
Чтобы воспользоваться формой, находящейся в DLL, достаточно подключить интерфейсный модуль DLL и вызвать функцию-оболочку, которая отобразит форму и вернет программе всю необходимую информацию.

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

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

Доступ к данным, желательно через стандартный источник данных (DataSource).

Место для локального хранения больших объемов данных.

Способ извлечения данных из источника.

Способ удобного получения любого из 13 статистических показателей.

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

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

До настоящего момента мы занимались подготовкой, причем вся работа в основном сводилась к созданию текстовых файлов. Теперь настало время воспользоваться Windows Sockets. Прежде всего необходимо вызвать CsSocket.Get Server, чтобы инициализировать структуры данных, необходимые для сервиса FTP. Процедура инициализации приведена в листинге 7.4.
Листинг 7.4. Метод CsSocket.GetServer
procedure TCsSocket.GetServer; begin GetServ; if Status = Failure then Exit; FSockAddress.sin_family := PF_INET; FSockAddress.sin_port := FServ^.s_port; FSockAddress.sin_addr.s_addr := htonl(INADDR_ANY); FRemoteName := LocalName; FSocket := CreateSocket; end; После того как все необходимые структуры данных инициализированы, GetServer вызывает CreateSocket, чтобы создать прослушивающий сокет FSocket. Далее мы вызываем функцию Winsock API с именем WSAAsyncSelect, чтобы приказать Winsock DLL извещать CsKeeper о событиях сокета посредством отправки сообщений в адрес Wnd (это логический номер окна типа HWND). Для этого используется следующая строка:
if WSAAsyncSelect(FSocket, Wnd, FTP_EVENT, FD_ACCEPT) = SOCKET_ERROR then Затем мы вызываем bind, еще одну функцию Winsock API, чтобы связать локальное имя с безымянным сокетом FSocket, а также с адресом хоста и номером порта. Это необходимо для прослушивания порта на предмет устанав ливаемых соединений. Функция listen сообщает CsKeeper о необходимости прослушивания порта 21. После вызова этой функции программа KEEPER32 готова к установке соединения через этот порт.

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

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

Рис. 2.1. Готовая форма текстового редактора
Листинг 2.6. Форма текстового редактора, EDITFORM.PAS
{ EDITFORM.PAS — Простейший текстовый редактор, демонстрирующий использование DLL Автор: Джим Мишель Дата последней редакции: 12/05/97 } unit editform; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls; type TForm1 = class(TForm) Memo1: TMemo; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; MainMenu1: TMainMenu; File1: TMenuItem; Open1: TMenuItem; Save1: TMenuItem; N1: TMenuItem; Exit1: TMenuItem; procedure Exit1Click(Sender: TObject); procedure Open1Click(Sender: TObject); procedure Save1Click(Sender: TObject); private { Private declarations } FileName : String; procedure OpenFile(Filename: String); procedure SaveFile(Filename: String); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} uses IniFiles; procedure TForm1.Exit1Click(Sender: TObject); begin Close; end; procedure TForm1.Open1Click(Sender: TObject); begin if OpenDialog1.Execute then OpenFile (OpenDialog1.FileName); end; procedure TForm1.Save1Click(Sender: TObject); begin if SaveDialog1.Execute then SaveFile (SaveDialog1.FileName); end; procedure TForm1.OpenFile (Filename: String); begin Memo1.Lines.LoadFromFile(Filename); end; procedure TForm1.SaveFile (Filename: String); begin Memo1.Lines.SaveToFile (Filename); end; end. Протестируйте программу и убедитесь в том, что она загружает и сохраняет ASCII-файлы (годится любой файл с расширением .TXT, а также .PAS и .DPR).
Мы хотим сделать так, чтобы наша программа читала другие файловые форматы, преобразовывала их в обычный текст и выводила его. Заранее неизвестно, какие форматы придется преобразовывать, поэтому нам потребуется возможность добавлять форматы по мере необходимости. Вероятно, простейший выход заключается в использовании файла инициализации (INI-файла).
Общая идея — поместить в INI-файл описание файлового формата, стандартное расширение и имя DLL, выполняющей преобразование. Пример такого INI-файла приведен в листинге 2.7.
Листинг 2.7. Файл TEXTEDIT.INI
; TEXTEDIT.INI ; Пример интерфейса расширения для файловых преобразований [Text] Extension=.TXT ConvertDLL=textconv.dll [Word for Windows] Extension=.DOC ConvertDLL=wfwconv.dll [WordCruncher] Extension=.WCX ConvertDLL=wcxconv.dll Нам придется изменить процедуру OpenFile так, чтобы она просматривала расширение имени открываемого файла и затем вызывала функцию преобразования из соответствующей DLL. Функция читает файл, преобразовы вает текст и возвращает результат в виде списка строк. Для выполнения всех преобразований используется функция Convert, вызываемая из текстового редактора. В листинге 2.8 содержится новый вариант функции OpenFile (не забудьте добавить модуль IniFiles в строку uses модуля формы), а в листингах 2.9 и 2.10 — исходный текст DLL текстовых преобразований (TEXTCONV.DLL).
Листинг 2.8. Новая функция OpenFile
procedure TForm1.OpenFile (Filename: String); type ConvertFunc = function (Filename: String; Strings: TStrings): boolean; stdcall; var ConvertIni : TIniFile; ConvertList : TStringList; FileExt : String; Extension : String; DLLName : String; x : Integer; Found : Boolean; LibInstance : HMODULE; Converter : ConvertFunc; IniFileName : String; begin FileExt := UpperCase (ExtractFileExt (Filename)); IniFileName := ExtractFileDir (ParamStr (0)) + "\TEXTEDIT.INI"; ConvertIni := TIniFile.Create (IniFileName); ConvertList := TStringList.Create; { Считываем список возможных преобразований } ConvertIni.ReadSections (ConvertList); { Для каждого преобразования читаем значение Extension и сравниваем его с расширением выбранного файла. } x := 0; Found := False; while ((x < ConvertList.Count) and (Not Found)) do begin Extension := ConvertIni.ReadString ( ConvertList.Strings[x], "Extension", ""); if (UpperCase (Extension) = FileExt) then Found := True else x := x + 1; end; if Found then begin DLLName := ConvertIni.ReadString ( ConvertList.Strings[x], "ConvertDLL", ""); { Загружаем DLL, получаем адрес функции Convert и вызываем ее. } LibInstance := LoadLibrary (PChar(DLLName)); if LibInstance = 0 then begin Application.MessageBox ( PChar ("Can"'t load DLL "+DLLName), "TextEdit", MB_ICONEXCLAMATION or MB_OK); end else begin Converter := GetProcAddress (LibInstance, "Convert"); if Not Assigned (Converter) then begin Application.MessageBox ( PChar ("Can"'t find Convert function in "+DLLName), "TextEdit", MB_ICONEXCLAMATION or MB_OK); end else begin if not Converter (Filename, Memo1.Lines) then begin Application.MessageBox ( "Error loading file", "TextEdit", MB_ICONEXCLAMATION or MB_OK); end; end; FreeLibrary (LibInstance); end; end else begin Application.MessageBox ( PChar("No conversion supplied for file type "+FileExt), "TextEdit", MB_ICONEXCLAMATION or MB_OK); end; ConvertList.Free; ConvertIni.Free; end; Листинг 2.9. Файл TEXTCONV.DPR
{ TEXTCONV.DPR — DLL текстовых преобразований Автор: Джим Мишель Дата последней редакции: 12/05/97 } library textconv; { Важное замечание об управлении памятью в DLL: модуль ShareMem должен стоять на первом месте в секции USES библиотеки, А ТАКЖЕ в секции USES вашего проекта (команда View|Project Source), если ваша DLL экспортирует какие-либо процедуры или функции, использующие строки в качестве параметров или результатов функций. Это относится ко всем строкам, передаваемым вашей DLL или получаемым от нее — даже если эти строки вложены в записи или классы. ShareMem представляет собой интерфейсный модуль для менеджера памяти DELPHIMM.DLL, который должен использоваться вместе с вашей DLL. Чтобы обойтись без использования DELPHIMM.DLL, передавайте строковую информацию в параметрах типа PChar или ShortString. } 1
uses ShareMem, SysUtils, Classes, textc in "textc.pas"; Exports textc.Convert index 1 name "Convert"; begin end. 1Этот комментарий создается средой Delphi автоматически. Поскольку далее в тексте идет его обсуждение, здесь приведен русский перевод. — Примеч. ред.
Листинг 2.10. Модуль TEXTC.PAS
{ TEXTC.PAS — Модуль текстовых преобразований. Загружает текстовые файлы с диска. Автор: Джим Мишель Дата последней редакции: 12/05/97 } unit textc; interface uses Classes; function Convert (Filename: String; Strings: TStrings) : boolean; stdcall; export; implementation function Convert (Filename: String; Strings: TStrings) : boolean; stdcall; begin Strings.LoadFromFile (Filename); Result := True; end; end. Обратите внимание на примечание в начале листинга 2.9 (TEXTCONV.DPR). Оно автоматически вставляется в файл проекта при выполнении команды File|New DLL. Честно говоря, я не уверен в том, что в данном случае ссылка на модуль ShareMem так уж необходима. Я попытался запустить программу без ShareMem, и она нормально работала. Кроме того, могу выдвинуть следующий аргумент: я передаю функции Convert не сам класс, а лишь указатель на объект TStrings. Впрочем, примечание, скорее всего, относится и к указателям на классы, поэтому на всякий случай я включил ShareMem в секции uses программы и DLL. Если вам придется использовать ShareMem, не забудьте поставлять файл DELPHIMM.DLL вместе с приложением.
Функция OpenFile из листинга 2.8 ни в коем случае не годится для коммерческой программы. Это лишь пример, который иллюстрирует общую концепцию. В коммерческом варианте ваша программа должна читать файл и (по возможности) определять его тип, а затем запрашивать у пользователя разрешение на выполнение преобразования, прежде чем начинать что-либо делать. Данный пример лишь показывает, как можно реализовать интерфейс расширения для вашего продукта.

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

Таинственная фигура закрыла дневник и потянулась к телефону. Аппарат с готовностью проглотил семь набранных цифр, а затем выдал серию гудков. Где-то на другом конце линии зазвонил телефон. Раздался щелчок, в трубке послышался уже знакомый нам обворожительный голос, и Мститель заговорил.
— Привет, Крошка… Да, это я. Подумал, что тебе захочется узнать, как прошло дело ночью. Мне удалось вломиться в контору Эйса Брейкпойнта, как и было задумано, и украсть Дневник прямо у него из-под носа. Все прошло почти идеально… А твоя роль в этом дельце была просто бесценной. Без тебя у меня бы ничего не вышло… Что? Да, ждать пришлось долго— но поверь, тем слаще оказалась месть. Верно. Послушай, Крошка, бросай все и встречай меня в 9 часов у мотеля «Гейтс», возле шоссе 101. Точно — прямо на холме, сразу за Нортон Сити. Угу… Сегодня я покажу тебе книгу, которая изменит нашу жизнь и сделает меня самым гениальным программистом в мире. Да, Крошка, меня — Дельфийского Мстителя. Встречаемся в 9 вечера. Не опаздывай. Пока.
Мститель повесил трубку, взял дневник и, громко хихикая, снова принялся перелистывать его.
Дневник №16, 26 марта. Сегодня снова позвонил Торговец. На этот раз он хочет, чтобы я создал компонент-заставку, которым можно будет пользовать ся в разных программах. В общих чертах идея состоит в следующем:
поместить компонент на главную форму приложения, задать значения нескольких свойств и выдать окно заставки перед отображением главной формы.
Я начал думать, что же требуется от обобщенной заставки. Не так уж много. Вероятно, ее стоит сделать модальной, чтобы программа приостановилась на время, пока заставка будет должным образом показана. Необходимо позаботиться о том, чтобы заставка исчезала по тайм-ауту, по щелчку мышью или в обоих случаях. Разумеется, в заставке должно присутствовать графическое изображение. Я сел за компьютер и создал исходную форму (см. рис. 15.4).
Но как превратить ее в компонент? После пары неудачных попыток я решил, что лучший вариант — создать новый компонент, построенный на
основе TForm, но с добавлением промежуточного объекта-оболочки, управляющего работой TForm. Объект-оболочка может ограничиться управлением свойствами, связанными с объектом-заставкой, что позволит наделить заставку простым пользовательским интерфейсом. Кроме того, оболочка может заниматься созданием и уничтожением формы по простой команде,
выданной владельцем объекта-оболочки. Я решил назвать этот класс TSplashDialog.
В рамках исходной спецификации я решил написать несложное тестовое приложение ы— форму, которая содержит всего одну кнопку и которой будет принадлежать TSplashDialog. Исходный текст тестового приложения приведен в листинге 15.2.

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

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

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

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

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

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

Метод, извлекающий все 13 показателей сразу;

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

В своем компоненте мы реализуем оба подхода.
Для одновременного получения всех показателей используется процедура GetAllStats. Она передает массив Data всем 13 статистическим функциям и сохраняет результаты в переменных, определенных в секции private нашего компонента. Кроме того, флагу DidGetAll присваивается True — это показывает другим методам, что все статистические показатели уже получены.
Разумеется, отдельные методы доступа могут проверять значение DidGetAll. Если оно равно True, метод доступа просто возвращает ранее сохраненную величину. С другой стороны, если флаг DidGetAll равен False, метод доступа может вызвать соответствующую функцию модуля Math напрямую и вернуть полученный результат. В качестве примера типичного метода доступа мы рассмотрим метод GetMean, который возвращает среднее арифметическое для поля DataField из выбранного диапазона записей.
Прежде всего необходимо позаботиться о том, чтобы данные были получены из источника и сохранены в массиве
Data: if not (IsArrayFilled) then FillArray; Затем следующая проверка — на этот раз необходимо убедиться, что искомый статистический показатель не был вычислен раньше. Если результат уже был получен и сохранен, нет смысла вычислять его заново — метод доступа просто возвращает сохраненное значение для экономии времени.
С другой стороны, если среднее арифметическое еще не вычислялось, мы вызываем соответствующую функцию модуля Math с использованием функций Slice и GetRange. В итоге мы возвращаем значение, полученное от модуля Math:
if not (DidGetAll) then
fMean := Math.Mean(Slice(Data,GetRange));
Result := fMean;
Теперь мы располагаем быстрым и удобным способом получения любого статистического показателя и можем вставить TDBStatistics в любой проект.

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

MaxIntValue Максимальное значение в наборе целых чисел. Функция по-
явилась в Delphi 3, ее не существует в Delphi 2
MaxValue Максимальное значение в наборе чисел. В Delphi 2 функция
возвращает минимальное значение
Mean Среднее арифметическое для набора чисел
MeanAndStdDev Одновременное вычисление среднего арифметического и
стандартного отклонения для набора чисел. Вычисляется
быстрее, чем обе величины по отдельности
MinIntValue Минимальное значение в наборе целых чисел. Функция по-
явилась в Delphi 3, ее не существует в Delphi 2
MinValue Минимальное значение в наборе чисел. В Delphi 2 функция
возвращает максимальное значение
MomentSkewKurtosis Статистические моменты порядков с первого по четвертый,
а также асимметрия (skew) и эксцесс (kurtosis) для набора
чисел
Norm Норма для набора данных (квадратный корень из суммы
квадратов)
PopnStdDev Выборочное стандартное отклонение. Отличается от обыч-
ного стандартного отклонения тем, что при вычислениях ис-
пользуется выборочное значение дисперсии, PopnVariance (см.
ниже)
PopnVariance Выборочная дисперсия. Использует «смещенную» формулу
TotalVariance/n
RandG Генерация нормально распределенных случайных чисел с за-
данным средним значением и среднеквадратическим от-
клонением
StdDev Среднеквадратическое отклонение для набора чисел
Sum Сумма набора чисел
SumsAndSquares Одновременное вычисление суммы и суммы квадратов для на-
бора чисел. Как и в других функциях модуля Math, обе вели-
чины вычисляются быстрее, чем по отдельности
SumInt Сумма набора целых чисел. Функция появилась в Delphi 3,
ее не существует в Delphi 2
SumOfSquares Сумма квадратов набора чисел
TotalVariance «Полная дисперсия» для набора чисел. Это сумма квадратов
расстояний всех величин от их среднего арифметического
Variance Выборочная дисперсия для набора чисел. Функция ис-
пользует «несмещенную» формулу TotalVariance/(n1)

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

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

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

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

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

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

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

Когда я переходил с Borland Pascal на Delphi, мне хотелось, чтобы строковые списки (TStringList) были похожи на строковые коллекции (TStringCollection)— ну как можно обойтись без итераторов ForEach?
Но когда я потом попытался перенести приложение Delphi обратно на Turbo Vision, мне сразу захотелось, чтобы строковые коллекции стали похожими на строковые списки.
Добавление и удаление строк в коллекциях по сравнению с удобными операциями списков выглядит как замешивание цемента — в основном из-за простоты и четкости нового синтаксиса Object Pascal.
Сравните код для добавления нового объекта в коллекцию Turbo Vision
AStringColl^.AtInsert(AStringColl^.Count, NewStr(S));
S := PString(AStringColl^.At(Index))^;
с аналогичным кодом для строкового списка Delphi
StringList.Add(S);
S := StringList[Index];
и вы поймете, что я имею в виду. Операции со строковыми коллекциями практически не читаются, а вторая строка приведенного выше фрагмента просто неверна. Если указатель PString равен NIL (то есть в коллекцию добавлена пустая строка), то в строковую переменную S попадет «мусор».
К счастью, на основе TStringCollection можно создать новый объект, облегчающий работу со строковыми коллекциями. Мы добавляем (см. листинг 9.6) безопасный по отношению к указателям метод StrAt и простой метод Add. Теперь можно легко написать код следующего вида:
StrList^.Add(S);
S := StrList^.StrAt(Index);
Знакомый синтаксис облегчает переходы между старым и новым миром — до тех пор, пока с существованием старого мира DOS приходится считаться.
Листинг 9.6. Модуль STRLIST.PAS
{ Создание удобных строковых коллекций в стиле TStringList. } unit StrList; interface uses Objects; type PStrListCollection = ^TStrListCollection; TStrListCollection = object(TStringCollection) function StrAt(Index: Integer): string; procedure Add(const S: string); end; implementation { PtrToStr преобразовывает указатель в строку с отдельной обработкой nil.} function PtrToStr(P: Pointer): string; begin if P = nil then PtrToStr := '' else PtrToStr := PString(P)^; end; { StrAt возвращает строку из строковой коллекции. } function TStrListCollection.StrAt (Index: Integer): string; begin StrAt := PtrToStr(At(Index)); end; { Add добавляет строку в конец строковой коллекции. } procedure TStrListCollection.Add(const S: string); begin AtInsert(Count, NewStr(S)); end; end.

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

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

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

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

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

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

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

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

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

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

Рис. 11.1. Программа StatsProject во время выполнения
Все начинается с вызова метода Execute. Если был выбран файл с допусти мым именем, работа продолжается:
with OpenDialog1 do begin Execute; if FileName = '' then exit; Затем мы устанавливаем свойства компонента TTable в соответствии с файлом, выбранного пользователем, и выводим сведения о файле с помощью двух элементов TLabel:
Table1.DatabaseName := ExtractFilePath(FileName); LblDatabase.Caption := ExtractFilePath(FileName); Table1.TableName := ExtractFileName(FileName); LblTable.Caption := ExtractFileName(FileName); Поскольку TDBStatistics обрабатывает данные лишь из одного поля, мы должны обеспечить пользователя средствами для выбора поля. Для этого мы извлекаем имена всех полей из TTable и включаем их в список:
CBFields.Items.Clear; CBFields.Text := ''; Memo1.Text := ''; Table1.Open; for i := 0 to Table1.FieldDefs.Count-1 do begin Application.ProcessMessages; CBFields.Items.Add(Table1.Fields[i].FieldName); end; Table1.Close; На этом выбор таблицы и имени поля завершается.
После того как пользователь выбрал анализируемое поле, он может сгенерировать статистический отчет в элементе Memo, нажимая кнопку BtnReports (кнопка с надписью «2. Generate a report»). В обработчике BtnReports.OnClick мы прежде всего задаем соответствующие свойства компонента DBStatistics1:
DBStatistics1.LowerBound := 1; Table1.Open; DBStatistics1.UpperBound := Table1.RecordCount; Table1.Close; DataSource1.DataSet := Table1; DBStatistics1.DataSource := DataSource1; DBStatistics1.DataField := CBFields.Text; {выбранное поле} Затем мы вызываем DBStatistics1.GetAllStats и выводим результаты в элементе Memo:
DBStatistics1.GetAllStats; Memo1.Text := ''; Memo1.Lines.Add('Mean: ' + #09 + #09 + FloatToStr(DBStatistics1.Mean)); { ... и т. д. ... } Memo1.Lines.Add('Kurtosis: ' + #09 + #09 + FloatToStr (DBStatistics1.Kurtosis)); Дело сделано — у нас появился работоспособный генератор статистических отчетов.

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

Теперь мы проверим, как работают функции анализа командной строки, с помощью тестовой программы. Создайте новое приложение на основе шаблона Console Application. Сохраните новый проект под именем FILTER.DPR и скопируйте файл CMDLINE.PAS (листинг1.3) в соответствующий каталог. Затем выполните команду File д Add to Project, чтобы включить модуль CmdLine в созданный проект.
Проект Filter предназначен для проверки модуля CmdLine, а также модуля файлового ввода/вывода, которым мы займемся далее. После завершения работы над модулями их окончательные версии будут помещены в хранили ще, и у нас появится шаблон для создания фильтров.
Для проверки модуля CmdLine нам понадобится массив с информацией о параметрах и фрагмент кода, в котором вызывается ProcessCommandLine. Тестовая программа (файл FILTER.DPR) приведена в листинге 1.4.
Листинг 1.4. Программа FILTER.DPR для тестирования модуля CmdLine
{ FILTER.DPR — основная программа фильтра Автор: Джим Мишель Дата последней редакции: 04/05/97 } {$APPTYPE CONSOLE} program filter; uses Windows, CmdLine; const nOptions = 4; Options : Array [1..nOptions] of OptionRec = ( (OptionChar : "i"; Option : otFilename; Filename : ""), (OptionChar : "o"; Option : otFilename; Filename : ""), (OptionChar : "n"; Option : otInt; Value : 36), (OptionChar : "d"; Option : otBool; OnOff : False) ); var cRslt : Boolean; Rec : pOptionRec; begin cRslt := CmdLine.ProcessCommandLine (@Options, nOptions); WriteLn("ProcessCommandLine returned ", cRslt); Rec := CmdLine.GetOptionsRec (@Options, nOptions, "i"); WriteLn ("i = ", Rec^.Filename); Rec := CmdLine.GetOptionsRec (@Options, nOptions, "o"); WriteLn ("o = ", Rec^.Filename); Rec := CmdLine.GetOptionsRec (@Options, nOptions, "n"); WriteLn ("i = ", Rec^.Value); Rec := CmdLine.GetOptionsRec (@Options, nOptions, "d"); WriteLn ("d = ", Rec^.OnOff); Write("Press Enter..."); ReadLn; end. После инициализации таблицы параметров (это происходит в секции const) вызывается функция ProcessCommandLine, которая читает аргументы командной строки и сохраняет значения параметров в таблице. Затем программа выводит результат, возвращенный функцией ProcessCommandLine, вместе со значени ями всех параметров.
Попробуйте задавать этой программе различные командные строки. Не ограничивайтесь правильными строками и обязательно введите несколько неправильных, чтобы убедиться в корректной обработке ошибок. Могу предложить несколько вариантов:
-iInFile.txt -oOutFile.txt -n995 -d{правильная строка}
-n8.94 {Error: integer expected}
-x {Invalid option character: x}
Обобщенный анализатор командных строк, содержащийся в модуле CmdLine, позволяет очень легко получить параметры нашей программы. Достаточно заполнить таблицу и передать ее функции ProcessCommandLine, которая и выполнит всю необходимую работу. Все, что от вас требуется, - проследить за тем, чтобы все необходимые параметры были заданы, и присвоить значения внутренним переменным программы в соответствии с указанными параметрами. Поверьте, это намного проще, чем писать отдельный анализатор для каждой программы.

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

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

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

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

Этим задачам соответствуют два метода IDropSource: QueryContinueDrag и Give Feedback. Их объявления приведены в следующей спецификации:
IDropSource = interface(IUnknown)
['{00000121-0000-0000-C000-000000000046}'] function QueryContinueDrag (fEscapePresed: BOOL; grfKeyState: Longint): HResult; stdcall; function GiveFeedback(dwEffect: Longint): HResult; stdcall; end; Метод QueryContinueDrag вызывается функцией DoDragDrop при каждом изменении состояния клавиатуры или кнопок мыши во время операции перетаскивания. На основании переменных fEscapePressed и grfKeyState он определяет дальнейшие действия — продолжение, завершение или отмену операции.
Метод GiveFeedback вызывается функцией DoDragDrop при каждом изменении состояния мыши во время перетаскивания. Основная задача GiveFeedback — предоставление визуальной индикации хода операции. Чаще всего такая индикация сводится к изменению внешнего вида курсора. DoDragDrop вызывает GiveFeedback после вызова методов DragEnter, DragLeave или DragOver интерфейса IDropSource и передает ему значение DROPEFFECT, возвращаемое методом IDRopTarget.
Интерфейс IDropSource обычно выглядит очень просто, особенно если учесть, что OLE определяет стандартное поведение, которое несложно реализовать.

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

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

TreeDataComboBox

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

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

TreeDataListBox

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

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

TreeDataOutline и TreeDataUpdate

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

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

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

Джон Шемитц
Полотна великих сюрреалистов вам не по карману? Тогда создайте виртуальный сюрреалистический пейзаж по своему вкусу (ведь он может быть сколь угодно велик). Для этого потребуется лишь фрактальная технология и немножко старой доброй магии Delphi.
Слово «фрактал» я впервые услышал примерно в 1983году, когда еще занимался программированием больших компьютеров. Мы с коллегой обсуждали только что полученные IBM PC, и он спросил, нет ли у меня программ для расчета фракталов.
«Нет», — ответил я. — «А что такое фракталы?»
Он объяснил, что фрактальное изображение создается применением некоторой геометрической операции к простой фигуре и последующим многократным применением той же операции к полученному результату. Хотя такое объяснение совершенно не затрагивает тех замечательных свойств фракталов, которые так интересуют математиков, оно вполне грамотно описывает, как же фракталы генерируются.
Несомненно, в полной мере это относится и к построению трехмерных фрактальных ландшафтов.

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

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

Рис. 8.6. Сохранение вершин в «квадратном» массиве
Впрочем, когда дело доходит до базы данных вершин, третья координата действительно игнорируется. Как видно из правой половины рис. 8.6, координаты вершин сохранятся и в том случае, если равносторонний треугольник преобразовать в прямоугольный. Поэтому координаты AB и BC можно будет использовать так, словно они относятся к элементу «квадратного» массива.
Однако сохранение нашего «треугольного» массива в «квадратном» означало бы, что почти половина места в массиве пропадает даром. В принципе в этом нет ничего страшного, хотя в 16-разрядной среде мы бы столкнулись с ограничением на размер сегмента (64 Кб). Каждый элемент типа TTriple состоит из трех 16-разрядных чисел с фиксированной точкой, поэтому квадратный массив после восьми итераций деления сторон (рис. 8.7) будет содержать (28-1 + 1)2 вершин, или 99 846 байтов. Если же сохранять только вершины, принадлежащие диагонали или находящиеся под ней, объем сокращается до 50 310 байтов. В этом случае можно воспользоваться простым индексированием вместо huge-указателей и массивов. К тому же вся база данных (по крайней мере в данной демонстрационной программе) помещается в одном сегменте данных, что ускоряет доступ к ней по сравнению с дополнительным выделением блоков из пула и использованием указателей.
Поскольку восемь итераций вряд ли можно назвать слишком мелким делением для экрана 1280?1024, описанная в этой главе программа Fractal Landscapes 3.0 (она же FL3 — переработанная (сначала под Windows, а затем для Delphi) версия DOS-программы, изначально написанной «для души» на Turbo Pascal 4.0) использует «треугольную» структуру базы данных (см. листинг 8.2). Основная идея заключается в том, что каждый ряд вершин хранится в базе после предыдущего ряда. Поскольку первый ряд состоит всего из одной вершины, второй ряд начинается со второй «ячейки». Он состоит из двух вершин, поэтому третий ряд начинается с четвертой ячейки, и так далее.

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

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

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

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

ArcCos Арккосинус
ArcCosh Гиперболический арккосинус
ArcSin Арксинус
ArcSinh Гиперболический арксинус
ArcTahn Гиперболический арктангенс
ArcTan2 Арктангенс с учетом квадранта (функция ArcTan, не учитывающая квадрант, находится в модуле System)
Cosh Гиперболический косинус
Cotan Котангенс
CycleToRad Преобразование циклов в радианы
DegToRad Преобразование градусов в радианы
GradToRad Преобразование градов в радианы
Hypot Вычисление гипотенузы прямоугольного треугольника по дли-
нам катетов
RadToCycle Преобразование радианов в циклы
RadToDeg Преобразование радианов в градусы
RadToGrad Преобразование радианов в грады
SinCos Вычисление синуса и косинуса угла. Как и в случае SumAndSquares
и MeanAndStdDev, одновременная генерация обеих величин
происходит быстрее
Sinh Гиперболический синус
Tan Тангенс
Tanh Гиперболический тангенс

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

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

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

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

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

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

Упущение

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

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

Поскольку я занимаюсь написанием shareware-программ на Delphi, мне захотелось создать простейшую установочную программу для тех людей, которые получают мои творения через онлайновые службы или BBS. К сожалению, Delphi почти автоматически «нагружает» любую программу немалым количеством ресурсов, так что даже простейшая установочная программа занимает около 200 Кб (правда, после этой цифры скорость роста программы резко уменьшается). Для Windows-приложения такой размер выглядит вполне нормально, но установочная программа должна быть как можно меньше — особенно если учесть, что пользователь оплачивает каждую секунду времени пересылки и что мне самому приходится платить за отправку зарегистрированной версии по электронной почте.
К счастью, я придумал, как предоставить установочной программе все ресурсы Delphi, обеспечив при этом минимальное увеличение объема пересылаемых файлов: главное приложение само выполняет функции установочной программы. Первоначально файл программы называется SETUP.EXE. При запуске под этим именем приложение устанавливает себя, хотя пользователю может показаться, что он имеет дело с отдельной установочной программой. После завершения установки программа переименовывает себя и перестает быть инсталлятором.
Давайте посмотрим, как это делается. В листинге 9.7 показан основной блок файла проекта (DPR) типичного приложения Delphi. В листинге 9.8 показан тот же блок, но с изменениями, благодаря которым он начинает действовать как установочная программа. Обратите внимание на проверку имени EXE-файла приложения — если имя файла равно SETUP.EXE, мы запускаем форму (или серию форм), в которой пользователь задает каталог, программную группу и прочие параметры установки.
Листинг 9.7. BEFORE.SRC
{ Основной блок DPR-файла приложения до внесения изменений, предназначенных для работы в установочном режиме. } begin Application.Initialize; Application.CreateForm( TMainForm, MainForm ); Application.Run; end Листинг 9.8. AFTER.SRC
{ Основной блок DPR-файла приложения после внесения изменений, предназначенных для работы в установочном режиме. } { Обратите внимание, что в строку USES модуля необходимо включить SYSUTILS.PAS. } begin Application.Initialize; if UpperCase( ExtractFileName ( Application.ExeName ) ) = 'SETUP.EXE' then begin Application.CreateForm ( TSetupForm, SetupForm ); end else Application.CreateForm ( TMainForm, MainForm ); Application.Run; end. Перед тем как архивировать свою программу (EXE-файл, справочные файлы и т. д.) для пересылки, я меняю имя EXE-файла на SETUP.EXE. После того как пользователь получит архив, раскроет его и запустит SETUP.EXE, приложение копирует себя и все вспомогательные файлы в указанный каталог и восстанавливает свое нормальное имя. При следующем запуске приложение обнаруживает, что его имя отличается от SETUP.EXE, и ведет себя нормально.
Ценой незначительного увеличения объема программы и времени пересылки пользователь получает полезную установочную программу, а я (хочется верить) — несколько лишних проданных экземпляров.

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

По умолчанию FTP-сервер всегда ожидает, что клиент инициирует соедине ние через TCP-порт с номером 21. Это соединение (оно называется управляющим соединением, control connection) остается открытым до тех пор, пока либо клиент, либо сервер не закроет его со своей стороны. Через установлен ное соединение клиент и сервер обмениваются командами FTP и кодами ответов соответственно. В командах Internet-протоколов обычно используется обычный англоязычный текст (чаще всего в верхнем регистре). Это остается справедливым даже при взаимодействиях между программами. Причина заключается в том, что Internet первоначально работал только с 7-разрядной ASCII-кодировкой, которая была (и остается) «наименьшим общим знамена телем» для общения двух систем — компьютерных или любых других.
Это обстоятельство не лучшим образом сказывается на скорости работы, но зато человеку становится значительно легче уследить за взаимодействием двух Internet-программ. На каждую команду, полученную от клиента, сервер обычно посылает код ответа. Код состоит из трех цифр, за которыми следует дефис или пробел, а затем — некоторый текст. Типичные сообщения могут выглядеть следующим образом:
200 PORT command successful.
230-Welcome to your I-SITE Internet server!
Дефис или пробел, следующий за числовым кодом, содержит важную для клиента информацию. Дефис сообщает клиенту о том, что данное сообщение является комментарием и его можно спокойно игнорировать. Пробел указывает клиенту на необходимость перехода к следующей фазе текущей операции. Текст, который идет дальше, обычно содержит информацию о статусе или инструкцию для пользователя.
Диаграмма, изображенная на рис. 6.1, описывает взаимодействие клиента с сервером во время регистрации. FTP-сеанс начинается с посылки клиентом команды USER, за которой следует имя пользователя, и получения со стороны сервера кода ответа, состоящего из трех цифр. Если имя пользовате ля признается допустимым, сервер отвечает кодом 331 или 230. При недопустимом имени пользователя генерируется код 4xx или 5xx, где xx описывает код конкретной ошибки.
Ответ 230 означает, что имя пользователя признано допустимым и для доступа к системе не требуется никакой дополнительной информации. Сервер обычно выдает этот код в ответ при знаменитой «анонимной» регистрации пользователей. Ответ 331 означает, что имя пользователя также признано допустимым, но для доступа к системе необходим пароль. В этом случае клиент посылает команду PASS, за которой следует пароль.
Неверный пароль вызывает ответ 4xx или 5xx, свидетельствующий об ошибке. Если пароль принят, сервер может послать код 230, чтобы сообщить о завершении регистрации. Если для регистрации необходимы сведения об используемых ресурсах (account), сервер снова отвечает кодом 331, чтобы клиент послал команду ACCT и требуемые сведения.

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

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

Я зашел в контору и так хлопнул дверью, что за стеной послышался глухой стук упавшей таблички. Дождь шел целый день, а сейчас, казалось, он лил еще сильнее. За несколько последних дней дождь превратил пустырь рядом с моей конторой в густое месиво, которое теперь осаждало заасфальтирован ную автостоянку с упорством телевизионных репортеров, прибывших на место катастрофы. Я вытер ноги о коврик в тщетной попытке избавиться от липкой коричневой грязи.
Я снял шляпу и плащ, швырнул промокшую кобуру на диван. Кобура едва не задела Мьюникса. Утомленный кот даже не пошевелился, а лишь открыл один глаз и презрительно взглянул на меня. Я бухнулся в кресло и включил компьютер. Только что закончилась встреча моей группы координирования проектов под Win95, и мне хотелось немного привести в порядок мысли. Пожалуй, для начала стоит просмотреть почту.
Меня ждала всего одна записка от моей мамы, Куини Брейкпойнт: «Не забудь позвонить сестре и поздравить ее с днем рожденья, обязательно пригласи всех друзей на вечеринку, посвященную годовщине твоего последнего приключения…»
Я тут же набросал e-mail с приглашением, забросил его в список рассылки «друзья» и задумался. Хотя то приключение состоялось всего два года назад, казалось, что прошла целая вечность. Все начиналось достаточно невинно — мы с Мелвином Бохакером соревновались за очередной контракт. Бохакер — высокий парень с длинной шеей, любитель гамбургеров и программирования на C/C++, знавший великое множество различных библиотек. До той поры ему удавалось перехватывать у меня почти всех клиентов.
Поначалу все выглядело, как честная конкуренция. Но когда прошло всего 24 часа и дым немного рассеялся, я был в кошмарном состоянии — избитый, окровавленный и совершенно одуревший. Не знаю, чем бы все кончилось, если бы не друзья.
Мы познакомились в колледже, и наша компания стала неразлучной. Мои самые близкие друзья даже оказались в некоторой степени участниками тех событий. Громила Бакендорф-Рабинович (бывший профессиональный футболист) попал тогда на психологическое обследование. Бифф Мэрфи, специалист по деловой этике, опасался за мою жизнь. Маффи Катц, профессиональный психиатр и по совместительству маникюрша, тоже опасалась… честно говоря, она больше всего опасалась сломать ноготь клиенту.
И еще была Хелен Хайуотер. Почти пять лет Хелен оставалась рядом, деля со мной все радости и беды. Но тогда, во время приключения, я едва не потерял ее. Впрочем, как бы скверно мне ни было, на следующий день мне все же удалось поквитаться с Бохакером. Я так врезал ему, что кровь из его расквашенного носа забрызгала мой плащ. Окровавленная реликвия до сих пор висит где-то в шкафу.
Я невольно усмехнулся. Много воды утекло за прошедший год. Теперь я почти полностью перешел на Delphi 3, моя консультационная практика постоянно расширялась. Бифф все еще стоял на раздаче в «Норвежских жареных цыплятах Бака МакГаука». Хелен работала менеджером в местном магазине. Маффи бросила работу и занялась созданием модной одежды и украшений. История Громилы закончилась трагично. Ему поставили диагноз «мания величия» и поместили в государственное лечебное учреждение (а проще
говоря — в психушку). Через два месяца интенсивного труда он научился настраивать гитару. Однажды ночью он вместе с четырьмя другими обитателя ми этого заведения сбежал и организовал гранж-группу «Крыша поехала». Их первый компакт-диск стал платиновым. На этой неделе должен выйти второй (не собираюсь покупать ни тот, ни другой — даже дружба имеет свои пределы).

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

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

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

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

Emp_ID Boss 1 Boss 1 Boss 2 Boss 1 Manager 1 Manager 2 Manager 3 Boss 3 Boss 3

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

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

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

Сначала я был удивлен различиями между 16- и 32-разрядной версиями ToolHelp. Некоторые процедуры (в том числе и TaskFirst с TaskNext) в 32-разрядной версии отсутствовали. Что это, просчет со стороны разработчиков?
Как выяснилось — нет. Реализация многопоточной, вытесняющей мультизадачности создала динамическую ситуацию, которая похожа на принцип неопределенности Гейзенберга. Система, которая постоянно управляет задачами, создает и уничтожает потоки, назначает приоритеты и занимается планированием, не может нормально функционировать и одновременно динамически сообщать о своем состоянии. К тому времени, когда вы получите отчет, состояние системы наверняка изменится.
Я мечтал о том, чтобы Win95 на несколько тактов уступила все полномочия моей программе и я получил бы абсолютно точный отчет о состоянии системы. Но при этом стабильность всей системы оказывается на совести одного приложения, что полностью противоречит всем принципам вытесняющей мультизадачности.
Как же решается проблема? Необходимо «сфотографировать» всю систему, причем процесс «фотографирования» планируется по усмотрению Win95. Затем содержимое полученного снимка можно изучить, не вмешиваясь в
работу системы. Решение, что и говорить, не идеальное, но по крайней мере работающее.
«Фотографирование» выполняется функцией CreateToolHelp32Snapshot, входящей в 32-разрядную версию ToolHelp. Функция вызывается с двумя параметрами. Первый из них представляет собой маску, определяющую тип собираемой информации. В табл. 15.1 приведены различные варианты масок и соответствующие им значения. Второй параметр является логическим номером процесса в системе. По этому логическому номеру (он принадлежит объекту, называемому идентификатором процесса , — process ID) можно получить доступ к одному процессу; изучая этот процесс, можно получить определенные сведения. Итак, в принципе необходимо проделать следующее:
w вызовите функцию для получения списка всех текущих процессов, используя маску, определяющую тип нужных данных. При этом возвращается логический номер области памяти, поддерживаемой KERNEL32 и являющейся источником всей информации о состоянии системы;
w используйте процедуры Process32First и Process32Next для перебора процессов из полученного списка и изучайте различные аспекты этих процессов. Сведения о каждом процессе помещаются в переменную, указанную при вызове процедуры перебора.
Хотя происходящее больше напоминало научные исследования, а не формальное упражнение, настало время принять несколько принципиальных решений. Прежде всего требовалось определить общую цель. Я решил, что мое приложение должно выводить имена всех активных процессов в системе. Дополнительно я захотел вывести имена всех модулей (то есть программного кода, данных, растровых изображений, драйверов устройств и всего остального, из чего состоит процесс). Кроме того, мне хотелось иметь возможность ограничить вывод списком модулей, связанных с заданным процессом. На конец, я решил вывести количество созданных в системе экземпляров каждого модуля.
Таблица 15.1. Маски функции CreateToolHelp32Snapshot

Имя TH32CS_SNAPHEAPLIST TH32CS_SNAPPROCESS TH32CS_SNAPTHREAD TH32CS_SNAPMODULE TH32CS_SNAPALL

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

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

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

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

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

Безопасность считается одной из самых больших проблем в Internet. В программе KEEPER32 я реализовал лишь самые примитивные меры по обеспечению безопасности доступа. Если вы захотите усовершенствовать KEEPER32, в этой области перед вами открываются великолепные возможности.
В групповом поле gbSecurity можно указать, какие действия разрешаются FTP-клиентам, а какие нет. Например, вы можете запретить клиентам удалять каталоги на сервере, для этого следует лишь снять флажок cbDeleteDir. Если вы не хотите, чтобы программа KEEPER32 разрешала клиентам передаватьFRcvBuffer свои файлы на сервер, снимите флажок cbUpload. Внесенные изменения сохраняются кнопкой Save, при нажатии которой вызывается процедура SaveSecure Settings.
KEEPER32 можно слегка защитить от злонамеренных хакеров посредством ведения списка IP-адресов тех клиентов, которые уже пытались вызвать хаос в вашей системе. Если IP-адрес подключающегося FTP-клиента присутствует в «черном» списке lbBadIPAddrs, CsKeeper1 разрывает соединение. Для добавления, удаления и сохранения «плохих» IP-адресов используются кнопки Add, Remove и Save соответственно. На рис. 7.4 показана вкладка tsOptions после ввода списка нежелательных IP-адресов.

Рис. 7.4. Список нежелательных IP-адресов, которым KEEPER32 отказывает в установлении соединения
Информационные сообщения для клиентов
Иногда бывает нужно сообщить подключающимся FTP-клиентам об изменениях в FTP-услугах, предоставляемых KEEPER32, вывести другие информационные сообщения или инструкции («каталог pub/incoming ликвидирован…»). Такие сообщения обычно передаются пользователям при установлении или разрыве соединения. Они называются «приветственными» (welcome) и «прощальными» (farewell) сообщениями соответственно.
Вы можете ввести такие сообщения, нажимая кнопку Edit в групповом поле gbMessages. При этом на экране появляется форма frmMessages. На ней содержится элемент pcMessages типа TPageControl, имеющий две вкладки, tsWelcome и tsFarewell. На обеих вкладках присутствуют элементы Memo, в которых редактируется текст сообщений. Кнопка Save сохраняет текущее сообщение в текстовом файле. Внешний вид формы frmMessages показан на рис. 7.5. Указывая имена файлов в свойствах Welcome и Farewell компонента CsKeeper1, вы определяете местонахождение хранящихся сообщений. Когда KEEPER32 принимает подключающегося клиента, компонент CsKeeper1 использует свойство Welcome для поиска и открытия файла с текстом сообщения, отображаемого во время регистра ции.

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

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

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

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

Дон Тейлор
Пока Дельфийский Мститель узнает, как научить приложения Delphi обнаруживать присутствие самих себя и среды Delphi (а заодно получает плавающую панель инструментов), Эйс обнаруживает очень странное уравнение со множеством неизвестных — но в конечном счете приводит дело к потрясающей развязке.
Эйс включил галогеновую настольную лампу и поднес лавандовый обрывок к свету.
— Довольно дорогая бумага, — сказал он. — Виден край водяного знака.
Эйс повернул клочок так, чтобы свет отражался от бумаги. — Почерк действительно женский. Судя по размеру закругленных элементов, принадлежит особе с сильным характером. Очень похоже на женщину, которой хватило смелости позвонить мне вчера вечером. Характерные линии, похоже на ручку с дорогим пером «Хабашер №4374» и чернилами «Ночная тень». Вот, пожалуй, и все.
— Можно посмотреть? — спросила Хелен.
— Конечно, — ответил Эйс, передал записку и добавил: — Да, и еще одно. Бумага пахнет духами.
Хелен понюхала обрывок, и глаза ее расширились.
— Это не просто духи, — сказала она. — Это очень дорогие духи, Chez Monieux.
— Значит, пахнет дорогими духами, — раздраженно заметил Эйс.
— Я не спорю с тобой, милый. Просто женщины иногда замечают мелочи, которых не видят мужчины. Видишь ли, только утонченная, хорошо обеспеченная женщина может позволить себе духи Chez Monieux.
— Ну, хватит об этом. Я ведь уже сказал, что она использовала дорогую бумагу, очень хорошую ручку и чернила, не так ли? В конце концов, я не эксперт по духам, и…
— Думаю, Хелен всего лишь пытается сказать, — вмешалась Мардж, — что эти духи называются Chez Monieux.
Эйс на секунду застыл в задумчивости. Он вдруг вспомнил, что слышал нечто подобное от Маффи.
— Я так и знал, — произнес он осторожно.
— Помнишь? — сказала Хелен. — Эти духи входят в эксклюзивную коллекцию моды Маффи.
— Помню, — ответил Эйс. — Но что это нам дает?
— У меня есть гипотеза, — начала Хелен. — Думаю, Мелвин Бохакер давно мечтал поквитаться с тобой. Наверное, он познакомился с хорошо обеспеченной женщиной, которая ставит собственное достоинство превыше всего.
Она выжидательно посмотрела на своих собеседников. Эйс закатил глаза, но Мардж явно внимала каждому слову Хелен.
— Когда эта женщина — назовем ее «Мадам Икс» — узнала, что Мелвин потерял лицо из-за тебя, она подговорила его свести старые счеты. Они составили план и выполнили его вчера вечером. На ее машине они подъехали к конторе и остановились рядом с твоей машиной. Он вышел и спрятался, а она отправилась к телефонной будке и набрала заранее записанный номер. В это время она могла даже видеть тебя через окно кухни.
— Но как же записка попала туда, где ее нашли? — спросил Эйс.
— Могу предположить и это — ее просто сдуло порывом ветра. Сама телефонная будка освещена, но в нескольких футах от нее записка вполне могла затеряться в темноте. Видимо, она торопилась, а может быть, даже не заметила пропажи.
— А перчатка?
— Конечно, чтобы не оставить отпечатков пальцев, Бохакер взламывал дверь конторы в перчатках. Садясь в машину, он просто выронил одну из них. Может быть, его машина даже проехала по перчатке и вдавила ее в грязь.
— Очень жаль, — сказал Эйс, перебивая ее взмахом руки. — Все это звучит довольно правдоподобно, за исключением одного: Бохакер на такое просто не способен, даже подстрекаемый какой-то богатой дамочкой.
Хелен вздохнула:
— Наверное, стоит подождать результатов экспертизы ДНК. По крайней мере, это докажет, кто из нас прав.
— Экспертиза? — спросила Мардж. — Какая экспертиза? И как насчет перчатки, которую ты нашел?
Эйс поведал историю перчатки. На полное изложение всех подробностей потребовалось не менее получаса.
— Да, интересный денек, — сказала она. — Я бы хотела посидеть с вами и подождать результатов экспертизы. Но сегодня в номер 193 въезжает новый жилец — кстати, холостой, — так что, пожалуй, я узнаю, как он устроился.
Мардж ?ейнольдс неуклюже протиснулась в дверь и закрыла ее за собой.

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

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

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

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

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

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

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

После завершения компиляции сохраните проект и выполните команду File д New Application. Сейчас мы напишем простейшую тестовую программу для вызова DLL.
Поместите кнопку на главную форму и создайте обработчик событий, который должен выглядеть так:
procedure TForm1.Button1Click(Sender: TObject);
begin
BeepMe;
end;
Включите BeepDLL в список, следующий за ключевым словом uses в модуле формы. Не пытайтесь компилировать программу, сначала нужно создать файл BEEPDLL.PAS.
Создайте новый модуль с именем BEEPDLL.PAS и введите содержимое листинга 2.2.
Листинг 2.2. Интерфейсный модуль для BEEPER.DLL
{ BEEPDLL.PAS — интерфейсный модуль для BEEPER.DLL } unit BeepDLL; interface procedure BeepMe; external "beeper.dll"; procedure BeepMeTwo; external "beeper.dll" name "BeepMe"; procedure BeepMeThree; external "beeper.dll" index 1; implementation end. Если все было сделано правильно, то после компиляции и запуска программы при нажатии кнопки будет раздаваться звуковой сигнал.
Наверное, вы заметили, что для вызова процедуры BeepMe из BEEPER.DLL я указал целых три разных варианта. Если бы обработчик нажатия кнопки вызывал BeepMeThree вместо BeepMe, результат остался бы прежним. Мы работаем с искусственным примером, но в некоторых ситуациях возможность подключения функций DLL по имени (name) или номеру (index) оказывается полезной. Пусть, например, вам требуется вызвать из DLL функцию с именем XY$FORMAT (вполне реальный пример). Поскольку в Паскале XY$FORMAT не является допустимым идентификатором, вам не удастся воспользоваться этой функцией без ее переименования (см. вариант BeepMeTwo). Столь же полезно и ключевое слово index: некоторые функции DLL экспортируются только по номеру, без имени!
Мы рассмотрели пример статического импорта DLL. Интерфейсный модуль BEEPDLL.PAS всего лишь сообщает компилятору о том, что процедуру BeepMe необходимо взять из файла BEEPER.DLL посредством динамической компоновки. Код, содержащийся в BEEPER.DLL, не включается в вашу программу. Если не верите, удалите BEEPER.DLL и попробуйте снова запустить программу. Если программа была запущена из IDE, Delphi выдаст сообщение об ошибке. Если же запустить программу автономно, Windows сообщит о том, что ей не удалось найти библиотеку BEEPER.DLL.
Это сообщение об ошибке подводит нас к другому способу вызова функций DLLАF0;— динамическому импорту.

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

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

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

В этой главе я показал, как с помощью Delphi скопировать содержимое экрана. Все замечательно работает, если вы используете растровое изображение вскоре после его создания. Если же попытаться сохранить изображение в файле и загрузить его позднее, цветопередача искажается.
Дело в том, что при копировании экрана в видеорежиме, использующем палитру, полученные цвета пикселей на самом деле представляют собой лишь индексы в цветовой таблице; они останутся правильными лишь в том случае, если не изменилась системная палитра.
Следовательно, после копирования экрана мы должны создать новую палитру с системными цветами и назначить ее свойству Palette растра. При сохранении растрового изображения значения цветов будут сохранены вместе с ним. Функция GetSystemPalette из листинга 9.13 создает такую палитру и возвращает ее логический номер. Функция CaptureScreenRect из того же листинга показывает, как использовать GetSystemPalette со скопированным изображением.
Листинг 9.13. SYSPAL.SRC
function GetSystemPalette: HPalette; var PaletteSize: Integer; LogSize: Integer; LogPalette: PLogPalette; DC: HDC; Focus: HWND; begin Result := 0; Focus := GetFocus; { ...это необходимо для GetDC } DC := GetDC( Focus ); { ...это необходимо для GetDeviceCaps } try PaletteSize := GetDeviceCaps( DC, SIZEPALETTE ); LogSize := SizeOf( TLogPalette ) + ( PaletteSize - 1 ) * SizeOf( TPaletteEntry ); GetMem( LogPalette, LogSize ); try with LogPalette^ do begin palVersion := $0300; palNumEntries := PaletteSize; GetSystemPaletteEntries( DC, 0, PaletteSize, palPalEntry ); end; Result := CreatePalette( LogPalette^ ); finally FreeMem( LogPalette, LogSize ); end; finally ReleaseDC( Focus, DC ); end; end; { Воспользуемся GetSystemPalette для копирования прямоугольника... } function CaptureScreenRect( ARect: TRect ) : TBitmap; var ScreenDC: HDC; begin Result := TBitmap.Create; with Result, ARect do begin Width := Right - Left; Height := Bottom - Top; ScreenDC := GetDC( 0 ); try BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY ); finally ReleaseDC( 0, ScreenDC ); end; { Также сохраним системную палитру... } Palette := GetSystemPalette; end; end; Палитра создается функцией API CreatePalette. Функция CreatePalette получает один параметр-запись, в котором указываются версия палитры, количество цветов и массив значений, определяющих каждый цвет.
В типе записи для этой «логической палитры» хватает места для хранения лишь одного элемента палитры. Сначала это может показаться странным, но на самом деле все логично — количество элементов палитры зависит от видеорежима. Следовательно, прежде всего необходимо определить размер палитры для текущего видеорежима. Затем мы используем указатель типа PLogPalette и выделяем область памяти, достаточную для хранения записи и всех элементов. Как видно из листинга 9.13, количество элементов палитры определяется функцией GetDeviceCaps.
Выделение памяти под логическую палитру — дело хлопотное, но зато дальше все просто. Мы получаем сами цветовые значения функцией GetSystem PaletteEntries, а затем передаем информацию о логической палитре функции CreatePalette и получаем необходимый логический номер (handle) палитры.

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

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

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

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

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

Для завершения работы с FTP-сервером необходимо лишь разорвать соединение командой QUIT. Нажатие кнопки Quit приводит к вызову CsShopper1.Finish и завершению сеанса:
procedure TfrmMain.bbtnQuitClick(Sender: TObject); begin bbtnQuit.Enabled := FALSE; bbtnRefresh.Enabled := FALSE; bbtnViewFile.Enabled := FALSE; bbtnFtpCmds.Enabled := FALSE; bbtnAbort.Enabled := FALSE; rgFileType.Enabled := FALSE; sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; gbMoreActions.Visible := FALSE; pbDataTransfer.Visible := FALSE; bbtnConnect.Enabled := TRUE; bbtnExit.Enabled := TRUE; with sbStatus do begin Panels[1].Text := 'Remote Host : '; Panels[3].Text := 'Status : Idle'; end; lbRemoteFiles.Clear; CsShopper1.Finish; Update; end;

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

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

?ис. 16.4. Программа, обнаруживающая присутствие Delphi во время работы
Ответ был настолько прост, что я не сразу в него поверил. На рис. 16.4 показано, как может выглядеть такая программа. В листинге 16.5 приведен исходный текст главной формы, а в листинге 16.6 — файл проекта.
Листинг 16.5. Исходный текст главной формы приложения,
обнаруживающего присутствие Delphi
{——————————————————————————————————————————————————————} { Демонстрационная программа, } { обнаруживающая присутствие Delphi. } { NRUNMAIN.PAS : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Главная форма приложения, работающего лишь при } { условии одновременной работы 32-разрядной версии } { Delphi. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} unit NRunMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, WalkStuf; type TForm1 = class(TForm) ExitBtn: TButton; Label1: TLabel; procedure ExitBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.ExitBtnClick(Sender: TObject); begin Close; end; end. Листинг 16.6. Файл проекта для приложения, обнаруживающего
присутствие Delphi
{——————————————————————————————————————————————————————} { Демонстрационная программа, } { обнаруживающая присутствие Delphi. } { NORUN.DPR : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Приложение, работающее лишь при условии } { одновременной работы 32-разрядной версии Delphi. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} program NoRun; uses Forms, Dialogs, NRunMain in 'NRunMain.pas' {Form1}, WalkStuf in 'WalkStuf.pas'; {$R *.RES} begin Application.Initialize; { Если не существует работающего экземпляра 32-разрядной версии Delphi, вывести сообщение об ошибке и завершить работу программы. Если все хорошо, продолжить выполнение. } if ModuleSysInstCount('DELPHI32.EXE') < 1 then MessageDlg('Delphi 32 must be running to execute this program', mtError, [mbOK], 0) else begin Application.CreateForm(TForm1, Form1); Application.Run; end; end. Основная идея — уничтожить приложение еще до того, как пользователь увидит главную форму. Для решения этой задачи я снова включил код непосредственно в файл проекта. На этот раз функция ModuleSysInstCount из модуля WalkStuf проверяет, работает ли в системе по меньшей мере один экземпляр 32-разрядной версии Delphi (DELPHI32.EXE). Если проверка дает положительный результат, программа продолжает работу, если нет — выводится сообщение об ошибке.
Небольшое замечание: поскольку в модуле WalkStuf используется Tool Help32, описанная методика будет работать лишь в Win95.
Конец записи (2 апреля).

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

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

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



    Программирование: Языки - Технологии - Разработка

• Программирование
  
• Технологии программирования
  
• Разработка программ
  
• Работа с данными
  
• Методы программирования
  
  
• IDE интерфейс
  
• Графический интерфейс
  
• Программирование интерфейсов
  
• Отладка программ
  
• Тестирование программ
  
  
• Программирование на Delphi
  
• Программирование в ActionScript
  
• Assembler
  
• Basic
  
• Pascal
  
  
• Perl
  
• VBA
  
• VRML
  
• XML
  
• Ada
  
  
• Lisp
  
• Python
  
• UML
  
• Форт
  
• Языки программирования