45803 (MIDAS. Практическое применение), страница 4

ApplyChanges – сохраняет текущий документ в БД.

DocID – свойство, доступное на запись и чтение При чтении выдается текущий ID документа (FDocID). При изменении значения свойства документ открывается для редактирования с ID, равным новому значению. Если значение свойства равно 0, документ закрывается, и модуль переводится в неактивное состояние.

CreateNewDoc – создает новый документ (вызывает методы DoInactiveState и DoCreateNew).

DocSum – выдается текущая сумма документа, результат работы метода CalcSum.

Реализация этих методов довольно проста, все основные процедуры уже есть, сложность представляет только функция ApplyChanges:

function TrdmDoc.ApplyChanges: WideString; begin lock; try FLastUpdateErrors := ''; if FState = osInactive then raise Exception.Create('Нет нового или открытого документа'); // Вычисляем итоговую сумму документа with cdsTitle do begin Edit; FieldByName('DOC_SUM').asCurrency := CalcSum; Post; end; RenumLines; // перенумерация содержимого // Сохранение в БД... ibtDoc.StartTransaction; // При вставке сначала сохраняем изменения в cdsTitle... if FState = osInsert then begin if cdsTitle.ChangeCount > 0 then cdsTitle.ApplyUpdates(0); if cdsBody.ChangeCount > 0 then cdsBody.ApplyUpdates(-1); end; // ...а при изменении – в cdsBody. if FState = osUpdate then begin if cdsBody.ChangeCount > 0 then cdsBody.ApplyUpdates(-1); if cdsTitle.ChangeCount > 0 then cdsTitle.ApplyUpdates(0); end; // FLastUpdateErrors заполняется на OnReconcileError. Result := FLastUpdateErrors; if Result = '' then ibtDoc.Commit else begin ibtDoc.Rollback; end; finally ibtDoc.Active := False; unlock; end; end;

Дело в том, что изменение данных в БД происходит не в методе провайдера, а в методе модуля, и клиентские наборы данных ничего об этом не знают. Поэтому функция ApplyChanges возвращает список ошибок, возникших при обновлении данных. Список накапливается в переменной FLastUpdateErrors, описанной в секции private как FLastUpdateErrors: String;. Перед сохранением изменений рассчитывается сумма документа. Процедура RenumLines нумерует строки содержимого по порядку. Это просто дополнительный сервис. Затем ClientDataSet-ы пытаются сохранить изменения в БД. При возникновении ошибки заполняется поле FLastUpdateErrors:

procedure TrdmDoc.cdsTitleReconcileError(DataSet: TClientDataSet; E: EReconcileError; UpdateKind: TUpdateKind; var Action: TReconcileAction); begin Action := raCancel; FLastUpdateErrors := FLastUpdateErrors + 'Заголовок: ' + E.Message + #13#10; end; procedure TrdmDoc.cdsBodyReconcileError(DataSet: TClientDataSet; E: EReconcileError; UpdateKind: TUpdateKind; var Action: TReconcileAction); begin Action := raCancel; FLastUpdateErrors := FLastUpdateErrors + 'Содержимое: ' + E.Message + #13#10; end;

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

Процедура RenumLines перенумерует строки содержимого документа так, чтобы номера шли по порядку, причем все номера сначала делаются отрицательными, иначе при попытке запомнить вторую запись с тем же ключем сразу генерируется исключение Key violation, что, разумеется, совершенно не нужно (Дело в том, что провайдер великолепно знает, какие поля составляют первичный ключ, вот и контролирует – у ClientDataSet создается контроль первичного ключа. Исключение генерируется сразу, при попытке вставки (до записи в БД)):

procedure TrdmDoc.RenumLines; var Num: Integer; begin cdsBody.IndexFieldNames := 'DOC_ID;LINE_NUM'; // Чтобы избежать Key violation при перенумерации, делаем все номера < 0 // На клиенте нужна проверка LINE_NUM >= 0 cdsBody.Last; with cdsBody do while FieldByName('LINE_NUM').AsInteger > 0 do begin Edit; Num := FieldByName('LINE_NUM').AsInteger; FieldByName('LINE_NUM').AsInteger := -num; Post; Last; end; // перенумерация... Num := cdsBody.RecordCount; cdsBody.First; with cdsBody do while FieldByName('LINE_NUM').AsInteger <= 0 do begin Edit; FieldByName('LINE_NUM').AsInteger := num; Post; Dec(Num); First; end; end;

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

Остается последний модуль данных сервера, rdmReport, предназначенный для создания отчета. По сравнению с предыдущими модулями он довольно прост (рисунок 4.).

Рисунок 4.

Здесь находится всего один компонент транзакции ibtInOut и один компонент запроса ibqInOut, обращающийся к процедуре отчета:

select * from REP_INOUT(:FromDate, :ToDate) order by TO_NAME

