Статьи Королевства Дельфи

         

Создание DTD для объекта


Раздел Подземелье Магов

Содержание

За созданием кода для сериализации и десериализации объектов в Delphi логично перейти к рассмотрению вопроса о возможности генерации соответствующего DTD для сохраняемых в XML классов. DTD понадобится нам, если мы захотим провести проверку XML документа на корректность и допустимость с помощью одного из XML анализаторов. Работа с анализатором MSXML рассмотрена в статье на есть. Необходимо рекурсивно пройтись по всем свойствам объекта и сгенерировать модели содержания для каждого тега. При сериализации в XML мы не использовали атрибутов, а значит мы не сможем в DTD установить контроль над содержанием конкретных элементов. Остается только определить модель содержания для XML, т.е. вложенность тегов в друг друга. Хотя стандарт DTD устаревает и следует переходить к использованию схем, будет полезным обеспечить возможность создания DTD для наших объектов.

Создадим процедуру GenerateDTD(), которая обеспечит запись формируемого DTD для заданного объекта Component в заданный поток Stream. Она создает список DTDList, в котором будут накапливаться атрибуты DTD, после чего передает всю черновую работу процедуре GenerateDTDInternal().

{ Процедура генерации DTD для заданного объекта в соответсвии с published интерфейсом его класса. Вход: Component - объект Выход: текст DTD в поток Stream } procedure GenerateDTD(Component: TObject; Stream: TStream); var DTDList: TStringList; begin DTDList := TStringList.Create; try GenerateDTDInternal(Component, DTDList, Stream, Component.ClassName); finally DTDList.Free; end; end;



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

Для всех неклассовых типов модель содержания это - (#PCDATA). К примеру, свойство объекта Tag: integer превращается в .

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


{ Внутренняя рекурсивная процедура генерации DTD для заданного объекта. Вход: Component - объект DTDList - список уже определенных элементов DTD для предотвращения повторений. Выход: текст DTD в поток Stream } procedure GenerateDTDInternal(Component: TObject; DTDList: TStrings; Stream: TStream; const ComponentTagName: string); var PropInfo: PPropInfo; TypeInf, PropTypeInf: PTypeInfo; EnumInfo: PTypeInfo; TypeData: PTypeData; i, j: integer; AName, PropName, sPropValue, s, TagContent: string; PropList: PPropList; NumProps: word; PropObject: TObject; const PCDATA = '#PCDATA'; procedure addElement(const ElementName: string; Data: string); var s: string; begin if DTDList.IndexOf(ElementName) <> -1 then exit; DTDList.Add(ElementName); s := '<!ELEMENT ' + ElementName + ' '; if Data = '' then Data := PCDATA; s := s + '(' + Data + ')>'#13#10; Stream.Write(PChar(s)[0], length(s)); end; begin { Playing with RTTI } TypeInf := Component.ClassInfo; AName := TypeInf^.Name; TypeData := GetTypeData(TypeInf); NumProps := TypeData^.PropCount; GetMem(PropList, NumProps*sizeof(pointer)); try { Получаем список свойств } GetPropInfos(TypeInf, PropList); TagContent := ''; for i := 0 to NumProps-1 do begin PropName := PropList^[i]^.Name; PropTypeInf := PropList^[i]^.PropType^; PropInfo := PropList^[i]; { Пропустить не поддерживаемые типы } if not (PropTypeInf^.Kind in [tkDynArray, tkArray, tkRecord, tkInterface, tkMethod]) then begin if TagContent <> '' then TagContent := TagContent + '|'; TagContent := TagContent + PropName; end; case PropTypeInf^.Kind of tkInteger, tkChar, tkFloat, tkString, tkWChar, tkLString, tkWString, tkVariant, tkEnumeration, tkSet: begin { Перевод в DTD. Для данных типов модель содержания - #PCDATA } addElement(PropName, PCDATA); end; { код был бы полезен при использовании атрибутов tkEnumeration: begin TypeData:= GetTypeData(GetTypeData(PropTypeInf)^.BaseType^); s := ''; for j := TypeData^.MinValue to TypeData^.MaxValue do begin if s <> '' then s := s + '|'; s := s + GetEnumName(PropTypeInf, j); end; addElement(PropName, s); end; } tkClass: { Для классовых типов рекурсивная обработка } begin PropObject := GetObjectProp(Component, PropInfo); if Assigned(PropObject)then begin { Для дочерних свойств-классов - рекурсивный вызов } if (PropObject is TPersistent) then GenerateDTDInternal(PropObject, DTDList, Stream, PropName); end; end; end; end; { Индивидуальный подход к некоторым классам } { Для коллекций необходимо включить в модель содержания тип элемента } if (Component is TCollection) then begin if TagContent <> '' then TagContent := TagContent + '|'; TagContent := TagContent + (Component as TCollection).ItemClass.ClassName + '*'; end; { Добавляем модель содержания для элемента } addElement(ComponentTagName, TagContent); finally FreeMem(PropList, NumProps*sizeof(pointer)); end; end; Закоментированный код нам не нужен, но он не удален, т.к. он демонстрирует получение списка возможных значений для перечисления (Enumeration) и набора (Set). Это может понадобится, если появится необходимость генерировать свойства в виде атрибутов XML тегов и, соответственно, DTD для возможных значений этих атрибутов.

Продолжение



Создание и наследование элементов управления, редактирование особенностей


Редакторы-наследники 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+ весь обмен информацией между компьютерами осуществляется самим COM+, то данный код не требуется и его нужно удалить руками, как из интерфейсной части компонента, так и из его реализации.

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


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


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

Первый способ наиболее простой. В начале необходимо определиться с формой. Здесь возможны два варианта: или создать форму в DesignTime или в RunTime. Обработка формы будет происходить внутри специальной процедуры типа TExecutor, которую затем необходимо будет зарегистрировать:

const dtSample = 100; ... procedure function SampleExecutor(Code, Info: string; var Changed: Boolean; ReadMode: Boolean = False): string; ... implementation ... procedure function SampleExecutor(Code, Info: string; var Changed: Boolean; ReadMode: Boolean = False): string; var SampleForm: TSampleForm; {или TForm, если в RunTime} begin Changed := False; SampleForm := TSampleForm.Create(nil); with SampleForm do begin ... end; procedure TForm1.FormCreate(Sender: TObject); begin RegisterData(dtSample, TButtonEditor, SampleExecutor); ... end; ... end; Не следует регистрировать новый тип данных в конструкторе элемента управления!!! При создании второго экземпляра элемента возникнет ошибка регистрации ERegister (так как это будет попытка зарегистрировать ещё раз на один и тот же номер).
Теперь можно этот новый тип использовать: function TSampleControl.GetParticuls: TParticulList; var P: TParticul; begin ... P := DoProperty('Новый тип', dtSample, ...); ... end; Но иногда хочется обработать новые данные более красивым способом. Тогда можно пойти вторым способом - создать собственный редактор свойств. Как я уже упоминал, не все элементы управления подходят для создания собственного редактора, так, например, трудно будет что-либо редактировать в TStringGrid'е стандартной высотой 20 пикселов!


Перед написанием собственного редактора необходимо выбрать элемент управления, который отобразится в рабочей области Инспектора. Это может быть либо один из элементов управления VCL, обязательно наследник TWinControl (так, например, TSpeedButton не подойдёт!), либо собственный созданный элемент управления, наследник TWinControl (TCustomControl). В конструкторе редактора необходимо инициализировать этот элемент процедурой Init, без инициализации возникнет EAccessViolation. Новый редактор, естественно, должен быть наследником TParticulEditor.

TMyControl = class(TCustomControl) ... TSampleEditor = class(TParticulEditor) ... constructor TSampleEditor.Create; begin inherited Create; Init(TMyControl); ... end; Далее в конструкторе должны быть сделаны необходимые установки: стиль, границы (если необходимо) и, главное, назначены процедуры-обработчики событий для редактирования новой особенности. Так, например, изменение особенности в TEditEditor'е и TComboBoxEditor'е осуществляет OnChange, в TButtonEditor'е и TCheckBoxEditor'е - OnClick. Обработчик будет выглядеть примерно таким образом: procedure TSampleEditor.SelfAction; var Changed: Boolean; begin Changed := True; if Assigned(Executor) then FParticul.Code := Executor((Control as TMyControl).TextProperty, FParticul.Info, Changed, FParticul.ReadMode); if Changed then Make; end; ... constructor TSampleEditor.Create; begin ... (Control as TMyControl).OnAction := SelfAction; end; Желательно, чтобы текстовые данные могли отображаться в Инспекторе при редактировании (например, в TEdit - свойство Text, в TButton, TCheckBox - Caption, в TComboBox реализовано неявно, но, тем не менее, информация о данных выдаётся в Инспектор через Items и ItemIndex), хотя и необязательно.
Также необходимо перекрыть метод SetParticul, который влияет на внешний вид элемента управления в зависимости от значений полей TParticul. Далее необходимо написать специальную процедуру обработки данных. Если это простое присваивание, то можно процедуру не писать (указать при регистрации nil). Новый редактор регистрируется: procedure RegisterData(dtSample, TSampleEditor, SampleExecutor); или procedure RegisterData(dtSample, TSampleEditor, nil); В примере Example2 показаны оба подхода. Нестандартный тип данных THomo обрабатывается c помощью процедуры HomoExecutor, в которой данные редактируются с помощью формы THomoForm2. Для типа данных TDate создаётся новый редактор TDateTimePickerEditor на базе элемента управления TDateTimePicker из VCL.


Создание поля в таблице


Создание поля может выполняться двумя путями: по ходу создания новой таблицы из диалога формирования списка полей 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;
Начнем с конца. Т.е. с IMenuItem. Как видно, почти все члены интерфейса соответствуют членам класса TMenuItem. Т.е. обратившись в методе PrepareItem к AItem.Enabled:=false мы запретим выбор этого элемента меню. Что же касается класса TMenuItems, то они, видимо, предназначены для манипулирования элементом меню в качестве родительского для нескольких других. Думаю, в них опытным путем разобраться тоже не составит труда.

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


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


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

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;
Итак, приступаем к рассмотрению методов класса TPropertyEditor. Начнем с тех, которые мы уже использовали.

Метод 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 (естественно, если все нити будут использовать одну и ту же БД с одними и теми же правами доступа). ет, что читатель легко сможет сделать соответствующие изменения в коде.



StdIn, StdOut и StdErr. Перенаправление, чтение и запись.


рбань С.В.,
дата публикации 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)
Создали? Если нет - то дальше ловить нечего, поэтому генерим Exception'ы...
Есть еще одна тонкость. У нас Все созданные хэндлы наследуемые! А дочернему процессу понадобятся только два... Поэтому:

//Делаем НЕ наследуемые дубликаты //Это нужно, чтобы не тащить лишние хэндлы в дочерний процесс... 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)
Дубликаты у нас в Tmp1 и Tmp2, теперь:

CloseHandle(FChildStdoutRd);//Закроем наследуемый вариант "Читального" хэндла CloseHandle(FChildStdinWr); //Закроем наследуемый вариант "Писального" хэндла FChildStdoutRd:=Tmp1; //И воткнем их места НЕ наследуемые дубликаты FChildStdinWr:=Tmp2; //И воткнем их места НЕ наследуемые дубликаты
Ура! Теперь можем создавать дочерний процесс!

If not CreateChildProcess(ExeName, CommadLine, FChildStdinRd, FChildStdoutWr) Then //Наконец-то! Создаем дочерний процесс! raise ECreateChildProcessErr.CreateRes(@sCreateChildProcessMsg)
Причем CreateChildProcess - это не API - это моя функция! Вот она:

//************************************************************************* 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; //*************************************************************************
Здесь важное значение имеют вот эти строчки: siStartInfo.hStdInput:=StdIn; siStartInfo.hStdOutput:=StdOut; siStartInfo.dwFlags:=STARTF_USESTDHANDLES; Первые две - понятно. А третья - читайте Хелп! Там все написано...

Самые умные (то есть те, кто ухитрился дочитать до этого места :-))) спросят:



- Ну, создали мы процесс и что дальше?

А дальше - мы можем с ентим процессом общаться! Например вот так:

//************************************************************************* 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; //*************************************************************************
Это мы посылаем данные на StdIn процесса.

Читать - несколько сложнее. Нам же не надо вешать всю нашу программу только потому, что процесс не желает нам ничего сообщать??? А 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; //*************************************************************************
Ну, вот, как я и говорил - работает. Даже слишком хорошо. Как я и говорил - эта вся бодяга для Web сервера. Ну, беру я в качестве файла - format.exe.... Ндаааа....

Если честно - с 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;



Свойства COM пакета


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

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

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

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.



Тактико-технические характеристики


