Создание DTD для объекта
Раздел Подземелье Магов |
Содержание
За созданием кода для сериализации и десериализации объектов в Delphi логично перейти к рассмотрению вопроса о возможности генерации соответствующего DTD для сохраняемых в XML классов. DTD понадобится нам, если мы захотим провести проверку XML документа на корректность и допустимость с помощью одного из XML анализаторов. Работа с анализатором MSXML рассмотрена в статье на есть. Необходимо рекурсивно пройтись по всем свойствам объекта и сгенерировать модели содержания для каждого тега. При сериализации в XML мы не использовали атрибутов, а значит мы не сможем в DTD установить контроль над содержанием конкретных элементов. Остается только определить модель содержания для XML, т.е. вложенность тегов в друг друга. Хотя стандарт DTD устаревает и следует переходить к использованию схем, будет полезным обеспечить возможность создания DTD для наших объектов.
Создадим процедуру GenerateDTD(), которая обеспечит запись формируемого DTD для заданного объекта Component в заданный поток Stream. Она создает список DTDList, в котором будут накапливаться атрибуты DTD, после чего передает всю черновую работу процедуре GenerateDTDInternal().
Следующий код просматривает свойства объекта, составляет их список, а затем формирует из этого модель содержания для элемента. Для свойств классовых типов используется рекурсия. Поскольку при сериализации объекта мы не использовали атрибутов, то определений для них создавать нет необходимости.
Для всех неклассовых типов модель содержания это - (#PCDATA). К примеру, свойство объекта Tag: integer превращается в .
Отдельно подходим к коллекциям. Для них необходимо указать на множественность дочернего тега элемента коллекции. Например, для свойства TMyCollection модель содержания может выглядеть так: .
Продолжение
Создание и наследование элементов управления, редактирование особенностей
Редакторы-наследники TParticulEditor предполагают, что элемент управления TParticulEditor.Control будет "умещён в одну строку", т. е. данные, которые будут отображены в нём, можно отобразить в сравнительно "узком" элементе управления (20 пикселов). TParticulEditor имеет 4 стандартных наследника TEditEditor (редактор в виде TEdit), TButtonEditor (в виде TButton), TComboBoxEditor (в виде TComboBox), TCheckBoxEditor (в виде TCheckBox). В модуле автоматически регистрируются 11 основных типов данных, которые привязываются к редакторам следующим образом: к TEditEditor - строки, целые числа, действительные числа, к TButtonEditor - текст, выбор цвета и методы: без параметров, вычисление периметра элемента управления и масштабирование, к TComboBoxEditor - перечисление (в том числе и события), к TCheckBoxEditor - булевы величины.
Рассмотрим TEditEditor. Он редактирует данные трёх типов (в модуле PrtEdits). Всю "соль" обработки осуществляют процедуры TExecutor: StringExecutor, IntegerExecutor и RealExecutor. Так, StringExecutor просто переприсваивает данные из строки ввода TEdit редактируемой особенности, IntegerEdit и RealEdit перед присваиванием делают проверку формата вводимого числа из TEdit. Таким же образом, благодаря TExecutor можно обрабатывать любые данные, вводимые в строку.
Немного остановлюсь на TButtonEditor. Он служит, как правило, для обработки сложных данных, редактирование которых производится в диалоговом окне. Таким образом, кнопка редактора TButton служит для вызова некоторого диалога (его инициализация и обработка производится внутри процедуры TExecutor). В него передаются кодированные данные (параметры Code и Info), редактируются, кодируются в строку и выдаются Result'ом. Следует обратить внимание, что если особенность только для чтения, то внутри TExecutor следует это учесть и изменить форму, запрещая редактирование данных. Также TButtonEditor служит для реализации методов. Если метод без параметров, то по клику на кнопке производится выполнение этого метода; если с параметрами - выводится диалоговое окно ввода параметров; если метод возвращает какой-либо результат, то он отображается в заголовке кнопки. В Delphi это реализуется маленькой кнопочкой с тремя точками.
Для создания нового элемента управления следует унаследовать его от TParticulControl и обязательно перекрыть методы GetTypeName, GetParticuls и SetParticul. Быстрое создание новых свойств, методов или событий выполняется с помощью процедур DoProperty, DoMethod и DoEvent. Например:
function TSample.GetTypeName: string; begin Result := 'Некоторый класс'; end; function TSample.GetParticuls: TParticulList; var P: TParticul; begin Result := TParticulList.Create; with Result do begin P := DoProperty('Просто строка', dtString, True, True, FString, '', False); Add(P); P := DoProperty('Ширина', dtInteger, Length(FString) <> 0, True, IntToStr(Width), '', False); Add(P); end; end; procedure TSample.SetParticul(Value: TParticul); begin if Value.Name = 'Просто строка' then FString := Value.Code; if Value.Name = 'Ширина' then Width := StrToInt(Value.Code); end; Теперь свойства отобразятся в Инспекторе на вкладке "Свойства" с заголовками "Просто строка" и "Ширина" (на русском!). При их редактировании выведутся соответствующие редакторы с соответствующими Executor'ами. Обращу внимание, что таким образом могут редактироваться как "реальные" свойства, так и просто поля, а, быть может, и выполнятся процедуры (что-то вроде Get и Set).
Теперь хочу коснуться наследования элементов управления. Как известно, Object Pascal не позволяет осуществлять наследование с ограничением видимости, что послужило причиной создания большого количества Custom'ов в VCL. В языке С++ эта возможность имеется (private-, protected- и public-наследование). Данный Инспектор позволяет производить имитацию private- и public-наследования. Это очень удобно, когда необходимо скрыть "лишние" особенности в потомках.
TPublicSample = class(TSample) ... TPrivateSample = class(TSample) ... implementation ... //наследуем все особенности предка и добавляем свои function TPublicSample.GetParticuls: TParticulList; begin Result := inherited GetParticuls; ... end; //добавляем только свои особенности function TPrivateSample.GetParticuls: TParticulList; begin Result := TParticulList.Create; ... end; Хочу ещё раз обратить внимание, что особенности элемента управления не имеют никакого отношения к реальным свойствам, событиям и методам. Можно обращаться к полям, методам, свойствам любой области видимости (а не только published). То есть, методы GetParticuls и SetParticul - это имитация области published.
В примере Example1 показаны реализация свойств и методов различных элементов управления (о событиях чуть попозже, там есть несколько тонкостей). TRectControl - пример элемента управления, TRoundRectControl - его public-наследник, TEllipticControl - его private-наследник. На форму выведены два TRectControl'а и по одному TRoundRectControl'у и TEllipticControl'у. Кнопка Button1 показывает/скрывает Инспектор.
Создание и отладка MTS объектов
MTS представляет собой оболочку, которая осуществляет поддержку транзакций, управление доступом и совместное использование ресурсов (resource pooling) в распределенных системах, построенных на основе COM.
В Delphi имеются Мастера, которые позволяют создавать MTS объекты, поддерживающие все возможности MTS.
Еще раз перечислим возможности, которые предоставляет пользователю MTS: Управление системными ресурсами, включая процессы, потоки (threads), и соединения с базами данных, что позволяет серверному приложению осуществлять работу с множеством пользователей одновременно. Автоматическую поддержку транзакций, что повышает надежность системы. Создание, выполнение и удаление серверных компонентов тогда, когда это необходимо системе. Поддержку доступа к системе на основе роли пользователя (role-based security).
С помощью этих возможностей разработчик может создавать распределенные приложения, состоящие из функциональных частей, каждая из которых реализует одно или несколько бизнес правил (business logic). Для этой цели можно использовать либо MTS объекты (MTS objects) или MTS модули данных (MTS remote data modules). Эти компоненты располагаются в динамических библиотеках (DLLs), которые затем устанавливаются в MTS.
Созданные таким образом компоненты могут использоваться как обычными Windows приложениями, так и ActiveForm.
Создание MTS объектов
В Delphi 5 имеются два Мастера для создания MTS объектов. Первый, под названием MTS Object, создает компонент, похожий на обычный компонент Delphi. Второй, с именем MTS Data Module, создает модуль данных, похожий на одноименный компонент Delphi. Его можно использовать, как контейнер для размещения компонентов доступа к базам данных. Но, в общем-то, особой разницы между этими компонентами нет.
Первый шаг, который необходимо сделать — создать новую ActiveX Library (Рисунок 1).
Второй - создать Data module с помощью Мастера создания MTS Data Module (Рисунок 2).
Далее необходимо выбрать потоковую модель (Threading model) и модель транзакций (Transaction model) для создаваемого компонента (Рисунок 3).
Вы должны выбрать одну потоковую модель из трех - Single, Apartment, или Both.В том случае, если выбрана Single, MTS гарантирует, что только один вызов клиента будет обрабатываться в каждый момент времени. В этом случае полностью исключается влияние одного клиентского приложения на другое.
В том случае, если выбрана модель Apartment, то MTS гарантирует, что один экземпляр данного компонента в любой момент выполняет один запрос клиента, но не обязательно использует для этого один и тот же поток (thread). Поэтому нельзя использовать переменные потока (thread variables), поскольку нет гарантии, что последовательность клиентских вызовов будет обрабатываться тем же потоком данного компонента. Таким образом, для избежания конфликтов между потоками, нельзя использовать глобальные переменные или компоненты, которые находятся в модуле данных, если их одновременное использование может привести к таким конфликтам. Вместо этого следует использовать shared property manager.
В том случае, если выбрана модель Both, то это означает, что модуль работает так же, как и в случае Apartment, но обратные вызовы (callbacks), которые передаются клиенту, будут выполняться последовательно. Таким образом, можно не заботиться о влиянии их друг на друга.
Внимание!
Модель Apartment в MTS отличается от одноименной модели в терминологии DCOM (Distributed COM).
Вы так же должны выбрать один из вариантов поддержки транзакции. Доступны следующие опции: Requires a transaction. В этом случае, всякий раз, как только клиент будет обращаться к интерфейсу модуля данных, его обращение будет выполняться в контексте транзакции MTS. В том случае, если клиент работает в контексте транзакции, новая транзакция не будет создаваться. Requires a new transaction. При выборе этого варианта, каждый раз, как только к интерфейсу компонента будет происходить обращение, MTS автоматически будет создавать для него транзакцию. Supports transactions. В данном варианте модуль может работать в контексте транзакции MTS, но клиент должен поддерживать использовать контекст транзакции при вызове методов интерфейса. Does not support transactions. В этом случае модуль данных не может использоваться в контексте транзакции MTS.
Следует иметь в виду, что при установке компонента на MTS, модель транзакции можно будет изменить.
При этом можно указать максимально время, после которого транзакция будет автоматически прервана (transaction timeout). По умолчанию оно равно 60сек. Для того чтобы запретить автоматическое прерывание транзакции (например, при отладке приложения), следует установить это время равным нулю.
Для установки его следует с помощью утилиты Component Services выбрать компьютер, для которого следует изменить время транзакции и на странице Options провести соответствующие изменения (Рисунок 4).
В Delphi 6 процесс создания модуля данных практически совпадает с тем, что был описан выше, за исключением того, что новый проект будет создан автоматически, как только вы обратитесь к Мастеру Transaction Data Module Object (Рисунок 5).
При создании нового MTS data module, Delphi автоматически создает процедуру UpdateRegistry для поддержки технологии Midas, которая используется Borland.
class procedure TTestD5.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); begin if Register then begin inherited UpdateRegistry(Register, ClassID, ProgID); EnableSocketTransport(ClassID); EnableWebTransport(ClassID); end else begin DisableSocketTransport(ClassID); DisableWebTransport(ClassID); inherited UpdateRegistry(Register, ClassID, ProgID); end; end; |
Процесс создания интерфейса полностью совпадает с тем, что используется в обычном COM компоненте, и поэтому здесь не рассматривается.
Создание поля в таблице
Создание поля может выполняться двумя путями: по ходу создания новой таблицы из диалога формирования списка полей TTbDefFr по кнопке Новое поле или же непосредственно из главной формы нашей платформы по кнопке NewF. В обоих случаях создается диалог формирования новой структуры поля FldDlgFr с тем отличием, что в первом случае работа происходит с буферной структурой таблицы FDbInterface.N_pTTableInfo, а во втором – с текущей структурой таблицы FpTTableInfo главной формы конфигуратора. В обоих случаях работа начинается с создания буферной структуры поля
FDbInterface.Init_NpTFieldInfo;
После выхода из диалога FldDlgFr ход действий несколько отличается, но суть их одна и та же. В первом случае сначала идет «набивка структуры таблицы» FDbInterface.N_pTTableInfo списком структур полей и обновление информации на сервере производится в один прием, т.е. одновременно создается как таблица, так и поля в ней. Во втором случае эта операция выполняется для одиночной структуры поля, добавляемой в структуру таблицы, что требует лишь обновления структуры таблицы на сервере.
Создание pop-up меню своего компонента и кое-что еще о классе TComponentExpert
Давайте рассмотрим создание простейшего одноуровневого контекстного меню на своем компоненте, которое будет открываться при щелчке правой кнопкой по нему в самом верху контекстного меню Delphi.
Прежде всего вам следует разделить код вашего компонента на Design-time и Run-time. Для этого перенесите ваш компонент в модуль, с названием, например, MyComponent.pas, а процедуры регистрации его в палитре компонентов (procedure Register и т.д.) в модуль, с названием, например, MyComponentReg. На такие меры приходится идти из-за того, что Borland не включила в исходные коды исходник файла Proxies.pas.
Итак, получим два файла:
MyComponent.pas:
unit MyComponent; interface uses SysUtils, Classes; type TMyComponent = class(TComponent) private { Private declarations } protected { Protected declarations } public { Public declarations } published { Published declarations } end; |
MyComponentReg.pas
unit MyComponentReg; interface uses DesignIntf, DesignEditors, MyComponent, Classes, Dialogs; type TMyComponentEditor = class(TComponentEditor) private procedure ExecuteVerb(Index: Integer); override; function GetVerbCount: Integer; override; function GetVerb(Index: Integer): string; override; procedure Edit; override; end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TMyComponent]); RegisterComponentEditor(TMyComponent, TMyComponentEditor); end; { TMyComponentEditor } procedure TMyComponentEditor.Edit; begin ShowMessage('TMyComponent component v1.0 by Rastrusny Vladislav'); end; procedure TMyComponentEditor.ExecuteVerb(Index: Integer); begin inherited; case Index of 0: //Действие при выборе первого определенного пункта меню end; end; function TMyComponentEditor.GetVerb(Index: Integer): string; begin case Index of 0: Result := 'Demo Menu Item 1'; //Название первого пункта меню end; end; function TMyComponentEditor.GetVerbCount: Integer; begin Result := 1; end; end. |
Рассмотрим теперь, что же тут написано. В первом файле просто определен компонент MyComponent. В нем вы определяете все свойства и методы вашего компонента. Все как обычно. Теперь - второй файл MyComponentReg. Он содержит процедуры регистрации компонента и процедуру регистрации редактора компонента (TComponentEditor). Этот редактор и будет отображать меню и прочие безобразия. Итак:
Определяем TMyComponentEditor как потомка TComponentEditor. Сам по себе этот класс является "воплотителем" интерфейса IComponentEditor, хотя нам все равно. Для того, чтобы все это заработало нам нужно будет переопределить стандартные методы класса TComponentEditor. Рассмотрим его:
type TComponentEditor = class(TBaseComponentEditor, IComponentEditor) private FComponent: TComponent; FDesigner: IDesigner; public constructor Create(AComponent: TComponent; ADesigner: IDesigner); override; procedure Edit; virtual; function GetVerbCount: Integer; virtual; function GetVerb(Index: Integer): string; virtual; procedure ExecuteVerb(Index: Integer); virtual; procedure Copy; virtual; procedure PrepareItem(Index: Integer; const AItem: IMenuItem); virtual; property Component: TComponent; property Designer: IDesigner; end; |
Конструктор нам переопределять не нужно. Поэтому начнем с описания метода Edit. Метод Edit вызывается при двойном щелчке по компоненту. Вот так просто! При двойном щелчке на компоненте! Если метод не определен, то при двойном щелчке будет выполнен первый пункт меню, которое вы определили. Метод GetVerbCount: Integer должен возвращать количество определенных вами пунктов меню. Метод GetVerb(Index: Integer): string должен возвращать название пункта меню № Index. Метод ExecuteVerb(Index: Integer) вызывается при щелчке на пункте меню, определенном вами. Index - номер меню из метода GetVerb. В нем вы определяете действия, которые будут происходить при нажатии на ваш пункт меню. Метод Copy вызывается при копировании вашего компонента в буфер обмена Свойство Component как вы уже наверное догадались позволяет получить доступ к компоненту, на котором щелкнули мышью и т.п. Метод PrepareItem(Index: Integer; const AItem: IMenuItem) вызывается для каждого определенного вами пункта меню № Index и через параметр AItem передает сам пункт меню для настройки. Для работы нам нужно будет рассмотреть саму реализацию интерфейсас IMenuItem. Он определен в модуле DesignMenus.pas и является потомком интерфейса IMenuItems.
IMenuItems = interface ['{C9CC6C38-C96A-4514-8D6F-1D121727BFAF}'] // public function SameAs(const AItem: IUnknown): Boolean; function Find(const ACaption: WideString): IMenuItem; function FindByName(const AName: string): IMenuItem; function Count: Integer; property Items[Index: Integer]: IMenuItem read GetItem; procedure Clear; function AddItem(const ACaption: WideString; AShortCut: TShortCut; AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent = nil; hCtx: THelpContext = 0; const AName: string = ''): IMenuItem; overload; function AddItem(AAction: TBasicAction; const AName: string = ''): IMenuItem; overload; function InsertItem(const ACaption: WideString; AShortCut: TShortCut; AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent = nil; hCtx: THelpContext = 0; const AName: string = ''): IMenuItem; overload; function InsertItem(Index: Integer; const ACaption: WideString; AShortCut: TShortCut; AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent = nil; hCtx: THelpContext = 0; const AName: string = ''): IMenuItem; overload; function InsertItem(AAction: TBasicAction; const AName: string = ''): IMenuItem; overload; function InsertItem(Index: Integer; AAction: TBasicAction; const AName: string = ''): IMenuItem; overload; function AddLine(const AName: string = ''): IMenuItem; function InsertLine(const AName: string = ''): IMenuItem; overload; function InsertLine(Index: Integer; const AName: string = ''): IMenuItem; overload; end; |
IMenuItem = interface(IMenuItems) ['{DAF029E1-9592-4B07-A450-A10056A2B9B5}'] // public function Name: TComponentName; function MenuIndex: Integer; function Parent: IMenuItem; function HasParent: Boolean; function IsLine: Boolean; property Caption: WideString; property Checked: Boolean; property Enabled: Boolean; property GroupIndex: Byte; property HelpContext: THelpContext; property Hint: string; property RadioItem: Boolean; property ShortCut: TShortCut; property Tag: LongInt; property Visible: Boolean; end; |
Что же касается процедуры RegisterComponentEditor, то она принимает два параметра: первый - класс компонента, для которого создается редактор свойств и второй - собственно сам класс редактора свойств.
TPropertyEditor = class(TBasePropertyEditor, IProperty, IProperty70) protected procedure SetPropEntry(Index: Integer; AInstance: TPersistent; APropInfo: PPropInfo); override; protected function GetFloatValue: Extended; function GetFloatValueAt(Index: Integer): Extended; function GetInt64Value: Int64; function GetInt64ValueAt(Index: Integer): Int64; function GetMethodValue: TMethod; function GetMethodValueAt(Index: Integer): TMethod; function GetOrdValue: Longint; function GetOrdValueAt(Index: Integer): Longint; function GetStrValue: string; function GetStrValueAt(Index: Integer): string; function GetVarValue: Variant; function GetVarValueAt(Index: Integer): Variant; function GetIntfValue: IInterface; function GetIntfValueAt(Index: Integer): IInterface; procedure Modified; procedure SetFloatValue(Value: Extended); procedure SetMethodValue(const Value: TMethod); procedure SetInt64Value(Value: Int64); procedure SetOrdValue(Value: Longint); procedure SetStrValue(const Value: string); procedure SetVarValue(const Value: Variant); procedure SetIntfValue(const Value: IInterface); protected { IProperty } function GetEditValue(out Value: string): Boolean; function HasInstance(Instance: TPersistent): Boolean; { IProperty70 } function GetIsDefault: Boolean; virtual; public constructor Create(const ADesigner: IDesigner; APropCount: Integer); override; destructor Destroy; override; procedure Activate; virtual; function AllEqual: Boolean; virtual; function AutoFill: Boolean; virtual; procedure Edit; virtual; function GetAttributes: TPropertyAttributes; virtual; function GetComponent(Index: Integer): TPersistent; function GetEditLimit: Integer; virtual; function GetName: string; virtual; procedure GetProperties(Proc: TGetPropProc); virtual; function GetPropInfo: PPropInfo; virtual; function GetPropType: PTypeInfo; function GetValue: string; virtual; function GetVisualValue: string; procedure GetValues(Proc: TGetStrProc); virtual; procedure Initialize; override; procedure Revert; procedure SetValue(const Value: string); virtual; function ValueAvailable: Boolean; property Designer: IDesigner read FDesigner; property PrivateDirectory: string read GetPrivateDirectory; property PropCount: Integer read FPropCount; property Value: string read GetValue write SetValue; end; |
Предположим, нам нужно создать редактор для текстового свойства, при нажатии кнопки "…" в Object Inspector.
Объявим специальный тип этого свойства TMyComponentStringProperty = string;
Далее, в компоненте укажем свойство данного типа property MyProperty: TMyComponentStringProperty, далее в Run-time части компонента (MyComponentReg.pas) объявим класс TMyCSPEditor (в переводе: TMyComponentStringPropertyEditor :)), унаследовав его от класса TStringProperty, который в свою очередь является потомком рассматриваемого класса TPropertyEditor: type TMyCSPEditor = class(TStringProperty) . Переопределим в нем несколько методов таким образом (фрагменты файла):
type TVRSIDBListViewExcludeColumnsPropertyEditor = class(TStringProperty) function GetAttributes: TPropertyAttributes; override; procedure Edit;override; end; -------------------------------------------------------------- procedure TVRSIDBListViewExcludeColumnsPropertyEditor.Edit; var Text: string; begin if InputQuery('Введите строковое значение',Text)=False then Exit; Self.SetValue(Text); end; function TVRSIDBListViewExcludeColumnsPropertyEditor.GetAttributes: TPropertyAttributes; begin Result:=[paDialog]; end; |
Метод Edit. Просто вызывается при щелчке на кнопке "…" в Object Inspector. В TStringProperty не переопределен. Метод SetValue(Text: string). Должен устанавливать значение свойства в переданную строку. В TStringProperty переопределен. Этот метод вызывается самим Object Inspector, когда пользователь вводит значение поля. Вы можете переопределить этот метод для установки вашего свойства в зависимости от значения, введенного пользователем. Если вы обнаруживаете ошибку в переданном параметре - вызовите исключение. Метод GetAttributes: TPropertyAttributes. Задает параметры свойства. Рассмотрим их по порядку. paValueList - указывает, что редактор свойств возвращает список допустимых значений свойства через метод GetValues. В редакторе свойств рядом со свойством появляется раскрывающийся список paSortList - указывает, что список, возвращенный GetValues нужно сортировать paSubProperties - указывает, что у свойства имеются подсвойства (типа подсвойства Name у свойства Font класса TFont). Подсвойства, если этот флаг установлен, должны возвращаться методом GetProperties. paDialog - указывает, что рядом со свойством должна быть кнопка "…", по нажатию которой вызывается метод Edit для редактирования значения свойства. Что мы и указали в нашем примере. paMultiSelect - Разрешает отображать свойство в Object Inspector, даже если выделено более одного объекта paAutoUpdate - указывает, что метод SetValue нужно вызывать при каждом изменении значения свойства, а не после нажатия Enter или выхода из Object Inspector (Пример: свойство Caption у формы изменяется одновременно с набором на клавиатуре) paReadOnly - указывает, что значение через Object Inspector изменить нельзя. Оно устанавливается в классе TClassProperty, от которого унаследованы все классовые редакторы свойств типа TStrings, TFont и т.п. При установке рядом со значением свойства отображается строка, возвращенная методом GetValue и значение это изменить нельзя. paRevertable - указывает, изменение значения свойства можно отменить. Это не касается вложенных подсвойств. paFullWidthName - указывает Object Inspector, что прорисовка значения свойства не требуется и можно занять под имя свойства всю длину панели. paVolatileSubProperties - установка этого значения указывает, что при любом изменении свойства нужно повторить сборку подсвойств (GetProperties) paVCL - ??? paReference - указывает, что свойство является указателем на что-либо. Используется вместе с paSubProperties для указазания отображения объекта, на которое ссылается в качестве подсвойств (TFont). paNotNestable - указывает, что отображать значение свойства в момент, когда его подсвойства развернуты - небезопасно (этот пункт мне пока непонятен) Методы GetXXXValue и SetXXXValue. Используются для внутренней установки реального значения свойства. Как правило, используются методом GetValue и SetValue. В принципе, все эти методы уже определены в классе TPropertyEditor, и переопределять их не нужно. Метод Modified вызывается для указания того факта, что значение свойства изменено. Это метод уже определен в TPropertyEditor и переопределять его не требуется. Метод GetEditValue возвращает true, если значение можно редактировать Метод GetIsDefault возвращает true, если значение свойства в текущий момент является значением свойства по умолчанию. Т.е. метод должен возвращать true, если НЕ нужно сохранять значение свойства в .dfm файле. Метод Activate вызывается при выборе свойства в Object Inspector. При использовании переопределения этого метода для отображения значения свойства исключительно в момент активизации нужно быть осторожным, если указаны параметры свойства paSubProperties и paMultiSelect. Метод AllEqual вызывается всякий раз, когда выделяется более одного компонента. Если этот метод вернет true, будет вызван метод GetValue, в противоположном случае будет отображена пустая строка. Вызывается только, если указано свойство paMultiSelect. Очевидно, метод должен проверять совпадение свойств у все выбранных компонентов путем опроса методе GetComponent. Метод AutoFill вызывается для определения, могут ли элементы списка быть выбраны по возрастанию. Указывается, только если указан параметр paValueList. Метод GetComponent возвращает компонент с заданным индексом из выбранных компонентов. Метод GetEditLimit возвращает максимальное количество символов, которые можно ввести в текстовое значение свойства. По умолчанию 255. Метод GetName возвращает имя свойства, в котором знаки подчеркивания заменены на пробелы. Метод должен переопределяться только, если свойство не предназначено для отображения в Object Inspector Метод GetComponentValue возвращает значение свойства типа TComponent в том и только в том случае, если свойство унаследовано от TComponent. Этот метод переопределяется в классе TComponentEditor Метод GetProperties вызывается для каждого подсвойства, которое редактируется. В метод передается параметр типа TGetPropertyProc. Это указатель на процедуру для обработки каждого свойства. Например, TClassProperty вызывает процедуру TGetPropertyProc для каждого published элемента класса, а TSetProperty - для каждого элемента множества. Т.е. при использовании подсвойств вы должны определить процедуру TGetPropertyProc, чтобы она определяла каждое подсвойство. Метод GetPropType возвращает указатель на информацию о типе редактируемого свойства (TypeInfo (Type)) Метод GetValue возвращает значение свойства в виде текстовой строки. Например, в TClassProperty этот метод переопределен для возвращения в качестве результата имени типа класса (TStrings и т.п.). Метод ValueAvailable возвращает true, если можно получить доступ к значению свойства, не вызывая исключения.
Описания для остальных методов и свойств, к сожалению, найти не удалось, поэтому исследовать их можно только опытным путем.
По завершении создания редактора свойств не забудьте зарегистрировать его внутри метода register вызовом RegisterPropertyEditor(TypeInfo(), , , ); RegisterPropertyEditor(TypeInfo(TMyComponentsStringProperty), TMyComponent, '', TMCSPEditor);
Передав вместо имени свойства пустую строку, мы указали тем самым, что имя может быть любым. Так же пустую строку можно передать вместо имени компонента.
Вот, собственно, и все. Пишите свой редактор свойств, переопределяйте нужные методы и вперед!
Создание собственной среды разработки
До настоящего момента были показаны приёмы непосредственной работы с элементами-потомками TParticulControl. Эти приёмы, как уже упоминалось, годятся для проектирования таких систем, работающих только в режиме редактирования (яркий пример - САПРы). Но во многих системах редактируемые элементы используются как в "DesignTime", так и в "RunTime" (Word, HTML-редакторы и пр.). Ясно, что данный подход для них неприемлем.
Данная проблема решена путём использования приёмов агрегации и установления прозрачности. Как уже было сказано ранее, TParticulControl имеет наследника TExternalControl, специально предназначенного для этой цели. Свойство ExternalObject элемента TExternalControl позволяет редактировать любые объекты (а не только компоненты!). Если объект не является наследником TControl, то он отображается, как в Delphi, квадратиком. TExternalControl располагается под редактируемым объектом, если тот является наследником TWinControl, в рабочем режиме, и над ним - в режиме редактирования.
Для того, чтобы обработать какой-либо объект, необходимо создать класс-потомок от TExternalControl для перекрытия методов GetTypeName, GetParticuls и SetParticul. Однако в отличие от TParticulControl в потомке TExternalControl методы служат для обработки свойств, полей, методов и событий не самого себя, а объекта ExternalObject. Перед использованием нового элемента управления необходимо присвоить его свойству ExternalObject редактируемый объект.
TExternalControl прозрачен, поэтому, в случае обработки потомка TControl будет отрисовываться именно потомок. В случае редактирования наследника от TWinControl необходимо "менять их местами" в режимах редактирования (TExternalControl.BringToFront) и рабочем (TExternal.SendToBack) для получения фокуса. В противном случае, невозможно будет добраться до нижнего.
В примере Example3 показано, как создать собственную среду разработки. Показано, как можно редактировать потомка TWinControl (TEdit внедрён в TParticulEdit), TControl (TImage в TParticulImage) и TObject (TParticulSample).
Также в примере показана обработка событий. Процедуры-обработчики для последних могут находится как на "несущей" форме, так и "внутри" объектов. Обработка событий идентична обработке перечислений (Enum): создаётся список-"перевод" на русский всех возможных процедур-обработчиков и выдаётся в виде списка, из которого пользователь выбирает нужную. Поскольку процедуры нельзя сравнивать (if OnEnter = SelfEnter then ...), то текущие процедуры отслеживаются путём присвоения их русских имён специальным полям в объекте (например, поля StrEnter, StrExit, StrMouseMove в TParticulEdit).
Также в примере показано, как обрабатывать данные типа TBitmap через свойство Handle.
Создание таблицы пользовательской базы данных
Для этого служит операция по кнопке NewT.
Работа платформы состоит в следующем, определяется текущая категория информации, которая занесена в свойство Tag в виде числового выражения ссылки на структуру категории информации TInfoCategory:
wTabSheet := FPageControl.ActivePage; wpTInfoCategory := pTInfoCategory(Pointer(wTabSheet.Tag)); В глобальные переменные заносятся соответствующие сведения: apDbType := wpTInfoCategory.sTFbDbType; apDbTypeS := wpTInfoCategory.sEnumName; Создается диалог формирования структуры таблицы и в него передается информация о категории информации, для которой нужно создать таблицу: if TbDlgFr = nil then TbDlgFr := TTbDlgFr.Create(nil); try TbDlgFr.DbInterface := FDbInterface; TbDlgFr.ppTInfoCategory := wpTInfoCategory; TbDlgFr.ShowModal; finally FreeAndNil(TbDlgFr); end;
Если после выхода из этого диалога имеется ненулевая ссылка на буферную структуру FDbInterface.N_pTTableInfo, то производится как обновление отображения главной формы, так и обновление системной базы данных в процедуре Update_Server(). Разумеется, на SQL сервере создается соответствующая таблица пользователя.
Суть обновления системной базы данных состоит в том, что в таблицу T_Tables заносятся сведения о вновь созданной таблице, а в таблицу T_Fields – информация о ее полях.
Создании серверной части обработки документа
Как было отмечено ранее, обработка HTTP запроса может осуществляться либо CGI-приложениями, либо Java-сервлетами. Возможен и вариант написания ASP-страниц. Но в этом случае передача данных возможна только методом "GET" через строку запроса. Хотя, обработка HTTP запроса ASP-страниц работает более эффективнее, чем CGI-приложением. Однако, на мой взгляд, без разницы, как обрабатывать, а важнее решить вопрос - как построить программму обработки, а не какими средствами.
Если из предыдущей главы мы рассмотрели варианты формирования XML-документ, то задача серверного приложения обратная - разбор XML-документов. Ниже представлена часть программы, осуществляющей разбор xml-документа:
procedure Tthread1.DataParser(Sender: Tobject); var r,FNode : IXMLDOMElement; // объявление объектов DOMElement Str,Filename : String; parm : String; CoDocXML, CoDocXSL, CoDocResult : CoDomDocument ; // объявление сокласса и XMLDoc, XSLDoc, ResultDoc : DomDocument ; // объекта XMLDomDocument // HttpStr : String; - глобальная переменная, содержащая строку HTTP запроса Begin XMLDoc:=coDocXML.Create; // создание документа XMLDoc XMLDoc.Set_async(false); // установка синхронного режима обрабработки XMLDoc.LoadXML(HttpStr); // загрузка DOM документа из строки HttpStr r:=Doc.Get_documentElement; // получение адреса корневого элемента FNode:= r.SelectSingleNode("//TypeDocument"); // получение значения элемента <TypeDocument> FileName:= FNode.GetAttibute("id"); // получение значения аттрибута id="Order" FileName:= FileName+".xsl"; // и формирование имени файла Order.xsl XSLDoc:=coDocXSL.Create; // создание документа XSLDoc XSLDoc.Set_async(false); // установка синхронного режима обрабработки XSLDoc.LoadXML(FileName); // загрузка DOM документа из файла Order.xsl ResultDoc:=coDocResult.Create; // создание документа XMLDoc ResultDoc.Set_async(false); // установка синхронного режима обрабработки ResultDoc.validateOnParse := true; // установка проверки разбора XMLDoc.transformNodeToObject(XSLDoc, ResultDoc); // разбор XMLDoc по XSL-шаблону Str:= ResultDoc.text; // переменной Str присваивается текстовое значение // результирующего документа. FNode:= r.SelectSingleNode("//InvoiceNumber"); // поиск элемента <InvoiceNumber> parm:= FNode.text; // и получение значения элемента Query.Close; // закрывает запрос для доступа Query.Text := Str; Query.Params[0].AsString := parm; // присваивание значения параметра Query.ExecSQL; // выполнение запроса end;
Вся изюминка разбора заключается в применении XSL-шаблона, который сформирован для каждого типа документа индивидуально. Результатом разбора является строка SQL-запроса. Впоследствие выполнение сформированной строки SQL-запроса осуществит необходимые изменения данных в СУБД.
Приимущество использования разбора через щаблон еще и в том, что получается некая гибкость данных, и получается полная независимость работы алгоритма от программного кода. Ниже приведен используемый для обработки документа типа ORDER текст XSL-шаблона:
<!-- файл Order.xsl --> <xsl:stylesheet xmlns:xsl="http://www.w3.org/TR/WD-xsl"> <xsl:template match="/"> <!-- применяем шаблон ко всему документу, начиная с корневого элемента "/" --> <HTML> <xsl:for-each select="//header"> <!-- формирование запроса для записи данных --> <!-- в таблицу регистрации приходящих сообщений TABREG --> INSERT into TABREG ( FROM, TO, TYPEDOC,body) VALUES( ' <xsl:value-of select="from" />' ,' <xsl:value-of select="to" />','<xsl:value-of select="TypeDocument/@id" />' ) </xsl:for-each> <!-- формирование запроса для записи данных в таблицу GOODS --> <!-- информация о товарах --> <xsl:for-each select="//item"> INSERT into GOODS ( invoiceNumber, name, price, quality) VALUES( ' :num', '<xsl:value-of select="name" />' , '<xsl:value-of select="price" />', '<xsl:value-of select="quality" /> ' ) </xsl:for-each> </HTML> </xsl:template> </xsl:stylesheet>
Поясняя вышеприведенный пример, надо отметить, что использование пары тагов <HTML> и </HTML> носит формальный характер, т.к. после разбора в результирующем XML-документе формально должен присутствовать хотябы один узел. Метод ResultDoc.text присваивает текстовае значение полученного в ходе разбора XML-документа ResultDoc. В этом случае значением является все то, что обрамлено пары тегов <HTML> и </HTML>, т.е. сформированный нами SQL-запрос.
Другой особенностью написания программы надо отметить возможность использования SQL-параметра :num. Использование параметра позволяет упростить текст xsl-шаблона. Определение значение соответствующих элементов узлов XML-документа определякется первоночально выбора по имени соответствующего узла, например:
FNode:= r.SelectSingleNode("//InvoiceNumber"); // поиск элемента >InvoiceNumber> и далее использование свойства text: parm:= FNode.text; // и получение значения элемента >InvoiceNumber>
Список использованной литературы.
Platform SDK Release: August 2002.
Алексей Павлов
Специально для
Moscow Power Engineering Institute (Technical University)
Faculty of Nuclear Power Plants
21.10.02
Скачать (886 K)
var StartupInfo: TStartupInfo; ProcessInformation: TProcessInformation;
//… var StartupInfo: TStartupInfo; ProcessInformation: TProcessInformation; begin GetStartupInfo(StartupInfo); with StartupInfo do begin wShowWindow := SW_HIDE; //не показывать окно dwFlags := STARTF_USESHOWWINDOW; end; // для примера будем запускать [c:\program files\Borland\Delphi5\Bin]grep.exe с ключом '?' Win32Check(CreateProcess(nil, 'command.com /c grep.exe ? > MyStdOut.txt', nil, nil, FALSE, CREATE_NEW_CONSOLE, nil, nil, StartupInfo, ProcessInformation)); // ждем пока наш процесс отработает WaitForSingleObject(ProcInfo.hProcess, INFINITE); Win32Check(CloseHandle(ProcInfo.hProcess); end;
//… var ProcInfo: TProcessInformation; StartupInfo: TStartupInfo; hOut, hOutDup: THandle; begin // Создаем файл в который и будем переназначать StdOut // Например, с такими настройками, вы можете их изменить под свои нужды hOut := CreateFile('MyStdOut.txt', GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); if (hOut = INVALID_HANDLE_VALUE) then RaiseLastWin32Error; А вот в этом месте и происходит все самое важное!!!
Необходимо сделать рукоятку нашего файла НАСЛЕДУЕМОЙ, что и делаем… Win32Check(DuplicateHandle(GetCurrentProcess, hOut, GetCurrentProcess, @hOutDup, 0, TRUE, DUPLICATE_SAME_ACCESS)); Небольшое замечание
Следует отметить, что если вы пишите прогу ТОЛЬКО под NT/2000, то сделать рукоятку наследуемой можно проще: Win32Check(SetHandleInformation (hOut, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT); и не надо будет заводить дубликат рукоятки hOutDup
// эта рукоятка нам уже не нужна, хотя вы можете ее использовать для своих целей Win32Check(CloseHandle(hOut)); GetStartupInfo(StartupInfo); with StartupInfo do begin wShowWindow := SW_HIDE; // не показывать окно dwFlags := dwFlags or STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; hStdOutput := hOutDup; // присваиваем рукоятку на свой файл end; Для примера будем запускать [c:\program files\Borland\Delphi5\Bin]grep.exe с ключом '?'
Вызов CreateProcess с флагом bInheritHandles = TRUE !!! Win32Check(CreateProcess(nil, 'grep.exe ?', nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, StartupInfo, ProcInfo)); // ждем пока наш процесс отработает WaitForSingleObject(ProcInfo.hProcess, INFINITE); Win32Check(CloseHandle(ProcInfo.hProcess)); //если вы больше ничего не хотите делать с файлом, в который перенаправили StdOut, то закроем его Win32Check(CloseHandle(hOutDup)); end;
Этот способ мне показал Юрий Зотов (поместив его в разделе "
Ссылки
подготовлен для Delphi5. где есть приличный компонент микшер.
Стандартные средства
Как известно, компонент TTimer основан на User таймерах, предоставляемых Win32API. Это просто VCL-оболочка, удобная для использования "на форме" системных таймеров данного типа. Для их работы требуется окно, поскольку программа получает извещение о срабатывании таймера посредством сообщения WM_TIMER. Без участия VCL для работы с ними необходим обработчик сообщения WM_TIMER и функции API:
CreateTimer SetTimer KillTimer
Да чем же они плохи, эти User таймеры? А вот чем!
Недостаток 1.
Как известно, сообщения в Win32 обрабатываются в следующем порядке очередности: синхронные сообщения (от SendMessage) асинхронные сообщения (от PostMessage) завершение приложения или WM_QUIT (от PostQuitMessage) асинхронный ввод (мышь, клавиатура) требование прорисовки или WM_PAINT извещения от User таймеров или WM_TIMER
Таким образом, сообщение WM_TIMER имеет наименьший приоритет и принимается только когда в очереди потока нет других сообщений. Это значит, что своевременному получению "тика" от User таймера может помешать как длительная обработка синхронных и асинхронных сообщений, так и реакция на интенсивный ввод пользователя, и даже активная перерисовка окон. Недостаток 2.
Кроме того, повторные сообщения WM_TIMER от того же таймера уничтожаются, если в очереди еще есть необработанное такое же. Все это приводит к потере тиков таймера, в результате программа получает меньше вызовов обработчика таймера на заданном интервале, чем рассчитывал программист. Недостаток 3.
Нельзя сделать так, чтобы моменты срабатывания были привязаны к системному времени (были синхронны с ним), т.е. чтобы таймер тикал в определенные часы, минуты, секунды. Он обязательно будет "уплывать". Недостаток 4.
О срабатывании таймера User уведомляется только один поток (тот, который вызвал SetTimer), поэтому невозможно пробудить по таймеру сразу несколько потоков. Недостаток 5.
Дискретность временного интервала оставляет желать лучшего. В Win9x она составляет 55 мс. Но даже в NT интервал квантуется не менее чем по 10 мс.
Stateful и stateless объекты
Как и обычные COM объекты, MTS объекты могут поддерживать свое внутренне сoстояние во время обращения к ним со стороны множества клиентов. Такие компоненты называют stateful. Но с другой стороны, MTS objects могут быть неустойчивыми (stateless), что означает, что объект не сохраняет свое внутреннее состояние (определяемое глобальными перемененными или полями в самом объекте) между обращениями к нему со стороны клиента. Напомним, что только Single модель гарантирует то, что компонент будет сохранять свое состояние между вызовами клиента. Т.е. только в этом случае вы можете использовать для доступа к базам данных компоненты Delphi, просто помещая их на модуль данных.
Следует иметь в виду, что такая модель работает значительно медленнее, и stateless объекты являются предпочтительнее.
При использовании любой потоковой модели значения локальных переменных не будут изменяться другими потоками (thread) во время их взаимодействия компонента с клиентом. Эту возможность и следует использовать, чтобы реализовать stateful свойство компонента. Например, для при работе с базами данных вы должны динамически создавать компоненты для доступа к ним ( TQuery, TADOQuery и т.д.) как локальные переменные в ваших методах, например:
function TMastCon.GetLZString (const RecID: Integer; const ConnectionString: WideString): String; var dsGetBlob: TADODataset; begin Result := ''; // Initialize string result to blank dsGetBlob := TADODataset.Create(nil); {Create TADODataset dynamically} try { Assign the ConnectionString w/c points to the DB } dsGetBlob.ConnectionString := ConnectionString; dsGetBlob.CommandText := 'select DocImage, RecID from _userblobs '+ 'where (RecID = :RecID) and (DocType=''LZ'')'; dsGetBlob.Parameters[0].Value := RecID; . . . . . . finally dsGetBlob.Free; //Release memory allocated to TADODataset end; end; |
В этом случае каждый поток (thread) будет использовать свой собственный локальный компонент ADODataset и они не будет мешать друг другу. А вот для уменьшения количества соединений к базе данных, можно использовать глобальный компонент TADOConnection (естественно, если все нити будут использовать одну и ту же БД с одними и теми же правами доступа). ет, что читатель легко сможет сделать соответствующие изменения в коде.
рбань С.В., дата публикации 23 декабря 2002г. |
Вообще - я программист молодой, стаж - всего 2 года. И я никак не ожидал, что в век GDI мне придется возится с консолью... Ан нет, пришлось.
Начал писать "движок" для собственного сайта. А именно - "Apache 1.x shared module" (dll - линкуется к Апачу и обрабатывает определенные адреса).
Написал. Всего три сотни строк. НО умеет кучу всяких полезностей, типа вставлять на страницы данные из файлов (файл в файл), строки и, главное, данные из БД. Все это прекрасно. НО не умеет вставлять результаты работы других файлов (типа как CGI). Ну, думаю, надо сделать.
Ага, а как? Вот тут то все и началось...
Итак,
ЗАДАЧА: запустить процесс (некий файл), передать ему команды и получить от него результаты работы. Вставить полученные результаты на страницу сайта.
Причем в целях совместимости механизмы передачи данных ДОЛЖНЫ быть стандартными - StdIn, StdOut, StdErr. Поискал на КД. Нашел вот такую штуку:
Хорошая статья, но мне-то НЕ в ФАЙЛ, а в ПРОГРАММУ надо!
ми :-)). Кому надо - тот сам вставит. (Вот так и рождается "кривой" код. Типа сейчас лень, потом добавлю... Ага... Через час уже забудешь!!!) В общем - перехожу таки к технике дела.
Для передачи данных используются "безымянные" (Anonymus) "каналы" (Pipes). Чтобы заставить программу писать в (читать из) канал (а) - просто подменяем соответствующие Std(In, Out, Err). Программа и знать не будет, что ее данные уходят в "трубу" а не на реальную консоль.
При создании каналов есть одна ВАЖНАЯ особенность. Создаем-то мы их в своем процессе (Parent) а использовать будем и в дочернем. (Учтите! дочерний процесс НЕ будет знать, что использует КАНАЛ! НО будет его использовать...). Так, вот, чтобы дочерний процесс мог нормально работать - хэндлы канала должны быть НАСЛЕДУЕМЫМИ.
Чтобы это обеспечить - надо правильно заполнить структуру SECURITY_ATTRIBUTES используемую при вызове CreatePipe:
New(FsaAttr); FsaAttr.nLength:=SizeOf(SECURITY_ATTRIBUTES); FsaAttr.bInheritHandle:=True; FsaAttr.lpSecurityDescriptor:=Nil; |
Заполнили? Молодцы! Теперь создаем каналы (я делаю только два, StdErr мне не нужен):
If not CreatePipe(FChildStdoutRd, FChildStdoutWr, FsaAttr, 0) Then //Создаем "читальный" Pipe raise ECreatePipeErr.CreateRes(@sCreatePipeMsg) Else If not CreatePipe(FChildStdinRd, FChildStdinWr, FsaAttr, 0) Then //Создаем "писальный" Pipe raise ECreatePipeErr.CreateRes(@sCreatePipeMsg) |
Есть еще одна тонкость. У нас Все созданные хэндлы наследуемые! А дочернему процессу понадобятся только два... Поэтому:
//Делаем НЕ наследуемые дубликаты //Это нужно, чтобы не тащить лишние хэндлы в дочерний процесс... If not DuplicateHandle(GetCurrentProcess(), FChildStdoutRd, GetCurrentProcess(), @Tmp1, 0, False, DUPLICATE_SAME_ACCESS) Then raise EDuplicateHandleErr.CreateRes(@sDuplicateHandleMsg) Else If not DuplicateHandle(GetCurrentProcess(), FChildStdinWr, GetCurrentProcess(), @Tmp2, 0, False, DUPLICATE_SAME_ACCESS) Then raise EDuplicateHandleErr.CreateRes(@sDuplicateHandleMsg) |
CloseHandle(FChildStdoutRd);//Закроем наследуемый вариант "Читального" хэндла CloseHandle(FChildStdinWr); //Закроем наследуемый вариант "Писального" хэндла FChildStdoutRd:=Tmp1; //И воткнем их места НЕ наследуемые дубликаты FChildStdinWr:=Tmp2; //И воткнем их места НЕ наследуемые дубликаты |
If not CreateChildProcess(ExeName, CommadLine, FChildStdinRd, FChildStdoutWr) Then //Наконец-то! Создаем дочерний процесс! raise ECreateChildProcessErr.CreateRes(@sCreateChildProcessMsg) |
//************************************************************************* function TChildProc.CreateChildProcess(ExeName, CommadLine: String; StdIn, StdOut: THandle): Boolean; Var piProcInfo: TProcessInformation; siStartInfo: TStartupInfo; begin // Set up members of STARTUPINFO structure. ZeroMemory(@siStartInfo, SizeOf(TStartupInfo)); siStartInfo.cb:=SizeOf(TStartupInfo); siStartInfo.hStdInput:=StdIn; siStartInfo.hStdOutput:=StdOut; siStartInfo.dwFlags:=STARTF_USESTDHANDLES; // Create the child process. Result:=CreateProcess(Nil, PChar(ExeName+' '+CommadLine), // command line Nil, // process security attributes Nil, // primary thread security attributes TRUE, // handles are inherited 0, // creation flags Nil, // use parent's environment Nil, // use parent's current directory siStartInfo, // STARTUPINFO pointer piProcInfo); // receives PROCESS_INFORMATION end; //************************************************************************* |
Самые умные (то есть те, кто ухитрился дочитать до этого места :-))) спросят:
- Ну, создали мы процесс и что дальше?
А дальше - мы можем с ентим процессом общаться! Например вот так:
//************************************************************************* function TChildProc.WriteToChild(Data: String; Timeout: Integer=1000): Boolean; Var dwWritten, BufSize: DWORD; chBuf: PChar; begin //Обратите внимание на Chr($0D)+Chr($0A)!!! Без них - будет работать с ошибками //На досуге - подумайте почему... //Для тех, кому думать лень - подскажу - это пара символов конца строки. //(вообще-то можно обойтись одним, но так надежнее, программы-то бывают разные) chBuf:=PChar(Data+Chr($0D)+Chr($0A)); BufSize:=Length(chBuf); Result:=WriteFile(FChildStdinWr, chBuf^, BufSize, dwWritten, Nil); Result:=Result and (BufSize = dwWritten); end; //************************************************************************* |
Читать - несколько сложнее. Нам же не надо вешать всю нашу программу только потому, что процесс не желает нам ничего сообщать??? А ReadFile - функция синхронная и висит - пока не прочитает! Если заранее известно, чего и сколько ДОЛЖЕН выдать процесс, то еще ничего... А если нет?
А если нет - делаем хитрый финт ушами :-) Есть у Мелко-Мягких такая ф-ия PeekNamedPipe. Не покупайтесь, на то, что она "Named" - фигня! Она прекрасно работает а анонимными пайпами! (кто не верит - можете почитать хелп)
Поэтому делаем так:
//************************************************************************* function TChildProc.ReadStrFromChild(Timeout: Integer): String; Var i: Integer; dwRead, BufSize, DesBufSize: DWORD; chBuf: PChar; Res: Boolean; begin Try BufSize:=0; New(chBuf); Repeat For i:=0 to 9 do begin Res:=PeekNamedPipe(FChildStdoutRd, nil, 0, nil, @DesBufSize, nil); Res:=Res and (DesBufSize > 0); If Res Then Break; Sleep(Round(Timeout/10)); end; If Res Then begin If DesBufSize > BufSize Then begin FreeMem(chBuf); GetMem(chBuf, DesBufSize); BufSize:=DesBufSize; end; Res:=ReadFile(FChildStdoutRd, chBuf^, BufSize, dwRead, Nil); Result:=Result+LeftStr(chBuf, dwRead); end; Until not Res; Except Result:='Read Err'; End; end; //************************************************************************* |
Если честно - с format'ом я не прверял - а вот help c парметрами и "net use" прошли на ура! Так что пришлось резко думать, как ограничить список разрешенных для запуска программ....
В общем, кому лень разбираться - вот вам исходники модуля с готовым классом. А вот пример его использования:
/************************************************************************* With TChildProc.Create(ReadIni(TagParams.Values['file'], FPage), TagParams.Values['cmd']) do Try WriteToChild(TagParams.Text); ReplaceText:=ReadStrFromChild; Finally Free; End; //************************************************************************* |
Скачать : Исходный код проекта (6 K) Исполняемый код (пример) (207 K)
Свойства COM компонента
Получение свойств компонента производится аналогичным образом и в дополнительных комментариях не нуждается.
function GetComponentProperties(ApplicationName, ComponentName: String; Properties: Tstrings): boolean; var MainCatalog : ICOMAdminCatalog; Apps : ICatalogCollection; App : ICatalogObject; Comps : ICatalogCollection; comp : ICatalogObject; props : ICatalogCollection; Prop : ICatalogObject; Appscount : integer; i,j,k : integer; compsCount : integer; propsCount : integer; propValue : Olevariant; stringPropValue : string; begin try MainCatalog := CoCOMAdminCatalog.Create; Apps := MainCatalog.GetCollection('Applications') as ICatalogCollection; Apps.Populate; Appscount := Apps.Count; for i := 0 to AppsCount -1 do begin App := ICatalogObject(Apps.Item[i]); if App.Name = ApplicationName then begin comps := ICatalogCollection(Apps.GetCollection('Components', app.Key)); comps.Populate; compsCount := comps.Count; for j := 0 to compsCount - 1 do begin comp := ICatalogObject(Comps.Item[j]); if comp.Name = ComponentName then begin props :=ICatalogCollection(comps.GetCollection('PropertyInfo',comp.Key)); props.Populate; propsCount := Props.Count; Properties.Text :=''; for k := 0 to propsCount-1 do begin prop := ICatalogObject(Props.Item [k]); propValue := (Comp.Value[prop.Name]); case VarType (PropValue) of varBoolean : if propValue = true then stringPropvalue := 'Y' else stringPropvalue := 'N'; else stringPropValue := string(PropValue); end; if prop.name = 'Transaction' then case integer(PropValue) of COMAdminTransactionIgnored : stringPropValue := 'Ignored'; COMAdminTransactionNone : stringPropValue := 'None '; COMAdminTransactionSupported : stringPropValue := 'Supported'; COMAdminTransactionRequired : stringPropValue := 'Required '; COMAdminTransactionRequiresNew : stringPropValue :='Requires New'; end; if prop.name = 'ThreadingModel' then case integer(PropValue) of COMAdminThreadingModelApartment :stringPropValue := 'Apartment'; COMAdminThreadingModelFree :stringPropValue := 'Free'; COMAdminThreadingModelMain :stringPropValue := 'Main'; COMAdminThreadingModelBoth :stringPropValue := 'Both'; COMAdminThreadingModelNeutral :stringPropValue := 'Neutral'; COMAdminThreadingModelNotSpecified :stringPropValue := 'Not Specified'; end; if prop.name = 'Synchronization' then case integer(PropValue) of COMAdminSynchronizationIgnored :stringPropValue := 'Ignored'; COMAdminSynchronizationNone :stringPropValue := 'None'; COMAdminSynchronizationSupported :stringPropValue := 'Supported'; COMAdminSynchronizationRequired :stringPropValue := 'Required'; COMAdminSynchronizationRequiresNew :stringPropValue := 'Requires New'; end; Properties.Add(prop.name + ' = '+ stringPropValue); end; end end end end; result := true; except result := false end end; |
function GetApplicationProperties(ApplicationName: String; Properties: TStrings): boolean; var MainCat : ICOMAdminCatalog; Apps : ICatalogCollection; App : ICatalogObject; props : ICatalogCollection; Prop : ICatalogObject; Appscount : integer; i,j : integer; propsCount : integer; propValue : Olevariant; stringPropValue : string; begin try MainCat := CoCOMAdminCatalog.Create; Apps := MainCat.GetCollection('Applications') as ICatalogCollection; Apps.Populate; Appscount := Apps.Count; for i := 0 to AppsCount -1 do begin App := ICatalogObject(Apps.Item[i]); if App.Name = ApplicationName then begin //show properties props := ICatalogCollection(Apps.GetCollection( 'PropertyInfo',App.Key)); props.Populate; propsCount := Props.Count; Properties.text :=''; for j := 0 to propsCount-1 do begin prop := ICatalogObject(Props.Item [j]); if not prop.IsPropertyWriteOnly then // you can't read it! begin propValue := (App.Value[prop.Name]); //Get property case VarType (PropValue) of varBoolean : // for Boolean properties if propValue = true then stringPropvalue := 'Y' else stringPropvalue := 'N'; else stringPropValue := string(PropValue); end; // Enumerated properties if prop.name = 'Authentication' then case integer(PropValue) of COMAdminAuthenticationDefault : stringPropvalue := 'Default'; COMAdminAuthenticationNone : stringPropvalue := 'None'; COMAdminAuthenticationConnect : stringPropvalue := 'Connect'; COMAdminAuthenticationCall : stringPropvalue := 'Call'; COMAdminAuthenticationPacket : stringPropvalue := 'Packet'; COMAdminAuthenticationIntegrity : stringPropvalue := 'Packet Integrity'; COMAdminAuthenticationPrivacy : stringPropvalue := 'Packet Privacy'; end; if prop.name = 'ImpersonationLevel' then case integer(PropValue) of COMAdminImpersonationAnonymous : stringPropvalue := 'Anonymous'; COMAdminImpersonationIdentify : stringPropvalue := 'Identify'; COMAdminImpersonationImpersonate : stringPropvalue := 'Impersonate'; COMAdminImpersonationDelegate : stringPropvalue := 'Delegate'; end; Properties.Add(prop.name + ' = '+ stringPropValue); // Add to list end end; end end; result := true; except result := false; end end; |
Раздел Подземелье Магов | н, дата публикации 18 июля 2001г. |
Мысль о хорошем таймере давно волнует умы программистов. Сразу оговорюсь, что речь не идет о прецизионном, "высокочастотном" иструменте отсчета интервалов времени, с дискретностью 1 мс и менее, как иногда хочется. Для этого существуют иные методы и/или иные операционные системы.
Здесь же будет построен просто надежный таймер общего назначения, который "тикнет" вовремя, во что бы то ни стало. Реализация в пределах стандартных возможностей Win32API, т.е. ничего "военного". Плюс одна интересная идея, заимствованная из мира Unix.
Текст монитора приведен ниже
Текст с высоты птичьего полета или Регулярные выражения
Раздел Подземелье Магов |
"Look for a white shirt and a white apron," said the head which had
been put together, speaking in a rather faint voice. "I'm the cook."
L. Frank Baum, The Emerald City of Oz
При решении прикладных задач, полезно рассматривать их с высоты "птичьего полета". Многие знают что это может существенно ускорить разработку, но не многие этим пользуются.
Разница в посимвольной обработке строк и обработке с помощью регулярных выражений в том, что в первом случае Вы думаете прежде всего как достичь цели, а во втором - а какая цель Вам собственно нужна ? %-) Кроме того, посимвольные алгоритмы трудно модифицировать, не говоря уж о том, что любая модификация сопровождается перекомпиляцией приложения.
В этой небольшой статье собрано несколько иллюстраций использования регулярных выражений в Delphi.
Прим. Если для Вас приведенные примеры выражений выглядят как древнеегипетские письмена, то ознакомьтесь с описанием их синтаксиса в любой книге о Perl или на . Они гораздо проще чем кажутся ! Для компиляции этих примеров достаточно добавить в список файлов проекта и вписать 'uses regexpr;' в юниты, где Вы используете регулярные выражения.
Детектор лжи |
Предположим, Вам необходимо выманить ;) у пользователя адрес его электронной почты (моральную сторону и маркетинговую обоснованность подобной затеи мы здесь рассматривать не будем).
Идея в том, что если отвергать синтаксически некорректные адреса, то большинству пользователей надоест играть в эту орлянку и они либо откажутся от Вашей программы / уйдут с web-страницы, либо введут синтаксически корректный адрес. А как рядовому юзеру проще всего ввести такой адрес ?.. Правильно ! Проще всего ввести свой реальный e-mail !
Естественно, что вариант с p := Pos ('@', email); if (p > 1) and (p < length (email)) then ... проблемы не решает. Желательно как минимум просмотреть строку на предмет отсутствия некорретных символов а также наличия домена второго (или выше) уровня. Конечно, любой программист напишет такой анализатор... строк этак на *дцать и с перспективой перекомпилировать программу если что-то не впишется в эту проверку.
А теперь забудьте о посимвольной обработке и посмотрите на этот же анализатор, упрятанный в одну строку : if ExecRegExpr ('[\w\d\-\.]+@[\w\d\-]+(\.[\w\d\-]+)+', email) then ... gotcha! ... Регулярные выражения позволяют гибко реализовать достаточно изощренные проверки. Вот, скажем абсолютно корректная проверка на ... римские цифры любой величины (шаблон позаимствован из книги "Mastering Perl"): const Mask1 = '^(?i)M*(D?C{0,3}|C[DM])(L?X{0,3}|X[LC])(V?I{0,3}|I[VX])$'; ... if not ExecRegExpr (Mask1, DBEdit1.Text) then begin ... show error message ... DBEdit1.SetFocus; end;
Персонального www-робота - каждому ! |
Например вот таким нехитрым способом можно получить курс доллара и дату этого курса программно, не рассматривая рекламные баннеры (да простят меня CityCat и ФинМаркет ;) ).
Бросьте на форму TBitBtn, TLabel и TNMHTTP (TNMHTTP здесь использован исключительно для упрощения примера. Использовать эту гадость в реальной жизни не советую :-E~ ) и вставьте такой код обработки нажатия BitBtn1: procedure TForm1.BitBtn1Click(Sender: TObject); const Template = '(?i)Официальный курс ЦБ по доллару' + '.*Дата\s*Курс\s*Курс пок.\s*Курс прод. [^<\d]*' + '(\d?\d)/(\d?\d)/(\d\d)\s*[\d.]+\s*([\d.]+)'; begin NMHTTP1.Get ('http://win.www.citycat.ru/finance/finmarket/_CBR/'); with TRegExpr.Create do try Expression := Template; if Exec (NMHTTP1.Body) then begin Label1.Caption := Format ('Курс на %s.%s.%s: %s', [Match [2], Match [1], Match [3], Match [4]]); end; finally Free; end; end; В этом примере используется очень мощный механизм backtrack, отличающий NFA (non-deterministic finite state machine) реализацию регулярных выражений от DFA (deterministic finite state machine). В случае с NFA (на базе которого построен и TRegExpr) мы получаем возможность работать с подвыражениями, что и использовано в примере выше для выделения из шаблона элементов даты и собственно курса.
Кстати, здесь уже проявляются и ограничения регулярных выражений (см. ). Решая подбную задачу, я бы предварительно обработал текст: убрал бы незначимые тэги (ИМХО для надержного анализа достаточно оставить только табличные тэги), из оставшихся тэгов убрал бы все модификаторы (size, align и т.п.), убрал бы все переводы строк, а табуляции заменил на пробелы и убрал после этого повторяющиеся пробелы. После этого можно уже написать гораздо более надежное регулярное выражение.
А вот так можно достаточно надежно вынуть из неформализованного текста все Санкт-Петербургские номера телефонов (представленные как '(812)123-4567' или '+7 (812) 12-345-67' и т.д., причем извлечены будут внутригородские части номеров): procedure ExtractPhones (const AText : string; APhones : TStrings); begin with TRegExpr.Create do try Expression := '(\+\d *)?(\((\d+)\) *)?(\d+(-\d*)*)'; if Exec (AText) then REPEAT if Match [3] = '812' then APhones.Add (Match [4]) UNTIL not ExecNext; finally Free; end; end;
Господин Оформитель |
Вот пример реализации (он не всегда сработает, но ведь 100% распознавание даже теоретически невозможно, да и в такого рода задачах не страшно если что-то не будет найдено. Страшно впустую тратить время на вспомогательные по сути вещи): type TDecorateURLsFlags = ( // Включаемые в видимую часть гипер-ссылки поля durlProto, // Протокол ('ftp://' или 'http://') durlAddr, // IP-адрес или символическое имя домена durlPort, // номер порта (например ':8080') durlPath, // путь (unix-формат) durlBMark, // объект внутри страницы (напрмер '#bookmark') durlParam // параметры запроса (например '?ID=13&User=Pupkin') ); TDecorateURLsFlagSet = set of TDecorateURLsFlags; function DecorateURLs (const AText : string; AFlags : TDecorateURLsFlagSet = [durlAddr, durlPath]) : string; const URLTemplate = '(?i)' // регистро-независимый режим + '(' + '(FTP|HTTP)://' // Протокол + '|www\.)' // Позволяет отловить ссылки указанные без 'http://' + '([\w\d\-]+(\.[\w\d\-]+)+)' // IP-адрес или символическое имя домена + '(:\d\d?\d?\d?\d?)?' // номер порта + '(((/[%+\w\d\-\\\.]*)+)*)' // путь (unix-формат) + '(\?[^\s=&]+=[^\s=&]+(&[^\s=&]+=[^\s=&]+)*)?' // параметры запроса + '(#[\w\d\-%+]+)?'; // объект внутри страницы var PrevPos : integer; s, Proto, Addr, HRef : string; begin Result := ''; PrevPos := 1; with TRegExpr.Create do try Expression := URLTemplate; if Exec (AText) then REPEAT s := ''; if CompareText (Match [1], 'www.') = 0 then begin Proto := 'http://'; Addr := Match [1] + Match [3]; HRef := Proto + Match [0]; end else begin Proto := Match [1]; Addr := Match [3]; HRef := Match [0]; end; if durlProto in AFlags then s := s + Proto; // Match [1] + '://'; if durlAddr in AFlags then s := s + Addr; // Match [2]; if durlPort in AFlags then s := s + Match [5]; if durlPath in AFlags then s := s + Match [6]; if durlParam in AFlags then s := s + Match [9]; if durlBMark in AFlags then s := s + Match [11]; Result := Result + System.Copy (AText, PrevPos, MatchPos [0] - PrevPos) + '<a href="' + HRef + '">' + s + '</a>'; PrevPos := MatchPos [0] + MatchLen [0]; UNTIL not ExecNext; Result := Result + System.Copy (AText, PrevPos, MaxInt); // Tail finally Free; end; end; { of function DecorateURLs -------------------------------} Обратите внимание, что в приведенном выше примере Вы имеете возможность легко выделять из URL протокол, домен, путь и параметры запроса (см. параметр AFlags).
Панацея ? |
Дело в том, что Перл - интерпретирующий язык. Основное следствие из этого - чем меньше операторов выполняется, тем быстрее (как правило) работает программа. В большистве случаев регулярное выражение отработает быстрее чем самый элементарный посимвольный анализ строки.
Поэтому, не кажется диким реализация функции Trim как выражения '^\s*(\S*)\s*$'.
Думаю, не надо объяснять насколько это глупо в истинно компилируемом Паскале. Так что, если анализируемая строка имеет простую структуру - напишите элементарный и очень быстрый цикл по ее разбору и не связывайтесь с регулярными выражениями.
Кроме того, не рекомендую использовать регулярные выражения там, где нужен полноценный парсер. Если, например, Вам нужно разобрать на теги HTML - поищите для этого более подходящий инструмент !
Если же искомая или проверяемая строка имеет сложную структуру, если эта структура может меняться, тогда это наш клиент ;) Если же описание должно меняться без перекомпиляции программы, то серьезной альтернативы регулярным выражениям практически нет.
Успехов !
Да, чуть не забыл, библиотека которая устраняет досадную забывчивость разработчиков Delphi и позволяет использовать в Delphi регулярные выражения без необходимости таскать за собой какие-либо DLL, лежит на
или
.
Андрей Сорокин
Специально для
Теоретические основы изображения кривых Безье
Теорию кривых Безье разработал П. де Кастело в 1959 году и, независимо от него, П. Безье в 1962 году. Для построения кривой Безье N-ого порядка необходимо N+1 точек, две из которых определяют концы кривой, а остальные N-1 называются опорными. В компьютерной графике наибольшее распространение получили квадратичные кривые Безье, строящиеся по трём точкам, и кубические кривые Безье, строящиеся по четырём точкам. Квадратичные кривые Безье используются, например, в шрифтах TrueType при определении контуров символов. API Windows позволяет строить только кубические кривые Безье.
Кубические кривые Безье задаются следующей формулой: P(t)=A*(1-t)3+3*B*t*(1-t)2+3*C*(1-t)*t2+3*D*t3, (1) где A - начало кривой, D - её конец, а B и C - первая и вторая опорные точки. Прямая AB является касательной к кривой в точке A, прямая CD - в точке D. Параметр t изменяется от 0 до 1. При t=0 P(t)=A, при t=1 P(t)=D
Одним из важнейших свойств кривой Безье является её делимость. Если кривую разделить на две кривых в точке t=0.5, каждая из полученных кривых также будет являться кривой Безье. На этом свойстве основывается алгоритм рисования кривых Безье: если кривая может быть достаточно точно аппроксимирована прямой, рисуется отрезок прямой, если нет - она разбивается на две кривых Безье, к каждой из которых вновь применяется этот алгоритм.
В Windows поддерживается два типа кривых: кубические кривые Безье и эллиптические дуги. В Windows 9x/Me дуги рисуются независимо от кривых Безье. В Windows NT/2000/XP дуги аппроксимируются кривыми Безье.
Для рисования кривых Безье используются функции PolyBezier, PolyBezierTo и PolyDraw.
В некоторых случаях удобно строить кривую Безье не по опорным точкам, а по точкам, через которые она должна пройти. Пусть кривая начинается в точке A, при t=1/3 проходит через точку B`, при t=2/3 - через точку C`, и заканчивается в точке D. Подставляя эти точки в уравнение (1), получаем систему, связывающую B` и C` с B и C. Решая систему, получаем:
B=(-5*A+18*B`-9*C`+2*D)/6 (2) C=(2*A-9*B`+18*C`-5*D)/6
Из этих уравнений, в частности, следует, что для любых четырёх точек плоскости существует, и притом единственная, кривая Безье, которая начинается в первой точке, проходит при t=1/3 через вторую точку, при t=2/3 - через третью и завершается в четвёртой точке. Аналогичным образом можно вычислить опорные точки для кривой, которая должна проходить через заданные точки при других значениях t.
Тестирование
Разумеется, в мире нет ничего абсолютного. А тем более когда дело касается столь нереалтаймовой системы как Уиндоус. Впрочем, в случае real-time OS вопрос о таймерах вообще бы не стоял. А в наших условиях вполне может найтись в системе какой-нибудь хулиганский поток с высоким приоритетом (выше или равным нашему), который наглым образом будет отбирать управление на длительное время (больше длительности внутреннего цикла таймерного менеджера - 10 мс). И тогда наш таймер будет пропускать "тики" на коротких заданных интервалах и увеличивать погрешность на длинных. Это происходит в том случае, если кто-то работает не по правилам, либо производительности процессора не хватает для работы системы.
В целях проверки и демонстрации функционирования таймерного менеджера, а также сравнительного анализа со стандартным таймером была разработана демо-программа ().
Сравнивались: компонент TTimer, два интервальных таймера с разными способами уведомления (сообщение окну и асинхронный вызов), один синхронизированный таймер. Подсчитывалось количество срабатываний. Каждый факт срабатывания таймера записывался в журнал (TMemo), что также играло роль полезной нагрузки в работе приложения (попросту отъедание процессорного времени). Дополнительная нагрузка по инициативе пользователя эмулировалась задержкой (sleep) в обработчике событи OnClick кнопки. Одновременно контролировалась загрузка процессора по показаниям Windows NT Task Manager.
Проведенные исследования показали (см. таблицу), что интервальный таймер ведет себя почти идеально от 100 мс и достаточно хорошо на более мелких интервалах, тогда как стандартный таймер на коротких интервалах, а особенно под нагрузкой совсем сдает позиции. На интервале 10 мс интенсивная обработка извещений от таймеров (обновление контролов, особенно TMemo) приводит к 100% загрузке процессора. Синхронизированный таймер (FixedTimer), заряженный на минимальный интервал 1 с, всегда давал точное число тиков, причем срабатывал в начале секунды с небольшим разбросом.
От способа уведомления количество полученных тиков не зависело. При большой нагрузке и высокой частоте приложение могло получать уведомления PostMessage неравномерно (пачками накопленных в очереди сообщений), но общее число выдерживалось, насколько это возможно.
Результаты приведены для следующей конфигурации: Cyrix 6x86PR233/64M/WinNT4. Измерения проводились также на платформе Win98SE, где IntervalTimer показал примерно те же результаты, а TTimer еще более худшие.
Нормальные условия | |||||
100 | 10000 | 100 | 99 | 100 | 3-12 |
100 | 100000 | 1000 | 998 | 1000 | 3-12 |
10 | 10000 | 1000 | 659 | 999 | 100 |
10 | 100000 | 10000 | 6361 | 9991 | 100 |
15 | 10000 | 667 | 482 | 667 | 44-60 |
Нагрузка приложения (задержка на 2000 мс) | |||||
100 | 10000 | 100 | 79 | 100 | 2-17 |
15 | 10000 | 667 | 333 | 667 | 2-100 |
10 | 10000 | 1000 | 156 | 999 | 2-100 |
Внешняя нагрузка (играющий Winamp) | |||||
100 | 10000 | 100 | 97 | 100 | 28-51 |
15 | 10000 | 667 | 175 | 632 | 100 |
10 | 10000 | 1000 | 22 | 894 | 100 |
Специально для
Исходные тексты программ, приложенные к данной статье, распространяются на правах freeware.
Все исходные тексты и откомпилированная DLL собраны в архив .
Тестовая программа (исходные тексты) отдельно в файле
Для интересующихся - сорцы версии на С++ в файле .
Типы данных
Некоторые задачи обеспечения целостности базы данных и адаптации ее к предметной области оказались легко решаемыми посредством ввода специальных структур для хранения в памяти информации о типах данных, причем в них содержатся не только традиционные сведения, такие, как тип поля, ее размер и т.д., но и дополнительная информация, вводимая для повышения удобства работы с ними настройщику и пользователю. К такой информации относится, прежде всего, смысловое наименование типа, понятное для пользователя, не обладающего специальными знаниями в области программирования. Так, например, программисту все ясно, когда он видит обозначение типа как ftInteger, а для пользователя лучше, когда он увидит в качестве обозначения типа фразу «Целое число». Для ряда задач оказалось удобным создать специальный набор структур, предназначенных для хранения информации о типах полей, используемых для связей между таблицами, а также типов полей для хранения данных, выбираемых пользователем из собственных списков, по существу являющихся справочниками небольшого объема. В таких структурах дополнительной информацией являются смысловые названия полей и списков. В связи с этим были введены так называемые группы данных, каждая из которых представляет собой определенный набор типов данных, имеющих общий признак, т.е. описываемых структурой одного и того же типа. Обратим внимание, что фактически все поля, с которыми манипулирует наша платформа, имеют типы, предусмотренные в BDE, и здесь ничего нового нет. Новое понятие групп данных связано с характером той дополнительной информации, которая сопровождает параметры типа поля в указанных структурах. Если эта информация сводится просто к названию типа и нет других особенностей, связанных с полем, имеющим этот тип (например, просто поле имеет тип «Целое число»), то мы будем такие поля относить к базовой группе данных, а во всех остальных случаях – к той или иной группе данных, в зависимости от характера дополнительной информации, которая важна с точки зрения назначения системы. В этих случаях уже неважно, как называется тип по канонам BDE, - эта информация в структуру даже не вводится, так как дополнительная информация, вводимая в структуру, косвенно содержит описание типа. Так, если поле предназначено для хранения информации из списков, то косвенно это означает, что тип поля ftString. Важно еще подчеркнуть, что групп данных априори может быть сколько угодно. В описываемой платформе пока таких групп реализовано четыре.
Базовая группа данных Прежде всего, разработчику следует решить, какие типы данных, реализуемые BDE, он собирается использовать в своей платформе. Вряд ли целесообразно организовывать поддержку почти сорока типов, перечисленных в BDE. Следует поддерживать часто используемые типы, такие как ftString, ftInteger, ftFloat, ftDate, ftTime, ftDateTime. Для автоинкрементных полей понадобится тип ftAutoInc. Для работы с текстами, графикой и вообще с бинарными данными нужны ftBlob, ftMemo, и, возможно, ftGraphic. Дальнейшее расширение базовой группы скорее носит узкоспециализированный характер.
Чтобы настройщик и пользователь могли свободно манипулировать выбранным подмножеством типов данных, целесообразно ввести структуру:
// Структура базового типа данных TFbBaseType = record sType: TFieldType; // идентификация типа BDE sBytes, // количество байтов под данный тип sSize, // размер типа, аналог из BDE sInc: Integer; // признак включения типа в платформу sDescr: ShortString; // краткое описание типа end; |
Ссылочная группа данных Ссылочная группа данных связана с требованием обязательности автоинкрементного поля в каждой таблице базы данных. Под ссылкой на таблицу можно иметь в виду поле целого типа, в котором хранится содержимое автоинкрементного поля той таблицы, на которую создается ссылка (ведущей таблицы). Для работы с ссылочными типами данных введена структура:
// Структура ссылочного типа данных TFbReferenceType = record sType: TFieldType; sBytes, sSize, sInc: Integer; sDescr: ShortString; spTableInfo: pTTableInfo; end; |
Следящая группа данных Следящая группа данных особых пояснений не требует, т.к. принцип работы с ней в целом аналогичен принципу работы со ссылочной группой. Особенность состоит в том, что в структуру управления, помимо ранее рассмотренного указателя на структуру таблицы, вводится указатель на структуру того поля, на которое создается ссылка (ведущее поле), а тип sType устанавливается равным типу ведущего поля:
// Структура следящего типа данных TFbLookupType = record sType: TFieldType; sBytes, sSize, sInc: Integer; sDescr: ShortString; spFieldInfo: pTFieldInfo; spTableInfo: pTTableInfo; end; |
Списочная группа данных Простейший список может состоять из значений Да, Нет. Списков аналогичного свойства, содержащих от двух до десятка и более членов, из которых пользователь может выбирать значение, любая предметная область содержит во множестве. Так, очень удобно реализовывать такими списками справочники небольшого объема. Примером может быть справочник частей света из 6 членов: Европа, Азия, Америка, Африка, Австралия и Антарктида. Другой пример - набор специальностей медицинского персонала, и т.д. Структура для работы со списочными типами, по аналогии с остальными, имеет вид:
// Структура списочного типа данных TFbPickType = record sType: TFieldType; sBytes, sSize, sInc: Integer; sDescr: ShortString; sPickList: TStrings; end; |
Для централизованного управления программным кодом в процессе использования групп данных целесообразно ввести обобщенную структуру. Предвидя это, мы намеренно вводили для всех групп данных схожие структуры для работы с ними в памяти. Сначала введем комбинированный тип для групп данных: TFbTypeGroup = (FldGroup, RefGroup, PicGroup, LUpGroup, NoGroup) соответственно идентифицирующий базовую, ссылочную, списочную и следящую группы. Для полноты в него введен тип NoGroup, не содержащий никакой группы.
Получаем структуру обобщенного (комбинированного) типа данных в виде вариантной записи:
// Структура комбинированного типа данных TFbCommonType = packed record FbTypeGroup: TFbTypeGroup; case TFbTypeGroup of FldGroup: (FbFld: pTFbBaseType); RefGroup: (FbRef: pTFbReferenceType); PicGroup: (FbPic: pTFbPickType); LUpGroup: (FbLUp: pTFbLookupType); NoGroup: (); end; |
Модернизируем структуру поля, приведенную выше (см. раздел ):
// Структура поля TFieldInfo = record sFieldAttr: TStrings; // атрибуты поля: { sFieldName - Имя поля } { sMTableName - Имя ведущей таблицы } { sMFieldName - Имя ведущего поля } { sPicDescr - Имя списочного типа } { sFieldCaption - Наименование } { sFieldDescr - Описание } sFieldType: TFieldType; sFieldSize: Integer; sFieldMBytes: Integer; sMTTableInfo : pTTableInfo; // Ссылка на структуру главной таблицы sMTFieldInfo : pTFieldInfo; // Ссылка на структуру главного поля sPickList : TStrings; // Список списочного типа end; |
Приведенные правила позволяют хранить необходимую информацию о типах полей в системной базе данных, а при загрузке приложения создавать в памяти необходимые списки структур TFbCommonType. Это - ключевая задача, которая обеспечивает возможность работать с типами полей в платформе в режиме конфигуратора, а в пользовательском режиме - реализовать ссылки и списки значений.
После такого утомительного экскурса в дебри построения платформы, вернемся к листингу L2, чтобы пояснить как работает диалог с полями-переменными FpTFbCommonType : pTFbCommonType; FTFbTypeGroup : TfbTypeGroup.
В момент передачи диалогу ссылки на интерфейс к базам данных в обработчике Set_FDbInterface производится заполнение списка групп данных TypeGroupCmBox.
При выборе какого-либо конкретного элемента из этого списка по событию TypeGroupCmBoxChange будет заполнен соответствующий список типов данных TypesComboBox, из которого пользователь может выбрать конкретный тип поля, формируемого диалогом.
После открытия диалога формирования поля необходимо выбрать группу данных, а затем из списка типов данных этой группы выбрать конкретное значение типа. Подчеркнем еще раз, что в ссылочной и следящей группах данных информация появляется только при наличии в базе данных таблиц.
При выходе из диалога по кнопке ОК выполняется метод Execute, в котором задаются атрибуты буферной структуры поля FDbInterface.N_pTFieldInfo, созданной до входа в данный дилог.
В заключение раздела, касающегося создания таблицы, приведем листинг диалога, в котором производится формирование списка полей для таблицы. Особенность данного диалога состоит в том, что при входе в него автоматически создается начальная структура поля для автоинкрементного поля.
Листинг L3.
, приведенного в листинге L3.
Траектории
API Windows реализует поддержку специфических объектов, называемых траекториями (path). Траектория представляет собой запись движения пера и состоит из одного или нескольких замкнутых контуров. Каждый контур состоит из отрезков прямых и кривых Безье. Для построения траектории в Windows NT/2000/XP могут быть использованы все графические функции рисования прямых, кривых и замкнутых контуров, а также функции вывода текста (в этом случае замкнутые контуры будут совпадать с контурами символов). В Windows 9x/Me могут быть использованы только функции рисования прямых, ломаных, многоугольников (за исключением PolyDraw и Rectangle), кривых Безье и функций вывода текста. Для создания траектории используются функции BeginPath и EndPath. Все вызовы графических функций, расположенные между BeginPath и EndPath, вместо вывода в контекст устройства будут создавать в нём траекторию.
После того как траектория построена, её можно отобразить или преобразовать. Мы не будем здесь перечислять все возможные операции с траекториями, остановимся только на преобразовании траектории в ломаную. Как уже отмечалось выше, все контуры траектории представляют собой набор отрезков прямых и кривых Безье. С другой стороны, при построении кривой Безье она аппроксимируется ломаной. Следовательно, вся траектория может быть аппроксимирована набором отрезков прямой. Функция FlattenPath преобразует кривые Безье, входящие в состав траектории, в ломаные линии. Таким образом, после вызова этой функции траектория будет состоять из отрезков прямой.
Отметим также некоторые другие преобразования траектории, полезные для создания графических редакторов и подобных им программ. Функция PathToRegion позволяет преобразовать траекторию в регион. Это может понадобиться, в частности, при определении, попадает ли курсор мыши в область объекта, представляемого сложной фигурой. Функция WidenPath превращает каждый контур траектории в два контура - внутренний и внешний. Расстояние между ними определяется толщиной текущего пера. Таким образом, траектория как бы утолщается. После преобразования утолщённой траектории в регион можно определять, попадает ли курсор мыши на кривую с учётом погрешности, определяемой толщиной пера.
Поучить информацию о точках текущей траектории можно с помощью функции GetPath. Для каждой точки траектории эта функция возвращает координаты и тип точки (начальная линии, замыкающая точка отрезка, точка кривой Безье, конец контура).
Таким образом, создав траекторию из кривой Безье (BeginPath/PolyBezier/EndPath), мы можем преобразовать эту траекторию в ломаную (FlattenPath), а затем получить координаты узлов этой ломаной (GetPath).
Требования к MTS объектам
В дополнение к обычным требованиям, предъявляемым COM к компонентам, MTS требует, чтобы компоненты находились внутри DLL.
Кроме того, существуют следующие требования, которые Мастера Delphi выполняют автоматически: При создании компонента он должен использовать стандартную фабрику классов (class factory), создаваемую. Компонент должен предоставлять доступ к входящим в него класс объектам (class object) с помощью стандартного метода DllGetClassObject. Все интерфейсы и классы (coclasses) должны быть описаны в библиотеке типов (type library), которая создается мастером и все методы и свойства должны создаваться с помощью Редактора библиотеки типов (Type Library editor). Компоненты должны поддерживать стандартный маршалинг (COM marshaling), который используется мастеров создания компонентов. Все интерфейсы должны быть дуальными (dual interface), что позволяет COM осуществлять автоматическую поддержку маршалинга. Компоненты должны поддерживать автоматическую регистрацию с помощью функции DllRegisterServer. Компоненты, выполняемые под управлением MTS не должны агрегатировать (aggregate) другие компоненты, которые выполняются вне MTS
Удаление поля в пользовательской таблице
Реализуется по кнопке DeleteF главной формы конфигуратора. В данном случае поступают по следующей схеме. Сначала из системной таблицы удаляется информация о выбранном поле в процедуре
RemoveFrom_T_Fields(FDbInterface, FpTFieldInfo);
Затем удаляется информация из списка FieldsLBox на главной форме и, наконец, пользуясь методом
FDbInterface.DeleteField(FpTTableInfo.sTableAttr.Values['sTableName'], FpTFieldInfo.sFieldAttr.Values['sFieldName']) удаляют структуру поля в памяти и обновляют структуру таблицы на сервере базы данных. В заключение производится обновление списков типов данных FDbInterface.Update_FbCommonTypeList.
(Продолжение следует)
Скачать пример: Исходные коды (51K) Backup базы (1.2M)
Николай Озниев
Удаление пользовательской таблицы
Реализуется по кнопке DeleteT главной формы конфигуратора. Сначала определяется ссылка на выбранную структуру таблицы через свойство Tag активной страницы объекта FPageControl, а затем вся работа выполняется в процедуре Delete_Table, в которую передается ссылка на структуру удаляемой таблицы.
В этой процедуре сначала удаляется информация о таблице из системных таблиц T_Tables и T_Fields с помощью соответствующих SQL-запросов. Затем удаляется из памяти структура поля вызовом специально для этого предназначенного метода интерфейса к базам данных:
FDbInterface.Dispose_pTTableInfo(ApTTableInfo, True, True);
Здесь второй параметр указывает на необходимость удаления списка структур полей, а третий – на необходимость обновления информации о типах. Последнее действие необходимо в связи с тем, что при удалении любой таблицы происходит удаление одной записи в списке ссылочной группы данных и удаление из списка следящей группы данных стольких записей, сколько было полей в удаляемой таблице, не считая автоинкрементного поля.
Установка компонента в пакет
Выполнить эту операцию можно с помощью метода InstallComponent интерфейса ICOMAdminCatalog ComAdminCatalog.InstallComponent('COMTest', 'D:\users\Tranning\COM+\Capital.dll', '',''); где в первый параметр - имя пакета, в который будет устанавливаться компонент, второй - имя компонента (файла) который будет устанавливаться, следующий параметр - имя файла с библиотекой типов (в том случае, если она встроена в главный файл, то его можно опустить) и имя proxy-stub .dll (если не используется, то его так же опускают).
Установка MapX в Delphi
После установки дистрибутива MapX на компьютер нужно установить MapX в Delphi. Следующие шаги устанавливают МарХ в Delphi package. Это необходимо сделать только один раз. Откройте Delphi с новым, пустым проектом. Выберите Import ActiveX Control из меню Components
Выберите MapInfo MapX V5 из списка, и нажмите Install.
В диалоге Install, установите его в по умолчанию в пакете программ Borland User's Components. Нажмите Yes чтобы перекомпилировать пакет программ (package), затем закройте и сохраните окно Package.
Пиктограмма МарХ должна появиться в Controls palette, в разделе ActiveX.