При этом необходимо учитывать, что данные из этой процедуры получаются совершенно не в том виде, который нужен, и нуждаются в дополнительной обработке. Такую дополнительную обработку лучше осуществлять на стороне клиента, так как это потенциально позволяет передавать данные в более компактном виде, да и само представление данных является частью презентационной логики. Но этот пример создавался, чтобы продемонстрировать, в основном, работу серверной стороны. Поэтому обработку данных мы будем производить на сервере. cdsInOut – это компонент ClientDataSet, в котором формируется отчет в том виде, в котором он должен быть отображен клиенту. К этому компоненту подсоединен провайдер dspInOut с установленным флагом poIncFieldProps. Его свойство Exported равно false. От провайдера требуется только генерация пакета данных. И, как обычно, ResolveToDataSet = true. cdsInOut не соединен ни с каким провайдером (свойство ProviderName пустое), и должен создаваться явно вызовом своего метода CreateDataSet. Для того, чтобы набор данных содержал поля, их описания должны содержаться в свойстве FieldDefs. Но по той причине, что в отчете-шахматке количество полей в записи заранее неизвестно, их описания приходится создавать динамически при обработке результата запроса. Для этого удобно создать отдельный метод, CollectInOutData:

function TrdmReport.CollectInOutData: OleVariant; const FieldPrefix = 'Receiver_'; var ReceiverFieldName: string; RecsOut: Integer; ProvOptions: TGetRecordOptions; begin cdsInOut.Active := False; try with cdsInOut.FieldDefs do begin Clear; // Первые две колонки - поставщик with AddFieldDef do begin Name := 'SenderID'; DataType := ftInteger; Required := True; end; with AddFieldDef do begin Name := 'SenderName'; DataType := ftString; Size := 180; end; // Теперь набор полей - получатели ibqInOut.First; while not ibqInOut.EOF do begin ReceiverFieldName := FieldPrefix + ibqInOut.FieldByName('TO_ID').AsString; if IndexOf(ReceiverFieldName) = -1 then with AddFieldDef do begin Name := ReceiverFieldName; DataType := ftCurrency; end; ibqInOut.Next; end; end; // Второй проход - заполнение суммами cdsInOut.IndexFieldNames := 'SenderID'; cdsInOut.CreateDataSet; with cdsInOut do begin ibqInOut.First; while not ibqInOut.EOF do begin if FindKey([ibqInOut.FieldByName('FROM_ID').AsInteger]) then Edit else Insert; ReceiverFieldName := FieldPrefix + ibqInOut.FieldByName('TO_ID').asString; if State = dsInsert then FieldByName('SenderID').AsInteger := ibqInOut.FieldByName('FROM_ID').AsInteger; FieldByName('SenderName').AsString := ibqInOut.FieldByName('FROM_NAME').AsString; with (FieldByName(ReceiverFieldName) as TFloatField) do begin asCurrency := ibqInOut.FieldByName('FULL_SUM').AsCurrency; // пока свойства заголовка не установлены if DisplayFormat = '' then // установим их begin DisplayLabel := ibqInOut.FieldByName('TO_NAME').AsString; DisplayWidth := 10; Currency := False; DisplayFormat := '# ##0.00'; end; end; Post; ibqInOut.Next; end; // название первой колонки with FieldByName('SenderName') do begin DisplayLabel := 'Поставщики'; DisplayWidth := 30; end; FieldByName('SenderID').Visible := false; end; // Пусть провайдер позаботится о формировании пакета. ProvOptions := [grMetadata, grReset]; Result := dspInOut.GetRecords(-1,RecsOut,Byte(ProvOptions)); finally cdsInOut.Active := False; end; end;

Хотя эта функция выглядит длинной и сложной, делается очень немного: организуется два прохода по ibqInOut, который к этому времени должен содержать результат выполнения хранимой процедуры. Предварительно создается два обязательных поля - SenderID и SenderName (ID и наименование поставщика). Во время первого прохода у cdsInOut создается список колонок (в FieldDefs) с именами вида 'Receiver_NN'. Затем создается набор данных командой CreateDataSet и организуется второй проход, в котором ячейки заполняются значениями сумм. При этом производится поиск поставщика по SenderID (с использованием индекса), если такого поставщика еще нет – добавляется запись. Затем ячейке таблицы (с соответствующим Receiver_ID) присваивается сумма, полученная из хранимой процедуры. Попутно устанавливаются визуальные свойства полей. После прохода по результату запросу выставляются визуальные свойства первых двух колонок. Наконец, функция dspInOut.GetRecords возвращает ClientDataSet (вместе со свойствами полей), содержащий готовыйй отчет. Провайдер dspInOut нужен только чтобы в пакет были включены визуальные свойства полей. Для этого используется флаг grMetadata, а данные получаются прямым вызовом метода GetRecords. После получения пакета клиентский набор данных можно благополучно закрыть, что, собственно, и делается.

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

function InOutData(FromDate, ToDate: TDateTime): OleVariant; safecall;

Этот метод принимает параметры отчета, и выдает весь отчет, запакованный в OleVariant:

function TrdmReport.InOutData(FromDate, ToDate: TDateTime): OleVariant; begin lock; try ibdReport.Connected := True; ibtInOut.StartTransaction; try with ibqInOut do begin ParamByName('FromDate').asDateTime := FromDate; ParamByName('ToDate').asDateTime := ToDate; Active := True; Result := CollectInOutData; Active := False; end; ibtInOut.Commit; finally ibtInOut.Active := False; end; finally unlock; end; end;