Подсистема виртуальных таймеров (или Таймерный менеджер). Предоставляет любое количество программных объектов для отсчета времени, независимых от загрузки системы приложениями и работой пользователя, следующих типов: интервальный таймер (одновибратор/мультивибратор); точность - 10 миллисекунд; управление: пуск, останов, задание периода и режима. синхронизированный таймер (будильник), привязан к системному времени; набор моментов срабатывания конфигурируется строкой в формате , позволяющем простым способом описывать сложные периодические события; дискретность настройки - от секунды до месяца; управление: пуск, останов, задание маски времени и режима.

Реализовано все это в виде DLL - для возможности использования не только в программах на Delphi. Впрочем, можно использовать Subj просто как библиотеку классов - модуль Timers.pas. При желании можно натянуть на это дело компонентную крышу, но у меня такой необходимости не возникало. В нынешнем виде его можно использовать в программах как с формами, так и вообще без "морды", т.к. он не использует VCL.

Разработано и отлажено в среде Delphi 5, но будет компилироваться и в более ранних - может понадобиться замена типа dword на что-нибудь похожее (беззнаковость здесь роли не играет).

Все исходные тексты и откомпилированная DLL собраны в архив .
Тестовая программа (исходные тексты) отдельно в файле
Для интересующихся - сорцы версии на С++ в файле .



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


Подпрограмма ловушки ошибок встраивается в каждую прикладную программу. Ниже приведен примерный шаблон такой ловушки и пример ее использования. Вы вправе настроить шаблон под особенности своей предметной области. unit fErrorClient; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TfmTest = class(TForm) Button1: TButton; Image1: TImage; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); private public end; implementation {$R *.DFM} type Error = class class procedure ErrorCatch(Sender : TObject; Exc : Exception); end; // для простоты ловушка ошибок описана в этом модуле // в реальных приложениях ее нужно вынести в отдельный unit class procedure Error.ErrorCatch(Sender : TObject; Exc : Exception); var strMess : string[250]; UserName : array[0..99] of char; h : THandle; i : integer; begin // здесь можно проанализировать Exception, воспользовавшись его свойствами, // и предпринять конкретные действия в зависимости от типа ошибки beep; // получение имени пользователя i:=SizeOf(UserName); GetUserName(UserName,DWORD(i)); // формирование текста сообщения об ошибке strMess:='/'+UserName+'/'+FormatDateTime('hh:mm',Time)+'/'+Exc.Message; // открытие канала : MyServer - имя сервера, на котором работает // монитор ошибок (\\.\\mailslot\EMon - монитор работает на этом же ПК) // EMon - имя канала h:=CreateFile(PChar('\\MyServer\mailslot\EMon'),GENERIC_WRITE, FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); if h <> INVALID_HANDLE_VALUE then begin // передача текста ошибки (запись в канал и закрытие канала) WriteFile(h,strMess,Length(strMess)+1,DWORD(i),nil); CloseHandle(h); end; // вывод сообщения об ошибке пользователю ShowMessage('У Вас возникла ошибка (не волнуйтесь-все под контролем)'+ chr(13)+strMess); end; procedure TfmTest.FormCreate(Sender: TObject); begin // при создании главной формы приложения устанавливаем // глобальный обработчик исключений Application.OnException:=Error.ErrorCatch; end; procedure TfmTest.Button1Click(Sender: TObject); var i : integer; begin // тестирование ловушки ошибок i:=1-1; i:=100 div i; end; end. В следующей статье будет показано как превратить монитор ошибок в сервис Windows NT. Даутов Ильдар, 06 декабря 1999



Текст с высоты птичьего полета или Регулярные выражения


Раздел Подземелье Магов

"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-робота - каждому !
В последнее время появилось неимоверное число программок, вылущивающих информацию из web-страниц. Так вот, на мой взгляд это гораздо разумнее делать с помощью регулярных выражений. Не изобретайте велосипед, используйте метро ! 8-)