Функция InOutData устанавливает параметры запроса и выполняет его, после чего вызывает функцию CollectInOutData, которая выполняет основную работу.

На этом этапе сервер приложений полностью закончен, и можно, запустив его один раз для регистрации в реестре как СОМ-сервера, приступать к созданию клиентской части.

Клиент

Задача клиентского приложения – взаимодействовать с пользователем и отображать нужную ему информацию.

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

В прилагаемых исходных текстах имеется клиентское приложение, содержащее три модуля данных (TdataModule), dmCommon, dmDoc и dmReport. Каждый из них предназначен для соединения с соответствующим удаленным модулем данных.

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

Для использования сервера приложений его библиотека типов импортирована в клиентское приложение.

ПРИМЕЧАНИЕ Дело в том, что для соединения клиентского приложения с сервером в данном случае используется TSocketConnection (scDoc). При обращении к интерфейсу удаленного модуля как к variant (через свойство AppServer) вызовы методов сервера в некоторых случаях вызывают сбой (Access violation). Поэтому все вызовы я произвожу через dispinterface, имя которого отличается от имени исходного интерфейса суффиксом Disp. Импорт библиотеки типов как раз и позволяет обращаться к этому интерфейсу. Кроме того, при обращении к серверу с импортированной библиотекой типов все параметры процедур проверяются на этапе компиляции, и вызов GetDispIDsOfNames не производится, что ускоряет вызовы методов. Для импорта надо выбрать пункты меню Project -> Import Type Library, и выбрать в списке DocServer library. Не забудьте, что сервер при этом должен быть зарегистрирован в реестре. После этого остается отключить опцию Generate Component Wrapper и нажать Create Unit, поскольку компонент в данном случае не нужен, достаточно только объявлений.

Работа с поставщиками и получателями

Свойство DMCommon.ClientName обеспечивает обращение к методу сервера:

property ClientName[ID: integer]: string read GetClientName; function TDMCommon.GetClientName(ID: integer): string; var AServer: IrdmCommonDisp; begin Result := ''; if ID = 0 then Exit; AServer := IrdmCommonDisp(scCommon.GetServer); Result := AServer.ClientName[ID]; AServer := nil; end;

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

Получение нового идентификатора для поставщика и получателя производится в обработчике события OnNewRecord:

procedure TDMCommon.cdsClientNewRecord(DataSet: TDataSet); var AServer: IrdmCommonDisp; begin AServer := IrdmCommonDisp(scCommon.GetServer); cdsClient.FieldByName('CLIENT_ID').AsInteger := AServer.NewClientID; AServer := nil; end;

Работа с документами

Удаление документа происходит прямо из списка. Это делается в обработчике события компонента TAction. А вот редактирование и добавление нового документа производится в отдельном модуле DMDoc, привязанном к rdmDoc:

procedure TDMCommon.actDelDocExecute(Sender: TObject); begin with cdsDocList do begin Delete; ApplyUpdates(0); end; end; function TDMDoc.ProcessDoc(DocID: Integer; NewDoc: Boolean): boolean; var AServer: IrdmDocDisp; begin AServer := IrdmDocDisp(scDoc.GetServer); // scDoc: TSocketConnection if NewDoc then AServer.CreateNewDoc else AServer.DocID := DocID; try cdsTitle.Active := True; cdsBody.Active := True; RecalcDocSum; Result := ShowEditForm; cdsTitle.Active := false; cdsBody.Active := false; finally AServer.DocID := 0; // Отмена регистрации документа end; end;

Как уже говорилось, если DocID становится равным 0, сервер закрывает документ.

Сумма документа запрашивается с сервера:

procedure TDMDoc.RecalcDocSum; begin with cdsBody do // Свежие изменения посылаются на сервер if ChangeCount > 0 then ApplyUpdates(-1); with cdsTitle do begin if not (State in [dsEdit, dsInsert]) then Edit; FieldByName('Summa').asCurrency := GetDocSum; end; end; function TDMDoc.GetDocSum: Currency; var AServer: IrdmDocDisp; begin AServer := IrdmDocDisp(scDoc.GetServer); Result := AServer.DocSum; end;

Поле Summa в клиентском наборе данных – вычисляемое, при этом его тип (свойство FieldKind) установлен в fkInternalCalc, что позволяет работать с этим полем, как с обычным полем данных, используя методы Edit и Post. Значение для него создается не в обработчике OnCalcFields, как требуется для типа fkCalculated, а непосредственно при редактировании записи. Хотя такой способ хорошим не назовешь, руководство VCL рекомендует использовать OnCalcFields, принципиальных различий нет, internalCalc-поля вычисляются только при вызове Post, однократно. Второй способ создания поля - сделать calculated Fields на сервере, и установить у них ProviderFlags = []; в этом случае поля на клиенте будут иметь тип fkData (данные записи), и с ними также можно работать, как с обычными полями данных.