Например вот таким нехитрым способом можно получить курс доллара и дату этого курса программно, не рассматривая рекламные баннеры (да простят меня 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;

Господин Оформитель
Необходимо некий текст отобразить в html-странице, но предварительно желательно выделить гиперссылками все встречающиеся в нем URL.
Вот пример реализации (он не всегда сработает, но ведь 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 еще более худшие.

Интервал таймера, мс Интервал измерения, мс Количество срабатываний Total CPU usage, % Идеальный таймер TTimer IntervalTimer
Нормальные условия
10010000100991003-12
100100000100099810003-12
10100001000659999100
101000001000063619991100
151000066748266744-60
Нагрузка приложения (задержка на 2000 мс)
10010000100791002-17
15100006673336672-100
101000010001569992-100
Внешняя нагрузка (играющий Winamp)
100100001009710028-51
1510000667175632100
1010000100022894100


Специально для

Исходные тексты программ, приложенные к данной статье, распространяются на правах 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;
Она служит хранилищем сведений о типе поля. Поля sBytes и sSize приведенной структуры содержат соответственно число байтов, занимаемых данным типом в памяти и стандартное значение размера типа по соглашениям BDE. Ввод в структуру поля sBytes обусловлен желанием явно указать размер отводимой памяти в тех случаях, когда в BDE параметр Size равен 0. Для строковых и аналогичных ему типов этот параметр конкретизируется в момент формирования поля базы данных. Создав массив базовых типов TFbFieldArray = Array[TFieldType] of TFbBaseType, а затем для тех ее членов, в которых поле sInc=1, заполнив поля sDescr, можно создать необходимые списки для работы с типами данных в конфигураторе. Если есть желание расширить или, наоборот, сузить реализованный список используемых типов базовой группы данных, достаточно отредактировать поля sInc и sDescr. Если sInc=0 (по умолчанию), то данный тип исключается из системы, причем при этом можно не очищать поле sDescr. И наоборот, если нужно включить данный тип в систему, то нужно установить sInc=1, и, если есть необходимость, отредактировать поле sDescr.

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

// Структура ссылочного типа данных TFbReferenceType = record sType: TFieldType; sBytes, sSize, sInc: Integer; sDescr: ShortString; spTableInfo: pTTableInfo; end;
Она отличается от ранее введенной структуры для базовой группы наличием поля spTableInfo, куда заносится ссылка на уже существующую структуру таблицы. Остальные поля этой структуры копируют информацию из структур для автоинкрементного поля, кроме sDescr и sType. В поле sDescr вписывается наименование ведущей таблицы, например, Диагнозы. Для ссылочной группы данных sType = ftInteger. Идентификаторы полей для ссылок унифицируем, назвав их T1_id, T2_id и T3_id и т.д., в какой бы новой таблице они не заводились, запретив тем самым их редактирование настройщикам и пользователям.

Следящая группа данных Следящая группа данных особых пояснений не требует, т.к. принцип работы с ней в целом аналогичен принципу работы со ссылочной группой. Особенность состоит в том, что в структуру управления, помимо ранее рассмотренного указателя на структуру таблицы, вводится указатель на структуру того поля, на которое создается ссылка (ведущее поле), а тип 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;
Как видно, ключевым полем в этой структуре является список значений sPickList, из которого пользователь выбирает нужные ему значения во время работы приложения. Работа с базой данных таких "справочников", фактически начинающаяся со стадии конфигурирования, позволяет повысить гибкость настройки системы под конкретные требования функциональных задач. Разумеется, для создания списка и управления им придется создать менеджер списочных типов. Он должен обеспечивать создание списка, добавление в список нового члена, редактирование и удаление членов списка. Созданный список сохраняется в системной базе данных.

Для централизованного управления программным кодом в процессе использования групп данных целесообразно ввести обобщенную структуру. Предвидя это, мы намеренно вводили для всех групп данных схожие структуры для работы с ними в памяти. Сначала введем комбинированный тип для групп данных: 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;
В ней pTFbBaseType, pTFbReferenceType, pTFbPickType и pTFbLookupType - суть ссылки на структуры TFbBaseType, TFbReferenceType, TFbPickType и TFbLookupType соответственно. Итак, мы получили открытый механизм управления группами данных в конструкторе, который позволяет вводить в систему новые группы данных. Разумеется ничто не дается даром, - каждая новая группа данных потребует собственного менеджера, который бы обеспечивал интерфейс для работы с ним в конфигураторе системы. Кроме того, необходим способ связи конкретных структур полей и только что введенных структур групп данных для использования в конструкторе, а также во всех библиотечных функциях и процедурах, обрабатывающих структуры полей в пользовательском режиме.

Модернизируем структуру поля, приведенную выше (см. раздел ):

// Структура поля TFieldInfo = record sFieldAttr: TStrings; // атрибуты поля: { sFieldName - Имя поля } { sMTableName - Имя ведущей таблицы } { sMFieldName - Имя ведущего поля } { sPicDescr - Имя списочного типа } { sFieldCaption - Наименование } { sFieldDescr - Описание } sFieldType: TFieldType; sFieldSize: Integer; sFieldMBytes: Integer; sMTTableInfo : pTTableInfo; // Ссылка на структуру главной таблицы sMTFieldInfo : pTFieldInfo; // Ссылка на структуру главного поля sPickList : TStrings; // Список списочного типа end;
Поясним смысл новых полей в структуре: sMTableName - имя ведущей таблицы, на которую задается ссылка; sMFieldName - имя ведущего поля, на которое задается ссылка; sPicDescr - строковое наименование списка значений. sMTTableInfo, sMTFieldInfo, sPickList - реальные ссылки на вудущую таблицу, ведущее поле и список значений поля соответственно, которые вводятся после загрузки приложения. Правила использования данных полей таковы. Если поле базы данных принадлежит к ссылочной группе, то sMTableName содержит наименование ведущей таблицы (sMTTableInfo <> nil). В этом случае структура поля не должна содержать атрибутов sMFieldName и sPicDescr (sMTFieldInfo = nil, sPickList = nil), а ее имя должно быть sMTableName_id. Если поле базы данных принадлежит к следящей группе, то должны быть заданы оба атрибута, как sMTableName, так и sMFieldName (sMTTableInfo <> nil, sMTFieldInfo <> nil), а имя поля должно быть sMTableName_sMFieldName. Структура такого поля не должна содержать атрибута sPicDescr (sPickList = nil). Если поле принадлежит к списочной группе, то должны отсутствовать атрибуты sMTableName и sMFieldName (sMTTableInfo = nil, sMTFieldInfo = nil), но должно быть задано имя списка sPicDescr (sPickList <> nil). Соответственно, все списки в системе должны быть с уникальными именами. Наконец, в структуре поля базовой группы не должно быть ни одного из атрибутов sMTableName, sMFieldName и sPicDescr (sMTTableInfo = nil, sMTFieldInfo = nil, sPickList = nil).



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



Визуальный компонент инспектора


В этом разделе мы рассмотрим визуальный компонент инспектора, его основные методы и события, а также некоторые пользовательские аспекты, какие, как хинты. Причем, для простоты опустим аспекты реализации и, кроме того, будем использовать понятия "инспектор" и "визуальный компонент инспектора" как синонимы. Как это принято в Delphi, визуальный компонент представлен в двух формах - как TGsvCustomObjectInspectorGrid и, соответственно, TGsvObjectInspectorGrid. Опуская детали реализации и не очень важные свойства, класс инспектора определяется так:

type TGsvCustomObjectInspectorGrid = class(TCustomControl) protected property LongTextHintTime: Cardinal; property LongEditHintTime: Cardinal; property AutoSelect: Boolean; property HideReadOnly: Boolean; property OnEnumProperties: TGsvObjectInspectorEnumPropertiesEvent; property OnGetStringValue: TGsvObjectInspectorGetStringValueEvent; property OnSetStringValue: TGsvObjectInspectorSetStringValueEvent; property OnGetIntegerValue: TGsvObjectInspectorGetIntegerValueEvent; property OnSetIntegerValue: TGsvObjectInspectorSetIntegerValueEvent; property OnFillList: TGsvObjectInspectorFillListEvent; property OnShowDialog: TGsvObjectInspectorShowDialogEvent; property OnHelp: TGsvObjectInspectorInfoEvent; property OnHint: TGsvObjectInspectorInfoEvent; public procedure NewObject; procedure Clear; procedure ExpandAll; procedure CollapseAll; end;

Вначале отметим самые простые свойства и методы: AutoSelect - если AutoSelect установить в True, то при выборе свойства, доступного для редактирования весь его текст будет выделяться, HideReadOnly - если установить в True, то инспектор будет скрывать все свойства, доступные только по чтению, Clear - вызов этого метода очистит инспектор, что означает отсутствие инспектируемого объекта, ExpandAll - раскрыть все вложенные веточки дерева свойств, CollapseAll - свернуть все вложенные веточки. Цикл событий инспектора при инспектировании начинается с вызова метода NewObject. Это приведет к тому, что инспектор начнет циклически вызывать событие OnEnumProperties. Сигнатура обработчика этого события следующая:


TGsvObjectInspectorEnumPropertiesEvent = procedure(Sender: TObject; Index: Integer; out Info: PGsvObjectInspectorPropertyInfo) of object;
Обработчику передается монотонно увеличивающееся значение Index и, при каждом обращении, обработчик должен вернуть в out-аргументе указатель на метаданные очередного свойства или nil, если все свойства перечислены. Обработчик может выглядеть так:

procedure TForm1.OnEnumProperties(Sender: TObject; Index: Integer; out Info: PGsvObjectInspectorPropertyInfo); begin Info := ObjectManager.PropertyInfo(Index); end;
То есть, запрос на очередное свойство просто передается менеджеру. После того, как все свойства перечислены, инспектор начинает отображение имен свойств и их значений. При этом, для доступа к значениям свойств он вызывает один из обработчиков OnGetStringValue или OnGetIntegerValue в зависимости от того, имеет ли значение свойства текстовое представление или графическое (например, значения boolean-свойств отображаются как CheckBox и не имеют текста). Обработчики этих событий также выглядят очень просто, например:

procedure TForm1.OnGetStringValue(Sender: TObject; Info: PGsvObjectInspectorPropertyInfo; out Value: String); begin try Value := ObjectManager.GetStringValue(Info); except on E: Exception do StatusMessage('Error: ' + E.Message); end; end;
Это общий принцип - обработчик просто перенаправляет запрос менеджеру, который обрабатывает его сам, или, в свою очередь, перенаправляет метаклассам. Если пользователь изменяет значение свойства, то формируется событие OnSetStringValue (или OnSetIntegerValue). Если пользователь нажимает кнопку выпадающего списка, то формируется событие OnFillList, и после заполнения списка, инспектор отображает его. Если нажимается кнопка диалога (обозначаемого, как и в Delphi, тремя точками), формируется событие OnShowDialog. При выборе нового свойства формируется событие OnHint, которое можно обработать, например, так:

procedure TForm1.OnHint(Sender: TObject; Info: PGsvObjectInspectorPropertyInfo); begin if Assigned(Info) then StatusBar.SimpleText := Info^.Hint; end;
то есть, просто вывести строку хинта из метаданных в статусную строку или в специальное окно подсказок. Хинт может быть весьма длинным, чтобы ясно изложить подсказку по свойству. Это облегчает работу пользователя при большом числе объектов и их свойств. Если пользователь нажимает клавишу F1, то формируется событие OnHelp, по которому программа вызывает справочную подсистему. Всплывающие подсказки (tooltips) используются в инспекторе для других целей, а именно, для отображения длинных имен и значений, которые не вмещаются в поля инспектора, например:
Контролирует такие подсказки свойство LongTextHintTime - его значение определяет время, в течении которого "длинная" всплывающая подсказка будет отображаться. Если этому свойству присвоить 0, то подсказка отображаться не будет. Другой тип всплывающей подсказки связан с редактированием значений, текст которых не помещается в поле редактирования, например:



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


Вместо вступления


Поводом для написания данной статьи является большое количество вопросов на Круглом столе по поводу реализации Инспектора, его русификации и т. п. В свою очередь я разрабатывал расчётную программу (что-то вроде мини-САПРа), в которой наиболее красиво выглядела бы реализация Инспектора (примерно как в SolidWorks. Именно из этой САПР я подчерпнул эту идею).

Сразу оговорюсь, что рассматриваемый далее Инспектор объектов правильнее было бы назвать "Псевдоинспектором", поскольку никакого отношения к реальным published-свойствам объектов он ни имеет. Он реализован без использования RTTI, в дебрях которого я, если честно, не очень разбираюсь.

Инспекторами объектов в том или ином виде обладают многие системы (Delphi, C++Builder, SolidWorks, Visual Basic и т. д.). В своём Инспекторе я хотел бы иметь некоторые усовершенствования, отличающие его от вышеперечисленных.

Принцип работы моего Инспектора - обмен данными с объектом в виде кодированных строк. Строки как вид представления данных выбраны по двум причинам: во-первых, строки удобно отображать в Инспекторе (поначалу я хотел организовать обмен указателями, но возник ряд проблем с их преобразованием), во-вторых, в модулях Delphi есть много процедур кодирования данных в строки и наоборот (IntToStr-StrToInt, BoolToStr-StrToBool, ColorToString-StringToColor и др.). Плюс к этому реализованы ещё некоторые возможности, которых нет в других инспекторах. Так, например, в Инспекторе в добавление к свойствам и событиям реализованы ещё и методы (это было необходимо в моей задаче); появилось разрешение/запрещение свойств, событий и методов; появилась возможность добавлять свои редакторы не только в виде окон.

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

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



Вопросы реализации.


Вот собственно то, что я хотел сказать о технологии "многозвенного программирования". Теперь практическая часть. Как можно реализовать такую технологию? Один из наиболее используемых вариантов - это встраивание в программу интерпретатора проблемно-ориентированного языка. Встраивание компилятора я встречал значительно реже. В своей программистской практике я использовал оба варианта. Достоинства интерпретатора очевидны, но также очевидны и недостатки. Общий принцип состоит в том, что интерпретатор либо каждый раз интерпретирует исходное представление программы на проблемно-ориентированном языке, либо порождает промежуточный код, исполняемый некоторой виртуальной машиной. Примеры - пакет Microsoft Office с языком VB for Applications, реализация языка Java. Сюда же относятся все скриптовые языки. Если требуется межплатформенная совместимость, то интерпретаторы, вероятно, будут лучшим вариантом. Если же более важны соображения эффективности, то компиляция оказывается более предпочтительным выбором. Общий принцип - берем описание задачи на проблемно-ориентированном языке, генерируем соответствующий код на некотором универсальном языке, компилируем его и выполняем.

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

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



"Вшивание" информации в растровые рисунки.


Раздел Подземелье Магов

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

Так выглядит программа в "рабочем" состоянии. А текст я взял из какого-то файла, валявшегося у меня под рукой.



Вступление


Crystal Reports (далее как CR) на сегодняшний день является лидирующим пакетом для разработки отчетности в крупных компаниях. Для доступа к отчетам компания Seagate предоставляет несколько вариантов: Элемент управления Crystal ActiveX Компонент Report Designer Component Компоненты VCL сторонних разработчиков. Automation Server Вызовы API реализуются через Report Engine API (далее RE). По моему мнению, лучшим является доступ посредством API функций, т.к.: вы полностью контролируете все, что происходит. узнаете, как все это работает. не зависите от фирмы разработчика компонент и их версий. не платите денег (хотя этот момент расплывчат J). В 90% случаев необходимо только вывести отчет и передать входящие параметры, т.е. вы получаете "тонкое" приложения на основе своих же наработок, что согласитесь, греет душу программиста. Предполагается, что читатель знаком с работой в Crystal Reports и понимает концепцию разработки отчетов в данной среде.


В настоящее время интегрированные среды программирования Borland Delphi и Borland C++ Builder являются весьма удобными средствами для разработки расширений оболочки Windows (далее Shell extensions).

В отличие от средств разработки компании Microsoft, где весь код Shell extension пишется внутри шаблона, генерируемого с помощью «Shell Extension Wizard», в Delphi вы можете использовать как подобные генераторы шаблонов, так и более быстрый и простой визуальный подход для разработки Shell extensions, например . В любом случае важным вопросом является отладка ваших Shell extensions.

Эта статья была написана в помощь программистам, которые используют Borland Delphi (C++ Builder) для разработки своих Shell extensions. Она будет одинаково полезна как тем, кто использует визуальный подход, так и тем, кто пишет Shell extensions "от руки".



к адресному пространству чужого процесса.


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

Чтобы получить доступ к процессу, компонент использует динамическую библиотеку. Устанавливается ловушка типа WH_CALLWNDPROC, которая реагирует на сообщения, посылаемые функцией SendMessage. После установки ловушки, компонент посылает сообщение WM_NULL целевому окну и, библиотека отображается на адресное пространство процесса (если не была отображена раньше), которому принадлежит целевое окно.
Эта технология подробно описывается в книге Джеффри Рихтера (как и ряд других технологий для тех же целей), поэтому особо подробно останавливаться не буду. Для того чтобы активировать компонент, предназначен метод:
function Activate: Boolean; virtual; который устанавливает ловушку, создает информационный файл, отображаемый в память, в общем, делает некоторую подготовительную работу. Для того чтобы деактивировать компонент, предназначен метод:
function Deactivate: Boolean; virtual; который убирает ловушку и закрывает все отображаемые в память файлы. Впрочем, активировать и деактивировать компонент, а также проследить его состояние можно, используя свойство:
property Active: Boolean; Явно вызывать метод Activate не обязательно, так как при вызове методов компонента проверяется статус компонента и, если надо, производится его активация. Метод:
function UpdateWndData: Boolean; virtual; получает информацию обо всех доступных в системе процессах и их окнах. После вызова этой функции становятся доступны следующие свойства:
property ProcessId_: THandles; содержит дескрипторы процессов;
property ProcessSize: TIntArray; содержит размеры процессов;
property WndHandle: THandles; содержит дескрипторы окон процессов;
property WndClassName: TStrings; содержит имена классов окон;
property WndText: TStrings; содержит заголовки окон;
property ModuleFileName: TStrings; содержит имена исполняемых файлов окон; Вышеперечисленные свойства представляет собой массивы данных, где любой элемент массива соответствует элементу любого другого массива с тем же индексом. Таким образом, все вышеперечисленные свойства имеют одинаковую длину, а элементы свойств с одинаковыми индексами относятся к одному и тому же процессу. Свойство компонента:
property Selected: Integer; обозначает индекс выбранного элемента вышеперечисленных массивов. Это свойство можно установить исходя из, например, заголовка окна:
… var Index: Integer; begin Index := 10; with MemoryInspector do if WndText[Index] = ‘Microsoft Internet Explorer’ then Selected := Index; end; … или это свойство можно установить исходя из имени класса окна:
… var Index: Integer; begin Index := 10; with MemoryInspector do if WndClassName[Index] = ‘IEFrame’ then Selected := Index; end; … Зная дескриптор окна, можно получить индекс, соответствующий свойству Selected:
function GetWindowIndex(Window: THandle): Integer; virtual;
Чтение памяти процесса

Чтение памяти процесса осуществляется функцией:
function PeekData: Boolean; virtual; Перед тем, как считывать данные процесса, необходимо установить некоторые свойства компонента. Первым делом, необходимо обновить информацию обо всех доступных в системе процессах и их окнах. После этого выбрать какое-нибудь окно целевого процесса и установить свойство Selected. В результате вызова функции PeekData данные записываются в поток памяти. Этот поток вы должны создать сами и установить ссылку на объект потока в свойстве компонента:
property StreamRef: TMemoryStream; После того, как заданы свойства Selected и StreamRef, можно вызывать функцию PeekData. Работа функции PeekData зависит от свойства:
property UpdateMemory: Boolean; Это свойство обозначает, будет ли перед считыванием памяти обновляться информация о регионах памяти и их блоках в выбранном процессе. Если это свойство истинно, то размер считываемой памяти будет, вероятно, изменяться. Когда память считывается первый раз, это свойство значение не имеет, библиотека обновляет информацию о памяти процесса в любом случае. В последующих вызовах функции PeekData можно либо заново обновить информацию (UpdateMemory = True), либо использовать ту информацию о памяти, которая была получена в первый раз (UpdateMemory = False). Работа функции PeekData также зависит от свойства компонента, которое определяет правила чтения памяти или записи в память:
property ReadOptions: TReadOptions; где
TProtect = (apPageReadOnly, apPageReadWrite, apPageWriteCopy, apPageExecute, apPageExecuteRead, apPageExecuteReadWrite, apPageExecuteWriteCopy, apPageNoAccess); TProtectSet = set of TProtect; определяет набор атрибутов защиты страниц памяти;
TSpecial = (spPageGuard, spPageNoCache); TSpecialProtect = set of TSpecial; определяет набор специальных атрибутов защиты страниц памяти;
TPageType = (ptMemImage, ptMemMapped, ptMemPrivate); TPageTypeSet = set of TPageType; определяет тип физической памяти страниц
TReadOptions = record ChangeProtect: Boolean; ProhibitedProtect, PermittedProtect: TProtectSet; ProhibitedSpecialProtect: TSpecialProtect; ProhibitedPageType: TPageTypeSet; end; Описание атрибутов защиты страниц памяти:


apPageReadOnly: Разрешено только чтение страницы apPageReadWrite: Разрешены только чтение страницы и запись на странице apPageWriteCopy: Разрешена только запись на странице, которая приводит к предоставлению копии страницы, после чего этот флаг убирается apPageExecute: Разрешено только исполнение содержимого страницы apPageExecuteRead: Разрешены только чтение страницы и исполнение содержимого страницы apPageExecuteReadWrite: Нет ограничений apPageExecuteWriteCopy: Нет ограничений, любые операции приводят к предоставлению копии страницы, после чего этот флаг убирается apPageNoAccess: Нет доступа
Описание специальные атрибутов защиты страниц памяти:
spPageGuard: Попытка доступа к содержимому страницы вызывает исключение, после чего этот флаг убирается spPageNoCache: Отключает кэширование группы страниц памяти
Тип страниц регионов памяти:
ptMemImage: Указывает что страницы региона памяти отображены на EXE или DLL файл, спроецированный в память ptMemMapped: Указывает что страницы региона памяти отображены на файл данных, спроецированный в память ptMemPrivate: Указывает что страницы региона памяти отображены на страничный файл памяти
Структура TReadOptions:
Поле ChangeProtect обозначает будут ли производиться попытки получить доступ к защищенным блокам памяти. Защищенными считаются те блоки памяти, атрибуты которых не определены полями ProhibitedProtect, PermittedProtect, ProhibitedSpecialProtect и ProhibitedPageType Поле ProhibitedProtect определяет запрещенный набор атрибутов страниц памяти. Любой блок памяти, имеющий страницы с один из таких атрибутов, будет проигнорирован Поле PermittedProtect определяет разрешенный набор атрибутов страниц памяти Поле ProhibitedSpecialProtect определяет запрещенный набор специальных атрибутов страниц памяти. Любой блок памяти, имеющий страницы с один из таких атрибутов, будет проигнорирован Поле ProhibitedPageType определяет запрещенные типы страниц памяти. Любой блок памяти, имеющий страницы таких типов, будет проигнорирован


Значение свойства ReadOptions по умолчанию настроено оптимальным образом.
Блоки памяти

Как уже было сказано, вся память редактируемого процесса разбита на регионы и блоки. Когда библиотека читает память, она берет ее по кусочкам из каждого блока, а потом склеивает воедино и передает в компонент. Таким образом, каждый байт полученной памяти принадлежит какому-то блоку в том процессе, где он был взят. Так вот, если у вас есть, например, память какого-то процесса размером, скажем, в 10 мегабайт, и вы обнаружили в этой памяти нужное вам число, адрес которого 100 байт, то вы, естественно, хотите изменить его. Можно поступить несколькими способами:
Первый способ – это передать соответствующим методам записи адрес этого числа – 100 байт, то есть локальный адрес, а также новое число, на которое вы хотите изменить старое. Этот способ рассмотрим несколько позже. Второй способ – это получить блок памяти в редактируемом процессе, которому соответствует число по локальному адресу 100, и использовать соответствующие методы записи. Этот способ имеет преимущество, так как он выполняется быстрее.
Для получения блока памяти используется функция:
function TMemoryInspector.GetMemoryRegion(LocalAddress: Longword): Boolean; Ее параметр LocalAddress это и есть адрес числа в нашем примере, по которому мы хотим получить соответствующий блок в редактируемом процессе. В результате вызова этой функции изменяются некоторые свойства компонента:
property Beginning: Integer; Используется библиотекой и обозначает сумму размеров разрешенных блоков памяти, предшествующих полученному блоку. Значение этого свойства необходимо для некоторых методов записи.
property MemoryRegion: TRegion; TRegion = record AllocationBase, BaseAddress: Pointer; AllocationProtect, Protect: TProtect; SpecialProtect: TSpecialProtect; PageState: TPageState; RegionSize: Longword; PageType: TPageType; end; Это и есть нужный нам блок памяти. Отдельные значения полей записи TRegion вряд ли вам понадобятся, так как свойство MemoryRegion нужно только для методов записи. Тем не менее, я кратко опишу эти поля:


AllocationBase: Начальный адрес региона памяти BaseAddress: Начальный адрес блока памяти AllocationProtect: Атрибуты защиты региона памяти, присвоенные ему по время резервирования Protect: Атрибуты защиты блока памяти SpecialProtect: Специальные атрибуты защиты блока памяти PageState: Состояние страниц блока памяти RegionSize: Размер блока памяти PageType: Тип физической памяти страниц блока
Все подготовительные работы для записи числа по адресу 100 завершены. Теперь можно приступать к записи:
function Write(MemoryRegion: TRegion; Start, Beginning: Longword; Buffer: TShareBuffer; Length: Longword = 0): Boolean; overload; virtual; function WriteByte(MemoryRegion: TRegion; Start, Beginning: Longword; Value: Byte): Boolean; overload; virtual; function WriteWord(MemoryRegion: TRegion; Start, Beginning: Longword; Value: Word): Boolean; overload; virtual; function WriteLongword(MemoryRegion: TRegion; Start, Beginning: Longword; Value: Longword): Boolean; overload; virtual; function WriteInt64(MemoryRegion: TRegion; Start, Beginning: Longword; Value: Int64): Boolean; overload; virtual; function WriteSingle(MemoryRegion: TRegion; Start, Beginning: Longword; Value: Single): Boolean; overload; virtual; function WriteDouble(MemoryRegion: TRegion; Start, Beginning: Longword; Value: Double): Boolean; overload; virtual; function WriteExtended(MemoryRegion: TRegion; Start, Beginning: Longword; Value: Extended): Boolean; overload; virtual; function WriteString(MemoryRegion: TRegion; Start, Beginning: Longword; Value: ShortString): Boolean; overload; virtual; function WriteBuffer(MemoryRegion: TRegion; Start, Beginning: Longword; Value: Pointer; Length: Longword): Boolean; overload; virtual; function WriteBuffer(MemoryRegion: TRegion; Start, Beginning: Longword; Value: TByteArray): Boolean; overload; virtual; function WriteBuffer(MemoryRegion: TRegion; Start, Beginning: Longword; Value: string): Boolean; overload; virtual; Осталось выбрать наиболее подходящую функцию для записи. Несколько слов об общих параметрах функций. Параметры MemoryRegion и Beginning это то, о чем мы только что говорили. Параметр Start это адрес начала записи в масштабе блока памяти: Start = LocalAddress – Beginning. Базовый метод записи Write требует параметр Buffer, который имеет тип:
TShareBuffer = record case Byte of 0: (ByteArray: TSmallByteArray); 1: (CharArray: TSmallCharArray); 2: (ValueRecord: TValueRecord); 3: (Float80: Extended); end; где
TSmallByteArray = array[Byte] of Byte; TSmallCharArray = array[Byte] of Char; TValueRecord = record case Byte of 0: (ByteArray: array[0..7] of Byte); 1: (Signed8: Shortint); 2: (Unsigned8: Byte); 3: (Signed16: Smallint); 4: (Unsigned16: Word); 5: (Signed32: Longint); 6: (Unsigned32: Longword); 7: (Signed64: Int64); 8: (Float32: Single); 9: (Float64: Double); end; Как видно, параметром Buffer может быть представлено практически любое значение, имеющее наиболее распространенный тип и небольшой размер. Если требуется записать значение, длина которого превышает размер структуры TShareBuffer, следует использовать методы типа WriteBuffer. Такие методы могут записывать значения неограниченной длины. Параметры Value методов WriteBuffer имеют тип:


Pointer; ссылка на величину записи TByteArray = array of Byte; массив байт неограниченной длины String; длинная строка
В итоге я приведу полный код примера, в котором требуется записать в память процесса число по локальному адресу 100: …
const Value: Int64 = 1000; var LocalAddress, Start: Integer; MemoryInspector: TMemoryInspector; Stream: TMemoryStream; begin MemoryInspector := TMemoryInspector.Create(Self); MemoryInspector.Parent := Self; with MemoryInspector do begin // Получаем информацию обо всех процессах и их окнах: UpdateWndData; // Выбираем самый первый процесс: Selected := 0; // Устанавливаем адрес: LocalAddress := 100; // Получаем блок памяти: GetMemoryRegion(LocalAddress); // Устанавливаем начало записи: Start := LocalAddress - Beginning; // Запись: WriteInt64(MemoryRegion, Start, Beginning, Value); // Память процесса можно загрузить в поток и сохранить в файл: Stream := TMemoryStream.Create; try StreamRef := Stream; PeekData; Stream.SaveToFile('stream.dat'); finally Stream.Free; end; end; …
Простые методы записи

Второй метод записи был только что подробно рассмотрен. Теперь пришла очередь описать первый метод, наиболее простой. Он работает немного медленнее предыдущего, но все же обладает некоторым преимуществом. Представьте себе ситуацию, вы собираетесь записать число размером, скажем 10 байт. Тот блок, в котором будет производиться запись, имеет размер, например 4096 байт, запись начинается с 4092 байта. Получается, что в регион может быть записано только 4 байта, а нужно записать 10 байт. Функции второго типа, которые были рассмотрены в предыдущей главе, в такой ситуации запишут только 4 байта из 10. Функции первого типа ведут себя иначе и в рассматриваемой ситуации сначала найдут следующий блок памяти, запишут в него неуместившиеся 6 байт, после чего запишут первые 4 байта в исходный блок памяти. Ниже приведен список функций первого типа:
function Write(LocalAddress: Longword; Buffer: TShareBuffer; Length: Longword = 0): Boolean; overload; virtual; function WriteByte(LocalAddress: Longword; Value: Byte): Boolean; overload; virtual; function WriteWord(LocalAddress: Longword; Value: Word): Boolean; overload; virtual; function WriteLongword(LocalAddress: Longword; Value: Longword): Boolean; overload; virtual; function WriteInt64(LocalAddress: Longword; Value: Int64): Boolean; overload; virtual; function WriteSingle(LocalAddress: Longword; Value: Single): Boolean; overload; virtual; function WriteDouble(LocalAddress: Longword; Value: Double): Boolean; overload; virtual; function WriteExtended(LocalAddress: Longword; Value: Extended): Boolean; overload; virtual; function WriteString(LocalAddress: Longword; Value: ShortString): Boolean; overload; virtual; function WriteBuffer(LocalAddress: Longword; Value: Pointer; Length: Longword): Boolean; overload; virtual; function WriteBuffer(LocalAddress: Longword; Value: TByteArray): Boolean; overload; virtual; function WriteBuffer(LocalAddress: Longword; Value: string): Boolean; overload; virtual;


Список этих функций соответствует уже рассмотренному списку функций, есть лишь некоторая разница лишь в параметрах. Параметр LocalAddress обозначает адрес начала записи в масштабе полученной памяти редактируемого процесса, т.е. в масштабе объекта потока памяти, на который ссылается свойство StreamRef. Я приведу код примера, который обсуждался в предыдущей главе, но применительно к рассматриваемым методам записи:
… const Value: Int64 = 1000; var LocalAddress: Integer; MemoryInspector: TMemoryInspector; Stream: TMemoryStream; begin MemoryInspector := TMemoryInspector.Create(Self); MemoryInspector.Parent := Self; with MemoryInspector do begin // Получаем информацию обо всех процессах и их окнах: UpdateWndData; // Выбираем самый первый процесс: Selected := 0; // Устанавливаем адрес: LocalAddress := 100; // Запись: WriteInt64(LocalAddress, Value); // Память процесса можно загрузить в поток и сохранить в файл: Stream := TMemoryStream.Create; try StreamRef := Stream; PeekData; Stream.SaveToFile('stream.dat'); finally Stream.Free; end; end; …
Заморозка значений

Технология заморозки значений практически ничем не отличается от технологии записи на уровне блока памяти:
function Freeze(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Buffer: TShareBuffer; Length: Longword = 0): Boolean; overload; virtual; function FreezeByte(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: Byte): Boolean; virtual; function FreezeWord(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: Word): Boolean; virtual; function FreezeLongword(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: Longword): Boolean; virtual; function FreezeInt64(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: Int64): Boolean; virtual; function FreezeSingle(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: Single): Boolean; virtual; function FreezeDouble(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: Double): Boolean; virtual; function FreezeExtended(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: Extended): Boolean; virtual; function FreezeString(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: ShortString): Boolean; virtual; function FreezeBuffer(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: Pointer; Length: Longword): Boolean; overload; virtual; function FreezeBuffer(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: TByteArray): Boolean; virtual; function FreezeBuffer(Elapse: Longword; MemoryRegion: TRegion; Start, Beginning: Longword; Value: string): Boolean; virtual;


Как видно, список этих функций отличается от списка функций записи только одним дополнительным параметром. Параметр Elapse обозначает частоту обновления в миллисекундах. После вызова любой из этих функций, изменяется свойство компонента, которое обозначает состояние заморозки:
property Frozen: Boolean; В любой момент времени может быть заморожено только одно значение одного процесса. Для разморозки предназначена функция:
function Unfreeze: Boolean; virtual; Ниже приведен код пример, который рассматривался в предыдущих главах, где вместо записи мы замораживаем значение:
… const Value: Int64 = 1000; var LocalAddress, Start: Integer; MemoryInspector: TMemoryInspector; Stream: TMemoryStream; begin MemoryInspector := TMemoryInspector.Create(Self); MemoryInspector.Parent := Self; with MemoryInspector do begin // Получаем информацию обо всех процессах и их окнах: UpdateWndData; // Выбираем самый первый процесс: Selected := 0; // Устанавливаем адрес: LocalAddress := 100; // Получаем блок памяти: GetMemoryRegion(LocalAddress); // Устанавливаем начало заморозки: Start := LocalAddress - Beginning; // Заморозка с интервалом обновления 500 мс: FreezeInt64(500, MemoryRegion, Start, Beginning, Value); … // Разморозка: Unfreeze; // Память процесса можно загрузить в поток и сохранить в файл: Stream := TMemoryStream.Create; try StreamRef := Stream; PeekData; Stream.SaveToFile('stream.dat'); finally Stream.Free; end; end; …
Установка компонента

Компонент состоит из нескольких частей. Первая часть это, собственно, сам компонент и набор необходимых вторичных компонентов. Вторая часть это используемая компонентом библиотека. Несколько слов о вторичных компонентах и файлах:
Компонент TMemoryManager предназначен для получения информации о доступных процессах и их окнах, а также для чтения памяти и записи в память Компонент TFileManager предназначен для создания файла, отображаемого в память и дальнейшей работы с таким файлом Файл MemUtils содержит некоторые общие типы и данные
Порядок установки компонента:


Установить компоненты TMemoryManager, TFileManager, файл MemUtils Получить файл Mi.dll и переместить его в директорию, где находится пакет с установленными компонентами Установить компонент TMemoryInspector
Необходимо, чтобы еще одна копия файла Mi.dll находилась в одной директории с исходными файлами программы, использующей компонент.
Ресурсы

Скачать: (16 K)
Архив содержит:
компонент TMemoryInspector компонент TMemoryManager компонент TFileManager файл MemUtils библиотеку Mi
Дополнительную информацию, а также пример по использованию этого компонента вы сможете найти на сайте .


Введение и библиография


В журнале (№9 за 2002 г.) была опубликована статья Вячеслава Ермолаева "Использование template-классов при импортировании функций из DLL".

Уважаемый ет для решения этой задачи использовать механизм шаблонов (templates) языка С++. Это огромный шаг вперёд по сравнению с рутинным кодированием, но на мой взгляд, не идеальное решение, которому присущи некоторые недостатки:

Всё разнообразие возможных функций ограничивается богатством заранее описан-ных шаблонов; и хотя в статье ли Вы припомните функций, не укладывающихся в эти рамки ?), всё же сам факт несвободы как-то стесняет Если Вы всё же где-то откопаете функцию с большим количеством параметров, Вам придётся расширить набор шаблонов, т.е. изменить библиотеку классов, что является крайне нетехнологичным решением - Вы же не изменяете исходники VCL! При кодировании пользовательского приложения приходится использовать до-вольно-таки громоздкое описание импортируемых функций в обёртках template-классов, что не способствует мнемонической лёгкости чтения и понимания текста Механизм шаблонов языка C++ позволяет уменьшить объём исходного, но никак не объектного, полученного после компиляции кода, который раздувается тем сильнее, чем более разнообразны параметры в импортируемых из DLL функциях. Кроме того, в рамках предложенного метода остаётся нерешённой проблема автоматизации довольно трудоёмкой рутинной операции - определения полных идентифика-торов функций в DLL (строковых параметров для функции GetProcAddress): Особых проблем не наблюдается, если все функции в DLL скомпилированы как "extern "C" - в этом случае линкер просто добавляет символ подчёрки-вания перед именем функции Если же DLL собрана с функциями в стиле C++, всё совсем не так одно-значно: идентификаторы могут получиться до полуметра длиной , и выковыривание их из DLL - лишняя ручная работа; можно, конечно, зная прави-ла работы линкера, синтезировать их - но и это явно предмет для автоматизации, к тому же подозреваю, что у разных средств разработки (BCB, Visual C++) раз-ные правила, по которым работает линкер



Технология.


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

Если первый этап достаточно хорошо поддерживается разнообразным программистским инструментарием, то второй этап в этом смысле поддержан значительно хуже. Главной целью "многозвенного программирования" как раз и является поддержка этапа сопровождения. В чем основная идея этого подхода? Рассмотрим простую схему:

разработчик <---> заказчик

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

разработчик <---> технолог <---> пользователь


В этой схеме заказчик образно разделяется на две составляющие - технолог и пользователь. Под технологом здесь понимается человек (или группа), который является посредником между разработчиком и пользователем. Технолог профессионально владеет той предметной областью, для которой разработана программа, но не является программистом - это может быть энергетик, астроном, режиссер. Причем, такое разделение заказчика может быть чисто условным - один и тот же человек может выполнять функции, как технолога, так и конечного пользователя. Технолог - это ключевое звено в цепочке. Технолог знает предметную область значительно лучше разработчика и, весьма часто, хотел бы изменить функционирование программы так, как не было предусмотрено программистом. Частые обращения к разработчику могут быть весьма затруднительными - как во времени, так и в пространстве.
Для улучшения этой ситуации можно сделать следующее - передать часть работы программиста технологу. Поскольку технолог по определению не является программистом, нужна дополнительная связующая часть. Такой связующей частью может быть проблемно-ориентированный язык, который разработчик включает в свой проект и которым технолог может воспользоваться для изменения функциональности программы (в разумных пределах). Естественно, что этот язык должен оперировать терминами той предметной области, в которой работает технолог. То есть, между формулировкой задачи и языком ее решения нужен минимальный семантический разрыв. Универсальные языки программирования на эту роль явно не подойдут. Внешней синтаксической формой проблемно-ориентированного языка может быть текст, граф, схема, короче то, на чем технолог наиболее адекватно формулирует свои конкретные задачи. Таким образом, интенсивность взаимодействия между разработчиком и технологом может быть уменьшена, так как значительную часть изменений технолог может делать самостоятельно.
Эта идея используется многими разработчиками, но в литературе я не встречал ее обсуждения как инструмента для сопровождения. В этом смысле вместо термина "многозвенное программирование" обычно используется термин "проблемно-ориентированный язык".
В многозвенной структуре, которую я нарисовал выше, содержится только 2 программирующих звена, но в реальности этих звеньев может быть больше. Если предметная область достаточно разнородна, то "технолог" может быть целой цепочкой технологов - конкретный пример я приведу в самом конце статьи.
Конечно, здесь есть и другая сторона медали - маркетинговые соображения. Если заказчик получит развиваемый инструмент, то разработчик может остаться в проигрыше. И чем лучше инструмент, тем менее вероятно, что заказчик будет оплачивать сопровождение программы. Здесь уже решать разработчику - или заниматься только сопровождением старых программ или высвобождать время для новых разработок.

Введение в анимацию


Анимация заключается в последовательной смене картинок. При этом главная проблема - устранение мерцания изображения. В программе Canvas2 мерцание "резиновой" линии в целом незаметно, так как эта линия постоянно изменяет своё положение, а вот мерцание подложки, на которой нарисованы уже "впечатанные" в неё линии, было бы заметно, поэтому пришлось принимать специальные меры по её устранению.

Чтобы не было мерцания при обновлении изображения, необходимо выполнение двух условий: Быстрая смена одного изображения другим Отсутствие между старым и новым изображением промежуточных полустёртых изображений

Максимальную скорость вывода при использовании средств GDI даёт вывод изображения на поверхность растра (bitmap) с последующим перенесением на экран. Этим обеспечивается то, что все элементы рисунка выводятся на экран одновременно, а не по очереди, что позволяет избежать промежуточных изображений. Поэтому программа Canvas2 хранит растр, на котором отображаются уже завершённые кривые, и при обработке события OnPaint рисует растр, а сверху - редактируемую в данный момент кривую с дополнительными элементами, облегчающими редактирование. Тем не менее, это не устраняет мерцание полностью, если для обновления окна использовать метод TWinControl.Refresh или TWinControl.Invalidate. Это связано с особенностями рисования окон в Windows и с тем, как VCL использует эти особенности.

Для перерисовки сначала с помощью функций InvalidateRect или InvalidateRgn отмечается область окна, нуждающаяся в обновлении. Можно последовательно отметить несколько областей - система будет добавлять новую область к уже существующей. Затем с помощью функции UpdateWindow в очередь сообщений помещается WM_Paint. Рисование окна происходит при обработке этого сообщения. Для начала рисования вызывается функция BeginPaint. Эта функция анализирует область, нуждающуюся в обновлении, и, если при вызове функций InvalidateRect/Rgn был установлен флаг обновления фона, посылает окну сообщение WM_EraseBknd. В ответ на это сообщение окно закрашивает свою клиентскую часть заданной кистью. В частности, для форм Delphi это будет сплошная кисть с цветом, определяемым свойством Color формы. Поэтому сначала будет стёрто старое изображение, и лишь затем будет нарисовано новое. Это приводит к появлению мерцания.

Существует три способа избавиться от мерцания: Не указывать флаг обновления фона при вызове InvalidateRect(Rgn) Перекрыть обработчик WM_EraseBkgnd и ничего не делать при получении этого сообщения Обновлять окно напрямую, без сообщения WM_Paint. В Delphi самым простым является третий способ: достаточно вызвать процедуру обработки OnPaint напрямую. Для реализации первого способа придётся вручную вызывать функцию API InvalidateRect, потому что TWinControl.Invalidate не позволяет сбрасывать флаг обновления фона. Второй способ не очень удобен, если анимированная картинка занимает не всё окно. Поэтому в программе Canvas2 выбран третий способ.



Выравнивание текста по ширине с автоматическим переносом русских слов.


Раздел Подземелье Магов Антон Григорьев , дата публикации

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

Краткое описание :

Для переноса слов программа не использует словарь, а анализирует каждое слово с точки зрения правил русского языка. Правила эти достаточно сложны, поэтому иногда программа выбирает не самое изящное, хотя и не неправильное решение. Прежде всего это касается тех слов, в которых три или более согласных идут подряд. Программа может вставить перенос между любыми из них, хотя есть дополнительные правила, которые при этом игнорируются.
Например, то, что приставка должна оставаться целой. Слишком муторно было бы заставлять компьютер учить все приставки. Да ещё и объяснять, что, например, в слове "президент" "пре" - это не приставка, а в слове "предлог" приставка не "пре", а "пред". Тогда уж лучше и в самом деле словарь. Впрочем, демонстрационная программа и есть демонстрационная программа, кто захочет, посмотрит, поймёт основные принципы и сделает лучше.

Из улучшений, которые так и напрашиваются, стоит назвать красную строку и разбивку текста на несколько абзацев. Но это делается настолько элементарно, что мне даже не хочется на этом останавливаться.
Можно ввести перенос английских слов (сейчас программа их переносить не умеет, потому что я не слишком хорошо знаком с английскими правилами переноса), можно ввести запрет на перенос слов из прописных букв - возможностей для творчества хватает, было бы желание.
Я же реализовал простейший вариант - при запуске программа ищет файл ByWidth.txt, мешает все слова в одну кучу, удаляет все лишние пробелы и разбивает на строки нужной длины, перенося при необходимости слова. Предполагается, что в исходном тексте нет переносов, в том числе и тех слов, которые пишутся через дефис. Таким образом, исходный текст может быть написан хоть в одну строку, хоть по одному слову на строку - разницы не будет. И можно вставлять пустые строки - они всё равно игнорируются.

Примечание:

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



Вызов процедуры клиента


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

Главный недостаток - процедура выполняется в контексте вызывающего потока (сервера), и программист должен сам принять необходимые меры для синхронизации с потоком клиента, если имеются обращения к разделяемым данным. Кроме того, процедура должна выполниться достаточно быстро, чтобы не задерживать работу сервера (всяческие ожидания и SendMessage, явные и неявные, тут недопустимы). Вследствие некоторой противоречивости данных требований можно рекомендовать следующий метод работы: выполнить в асинхронной процедуре некие оперативные вычисления, а затем известить поток клиента способом, не требующим задержки (например - PostMessage), и быстренько отдать управление серверу.

Асинхронный вызов метода класса (procedure of object) является разновидностью данного метода.



Взгляд в будущее


Пока эта статья создавалась, меня стали обуревать новые идеи. Потихоньку начал возникать код нового Инспектора. А идеи таковы: Возможность отключения из поля видимости тех особенностей, которые обрабатывать не нужно и которые "мешают", загромождая рабочую область Инспектора. Создание и регистрация не только своих объектов, а и своих классов. Для каждого реального обрабатываемого объекта в "DesignTime" нашей программы автоматически создавать объект-оболочку. Методы GetParticuls и SetParticul сделать свойствами процедурного типа. Это позволит не создавать специальный класс для каждого редактируемого класса. Реализовать множественное наследование, как в C++. Возможность создавать "DesignTime" не для всей программы, а для отдельного контейнера объектов. Возможность быстрой смены класса редактируемого объекта в "DesignTime" программы. Добавление собственных вкладок, помимо "Свойства", "Методы" и "События", например "Операции", "Состав", "Ссылки" и пр.



Waveform Audio Win32 API. Часть I


Раздел лилов
дата публикации 29 апреля 2000.

Введение

Одной из наиболее важных частей Multimedia-API Windows 95/98/NT по праву может считаться Waveform Audio. Предоставляя наиболее широкие возможности по работе с оцифрованным звуком, эта группа функций таит в себе немало "подводных камней". сил приложил к исследованию вопроса оптимального применения этих функций и хотел бы поделиться своими "открытиями" с читателями. Приводимые здесь примеры могут использоваться совершенно свободно, за исключением особо оговоренных случаев. Первая часть открывает небольшую серию статей, посвященных обработке звука в режиме реального времени (это когда время реакции системы на событие строго ограничено и не превышает заранее заданной величины - т.н. "жесткие" системы реального времени). Если Вы рассчитываете увидеть здесь разбор каких-то особенно сложных алгоритмов кодирования или сжатия звука - разочарую Вас. Далее применения быстрого преобразования Фурье пока ничего шибко математического не планируется. Обратите внимание, что вся информация почерпнута из Microsoft Multimedia Programmer's Reference, поэтому всячески рекомендую обращаться туда, тем более, что эти файлы включены в поставку Delphi 3, 4, 5.
В первой части рассматривается использование функций Waveform Audio Win32 API. мнению, функций и рассматривает пример реализации программы, записывающей звук в WAV-файл в течение "неограниченного" времени. Приведенный в статье пример реализован на Delphi 4.

Часть 1

Оцифрованный звук может быть представлен самыми различными способами. В числе наиболее широко применяемого способа цифрового представления звука можно отметить формат PCM - pulse code modulation - импульсно-кодовая модуляция. В контексте нашей тематики под этим термином подразумевается такой способ кодирования данных, при котором каждая выборка (отсчет), произведенная аналого-цифровым преобразователем (здесь - в смысле звуковой карты), представляется в памяти в виде числа, пропорционального по своему значению мгновенной величине сигнала в момент выборки. Скорость выборок или, другими словами, частота выполнения отсчетов (частота дискретизации), прямо связана с максимальной частотой поступающего аналогового сигнала. Если сигнал имеет гармоническую природу и ограничен в некотором диапазоне частот, т.е. может быть представлен в виде конечного числа членов ряда Фурье, то для его корректной оцифровки, согласно теореме отсчетов, достаточно иметь частоту дискретизации вдвое превосходящей частоту максимальной гармоники сигнала.
Таким образом, если мы хотим без потери качества производить цифровую запись скажем, телефонного разговора, частота сигнала которого находится в диапазоне 300..3400 Гц, нам вполне достаточно установить частоту дискретизации 8000 отсчетов/сек. Величина 8000 выбрана из соображений совместимости с различными звуковыми картами и драйверами, поскольку для некоторых из них это является наименьшим возможным значением частоты дискретизации сигнала. Если же Вы хотите записывать радиопередачи в диапазоне FM (88 - 108 MHz), то необходимо выбрать частоту дискретизации 12500*2=25000 отсчетов/сек, т.к. звуковой диапазон FM-станции 12.5 килогерц.
Как Вы уже наверное догадались, запись с компакт-диска для сохранения качества нужно производить с частотой дискретизации 44100 выборок/секунду. Замечу, что это вовсе не гарантирует качество звучание записи "как на CD-ROM". Звуковая карта вносит некоторые искажения в любом случае. Как правило, это напрямую связано со стоимостью карты. Более дорогие обычно обеспечивают лучшее качество.

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

Прежде всего, рассмотрим функцию waveInGetNumDevs:
function waveInGetNumDevs: UINT; stdcall; - функция возвращает количество устройств ввода, поддерживающих оцифровку звукового сигнала. Если функция вернула 0, то таких устройств в системе нет.
Функция waveInGetDevCaps позволяет получить характеристики указанных устройств.

function waveInGetDevCaps(
hwi: HWAVEIN;
lpCaps: PWaveInCaps;
uSize: UINT ): MMRESULT; stdcall;
Здесь
hwi - идентификатор открытого функцией waveInOpen (см. ниже) устройства или порядковый номер неоткрытого устройства в диапазоне от 0 до значения, возвращаемого функцией waveInGetNumDevs, уменьшенного на 1;
lpCaps - адрес структуры (записи) TWAVEINCAPS; uSize - размер в байтах структуры TWAVEINCAPS.

type TWaveInCaps = record wMid: Word;
wPid: Word;
vDriverVersion: MMVERSION;
szPname: array[0..MAXPNAMELEN-1] of AnsiChar;
dwFormats: DWORD;
wChannels: Word;
wReserved1: Word; end;

Структура TWAVEINCAPS описывает параметры заданного устройства. Т.е. после вызова функции waveInGetDevCaps поля структуры содержат следующие значения:
wMid: Word - идентификатор производителя;
wPid: Word - идентификатор продукции производителя;
vDriverVersion: MMVERSION - версия драйвера;
szPname: array[0..MAXPNAMELEN-1] of AnsiChar - наименование продукта (строка заканчивается символом с кодом 0);
dwFormats: DWORD - стандартные форматы данных, поддерживаемые устройством:


WAVE_FORMAT_1M08

11.025 kHz, mono, 8-bit

WAVE_FORMAT_1M16

11.025 kHz, mono, 16-bit
WAVE_FORMAT_1S08

11.025 kHz, stereo, 8-bit
WAVE_FORMAT_1S16

11.025 kHz, stereo, 16-bit
WAVE_FORMAT_2M08

22.05 kHz, mono, 8-bit
WAVE_FORMAT_2M16

22.05 kHz, mono, 16-bit
WAVE_FORMAT_2S08

22.05 kHz, stereo, 8-bit
WAVE_FORMAT_2S16

22.05 kHz, stereo, 16-bit
WAVE_FORMAT_4M08

44.1 kHz, mono, 8-bit
WAVE_FORMAT_4M16

44.1 kHz, mono, 16-bit
WAVE_FORMAT_4S08

44.1 kHz, stereo, 8-bit
WAVE_FORMAT_4S16

44.1 kHz, stereo, 16-bit

Обратите внимание на то, что подавляющее большинство (если не все) звуковые карты поддерживают промежуточные режимы записи-воспроизведения. Т.е. вполне возможно на карте с максимальной частотой дискретизации 44100 выборок/сек производить запись со скоростью 16000 выборок/сек, хотя это и не сообщается по запросу waveInGetDevCaps. wChannels: Word - количество входных каналов (1-моно, 2-стерео)
wReserved1: Word - зарезервировано


Функция waveInGetErrorText возвращает текстовое описание возникших в ходе выполнения ошибок.

function waveInGetErrorText(
mmrError: MMRESULT;
lpText: PChar;
uSize: UINT
): MMRESULT; stdcall;

mmrError - код ошибки;
lpText - адрес с которого будет размещена нуль-терминированная строка-описание;
uSize - размер участка памяти, на который ссылается lpText;

Ниже приведен пример процедуры, выводящей сведения об устройствах аудиоввода.
uses Windows, MMSystem; type TModeDescr=record mode: DWORD; // код режима работы descr: string[32]; // словесное описание end; const // массив содержит сопоставления режима работы и словесного описания modes: array [1..12] of TModeDescr=((mode: WAVE_FORMAT_1M08; descr:'11.025 kHz, mono, 8-bit'), (mode: WAVE_FORMAT_1M16; descr:'11.025 kHz, mono, 16-bit'), (mode: WAVE_FORMAT_1S08; descr:'11.025 kHz, stereo, 8-bit'), (mode: WAVE_FORMAT_1S16; descr:'11.025 kHz, stereo, 16-bit'), (mode: WAVE_FORMAT_2M08; descr:'22.05 kHz, mono, 8-bit'), (mode: WAVE_FORMAT_2M16; descr:'22.05 kHz, mono, 16-bit'), (mode: WAVE_FORMAT_2S08; descr:'22.05 kHz, stereo, 8-bit'), (mode: WAVE_FORMAT_2S16; descr:'22.05 kHz, stereo, 16-bit'), (mode: WAVE_FORMAT_4M08; descr:'44.1 kHz, mono, 8-bit'), (mode: WAVE_FORMAT_4M16; descr:'44.1 kHz, mono, 16-bit'), (mode: WAVE_FORMAT_4S08; descr:'44.1 kHz, stereo, 8-bit'), (mode: WAVE_FORMAT_4S16; descr:'44.1 kHz, stereo, 16-bit')); procedure ShowInfo; var WaveNums, i, j: integer; WaveInCaps: TWaveInCaps; // структура в которую помещается информация об устройстве begin WaveNums:=waveInGetNumDevs; if WaveNums>0 then // если в системе есть устройства аудиоввода,то begin for i:=0 to WaveNums-1 do // получаем характеристики всех имеющихся устройств begin waveInGetDevCaps(i,@WaveInCaps,sizeof(TWaveInCaps)); // добавляем наименование устройства MainForm.Memo.Lines.Add(PChar(@WaveInCaps.szPname)); for j:=1 to High(modes) do begin // выводим поддерживаемые устройством режимы работы if (modes[j].mode and WaveInCaps.dwFormats)=modes[j].mode then Memo.Lines.Add(modes[j].descr); end; end; end; end;


Рис 1. Сведения, выводимые процедурой ShowInfo.

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

function waveInOpen( lphWaveIn: PHWAVEIN;
uDeviceID: UINT;
lpFormatEx: PWaveFormatEx;
dwCallback,
dwInstance,
dwFlags: DWORD
): MMRESULT; stdcall;

Здесь
lphWaveIn - указатель на идентификатор открытого Waveform audio устройства. Идентификатор используется после того, как устройство открыто, в других функциях Waveform audio;
uDeviceID - номер открываемого устройства (см. waveInGetNumDevs). Это может быть также идентификатор уже открытого ранее устройства. Вы можете использовать значение WAVE_MAPPER для того, чтобы функция автоматически выбрала совместимое с требуемым форматом данных устройство;
lpFormatEx - указатель на структуру типа TWaveFormatEx

type TWaveFormatEx = packed record wFormatTag: Word; { format type }
nChannels: Word; { number of channels (i.e. mono, stereo, etc.) }
nSamplesPerSec: DWORD; { sample rate }
nAvgBytesPerSec: DWORD; { for buffer estimation }
nBlockAlign: Word; { block size of data }
wBitsPerSample: Word; { number of bits per sample of mono data }
cbSize: Word; { the count in bytes of the size of }
end;

В этой структуре значения полей следующее:
wFormatTag - формат Waveform audio. Мы будем использовать значение WAVE_FORMAT_PCM (это означает импульсно-кодовая модуляция) другие возможные значения смотрите в заголовочном файле MMREG.H;
nChannels - количество каналов. Обычно 1 (моно) или 2(стерео);
nSamplesPerSec - частота дискретизации. Для формата PCM - в классическом смысле, т.е. количество выборок в секунду. Согласно теореме отсчетов должна вдвое превышать частоту оцифровываемого сигнала. Обычно находится в диапазоне от 8000 до 44100 выборок в секунду;
nAvgBytesPerSec - средняя скорость передачи данных. Для PCM равна nSamplesPerSec*nBlockAlign;
nBlockAlign - для PCM равен (nChannels*wBitsPerSample)/8;
wBitsPerSample - количество бит в одной выборке. Для PCM равно 8 или 16;
cbSize - равно 0. Подробности в Microsoft Multimedia Programmer's Reference;
dwCallback - адрес callback-функции, идентификатор окна или потока, вызываемого при наступлении события;
dwInstance - пользовательский параметр в callback-механизме. Сам по себе не используется
dwFlags - флаги для открываемого устройства:
CALLBACK_EVENT dwCallback-параметр - код сообщения (an event handle);
CALLBACK_FUNCTION dwCallback-параметр - адрес процедуры-обработчика;
CALLBACK_NULL dwCallback-параметр не используется;
CALLBACK_THREAD dwCallback-параметр - идентификатор потока команд;
CALLBACK_WINDOW dwCallback-параметр - идентификатор окна;
WAVE_FORMAT_DIRECT если указан этот флаг, ACM-драйвер не выполняет преобразование данных;
WAVE_FORMAT_QUERY функция запрашивает устройство для определения, поддерживает ли оно указанный формат, но не открывает его;

В случае использование Callback процедуры она имеет следующий вид:
procedure waveInProc(hwi: HWAVEIN; uMsg,dwInstance, dwParam1,dwParam2: DWORD);stdcall; begin // что-то делаем end; Параметры процедуры имеют следующее значение:
hwi - идентификатор связанного с функцией открытого устройства;
uMsg - Waveform audio сообщение. Может принимать значения:
WIM_CLOSE посылается, когда устройство закрывается функцией waveInClose;
WIM_DATA устройство завершило передачу данных в блок памяти, установленный процедурой waveInAddBuffer;
WIM_OPEN сообщение посылается если устройство открыто функцией waveInOpen;
dwInstance - данные, определенные пользователем при вызове waveInOpen;
dwParam1, dwParam2 - параметры сообщения.

Необходимо заметить, что в Microsoft Multimedia Programmer's Reference написано, что из callback-процедуры нельзя вызывать никаких системных функций кроме:
EnterCriticalSection, LeaveCriticalSection, midiOutLongMsg, midiOutShortMsg, OutputDebugString, PostMessage, PostThreadMessage, SetEvent, timeGetSystemTime, timeGetTime, timeKillEvent, и timeSetEvent , поскольку это вызывает deadlock.
Я столкнулся с весьма серьезным препятствием из-за этого ограничения, и решил все-таки рискнуть. В ходе небольших экспериментов я выяснил, что данное ограничение не распространяется на группу waveInAddBuffer, waveInReset и waveInClose, и возможно, некоторые другие. Не было проблем и с использованием функций Reset, BlockWrite, BlockRead, CloseFile. Говоря более точно, я так и не обнаружил возникновения deadlock, какие бы функции не вызывал изнутри waveInProc. Самое главное - не инициировать бесконечный рекурсивный вызов waveInProc. Для этого необходимо хорошо продумать обработчики поступающих в waveInProc сообщений.
Вообще, рекомендую использовать механизм оконных сообщений вместо callback. Это позволяет избежать ненужных экспериментов и возможной неработоспособности программы в других версиях ОС. Более подробно реализация этого механизма приведена в примере. Функция waveInPrepareHeader выполняет подготовку буфера для операции загрузки данных:

function waveInPrepareHeader( hWaveIn: HWAVEIN;
lpWaveInHdr: PWaveHdr;
uSize: UINT
): MMRESULT; stdcall;
Здесь:
hWaveIn - идентификатор открытого устройства;
lpWaveInHdr - адрес структуры WaveHdr:
type TWaveHdr = record lpData: PChar; { pointer to locked data buffer }
dwBufferLength: DWORD; { length of data buffer }
dwBytesRecorded: DWORD; { used for input only }
dwUser: DWORD; { for client's use }
dwFlags: DWORD; { assorted flags}
dwLoops: DWORD; { loop control counter }
lpNext: PWaveHdr; { reserved for driver }
reserved: DWORD; { reserved for driver }
end;

lpData - адрес буфера для загрузки данных;
dwBufferLength - длина буфера в байтах;
dwBytesRecorded - для режима загрузки данных определяет количество загруженных в буфер байт;
dwUser - пользовательские данные
dwFlags - флаги. Могут иметь следующие значения:
WHDR_DONE устанавливается драйвером при завершении загрузки буфера данными;
WHDR_PREPARED устанавливается системой. Показывает готовность буфера к загрузке данных;
WHDR_INQUEUE устанавливается системой когда буфер установлен в очередь;
dwLoops - используется только при воспроизведении. При записи звука всегда 0;
lpNext - зарезервировано;
reserved - зарезервировано;
uSize - размер структуры WaveHdr в байтах;

Функция waveInPrepareHeader вызывается только один раз для каждого устанавливаемого в очередь загрузки буфера. Существует функция waveInUnprepareHeader, с такими же параметрами, которая освобождает ресурсы системы по сопровождению выделенного под загрузку блока. waveInUnprepareHeader должна быть вызвана до удаления выделенного под буфер загрузки блока памяти.
Функция waveInAddBuffer ставит в очередь на загрузку данными буфер памяти. Когда буфер заполнен, система уведомляет об этом приложение (см. выше waveInOpen).
function waveInAddBuffer( hWaveIn: HWAVEIN;
lpWaveInHdr: PWaveHdr;
uSize: UINT
): MMRESULT; stdcall;

Здесь:
hWaveIn - идентификатор открытого Waveform audio устройства ввода;
lpWaveInHdr - адрес структуры TWaveHdr;
uSize - размер WaveHdr в байтах;

Функция waveInReset останавливает операцию загрузки данных. Все текущие буферы отмечаются как обработанные и приложение уведомляется о завершении загрузки данных (см. waveInOpen).
function waveInReset( hWaveIn: HWAVEIN ): MMRESULT; stdcall; Здесь:
hWaveIn - идентификатор открытого Waveform audio устройства.
Функция waveInClose закрывает открытое устройство ввода:

function waveInClose(
hWaveIn: HWAVEIN
): MMRESULT; stdcall;
hWaveIn - идентификатор открытого устройства;


MMRESULT может принимать следующие значения:
MMSYSERR_NOERROR нет ошибок;
MMSYSERR_ALLOCATED указанный ресурс уже выделен;
MMSYSERR_BADDEVICEID указанный идентификатор устройства вне диапазона;
MMSYSERR_NODRIVER отсутствует драйвер устройства;
MMSYSERR_NOMEM невозможно выделить или зафиксировать блок памяти;
WAVERR_BADFORMAT попытка открытия с неподдерживаемым форматом данных;
MMSYSERR_INVALHANDLE параметром является недопустимый идентификатор;
WAVERR_STILLPLAYING указанный буфер все еще в очереди;
WAVERR_UNPREPARED буфер не был подготовлен;
Пример реализации описанного в статье механизма (Delphi 3) Вы можете скачать (17.7 K)

Александр Галилов


WMI - практика применения в Delphi


Раздел Подземелье Магов
Содержание:
Предисловие. Подготовка. Порядок действий. Примеры.



XML сериализация объекта Delphi


Раздел Подземелье Магов

В статье рассмотрены возможности прямой загрузки/сохранения XML документов в объекты Delphi/С++Builder и генерации соответствующих DTD. Предлагается оптимизированный компонент для реализации этих возможностей.

Язык XML предоставляет нам чрезвычайно удобный и почти универсальный подход к хранению и передаче информации. Существует множество парсеров для разбора XML документов по модели DOM. На платформе Microsoft Windows - это, в первую очередь, парсеры MSXML от Microsoft.

Парсеры взаимодействуют с вызывающими приложениями посредством интерфейса SAX (Simple API for XML) и/или DOM (Document Object Model). Во всех анализаторах, за исключением продукта фирмы Microsoft, используется SAX, и почти во всех их возможно применение DOM.

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

Возникает вопрос возможности упростить работу с XML документами, интегрировать их обработку в разрабатываемые программы. Для модели DOM наилучшим является непосредственная загрузка XML документа в объект Delphi/С++Builder. И эта возможность есть. Используя RTTI можно загружать данные непосредственно из тегов XML документа в атрибуты заданного объекта. Соответственно, становится возможным и XML-сериализация published интерфейсов объектов любых классов Delphi.

Рассматриваемый подход дает возможность наиболее удобно интегрировать обработку XML в среду разработки Delphi и C++Builder. Возможность доступа к свойствам объектов определяется через механизмы RTTI. Его возможности в Delphi очень велики, т.к. среда разработки сама хранит ресурсы объектов в текстовом формате.

Очевидно, что за предлагаемыми преимуществами скрываются и ряд ограничений. В первую очередь, это касается атрибутов тегов. У нас нет простых механизмов отличить атрибут от тега при сохранении свойства объекта. Поэтому в предлагаемой реализации мы будем обрабатывать XML документы, не содержащие атрибутов. Это ограничение может стать критическим только если мы хотим поддержать уже существующий тип XML документа. Если же мы разрабатываем формат сами, то вполне можем отказаться от атрибутов. Зато наш парсер будет работать не просто быстро, а очень быстро. ;)

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

{ пишет строку в выходящий поток. Исп-ся при сериализации } procedure WriteOutStream(Value: string); begin OutStream.Write(Pchar(Value)[0], Length(Value)); end; { Добавляет открывающий тег с заданным именем } procedure addOpenTag(const Value: string); begin WriteOutStream(CR + DupStr(TAB, Level) + ''); inc(Level); end; { Добавляет закрывающий тег с заданным именем } procedure addCloseTag(const Value: string; addBreak: boolean = false); begin dec(Level); if addBreak then WriteOutStream(CR + DupStr(TAB, Level)); WriteOutStream('</' + Value + '>'); end; { Добавляет значение в результирующую строку } procedure addValue(const Value: string); begin WriteOutStream(Value); end;

Следующее, что предстоит реализовать - это перебор всех свойств объекта и формирование тегов. Сведения о свойствах получаются через интерфейс компонента. Это информация о типе. Для каждого свойства, за исключением классовых получается их имя и текстовое значение, после чего формируется XML-тег. Значение загружается через ф-ию TypInfo.GetPropValue();

procedure TglXMLSerializer.SerializeInternal(Component: TObject; Level: integer = 1); var PropInfo: PPropInfo; TypeInf, PropTypeInf: PTypeInfo; TypeData: PTypeData; i, j: integer; AName, PropName, sPropValue: string; PropList: PPropList; NumProps: word; PropObject: TObject; begin { Playing with RTTI } TypeInf := Component.ClassInfo; AName := TypeInf^.Name; TypeData := GetTypeData(TypeInf); NumProps := TypeData^.PropCount; GetMem(PropList, NumProps*sizeof(pointer)); try { Получаем список строк } GetPropInfos(TypeInf, PropList); for i := 0 to NumProps-1 do begin PropName := PropList^[i]^.Name; PropTypeInf := PropList^[i]^.PropType^; PropInfo := PropList^[i]; case PropTypeInf^.Kind of tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkWChar, tkLString, tkWString, tkVariant: begin { Получение значения свойства } sPropValue := GetPropValue(Component, PropName, true); { Перевод в XML } addOpenTag(PropName); addValue(sPropValue); { Добавляем значение свойства в результат } addCloseTag(PropName); end; ...


Для классовых типов придется использовать рекурсию для загрузки всех свойств соответствующего объекта.
Более того, для ряда классов необходимо использовать особый подход. Сюда относятся, к примеру, строковые списки и коллекции. Ими и ограничимся.

Для текстового списка TStrings будем сохранять в XML его свойство CommaText, а в случае коллекции после обработки всех ее свойств сохраним в XML каждый элемент TCollectionItem отдельно. При этом в качестве контейнерного тега будем использовать имя класса TCollection(PropObject).Items[j].ClassName.

... tkClass: { Для классовых типов рекурсивная обработка } begin addOpenTag(PropName); PropObject := GetObjectProp(Component, PropInfo); if Assigned(PropObject)then begin { Для дочерних свойств-классов - рекурсивный вызов } if (PropObject is TPersistent) then Result := Result + SerializeInternal(PropObject, Level); { Индивидуальный подход к некоторым классам } if (PropObject is TStrings) then { Текстовые списки } begin WriteOutStream(TStrings(PropObject).CommaText); end else if (PropObject is TCollection) then { Коллекции } begin Result := Result + SerializeInternal(PropObject, Level); for j := 0 to (PropObject as TCollection).Count-1 do begin addOpenTag(TCollection(PropObject).Items[j].ClassName); SerializeInternal(TCollection(PropObject).Items[j], Level); addCloseTag(TCollection(PropObject).Items[j].ClassName, true); end end; { Здесь можно добавить обработку остальных классов: TTreeNodes, TListItems } end; addCloseTag(PropName, true); end;

Описанные функции позволят нам получить XML код для объекта включая все его свойства. Остается только 'обернуть' полученный XML в тег верхнего уровня - имя класса объекта. Если мы поместим вышеприведенный код в функцию SerializeInternal(), то результирующая функция Serialize() будет выглядеть так:

procedure Serialize(Component: TObject; Stream: TStream); ... WriteOutStream( PChar(CR + '') ); SerializeInternal(Component); WriteOutStream( PChar(CR + '</' + Component.ClassName + '>') );



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

Следует заметить, что при желании можно переписать этот код для генерации также и атрибутов элементов. Для отличия элементов от их атрибутов в интерфейсе сохраняемого объекта можно принять следующее соглашение: элементами являются только классовые типы, все же прочие свойства кодируются как атрибуты соответствующих классов. Соответственно можно модифицировать и парсер. При этом появляется возможность использования XML схем вместо DTD. Тут, однако, возникает проблема описания модели содержания для текста #PCDATA. Для разрешения проблемы придется выделить отдельный класс для хранения подобных данных. Но это тема уже другой статьи.

Продолжение:

Загрузка XML в объект


Раздел Подземелье Магов
Содержание

После того, как мы рассмотрели возможность превода данных объекта в XML следует перейти к следующей задаче. Задача состоит в реализации обратного процесса, а именно - загрузки XML данных в объект.

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

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

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

var Buffer: PChar; { Буфер, в котором находится XML документ } TokenPtr: PChar; { Указатель на текущее положение парсера XML документа } { Загружает в компонент данные из потока с XML-кодом. Вход: Component - компонент для конвертации Stream - источник загрузки XML Предусловия: Объект Component должен быть создан до вызова процедуры } procedure DeSerialize(Component: TObject; Stream: TStream); begin GetMem(Buffer, Stream.Size); try { Получаем данные из потока } Stream.Read(Buffer[0], Stream.Size + 1); { Устанавливаем текущий указатель чтения данных } TokenPtr := Buffer; { Вызываем загрузчик } DeSerializeInternal(Component, Component.ClassName); finally FreeMem(Buffer); end; end;

Следующий код занимается тривиальным разбором XML текта. Ищется первый открывающий тег, затем его закрывающая пара. Найденная пара содержит в себе данные для свойств объекта. Внутри найденной пары тегов последовательно выбираются теги (TagName) и текст их содержания (TagValue). Эти теги предположительно соответствуют свойствам объекта, что мы тут же и проверяем. Обратите внимание, что функция StrPos заменена на StrPosExt для ускорения обработки.

Среди свойств объекта отыскивается через FindProperty() оноименное свойство. При неудаче генерируется исключение об ошибочности XML тега. Если для тега найден соответвующее свойство, то передаем дальнейшую обработку процедуре SetPropertyValue(), которая заданное свойство с именем TagName проинициализирует найденным значением TagValue.

Не забываем также передвигать указатель чтения данных TokenPtr по мере выборки данных.

{ Рекурсивная процедура загрузки объекта их текстового буфера с XML Вызывается из: Serialize() Вход: Component - компонент для конвертации ComponentTagName - имя XML тега объекта } procedure DeSerializeInternal(Component: TObject; const ComponentTagName: string); var BlockStart, BlockEnd, TagStart, TagEnd: PChar; TagName, TagValue: PChar; TypeInf: PTypeInfo; TypeData: PTypeData; PropIndex: integer; AName: string; PropList: PPropList; NumProps: word; { Поиск у объекта свойства с заданным именем } function FindProperty(TagName: PChar): integer; var i: integer; begin Result := -1; for i := 0 to NumProps-1 do if CompareText(PropList^[i]^.Name, TagName) = 0 then begin Result := i; break; end; end; procedure SkipSpaces(var TagEnd: PChar); begin while (TagEnd[0] in [#0..#20]) do inc(TagEnd); end; begin { Playing with RTTI } TypeInf := Component.ClassInfo; AName := TypeInf^.Name; TypeData := GetTypeData(TypeInf); NumProps := TypeData^.PropCount; GetMem(PropList, NumProps*sizeof(pointer)); try GetPropInfos(TypeInf, PropList); { ищем открывающий тег } BlockStart := StrPosExt(TokenPtr, PChar('<' + ComponentTagName + '>'), BufferLength); inc(BlockStart, length(ComponentTagName) + 2); { ищем закрывающий тег } BlockEnd := StrPosExt(BlockStart, PChar('<' + ComponentTagName + '>'), BufferLength); TagEnd := BlockStart; SkipSpaces(TagEnd); { XML парсер } while TagEnd < BlockEnd do begin TagStart := StrPosExt(TagEnd, '<', BufferLength); TagEnd := StrPos(TagStart, '>', BufferLength); GetMem(TagName, TagEnd - TagStart + 1); try { TagName - имя тега } StrLCopy(TagName, TagStart + 1, TagEnd - TagStart - 1); TagEnd := StrPos(TagStart, PChar('</' + TagName + '>')); TokenPtr := TagStart; inc(TagStart, length('</' + TagName + '>')-1); GetMem(TagValue, TagEnd - TagStart + 1); try { TagValue - значение тега } StrLCopy(TagValue, TagStart, TagEnd - TagStart); { поиск свойства, соответствующего тегу } PropIndex := FindProperty(TagName); if PropIndex = -1 then raise Exception.Create( 'TglXMLSerializer.DeSerializeInternal: Uncknown property: ' + TagName); SetPropertyValue(Component, PropList^[PropIndex], TagValue); inc(TagEnd, length('</' + TagName + '>')); SkipSpaces(TagEnd); finally FreeMem(TagValue); end; finally FreeMem(TagName); end; end; finally FreeMem(PropList, NumProps*sizeof(pointer)); end; end;



Остается только код, который загрузит найденные данные в заданной свойство. Процедуре SetPropertyValue() передаются данные о соответствующем свойстве (PropInfo), которое на следует проинициализировать. Также процедура получает и текстовое значение, содержащееся в найденном теге.

В случае, если тип данные не является классовым типом, то, очевидно, текст Value следует просто загрузить в свойство. Это реализуется вызовом процедуры TypInfo.SetPropValue(). Последняя самостоятельно разберется, как корректно преобразовать тестовое значение в значение свойства в завистимости от его типа.

Если свойство имеет классовый тип, то его значение Value должно содержать XML код, описывающий свойства данного класса. В этом случае воспользуемся рекурсией и передадим обработку вышеприведенной процедуре DeSerializeInternal(). При этом передаем ей в качестве объекта ссылку на найденное свойство PropObject и его имя PropInfo^.Name.

Нам также необходимо озаботиться отдельной обработкой данных для таких классовых типов как списки TStrings и коллекции TCollection. Данные для списков мы загружаем из значения Value как CommaText. Тут все понятно. В сллучае же коллеций данные о элементах коллекции в XML документе содержаться в виде последовательных контейнерных тегов с именем типа элемента коллекци. Т.е., к примеру, <TMyCollection> ... </TMyCollection> <TMyCollection> ... </TMyCollection> <TMyCollection> ... </TMyCollection> и так далее. Внутри каждой пары тегов <TMyCollection> содержатся свойства объекта TMyCollection.

procedure SetPropertyValue(Component: TObject; PropInfo: PPropInfo; Value: PChar); var PropTypeInf: PTypeInfo; PropObject: TObject; CollectionItem: TCollectionItem; sValue: string; begin PropTypeInf := PropInfo.PropType^; case PropTypeInf^.Kind of tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkWChar, tkLString, tkWString, tkVariant: begin sValue := StrPas(Value); { Для корректного преобразования парсером tkSet нужны угловые скобки } if PropTypeInf^.Kind = tkSet then sValue := '[' + sValue + ']'; SetPropValue(Component, PropInfo^.Name, sValue); end; tkClass: begin PropObject := GetObjectProp(Component, PropInfo); if Assigned(PropObject)then begin { Индивидуальный подход к некоторым классам } if (PropObject is TStrings) then { Текстовые списки } TStrings(PropObject).CommaText := Value else if (PropObject is TCollection) then { Коллекции } begin while true do { Заранее не известно число элементов в коллекции } begin CollectionItem := (PropObject as TCollection).Add; try DeSerializeInternal(CollectionItem, CollectionItem.ClassName); except { Исключение, если очередной элемент не найден } CollectionItem.Free; break; end; end; end else { Для остальных классов - рекурсивная обработка } DeSerializeInternal(PropObject, PropInfo^.Name); end; end; end; end; { StrPosExt - ищет позицию одной строки в другой с заданной длиной. На длинных строках превосходит StrPos. } function StrPosExt(const Str1, Str2: PChar; Str2Len: DWORD): PChar; assembler; asm PUSH EDI PUSH ESI PUSH EBX OR EAX,EAX // Str1 JE @@2 // если строка Str1 пуста - на выход OR EDX,EDX // Str2 JE @@2 // если строка Str2 пуста - на выход MOV EBX,EAX MOV EDI,EDX // установим смещение для SCASB - подстрока Str2 XOR AL,AL // обнулим AL push ECX // длина строки MOV ECX,0FFFFFFFFH // счетчик с запасом REPNE SCASB // ищем конец подстроки Str2 NOT ECX // инвертируем ECX - получаем длину строки+1 DEC ECX // в ECX - длина искомой подстроки Str2 JE @@2 // при нулевой длине - все на выход MOV ESI,ECX // сохраняем длину подстроки в ESI pop ECX SUB ECX,ESI // ECX == разница длин строк : Str1 - Str2 JBE @@2 // если длина подсроки больше длине строки - выход MOV EDI,EBX // EDI - начало строки Str1 LEA EBX,[ESI-1] // EBX - длина сравнения строк @@1: MOV ESI,EDX // ESI - смещение строки Str2 LODSB // загужаем первый символ подстроки в AL REPNE SCASB // ищем этот символ в строке EDI JNE @@2 // если символ не обнаружен - на выход MOV EAX,ECX // сохраним разницу длин строк PUSH EDI // запомним текущее смещение поиска MOV ECX,EBX REPE CMPSB // побайтно сравниваем строки POP EDI MOV ECX,EAX JNE @@1 // если строки различны - ищем следующее совпадение первого символа LEA EAX,[EDI-1] JMP @@3 @@2: XOR EAX,EAX @@3: POP EBX POP ESI POP EDI end; К приведенному коду следует добавить еще ряд возможностей для более корректной реакции для обработки неверного XML кода. Также можно достаточно просто реализовать автоматическую генерацию DTD для любого класса Delphi. После этого можно собрать полноценный компонент, объединяющий в себе всю необходимую функциональность для XML сериализации.

Продолжение


с использованием API вы может


В архиве все исходники примера (73К).
Дополнительные сведения о программировании с использованием API вы может посмотреть в справочных файлах, которые идут с CR (PROGRAM FILES\SEAGATSOFTWARE\CRYSTAL REPORTS\DEVELOPER FILES\HELP\), файлы DEVELOPR.HLP и RUNTIME.HLP. Если их у вас нет, то скачайте с .
В будущем я надеюсь развить тему CR более углубленно, но это зависит от интереса читателей и наличия времени :-).

Специально для

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


При составлении этого примера я оставил доступными все математические функции, которые были перечислены выше. Вообще функции типа "random", "frac" или "int" с точки зрения математики не желательны. Но при использовании некоторых из них получаются очень любопытные графики (например, int abs x ^ frac abs x или random * x * sin x). Обратите также внимание, что при изменении максимальных значений осей X или Y перерасчет графика происходит практически мгновенно.

Запрос данных от программы Map Info


Для выполнения запроса из Вашей программы-клиента значения MapBasic используйте OLE-методEval.
Например: MyVar:= FServer.Eval('здесь команда MapBasic');

Примечание:
В компоненте это реализовано процедурой Eval, но в сущносте вызывается FServer.Eval

При использовании метода Eval программа MapInfo интерпретирует строку как выражение языка MapBasic, определяет значение выражения и возвращает это значение в виде строки. Замечание: Если выражение приводится к логическому значению (тип Logical), MapInfo возвращает односимвольную строку, "Т" или "F" соответственно.



Запуск и остановка пакета


Для того чтобы произвести запуск (активацию) компонентов, установленных в пакете, можно воспользоваться методом StartApplication интерфейса ICOMAdminCatalog. При этом в качестве параметра можно передавать как имя пакета, так и его GUID ComAdminCatalog.StartApplication('COMTest'); Аналогично выполняется и операция остановки компонентов данного пакета. ComAdminCatalog.ShutdownApplication('COMTest');



Запуск MapInfo


Запуск уникального экземпляра программы MapInfо осуществляется вызовом функции CreateObject() Visual Basic с присваиванием возвращаемого значения объектной переменной. (Вы можете декларировать объектную переменную как глобальную; в противном случае объект MapInfо освобождается после выхода из локальной процедуры.)
Например: FServer := CreateOleObject('MapInfo.Application'); Для подключения к ранее исполнявшемуся экземпляру MapInfo, который не был запущен вызовом функции CreateObject(), используйте функцию GetObject(). // Данная реализация оставлена вам уважаемые читатели для тренировки FServer := GetObject('MapInfo.Application'); Внимание: Если Вы работаете с Runtime-версией MapInfo, а не с полной копией, задавайте "MapInfo. Runtime" вместо "MapInfo. Арplication". Runtime-версия и полная версия могут работать одновременно.

Функции CreateObject() и GetObject() используют механизм управления объектами OLE (OLE Automation) для связи с MapInfo.

Примечание:
В 32-разрядной версии Windows (Windows95 или Windows NT) можно запускать несколько экземпляров MapInfo. Если Вы запустите MapInfo и вслед за этим программу, использующую Интегрированную Картографию и вызывающую CreateObjectf), то будут работать два независимых экземпляра MapInfo. Однако в 16-разрядной версии программа использующая Интегрированную Картографию с запущенным MapInfo работать не сможет.



Завершающие штрихи


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

Скачать : (88К)

Кроме того, к тексту инспектора приложен простенький пример, картинки из которого использованы в статье: модули UnitMainForm (главная форма примера) и UnitInfo (классы метаданных для объектов, инспектируемых в примере). Пример можно компилировать не устанавливая компонент инспектора в палитру компонентов, так как компонент создается явно во время выполнения.


Россия, Томск.

Специально для