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

         

Часть 2. Доступ к объектам пакета.


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

Для того, чтобы новичкам было все ясно, следует немного углубиться в понятие интерфейса. Я полагаю, что вы знакомы с понятием виртуальной таблицы методов (VMT). Именно она является источником и тремя составными частями ООП . Для поддержки COM в Delphi был введен новый, особый тип interface, который позволяет "поименовать" куски виртуальной таблицы методов. Способ этого именования достаточно уникален - 16-байтовое число , которое присваивается каждому такому куску. Есть мнение, что оно статистически уникально . Синтаксис данного типа следующий type IMyInitialize = interface ['{7D501741-B419-11D5-915B-ED714AED3037}'] // то самое 16-битное число в строковом // представлении. Получается // в Delphi нажатием клавиш Ctrl+g. procedure InitializeForm(const ACaption: String); // а это процедура интерфейса. end; Помимо прочего компоненты Delphi содержат метод, позволяющий получать этот кусок виртуальной таблицы. Причем этих методов два. Первый имеет название QueryInterface. Для любителей COM он является привычным, так как используется в оном вдоль и поперек. Второй называется GetInterface. Разница этими методами в том, что у QueryInterface нужно проверять результат на S_OK, а у GetInterface на Boolean .

Теперь давайте прикрутим к нашей системе интерфейсы и покажем, как с ними работать. Для этого создаем новый модуль (он достаточно короткий, и я здесь привожу его полностью) unit CommonInterfaces; interface type IMyInitialize = interface ['{7D501741-B419-11D5-915B-ED714AED3037}'] procedure InitializeForm(const ACaption: String); end; IMyHello = interface ['{7D501742-B419-11D5-915B-ED714AED3037}'] function ShowHello(AText: String): String; end; implementation end. Далее, внесем изменения в наш пакет, учитывающий поддержку интерфейсов 1. для дочерней формы: type TfrmChild = class(TForm, IMyInitialize, IMyHello) // так наследуются интерфейсы Private { описание методов IMyInitialize } procedure InitializeForm(const ACaption: String); { описание методов IMyHello } function ShowHello(AText: String): String; end; Что мы тут сделали? Мы сказали, что TfrmChild является наследником TForm, но помимо методов TForm VMT класа TfrmChild содержит еще два цельных куска, один из которых идентичен VMT IMyInitialize, а второй VMT IMyHello. 2. для диалоговой формы: type TfrmDialogFrom = class(TForm, IMyInitialize) BitBtn1: TBitBtn; BitBtn2: TBitBtn; Label1: TLabel; private { описание методов IMyInitialize } procedure InitializeForm(const ACaption: String); end; Реализация этих методов проста, ее можно смотреть в архиве (Step2).


Соответственно (для вызова этих методов), немного корректируем главную форму… procedure TForm1.aOpenExecute(Sender: TObject); var frmClass: TFormClass; frm: TForm; MyInitialize: IMyInitialize; begin frmClass := TFormClass(GetClass('TfrmChild')); if not Assigned(frmClass) then begin MessageBox(Handle, PChar(Format(' Не найден класс %s', ['TfrmDialogFrom'])), 'Ошибка', MB_APPLMODAL+MB_ICONERROR+MB_OK); exit; end; frm := frmClass.Create(Self); // производим вызов метода интерфейса if frm.GetInterface(IMyInitialize, MyInitialize) then begin // интерфейс поддерживается формой, можно вызывать его методы MyInitialize.InitializeForm(Format('Дочернее окно ? %d', [Tag])); Tag := Tag + 1; end else raise Exception.CreateFmt('Интерфейс %s не поддерживается классом %s', ['ImyInitialize', frm.GetClassName]); end; procedure TForm1.aOpenDialogExecute(Sender: TObject); var frmClass: TFormClass; MyInitialize: IMyInitialize; begin frmClass := TFormClass(GetClass('TfrmDialogFrom')); if not Assigned(frmClass) then begin MessageBox(Handle, PChar(Format('Не найден класс %s', ['TfrmDialogFrom'])), 'Внимание!', MB_APPLMODAL+MB_ICONERROR+MB_OK); Exit; end; with frmClass.Create(Self) do try if GetInterface(IMyInitialize, MyInitialize) then begin // Интерфейс поддерживается фомой, вызываем его метод MyInitialize.InitializeForm(' Диалог'); end else raise Exception.CreateFmt('Интерфейс %s не поддерживается классом %s', ['ImyInitialize', frm.GetClassName]); case ShowModal of mrOk: MessageDlg('Ok!', mtInformation, [mbOk], 0); mrCancel: MessageDlg('Cancel!', mtInformation, [mbOk], 0); else MessageDlg('Неизвестная распальцовка!', mtInformation, [mbOk], 0); end; finally Free(); end; end; Полностью весь проект смотрите в архиве (Step2.zip).

Теперь что мы имеем. Во-первых, мы не знаем действительный тип как дочернего, так и диалогового окон. Но между тем вызываем функции, входящие в его VMT. Во-вторых, мы запросто можем поменять наш пакет на другой. Имена классов форм пакета особого значения не имеют - их можно сохранять в файле настроек или реестре и подгружать при инициализации основного приложения. Единственное, что необходимо неукоснительно соблюдать - дочернее и диалоговое окно ДОЛЖНЫ поддерживать необходимые интерфейсы. В третьих, мы можем КАК УГОДНО изменять формы пакета (включая изменения самой виртуальной таблицы методов, естественно, не затрагивая описания интерфейсов) - общая система приложение-пакет останутся в рабочем состоянии.


Часть 2. Работа с примитивами и изображениями.




Доброе время суток, уважаемые коллеги. В данной статье мы разберем вывод графических примитивов и вывод изображений. GDI+ предоставляет программисту огромный выбор методов для вывода графики, в данной статье мы рассмотрим вывод примитивов с заливкой и без, вывод примитивов с своим стилем линии, использование групп (путей) для группировки примитивов и вывода их на экран, также мы рассмотрим операции по загрузке и выводу изображений, создание на основе изображения - мини-просмотра (Thumbnail), вывода изображения в область (растягивание), вывод изображения в параллелограмм. В данной статье я не буду специально рассматривать трансформацию изображений и примитивов, а так же заливку примитивов различными градиентами и изображениями, так как в первой части данного цикла статей я дал простые примеры по данным вопросам, а применить их к изображению иль к примитивам не составляет особого труда.

Итак, что в данной части мы получим -
вот такой пример.

Итак, сверху - вниз : 1. Вывод примитивов без заливки (для этого в GDI+ предусмотрены функции начинающиеся с Draw…) 2. Вывод примитивов с заливкой (для этого в GDI+ предусмотрены функции начинающиеся с Fill…) 3. Создание мини-просмотра 4.Вывод оригинального изображения, вывод растянутого и вывод изображения в параллелограмм. Рассмотрим это в коде :

procedure TForm1.PaintBox1Paint(Sender: TObject); Const dash : array[0..3] of single = (1, 1, 5, 4); Grani : array[0..2] of TPoint = ((x: 620; y: 180), // Верхняя грань (x: 560; y: 200), // Правая грань (x: 600; y: 260)); // Нижяя грань var R : TRect; Pen : TGPPen; // Кисть SolidBrush : TGPSolidBrush; // Заливка непрерывным цветом path : TGPGraphicsPath; // Пути Image, pThumbnail: TGPImage; // Рисунок begin graphicsGDIPlus := TGPGraphics.Create(PaintBox1.Canvas.Handle); // Рисование примитивов без заливки pen:= TGPPen.Create(MakeColor(255, 0, 0, 0), 1); R.X := 0; R.Y := 0; R.Width := 50; R.Height := 50; graphicsGDIPlus.DrawRectangle(Pen,R); graphicsGDIPlus.DrawLine(Pen,R.X,R.Y,R.X+R.Width,R.Y+R.Height); pen.Free; // Рисование примитивов без заливки c толщиной линии 5 pen:= TGPPen.Create(MakeColor(255, 0, 0, 0), 5); R.X := 60; R.Y := 0; R.Width := 50; R.Height := 50; graphicsGDIPlus.DrawRectangle(Pen,R); graphicsGDIPlus.DrawLine(Pen,R.X,R.Y,R.X+R.Width,R.Y+R.Height); pen.Free; // Рисование примитивов без заливки c толщиной линии 5 и собственным стилем Dash pen:= TGPPen.Create(MakeColor(255, 0, 0, 0), 5); Pen.SetDashPattern(@dash, 4); R.X := 120; R.Y := 0; R.Width := 50; R.Height := 50; graphicsGDIPlus.DrawRectangle(Pen,R); graphicsGDIPlus.DrawLine(Pen,R.X,R.Y,R.X+R.Width,R.Y+R.Height); pen.Free; // Использование графических путей path := TGPGraphicsPath.Create; pen:= TGPPen.Create(MakeColor(255, 0, 0, 0), 1); path.Reset; R.X := 180 ; R.Y := 0; R.Width := 50; R.Height := 50; path.StartFigure(); path.AddArc(R, 0.0, -180.0); path.AddLine(R.X, R.Y+25, R.X+25, R.Y+R.Height); path.AddLine(R.X+25, R.Y+R.Height,R.X+R.Width, R.Y+25); path.CloseFigure(); graphicsGDIPlus.DrawPath(pen, path); Pen.Free; // Рисование примитивов с заливкой непрерывным цветом // Создаем объект для непрерывной заливки SolidBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255, 0)); R.X := 0 ; R.Y := 60; R.Width := 50; R.Height := 50; graphicsGDIPlus.FillRectangle(SolidBrush,R); SolidBrush.Free; SolidBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255, 0)); R.X := 60 ; R.Y := 60; R.Width := 50; R.Height := 50; graphicsGDIPlus.FillEllipse(SolidBrush,R); SolidBrush.Free; // Использование графических путей path := TGPGraphicsPath.Create; SolidBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255, 0)); path.Reset; R.X := 120 ; R.Y := 60; R.Width := 50; R.Height := 50; path.StartFigure(); path.AddArc(R, 0.0, -180.0); path.AddLine(R.X, R.Y+25, R.X+25, R.Y+R.Height); path.AddLine(R.X+25, R.Y+R.Height,R.X+R.Width, R.Y+25); path.CloseFigure(); graphicsGDIPlus.FillPath(SolidBrush, path); SolidBrush.Free; // РАБОТА С ИЗОБРАЖЕНИЕМ // Создаем Thumbnail (Мини просмотр) Image:= TGPImage.Create('FRUIT.JPG'); pThumbnail := Image.GetThumbnailImage(60, 48, nil, nil); graphicsGDIPlus.DrawImage(pThumbnail, 0, 120, pThumbnail.GetWidth, pThumbnail.GetHeight); pThumbnail.Free; pThumbnail := Image.GetThumbnailImage(20, 20, nil, nil); graphicsGDIPlus.DrawImage(pThumbnail, 70, 120, pThumbnail.GetWidth, pThumbnail.GetHeight); pThumbnail.Free; // Вывести изображение как есть graphicsGDIPlus.DrawImage(image, 0, 180); // Вывести изображение в область R := MakeRect(220, 180, 320, 200); graphicsGDIPlus.DrawImage(Image,R); // Вывести изображение в парралелограмм graphicsGDIPlus.DrawImage(Image, PPoint(@Grani), 3); Image.Free; graphicsGDIPlus.Free; end;

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

Скачать (219 K)

С уважением к коллегам, .



Для данного материала нет комментариев.



Часть 2. Создание собственных инструментов, строка состояния - вывод координат.




Доброе время суток, уважаемые коллеги. Этой статьей я продолжаю цикл изучения ActiveX компонента MapX предназначенного для встраивания в свои приложения элементов картографии. В данной статье мы научимся создавать собственные инструменты (tool), собственные (не предопределенные) указатели мыши для собственных инструментов, создадим статус строку с выводом координат. Итак, в прошлом проекте мы создали простое картографическое приложение, теперь мы хотим его приукрасить, это не сложно.

1. Для начала мы сделаем статусную строку где будем выводить координаты мыши преобразованные в координаты на карте.
Итак, в обработчик MouseOver пропишем следующий код, предварительно положив StatusBar на форму.

procedure TForm1.MapXMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var ScreenX,ScreenY : Single; MX,MY : Double; begin //Конвертируем координаты экрана в координаты карты ScreenX := X; ScreenY := Y; MapX.ConvertCoord(ScreenX,ScreenY,MX,MY,miScreenToMap); StatusBar.Panels[0].Text := 'X:' + FloatToStr(MX) + ' Y:' + FloatToStr(MY); end;

Итак что мы сделали - в обработчике мы вызвали метод ConvertCoord, который служит для конвертации координат карты в экранные и наоборот, в зависимости от параметра (miScreenToMap - экранные в картографические, miMapToScreen - картографические в экранные), при этом хочу обратить внимание я специально перевел экранные координаты в тип Single, т.к. процедура требует именно тип Single для экранных координат, ну а далее координаты выведем в строку состояния.
Согласитесь ничего сложного.

2. Все это конечно хорошо но внимательный читатель может задать вопрос а как преобразовывать координаты например в градусы , на что я отвечу к сожалению в MapX нет команд непосредственно изменяющих единицы измерения координат, так как MapX берет координаты непосредственно с карты, если вы хотите настроить вывод координат в градусах при определенной проекции карты вы должны, предварительно щелкнув правой клавишей на объекте Tmap, вызвать окно свойств и там загрузив слои, настроить проекцию.

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

3. После того как мы научились определять координаты на карте, рассмотрим вопрос создания собственных инструментов (что очень неудобно было в интегрированной картографии) в MapX делается очень просто - для этого существует команда CreateCustomTool;
Вот ее синтаксис :


CreateCustomTool (ToolNumber, Type, Cursor, [ShiftCursor],[CtrlCursor], [InfoTips])
Создает пользовательский инструмент, затем, когда он используется, посылает событие ToolUsed.

Небольшое отступление.
Если Вы создаете CustomTool типа "окружность" и в событии Tool_Used среды МарХ определяется SelectByRadius с величиной, передаваемой в событие, результаты получаются не такими, как если Вы выбираете объекты в Radius Select Tool. Метод SelectByRadius не будет точно выбирать, поскольку такой круг не учитывает проекцию карты. Выборки сделанные Radius Select Tool точно выбирают все объекты в заданной окружности.

ToolNumberКоличество инструментов, используемое в дальнейшем. Это целое между 1 и 999
TypeТип описывает поведение инструмента. Берется значениеToolTypeConstants, Которое имеет следующие значения :ToolTypeConstants miToolTypePoint =0 - Точка, указатель miToolTypeLine = 1 - инструмент рисует линию miToolTypeCircle = 2 - инструмент рисует окружность miToolTypeMarquee = 3 miToolTypePoly = 4 - инструмент рисует полилинию miToolTypePolygon = 5 - инструмент рисует полигон. Термин рисует не совсем верный инструмент ведет себя так, как бы рисуя линию, полигон, после окончания рисования данная область,линия,полигон и т.д затирается и вызывается обработчик Tool_Used
Cursor Курсор в случае когда инструмент создан в и курсор в CurrentTool окне карты. Значение выбирается из коллекции CursorConstants. Которая имеет вид :CursorConstants miDef aultCursor = 0 miArrowCursor = 1 miCrossCursor = 2 milBeamCursor = 3 milconCursor = 4 miSizeCursor = 5 miSizeNESWCursor = 6 miSizeNSCursor = 7 miSizeNWSECursor = 8 miSizeEWCursor = 9 miUpArrowCursor =10 miHourglassCursor =11 miNoDropCursor = 12 miArrowHourglassCursor =13 miArrowQuestionCursor = 14 miSizeAllCursor = 15 miArrowToolCursor = 16 miPanCursor =17 miCenter Cursor =18 miZoomlnCursor = 19 miZoomOutCursor = 20 miSymbol Cursor = 21 miTextCursor = 22 miSelectCursor = 23 miRadiusSelectCursor = 24 miRectSelectCursor = 25 miRegionSelectCursor = 26 milnfoCursor = 27 miSelectPlusCursor = 28 miSelectRadiusPlusCursor = 29 miSelectRectPlusCursor = 30 miSelectRegionPlusCursor = 31 miSelectMinusCursor = 32 miSelectRadiusMinusCursor = 33 miSelectRectMinusCursor = 34 miSelectRegionMinusCursor = 35 miLabel Cursor = 36 miDrillDownExpandCursor = 37 miDrillDownContractCursor = 38 miCustomCursor = 39
ShiftCursorЗначение CursorConstants, указывающее, что курсордолжен появиться, пока нажата клавиша SHIFT. Heобязательный параметр. Если он пропущен, клавиша SHIFT недействует на курсор.
CtrlCursorЗначение CursorConstants, указывет, что курсордолжен появиться, пока нажата клавиша CTRL. Heобязательный параметр. Если он пропущен, клавиша CTRL недействует на курсор.


Итак я создал 2 собственных инструмента в FormCreate - это инструмент стрелка (указатель) и инструмент окружность (круг).
Вот они :





MapX.CreateCustomTool(ToolCustomArrow,miToolTypePoint,miDefaultCursor); MapX.CreateCustomTool(ToolCustomCircle,miToolTypeCircle, miDefaultCursor);
Константы ID инструментов я определил так :

Const ToolCustomArrow = 1; ToolCustomCircle = 2;
Обработчики выбора инструментов так :

MapX.MousePointer := miDefaultCursor; MapX.CurrentTool := miArrowTool;
И обратите внимание так

MapX.MousePointer := miCustomCursor; MapX.MouseIcon := 'Icon2.ico'; MapX.CurrentTool := ToolCustomCircle;
Т. е при выборе инструмента окружность стандартный курсор на карте заменяется собственным выбранным из иконки 'Icon2.ico' т.е сразу ответ и на вопрос как создать собственный указатель в MapX. Видите, ничего сложного тоже нет.


Ну и наконец в обработчике инструментов пользователя MapXToolUsed я прописал следующий демо-код.

procedure TForm1.MapXToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool; var EnableDefault: WordBool); begin IF ToolNum = ToolCustomArrow Then ShowMessage('Использован собственный инструмент - стрелка'); IF ToolNum = ToolCustomCircle Then ShowMessage('Использован собственный инструмент - Круг'); end;
Вот в принципе и все на сегодня, в следующих частях мы более подробно разберем, собственные обработчики и научимся работать с данными таблиц

С уважением к коллегам,
.

Скачать проект: (11 K)


Часть 3. Взаимодействие пакета с приложением


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

Попробуем это реализовать. В модуль CommonInterfaces добавляем новый интерфейс ICallBackInterface = interface ['{7D501743-B419-11D5-915B-ED714AED3037}'] procedure Callback(Text: String); end; Добавляем этот интерфейс к главной форме приложения type TForm1 = class(TForm, ICallBackInterface) MainMenu: TMainMenu; … protected { ICallBackInterface } procedure Callback(Text: String); … end; var Form1: TForm1; implementation … procedure TForm1.Callback(Text: String); begin ShowMessage('Из главной формы с приветом "' + Text + '"'); end; … А теперь возвращаемся в пакет и пробуем вызвать метод Callback главной формы из пакета. В дочерней форме TfrmChild создаем TAction aQueryInMainForm, цепляем его в меню и создаем реализацию OnExecute procedure TfrmChild.aQueryInMainFormExecute(Sender: TObject); var CallBackInterface: ICallBackInterface; begin if Application.MainForm.GetInterface(ICallBackInterface, CallBackInterface) then CallBackInterface.Callback('Привет от дочерней формы ' + Caption); end; Теперь запускаем и проверяем, что все у нас работает как надо.



Можно несколько усложнить наш пример


Можно несколько усложнить наш пример и наглядно продемонстрировать новые преимущества данной методики. Давайте добавим на форму объект TListBox и изменим реализацию метода ShowHello из интерфейса IMyHello следующим образом function TfrmChild.ShowHello(AText: String): String; begin InputQuery('Вот что спросили', AText, Result); ListBox1.Items.Add('Вот что спросили:'); ListBox1.Items.Add(AText); ListBox1.Items.Add('Вот что ответили:'); ListBox1.Items.Add(Result); ListBox1.Items.Add(''); end; Идем к форме TfrmDialogFrom, добавляем туда большую кнопку, на OnClick которой пишем следующее: procedure TfrmDialogFrom.Button1Click(Sender: TObject); var MyHello: IMyHello; Result: String; begin if Assigned(Application.MainForm.ActiveMDIChild) and Application.MainForm.ActiveMDIChild.GetInterface(IMyHello, MyHello) then begin Result := MyHello.ShowHello('Где начало того конца, которым начинается начало?'); ShowMessage(Result); end; end; Если задуматься над этой процедурой, то станет ясно, что нам не важен тип активной дочерней формы и местоположение реализации этого типа (в главном приложении находится ее модуль, в том же пакете, что и TfrmDialogFrom, или где-нибудь еще). Мы просто обнаружили, что есть какая-то активная форма, спросили ее на предмет поддержки конкретного интерфейса и вызвали его метод.

Полный исходный код этой части находится в архиве (каталог Step3)


Часть 4. Некоторые нюансы


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

Добавим еще один интерфейс в модуль CommonInterfaces и назавем его ICallbackInterface2. В интерфейсе опишем процедуру с названием, пересекающимся с ICallbackInterface: ICallbackInterface2 = interface ['{7D501744-B419-11D5-915B-ED714AED3037}'] procedure Callback(Text: String); end; Теперь введем этот интерфейс в главную форму: type TForm1 = class(TForm, ICallBackInterface, ICallbackInterface2) MainMenu: TMainMenu; File1: TMenuItem; … Чтобы компилятор правильно различал вызовы методов Callback от разных интерфейсов, секцию protected перепишем следующим образом: … protected // перенаправляем вызов через ICallBackInterface к процедуре Callback1 procedure ICallBackInterface.Callback = Callback1; // перенаправляем вызов через ICallBackInterface2 к процедуре Callback2 procedure ICallBackInterface2.Callback = Callback2; procedure Callback1(Text: String); procedure Callback2(Text: String); … end; … procedure TForm1.Callback1(Text: String); begin ShowMessage('Из главной формы 1 "' + Text + '"'); end; procedure TForm1.Callback2(Text: String); begin ShowMessage(' Из главной формы 2 "' + Text + '"'); end; И, наконец, в форме TfrmChild нашего пакета строим вызовы этих методов type TfrmChild = class(TForm, IMyInitialize, IMyHello) … aQueryInMainForm: TAction; aQueryInMainForm2: TAction; … procedure aQueryInMainFormExecute(Sender: TObject); procedure aQueryInMainForm2Execute(Sender: TObject); private … procedure TfrmChild.aQueryInMainFormExecute(Sender: TObject); var CallBackInterface: ICallBackInterface; begin if Application.MainForm.GetInterface(ICallBackInterface, CallBackInterface) then CallBackInterface.Callback('Привет от ' + Caption); end; procedure TfrmChild.aQueryInMainForm2Execute(Sender: TObject); var CallBackInterface: ICallBackInterface2; begin if Application.MainForm.GetInterface(ICallBackInterface2, CallBackInterface) then CallBackInterface.Callback('Привет от ' + Caption); end; … Запускаем и убеждаемся в том, что вызываются действительно нужные методы.


Полный исходный код этой части находится в архиве (каталог Step4).

Еще один нюанс, известный программистам COM. Ничто не запрещает вводить в интерфейсы обычные свойства Deplhi (для более простого моделирования). Ограничением, естественно, является только то, что интерфейс не может содержать полей-данных. В интерфейсы должны быть описаны только методы. Вот пример интерфейса содержащего свойства IMainForm = interface ['{765B2E71-B81C-11D5-9160-C43E6EC62937}'] function GetCaption: TCaption; procedure SetCaption(const Value: TCaption); function GetFont: TFont; procedure SetFont(conts Value: TFont); function GetSelf: TForm; property Caption: TCaption read GetCaption write SetCaption; property Font: TFont read GetFont write SetFont; property Self: TForm read GetSelf; end Естественно, при наследовании некоторым классом (скажем, какой-нибудь формой) этого интерфейса необходимо в него ввести реализацию методов GetCaption, SetCaption, GetFont, SetFont, GetSelf .

Ну и напоследок, интерфейсы можно наследовать так же, как и обычные классы. При чем это наследование может быть множественным (как в С++). Пример:
У нас был интерфейс ICallBackInterface: ICallBackInterface = interface ['{7D501743-B419-11D5-915B-ED714AED3037}'] procedure Callback(Text: String); end; Добавляем еще один интерфейс, расширяющий поведение ICallBackInterface ICallBackInterfaceEx = interface(ICallBackInterface) ['{7D501743-B419-11D5-915B-ED714AED3038}'] procedure CallbackEx(Text: String); end; , а в главной форме поменяем наследование TForm1 = class(TForm, ICallBackInterface, ICallbackInterfaceEx) Теперь после компиляции что мы получим?

Вызов Application.MainForm.GetInterface(ICallBackInterface, CallBackInterface) всегда будет возвращать ссылку на кусок виртуальной таблицы методов, содержащей процедуру Callback и только ее (то есть, действительно ссылку ICallBackInterface, хотя мы его явно не наследовали).

А вот вызов Application.MainForm.GetInterface(ICallBackInterfaceEx, CallBackInterface) будет возвращать ссылку на кусок виртуальной таблицы методов, содержащей как процедуру Callback, так и CallbackEx.

Отсюда можно сделать следующие выводы: Старые приложения (или пакеты - все зависит от места использования интерфейса), не знающего ICallBackInterfaceEx, будут вызывать ICallBackInterface и останутся в работоспособном состоянии. Новые приложения (или пакеты), уже имеющие сведения о ICallBackInterfaceEx, вполне могут вызывать как ICallBackInterfaceEx, так и ICallBackInterface (в зависимости от прихоти программиста). То есть, значительно облегчается сопровождения декомпозированного приложения (что так знакомо программистам COM).


Часть 5. Агрегация


До сих пор для получения интерфейса объекта я использовал функцию GetInterface. Она прекрасно работает и удобна в использовании, но имеет существенные ограничения. Прежде всего, эта функция не виртуальная. То есть, вы не сможете переопределить ее поведение в классах-наследниках. А делает эта функция только одно - сканирует локальную VMT объекта на предмет получения требуемого куска VMT. Однако, начиная от TComponent, компоненты Delphi содержат функцию, делающую почти то же самое, но являющуюся виртуальной. Под "почти" я имею ввиду то, что эта функция вызывает GetInterface, но осуществляет еще дополнительные проверки и имеет немного другой формат вызова. Эта функция в последствии принимает участие в COM программировании и имеет наименование QueryInterface .
Функция определяется так: function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; Функция возвращает HResult (целое число, содержащее код ошибки) для определения успешности или не успешности ее выполнения. Для преобразования этого значения в boolean (если нет необходимости анализировать непосредственно код ошибки и вас интересует лишь фактическое "да" или "нет") имеется дополнительная функция Succeeded. Любой вызов GetInterface из приведенных выше примеров можно заменить на примерно следующий: if Succeeded(QueryInterface(IMyHello, MyHello)) then … Однако есть одна маленькая неприятность - функция QueryInterface описана в секции protected класса TComponent. Это означает, что вы не можете ее вызвать нигде, кроме как внутри методов данного класса TComponent. То есть, строка Application.MainForm.QueryInterface(…) не будет компилироваться. Из этого есть два выхода. Первый заключается в получении ЛЮБОГО интерфейса объекта через вызов GetInterface и через него вызывать функцию QueryInterface. Для этих целей можно написать обобщенную процедуру, скажем так function QueryInterface(const AObject: TObject, const IID: TGUID; out Obj): HResult; begin if AObject.GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE; end; Второй заключается в написании наследников всех (или почти всех) используемых базовых компонент, в которых эта функция перемещается в секцию public. Примерно вот так: type TInterfacedForm = class(TForm, IUnknown) public function QueryInterface(const IID: TGUID; out Obj): HResult; override; end; … implementation function TInterfacedForm .QueryInterface(const IID: TGUID; out Obj): HResult; begin Result := inherited QueryInterface(IID, Obj); end; end. Если при этом все необходимые компоненты проекта (в частности, главную форму приложения) наследовать от них, тогда в любой точке проекта можно будет построить следующий вызов. var MainForm: TInterfacedForm; begin if Application.MainForm is TInterfacedForm then begin MainForm := Application.MainForm is TInterfacedForm; if Succeeded(MainForm.QueryInterface(IMyHello, MyHello)) then … … end; end; Остается заметить, что этот модуль желательно оформить в виде отдельного пакета, установить его в системе и компилировать с ним как основное приложение, так и пакеты-плугины.

Теперь, после всего выше сказанного, нетрудно осуществить непосредственную агрегацию. Первое место, где она с успехом может быть применена - это приложения с использованием БД. Обычно в этом случае основное приложение имеет (помимо главной формы) один или несколько модулей данных (наследников TDataModule), содержащих коннект к БД и бизнес логику приложения. Чтобы явно подчеркнуть непосредственно агрегацию, сделаем главную форму не наследующей никакого интерфейса. Между тем, оказывается возможным (с помощью простой, но довольно обобщенной махинации) запрашивать требуемые дочерней форме интерфейсы и выполнять над ними работу. Исходный текст проекта см. в архиве (каталог Step5). Код проекта мал, упрощен насколько это возможно и вряд ли нуждается в особых комментариях.



Часть II


, часть I
Вернуться к разделу
тели часто стали жаловаться клиенты на то, что
их двигатели клинят. Руководству фирмы не что не оставалась делать, как объявить
награду в 1000 долларов тому кто найдет и исправит причину заклинивания неудачного
двигателя. Через час приходит обыкновенный ремонтник и одним ударом молотка исправляет
деффект. Причем цену назначает так 1 доллар за удар молотка и 999 за место по которому
нужно ударить.
Структура DCB

Структура DCB определяет установку управления для последовательного порта ввода-вывода (нам она понадобится для разбора примера с программой управления весами ПетрВес)

Примечание : В местах где нельзя дать точный перевод будет дано определение на английском из MSDK и приблизительный его перевод

Описание в эквиваленте C

typedef struct _DCB { // dcb DWORD DCBlength; // Размер DCB DWORD BaudRate; // Скорость пересылки данных в бодах; // текущая скорость в бодах DWORD fBinary: 1; // binary mode, no EOF check // двоичный режим , не проверять конец // данных (по умолчанию значение = 1) DWORD fParity: 1; // Включить проверку четность (по умолчанию // значение = 1) DWORD fOutxCtsFlow:1; // CTS управление потоком выхода DWORD fOutxDsrFlow:1; // DSR управление потоком выхода DWORD fDtrControl:2; // DTR Тип управления потоком скорости // передачи данных DWORD fDsrSensitivity:1; // DSR sensitivity (чувствительность) DWORD fTXContinueOnXoff:1; // XOFF continues Tx (стоп-сигнал // продалжает выполнение) DWORD fOutX: 1; // XON/XOFF out flow control (СТАРТ- // СИГНАЛ / СТОП-СИГНАЛ для управления // выходящим потоком (по умолчанию // значение = 1) DWORD fInX: 1; // XON/XOFF in flow control (СТАРТ- // СИГНАЛ / СТОП-СИГНАЛ для управления // входящим потоком (по умолчанию // значение = 1) DWORD fErrorChar: 1; // enable error replacement (включить // проверку погрешностей по умолчанию=1) DWORD fNull: 1; // enable null stripping (отвергать // пустой поток данных (по умолчанию=1)) DWORD fRtsControl:2; // RTS управление потоком данных DWORD fAbortOnError:1; // abort reads/writes on error // (проверять операции чтения/записи // по умолчанию=1) DWORD fDummy2:17; // reserved ЗАРЕЗЕРВИРОВАНО WORD wReserved; // not currently used НЕ ДЛЯ // ИСПОЛЬЗОВАНИЯ WORD XonLim; // transmit XON threshold (порог // чувствительности старт-сигнала) WORD XoffLim; // transmit XOFF threshold (порог // чувствительности стоп-сигнала) BYTE ByteSize; // Бит в байте (обычно 8) BYTE Parity; // 0-4=no,odd,even,mark,space // (четность байта) BYTE StopBits; // 0,1,2 = 1, 1.5, 2 (стоповые биты) char XonChar; // Tx and Rx XON character (вид // старт сигнал в потоке) char XoffChar; // Tx and Rx XOFF character (вид // стоп сигнал в потоке) char ErrorChar; // error replacement character (какой // сигнал погрешности,его вид) char EofChar; // end of input character (сигнал // окончания потока) char EvtChar; // received event character РЕЗЕРВ WORD wReserved1; // reserved; do not use НЕ ДЛЯ // ИСПОЛЬЗОВАНИЯ } DCB;


Пример :

with Mode do Begin BaudRate := 9600; ByteSize := 8; Parity := NOPARITY; StopBits := ONESTOPBIT; // одиночный стоп-бит Flags := EV_RXCHAR + EV_EVENT2; End;

Параметры :

DCBlengthРазмер DCB структуры. BaudRateОпределяет скорость в бодах, в которых порт оперирует. Этот параметр может принимать фактическое значение скорости в бодах, или один из следующих стандартных индексов скорости в бодах: CBR_110 CBR_19200 CBR_300 CBR_38400 CBR_600 CBR_56000 CBR_1200 CBR_57600 CBR_2400 CBR_115200 CBR_4800 CBR_128000 CBR_9600 CBR_256000 CBR_14400 fBinaryОпределяет, допускается ли двоичный (бинарный) способ передачи данных. Win32 API не поддерживает недвоичные (небинарные) способы передачи данных в потоке порта, так что этот параметр должен быть всегда ИСТИНЕН. Попытка использовать ЛОЖЬ в этом параметре не будет работать.

Примечание :

Под Windows 3.1 небинарный способ передачи допускается,но для работы данного способа необходимо заполнит параметр EofChar который будет восприниматься конец данных. fParityОпределяет, допускается ли проверка четности. Если этот параметр ИСТИНЕН, проверка четности допускается fOutxCtsFlowCTS (clear-to-send) управление потоком выхода fOutxDsrFlowDSR (data-set-ready) управление потоком выхода fDtrControlDTR (data-terminal-ready) управление потоком выхода
Принимает следующие значения : DTR_CONTROL_DISABLE
Отключает линию передачи дынных DTR_CONTROL_ENABLE
Включает линию передачи дынных DTR_CONTROL_HANDSHAKE
Enables DTR handshaking. If handshaking is enabled, it is an error for the application to adjust the line by using the EscapeCommFunction function.
Допускает подтверждению связи передачи данных Если подтверждение связи допускается, это - погрешность для того чтобы регулировать(корректировать) линию связи, используя функцию EscapeCommFunction. fDsrSensitivitySpecifies whether the communications driver is sensitive to the state of the DSR signal. If this member is TRUE, the driver ignores any bytes received, unless the DSR modem input line is high.
Определяет возможна ли по порту двухсторонняя передача в ту и в другую сторону сигнала. fTXContinueOnXoffОпределяет, останавливается ли передача потока , когда входной буфер становится полный, и драйвер передает сигнал XoffChar. Если этот параметр ИСТИНЕН, передача продолжается после того, как входной буфер становится в пределах XoffLim байтов, и драйвер передает сигнал XoffChar, чтобы прекратить прием байтов из потока . Если этот параметр ЛОЖНЫЙ, передача не продолжается до тех пор , пока входной буфер не в пределах XonLim байтов, и пока не получен сигнал XonChar, для возобновления приема . fOutXОпределяет, используется ли управление потоком СТАРТ-СИГНАЛА / СТОП-СИГНАЛА в течение передачи потока порту. Если этот параметр ИСТИНЕН, передача останавливается, когда получен сигнал XoffChar и начинается снова, когда получен сигнал XonChar. fInXSpecifies whether XON/XOFF flow control is used during reception. If this member is TRUE, the XoffChar character is sent when the input buffer comes within XoffLim bytes of being full, and the XonChar character is sent when the input buffer comes within XonLim bytes of being empty. Определяет, используется ли управление потоком СТАРТ-СИГНАЛА / СТОП-СИГНАЛА в течение приема потока портом. Если этот параметр ИСТИНЕН,сигнал XoffChar посылается , когда входной буфер находится в пределах XoffLim байтов, а сигнал XonChar посылается тогда когда входной буфер находится в пределах XonLim байтов или является пустым fErrorCharОпределяет, заменены ли байты, полученные с ошибками четности особенностью, указанной параметром ErrorChar Если этот параметр ИСТИНЕН, и fParity ИСТИНЕН, замена происходит. fNullОпределяет, отвергнуты ли нулевые(пустые) байты. Если этот параметр ИСТИНЕН, нулевые(пустые) байты, будут отвергнуты при получении их. fRtsControlRTS управление потоком " запрос пересылки ". Если это значение нулевое, то по умолчанию устанавливается RTS_CONTROL_HANDSHAKE. Принимает одно из следующих значений: RTS_CONTROL_DISABLE
Отключает строку RTS, когда устройство открыто RTS_CONTROL_ENABLE
Включает строку RTS RTS_CONTROL_HANDSHAKE
Enables RTS handshaking. The driver raises the RTS line when the "type-ahead" (input) buffer is less than one-half full and lowers the RTS line when the buffer is more than three-quarters full. If handshaking is enabled, it is an error for the application to adjust the line by using the EscapeCommFunction function.
Допускает RTS подтверждение связи. Драйвер управляет потоком пересылки.RTS выравнивается , когда входной буфер - меньше чем половина полного и понижается, когда буфер - больше 2/3 полного .Если подтверждение связи допускается, это используется для регулирования передачи данных EscapeCommFunction. RTS_CONTROL_TOGGLE
Specifies that the RTS line will be high if bytes are available for transmission. After all buffered bytes have been sent, the RTS line will be low. Определяет, что буфер будет высокий при подготовке данных для передачи. После того, как все байты отосланы, буфер RTS будет низок. FAbortOnError Определяет, закончена ли операции чтения/записи, если происходит погрешность.
Если этот параметр ИСТИНЕН, драйвер закрывает все операции чтения/записи с состоянием погрешности при возникновении оной.
Драйвер не будет принимать никакие дальнейшие действия, пока не дождется подтверждения погрешности в передоваемых (принимаемых) данных, вызывая функцию ClearCommError. fDummy2ЗАРЕЗЕРВИРОВАНО Microsoft wReservedЗАРЕЗЕРВИРОВАНО Microsoft XonLimОпределяет минимальное число байтов, находящихся во входном буфере прежде, чем будет генерирована подача СТАРТ-СИГНАЛА XoffLimОпределяет максимальное число байтов, находящихся во входном буфере прежде, чем будет генерирована подача СТОП-СИГНАЛА. Максимальное число байтов, позволенных во входном буфере вычитается из размеров, в байтах, самого входного буфера. ByteSizeОпределяет число битов в байтах, переданных и полученных. ParityОпределяет схему четности, которую нужно использовать. Этот параметр может быть одним из следующих значений: EVENPARITY MARKPARITY NOPARITY ODDPARITY StopBitsОпределяет число стоповых битов, которые нужно использовать.
Этот параметр может быть одним из следующих значений: ONESTOPBIT 1 stop bit ONE5STOPBITS 1.5 stop bits TWOSTOPBITS 2 stop bits XonCharОпределяет значение СТАРТ-СИГНАЛА для передачи и приема. XoffCharОпределяет значение СТОП-СИГНАЛА для передачи и приема. ErrorCharОпределяет значение СИГНАЛА ОШИБКИ (генерируемого при ошибке четности) для передачи и приема. EofCharОпределяет значение сигнала конца данных. EvtCharОпределяет значение сигнала события. wReserved1ЗАРЕЗЕРВИРОВАНО Microsoft

Дополнение :

Когда структура DCB использует «ручной» выбор конфигурации , следующие ограничения используются для ByteSize и StopBits параметров : Число информационных разрядов должно быть от 5 до 8 битов. Использование 5 информационных разрядов с 2 стоповыми битами - недопустимая комбинация, как - 6, 7, или 8 информационных разрядов с 1.5 стоповыми битами.

Продолжнение следует...

, часть I


20 апреля 2001 г.
Специально для


Часть II - Реализация CallBack вызовов MapInfo и перехват в собственной программе.


Доброе время суток ! Краткое примечание
Немного об отзывах - хочу сообщить и повторить снова в данных циклах статей не будет информации об ActiveX компоненте MapX (о работе с ней, отзывы о ней и т.п.) по причине отсутствия у меня оной (может кто поделится J).



Часть III


, часть I
, часть II
Вернуться к разделу
авное не знание ,
а умение его правильно применить» В обход своей статьи по желанию трудящихся масс представляю вашему вниманию еще пример для работы с портами теперь уже с портом LPT реализующий чистый вывод потока на принтер (данный пример взят мной из FAQ собранный Акжаном Абдулиным,за что ему огромное спасибо)

Итак…

Ниже пример открытия принтера и записи чистого потока данных в принтер.
Учтите, что Вы должны передать корректное имя принтера, такое, как "HP LaserJet 5MP",чтобы функция сработала успешно. Конечно, Вы можете включать в поток данных любые необходимые управляющие коды, которые могут потребоваться. === Cut === uses WinSpool; procedure WriteRawStringToPrinter(PrinterName:String; S:String); var Handle: THandle; N: DWORD; DocInfo1: TDocInfo1; begin if not OpenPrinter(PChar(PrinterName), Handle, nil) then begin ShowMessage('error ' + IntToStr(GetLastError)); Exit; end; with DocInfo1 do begin pDocName := PChar('test doc'); pOutputFile := nil; pDataType := 'RAW'; end; StartDocPrinter(Handle, 1, @DocInfo1); StartPagePrinter(Handle); WritePrinter(Handle, PChar(S), Length(S), N); EndPagePrinter(Handle); EndDocPrinter(Handle); ClosePrinter(Handle); end; procedure TForm1.Button1Click(Sender: TObject); begin WriteRawStringToPrinter('HP', 'Test This'); end; === Cut === unit TextPrinter; interface uses Windows, Controls, Forms, Dialogs; type TTextPrinter = class(TObject) FNumberOfBytesWritten: Integer; FHandle: THandle; FPrinterOpen: Boolean; FErrorString: PChar; procedure SetErrorString; public constructor Create; procedure Write(const Str: string); procedure WriteLn(const Str: string); destructor Destroy; override; published property NumberOfBytesWritten: Integer read FNumberOfBytesWritten; end; implementation {TTextPrinter} constructor TTextPrinter.Create; begin FHandle := CreateFile('LPT1', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); if FHandle = INVALID_HANDLE_VALUE then begin SetErrorString; raise Exception.Create(FErrorString); end else FPrinterOpen := True; end; procedure TTextPrinter.SetErrorString; begin if FErrorString <> nil then LocalFree(Integer(FErrorString)); FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(), LANG_USER_DEFAULT, @FErrorString, 0, nil); end; procedure TTextPrinter.Write(const Str: string); var OEMStr: PChar; NumberOfBytesToWrite: Integer; begin if not FPrinterOpen then Exit; NumberOfBytesToWrite := Length(Str); OEMStr := PChar(LocalAlloc(LMEM_FIXED, NumberOfBytesToWrite + 1)); try CharToOem(PChar(Str), OEMStr); if not WriteFile(FHandle, OEMStr^, NumberOfBytesToWrite, FNumberOfBytesWritten, nil) then begin SetErrorString; raise Exception.Create(FErrorString); end; finally LocalFree(Integer(OEMStr)); end; end; procedure TTextPrinter.WriteLn(const Str: string); begin Self.Write(Str); Self.Write(#10); end; destructor TTextPrinter.Destroy; begin CloseHandle(FHandle); if FErrorString <> nil then LocalFree(Integer(FErrorString)); end; end. === Cut === P.S. В принципе, вместо LPT1 может стоять что угодно, даже сетевой сервер печати (\\server\prn) - все равно печатает. Можно и параметр в конструктор вставить и т.д.

Ну на примерах остановились идем далее по теме статьи и продолжаем разбирать работу программы «ПетрВес» в которой я хотел бы остановится на следующем : В своей программе по работе с весами ПетрВес (далее во всех продолжениях цикла -«ПетрВес») ее аммы остановится на таком коде // Первоначальное считывание,приминяется для того что-бы установить // все параметры структур по умолчанию if not Windows.GetCommState(hComm, Mode) or not Windows.GetCommTimeouts(hComm,TimeOuts) then exit Else // у нас все хорошо все считалось нормально ,идем далее.. begin with Mode do Begin BaudRate := 9600; ByteSize := 8; Parity := NOPARITY; StopBits := ONESTOPBIT; Flags := EV_RXCHAR + EV_EVENT2; End; // Устанавливаем таймауты with TimeOuts do Begin ReadIntervalTimeout := MAXDWORD; ReadTotalTimeoutMultiplier := 0; ReadTotalTimeoutConstant := 0; End; IF Not SetCommState ( hComm, Mode ) OR Not SetCommTimeOuts(hComm,TimeOuts); Then ShowMessage("Ошибка"); // тут предпринимаем всякие действия // по обработке ошибки End; Итак посмотрим что делает данный код:


GetCommState
функция находится в файле kernel32. dll The GetCommState function fills in a device-control block (a DCB structure) with the current control settings for a specified communications device.
Функция GetCommState считывает структуру DCB с указанного порта (данную функцию можно использовать как проверку доступности порта).

Описание в эквиваленте C

BOOL GetCommState( HANDLE hFile, // Дескриптор указывающий на порт (этот дескриптор // может быть создан с помощью CreateFile, OpenFile) LPDCB lpDCB // Структура управления устройством DCB (портом в // нашем случае) );

Параметры :

HFileДескриптор указывающий на порт (этот дескриптор может быть создан с помощью CreateFile, OpenFile) lpDCBСтруктура управления устройством DCB (портом в нашем случае)

Возвращаемое значение :

Если функция выполняется успешно, возвращаемое значение - TRUE иначе возвращаемое значение - FALSE . При возникновении ошибки код ошибки можно получить используя GetLastErro

SetCommState
функция находится в файле kernel32.dll The SetCommState function configures a communications device according to the specifications in a device-control block (a DCB structure). The function reinitializes all hardware and control settings, but it does not empty output or input queues.
Функция SetCommState конфигурирует настройки порта согласно техническим требованиям указанным в блоке управления устройством (структура DCB). Функция повторно инициализирует все аппаратные средства и установки управления, но не затрагивает очеpеди пеpедачи и пpиема потоков данных.

Описание в эквиваленте C

BOOL SetCommState( HANDLE hFile, // Дескриптор указывающий на порт (этот дескриптор // может быть создан с помощью CreateFile,OpenFile) LPDCB lpDCB // Структура управления устройством DCB (портом в // нашем случае) );

Коротко

Инициализиpует устpойство связи, указанное в поле HFILE блока DCB, в состояние, заданное DCB. Очеpеди пеpедачи и пpиема не затpагиваются.

Параметры :

HFileДескриптор указывающий на порт (этот дескриптор может быть создан с помощью CreateFile, OpenFile) lpDCB Структура управления устройством DCB (портом в нашем случае)



Возвращаемое значение :

Если функция выполняется успешно, возвращаемое значение - TRUE иначе возвращаемое значение - FALSE . При возникновении ошибки код ошибки можно получить используя GetLastError.

Дополнительные сведения:

The SetCommState function uses a DCB structure to specify the desired configuration. The GetCommState function returns the current configuration. To set only a few members of the DCB structure, you should modify a DCB structure that has been filled in by a call to GetCommState. This ensures that the other members of the DCB structure have appropriate values. The SetCommState function fails if the XonChar member of the DCB structure is equal to the XoffChar member.
Функция SetCommState использует структуру DCB, чтобы переинициализировать конфигурацию по умолчанию. Чтобы перенастроить только несколько членов структуры DCB, Вы должны изменить структуру DCB, которая была получена с помощью GetCommState. Это будет гарантировать, что другие члены структуры DCB будут иметь соответствующие значения по умолчанию.

Важно

Функция SetCommState потерпит неудачу, если параметр XonChar структуры DCB будет равен параметру XoffChar.
Для функции SetCommState используются следующие ограничения параметров ByteSize и StopBits структуры DCB: Число информационных разрядов должно быть от 5 до 8 битов. Использование 5 информационных разрядов с 2 стоповыми битами - недопустимая комбинация, как - 6, 7, или 8 информационных разрядов с 1.5 стоповыми битами.

Продолжнение следует...

, часть I
, часть II


23 апреля 2001 г.
Специально для


Часть III - Настройка панелей


Доброе время суток !

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



Часть IV


, часть I
, часть II
, часть III
Вернуться к разделу
аммах для Win32 в среде C++» Титова Олега (за что ему очередное спасибо)

Следующей важной после DCB управляющей структурой является COMMTIMEOUTS. Она определяет параметры временных задержек при приеме и передаче. Значения, задаваемые полями этой структуры, оказывают большое влияние на работу функций чтения/записи.

COMMTIMEOUTS

Описание в эквиваленте C

typedef struct _COMMTIMEOUTS { DWORD ReadIntervalTimeout; DWORD ReadTotalTimeoutMultiplier; DWORD ReadTotalTimeoutConstant; DWORD WriteTotalTimeoutMultiplier; DWORD WriteTotalTimeoutConstant; } COMMTIMEOUTS,*LPCOMMTIMEOUTS;

Параметры :

ReadIntervalTimeoutМаксимальное время, в миллисекундах, допустимое между двумя последовательными символами считываемыми с коммуникационной линии. Во время операции чтения временной период начинает отсчитываться с момента приема первого символа. Если интервал между двумя последовательными символами превысит заданое значение, операция чтения завершается и все данные, накопленые в буфере, передаются в программу. Нулевое значение данного поля означает, что данный тайм-аут не используется. Значение MAXDWORD, вместе с нулевыми значениями полей ReadTotalTimeoutConstant и ReadTotalTimeoutMultiplier, означает немедленный возврат из операции чтения с передачей уже принятого символа, даже если ни одного символа не было получено из линии. ReadTotalTimeoutMultiplierЗадает множитель, в миллисекундах, используемый для вычисления общего тайм-аута операции чтения. Для каждой операции чтения данное значение умножается на количество запрошеных для чтения символов ReadTotalTimeoutConstantЗадает константу, в миллисекундах, используемую для вычисления общего тайм-аута операции чтения. Для каждой операции чтения данное значение прибавляется к результату умножения ReadTotalTimeoutMultiplier на количество запрошеных для чтения символов. Нулевое значение полей ReadTotalTimeoutMultiplier и ReadTotalTimeoutConstant означает, что общий тайм-аут для операции чтения не используется. WriteTotalTimeoutMultiplierЗадает множитель, в миллисекундах, используемый для вычисления общего тайм-аута операции записи. Для каждой операции записи данное значение умножается на количество записываемых символов. WriteTotalTimeoutConstantЗадает константу, в миллисекундах, используемую для вычисления общего тайм-аута операции записи. Для каждой операции записи данное значение прибавляется к результату умножения WriteTotalTimeoutMultiplier на количество записываемых символов. Нулевое значение полей WriteTotalTimeoutMultiplier и WriteTotalTimeoutConstant означает, что общий тайм-аут для операции записи не используется. По тайм-аутам обычно возникает много вопросов. Поэтому попробую объяснить подробнее. Пусть мы считываем 50 символов из порта со скоростью 9600. При этом используется 8 бит на символ, дополнение до четности и один стоповый бит. Таким образом на один символ в физической линии приходится 11 бит (включая стартовый бит). 50 символов на скорости 9600 будут приниматься 50 * 11 / 9600 = 0.0572916 секунд, или примерно 57.3 миллисекунды, при условии нулевого интервала между приемом последовательных символов. Если интервал между символами составляет примерно половину времени передачи одного символа, т.е. 0.5 миллисекунд, то время приема будет 50 * 11 / 9600 + 49 * 0.0005 = 0.0817916 секунд, или примерно 82 миллисекунды. Если в процессе чтения прошло более 82 миллисекунд, то мы вправе предположить, что произошла ошибка в работе внешнего устройства и прекратить считывание избежав тем самым зависания программы. Это и есть общий тайм-аут операции чтения. Аналогично существует и общий там-аут операции записи.


Если тайм- аут при чтении понятен, то тайм-аут при записи вызывает недоумение. В самом деле, что нам мешает передавать? Управление потоком! Внешнее устройство может использовать, например, аппаратное управление потоком. При этом пропадание питания во внешнем устройстве заставит компьютер приостановить передачу данных. Если не контролировать тайм-аут возможно точно такое же зависание компьютера, как и при операции чтения.

Общий тайм-аут зависит от количества участвующих в операции чтения/записи символов и среднего времени передачи одного символа с учетом межсимвольного интервала. Если символов много, например 1000, то на общем времени выполнения операции начинают сказываться колебания времени затрачиваемого на один символ или времени межсимвольного интервала. Поэтому тайм-ауты в структуре COMMTIMEOUTS задаются двумя величинами. Таким образом формула для вычисления общего тайм-аута операции, например чтения, выглядит так NumOfChar * ReadTotalTimeoutMultiplier + ReadTotalTimeoutConstant, где NumOfChar это число символов запрошеных для операции чтения.

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

Теперь небольшой пример.
ReadTotalTimeoutMultiplier = 2, ReadTotalTimeoutConstant = 1, ReadIntervalTimeout = 1,
считывается 250 символов. Если операция чтения завершится за 250 * 2 + 1 = 501 миллисекунду, то будет считано все сообщение. Если операция чтения не завершится за 501 миллисекунду, то она все равно будет завершена. При этом будут возвращены символы, прием которых завершился до истечения тайм-аута операции. Остальные символы могут быть получены следеющей операцией чтения. Если между началами двух последовательных символов пройдет более 1 миллисекунды, то операция чтения так же будет завершена.

Надеюсь, что теперь тайм-ауты не будут вызывать у Вас затруднений. Для завершения темы тайм-аутов рассмотрим один частный случай. Если поля ReadIntervalTimeout и ReadTotalTimeoutMultiplier установлены в MAXDWORD, а ReadTotalTimeoutConstant больше нуля и меньше MAXDWORD, то выполнение операции чтения подчиняется следующим правилам: Если в буфере есть символы, то чтение немедленно завершается и возвращается символ из буфера; Если в буфере нет символов, то операция чтения будет ожидать появления любого символа, после чего она немедленно завершится; Если в течении времени, заданого полем ReadTotalTimeoutConstant, не будет принято ни одного символа, оперция чтения завершится по тайм- ауту. Теперь вам ясно назначение структуры _COMMTIMEOUTS ,как и для заполнения структуры DCB, для COMMTIMEOUTS существуют функции считывания и установки значений. Это функции GetCommTimeouts и SetCommTimeouts:



GetCommTimeouts
функция находится в файле kernel32.dll

Функция GetCommTimeouts считывает структуру _COMMTIMEOUTS с указанного порта и заполняет параметры значениями по умолчанию.

Описание в эквиваленте C

BOOL GetCommTimeouts( HANDLE hFile, LPCOMMTIMEOUTS lpCommTimeouts );

Параметры :

HFileДескриптор указывающий на порт (этот дескриптор может быть создан с помощью CreateFile, OpenFile) LpCommTimeoutsСтруктура LPCOMMTIMEOUTS

Возвращаемое значение :

Если функция выполняется успешно, возвращаемое значение - TRUE иначе возвращаемое значение - FALSE . При возникновении ошибки код ошибки можно получить используя GetLastError

Ну и соответственно -

SetCommTimeouts
функция находится в файле kernel32.dll

Функция SetCommTimeouts устанавливает тайм-ауты порта

Описание в эквиваленте C

BOOL SetCommTimeouts( HANDLE hFile, LPCOMMTIMEOUTS lpCommTimeouts );

Параметры :

HFileДескриптор указывающий на порт (этот дескриптор может быть создан с помощью CreateFile, OpenFile) LpCommTimeoutsСтруктура LPCOMMTIMEOUTS

Возвращаемое значение :

Если функция выполняется успешно, возвращаемое значение - TRUE иначе возвращаемое значение - FALSE . При возникновении ошибки код ошибки можно получить используя GetLastError

Параметры этих функций очевидны. Хочется отметить что установку тайм-аутов можно производить как до установки параметров порта, так и после, т.е последовательность вызова функций SetCommState и SetCommTimeouts не имеет значения. Главное, что бы все настройки были завершены до начала ввода/вывода информации.

В продолжении статьи хочется добавить еще оду функцию использование которой несомненно очень нужно для получения данных о портах. Представьте ситуацию, когда под COM1 может скрываться вовсе не привычный порт RS-232, а что нибудь другое. Или порт может не позволять задавать скорость более 9600 бод.

Исчерпывающая информация о возможностях коммуникационного устройства и драйвера содержится в структуре COMMPROP:
COMMPROP
typedef struct _COMMPROP { WORD wPacketLength; // Задает размер, в байтах, // структуры COMMPROP WORD wPacketVersion; // Номер версии DWORD dwServiceMask; // Битовая маска DWORD dwReserved1; // reserved DWORD dwMaxTxQueue; // max буфер передачи DWORD dwMaxRxQueue; // max буфер приема DWORD dwMaxBaud; // max допустимая скорость обмена DWORD dwProvSubType; // Тип коммуникац.порта DWORD dwProvCapabilities; // Возможности перед.устройства DWORD dwSettableParams; // Допустимые для изменения // параметры DWORD dwSettableBaud; // Допустимый набор скоростей // обмена WORD wSettableData; // допустимые длины символов WORD wSettableStopParity; // Допуст.кол-во стоповых бит DWORD dwCurrentTxQueue; // Текущий размер буфер передачи DWORD dwCurrentRxQueue; // Текущий размер буфер приема DWORD dwProvSpec1; // Устройство-зависимые данные DWORD dwProvSpec2; // Устройство-зависимые данные WCHAR wcProvChar[1]; // Устройство-зависимые данные } COMMPROP; Поля этой структуры описывают все возможности драйвера. Вы не можете выйти за пределы этих возможностей. Вот какое значение имеют поля:



Параметры :

wPacketLengthЗадает размер, в байтах, структуры COMMPROP wPacketVersionНомер версии структуры. dwServiceMask Битовая маска. Для коммуникационных устройств всегда SP_SERIALCOMM, включая модемы. dwReserved1Зарезервировано Microsoft dwMaxTxQueueМаксимальный размер, в байтах, внутреннего буфера передачи драйвера. Нулевое значение свидетельствует об отсутствии ограничения. dwMaxRxQueueМаксимальный размер, в байтах, внутреннего буфера приема драйвера. Нулевое значение свидетельствует об отсутствии ограничения. dwMaxBaudМаксимально допустимая скорость обмена, в битах в секунду (бпс). Возможны следующие значения данного поля: BAUD_075 75 бпс. BAUD_110 110 бпс. BAUD_134_5 134.5 бпс. BAUD_150 150 бпс. BAUD_300 300 бпс. BAUD_600 600 бпс. BAUD_1200 1200 бпс. BAUD_1800 1800 бпс. BAUD_2400 2400 бпс. BAUD_4800 4800 бпс. BAUD_7200 7200 бпс. BAUD_9600 9600 бпс. BAUD_14400 14400 бпс. BAUD_19200 19200 бпс. BAUD_38400 38400 бпс. BAUD_56K 56K бпс. BAUD_57600 57600 бпс. BAUD_115200 115200 бпс. BAUD_128K 128K бпс. BAUD_USER Допускается программирование скорости обмена dwProvSubTypeТип коммуникационного порта. Возможны следующие значения данного поля: PST_FAX Факс PST_LAT LAT протокол PST_MODEM Модем PST_NETWORK_BRIDGE Сетевой мост PST_PARALLELPORT Параллельный порт PST_RS232 Последовательный порт RS-232 PST_RS422 Порт RS-422 PST_RS423 Порт RS-423 PST_RS449 Порт RS-449 PST_SCANNER Сканнер PST_TCPIP_TELNET Протокол TCP/IP TelnetR PST_UNSPECIFIED Неизвестное устройство PST_X25 Устройство стандарта X.25 dwProvCapabilitiesБитовая маска. Определяет возможности предоставляемые устройством. Возможны следующие значения: PCF_16BITMODE Поддерживается специальный 16-битный режим. PCF_DTRDSR Поддерживаются сигналы DTR/DSR. PCF_INTTIMEOUTS Поддерживается межсимвольный тайм-аут. PCF_PARITY_CHECK Поддерживается контроль четности. PCF_RLSD Поддерживается определение наличия сигнала в приемной линии. PCF_RTSCTS Поддерживаются сигналы RTS/CTS. PCF_SETXCHAR Поддерживаются задаваемые символы XON/XOFF. PCF_SPECIALCHARS Поддерживаются спецсимволы. PCF_TOTALTIMEOUTS Поддерживаются общие тайм-ауты (ожидаемое время). PCF_XONXOFF Поддерживается программное (XON/XOFF) управление потоком. PCF_XONXOFF Поддерживается программное (XON/XOFF) управление потоком dwSettableParamsБитовая маска. Определяет допустимые для изменения параметры. Возможны следующие значения: SP_BAUD Скорость обмена. SP_DATABITS Бит в символе. SP_HANDSHAKING Рукопожатие (управление потоком). SP_PARITY Четность. SP_PARITY_CHECK Контроль четности. SP_RLSD Детектирование наличия сигнала в приемной линии. SP_STOPBITS Количество стоповых бит. dwSettableBaudБитовая маска. Определяет допустимый набор скоростей обмена. Допустимые для данного поля значения указаны в описании поля dwMaxBaud. wSettableDataБитовая маска. Определяет допустимые длины символов, в битах. Возможны следующие значения: DATABITS_5 5 бит DATABITS_6 6 бит DATABITS_7 7 бит DATABITS_8 8 бит DATABITS_16 16 бит DATABITS_16Х Специальный широкий канал через аппаратную последовательную линию wSettableStopParity Битовая маска. Определяет допустимое количество стоповых бит и режимы четности. Возможны следующие значения: STOPBITS_10 Один стоповый бит STOPBITS_15 Полтора стоповыx бита STOPBITS_20 Два стоповых бита PARITY_NONE Без четности PARITY_ODD Доплнение до нечетности PARITY_EVEN Дополнение до четности PARITY_MARK Бит четности всегда "1" PARITY_SPACE Бит четности всегда "0" DwCurrentTxQueueОпределяет текущий размер, в байтах, внутренней очереди передачи драйвера. Нулевое значение свидетельствует о недоступности данного параметра. DwCurrentRxQueue Определяет текущий размер, в байтах, внутренней очереди приема драйвера. Нулевое значение свидетельствует о недоступности данного параметра. dwProvSpec1Устройство-зависимые данные. Программа должна игнорировать содержимое данного поля, за исключением случаев, когда Вы точно знаете формат этих данных. Занесите в данное поле значение COMMPROP_INITIALIZED, если поле wPacketLength уже содержит правильное значение. DwProvSpec2Устройство-зависимые данные. Программа должна игнорировать содержимое данного поля, за исключением случаев, когда Вы точно знаете формат этих данных. wcProvCharУстройство-зависимые данные. Программа должна игнорировать содержимое данного поля, за исключением случаев, когда Вы точно знаете формат этих данных. Информация хранящаяся в структуре COMMPROP требуется редко, так как чаще всего точно известно с каким типом портов будет работать программа.



Остановлюсь чуть подробнее на описании некоторых полей. Поле wPacketLength играет несколько иную роль, чем поле DCBlength структуры DCB, хотя из его описания это не следует. Секрет прост. Поле wcProvChar, расположеное в конце структуры, может содержать, а может и не содержать, данных. Вы не в состоянии это узнать не запросив информацию. В свою очередь, перед запросом информации Вы должны выделить (и обнулить) память под структуру COMMPROP. Поэтому последовательность шагов для получения всей информации следующая: Выделить память под структуру COMMPROP. Запросить информацию у системы вызвав функцию GetCommProperties. Если поле wPacketLength содержит значение большее sizeof(COMMPROP), то имеется дополнительная информация. Для ее получения измените размер ранее выделенного блока памяти, новый размер должен быть равен значению занесенному системой в поле wPacketLength. Установите в поле wProvSpec1 значение COMMPROP_INITIALIZED, это будет означать, что выделен достаточный блок памяти для получения дополнительной информации. Повторно вызовите функцию GetCommProperties. Чаще всего дополнительная информация представлена в виде структуры MODEMDEVCAPS, которая размещается на месте поля wcProvChar, если поле dwProvSubType содержит значение PST_MODEM.

, часть I
, часть II
, часть III


25 апреля 2001 г.
Специально для


Часть V


, часть I
, часть II
, часть III
, часть IV
Вернуться к разделу

«Все новое ,это хорошо забытое старое»

Данная 5 часть полностью взята из статьи «Работа с коммуникационными портами (COM и LPT) в программах для Win32 в среде C++» Титова Олега.
Это было сделано для полноты цикла по теме, просто не будем заново изобретать велосипед и продолжим разговор о работе с портам, основываясь на статье Титова Олега.

Получить информацию об устройстве в виде структуры COMMPROP можно функцией GetCommProperies.

Вот ее описание в эквиваленте С BOOL GetCommProperties( HANDLE hFile, LPCOMMPROP lpCommProp );

Следует отметить, что запросить информацию можно только об уже открытом устройстве, т.е устройстве открытом функциями CreateFile OpenFile.
Так-же для структуры lpCommProp должна быть предварительно выделена память.

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

Стандартый диалог выводится функцией CommConfigDialog, которая работает со структурой COMMCONFIG. Как и в случае со структурой DCB, заполнять структуру COMMCONFIG можно вручную или вызовом соответсвующих функций. Начнем с самой структуры COMMCONFIG:

typedef struct _COMM_CONFIG { DWORD dwSize; WORD wVersion; WORD wReserved; DCB dcb; DWORD dwProviderSubType; DWORD dwProviderOffset; DWORD dwProviderSize; WCHAR wcProviderData[1]; } COMMCONFIG, *LPCOMMCONFIG; Основной частью этой структуры является уже знакомый нам DCB. Остальные поля содержат вспомогательную информацию, которая, для наших целей, не представляет особого интереса (однако эта информация может быть полезной для получения дополнительных данных о порте). Познакомимся поближе с полями:


dwSize Задает размер структуры COMMCONFIG в байтах wVersion Задает номер версии структуры COMMCONFIG. Должен быть равным 1. wReserved Зарезервировано и не используется dcb Блок управления устройством (DCB) для порта RS-232. dwProviderSubType Задает тип устройства и формат устройство-зависимого блока информации. Фактически это тип порта. Конкретные значения данного поля приведены в описании структуры COMMPROP выше. dwProviderOffset Смещение, в байтах, до устройство-зависимого блока информации от начала структуры. dwProviderSize Размер, в байтах, устройство-зависимого блока информации. wcProviderData Устройство-зависимый блок информации. Это поле может быть любого размера или вообще отсутствовать. Поскольку структура COMMCONFIG может быть в дальшейшем расширена, для определения положения данного поля следует использовать dwProviderOffset. Если dwProviderSubType PST_RS232 или PST_PARALLELPORT, то данное поле отсутствует. Если dwProviderSubType PST_MODEM, то данное поле содержит структуру MODEMSETTINGS.

Не смотря на то, что нам нужен только DCB, приходится иметь дело со всеми полями. Заполнение данной структуры противоречивыми данными может привести к неправильной настройке порта, поэтому следует пользоваться функцией GetCommConfig: BOOL GetCommConfig( HANDLE hCommDev, LPCOMMCONFIG lpCC, LPDWORD lpdwSize ); Параметры функции следующие: hCommDev Описатель открытого коммуникационного порта. lpCC Адрес выделеного и заполненого нулями, кроме поля dwSize, блока памяти под структуру COMMCONFIG. В поле dwSize нужно занести размер структуры COMMCONFIG. После вызова функции все поля структуры будут содержать информацию о текущих параметрах порта. lpdwSize Адрес двойного слова, которое после воврата из функции будет содержать число фактически переданных в структуру байт. В случае успешного завершения функция возвращает ненулевое значение.

Как всегда не обошлось без тонкостей. Структура COMMPROP имеет перемнную длину, поэтому затруднительно сразу выделить требуемый блок памяти. Как и в случае с функцией GetCommProperties, функцию GetCommConfig придется вызывать дважды:



Теперь, имея заполненую корректной информацией структуру COMMCONFIG, можно позволить пользователю выполнить настройку параметров с помощью функции CommConfigDialog: BOOL CommConfigDialog( LPTSTR lpszName, HWND hWnd, LPCOMMCONFIG lpCC ); Вызов этой функции приводит к отображению диалогового окна. Вид окна может отличаться от приведенного. Это зависит от операционной системы и динамической библиотеки, предоставленной производителем порта.

Познакомимся с параметрами функции CommConfigDialog: lpszName Указатель на строку с именем порта для которого отображается диалоговое окно. К реальному имени порта эта строка не имеет никакого отношения, она просто выводится в заголовке окна. hWnd Описатель окна, которое владеет данным диалоговым окном. Должен быть передан корректный описатель окна-владельца или NULL, если у диалогового окна нет владельца. lpCC Указатель на структуру COMMCONFIG. Эта структура содержит начальные установки используемые для отображения в диалоговом окне, и установленные пользователем изменения, при завершении диалога. Как и большинство других функций Win32 API, функция CommConfigDialog возвращает отличное от нуля значение, в случае успешного завершения, и нуль, если возникла ошибочная ситуация.

Функция CommConfigDialog не выполняет настройки порта. Она все лишь позволяет пользователю изменить некоторые поля в блоке DCB, содержащемся в структуре COMMCONFIG. Разумеется, Вы можете изменить установленые пользователем некорректные значения или выполнить дополнительные настройки после вызова функции GetCommConfig. Фактическая настройка порта выполняется функцией SetCommConfig:

BOOL SetCommConfig( HANDLE hCommDev, LPCOMMCONFIG lpCC, DWORD dwSize );

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

Обратите внимание на кнопку "Restore Defaults". Вы в состоянии управлять ее поведением, правда опосредовано, с помощью функций GetDefaultCommConfig и SetDegaultCommConfig. Вот их прототипы: BOOL GetDefaultCommConfig( LPCSTR lpszName, LPCOMMCONFIG lpCC, LPDWORD lpdwSize ); BOOL SetDefaultCommConfig( LPCSTR lpszName, LPCOMMCONFIG lpCC, DWORD dwSize ); Эти функции очень похожи на GetCommConfig и SetCommConfig, но предназначены совсем для другой цели. Предположим, что Ваше устройство, по умолчанию, работает на скорости 175 бит в секунду и обменивается пятибитными символами. Системные же умолчания - 9600 бит в секунду и 8 бит в символе. Что бы пользователь, при нажатии на кнопку "Restore Defaults", получал не системные, а Ваши умолчания, воспользуйтесь функциями GetDefaultCommConfig и SetDefaultCommConfig. SetDefaultCommConfig не настраивает порт, это выполняется функцией SetCommConfig, а изменяет параметры во внутренней области коммуникационного драйвера.



Теперь познакомимся с функцией SetupComm, которая, на самом деле, совсем не то, что следует из названия. BOOL SetupComm( HANDLE hFile, DWORD dwInQueue, DWORD dwOutQueue ); Эту функцию скорее следовало назвать SetCommQueueSize, поскольку все, что она делает, это устанавливает размеры (в байтах) очередей приема и передачи. Причем размеры рекомендуемые. В общем случае, система сама в состоянии определить требуемый размер очередей, однако Вы можете вмешаться в этот процесс. Внутренние очереди драйвера позволяют избежать потери данных, если Ваша программа не успевает их считывать, и пауз в работе программы, если она передает данные слишком быстро. Размер очереди выбирается немного большим максимальной длины сообщения. Например, для протокола YMODEM, пакет данных которого имеет длину 1024 байт, разумным размером очереди будет 1200 байт.

Указаный Вами размер очереди будет принят драйвером к сведению. Но он оставляет за собой право внести коррективы или вообще отвергнуть устанавливаемое значение. В последнем случае функция завершится с ошибкой.

Внешние устройства управления объектами, чаще всего подключаемые к портам, обычно обмениваются с компьютером короткими сообщениями. Соответственно и вызов функции SetupComm не требуется. Однако, если Ваше устройство передает или принимает блоки данных длиной в несколько тысяч байт, рекомендуется установить размеры очередей драйвера.

Давайте сделаем паузу в изучении функций настройки и получения состояния коммуникационных портов. Пора от слов переходить к делу, а именно к приему и передаче данных. Начнем с синхронного чтения/записи, это проще.

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

BOOL ReadFile( HANDLE hFile, LPVOID lpBuffer, DWORD nNumOfBytesToRead, LPDWORD lpNumOfBytesRead, LPOVERLAPPED lpOverlapped ); BOOL WriteFile( HANDLE hFile, LPVOID lpBuffer, DWORD nNumOfBytesToWrite, LPDWORD lpNumOfBytesWritten, LPOVERLAPPED lpOverlapped );



Вы наверняка работали с этими функциями и знаете значение их параметров. Но я все таки кратко остановлюсь на их описании:

hFile Описатель открытого файла коммуникационного порта lpBuffer Адрес буфера. Для операции записи данные из этого буфера будут передаваться в порт. Для операции чтения в этот буфер будут помещаться принятые из линии данные. nNumOfBytesToRead, nNumOfBytesToWrite Число ожидаемых к приему или предназначеных к передаче байт. nNumOfBytesRead, nNumOfBytesWritten Число фактически принятых или переданых байт. Если принято или передано меньше данных, чем запрошено, то для дискового файла это свидетельствует об ошибке, а для коммуникационного порта совсем не обязательно. Причина в тайм-аутах. lpOverlapped Адрес структуры OVERLAPPED, используемой для асинхронных операций. Подробнее как с структурой, так и с асинхронными операциями мы познакомимся позже. Для синхронных операций данный параметр должен быть равным NULL.

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

Коммуникационный порт не совсем обычный файл. Например, для него нельзя выполнить операцию позиционирования файлового указателя. С другой стороны, порт позволяет управлять потоком, что нельзя делать с обычным файлом. Настало время познакомиться с функциями управления приемом/передачей данных через коммуникационные порты. Поскольку первой операцией, после открытия порта, является его сброс, то и начнем с функции выполняющей требуемые действия. BOOL PurgeComm( HANDLE hFile, DWORD dwFlags );



Вызов этой функции позволяет решить две задачи: очистить очереди приема/передачи в драйвере и завершить все находящиеся в ожидании запросы ввода/вывода. Какие именно действия выполнять задается вторым параметром (значения можно комбинировать с помощью побитовой операции OR: PURGE_TXABORT Немедленно прекращает все операции записи, даже если они не завершены PURGE_RXABORT Немедленно прекращает все операции чтения, даже если они не завершены PURGE_TXCLEAR Очищает очередь передачи в драйвере PURGE_RXCLEAR Очищает очередь приема в драйвере Вызов этой функции нужен для отбрасывания мусора, который может находиться в приемном буфере на момент запуска программы, или как результат ошибки в работе устройства. Очистка буфера передачи и завершение операций ввода/вывода так же потребуются при ошибке, как процедура восстановления, и при завершении программы, для красивого выхода.

Следует помнить, что очистка буфера передачи, как и экстреное завершение операции записи, не выполняют передачу данных находящихся в этом буфере. Данные просто отбрасываются. Если же передача остатка данных необходима, то перед вызовом PurgeComm следует вызвать функцию: BOOL FlushFileBuffers( HANDLE hFile );

Если на COM2 установить перемычку между сигналами TxD и RxD, то переменная buf_in, после выполнения ReadFile, будет содержать ту же информацию, что и buf_out. Других пояснений пример не требует, все уже было подробно рассмотрено раньше.

Иногда требуется срочно передать символ, имеющий определенное специальное значение, а в очереди передатчика уже есть данные, которые нельзя терять. В этом случае можно воспользоваться функцией: BOOL TransmitCommChar( HANDLE hFile, char cChar );

Данная функция передает один (и только один) внеочередной байт в линию, не смотря на наличие данных в очереди передатчика, и перед этими данными. Однако управление потоком действует. Функцию можно вызвать только синхронно. Более того, если байт экстренных данных, от предыдущего вызова этой функции, еще не передан в линию (например из-за функций управления потоком), то попытка экстренной передачи еще одного байта завершится ошибкой. Если Вы используете программное управление потоком, то символы приостановки и возобновления передачи (обычно CTRL-S и CTRL-Q), лучше всего передавать именно этой функцией.



Последовательный канал передачи данных можно перевести в специальное состояние, называемое разрывом связи. При этом передача данных прекращается, а выходная линия переводится в состояние "0". Приемник, обнаружив, что за время необходимое для передачи стартового бита, битов данных, бита четности и стоповых битов, приемная линия ни разу не перешла в состояние "1", так же фиксирует у себя состояние разрыва. BOOL SetCommBreak( HANDLE hFile ); BOOL ClearCommBreak( HANDLE hFile );

Следует заметить, что состояние разрыва линии устанавливается аппаратно. Поэтому нет другого способа возобновить прерваную, с помощью SetCommBreak, передачу данных, кроме вызова ClearCommBreak.

Более тонкое управление потоком данным позволяет осуществить функция: BOOL EscapeCommFunction( HANDLE hFile, DWORD dwFunc ); Выполняемое действие определяется вторым параметром, который может принимать одно из следующих значений: CLRDTR Сбрасывает сигнал DTR CLRRTS Сбрасывает сигнал RTS SETDTR Устанавливет сигнал DTR SETRTS Устанавливает сигнал RTS SETXOFF Симулирует прием символа XOFF SETXON Симулирует прием символа XON SETBREAK Переводит выходную линию передатчика в состояние разрыва. SetCommBreak является упрощенной формой данного вызова. CLRBREAK Снимает состояние разрыва для выходной линии передатчика. ClearCommBreak является упрощенной формой данного вызова. Приостановить прием/передачу данных может и возникновение любой ошибки при установленом в TRUE поле fAbortOnError в структуре DCB использованой для настройки режимов работы коммуникационного порта. В этом случае, для восстановления нормальной работы порта, следует использовать функцию: BOOL ClearCommError( HANDLE hFile, LPDWORD lpErrors, LPCOMSTAT lpStat );

Эта функция не только сбрасывает признак ошибки для соответсвующего порта, но и возвращает более подробную информацию об ошибке. Кроме того, возможно получение информации о текущем состоянии порта. Вот что означают параметры: hFile Описатель открытого файла коммуникационного порта. lpErrors Адрес переменной, в которую заносится информация об ошибке. В этой переменной могут быть установлены один или несколько из следующих бит: CE_BREAK Обнаружено состояние разрыва связи CE_DNS Только для Windows95. Параллельное устройство не выбрано. CE_FRAME Ошибка обрамления. CE_IOE Ошибка ввода-вывода при работе с портом CE_MODE Запрошеный режим не поддерживается, или неверный описатель hFile. Если данный бит установлен, то значение остальных бит не имеет значение. CE_OOP Только для Windows95. Для параллельного порта установлен сигнал "нет бумаги". CE_OVERRUN Ошибка перебега (переполнение аппаратного буфера), следующий символ потерян. CE_PTO Только для Windows95. Тайм-аут на параллельном порту. CE_RXOVER Переполнение приемного буфера или принят символ после символа конца файла (EOF) CE_RXPARITY Ошибка четности CE_TXFULL Переполнение буфера передачи lpStat Адрес структуры COMMSTAT. Должен быть указан, или адрес выделенного блока памяти, или NULL, если не требуется получать информацию о состоянии.



Если с информацией об ошибке все ясно, то со структурой COMMSTAT мы еще не встречались. Вот она: typedef struct _COMSTAT DWORD fCtsHold:1; DWORD fDsrHold:1; DWORD fRlsdHold:1; DWORD fXoffHold:1; DWORD fXoffSent:1; DWORD fEof:1; DWORD fTxim:1; DWORD fReserved:25; DWORD cbInQue; DWORD cbOutQue; } COMSTAT, *LPCOMSTAT;

Поля структуры имеют следующее значение:

fCtsHold Передача приостановлена из-за сброса сигнала CSR. fDsrHoldПередача приостановлена из-за сброса сигнала DSR. fRlsdHold Передача приостановлена из-за ожидания сигнала RLSD (receive-line-signal-detect). Более известное название данного сигнала - DCD (обнаружение несущей). fXoffHold Передача приостановлена из-за приема символа XOFF. fXoffSent Передача приостановлена из-за передачи символа XOFF. Следующий передаваемый символ обязательно должен быть XON, поэтому передача собственно данных тоже приостанавливается fEof Принят символ конца файла (EOF). fTxim В очередь, с помощью TransmitCommChar, поставлен символ для экстреной передачи. fReserved Зарезервировано и не используется cbInQue Число символов в приемном буфере. Эти символы приняты из линии но еще не считаны функцией ReadFile. cbOutQue Число символов в передающем буфере. Эти символы ожидают передачи в линию. Для синхронных операций всегда 0.

Теперь Вы знаете почти все о работе с последовательными и параллельными портами в синхронном режиме. Особенности непосредственной работы с модемами я не буду рассматривать, так как существует большой набор высокоуровневых функций и протоколов, таких как TAPI, специально предназначеных для работы с модемами. Если Вас все же интересует эта тема, то почитайте описания функции GetCommModemStatus, и структур MODEMDEVCAPS и MODEMSETTINGS. В остальном работа с модемом ничем не отличается от работы с обычным портом.

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



Начнем с событий связаных с последовательными портами. Вы указываете системе осуществлять слежение за возникновением связанных с портом событий устанавливая маску с помощью функции BOOL SetCommMask( HANDLE hFile, DWORD dwEvtMask ); Маска отслеживаемых событий задается вторым параметром. Можно указывать любую комбинацию следующих значений: EV_BREAK Состояние разрыва приемной линии EV_CTS Изменение состояния линии CTS EV_DSR Изменение состояния линии DSR EV_ERR Ошибка обрамления, перебега или четности EV_RING Входящий звонок на модем (сигнал на линии RI порта) EV_RLSD Изменение состояния линии RLSD (DCD) EV_RXCHAR Символ принят и помещен в приемный буфер EV_RXFLAG Принят символ заданый полем EvtChar структуры DCB использованой для настройки режимов работы порта EV_TXEMPTY Из буфера передачи передан последний символ Если dwEvtMask равно нулю, то отслеживание событий запрещается. Разумеется всегда можно получить текущую маску отслеживаемых событий с помощью функции BOOL GetCommMask( HANDLE hFile, LPDWORD lpEvtMask );

Вторым параметром задается адрес переменной принимающей значение текущей установленой маски отслеживаемых событий. В дополнение к событиям, перечисленым в описании функции SetCommMask, данная функция может возвратить следующие: EV_EVENT1 Устройство-зависимое событие EV_EVENT2 Устройство-зависимое событие EV_PERR Ошибка принтера EV_RX80FULL Приемный буфер заполнен на 80 процентов Эти дополнительные события используются внутри драйвера. Вы не должны переустанавливать состояние их отслеживания.

Когда маска отслеживаемых событий задана, Вы можете приостановить выполнение своей программы до наступления события. При этом программа не будет занимать процессор. Это выполняется вызовом функции BOOL WaitCommEvent( HANDLE hFile, LPDWORD lpEvtMask, LPOVERLAPPED lpOverlapped, );

Замечу, что в переменной, адресуемой вторым параметром, не будут устанавливаться внутренние события драйвера (перечислены в описании функции GetCommMask). В единичное состояние установятся только те биты, которые соответствуют реально произошедшим событиям.



Адрес структуры OVERLAPPED требуется для асинхронного ожидания (возможно и такое). Однако пока будем полагать, что порт открыт для синхронных операций, следовательно этот параметр должен быть NULL. Замечу только, что при асинхронном ожидании данная функция может завершиться с ошибкой, если в процессе этого ожидания будет вызвана функция SetCommMask для переустановки маски событий. Кроме того, связанное со структурой OVERLAPPED событие (объект создаваемый функцией CreateEvent, а не событие порта) должно быть с ручным сбросом. Вообще, поведение функции с ненулевым указателем на структуру OVERLAPPED аналогично поведению функций чтения и записи.

Освобождать процессор на время ожидания хорошо, но хотелось бы параллельно с вводом/выводом делать какую-либо полезную работу. Что бы это стало возможным, необходимо в качестве параметра dwFlagsAndAttributes вместо 0 указать FILE_FLAG_OVERLAPPED. Кроме того, для функций ReadFile, WriteFile и WaitCommEvent необходимо в качестве параметра lpOverlapped указывать адрес правильно инициализированной структуры OVERLAPPED. Вот как выглядит эта структура: typedef struct _OVERLAPPED { DWORD Internal; DWORD InternalHigh; DWORD Offset; DWORD OffsetHigh; HANDLE hEvent; } OVERLAPPED, *LPOVERLAPPED

Подробно описывать поля этой структуры не буду, поскольку данная статья не о файловом вводе/выводе вообще, а о работе с портами. Для наших целей, за исключением WaitCommEvent, можно просто обнулить все поля этой структуры. Для WaitCommEvent поле hEvent должно содержать корректный описатель объекта "событие". Что бы все стало понятно, надо разобраться с таким обязательным атрибутом параллельной работы как синхронизация.

ВНИМАНИЕ!!! Дескриптор файла, в данном случае дескриптор файла порта, является синхронизирующим объектом ядра (согласно официальной документации Microsoft). Это означает, что его можно использовать в функциях ожидания событий наравне с дескрипторами событий. Таким образом в поле hEvent в структуре OVERLAPPED можно занести NULL и ожидать освобождения дескриптора файла, а не дескриптора события. Это действительно работает в Windows NT. Однако в Windows95/98 все совсем иначе. Обсуждение ошибок, неточностей и прочих проблем документации оставим в стороне. Просто замечу, что в Windows95/98 поле hEvent должно содержать корректный дескриптор объекта event В ЛЮБОМ СЛУЧАЕ!!! Иначе функции асинхронного ввода/вывода будут работать более чем странным образом. Кроме того, мы должны ожидать освобождения именно дескриптора этого события, а не дескриптора файла.



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

Для синхронизации используются различные методы: семафоры, блокировки, события, критические секции и т.п. События являются простейшими синхронизирующими объектами. Они могут находиться только в двух состояниях: установленом (событие произошло или наступило) и сброшеном (собитие не произошло или не наступило). События создаются функцией CreateEvent и разрушаются функцией CloseHandle. Установить событие можно функцией SetEvent, а сбросить ResetEvent.

Фнкции записи/чтения для файла открытого для асинхронного ввода/вывода будут немедленно возвращать управление с кодом ошибки ERROR_IO_PENDING. Это означает, что асинхронная операция успешно стартовала. Если возвращается другой код ошибки, то операция не стартовала (например из-за ошибки в параметрах). Теперь Вы можете спокойно заниматься другой работой периодически проверяя, завершилась ли операция ввода/вывода. Эта проверка выполняется функцией BOOL GetOverlappedResult( HANDLE hFile, LPOVERLAPPED lpOverlapped, LPDWORD lpcbTransfer, BOOL fWait );

Параметр hFile определяет дескриптор опрашиваемого файла, lpOverlapped задает адрес структуры OVERLPPED. Третий параметр задает адрес переменной, куда будет помещено количество считанных или записанных байт. Соответсвующий параметр функций ReadFile и WriteFile, хоть и ДОЛЖЕН БЫТЬ ЗАДАН НЕ НУЛЕВЫМ, не позволяет получить количество переданных байт, так как на момент возврата управления из функций чтения/записи не передано ни одного байта. Параметр fWait означает, должна ли функция GetOverlappedResult ждать завершения операции ввода/вывода. Если этот параметр равет FALSE, то функция немедленно вернет управление. При этом код возврата будет TRUE, если операция завершена, или FALSE, если операция не завершена. В послед случае код ошибки возвращаемой функцией GetLastError будет ERROR_IO_INCOMPLETE. Если функция GetOverlappedResult завершилась с кодом возврата FALSE, и другим кодом ошибки, то ошибка произошла именно при вызове самой функции. Если параметр fWait равен TRUE, то функция будет дожидаться завершения операции ввода-вывода.



Замечу, что ожидать завершения ввода/вывода с помощью функции GetOverlappedResult не самое правильное решение. При работе с дисковым файлом операция завершится гарантированно, а при работе с последовательным или параллельным портом совсем не обязательно. Представьте, что Вы не настроили тайм-ауты последовательного порта, а подключенное устройство неисправно. GetOverlappedResult будет ждать вечно, так как нет способа указать максимальное время ожидания. Ждать завершения ввода/вывода лучше с помощью функций: DWORD WaitForSingleObject( HANDLE hObject, DWORD dwTimeot ); DWORD WaitForMultipleObjects( DWORD cObjects, LPHANDLE lpHandles, BOOL bWaitAll, DWORD dwTimeout );

Как следует из названия, эти функции предназначены для ожидания одного или нескольких объектов. Однако следует вспомнить примечание, которое я привел к описанию структуры OVERLAPPED! Поэтому не мудрствуя лукаво будем ожидать только объекты event.

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

Функция WaitForMultipleObjects ждет несколько событий. Первый параметр указывает сколько именно, а второй задает массив дескрипторов этих событий. Замечу, что один и тот же дескриптор нельзя указывать в этом массиве более одного раза. Третий параметр задает тип ожидания. Если он равен TRUE, то ожидается наступление всех событий. Если FALSE, то наступления любого одного из указанных. И естественно тоже можно задать максимальное время ожидания последним параметром.

Если событие наступило, то функции возвращают значения от WAIT_OBJECT_0 до WAIT_OBJECT_0+cObject-1. Естественно, что WaitForSingleObject может вернуть только WAIT_OBJECT_0 (если конечно не произошло ошибки). Если произошла ошибка, то будет возвращено WAIT_FAILED. При превышении максимального времени ожидания функции вернут WAIT_TIMEOUT.



Вернусь к объектам event, которые мы собственно и используем для ожидания. Поясню, почему для наших целей требуются события с ручным сбросом. Функции ReadFile и WriteFile в асинхронном режиме первым делом сбрасывают (переводят в занятое состояние) как дескриптор файла, так и дескриптор объекта event задананный в структуре OVERLAPPED. Когда операция чтения или записи завершается система устанавливает эти дескрипторы в свободное состояние. Тут все логично. Однако и функции WaitForSingleObject и WaitForMultipleObjects для событий с автоматическим сбросом так же выполняют их перевод в занятое состояние при вызове. Для событий с ручным сбросом этого не происходит. Теперь представьте, что операция ввода/вывода завершилась ДО вызова WaitForSingleObject. Представили? Для событий с автоматическим сбросом снова будет выполнен перевод объекта в занятое состояние. Но освобождать то его будет некому! Более подробная информация об объектах event выходит за рамки этой статьи.

Теперь небольшой пример на С. Все подробности, не относящиеся к работе в асинхронном режиме я опускаю. #include <windows.h> #include <string.h> . . . HANDLE port; char* buf; OVERLAPPED ovr; DWORD bc; . . . port=CreateFile("COM2",GENERIC_READ,0,NULL,OPEN_EXISTING, FILE_FLAG_OVERLAPPED,NULL); memset(&ovr,0,sizeof(ovr)); ovr.hEvent=CreateEvent(NULL,FALSE,FALSE,NULL); ReadFile(port,buf,buf_size,&bc,&ovr); /* Выполняем некую полезную работу */ if(WaitForSingleObject(ovr.hEvent,10000)==WAIT_OBJECT_0) { GetOverlappedResult(port,&ovr,&bc,FALSE); } else { /* Обработка ошибки */ } CloseHandle(port); CloseHandle(ovr.hEvent);

В этом примере переменная bc, предназначенная для получения количества считанных байт, после вызова ReadFile будет равна 0, так как никакой передачи информации еще не было. После вызова GetOverlappedResult в эту переменную будет помещено число реально считанных байт.

Безусловно, можно придумать очень сложные схемы распараллеливания ввода/вывода и вычислений, базирующиеся на использовании асинхронных операций и объектов event. Позволю себе не приводить реально работающих примеров программ. Таких программ работающих в реальном масштабе времени много, но они очень сложны и громоздки для этой статьи.



Вернемся ненадолго с структуре OVERLAPPED и функциям ReadFile и WriteFile. Для дискового ввода/ вывода возможно задать одновременно несколько конкурирующих операций чтения/записи. Однако для каждой такой операции необходимо использовать свою структуру OVERLAPPED. Для работы с портами нельзя задавать конкурирующие операции. Точнее можно, но только в Windows NT. Поэтому для целей совместимости лучше этого не делать.

Теперь, уже совсем кратко, еще об одной возможности, реализованной только в Windows NT. Речь идет о "тревожном вводе-выводе". Эта возможность реализуется функциями ReadFileEx, WriteFileEx и SleepEx. Суть использования данных функий такова. Вы вызываете расширенную функцию записи или чтения, которая имеет еще один параметр - адрес функции завершения. После чего, вызвав расширенную функцию засыпания, освобождаете процессор. После завершения ввода/вывода Ваша функция завершения будет вызвана системой. Причем вызвана ТОЛЬКО в том случае, если ваша программа вызвала SleepEx. Нетрудно заметить, что данный вариант работы подходит для систем с большим количеством портов и работающих в режиме ответа по требованию. Например, сервер с мультипортовым контроллером последовательного порта, к которому подключены модемы.

Теперь, но ОЧЕНЬ кратко, залезем в еще большие дебри. Предположим, что протокол обмена с Вашим устройством, подключенным к последовательному порту, очень сложен (передаются большие и сложные структуры данных). При этом Ваша программа должна получать уже полностью принятую и проверенную информацию. Предположим так же, что Ваша программа занимается очень большими и сложными вычислениями и ей нет времени отвлекаться на обработку ввода/вывода. Да и сложность ее такова, что встраивание фонового ввода/вывода сделает ее трудно прослеживаемой и неустойчивой. Чувствуете, куда я клоню? Правильно, к выделению всех тонкостей ввода/вывода в отдельный поток. Возможно выделение и в отдельную задачу, но в этом случае мы не получим никакой выгоды, а накладные расходы на переключение задач гораздо больше, нежели на переключение потоков в одной задаче.



Потоки создаются функцией CreateThread, и уничтожаются функциями ExitThread и TerminateThread. Принцип работы таков. Вы создаете поток. При этом управление получает Ваша функция потока. Она работает параллельно, как минимум, основному потоку Вашей программы. Функция открывает порт и выполняет все необходимые настройки. Затем она выполняет весь ввод/вывод, при чем совершенно не важно, используется синхронный или асинхронный режим. При засыпании потока (при синхронном режиме) остальные потоки Вашей программы продолжат выплняться. Когда завершится необходимый обмен информацией с устройством и данные будут готовы для передачи основной программе Ваш поток установит некий флаг, котрый будет воспринят основной программой как готовность данных. После их обработки и формирования блока выходной информации основной поток установит другой флаг, который будет воспринят потоком ввода-вывода как готовность данных для передачи. При этом в качестве флагов можно использовать как объекты event, так и обычные переменные (ведь все потоки задачи выполняются в едином адресном прогстранстве). В случае использования обычных глобальных переменных не забудте в их определения добавить модификатор volatile. Он обозначает, что переменная может измениться асинхронно и компилятор не должен строить иллюзий насчет возможности ее оптимизации. В противном случае у Вас ничего не получится. Так как в потоке ввода/вывода, выполняющемся параллельно основному потоку программы, можно использовать асинхронный ввод/вывод, то достаточно просто реализуется возможность обработки большого количества портов. Фактически поток ввода/вывода будет работь еще и параллельно самому себе. При запуске такой задачи на многопроцессорной машине выгода от использования многопоточности будет очевидна, поскольку потоки будут выполняться на разных процессорах.

В заключении я хочу добавить следующее: в следующих циклах я хочу более подробно рассказать о внутреннем устройстве портов.

Еще раз повторяюсь что данная часть полностью взята из «Работа с коммуникационными портами (COM и LPT) в программах для Win32 в среде C++» Титова Олега, дабы исключить обвинения в плагиате.


Что делает настройщик


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

На MS SQL-сервере создана база данных DbExample, В BDE создан псевдоним alDbExample для этой базы данных, В базе данных DbExample нет ни одной системной таблицы и ни одной пользовательской таблицы. В памяти созданы все необходимые списки. Пока мы знакомы со списком таблиц FTablesList и списком имен таблиц FTableNames компоненты TDbInterface, а также с обобщенным списком FFbSUObjectL элементов СУ компоненты TArmInterface. На самом деле создается значительно большее число списков. Однако нам важно пояснить принцип работы платформы, поэтому обойдемся необходимым минимумом. Более менее полный список рабочих списков, используемых в платформе, можно найти в прилагаемом учебном приложении. Так как пользовательская база данных пуста, то список таблиц и список их имен пока не содержат ни одного элемента.

Начнем с простейшей задачи, когда нужно создать базу данных клиентов некой фирмы и обеспечить пользовательский интерфейс для ввода, просмотра, редактирования данных и получения несложных отчетов, например, списков клиентов, отобранных по каким-либо признакам.

На Рисунок 1 показано, как выглядит один из ключевых моментов запуска штатной системы.


Рисунок 1

В этих условиях существует лишь одна возможность продвинуться вперед – продолжить загрузку в режиме конфигуратора, установив флаг Конфигуратор. Как видите, у системы нет даже имени. Сразу после входа в конфигуратор настройщик устанавливает ряд параметров, в том числе название системы.

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


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

К этому добавлю, что для желающих а готов рассказать о штатной платформе. Итак, в памяти создается структура TTableInfo, содержащая атрибуты, вводимые через специальный диалог. Затем создается набор структур для полей таблицы. Для выполнения этой работы нужно разработать по крайней мере два диалога, - один для заполнения структуры TTableInfo, а другой для заполнения структуры TFieldInfo и ее добавления в структуру TTableInfo. Упрощенные реализации этих диалогов имеют вид, приведенный в листингах L1 и L2.

Листинг L1.
, приведенного в листинге L1.

Рассмотрим некоторые детали этого диалога, относящиеся к общей идеологии платформы, о которых пока не было ничего сказано. Это касается свойства ppTInfoCategory, обеспечивающего доступ к полю FpTInfoCategory : pTInfoCategory, содержащему ссылку на структуру

// Структура категории информации TInfoCategory = record sInfoID : TFbMedID; sTFbDbType : TFbDbType; sEnumName, sInfoName : TFbMedName; sInfoDescr : TFbMedDesc; sCount : Integer; sPrefix : String[5]; sMainPrefix : String[3]; sSubPrefix : String[2]; sStatusID : Byte; end;
Эта структура введена в связи с тем, что вся пользовательская информация в рассматриваемой платформе разбита на ряд категорий, чтобы легче было оперировать множеством таблиц. В частности, в медицинской тематике используются такие категории информации как Справочники, Клиенты, Персонал и др. Информация о том, что конкретная таблица относится к той или иной категории, содержится в специальном префиксе имени таблицы (поле sPrefix структуры TInfoCategory). Кроме того используется префикс для всех таблиц платформы, который позволяет отличить таблицы на сервере, с которыми оперирует платформа, от других типов таблиц, в частности, системных таблиц. Рассмотрим конкретный пример таблицы с именем Fb_c_pclients. Префикс ‘Fb_’ указывает на то, что данная таблица относится к пользовательской базе данных платформы. Далее идет префикс ‘c_’, который указывает на то, что данная таблица относится к категории Клиенты. Как видим, префиксы отделяются друг от друга и от имени таблицы знаками подчеркивания. В приведенной структуре для нашего примера могут быть, например, такие значения:

sInfoID = ‘001111’, sTFbDbType = icClient, sEnumName = ‘icClient’, sInfoName = ‘InfoName_001111’, sInfoDescr = ‘Клиенты’, sPrefix = ‘Fb_c’, sMainPrefix = ‘Fb_’, sSubPrefix = ‘c_’.
Поля sCount и sStatusID имеют специальное назначение, выходящее за пределы обсуждения, и пока практически в платформе не используются. Для работы с категориями введены следующие конструкции:

специальный перечислимый тип



// Тип категорий информации TFbDbType = ( icOther, // Прочие icSpr, // Справочники icClient, // Клиенты icStaff, // Персонал icStatist, // Статистика icJournal, // Журналы icAll, // Все категории icNoCateg); // Без категории,
вспомогательные типы для хранения описаний категорий информации

// Тип паспорта категории информации TFbDbTypeItem = Array [1..2] of String; // Тип массива паспортов категорий информации TFbDbTypeArray = Array [TFbDbType] of TfbDbTypeItem,
и константа-массив префиксов для выбранных категорий информации

apDbTypeArray : TFbDbTypeArray = ( { Категория информации и префиксы имен таблиц } { , } ('Прочие', 'Fb_o_'), ('Справочники', 'Fb_s_'), ('Клиенты', 'Fb_c_'), ('Персонал', 'Fb_m_'), ('Статистика', 'Fb_r_'), ('Журналы', 'Fb_j_'), ('Виртуальная БД', 'Fb_v_'), ('Все категории', 'Fb___'), ('Без категории', 'Fb_' ) )
Забегая вперед, отметим, что практика работы с платформой показала, что такая схема ведения категорий информации недостаточно гибкая, т.к. не позволяет изменить набор категорий информации у пользователя, а также создавать иерархические категории информации. В последних версиях платформы уже проводится опытная отработка механизмов, позволяющих все это делать.

Вернемся к нашему диалогу формирования структуры таблицы. Суть его работы сводится к формированию специальной буферной структуры таблицы FN_pTTableInfo для текущего экземпляра интерфейса к базам данных (по клику на кнопке ОК) в методе FDbInterface.Init_NpTTableInfo и переходу в диалог работы со списком полей TbDefFr. Если при выходе из диалога TbDefFr пользователь откажется от создания таблицы, то буферная структура будет удалена из памяти. Если же процесс создания таблицы будет завершен успешно, то судьба буферной структуры поля окончательно будет решена после выхода из диалога TbDefFr. Сама буферная структура FN_pTTableInfo является принадлежностью интерфейса к базам данных FDbInterface.

Ниже приводится программный код для диалога создания структуры поля.

Листинг L2.
, приведенного в листинге L2.

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


Что такое свободно связанные события? Понятие «Издатель-Подписчик»


До появления COM+, модель COM поддерживала систему событий, реализованную через интерфейс IConnectionPointContainer. Это жестко связанные события. (В данной статье, мы не будем рассматривать реализацию этого подхода). В COM+ появилось новое понятие: СВОБОДНО СВЯЗАННЫЕ СОБЫТИЯ (Loosely coupled events - LCE), разработанные для удовлетворения потребностей распределенных вычислений.

В COM+ Инициатор события (Издатель) и потребитель (Подписчик) свободно связаны.

Информация от различных издателей хранится в каталоге COM+, а подписчики указывают, какую информацию они хотят получать, регистрируясь в каталоге.



Что же, все-таки, можно сделать


Есть три базовых идеи, три "кита", на основе которых можно построить надежный таймерный сервер: Функция Sleep, которая позволяет отсчитать заданное количество миллисекунд, не загружая при этом процессор. Отдельный поток, в котором будет крутиться цикл для отслеживания времени срабатывания. Набор средств уведомления клиентов (в других потоках приложения) о тиках таймеров - объекты ядра для синхронизации потоков, оконные сообщения и др.

Функция Sleep имеет дискретность отработки заданного интервала (по результатам эксперимента) 10 мс в Windows NT и примерно 3-4 мс в Windows 98. Во многих случаях достаточно просто вызвать эту функцию там, где нужна задержка, если потоку больше нечем заняться в течение этого интервала времени.

Цикл в отдельном потоке с вызовом Sleep с постоянным интервалом и опросом списка таймерных объектов (у каждого свой интервал, заданный клиентом) с определением момента срабатывания, позволяет обрабатывать столько виртуальных таймеров, сколько потребуется программе. Высокий приоритет, заданный потоку, даст возможность таймерам "тикать" даже тогда, когда другие потоки заняты работой.

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



COM:Агрегация и нотификация вообще и для Дельфи в частности.


Раздел Подземелье Магов Виталий Маматов ,
дата публикации 07 августа 2000г.

Вступление.

К написанию данной статьи меня подтолкнула моя недавняя пробежка по вопросам относительно COM. Значительное их число сводилось к непониманию принципов организации агрегирования и нотификации. И, дабы лишний раз не утруждать себя напрасно, было решено, дать такой развёрнутый ответ с примером и сразу для всех.

Про литературу.

Самой полезной книжкой по технологии COM для меня стала неброская книжонка А.Кобирниченко "Visual Studio 6. Искусство программирования". Для примера два одинаковых понятия из тоже хорошей книжки Елмановой и Трепалина "Delphi 4 технология COM" но несколько путаной:
Apartment:
Елманова: "Можно вызывать методы объекта только из того потока, где объект был создан. При этом одновременно можно создать несколько отличающихся объектов в разных потоках, но каждый объект обязан вызываться только из того потока, где был создан". Кобирниченко: "Каждый объект выполняется в своём потоке. Потоков может быть несколько, но всю синхронизацию берёт на себя сама библиотека. Объект, выполняющийся в одном потоке, ничего не знает о других потоках, поэтому может не заботится о многопоточном доступе к своим методам." Теоретические экскурсы в данной статье, в основном, основаны на книге Кобирниченко.

Часть первая: Теория.

Агрегация.

При агрегировании внешний объект не реализует сам интерфейсы имеющиеся у внутреннего. Вместо этого он передаёт своему клиенту указатель указатель непосредственно на интерфейс внутреннего. Клиент напрямую общается с внутренним объектом. Взамен появляются требования к внутреннему объекту связанные с реализацией IUnknown внутреннего объекта. Все вызовы IUnknown внутреннего объекта должны делегироваться методам IUnknown внешнего объекта.

Нотификация.

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

Исходящие интерфейсы являются расширением принципа уведомления, реализованного в составных документах всё уведомление в которых построено на IAdviseSink с ограниченным набором событий. Установление соединения на основе этого интерфейса требует всего одного вызова IOleObject::SetAdise.


При использовании точек соединения нужно четыре вызова: QueryInterface для получения IConnectionPointContainer, затем FindConnectionPoint для получения нужной точки соединения, затем Advise для передачи указателя на IUnknown исходящего интерфейса и, наконец, QueryInterface со стороны клиента для получения самого исходящего интерфейса. Вся эта деятельность, особенно в случае DCOM, может занять значительное время. Собственно по этому сама Microsoft рекомендует организовывать уведомление на основе собственных интерфейсов, похожих на IadviseSink, а не на основе точек соединения.

После такого введения, я думаю, вы уже готовы взять в руки инструмент Исследователя - IDE Delphi. В нашем случае ;).

Часть вторая: Махровая практика.
Агрегирование:

После тщательных поисков по Дельфийскому хелпу в данной предметной области, мною было обнаружено следующее:
"TAggregatedObject is used as part of an aggregate that has a single controlling Iunknown"
И приписка:
"Note: For more information about aggregation, controlling objects, and interfaces, see the Inside OLE, second edition, by Kraig Brockschmidt"
Ну, второе нам сейчас ни к чему, а вот с первым следует ознакомиться поближе.
Итак, вот он:
TAggregatedObject = class private FController: Pointer; function GetController: IUnknown; protected { IUnknown } function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; public constructor Create(Controller: IUnknown); property Controller: IUnknown read GetController; end; constructor TAggregatedObject.Create(Controller: IUnknown); begin FController := Pointer(Controller); end; function TAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HResult; begin Result := IUnknown(FController).QueryInterface(IID, Obj); end;
и т.д. В общем ясен перец.

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



В ATL эта проблема решается применением шаблонов классов. В результате чего получается, что все методы реализованные в шаблоне _как_бы_ виртуальные. Это здорово придумано, берёшь любой метод, перекрываешь его и никаких гвоздей. Только надо учитывать, что после сборки, на этане выполнения, никакие фокусы с полиморфными вызовами у вас не пройдут.

Однако, вернёмся к нашим баранам. Просматривая, в некотором унынии, предков нашего обожаемого TAutoObject была обнаружена следующая забавная конструкция:

TComObject = class(TObject, IUnknown, ISupportErrorInfo) .. protected { IUnknown } function IUnknown.QueryInterface = ObjQueryInterface; .. function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; .. public function ObjQueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; .. end;
Это явно не спроста, что же получается, уважаемая Borland, виртуализируем QueryInterface, сами забавляемся полученным результатом, а простым бедным программерам ни слова? Некрасиво!

Ну, думаю, с этим моментом также всё ясно, перекрываем ObjQueryInterface и дело в шляпе. Пошли дальше.

Нотификация:

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

Идея: см. IAdviseSink, и мой пример по его мотивам.

Ну вот, теперь настало время которого вы так долго ждали, рассмотрим пример.

Пример.

Пример представляет из себя два проекта в одной группе. Внутренний сервер и клиент к нему. Для тех кто начал только отсюда напоминаю: Сервер надлежит регистрировать.
Обычно для таких примеров выбирают что-нибудь абсолютно бесполезное. Я же, бесполезные вещи перестал писать одновременно с окончанием института, совпало так. Посему надлежит сделать что-нибудь полезное, но простое. Полезное, потому как смотри выше, а простое, потому как денег мне за это не платят. Пускай это будет таймер, а что, вещь в хозяйстве необходимая, редко какое приложение обходится без таймера. Полагаю, будет вполне естественно назвать его XTimer. Сказано, сделано. Отныне, я надеюсь, вы навсегда забудете где у вас находиться таймер на палитре компонентов и будете пользоваться только моим Aggregated XTimer.
Далее, наш, во всех отношения полезный XTimer надо использовать как-то полезно. Для чего полезно можно использовать таймер? Правильно, для анимации.
Что так же было реализовано. Картинка для анимации взята из SDK DirectX7.
И последнее: в данном примере вы ни найдете ни одного комментария, так как комментировать там особо и нечего. Само документируемый код в чистом виде ;-). Также надеюсь у вас не возникнет впечатления, что использовано слишком много компонент.
Засим всё.

Скачать проект : ( 112.8 K)


Два простых способа уведомления.


Раздел Подземелье Магов Алексей Еремеев ,
дата публикации 14 декабря 2000

В своей работе мне частенько приходиться делать разного рода клиент-серверные системы.
И совсем не обязательно на уровне глобальных сетей. Речь пойдет о внутренних подсистемах.
Например, имеем компонент, который эмулирует секундомер. Запустили его с параметром типа "а напомни мне, что будет полночь" и забыли. Ну и конечно событие есть типа OnAlert. И обработчик его честно будет вызван по достижении нужной нам полуночи. Но обработчик один, а захотели узнать об этом событии сразу десять разных объектов. Не вешать же десять будильников?
Конечно, проще в одном обработчике перебрать методы уведомления этих десяти объектов да и дело с концом. Но можно поступить хитрее - заставить объект-будильник самому напоминать всем кто попросит его об этом. Вот о способах такого уведомления и пойдет речь.

Как условие - объект "сервер" ничего не знает об объекте "клиенте". После некоторого размышления и перебрав несколько вариантов я пришел к выводу, что наиболее приемлимые для практики есть два способа. Первый подсмотрен в WinAPI а второй - чисто Дельфи. Оба способа основаны на простой идее регистрации клиента на сервере и оповещении сервером клиентов по внутреннему списку зарегистрированных клиентов.

Способ 1. Оповещение через механизм сообщений Windows.

в модуле объекта-сервера в интерфейсной части определяется пользовательский номер события: const WM_NOTIFY_MSG = WM_USER + 123; в объекте-сервере реализуются две интерфейсные процедуры (вкупе с объявленным в приватной секции и созданным в конструкторе TList, в деструкторе не забудем его разрушить, естественно) procedure RegisterHandle(HW: THandle); var i: integer; begin i := FWindList.IndexOf(pointer(HW)); if i < 0 then FWinList.Add(pointer(HW)); end; procedure UnregisterHandle(HW: THandle) var i: integer; begin i := FWindList.IndexOf(pointer(HW)); if i >= 0 then FWinList.Delete(i); end; и создается функция оповещения в приватной секции: procedure SendNotify(wParam, lParam: integer); var i: integer; begin i := 0; while i < FWinList.Count do begin SendMessage(integer(FWinList.Items[i]), WM_NOTIFY_MSG, wParam, lParam); Inc(i); end; end; можно вместо SendMessage использовать PostMessage, будет асинхронное сообщение, иногда это выгодней, например для исключения возможности бесконечной рекурсии.


Объект- клиент должен иметь хэндл окна, который регистрируется на объекте-сервере и обработчик событий этого окна, который будет вызыватся при оповещении сервером списка клиентов (окон).
У объекта-клиента можно поступить двояко. Если объект-клиент уже имеет хэндл окна (например, форма) то пишется обработчик фиксированного номера события: procedure ServMsg(var Msg: TMessage); message WM_NOTIFY_MSG; или если окна нет, то создается универсальный метод-обработчик и невидимое окно при помощи функции AllocateHWND() (пример смотрите в исходниках VCL - объект TTimer)

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

Способ 2. Оповещение через объект-посредник.

В отдельном модуле создаем объект-посредник, который имеет один метод типа SendEvent и одну ссылку на обработчик события OnEvent. Я назвал такой объект TSynaps (да простят меня нейрохирурги) unit Synaps; interface uses Windows, Messages, SysUtils, Classes; type TSynaps = class(TObject) private FOnEvent : TNotifyEvent; public procedure SendEvent; property OnEvent : TNotifyEvent read FOnEvent write FOnEvent; end; implementation procedure SendEvent; begin if Assigned(FOnEvent) then try FOnEvent(Self); except end; end; end; Причем методов и событий может быть много разных на любой вкус. С очередями, асинхронными "прослойками", задержками и другими наворотами. Тут уж кто на что горазд. Я лишь демонстрирую идею. Модуль с объектом-сервером и модуль с объектом-клиентом имеют право знать о модуле Synaps. В объекте-сервере реализуются уже знакомые нам три функции (чуть иначе):
в интерфейсе объекта: procedure RegisterSynaps(Syn: TSynaps); var i: integer; begin i := FSynapsList.IndexOf(pointer(Syn)); if i < 0 then FSynapsList.Add(pointer(Syn)); end; procedure UnregisterSynaps(Syn: TSynaps); var i: integer; begin i := FSynapsList.IndexOf(pointer(Syn)); if i >= 0 then FSynapsList.Delete(i); end; и приватная функция: procedure NotifySynapses; var i: integer; begin i := 0; while i < FSynapsList.Count do begin TSynaps(FSynapsList.Items[i]).SendEvent; Inc(i); end; end; Объект-клиент создает в себе объект-синапс, назначает его событию OnEvent свой внутренний обработчик и регистрирует этот синапс на объекте-сервере. Вуаля! И получает оттуда уведомления. Кстати, в деструктор синапса можно встроить вызов события OnDestroy, и тогда объект-сервер, при регистрации клиента, может назначить ему обработчик и автоматически разрегистрировать его при уничтожении. Но это уже навороты.



Такой подход позволяет строить обратные вызовы любой сложности. К тому-же это чистый паскаль-код без привязки к операционке. (а вдруг Kylix :о)

Итог.

Как вы могли заметить, оба способа базируются на двух базовых идеях. Первое - это регистрация клиента на сервере, и второе - вызов сервером некой функции внутри клиента. Разница только в механизмах. И выбирать тут можно исходя из вкусов, предпочтений и неких требований, связанных с ресурсоемкостью, переносимостью и т. п.
На самом деле есть очень широко распространенный и давно известный метод под названием CallBack-функция.
Мы вызываем кого-то и передаем как один из параметров адрес другой функции. И этот метод частенько используется в WinAPI (смотрите, к примеру, справку по функции EnumFonts). Но! Механизм прямого CallBack-а довольно некрасиво ложится на объектную модель Дельфи, так что я не стал описывать его здесь. Тем более, что оба способа - то-же самое, но красивше. И самое последнее - не забывайте разрегистрировать клиента в конце работы и освобождать ресурсы в деструкторе. И да известят вас ваши сервера только о хорошем!

Алексей Еремеев


монитор ошибок должна работать как


Искусство управления ошибками.
Раздел Подземелье Магов
Часть I :
Автор: Даутов Ильдар,
дата публикации 05 января 2000
Часть II

Продолжая тему "Управление ошибками в Delphi", поставим следующие задачи : программа- монитор ошибок должна работать как системный сервис Windows NT журнал ошибок должен сохраняться на диске и постоянно пополняться список текущих ошибок и полный журнал ошибок должны быть доступны для просмотра на любом компьютере локальной сети предприятия Реализуем следующую схему взаимодействия программ при возникновении ошибки : ошибка, возникшая в клиентской программе, передается по сети монитору-сервису Windows NT. Для передачи используем механизм каналов Mailslot монитор сохраняет текст ошибки на диске. Для хранения используем текстовый файл монитор пересылает по сети текст ошибки программе просмотра ошибок. Для передачи используем механизм каналов Mailslot программа просмотра принимает текст ошибки и отображает его на экране программа просмотра может запросить полный журнал ошибок. Для получения полного журнала используем механизм разделяемых сетевых файловых ресурсов В статье представлены 2 проекта : монитор ошибок и окно просмотра ошибок. Клиентская программа, имитирующая ошибку, была представлена в , и здесь не рассматривается.

Монитор ошибок

Оформить программу как сервис Windows NT (Win32 service) не составляет большого труда : создаем новое приложение File | New... | New | Service Application. Создается приложение с глобальной переменной Application типа TServiceApplication и объектом типа TService, который и реализует всю функциональность сервиса устанавливаем требуемые свойства объекта TService имя сервиса параметры запуска сервиса имя и пароль пользователя, от имени которого стартует сервис переписываем событие OnExecute объекта TService, в котором реализуем требуемую функциональность сервиса компилируем проект регистрируем созданный сервис на сервере Windows NT и запускаем Регистрация сервиса выполняется из командной строки следующим образом :
ErrorMonitorService.exe /install
Удаление сервиса :
ErrorMonitorService.exe /uninstall
Запуск сервиса выполняется из командной строки следующим образом :
net start ErrorMonitor
Останов сервиса :
net stop ErrorMonitor

Оформив эту последовательность команд как BAT-файл, можно значительно облегчить себе жизнь при отладке сервиса.

Достаточно подробную информацию о сервисах Windows NT можно найти в книге : А.В.Фролов, Г.В.Фролов 'Программирование для Windows NT (часть вторая)', Москва, ДИАЛОГ-МИФИ, 1997

Для сохранения протокола (журнала) пользовательских ошибок используем следующую схему : журнал ведется в текстовом файле в определенном каталоге Windows NT журнал имеет имя yyyy-mm-dd.log, соответствующее календарной дате запуска сервера при каждом запуске монитор проверяет наличие файла, имя которого соответствует текущей дате. При отсутствии - файл создается, иначе происходит дозапись в конец файла сохраняются только последние 7 файлов журнала Текст программы монитора ошибок приведен ниже : unit uErrorMonitorService; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, ScktComp; type TErrorMonitor = class(TService) procedure Service1Execute(Sender: TService); procedure ServiceEMCreate(Sender: TObject); private public function GetServiceController: PServiceController; override; procedure SendError; function InitLog : boolean; end; var ErrorMonitor: TErrorMonitor; implementation uses Dialogs; {$R *.DFM} const LogDir='C:\Log\'; // каталог, где сохраняются журналы var LogFile : TextFile; // файл текущего журнала LogName : string; // имя файла текущего журнала h : THandle; // handle канала Mailslot str : string[250]; // буфер для передачи информации MsgNumber,MsgNext,Read : DWORD; procedure ServiceController(CtrlCode: DWord); stdcall; begin ErrorMonitor.Controller(CtrlCode); end; function TErrorMonitor.GetServiceController: PServiceController; begin Result := @ServiceController; end; // Передача текста ошибки от сервиса программе просмотра procedure TErrorMonitor.SendError; var h : THandle; i : integer; begin // открытие MailSlot-канала, по которому будет передаваться протокол // используется широковещательная передача в домене h:=CreateFile(PChar('\\*\mailslot\EMonMess'),GENERIC_WRITE,FILE_SHARE_READ,nil, OPEN_EXISTING,0,0); if h <> INVALID_HANDLE_VALUE then begin // запись в канал и закрытие канала WriteFile(h,str,Length(str)+1,DWORD(i),nil); CloseHandle(h); end; end; // инициализация файла журнала // журналы ведутся в отдельных файлах по каждой дате function TErrorMonitor.InitLog : boolean; var sr : TSearchRec; i : integer; begin Result:=True; // удаление старых файлов журнала //(сохраняются только последние 7 журналов) with TStringList.Create do begin Sorted:=True; i:=FindFirst(LogDir+'*.log',faAnyFile,sr); while i = 0 do begin Add(sr.Name); i:=FindNext(sr); end; FindClose(sr); if Count > 7 then for i:=0 to Count-8 do DeleteFile(LogDir+Strings[i]); Free; end; // текущий файл журнала LogName:=LogDir+FormatDateTime('yyyy-mm-dd',Date)+'.log'; AssignFile(LogFile,LogName); try if FileExists(LogName) then Append(LogFile) else Rewrite(LogFile); except str:='Ошибка создания файла журнала : '+LogName; Status:=csStopped; LogMessage(str); ShowMessage(str); Result:=False; end; end; // основная логика сервиса procedure TErrorMonitor.Service1Execute(Sender: TService); begin // создание MailSlot-канала с именем EMon - по этому имени к нему // будут обращаться клиенты, у которых возникли ошибки h:=CreateMailSlot('\\.\mailslot\EMon',0,MAILSLOT_WAIT_FOREVER,nil); if h=INVALID_HANDLE_VALUE then begin Status:=csStopped; // запись в журнал событий NT str:='Ошибка создания канала EMon !'; LogMessage(str); ShowMessage(str); Exit; end; // создание файла журнала if not InitLog then Exit; try while not Terminated do begin // определение наличия сообщения в канале if not GetMailSlotInfo(h,nil,DWORD(MsgNext),@MsgNumber,nil) then begin Status:=csStopped; str:='Ошибка сбора информации канала EMon !'; LogMessage(str); ShowMessage(str); Break; end; if MsgNext <> MAILSLOT_NO_MESSAGE then begin beep; // чтение сообщения из канала и добавление в текст протокола if ReadFile(h,str,200,DWORD(Read),nil) then begin // запись в журнал Writeln(LogFile,str); // посылка сообщения для показа SendError; end else begin str:='Ошибка чтения сообщения !'; Writeln(LogFile,str); SendError; end; Flush(LogFile); end; sleep(500); ServiceThread.ProcessRequests(False); end; finally CloseHandle(h); CloseFile(LogFile); end; end; procedure TErrorMonitor.ServiceEMCreate(Sender: TObject); begin // под таким именем наш сервис будет виден в Service Control Manager DisplayName:='ErrorMonitor'; // необходимо при использовании ShowMessage InterActive:=True; end; end.



Окно просмотра ошибок


Текст программы окна просмотра ошибок приведен ниже : unit fErrorMonitorMessage; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ScktComp; type TfmErrorMonitorMessage = class(TForm) // протокол текущих ошибок meErrorTextNow: TMemo; meJournals: TMemo; // таймер для опроса канала Timer: TTimer; paJournals: TPanel; buJournals: TButton; lbJournals: TListBox; laJournals: TLabel; procedure FormCreate(Sender: TObject); procedure TimerTimer(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure buJournalsClick(Sender: TObject); private public end; // сетевой разделяемый ресурс, где сохраняются журналы // (укажите здесь имя своего ресурса и обеспечьте права для доступа) const LogDir='\\MyServer\C$\Log\'; var fmErrorMonitorMessage: TfmErrorMonitorMessage; h : THandle; // handle Mailslot-канала str : string[250]; // буфер обмена MsgNumber,MsgNext,Read : DWORD; implementation {$R *.DFM} procedure TfmErrorMonitorMessage.FormCreate(Sender: TObject); var sr : TSearchRec; i : integer; begin // создание Mailslot-канала с именем EMonMess // по этому каналу будем получать сообщения об ошибках от сервиса NT h:=CreateMailSlot('\\.\mailslot\EMonMess',0,MAILSLOT_WAIT_FOREVER,nil); if h=INVALID_HANDLE_VALUE then begin ShowMessage('Ошибка создания канала !'); Halt; end; // интервал опроса канала Mailslot - 3 секунды Timer.Interval:=3000; // таймер первоначально был выключен Timer.Enabled:=True; // заполнение списка доступных журналов i:=FindFirst(LogDir+'*.log',faAnyFile,sr); while i = 0 do begin lbJournals.Items.Add(sr.Name); i:=FindNext(sr); end; lbJournals.ItemIndex:=lbJournals.Items.Count-1; FindClose(sr); end; procedure TfmErrorMonitorMessage.TimerTimer(Sender: TObject); var str : string[250]; begin Timer.Enabled:=False; // определение наличия сообщения в канале if not GetMailSlotInfo(h,nil,DWORD(MsgNext),@MsgNumber,nil) then begin ShowMessage('Ошибка сбора информации !'); Close; end; if MsgNext <> MAILSLOT_NO_MESSAGE then begin beep; // чтение сообщения из канала и добавление в текст протокола if ReadFile(h,str,200,DWORD(Read),nil) then meErrorTextNow.Lines.Add(str) else ShowMessage('Ошибка чтения сообщения !'); end; Timer.Enabled:=True; end; procedure TfmErrorMonitorMessage.FormClose(Sender: TObject; var Action: TCloseAction); begin CloseHandle(h); end; procedure TfmErrorMonitorMessage.buJournalsClick(Sender: TObject); var Journal : TFileStream; s : string; begin // получение журнала ошибок за дату meJournals.Lines.Clear; meJournals.Lines.Add('Файл журнала '+lbJournals.Items[lbJournals.ItemIndex]); Journal:=TFileStream.Create(LogDir+lbJournals.Items[lbJournals.ItemIndex], fmOpenRead or fmShareDenyNone); SetLength(s,Journal.Size); Journal.Read(PChar(s)^,Journal.Size); meJournals.Lines.Add(s); Journal.Free; end; end.

Ильдар Даутов





Еще раз о звуке


Раздел Подземелье Магов й Козлов,
дата публикации 04 марта 2002г.

От ого стола):

…текущие характеристики САМОГО звука (частоту или громкость) …получение спектра с помощью FFT, …запись в формате MP3. …помогите проиграть mp3 и wma файлы с помощью Mutlimedia API WAVEOUT***** …определить устройство ввода звука, получить с него звук, отобразить форму волны, сравнить с образцом и выдать расхождение. Что-то вроде системы распознавания речи. …самый примитивный код, осуществляющий воспроизведение звука с помощью базовых функций (waveOutOpen,waveOutPrepareHeader и т.д.), …регулировать звук воспроизводимого файла из своей программы не могу …как програмно регулировать громкости не знаю. …функции waveOutWtire и waveInAddBuffer при работе с каким либо callback механизмом тратят очень много времени на переключение буферов. …в CallBack-функции при переключении буферов возникают щелчки в динамиках. Как от них избавиться? …Но как все-таки сначала узнать, установлена ли звуковая карта или нет ?

Итак, на что я попытаюсь ответить:

как узнать, есть ли устройство вывода/записи звука как использовать Multimedia API для вывода/записи звука как генерировать звук как менять громкость и вообще работать с микшером что можно сделать, если есть fullduplex

Чего я не скажу (надеюсь, скажет кто-то другой :)

Как работать с MP3 файлами. Как проводить цифровую обработку сигнала. Как работать со звуком в DirectX.

Еще "на берегу" хочу договориться -- HELP или MSDN не переписываю! В хелпах Delphi все функции описаны -- осталось только найти…

Начинаем.

Для нас важны следующие понятия: PCM, выборка, битовое разрешение, частота выборки. (см. более полно )

PCM (импульсно-кодовая модуляция) -- Звук может быть представлен разными способами, но это самый простой (и, наверное, поэтому наиболее используемый). Что это такое, можно посмотреть я повторяться не буду.

Sample (выборка) -- значение амплитуды дискретизированного сигнала. Секунда звучания на компакт-диске содержит 44100 выборок (сэмплов). Имеется в виду, что выборка содержит в себе реально два значения - для левого и правого каналов.

sample rate (частота выборки) -- Число выборок в секунду, которое используется для записи звука. Более высокие частоты соответствуют более высокому качеству звука, однако потребляют большее количество памяти.

sample size (битовое разрешение) -- определяет количество бит, используемое для записи единичной выборки на каждом канале. Компьютеры используют в основном 8 и 16 бит, профессиональное оборудование - 18, 20 и выше.

Несколько слов по поводу "железа". Необходимо четко различать, что звуковая плата -- это НЕ ОДНО устройство в системе. Есть устройство вывода звука, записи звука, микшер, синтезатор и т.д. по вкусу. Это важно понимать, т.к. каждое устройство имеет свой набор функций: waveOut***, waveIn***, midiOut***, midiIn***, mixer*** и др.

Еще раз повторю: все это РЕАЛЬНО РАЗНЫЕ устройства, упакованные в одном или нескольких аудиочипах. Кому интересно, посмотрите описание любого аудиочипа. Например, или

Как узнать, есть ли устройство вывода/записи звука

Для ответа на этот важнейший вопрос ( если устройства нет -- мы ведь ничего не услышим, правда?) используются следующие функции и структуры API:

waveOutGetNumDevs -- получить количество аудиоустройств waveOutGetDevCaps -- получить свойства аудиоустройства TWAVEOUTCAPS -- структура для WaveOutGetDevCaps


Если Вы знаете, что устройство в системе одно, можно поступить так:

procedure TForm1.btnClick(Sender: TObject); var WOutCaps : TWAVEOUTCAPS; begin // проверка наличия устройства вывода FillChar(WOutCaps,SizeOf(TWAVEOUTCAPS),#0); if MMSYSERR_NOERROR <> WaveOutGetDevCaps(0,@WOutCaps,SizeOf(TWAVEOUTCAPS)) then begin ShowMessage('Ошибка аудиоустройства'); exit; end; end;

Так мы пытаемся узнать характеристики устройства с номером 0 (т.е. первого в системе) и если его нет, говорим об ошибке. Если у нас несколько звуковых карточек, используем waveOutGetNumDevs. Характеристики нам понадобятся позже.

Важно: если хотим узнать, есть ли устройство записи, миксер в системе, используем WaveIn***, mixer*** и т.д. Ведь этих устройств может и не быть (USB-колонки). Так что вопрос: "Есть ли звуковая карточка в компьютере?" не совсем корректен для наших целей, да и не нужен. Вам звук выводить или карточкой хвалиться?

Как использовать Multimedia API для записи/вывода звука.

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

waveOutGetDevCaps -- получить свойства аудиоустройства waveOutOpen -- открыть аудиоустройство waveOutPrepareHeader -- приготовить буфер вывода для воспроизведения waveOutWrite -- вывести звук (поставить буфер на воспроизведение) waveOutReset -- остановить воспроизведение и освободить буферы waveOutUnprepareHeader -- вернуть буфер вывода WaveOutClose -- закрыть устройство вывода звука TWAVEOUTCAPS -- структура для WaveOutGetDevCaps TWAVEFORMATEX -- формат звуковых данных TWAVEHDR -- формат заголовка буфера вывода.

Как же мы выведем звук?

Во-первых, надо озаботиться способом общения с драйвером. Вариантов много: сообщения, callback-функции, объекты-события и т.д. По моему опыту, наиболее "приятно" работать с объектами-событиями, то есть использовать объекты ядра Events и потоки. Работает без особых проблем, лего управляется, нет ненужных задержек в очереди сообщений, можно поставить более высокий приоритет потоку, обрабатывающему звуковые данные. В общем, плюсов много, а главное … Microsoft рекомендует.

Так, с этим определились, теперь формат звуковых данных. Необходимо заполнить TWAVEFORMATEX, например, так:

var wfx : TWAVEFORMATEX; … // заполнение структуры формата FillChar(wfx,Sizeof(TWAVEFORMATEX),#0); with wfx do begin wFormatTag := WAVE_FORMAT_PCM; // используется PCM формат nChannels := 2; // это стереосигнал nSamplesPerSec := 44100; // частота дискретизации 44,1 Кгц wBitsPerSample := 16; // битовое разрешение выборки 16 бит nBlockAlign := wBitsPerSample div 8 * nChannels; // число байт в выборке для стереосигнала -- 4 байта nAvgBytesPerSec := nSamplesPerSec * nBlockAlign; // число байт в секундном интервале для стереосигнала cbSize := 0; // не используется end;



Готово, можно открывать:

var wfx : TWAVEFORMATEX; hEvent : THandle; wfx : TWAVEFORMATEX; hwo : HWAVEOUT; … // открытие устройства hEvent := CreateEvent(nil,false,false,nil); if WaveOutOpen(@hwo,0,@wfx,hEvent,0,CALLBACK_EVENT) <> MMSYSERR_NOERROR then …;

Устройство открыто, теперь (вторым шагом) решим, откуда будем брать данные для вывода. Для этого выделяем память и готовим буферы вывода. Заметьте, готовим ДВА буфера для того, чтобы организовать двойную буферизацию -- и никто никого не ждет…если буфер подходящего размера. В зависимости от производительности системы он может быть поменьше. ( у меня был минимум -- 8 кбайт)

Ниже в листинге есть одна особенность -- выделяется память из расчета на КАЖДЫЙ канал стереозвука -- это нужно для нашего примера, но обычно такое не требуется.

И еще одна особенность -- умные люди (см. ) рекомендуют выделять только целое количество страниц памяти с учетом грануляции, что мы и делаем.

var wfx : TWAVEFORMATEX; hEvent : THandle; wfx : TWAVEFORMATEX; hwo : HWAVEOUT; si : TSYSTEMINFO; wh : array [0..1] of TWAVEHDR; Buf : array [0..1] of PChar; CnlBuf : array [0..1] of PChar; … // выделение памяти под буферы, выравниваются под страницу памяти Windows GetSystemInfo(si); buf[0] := VirtualAlloc(nil,(BlockSize*4+si.dwPageSize-1) div si.dwPagesize * si.dwPageSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE); buf[1] := PChar(LongInt(buf[0]) + BlockSize); // отдельно буферы для генераторов под каждый канал CnlBuf[0] := PChar(LongInt(Buf[1]) + BlockSize); CnlBuf[1] := PChar(LongInt(CnlBuf[0]) + BlockSize div 2); // подготовка 2-х буферов вывода for I:=0 to 1 do begin FillChar(wh[I],sizeof(TWAVEHDR),#0); wh[I].lpData := buf[I]; // указатель на буфер wh[I].dwBufferLength := BlockSize; // длина буфера waveOutPrepareHeader(hwo, @wh[I], sizeof(TWAVEHDR)); // подготовка буферов драйвером end;

Итак, куда выводить -- есть, откуда выводить -- есть. Третим шагом осталось определить, что выводить и СДЕЛАТЬ ЭТО (вывести звук). Сначала мы генерим данные для левого и правого канала раздельно, затем смешиваем и помещаем в первый буфер вывода. Генерация производится очень просто -- sin. Смешиваем два буфера в один с помощью процедуры mix -- небольшая процедурка на ASMе Такой подход я избрал вот почему -- не все же синус по двум каналам генерить! Можно и музыку разную налево и направо пустить. (это называется бинуральное слушание, кажется). Заметьте, для генерации каждого нового буфера мы сохраняем текущее время сигнала, чтобы он был гладкий да шелковистый... И ПОМНИТЕ, что все это делается в отдельном потоке. Как видите, здесь есть пространство для творчества (оптимизации), но это оставляю читателям.

// генерация буферов каналов Generator(CnlBuf[0],Typ[0], Freq[0], Lev[0], BlockSize div 2, tPred[0]); Generator(CnlBuf[1],Typ[1], Freq[1], Lev[1], BlockSize div 2, tPred[1]); // смешивание буферов каналов в первый буфер вывода Mix(buf[0],CnlBuf[0],CnlBuf[1], BlockSize div 2);



И наконец, вот он, ЗВУК!

I:=0; while not Terminated do begin // передача очередного буфера драйверу для проигрывания waveOutWrite(hwo, @wh[I], sizeof(WAVEHDR)); WaitForSingleObject(hEvent, INFINITE); I:= I xor 1; // генерация буферов каналов Generator(CnlBuf[0],Typ[0], Freq[0], Lev[0], BlockSize div 2, tPred[0]); Generator(CnlBuf[1],Typ[1], Freq[1], Lev[1], BlockSize div 2, tPred[1]); // смешивание буферов каналов в очередной буфер вывода Mix(buf[I],CnlBuf[0],CnlBuf[1], BlockSize div 2); // ожидание конца проигрывания и освобождения предыдущего буфера end;

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

// завершение работы с аудиоустройством waveOutReset(hwo); waveOutUnprepareHeader(hwo, @wh[0], sizeof(WAVEHDR)); waveOutUnprepareHeader(hwo, @wh[1], sizeof(WAVEHDR)); // освобождение памяти VirtualFree(buf[0],0,MEM_RELEASE); WaveOutClose(hwo);

И освобождаем наш объект-событие.

CloseHandle(hEvent);

Все, наступила тишина…

Итак, мы разобрались с тремя вопросами:

как узнать, есть ли устройство вывода звука, как сгенерировать звук и как вывести звук.

Далее по плану: как менять громкость и вообще работать с микшером и что такое fullduplex.

Пример программы подготовлен для Delphi5. Скачать — 5.8K

Литература

Гордеев О. В. Программирование звука в Windows. СПб.: БХВ — Санкт-Петербург 1999 384 с.

Сергей Козлов
Специально для


Еще раз о звуке. II


й Козлов,
дата публикации 12 августа 2003г.


От воды утекло с тех пор, как вышла . Теперь, как и было обещано, статья про микшер. Сразу предупреждаю, что я не приведу ни одной строчки кода. Так что скучная статья получилась. Может, вы вообще зря ее читаете:)?... Нет? Ну тогда начнем.

Ранее мы разобрались с выводом звука. Сегодня мы рассмотрим другую тему: работа с микшером. Эта тема в материалах Королевства освещена в меньшей степени ;) поэтому остановимся на ней более подробно, местами цитируя MSDN.

Как говорил К.Маркс ( может кто помнит про такого) хороший архитектор отличается от пчелы тем, что при строительстве имеет план на бумаге ( или хотя бы в голове). Пчела же плана не имеет, у нее инстинкт. Я пока не слышал, есть ли инстинкт программирования, возможно, через несколько поколений программистов он и появится у отдельных личностей, но пока для работы нужен план. Поэтому сначала построим модель в голове, о!



Файловые операции средствами ShellAPI.


Раздел Подземелье Магов Автор: Владимир Татарчевский
дата публикации 15 октября 1999 г.

В данной статье мы подробно рассмотрим применение функции SHFileOperation. function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall; Данная функция позволяет производить копирование, перемещение, переименование и удаление (в том числе и в Recycle Bin) объектов файловой системы.
Функция возвращает 0, если операция выполнена успешно, и ненулевое значение в противном :-) случае.

Функция имеет единственный аргумент - структуру типа TSHFileOpStruct, в которой и передаются все необходимые данные.
Эта структура выглядит следующим образом: _SHFILEOPSTRUCTA = packed record Wnd: HWND; wFunc: UINT; pFrom: PAnsiChar; pTo: PAnsiChar; fFlags: FILEOP_FLAGS; fAnyOperationsAborted: BOOL; hNameMappings: Pointer; lpszProgressTitle: PAnsiChar; { используется только при установленном флаге FOF_SIMPLEPROGRESS } end; Поля этой структуры имеют следующее назначение:
hwnd Хэндл окна, на которое будут выводиться диалоговые окна о ходе операции.
wFunc Требуемая операция. Может принимать одно из значений:
FO_COPY Копирует файлы, указанные в pFrom в папку, указанную в pTo. FO_DELETE Удаляет файлы, указанные pFrom (pTo игнорируется). FO_MOVE Перемещает файлы, указанные в pFrom в папку, указанную в pTo. FO_RENAME Переименовывает файлы, указанные в pFrom. pFrom
Указатель на буфер, содержащий пути к одному или нескольким файлам. Если файлов несколько, между путями ставится нулевой байт. Список должен заканчиваться двумя нулевыми байтами.

pTo
Аналогично pFrom, но содержит путь к директории - адресату, в которую производится копирование или перемещение файлов. Также может содержать несколько путей. При этом нужно установить флаг FOF_MULTIDESTFILES.

fFlags
Управляющие флаги. FOF_ALLOWUNDO Если возможно, сохраняет информацию для возможности UnDo. FOF_CONFIRMMOUSE Не реализовано. FOF_FILESONLY Если в поле pFrom установлено *.*, то операция будет производиться только с файлами. FOF_MULTIDESTFILES Указывает, что для каждого исходного файла в поле pFrom указана своя директория - адресат. FOF_NOCONFIRMATION Отвечает "yes to all" на все запросы в ходе опеации. FOF_NOCONFIRMMKDIR Не подтверждает создание нового каталога, если операция требует, чтобы он был создан. FOF_RENAMEONCOLLISION В случае, если уже существует файл с данным именем, создается файл с именем "Copy #N of..." FOF_SILENT Не показывать диалог с индикатором прогресса. FOF_SIMPLEPROGRESS Показывать диалог с индикатором прогресса, но не показывать имен файлов. FOF_WANTMAPPINGHANDLE Вносит hNameMappings элемент. Дескриптор должен быть освобожден функцией SHFreeNameMappings. fAnyOperationsAborted
Принимает значение TRUE если пользователь прервал любую файловую операцию до ее завершения и FALSE в ином случае.

hNameMappings
Дескриптор объекта отображения имени файла, который содержит массив структур SHNAMEMAPPING. Каждая структура содержит старые и новые имена пути для каждого файла, который перемещался, скопирован, или переименован. Этот элемент используется только, если установлен флаг FOF_WANTMAPPINGHANDLE.

lpszProgressTitle
Указатель на строку, используемую как заголовок для диалогового окна прогресса. Этот элемент используется только, если установлен флаг FOF_SIMPLEPROGRESS.

Примечание.
Если pFrom или pTo не указаны, берутся файлы из текущей директории. Текущую директорию можно установить с помощью функции SetCurrentDirectory и получить функцией GetCurrentDirectory.



ФИЛЬТРЫ


Механизм фильтрации подписчиков использует строку условия фильтрации, являющуюся свойством подписки. Такая фильтрация выполняется для каждого метода и каждой подписки. Вы можете использовать строку, используя имена параметров из библиотеки типов. Можно использовать так же стандартные операции отношения, вложенные скобки и ключевые слова AND, OR, NOT. Строка может быть определена с помощью средств ComponentServices или средств административного API.

Скачать пример (21 K)

Андрей Семак
Компания ProFIX
май 2001г.




Форма просмотра журнала сбоев



Рисунок 1

Здесь показан внешний вид формы для просмотра журнала сбоев; думаю, комментарии не требуются. Отмечу лишь, что эта форма (наряду с другими формами общего назначения) лежит в DLL, и мне не приходится «таскать» её из проекта в проект. В целом процесс кодирования обработки ИС в каждом моём проекте выглядит так: «Перетаскиваю» компоненту TAskExceptionHandler на главную форму «Перетаскиваю» компоненту TAskDLL, ответственную за подключение и обработку DLL, на главную форму. Почитать об этой компоненте можно здесь: Указываю в свойстве TAskDLL имя DLL с формами В пункте меню организую показ этой формы: void __fastcall TFormMain::ALogExecute(TObject *Sender)
{ AskShowForm(AF_EXCEPTION_LOG); }



Формат CRON


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

Строка CRON представляет собой несколько , разделенных пробелом. Каждый список задает перечень моментов времени или даты, в единицах, зависящих от позиции (номера) списка в строке.

Последовательность списков в строке CRON такова: Секунды Минуты Часы Дни Месяцы ДниНедели

Если какая-либо единица времени/даты имеет произвольное значение, то ее просто опускают (если все старшие единицы тоже произвольны) или список ее значений представляют знаком "*" (если соседняя старшая единица задана).

Примеры записи периодических событий в формате CRON (с вариантами):

Каждую минуту в 0 секунд и 30 секунд: 0,30
0+30
+30
Каждую секунду в 0 часов, 8 и 16 часов: 0-59 0-59 0-16+8
* * 0+8
* * +8
Начало каждого часа, исключая полночь и полдень: 0 0 1-11,13-23
Каждые 3 секунды 1 числа каждого месяца: 0-59+3 * * 1
+3 * * 1
30 минут 0 секунд каждого часа в воскресенье: 0 30 * * * 0



Генерация и обработка исключений без подключения SysUtils


й,
дата публикации 25 августа 2003г.


Существует определенный класс программ, для которых достаточно важным является размер. Как правило, это утилиты с ограниченной функциональностью, и при их написании аничиваются использованием модулей Windows и Messages. Однако, при этом нередко хотелось бы иметь полноценный сервис обработки исключений, не утяжеляя проект модулем SysUtils. Попробуем решить эту задачу.

В Delphi работа с исключениями разделена на две части: собственно механизм генерации и обработки, расположенный в модуле System, и набор сервисных функций и классов, находящийся в SysUtils.

Реализация механизма в System сама по себе представляет немалый интерес, но ее рассмотрение выходит за рамки данной статьи. Нас интересует только небольшая ее часть, а именно процедура _ExceptionHandler. Это обработчик исключений, установленный при старте приложения, и получающий управление при генерации системой исключения – например, при вызове приложением функции RaiseException. _ExceptionHandler проводит ряд проверок, в зависимости от которых предпринимаются различные действия. Кратко рассмотрим только некоторые из них:

Если это исключение сгенерировано Delphi-программой, то происходит переход к пункту 5. Если значение переменной ExceptObjProc не равно nil, то вызывается функция, адрес которой находится в этой переменной, иначе переход к пункту 4. Если вызванной в п. 2 функции удалось “подобрать” соответствующий класс исключений, то происходит переход к пункту 5. Так как исключение осталось “неопознанным”, происходит нотификация пользователя и аварийное завершение процесса. Если значение переменной ExceptProc не равно nil, то вызывается процедура, адрес которой находится в этой переменной, иначе переход к пункту 4.

Таким образом, нас интересуют две переменные: ExceptObjProc и ExceptProc. Заглянем в SysUtils, чтобы посмотреть, как они используются в нем. В секции инициализации этот модуль присваивает им адреса функции GetExceptionObject и процедуры ExceptHandler соответственно. Первая из них пытается подобрать по коду ошибки соответствующий класс исключения и, при удаче, возвращает его экземрляр. Вторая производит нотификацию пользователя, используя строку сообщения из объекта, и вызывает Halt с кодом 1.

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

Прежде всего, нам необходим базовый класс исключения, по аналогии с Exception из SysUtils. Ниже приводится один из возможных вариантов его реализации:

interface uses Windows; type TLogHandler = procedure (ExceptObject: TObject; ExceptAddr: Pointer); LException = class private FExceptAddress: Pointer; protected function GetExceptionMessage: string; virtual; abstract; function GetExceptionTitle: string; virtual; property ExceptionAddress: Pointer read FExceptAddress; procedure ShowException; virtual; public property ExceptionMessage: string read GetExceptionMessage; property ExceptionTitle: string read GetExceptionTitle; function GetAddrString: string; end; var LogHandler: TLogHandler = nil; implementation { LException } function LException.GetAddrString: string; const CharBuf: array[0..15] of Char = '0123456789ABCDEF'; var BufLen: integer; Value: Cardinal; begin BufLen:=Succ(SizeOf(FExceptAddress) shl 1); SetLength(Result, BufLen); Result[1]:='$'; Value:=Cardinal(FExceptAddress); while BufLen > 1 do begin Result[BufLen]:=CharBuf[Value and $F]; Value:=Value shr 4; Dec(BufLen); end; end; function LException.GetExceptionTitle: string; begin Result:='Error'; end; procedure LException.ShowException; begin MessageBox(0, PChar(ExceptionMessage), PChar(ExceptionTitle), MB_ICONERROR or MB_TASKMODAL); end;

Раз уж мы внедряемся в обработку исключений, то почему бы не предусмотреть заодно и механизм ведения лога ошибок? Для этого и предусмотрен тип TLogHandler и переменная LogHandler. Остальной код прост и вряд ли нуждается в комментариях.

Далее, нам необходимо описать наш обработчик и присвоить его адрес переменной:


type TExceptHandler = TLogHandler; var OldHandler: TExceptHandler; procedure ExceptHandler(ExceptObject: TObject; ExceptAddr: Pointer); begin if Assigned(LogHandler) then try LogHandler(ExceptObject, ExceptAddr); except end; if ExceptObject is LException then begin LException(ExceptObject).FExceptAddress:=ExceptAddr; LException(ExceptObject).ShowException; Halt(1); end else if Assigned(OldHandler) then OldHandler(ExceptObject, ExceptAddr); end; procedure InitProc; begin OldHandler:=TExceptHandler(ExceptProc); ExceptProc:=@ExceptHandler; end; procedure FinalProc; begin TExceptHandler(ExceptProc):=OldHandler; end; initialization InitProc; finalization FinalProc;
Как видите, этот код не сложнее предыдущего. Прежде всего, мы вызываем обработчик логов, подстраховавшись от возможных ошибок блоком try-except. На всякий случай, все-таки ведение логов – не то место, где позволительно допускать ошибки. Далее мы проверяем, является ли объект исключения “нашим”, то есть потомком класса LException. Если это так, мы вызываем его методы и завершаем программу вызовом Halt. В противном случае мы вызываем предыдущий в цепочке обработчик. В секции инициализации мы устанавливаем свой обработчик, сохранив адрес предыдущего, а в секции финализации все восстанавливаем в первоначальном виде.

Аналог GetExceptionObject требуется реже и его реализация не представляет какой-либо сложности, поэтому я оставляю это читателям.

В качестве примера рассмотрим вариант реализации класса исключения для консольного приложения:

type LConsoleException = class(LException) private FMsg: string; protected function GetExceptionMessage: string; override; procedure ShowException; override; public constructor Create(Msg: string); end; { EConsoleException } constructor LConsoleException.Create(Msg: string); begin FMsg:=Msg; end; function LConsoleException.GetExceptionMessage: string; begin Result:=ExceptionTitle + ': ' + FMsg + ' at address ' + GetAddrString + #13#10; end; procedure LConsoleException.ShowException; var s: string; Len: DWORD; H: THandle; begin s:=ExceptionMessage; Len:=Length(s); H:=GetStdHandle(STD_ERROR_HANDLE); if H <> INVALID_HANDLE_VALUE then begin WriteConsole(H, PChar(s), Len, Len, nil); CloseHandle(H); end else inherited; end;
Мы переопределили конструктор, чтобы установить текст сообщения, и перекрыли два метода: GetExceptionMessage, чтобы отформатировать сообщение, и ShowException, чтобы перенаправить сообщение в стандартный вывод консоли. Генрация этого исключения вне защитного блока приведет к записи в стандартный вывод консоли сообщения об ошибке и завершению приложения. Если же его поместить в блок try-except, мы получим возможность вывести в консоль сообщение об ошибке и продолжить выполнение программы.

В заключении хочу отметить, что рассмотренный пример актуален для узкого класса приложений. Использование модулей SysUtils и Forms вносит в работу с исключениями весьма существенные коррективы.

Набережных Сергей
25 августа 2003г.


obal.pas


Unit Global; Interface CONST //MapInfo STANDARD Definitions''''''''''''''''''''''''' //''' Angle conversion '''''''''''''''''''''''''''''''''''''''''''''''''''''''' DEG_2_RAD = 0.01745329252; RAD_2_DEG = 57.29577951; //''' COLOR Consts ''''''''''''''''''''''''''''''''''''''''''''''''''''' miBLACK = '0'; miWHITE = '16777215'; miRED = '16711680'; miGREEN = '65280'; miBLUE = '255'; miCYAN = '65535'; miMAGENTA = '16711935'; miYELLOW = '16776960'; //''' TableInfo() Consts ''''''''''''''''''''''''''''''''''''''''''''''''''''' TAB_INFO_NAME = '1'; TAB_INFO_NUM = '2'; TAB_INFO_TYPE = '3'; TAB_INFO_NCOLS = '4'; TAB_INFO_MAPPABLE = '5'; TAB_INFO_READONLY = '6'; TAB_INFO_TEMP = '7'; TAB_INFO_NROWS = '8'; TAB_INFO_EDITED = '9'; TAB_INFO_FASTEDIT = '10'; TAB_INFO_UNDO = '11'; TAB_INFO_MAPPABLE_TABLE = '12'; TAB_INFO_USERMAP = '13'; TAB_INFO_USERBROWSE = '14'; TAB_INFO_USERCLOSE = '15'; TAB_INFO_USEREDITABLE = '16'; TAB_INFO_USERREMOVEMAP = '17'; TAB_INFO_USERDISPLAYMAP = '18'; TAB_INFO_TABFILE = '19'; TAB_INFO_MINX = '20'; TAB_INFO_MINY = '21'; TAB_INFO_MAXX = '22'; TAB_INFO_MAXY = '23'; TAB_INFO_SEAMLESS = '24'; TAB_INFO_COORDSYS_MINX = '25'; TAB_INFO_COORDSYS_MINY = '26'; TAB_INFO_COORDSYS_MAXX = '27'; TAB_INFO_COORDSYS_MAXY = '28'; TAB_INFO_COORDSYS_CLAUSE = '29'; TAB_INFO_COORDSYS_NAME = '30'; TAB_INFO_NREFS = '31'; //''' Table type Consts, returned by TableInfo(, TAB_INFO_TYPE) ''''' TAB_TYPE_BASE = '1'; TAB_TYPE_RESULT = '2'; TAB_TYPE_VIEW = '3'; TAB_TYPE_IMAGE = '4'; //''' ColumnInfo() Consts '''''''''''''''''''''''''''''''''''''''''''''''''''' COL_INFO_NAME = '1'; COL_INFO_NUM = '2'; COL_INFO_TYPE = '3'; COL_INFO_WIDTH = '4'; COL_INFO_DECPLACES = '5'; COL_INFO_INDEXED = '6'; COL_INFO_EDITABLE = '7'; //''' Column type Consts, returned by ColumnInfo(, COL_INFO_TYPE) ''' COL_TYPE_CHAR = '1'; COL_TYPE_DECIMAL = '2'; COL_TYPE_INTEGER = '3'; COL_TYPE_SMALLINT = '4'; COL_TYPE_DATE = '5'; COL_TYPE_LOGICAL = '6'; COL_TYPE_GRAPHIC = '7'; COL_TYPE_FLOAT = '8'; //''' WindowInfo() Consts '''''''''''''''''''''''''''''''''''''''''''''''''''' WIN_INFO_NAME = '1'; WIN_INFO_TYPE = '3'; WIN_INFO_WIDTH = '4'; WIN_INFO_HEIGHT = '5'; WIN_INFO_X = '6'; WIN_INFO_Y = '7'; WIN_INFO_TOPMOST = '8'; WIN_INFO_STATE = '9'; WIN_INFO_TABLE = '10'; WIN_INFO_OPEN = '11'; WIN_INFO_WND = '12'; //''' Window types, returned by WindowInfo(, WIN_INFO_TYPE) ''''''''''' WIN_MAPPER = '1'; WIN_BROWSER = '2'; WIN_LAYOUT = '3'; WIN_GRAPH = '4'; WIN_HELP = '1001'; WIN_MAPBASIC = '1002'; WIN_MESSAGE = '1003'; WIN_RULER = '1007'; WIN_INFO = '1008'; WIN_LEGEND = '1009'; WIN_STATISTICS = '1010'; WIN_MAPINFO = '1011'; //''' Version 2 window types no longer used in version 3 '''''''''''''''''''''' WIN_TOOLPICKER = '1004'; WIN_PENPICKER = '1005'; WIN_SYMBOLPICKER = '1006'; //''' Window states, returned by WindowInfo(, WIN_INFO_STATE) ''''''''' WIN_STATE_NORMAL = '0'; WIN_STATE_MINIMIZED = '1'; WIN_STATE_MAXIMIZED = '2'; //''' FileAttr() Consts and return codes ''''''''''''''''''''''''''''''''''''' FILE_ATTR_MODE = '1'; MODE_INPUT = '0'; MODE_OUTPUT = '1'; MODE_APPEND = '2'; MODE_RANDOM = '3'; MODE_BINARY = '4'; //''' ObjectInfo() Consts '''''''''''''''''''''''''''''''''''''''''''''''''''' OBJ_INFO_TYPE = '1'; OBJ_INFO_PEN = '2'; OBJ_INFO_SYMBOL = '2'; OBJ_INFO_TEXTFONT = '2'; OBJ_INFO_BRUSH = '3'; OBJ_INFO_NPNTS = '20'; OBJ_INFO_TEXTSTRING = '3'; OBJ_INFO_SMOOTH = '4'; OBJ_INFO_FRAMEWIN = '4'; OBJ_INFO_NPOLYGONS = '21'; OBJ_INFO_TEXTSPACING = '4'; OBJ_INFO_TEXTJUSTIFY = '5'; OBJ_INFO_FRAMETITLE = '6'; OBJ_INFO_TEXTARROW = '6'; //''' Object types, returned by ObjectInfo(, OBJ_INFO_TYPE) '''''''''''''' OBJ_ARC = '1'; OBJ_ELLIPSE = '2'; OBJ_LINE = '3'; OBJ_PLINE = '4'; OBJ_POINT = '5'; OBJ_FRAME = '6'; OBJ_REGION = '7'; OBJ_RECT = '8'; OBJ_ROUNDRECT = '9'; OBJ_TEXT = '10'; //''' ObjectGeography() Consts ''''''''''''''''''''''''''''''''''''''''''''''' OBJ_GEO_MINX = '1'; OBJ_GEO_LINEBEGX = '1'; OBJ_GEO_POINTX = '1'; OBJ_GEO_MINY = '2'; OBJ_GEO_LINEBEGY = '2'; OBJ_GEO_POINTY = '2'; OBJ_GEO_MAXX = '3'; OBJ_GEO_LINEENDX = '3'; OBJ_GEO_MAXY = '4'; OBJ_GEO_LINEENDY = '4'; OBJ_GEO_ARCBEGANGLE = '5'; OBJ_GEO_TEXTLINEX = '5'; OBJ_GEO_ROUNDRADIUS = '5'; OBJ_GEO_ARCENDANGLE = '6'; OBJ_GEO_TEXTLINEY = '6'; OBJ_GEO_TEXTANGLE = '7'; //''' StyleAttr() Consts ''''''''''''''''''''''''''''''''''''''''''''''''''''' PEN_WIDTH = '1'; PEN_PATTERN = '2'; PEN_COLOR = '4'; BRUSH_PATTERN = '1'; BRUSH_FORECOLOR = '2'; BRUSH_BACKCOLOR = '3'; FONT_NAME = '1'; FONT_STYLE = '2'; FONT_POINTSIZE = '3'; FONT_FORECOLOR = '4'; FONT_BACKCOLOR = '5'; SYMBOL_CODE = '1'; SYMBOL_COLOR = '2'; SYMBOL_POINTSIZE = '3'; //''' MapperInfo() Consts '''''''''''''''''''''''''''''''''''''''''''''''''''' MAPPER_INFO_ZOOM = '1'; MAPPER_INFO_SCALE = '2'; MAPPER_INFO_CENTERX = '3'; MAPPER_INFO_CENTERY = '4'; MAPPER_INFO_MINX = '5'; MAPPER_INFO_MINY = '6'; MAPPER_INFO_MAXX = '7'; MAPPER_INFO_MAXY = '8'; MAPPER_INFO_LAYERS = '9'; MAPPER_INFO_EDIT_LAYER = '10'; MAPPER_INFO_XYUNITS = '11'; MAPPER_INFO_DISTUNITS = '12'; MAPPER_INFO_AREAUNITS = '13'; MAPPER_INFO_SCROLLBARS = '14'; //''' LayerInfo() Consts ''''''''''''''''''''''''''''''''''''''''''''''''''''' LAYER_INFO_NAME = '1'; LAYER_INFO_EDITABLE = '2'; LAYER_INFO_SELECTABLE = '3'; LAYER_INFO_ZOOM_LAYERED = '4'; LAYER_INFO_ZOOM_MIN = '5'; LAYER_INFO_ZOOM_MAX = '6'; LAYER_INFO_COSMETIC = '7'; LAYER_INFO_PATH = '8'; LAYER_INFO_DISPLAY = '9'; LAYER_INFO_OVR_LINE = '10'; LAYER_INFO_OVR_PEN = '11'; LAYER_INFO_OVR_BRUSH = '12'; LAYER_INFO_OVR_SYMBOL = '13'; LAYER_INFO_OVR_FONT = '14'; LAYER_INFO_LBL_EXPR = '15'; LAYER_INFO_LBL_LT = '16'; LAYER_INFO_LBL_CURFONT = '17'; LAYER_INFO_LBL_FONT = '18'; LAYER_INFO_LBL_PARALLEL = '19'; LAYER_INFO_LBL_POS = '20'; LAYER_INFO_ARROWS = '21'; LAYER_INFO_NODES = '22'; LAYER_INFO_CENTROIDS = '23'; LAYER_INFO_TYPE = '24'; //''' Display Modes, returned by LayerInfo() for LAYER_INFO_DISPLAY ''''''''''' LAYER_INFO_DISPLAY_OFF = '0'; LAYER_INFO_DISPLAY_GRAPHIC = '1'; LAYER_INFO_DISPLAY_GLOBAL = '2'; LAYER_INFO_DISPLAY_VALUE = '3'; //''' Label Linetypes, returned by LayerInfo() for LAYER_INFO_LBL_LT '''''''''' LAYER_INFO_LBL_LT_NONE = '0'; LAYER_INFO_LBL_LT_SIMPLE = '1'; LAYER_INFO_LBL_LT_ARROW = '2'; //''' Label Positions, returned by LayerInfo() for LAYER_INFO_LBL_POS ''''''''' LAYER_INFO_LBL_POS_CC = '0'; LAYER_INFO_LBL_POS_TL = '1'; LAYER_INFO_LBL_POS_TC = '2'; LAYER_INFO_LBL_POS_TR = '3'; LAYER_INFO_LBL_POS_CL = '4'; LAYER_INFO_LBL_POS_CR = '5'; LAYER_INFO_LBL_POS_BL = '6'; LAYER_INFO_LBL_POS_BC = '7'; LAYER_INFO_LBL_POS_BR = '8'; //''' Layer Types, returned by LayerInfo() for LAYER_INFO_TYPE '''''''''''''''' LAYER_INFO_TYPE_NORMAL = '0'; LAYER_INFO_TYPE_COSMETIC = '1'; LAYER_INFO_TYPE_IMAGE = '2'; LAYER_INFO_TYPE_THEMATIC = '3'; //''' CommandInfo() Consts ''''''''''''''''''''''''''''''''''''''''''''''''''' CMD_INFO_X = '1'; CMD_INFO_Y = '2'; CMD_INFO_SHIFT = '3'; CMD_INFO_CTRL = '4'; CMD_INFO_X2 = '5'; CMD_INFO_Y2 = '6'; CMD_INFO_TOOLBTN = '7'; CMD_INFO_MENUITEM = '8'; CMD_INFO_WIN = '1'; CMD_INFO_SELTYPE = '1'; CMD_INFO_ROWID = '2'; CMD_INFO_STATUS = '1'; CMD_INFO_MSG = '1000'; CMD_INFO_DLG_OK = '1'; CMD_INFO_DLG_DBL = '1'; CMD_INFO_FIND_RC = '3'; CMD_INFO_FIND_ROWID = '4'; CMD_INFO_XCMD = '1'; //''' SysteMIdetailnfo() Consts '''''''''''''''''''''''''''''''''''''''''''''''''''' SYS_INFO_PLATFORM = '1'; SYS_INFO_APPVERSION = '2'; SYS_INFO_MIVERSION = '3'; SYS_INFO_RUNTIME = '4'; SYS_INFO_CHARSET = '5'; //''' Platform, returned by SysteMIdetailnfo(SYS_INFO_PLATFORM) ''''''''''''''''''''' PLATFORM_WIN = '1'; PLATFORM_MAC = '2'; PLATFORM_MOTIF = '3'; PLATFORM_X11 = '4'; PLATFORM_XOL = '5'; PLATFORM_DWT = '6'; //''' SelectionInfo() Consts ''''''''''''''''''''''''''''''''''''''''''''''''' SEL_INFO_TABLENAME = '1'; SEL_INFO_SELNAME = '2'; SEL_INFO_NROWS = '3'; //''' Return Values from StringCompare(, ) '''''''''''''''''''''' STR_LT = '-1'; STR_GT = '1'; STR_EQ = '0'; //''' Parameters used for IntersectNodes(obj1, obj2, mode) '''''''''''''''''''' INCL_CROSSINGS = '1'; INCL_COMMON = '6'; INCL_ALL = '7'; //''' Macros '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' // CLS = 'print Chr$(12) // MUST BE MANUALLY ENTERED //''' Symbol Styles MAPINFOW.FNT ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' SYM_NULL = '31'; SYM_SQUARE_FILL = '32'; SYM_DIAMOND_FILL = '33'; SYM_CIRCLE_FILL = '34'; SYM_STAR_FILL = '35'; SYM_UP_FILL = '36'; SYM_DOWN_FILL = '37'; SYM_SQUARE = '38'; SYM_DIAMOND = '39'; SYM_CIRCLE = '40'; SYM_STAR = '41'; SYM_UP = '42'; SYM_DOWN = '43'; SYM_SQUARE_SHADOW = '44'; SYM_UP_SHADOW = '45'; SYM_CIRCLE_SHADOW = '46'; SYM_ARROW_NE = '47'; SYM_ARROW_SW = '48'; SYM_CROSS = '49'; SYM_X = '50'; SYM_XCROSS = '51'; SYM_PLANE = '52'; SYM_SCHOOL = '53'; SYM_FLAG = '54'; SYM_HOSPITAL = '55'; SYM_MEDIC = '56'; SYM_CAMPING = '57'; SYM_BOATING = '58'; SYM_BULLEYE = '59'; SYM_HOUSE_WOOD1 = '60'; SYM_INTERSTATE = '61'; SYM_HIGHWAY = '62'; SYM_OILFIELD = '63'; SYM_MINING = '64'; SYM_CHURCH = '65'; SYM_HIRISE = '66'; SYM_PUSHPIN = '67'; //''' Symbol Styles GEO_SYM.FNT ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' SYM_HOUSE_BRICK1 = '68'; SYM_HOUSE_BRICK2 = '69'; SYM_HOUSE_WOOD2 = '70'; SYM_HOUSE_MOBIL = '71'; SYM_BUSINESS = '66'; // //MapInfo MENU Commands'''''''''''''''''''''''' // M_FILE_NEW = '101'; M_FILE_OPEN = '102'; M_FILE_OPEN_ODBC = '116'; M_FILE_ADD_WORKSPACE = '108'; M_FILE_CLOSE = '103'; M_FILE_CLOSE_ALL = '104'; M_FILE_SAVE = '105'; M_FILE_SAVE_COPY_AS = '106'; M_FILE_SAVE_WORKSPACE = '109'; M_FILE_SAVE_WINDOW_AS = '609'; M_FILE_REVERT = '107'; M_FILE_RUN = '110'; M_FILE_PAGE_SETUP = '111'; M_FILE_PRINT = '112'; M_FILE_EXIT = '113'; M_SENDMAIL_CURRENTWINDOW = '114'; M_SENDMAIL_WORKSPACE = '115'; //---------------------------------------------------------------------------- // Edit menu //---------------------------------------------------------------------------- M_EDIT_UNDO = '201'; M_EDIT_CUT = '202'; M_EDIT_COPY = '203'; M_EDIT_PASTE = '204'; M_EDIT_CLEAR = '205'; M_EDIT_CLEAROBJ = '206'; M_EDIT_RESHAPE = '1601'; M_EDIT_NEW_ROW = '702'; M_EDIT_GETINFO = '207'; //---------------------------------------------------------------------------- // Objects menu //---------------------------------------------------------------------------- M_OBJECTS_SET_TARGET = '1610'; M_OBJECTS_CLEAR_TARGET = '1611'; M_OBJECTS_COMBINE = '1605'; M_OBJECTS_SPLIT = '1612'; M_OBJECTS_ERASE = '1613'; M_OBJECTS_ERASE_OUT = '1614'; M_OBJECTS_OVERLAY = '1615'; M_OBJECTS_BUFFER = '1606'; M_OBJECTS_SMOOTH = '1602'; M_OBJECTS_UNSMOOTH = '1603'; M_OBJECTS_CVT_PGON = '1607'; M_OBJECTS_CVT_PLINE = '1604'; //---------------------------------------------------------------------------- // Query menu //---------------------------------------------------------------------------- M_ANALYZE_SELECT = '301'; M_QUERY_SELECT = '301'; M_ANALYZE_SQLQUERY = '302'; M_QUERY_SQLQUERY = '302'; M_ANALYZE_SELECTALL = '303'; M_QUERY_SELECTALL = '303'; M_ANALYZE_UNSELECT = '304'; M_QUERY_UNSELECT = '304'; M_ANALYZE_FIND = '305'; M_QUERY_FIND = '305'; M_ANALYZE_FIND_SELECTION = '306'; M_QUERY_FIND_SELECTION = '306'; M_ANALYZE_CALC_STATISTICS = '309'; M_QUERY_CALC_STATISTICS = '309'; //---------------------------------------------------------------------------- // Table, Maintenance, and Raster menus //---------------------------------------------------------------------------- M_TABLE_UPDATE_COLUMN = '405'; M_TABLE_APPEND = '411'; M_TABLE_GEOCODE = '407'; M_TABLE_CREATE_POINTS = '408'; M_TABLE_MERGE_USING_COLUMN = '406'; M_TABLE_IMPORT = '401'; M_TABLE_EXPORT = '402'; M_TABLE_MODIFY_STRUCTURE = '404'; M_TABLE_DELETE = '409'; M_TABLE_RENAME = '410'; M_TABLE_PACK = '403'; M_TABLE_MAKEMAPPABLE = '415'; M_TABLE_UNLINK = '416'; M_TABLE_REFRESH = '417'; M_TABLE_CHANGESYMBOL = '418'; M_TABLE_RASTER_STYLE = '414'; M_TABLE_RASTER_REG = '413'; M_TOOLS_RASTER_REG = '1730'; //---------------------------------------------------------------------------- // Options menu //---------------------------------------------------------------------------- M_FORMAT_PICK_LINE = '501'; M_FORMAT_PICK_FILL = '502'; M_FORMAT_PICK_SYMBOL = '503'; M_FORMAT_PICK_FONT = '504'; M_WINDOW_BUTTONPAD = '605'; M_WINDOW_LEGEND = '606'; M_WINDOW_STATISTICS = '607'; M_WINDOW_MAPBASIC = '608'; M_WINDOW_STATUSBAR = '616'; M_FORMAT_CUSTOM_COLORS = '617'; M_EDIT_PREFERENCES = '208'; M_EDIT_PREFERENCES_SYSTEM = '210'; M_EDIT_PREFERENCES_FILE = '211'; M_EDIT_PREFERENCES_MAP = '212'; M_EDIT_PREFERENCES_COUNTRY = '213'; M_EDIT_PREFERENCES_PATH = '214'; //---------------------------------------------------------------------------- // Window menu //---------------------------------------------------------------------------- M_WINDOW_BROWSE = '601'; M_WINDOW_MAP = '602'; M_WINDOW_GRAPH = '603'; M_WINDOW_LAYOUT = '604'; M_WINDOW_REDISTRICT = '615'; M_WINDOW_REDRAW = '610'; M_WINDOW_TILE = '611'; M_WINDOW_CASCADE = '612'; M_WINDOW_ARRANGEICONS = '613'; M_WINDOW_MORE = '614'; M_WINDOW_FIRST = '620'; // - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - // Note: the 2nd through 80th windows can be accessed as (M_WINDOW_FIRST+i-1) // - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - //---------------------------------------------------------------------------- // Help menu //---------------------------------------------------------------------------- M_HELP_CONTENTS = '1202'; M_HELP_SEARCH = '1203'; M_HELP_USE_HELP = '1204'; M_HELP_TECHSUPPORT = '1208'; M_HELP_CONNECT_MIFORUM = '1209'; M_HELP_ABOUT = '1205'; M_HELP_CONTEXTSENSITIVE = '1201'; M_HELP_HELPMODE = '1206'; //---------------------------------------------------------------------------- // Browse menu //---------------------------------------------------------------------------- M_BROWSE_PICK_FIELDS = '704'; M_BROWSE_OPTIONS = '703'; //---------------------------------------------------------------------------- // Map menu //---------------------------------------------------------------------------- M_MAP_LAYER_CONTROL = '801'; M_MAP_THEMATIC = '307'; M_MAP_MODIFY_THEMATIC = '308'; M_MAP_CHANGE_VIEW = '805'; M_MAP_CLONE_MAPPER = '811'; M_MAP_PREVIOUS = '806'; M_MAP_ENTIRE_LAYER = '807'; M_MAP_CLEAR_CUSTOM_LABELS = '814'; M_MAP_SAVE_COSMETIC = '809'; M_MAP_CLEAR_COSMETIC = '810'; M_MAP_SET_CLIP_REGION = '812'; M_MAP_CLIP_REGION_ONOFF = '813'; M_MAP_SETUPDIGITIZER = '803'; M_MAP_OPTIONS = '802'; //---------------------------------------------------------------------------- // Layout menu //---------------------------------------------------------------------------- M_LAYOUT_CHANGE_VIEW = '902'; M_LAYOUT_ACTUAL = '903'; M_LAYOUT_ENTIRE = '904'; M_LAYOUT_PREVIOUS = '905'; M_LAYOUT_BRING2FRONT = '906'; M_LAYOUT_SEND2BACK = '907'; M_LAYOUT_ALIGN = '908'; M_LAYOUT_DROPSHADOWS = '909'; M_LAYOUT_DISPLAYOPTIONS = '901'; //---------------------------------------------------------------------------- // Graph menu //---------------------------------------------------------------------------- M_GRAPH_TYPE = '1001'; M_GRAPH_LABEL_AXIS = '1002'; M_GRAPH_VALUE_AXIS = '1003'; M_GRAPH_SERIES = '1004'; //---------------------------------------------------------------------------- // MapBasic menu //---------------------------------------------------------------------------- M_MAPBASIC_CLEAR = '1101'; M_MAPBASIC_SAVECONTENTS = '1102'; //---------------------------------------------------------------------------- // Redistrict menu //---------------------------------------------------------------------------- M_REDISTRICT_ASSIGN = '705'; M_REDISTRICT_TARGET = '706'; M_REDISTRICT_ADD = '707'; M_REDISTRICT_DELETE = '708'; M_REDISTRICT_OPTIONS = '709'; //---------------------------------------------------------------------------- // Main Buttonpad //---------------------------------------------------------------------------- M_TOOLS_SELECTOR = '1701'; M_TOOLS_SEARCH_RECT = '1722'; M_TOOLS_SEARCH_RADIUS = '1703'; M_TOOLS_SEARCH_BOUNDARY = '1704'; M_TOOLS_EXPAND = '1705'; M_TOOLS_SHRINK = '1706'; M_TOOLS_RECENTER = '1702'; M_TOOLS_PNT_QUERY = '1707'; M_TOOLS_LABELER = '1708'; M_TOOLS_DRAGWINDOW = '1734'; M_TOOLS_RULER = '1710'; //---------------------------------------------------------------------------- // Drawing Buttonpad //---------------------------------------------------------------------------- M_TOOLS_POINT = '1711'; M_TOOLS_LINE = '1712'; M_TOOLS_POLYLINE = '1713'; M_TOOLS_ARC = '1716'; M_TOOLS_POLYGON = '1714'; M_TOOLS_ELLIPSE = '1715'; M_TOOLS_RECTANGLE = '1717'; M_TOOLS_ROUNDEDRECT = '1718'; M_TOOLS_TEXT = '1709'; M_TOOLS_FRAME = '1719'; M_TOOLS_ADD_NODE = '1723'; //---------------------------------------------------------------------------- // Menu and ButtonPad items that do not appear in the standard menus //---------------------------------------------------------------------------- M_TOOLS_MAPBASIC = '1720'; M_TOOLS_SEARCH_POLYGON = '1733'; //---------------------------------------------------------------------------- // Constants whose names have changed: these are left for backward // compatibility with existing programs. Recommended action is to use // the new name as indicated. Note that there might be some functiona // difference between the old functiona and the current functionality. //---------------------------------------------------------------------------- // M_ANALYZE_CUSTOMIZE_LEGEND M_MAP_MODIFY_THEMATIC // M_ANALYZE_SHADE M_MAP_THEMATIC // M_BROWSE_GRID M_BROWSE_OPTIONS // M_BROWSE_NEW_RECORD M_EDIT_NEW_ROW // M_FILE_ABOUT M_HELP_ABOUT // M_FILE_HELP M_HELP_CONTENTS // M_FILE_PRINT_SETUP M_FILE_PAGE_SETUP // M_LAYOUT_LAYOUT_SIZE M_LAYOUT_CHANGE_VIEW // M_MAP_SETUNITS M_MAP_OPTIONS // M_OBJECTS_BREAKPOLY M_OBJECTS_CVT_PLINE // M_OBJECTS_MERGE M_OBJECTS_COMBINE // M_OBJECTS_RESHAPE M_EDIT_RESHAPE // M_WINDOW_EXPORT_WINDOW M_FILE_SAVE_WINDOW_AS // M_WINDOW_TOOL_PALETTE M_WINDOW_BUTTONPAD //---------------------------------------------------------------------------- // Obsolete menu items that are not used in the current version of MapInfo //---------------------------------------------------------------------------- // M_BROWSE_EDIT 701 // 'OBSOLETE - DOES NOTHING // M_MAP_AUTOLABEL 804 // 'OBSOLETE - DOES NOTHING // M_MAP_PROJECTION 808 // 'SAME AS M_MAP_OPTIONS //============================================================================ // end of MENU.DEF //============================================================================ Implementation End.



Hooks - аспекты реализации


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

Моя обзорная (DLL) вызвала множество вопросов, большая часть которых касалась использования глобальных ловушек (Hook) и размещению разного рода ресурсов в DLL. О ресурсах поговорим в следующий раз, а пока попробуем разобраться с ловушками.

Скачать проект : (76 K)

Сразу хочу сделать несколько оговорок: речь в дальнейшем пойдёт только о 32-х разрядной Windows и о глобальных ловушках, т.к. именно при их программировании возникает большинство ошибок; все примеры будут даваться на Delphi, т.к. примеров и описаний для любителей С++ достаточно.

Давайте сначала разберёмся почему, иногда, даже опытные программисты допускают ошибки при написании глобальных ловушек. Первая, и самая распространённая причина: многие программисты, перейдя от 16-ти разрядной к 32-х разрядной Windows, порой забывают об изолированности адресных пространств процессов, такая забывчивость прощается при написании локальных ловушек, в случае с глобальными она может стать фатальной (подробнее об этом рассказано дальше в статье). Второй причиной является то, что в SDK (да и в MSDN тоже) даётся недостаточно информации по данной тематике, а та что есть часто трактуется неверно. Третья причина… хотя, думаю, стоит остановиться пока на этом.

Дальнейшее повествование предполагает, что читатель знаком с основными принципами работы с DLL и хотя бы в общих чертах представляет механизм их написания.

Что же происходит в системе когда мы "ставим" ловушку и что это вообще такое - ловушка ?

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

Функции-фильтры - это функции, получающие уведомления о произошедшем событии от ловушки.

В зависимости от типа ловушки функции-фильтры могут изменять события, отменять их или просто реагировать на них. Таким образом, когда мы говорим "установил ловушку" мы подразумеваем процесс прикрепления функции-фильтра к выбранному нами типу ловушки. Итак, когда мы в своей программе используем функцию SetWindowsHookEx мы прикрепляем функцию-фильтр, указатель на которую мы и передаём вторым параметром, пример SetWindowsHookEx(WH_SHELL, @ShellHook, HInstance, 0); в данном случае ShellHook - это и есть функция-фильтр. В дальнейшем, под словосочетанием "установили ловушку" будем понимать присоединение функции-фильтра к ловушке.


Что же происходит после того, как мы установили глобальную ловушку ? Понимание следующего параграфа является ключом для понимания механизма работы ловушек Windows, располагающихся в DLL. Если вы не поймёте его, вернитесь и перечитайте заново и так до тех пор, пока всё не станет ясным.

Наш Process1 устанавливает глобальную ловушку из DLL находящейся в адресном пространстве (АП) нашего процесса (Process1). DLL, находящаяся в АП процесса1 имеет свои данные, обозначенные на рисунке как Dll data. Когда система посылает событие, на которое мы установили ловушку, в Process2, то в Process2 отображается код DLL, находящийся в первом процессе (Dll code), НО НЕ ДАННЫЕ ! Все данные, только что отображённой в Process2 DLL, инициализируются заново (т.е. равны 0, nil, False в зависимости от типа). То есть, Process2 знать не знает о существовании Process1, и всё что в нём находится никак не относится к АП первого процесса, из которого произошло отображение кода DLL. В библиотеки, находящиеся не в АП вашего процесса, можно посылать только процессо-независимые данные, такие как, к примеру, дескрипторы окон (под термином "посылка" в данном случае подразумевается использование функций PostMessage() и SendMessage()).

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


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

Для вызова следующей ловушки в цепочке ловушек в Windows используется функция CallNextHookEx, первым параметром которой является дескриптор текущей ловушки, получаемый функцией SetWindowsHookEx. Теперь внимание: мы установили ловушку в Process1, т.е. функция SetWindowsHookEx выполнялась в DLL, находящейся в АП Process1 (см. Рисунок 1) и, соответственно, дескриптор установленной ловушки возвращаемый функцией SetWindowsHookEx принадлежит данным DLL, находящимся в АП Process1. Пусть в Process2 возникает событие на которое поставлена ловушка, тогда Dll из первого процесса проецируется на АП Process2, а данные DLL в Process2 инициализируются заново, и получается, что в Process2 в переменной, в которой "лежал" дескриптор поставленной ловушки в Process1, будет равен 0. Функция-фильтр Process2, отработав, должна будет передать сообщение дальше по цепочке ловушек, т.е. выполнить функцию CallNextHookEx, первым параметром которой должен быть дескриптор текущей ловушки, но в данных DLL, находящейся в Process2 нет этого дескриптора (переменная, которая должна содержать его содержит ноль). "Как же быть в таком случае ? Как же нам узнать дескриптор ловушки, поставленной в другом процессе, если сами процессы ничего не знают друг о друге ?" - спросите вы. На этот вопрос я отвечу чуть позже, а пока давайте поверхностно пробежимся по типам ловушек, хотя информация о типах полностью приведена в SDK.



Как мы уже знаем, ловушка устанавливается с помощью Win32 API функции SetWindowsHookEx(): function SetWindowsHookEx(idHook: integer; lpfn: TFNHookProc; hmod: HINST; dwThreadID: DWORD): HHOOK; stdcall; idHook: описывает тип устанавливаемой ловушки. Данный параметр может принимать одно из следующих значений:
Константа Описание
WH_CALLWNDPROC Фильтр процедуры окна. Функция-фильтр ловушки вызывается, когда процедуре окна посылается сообщение. Windows вызывает этот хук при каждом вызове функции SendMessage.
WH_CALLWNDPROCRET Функция-фильтр, контролирующая сообщения после их обработки процедурой окна приемника.
WH_CBT В литературе встречаются следующие названия для этого типа фильтров: "тренировочный" или "обучающий". Данная ловушка вызывается перед обработкой большинства сообщений окон, мыши и клавиатуры
WH_DEBUG Функция-фильтр, предназначенная для отладки. Функция-фильтр ловушки вызывается перед любой другой ловушкой Windows. Удобный инструмент для отладки и контроля ловушек.
WH_GETMESSAGE Функция-фильтр обработки сообщений. Функция-фильтр ловушки вызывается всегда, когда из очереди приложения считывается любое сообщение.
WH_HARDWARE Функция-фильтр, обрабатывающая сообщения оборудования. Функция-фильтр ловушки вызывается, когда из очереди приложения считывается сообщение оборудования.
WH_JOURNALPLAYBACK Функция-фильтр вызывается, когда из очереди системы считывается любое сообщение. Используется для вставки в очередь системных событий.
WH_JOURNALRECORD Функция-фильтр вызывается, когда из очереди системы запрашивается какое-либо событие. Используется для регистрации системных событий.
WH_KEYBOARD Функция-фильтр "обработки" клавиатуры. Наверное, наиболее часто используемый тип ловушки. Функция-фильтр ловушки вызывается, когда из очереди приложения считывается сообщения wm_KeyDown или wm_KeyUp.
WH_KEYBOARD_LL Низкоуровневый фильтр клавиатуры.
WH_MOUSE Функция-фильтр, обрабатывающая сообщения мыши. Функция-фильтр ловушки вызывается, когда из очереди приложения считывается сообщение мыши.
WH_MOUSE_LL Низкоуровневый фильтр мыши.
WH_MSGFILTER Функция-фильтр специального сообщения. Функция-фильтр ловушки вызывается, когда сообщение должно быть обработано диалоговым окном приложения, меню или окном приложения.
WH_SHELL Фильтр приложения оболочки. Функция-фильтр ловушки вызывается, когда создаются и разрушаются окна верхнего уровня или когда приложению-оболочке требуется стать активным.


Что бы упредить шквал писем в мой адрес, скажу сразу, что каждый, из вышеперечисленных, типов имеет свои особенности, о которых каждый может прочитать в SDK, MSDN или же найти их описание в Internet-e.
lpfn : это адрес функции-фильтра, которая является функцией обратного вызова. Функция-фильтр имеет тип TFNHookProc, определение которого выглядит следующим образом: TFNHookProc = function (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall; Значение каждого из параметров функции-фильтра ловушки изменяется в зависимости от типа устанавливаемой ловушки. За более подробными разъяснениями значений параметров обращайтесь к справке по Win32 API.

hmod: данный параметр должен иметь значение hInstance в EXE или DLL-файлах, в которых содержится функция-фильтр ловушки (напомню, что это функция обратного вызова). Если речь идёт о глобальных ловушках, то данный параметр может принимать только дескриптор DLL, из которой устанавливается ловушка. Причина очевидна - EXE-файл не может быть отображён на АП другого процесса, тогда как DLL-фалы специально созданы для этого. Подчеркну это обстоятельство ещё раз: глобальные ловушки могут располагаться только в DLL, но никак не в EXE файлах !

dwThreadID: данный параметр идентифицирует поток, с которым будет связана ловушка. Мы ведём речь о глобальных ловушках, поэтому данный параметр будет всегда равен 0, что означает, что ловушка будет связана со всеми потоками в системе.
Возвращаемое значение: функция SetWindowsHookEx возвращает дескриптор установленной ловушки, именно этот дескриптор нам и надо будет сделать доступным ВСЕМ экземплярам отображаемой DLL. Как это сделать я расскажу после небольшого примера, показывающего на практике необходимость сохранять дескриптор ловушки для того, что бы суметь вызвать предыдущую ловушку в цепочке.

Замечание::
при установке двух ловушек разного типа, система создаст две цепочки ловушек. Т.е. каждому типу ловушки соответствует своя цепочка. Так при установке ловушки типа WH_MOUSE и WH_KEYBOARD обе эти ловушки будут находиться в разных цепочках и, соответственно, будут обрабатываться независимо друг от друга.

Для удаления функции-фильтра из очереди необходимо вызвать функцию UnhookWindowsHookEx. Данная функция принимает дескриптор ловушки, полученный функцией SetWindowsHookEx. Если удаление не удалось, то функция возвращает ноль, иначе не нулевое значение. В дальнейшем, под выражением "снять ловушку" будем подразумевать удаление функции-фильтра.



Теперь, когда вам известно как устанавливать ловушку и как её снимать, рассмотрим пару примеров, которые дадут наглядное представление об изолированности АП процессов и укажут на одну из самых распространённых ошибок.
Откройте каталог Example1, из прилагаемого к статье файла, далее зайдите в каталоги First и Second и скомпилируйте все имеющиеся в этих каталогах проекты. В итоге вы должны получить в одном каталоге файлы MainProg1.exe и hook_dll1.dll, и во втором - MainProg2.exe и hook_dll2.dll (не забудьте, что *.DLL файлы могут быть не видны, из-за того, что у вас в свойствах обозревателя выбран пункт "Не показывать скрытые и системные файлы" ) . Запустите MainProg1.exe и MainProg2.exe, расположите появившиеся окошки рядом. Теперь в окне MainProg1 нажмите "Load DLL and set hook", как только вы нажмёте на эту кнопку, ловушка типа WH_GETMESSAGE установится и теперь, когда какой либо процесс будет считывать сообщение из очереди, в этот процесс будет отображена hook_dll1.dll и выполнена функция-фильтр. При отображении в процесс этой DLL будет выводиться сообщение с именем модуля, из которого был загружен процесс, отобразивший эту DLL в своё АП. Если ловушка установлена успешно, - будет выведено соответствующее сообщение. Проделайте те же действия со второй формой (Example1/Process2). Теперь, после успешной установки двух ловушек, попробуйте кликнуть правой кнопкой мыши на какой-либо форме (но не на форме MainProg2). Вы увидите сообщение "HOOK2 working !", что означает что сработала вторая ловушка, которую мы установили последней и которая находится в конце очереди, но, несмотря на то, что в коде функции-фильтра второй ловушки мы пытались передать сообщение следующей ловушке (установленной нами из MainProg1 CallNextHookEx(SysHook, Code, wParam, lParam); первая ловушка не выполняется, потому что в процессе, которому принадлежит форма, на которой вы произвели клик, переменная SysHook будет равна нулю. Надеюсь, это понятно, если нет, - начинайте читать заново ;) Теперь попробуйте так же кликнуть правой кнопкой мыши на форму Example1/Process2 и вы увидите сначала сообщение "HOOK2 working !", а затем "HOOK1 working !". Почему ? - спросите вы. А потому, что в АП Process2 (в данных DLL) лежит дескриптор установленной из этого процесса ловушки и функция CallNextHookEx(SysHook, Code, wParam, lParam); работает как надо (SysHook не равна нулю, мы её сохранили в глобальных данных DLL - см. исходный код). Далее, попробуйте снять вторую ловушку (удалить функцию-фильтр из очереди) нажав на кнопку "TurnOff the hook". После того, как ловушка будет снята, попробуйте снова где-либо нажать правую кнопку мыши. При этом вы увидите, что ловушка, поставленная из первого приложения работает (будет появляться сообщение "HOOK1 working !"). Естественно, если вы, не сняв ловушку, закроете приложение, из которого она была установлена, ловушка будет уничтожена, а DLL выгружена, если более ни одним приложением не используется. ( Хотя, строго говоря, это не совсем так. Дело в том, что Windows использует механизм кэширования DLL в оперативной памяти. Делается это для того, что бы уменьшить накладные расходы на загрузку DLL с жёсткого диска в случае, если к этой DLL часто обращаются различные приложения, т.е. отображают эту DLL на своё АП. Более подробно об этом механизме можно почитать в специализированной литературе, для нас же, как для программистов, данное свойство ОС остаётся, как правило, прозрачным).



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

Замечание:
если вы работаете на Windows 2000, то вышеописанный пример будет работать иначе. Дело в том, что в Windows 2000 изменён механизм вызова ловушки, стоящей в очереди. Программисты Microsoft довели-таки его до ума, и в новой ОС он стал, по моему личному мнению, более логичен. В Windows 2000 если у вас имеется цепочка ловушек, то при выполнении функции CallNextHookEx(0, nCode, wParam, lParam ) вызывается следующая ловушка в цепочке, т.е. отпадает необходимость в передачи дескриптора, возвращаемого функцией SetWindowsHookEx. Таким образом, в первом примере будут вызываться обе ловушки и при клике на правую кнопку мыши вы увидите сообщение "HOOK2 working !", а затем и "HOOK1 working !". Рассмотрев и опробовав пример 2, вы увидите, что в Windows 2000 оба примера работают одинаково, хотя второй пример гораздо более сложен в плане реализации. Так как мы стремимся к тому, что бы наши программы были устойчивы в работе под любой версией Windows (имеются ввиду 32-х разрядные и выше), то в связи с этим я бы рекомендовал в ваших программах использовать метод, описанный далее в статье, а ещё лучше - делать проверку на ОС, под которой была запущена ваша программа и соответствующим образом работать с ловушками. К сожалению у меня нет описания, содержащего декларацию "новой" функции CallNextHookEx(), нововведение было обнаружено мной в результате тестирования своих программ на Windows 2000, поэтому возможны какие-то нюансы при работе с этой функцией. Лично я, работая с ловушками в среде Windows 2000, на другие изменения не натыкался, если кто-то располагает какой-либо интересной информацией по данному вопросу - буду признателен, если со мной ею поделятся.

Теперь поговорим о том, как избежать неприятных ситуаций, используя глобальные ловушки.

Для того, что бы все экземпляры DLL, находящиеся в разных процессах, имели доступ к дескриптору ловушки, надо выделить какую-то область, доступ к которой будут иметь все "желающие". Для этого воспользуемся одним из мощнейших механизмов Windows под названием "Файлы, отображённые в память" (Memory Mapped Files). В цели данной статьи не входит углубление в подробности работы с данным механизмом, так что если он кого-то заинтересует всерьёз - рекомендую почитать о нём в литературе, общие же понятия я постараюсь вкратце осветить. Механизм файлов, отображённых в память (MMF - Memory Mapped Files) позволяет резервировать определённую область АП системы Windows, для которой назначаются страницы физической памяти. Таким образом, с помощью MMF можно отображать в память не только файлы, но и данные, ссылаясь на них из своих программ с помощью указателей. В первом приближении работу механизма MMF можно представить следующим образом: Process1 создаёт отображение, которое связывает с некими данными (будь то файл на диске или значение неких переменных в самом Process1) и может изменять отображённые данные; затем Process2 так же отображает некие свои данные в тоже отображение, что и Process1, таким образом, изменения, внесённые Process1 в отображённые данные, будут видны Process2 и наоборот (см. Рисунок 1 - красный овал c именем Global Data и есть зарезервированное под совместные нужды двух процессов АП). Данное приближение, вообще говоря, грубое, потому что всё намного сложнее, но для наших "нужд" этого будет вполне достаточно. Мы не будем создавать никаких временных файлов для передачи информации между процессами, мы воспользуемся файлом подкачки Windows (файл страничного обмена), таким образом, нам не придётся ни создавать ни уничтожать файлы, а придётся просто создать некоторое АП, которое будет доступно нашим приложениям и которое будет автоматически освобождаться системой, когда в нём отпадёт необходимость. К тому же, ясно, что работа с файлом подкачки куда быстрее, чем с обычным файлом, хранящимся на диске. Таким образом, к рассмотренному вами ранее Example1 можно применить следующий сценарий: при загрузки вашей программой (MainProg1.exe) библиотеки hook_dll1.dll эта библиотека создаёт отображённый в память файл, в котором сохраняет значение дескриптора установленной ловушки; затем некий процесс, в котором произошло событие, на которое была установлена ловушка, отображает на своё АП код hook_dll1.dll и уже новый экземпляр hook_dll1.dll, находящийся в АП другого процесса использует то же отображение, что и библиотека, из который была установлена ловушка, т.е. будет иметь доступ к сохранённому значению дескриптора установленной ловушки. Таким образом, вызов функции CallNextHookEx(Hook_Handle, Code, wParam, lParam); будет происходить вполне корректно, т.к. значение Hook_Handle будет содержать не 0, как в примере1, а значение, возвращённое функцией SetWindowsHookEx из первого экземпляра DLL. Возможно, данные объяснения кажутся вам запутанными, но после просмотра примера и повторного прочтения этих объяснений всё встанет на свои места.



Теперь пару слов о программной реализации всего вышесказанного.

CreateFileMapping()Создаёт объект файлового отображения. Данная функция возвращает указатель (handle) на объект файлового отображения.
MapViewOfFile()Данная функция отображает образ объекта файлового отображения на АП процесса, из которого она была вызвана. Первым параметром данной функции является результат выполнения функции CreateFileMapping(). Результатом работы данной функции является указатель на начало выделенного АП (уже в том процессе, из которого была вызвана данная функция). См. Рисунок 1. - красные овалы в Process1 и Process2 под названием GD1 и GD2 (Global Data 1/2). Следует отметить, что для различных процессов, использующих экземпляры одной и той же DLL, адреса выделенных областей будут различными (хотя могут и совпадать, но это совпадение носит вероятностный характер), хотя данные, на которые они будут ссылаться, одни и те же !
UnmapViewOfFile()Данная функция закрывает отображённый в память файл и освобождает его дескриптор. При удачном закрытие функция возвращает ненулевое значение и 0 в случае неудачи.
За подробной информацией о параметрах вышеописанных функций обращайтесь к SDK, а так же разберитесь в примере, который будет разобран ниже.

Замечание:
первым параметром функции CreateFileMapping() должен быть передан дескриптор файла, которого мы собираемся отобразить. Т.к. мы собираемся отображать данные в файл подкачки, то следует передавать значение $FFFFFFFF или DWORD(-1), что соответствует тому же значению; но т.к. грядёт эра 64-разрядных систем, стоит использовать значение INVALID_HANDLE_VALUE, которое будет в 64 разрядной системе равно $FFFFFFFFFFFFFFFF соответственно. Для тех, кто переходил с ранних версий Delphi на более поздние (к примеру с Delphi2 на Delphi4) те, возможно, сталкивались с такого рода проблемами в своих программах. Так как мы будем создавать именованный объект файлового отображения, то последним параметром функции CreateFileMapping() передадим имя объекта, которое впоследствии будут использовать другие процессы для ссылки на ту же область памяти. Следует упомянуть о том, что создаваемый таким образом объект должен иметь фиксированный размер, т.е. не может его изменять по ходу программы.

Теперь мы владеем всеми необходимыми знаниями для рассмотрения второго примера. Откройте каталог Example2 и выполните те же действия, что и в первом примере, предварительно внимательно разобравшись в исходных кодах. После того как вы запустите оба приложения и установите из них две функции-фильтра одного типа, попробуйте кликнуть правой кнопкой мыши на любом из окон и вы увидите, что теперь отрабатывают обе установленные ловушки, независимо от того, на каком из окон произошло нажатие кнопки мыши (т.е. несмотря на то, из какого экземпляра DLL выполняется вызов функции CallNextHookEx() ). Таким образом, когда какое-либо приложение будет отображать на своё АП DLL, в которой находится функция-фильтр, этот экземпляр DLL будет иметь доступ к данным, отображённым в память из Process1 или Process2, в зависимости от DLL. Думаю, после столь подробных объяснений всё должно быть понятно.



В завершении напишем программу, которая будет устанавливать ловушку типа WH_KEYBOARD и записывать в файл значения нажатых клавиш во всех приложениях (программа будет накапливать в буфере значения нажатых клавиш и как только их количество превысит 40 - все значения будут выведены в соответствующее окно формы). Попутно, в данном примере, новички могут найти ответы на многие вопросы, часто задаваемые в различных форумах. Все объяснения будут даваться в виде комментариев к исходному коду. Откройте каталог Example3, в нём вы найдёте исходные коды библиотеки и главной программы, - разберитесь с ними, а затем откомпилируйте и сами попробуйте программу в действии.

Благодарю а за оказанную поддержку.

Список использованной литературы: Microsoft Win32 Software Development Kit. Стив Тейксейра и Ксавье Пачеко, "Delphi5. Руководство разработчика. Том 1. Основные методы и технологии". Kyle Marsh, "Hooks in Win32" (in the original). Dr. Joseph M. Newcomer, "Hooks and DLLs" (in the original). Скачать проект : (76 K)

Алексей Павлов
Moscow Power Engineering Institute (Technical University)
Faculty of Nuclear Power Plants
для публикации на статья предоставлена


Инспектор объектов и метаданные


й Гурин,
дата публикации 28 апреля 2003г.


Предмет данной статьи - инспектор объектов как средство, доступное конечному пользователю некоторой прикладной программы. Само понятие "инспектор" трактуется в данном случае очень широко: инспектор - это инструмент прикладной программы, с помощью которого пользователь может посмотреть и изменить свойства тех объектов, с которыми он работает. Отметим, что речь идет о любых объектах прикладного уровня, а не только о визуальных компонентах (как в Delphi).



Использование функциональности IE или заметки о WebBrowser


Раздел Подземелье Магов Игорь Осов'як ,
дата публикации 28 февраля 2001г.

Содержание:

Введение.

Довольно часто современному программисту приходится решать вопросы, которые связанные с отображением или обработкой информации, представленной в виде html-ресурсов. Например, на некотором сайте приводятся ежедневные котировки акций и Вам нужно собирать и обрабатывать статистку за определенный период времени. Или нужно создать сторожа, который "наблюдает" за он-лайн прайс-листом конкурента и который должен "предупреждать" об изменениях цены на определенные позиции. Или нужно написать "паука", который должен пробегать по некоторому сайту в поисках определенного текста, причем в процессе пробежки ему нужно заполнить несколько регистрационных форм, а фрагменты текста, которые он отыскал - выделить определенным цветом. Можно назвать бесконечно много подобных примеров, но суть их сводится к одному - получение веб-страницы, извлечение из нее определенной части HTML-кода программными средствами (парсинг), и, возможно, программное влияние на эту часть кода.
Можно, конечно, используя WinInet.dll, получить доступ к требуемому веб-ресурсу, а затем с помощью многочисленных строковых функций получить интересующею нас ее часть. Эта технология вполне работает, но довольно трудоемкая и, в большинстве случаев далека от элегантности. Другой путь - использование функциональности Microsoft Internet Explorer.

Internet Explorer (далее - IE)- это не одна отдельная программа, а целая коллекция компонент, которые можно использовать при разработке своих приложений. Наиболее интересными с точки зрения прикладного программиста есть компоненты из shdocvw.dll и mshtml.dll. Первая DLL содержит WebBrowser - Microsoft ActiveX control, используемый для визуального просмотра веб-страниц (рабочая область окна Internet Explorer и есть тот самый компонент WebBrowser). Вторая DLL содержит синтаксический анализатор HTML кода, а также средства взаимодействия с отдельными элементами этого кода. По скромному мнению и.


Целью написания этого цикла статей есть демонстрация некоторых приемов использования функциональности ActiveX-контрола WebBrowser в прикладных дельфийских программах. численных веб-ресурсах. То небольшое, что отличает этот материал (по мнению чных - это во-первых, ориентация на Delphi, а во вторых - обобщение личного опыта рода благодарность тем людям, которые довольно сильно помогли мне в то время, когда я делал первые шаги в направлении, к которому имеет отношение эта статья. Я особенно благодарен Борису Ладугину за тот "ликбез" в части COM, который он провел со мной в личной переписке, а также Лене Филиповой и всем местным жителям, советы которых на "круглом столе" не раз давали толчок для движения в верном направлении.

аммирования на Delphi и хотя бы в общих чертах знаком с COM-технологиями. Хотя материала, но, надеюсь, дадут хотя бы направление поиска в случае затруднений.

Где в Delphi живет WebBrowser?


Для любого зарегистрированного в палитре ActivX-контрола Delphi при импорте создает класс-оболочку, которая наследуется от TOleControl . Для начала не станем углубляться в особенности TOleControl и производных от нее оболочек - ибо сие дело поначалу может не так прояснить, как запутать ситуацию. Отметим только, что оболочка и сам ActiveX есть несколько разные вещи. Собственно TOleControl и производные от него оболочки есть не более, чем средство, которое обеспечивают возможность работы с ActiveX, как с "родными" VCL-компонентами. Для WebBrowser от IE такой оболочкой есть TWebBrowser. Если Вы используете Delphi5, то соответствующий компонент можно отыскать на закладке "Internet " палитры компонентов. Если Вы работаете с Delphi4 , то Вам нужно провести импорт соответствующего ActiveX-контрола. Для этого следует воспользоваться меню "Import ActiveX Control" и в списке ActiveX выбрать "Microsoft Internet Controls" (разумеется, у Вас должен быть установлен IE). Компонент-оболочка по умолчанию устанавливается на закладку "ActiveX" палитры компонентов. Если Вам нужен не только компонент для отображения Web-страниц, а Вы еще собираетесь проводить парсинг загруженных страниц, то Вам также следует провести импорт mshtml.dll. Это можно сделать при помощи меню Import Type Library, выбрав в списке строчку Microsoft HTML Object Library.
Даже если Вы используете Delphi5, в определенных случаях есть смысл исключить предустановленный компонент TWebBrowser и провести импорт соответствующих компонентов самостоятельно. Это может быть необходимым в случае, если Вы желаете написать приложение, совместимое с IE4, а в Delphi5 модули mshtml.pas и shdocvw.pas рассчитаны на использование IE5. И как следствие, довольно много интерфейсов, которые декларируются в соответствующих модулях, не будут поддерживаться IE4 (к примеру, тот же IHTMLDocument3). Или наоборот, Вас, возможно, заинтересовала какая-то особенность новой версии IE, декларация которой отсутствует в mshtml.pas (или shdocvw.pas) c поставки Delphi.
Если Вы решитесь для Delphi5 проводить самостоятельный импорт mshtml.dll через Import Type Library - уберите галочку с "Generate Component Wrapper" - в противном случае Delphi создаст никому не нужные класы-оболочки для интерфейсов и раздует результирующий файл (mshtml_tbl.pas)до несусветных размеров.
Понятно, что если Вы провели импорт, то в Delphi5 Вам вместо uses mshtml,shdocvw;
придется использовать uses mshtml_tbl,shdocvw_tbl;
Если Вы проведете импорт, то Вы наверняка обратите внимание на то, что помимо упоминаемого TWebBrowser рядышком будет TWebBrowser_V1. Что это за зверь? Ответ довольно прост - это совместимый с IE3 контрол. В IE4 он введен для совместимости с теми прикладными программами, которые разрабатывались в расчете на IE3.

И заканчивая тему экспорта - в библиотеке типов от IE довольно часто используются имена, которые есть зарезервироваными для Delphi. В большинстве случаев Delphi справляется с этой задачей (к примеру переименовывая метод type некоего интерфейса в type_). Но для mshtml.dll от IE5 есть один неприятный момент - там декларируется константа const True = $00000001; И если Вы делаете импорт в Delphi4 - то никакого переименования не происходит. B как следствие в каком-то безобидном месте наподобие нижеследующего implemantation uses mshtml_tbl; function IsOk:boolean; begin result:=true; // ..... end; получаете сообщение компилятора о несовместимости типов. Что делать?
Или смирится и писать: result:=system.true;< BR> или "научить" Delphi4 обходному маневру: перед импортом mshtml.dll добавить в DELPHI\BIN\tlibimp.sym две строчки: True False



Содержание

Где искать информацию?

Итак, мы уже разобрались, где наш контрол живет. И как его импортировать в случае необходимости.
Теперь несколько слов об дополнительных источниках информации. Если Вы работаете с Delphi5, то для начала можно посмотреть встроенную контекстную справку по TWebBrowser. Но к сожаленью, она довольно скудна, и описывает (и то поверхностно) только основные свойства компонента TWebBrowser. Вы ни слова не найдете об возможностях mshtml.dll (а там запрятаны основные вкусности). Наиболее радикальное решение - приобрести свежее издание MSDN (или работать с ее онлайновой версией ). Но и при таком решении не все будет гладко - так как MSDN в первую очередь не учебник, а справочник. И к тому же некоторые аспекты в нем освещены не так полно, как хотелось бы. Но увы, это пожалуй наиболее полный источник информации, пробелы в котором можно компенсировать только многочисленными экспериментами и анализом происходящего. Ответ на конкретный вопрос можно попытаться отыскать в конференциях. Можно и в "общих", таких как старый, добрый fido7.delphi.ru, или здесь, на . А также в "специализированных" - и (последняя - англоязычная). Также рекомендую сайт .

Я также надеюсь, что время, затраченное мной на написание, а Вами на прочтение этой статьи, потрачено не зря.
Ну, а если Вы находитесь в самом начале пути - то можно просмотреть статью Александра Лозовюка (рубрика Hello, world) ...

Несколько слов о реализации простого веб-броузера и не только ..

В принципе, создать простенький веб-броузер c использованием TWebBrowser - дело мало чем более одной минуты. Открываем новый проект, центрируем форму, в нижней части размещаем панель, на которую бросаем ComboBox для вввода URL, слева от нее соответствующий Label, справа кнопочку "Go". Разместим также главное действующие лицо TWebBrowser над панелью. Дадим более-менее вразумительные имена нашим компонентам (например, ComboBox можно назвать "selUrl"), проставим соответствующие опции выравнивания. Ну, и самая "трудная" часть задачи - создадим обработчик нажатия на кнопочку "Go": procedure TFormSimpleWB.btGoClick(Sender: TObject); var _URL, Flags, TargetFrameName, PostData, Headers: Olevariant; begin _URL := selUrl.Text; Flags := 0; TargetFrameName := 0; Postdata := 0; Headers := 0; WebBrowser1.Navigate2(_URL, Flags, TargetFrameName, PostData, Headers); end; Исходники этого "шедевра" (Delphi5) c теми дополнениями, о которых речь идет ниже, можно взять (3k)



Ну а теперь несколько более подробно. Для начала посмотрим список методов и свойств TWebBrowser. Здесь следует отличать "обычные" методы и свойства компонентов VCL, и те, которые "отражают" методы соответствующего ActiveX элемента. Первые нас не очень интересуют (если читатель имеет хотя бы небольшой опыт работы с Delphi, то по отношению к чисто VCL-свойствам типа Align , TabOrder ему должно быть все понятно.) Остановимся на второй группе свойств и методов.Их можно разделить на две группы - те, которые "отражают" default-интерфейс (в нашем случае это IWebBrowser2 и те, которые "отражают" нотификационный интерфейс DWebBrowserEvents2 ).

"Cвязку" между методами интерфейсов и методами класса-оболочки делает експерт импорта ActiveX, основываясь на особенностях реализации TOleControl. Проанализируйте исходники TOleControl и TWebBrowser - и Вы увидите эти связки. Это довольно интересное и довольно утомительное занятие ... Лично мне до конца пройти этот путь не хватило терпения - я остановился на той стадии, когда начал более-менее понимать основные принципы интеграции ActiveX в VCL. Для заинтересовавшихся подсказка - обратите в первую очередь внимание на методы TWebBrowser.InitControlData и на TOleControl.GetEventMethod(DispID: TDispID; var Method: TMethod);

Да, вполне возможно, что читатель не знаком с основами СOM, и понятия "интерфейс", "нотификационный интерфейс" ему ни о чем не говорят. Я не знаю, смогу ли я в двух-трех предложениях компенсировать этот пробел. Но все - же попытаюсь. Если читатель ориентируется в COM-технологиях, но следующих несколько абзацев можно пропустить.

Итак, маленькое лирическое отступление в сторону COM

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

Внимательный читатель задаст вопрос - а как же с разделением адресного пространства, ведь довольно часто клиент и объект COM живут в разных процессах, и следовательно их адресные пространства изолированы друг от друга? Как же тогда клиент и объект COM работают с одной таблицей?
Эту проблему решает библиотека поддержки СOM, которая внедряет в адресное пространство клиента и сервера специальные служебные объекты, называемые заместителями (для клиента) и заглушками (для сервера) (здесь под сервером понимается тот процесс, который создал один или несколько экземпляров объектов COM). Таким образом клиент будет взаимодействовать с заглушкой, а сервер с заместителем. Организация взаимодействия между заглушкой и заместителем - проблема библиотеки поддержки COM.
К счастью, вся эта алхимия в большинстве случаев не требует от программиста какого-то либо вмешательства. Я во всяком случае, встречал довольно много программистов, которые активно используют COM-технологии, но понятия не имеют о тех вещах, которых мы вскользь коснулись выше.



Подытоживая, можно сказать, что интерфейс есть спецификация, которая на на уровне бинарного кода "отражается" в таблицу вызовов в памяти.
В СОМ интерфейсы - это все. Для клиента сервер представляет собой набор интерфейсов. Клиент с сервером может взаимодействовать только посредством интерфейсов. Мало того, клиент даже может не знать о всех интерфейсах, поддерживаемых сервером.
Все интерфейсы наследуются от базового интерфейса IUnnknown . Причем, если говорят о наследовании интерфейсов, то понимают не наследование реализации (с ней мы имеем дело, когда работаем в пределах объектной модели хотя бы того же Delphi), а наследование деклараций. Под наследованием деклараций понимается то, что если некий интерфейс IB наследуется от интерфейса IA, то в соответствующей таблице вызовов для интерфейса IB сначала будут идти адреса методов, которые декларируются в IA, а затем адреса методов от IB. Причем списки формальных параметров наследуемых методов не должны быть изменены. Если вспомнить, что интерфейсы есть спецификации, то становится понятным, почему по отношению к ним может идти речь только о наследовании деклараций. Конечно, при реализации конкретного COM-обьекта можно использовать технологию наследования реализации, но это будет внутреннее дело объекта, которое никак не затрагивает клиента.

В завершение разговора об COM, я хотел бы упомянуть о некоторых методах базового интерфейса IUnnknown, так как во первых, эти методы присутствуют в любом интерфейсе (вспомним о наследовании деклараций и о том, что любой интерфейс наследуется от IUnnknown) и во вторых, на использовании этих методов строится вся идеология работы с COM.

Итак, разрешите представить - QueryInterface. С помощью этого интерфейса клиент может определить, поддерживает ли COM-обьектом какой либо другой интерфейс, который известен клиенту, и получить указатель на тот интерфейс, если он поддерживается объектом. При работе с СOM, это пожалуй самый популярный вызов. В Dеlphi он иногда вызывается явно, иногда неявно. Неявный вызов происходит при применении оператора as для интерфейсных ссылок.
Интерфейс IUnnknown также декларирует два метода интерфейса AddRef и Release, которые ответственны за подсчет использования COM-обьекта (одно из требований к COM-обьектам - они должны уметь сами себя уничтожить, если в их услугах более никто не нуждается). Вам вряд ли придется вызывать эти методы напрямую, так как Delphi генерирует их вызовы автоматически.

Сейчас, пожалуй, самое время время взглянуть на mshtml.pas - как видим он почти на 100% состоит из одних деклараций интерфейсов - ведь нам как клиенту важно знать спецификацию. И совсем не обязательно быть в курсе особенностей реализации.

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





И снова об WebBrowser

В нашем случае ActiveX нам предоставляет интерфейс IWebBrowser2 и ожидает от нас, что мы предоставим ему реализацию нотификационного интерфейса DWebBrowserEvents2 . К счастью, всю необходимую работу за нас сделал эксперт импорта ActiveX, "наследовав" TWebBrowser от TOleControl, инкапсулировав при этом IWebBrowser2 посредством соответствующих методов и свойств и реализовав обработчики для каждого метода нотификационного интерфейса.

Перед тем, как продолжить рассказ, хотелось бы обратить Ваше внимание на такой момент. Как Вы знаете, веб-документ может состоять из одного фрейма (более корректно - не иметь фреймов) или состоять из нескольких фреймов. Каждый фрейм - это тот же WebBrowser, который входит в WebBrowse более высокого уровня. WebBrowser самого верхнего уровня и есть тот AxtivX, который инкапсулируется VCL-компонентом TWebBrowser. Он как бы живет все время, пока живет TWebBrowser, тогда как WebBrowser более нижнего уровня могут динамически создаваться и уничтожатся в зависимости от того, делаем мы навигацию к много-фреймовым или к одно-фреймовым документам. Так вот, к методам WebBrowser верхнего уровня мы можем получить доступ как через методы и свойства соответствующего TWebBrowser, так и через соответствующие интерфейсные ссылки. К методам "вложенных" WebBrowser - только через интерфейсные ссылки. Интерфейсную ссылку на WebBrowser верхнего уровня можно получить через свойство TWebBrowser.ControlInterface или через TWebBrowser.DefaultInterface Получить интерфейсные ссылки на WebBrowser нижнего уровня можно посредством простого парсинга или при помощи некоторых обработчиков событий, которые сопровождают процесс навигации (но об этом ниже).

Рассмотрим вкратце сначала основные методы и свойства "от" IWebBrowser2, а затем обработчики "от" DWebBrowserEvents2 .

В первую очередь следует упомянуть метод Navigate. Этот метод дает команду WebBrowser начать навигацию к указанному ресурсу. Синтаксис этого метода следующий:



procedure Navigate( const URL: WideString; var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant; var Headers: OleVariant); overload; Здесь
URL - адресс навигации для значения Flags определены такие константы:
navOpenInNewWindow 1 - открывает URL в новом окне браузера по умолчанию. То есть, в IE. Как заставить открыть URL в новом екземпляре нашего броузера я раскажу ниже при описании обработчика OnNewWindow2
navNoHistory 2 - не заносит адрес в список History.
navNoReadFromCache 4 - не использует сохраненную в кеше страницу, а загружает с сервера.
navNoWriteToCache 8 - не записывает страницу в дисковый кеш.
navAllowAutosearch 16 - если броузер не может найти указанный домен, он передает его в поисковый механизм.
TargetFrameName - определяет целевой фрейм по имени. Если присвоить system.NULL (или имя несуществующего фрейма ) страница просто загрузиться в текущий броузер PostData - определяет данные для передачи на сервер. Headers - определяет HTTP-хидер для передачи на сервер. Пример вызова этого метода для обычной навигации можно посмотреть в примере, ссылка на который была
Для передачи данных можно воспользоваться следующим фрагментом кода, который предложен Hans Gulo:

procedure TForm1.SubmitPostForm; var strPostData: string; Data: Pointer; URL, Flags, TargetFrameName, PostData, Headers: OleVariant; begin { <!-- submit thishtml form:--> <form method="post" action= "http://127.0.0.1/cgi-bin/register.pl"> <input name= "FIRSTNAME" value="Hans"> <input name= "LASTNAME" value="Gulo"> <inputname="NOTE"value="thatsit"> <inputtype="submit"value="thatsit"></form>} strPostData:='FIRSTNAME=Hans&LASTNAME=Gulo&NOTE=thats+it'; PostData := VarArrayCreate([0, Length(strPostData) - 1], varByte); Data := VarArrayLock(PostData); try Move(strPostData[1], Data^, Length(strPostData)); finally VarArrayUnlock(PostData); end; URL := 'http://127.0.0.1/cgi-bin/register.pl'; Flags := EmptyParam; TargetFrameName := EmptyParam; Headers := EmptyParam; // TWebBrowser will see that we are providing // post data and then should automatically fill // this Headers with appropriate value WebBrowser1.Navigate2(URL, Flags, TargetFrameName, PostData, Headers); end;
Важным есть property Busy . Если это свойство активно (равно True), то это свидетельствует о том, что наш АктивИкс еще не закончил загрузки страницы или выполняет некоторую команду. И может быть, что он проигнорирует новую команду. Так что в этом случае лучше подождать, когда это свойство станет равным false (или когда идет загрузка, то остановить ее можно с помощью метода Stop).

Теперь несколько слов о событиях, которые сопровождают процесс загрузки. Они, как отмечалось выше, есть своего "продолжение" соответствующих методов DWebBrowserEvents2 . Наиболее существенными из них есть (они возникают для каждого фрейма): OnBeforeNavigate2 Возникает при попытке начать навигацию. Из параметров наиболее существенным есть pDisp: IDispatch;. Этот параметр определяет броузер, который начинает навигацию. Для многофреймового документа этот броузер может не соответствовать броузеру верхнего уровня. К сожалению, этот обработчик не вызывается при вызове метода Refresh. OnNavigateComplete2 Возникает, когда попытка навигации была успешной. Наблюдение за WebBrowser позволяют сделать предположение, что это событие возникает после того, как с сервера придет первая порция данных. Документ еще продолжает загружаться. OnDocumentComplete Возникает при окончании загрузки в независимости от того, был ли документ загружен полностью или нет. К сожалению нет простого критерия для определения того, была ли страница загружена полностью или нет. Как решить єту проблему я попытаюсь рассказать в следующих статьях этого цикла. OnNewWindow2 Возникает при попытке открыть документ в новом окне. Если Вы хотите, чтобы документ был открыт в Вашем экземпляре броузера, то Вам нужно создать свой экземпляр броузера и параметру ppDisp присвоить интерфейсную ссылку на этот экземпляр:





procedure TFormSimpleWB.WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); var newForm:TFormSimpleWB; begin newForm:=TFormSimpleWB.Create(Application); newForm.Show; ppDisp:=newForm.WebBrowser1.ControlInterface; end;

С остальными методами должно быть более-менее понятно из их названия. Если это не так - можно посмотреть уже упоминаемую статью Александра Лозовюка.

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

Первым делом это TWebBrowser.Document:IDispatch . Через это свойство можно получить доступ к интерфейсу IHtmlDocument2.. Далее через этот интерфейс можно получить доступ к большинству средств по взаимодействию с загруженным документом. То есть это очень интересное и "нужное" свойство. Но немного забегая наперед, скажу, что если Вы попытаетесь использовать TWebBrowser.Document:IDispatch, то Вы рано или поздно заметите довольно странную "утечку" памяти в процессе навигации. В чем же дело? После анализа ситуации, удалось определить, что для любой интерфейсной ссылки на документ, которая получена через этот свойство, счетчик использования "необоснованно" увеличивается на 1 и соответствующий COM-обьект никогда не будет освобожден. При более детальном изучении нашлась и создательница этой проблемы - function TOleControl.GetIDispatchProp(Index: Integer): IDispatch;, через которую и работает TWebBrowser.Document:IDispatch (я речь веду о Delphi5, возможно в Delphi4 все нормально, не проверял). Детальный рассказ об этой ситуации выходит за рамки этой статьи..
К счастью эту проблему легко обойти, использовав для получения IHtmlDocument2 альтернативные возможности, хотя бы WebBrowser1.ControlInterface.Document .

Также хочется упомянуть о property LocationURL: WideString; Как утверждается в вышеупомянутой статье Александра Лозовюка , оно содержит URL ресурса, загруженного в браузер. Того же мнения придерживается и контекстная справка от Delphi5. Мало того - об этом также говорится в - во всяком случае так было на момент написания статьи ...

Но это не совсем так. Дополним наш "шедевр" обработчиком события окончания загрузки документа:

implementation {$R *.DFM} uses mshtml; procedure TFormSimpleWB.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); begin // Caption:=WebBrowser1.LocationURL+' '+ ((pDisp as IWebBrowser).Document as IHtmlDocument2).URL; end;

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

Перед тем как продолжить рассказ я снова вынужден сделать маленькое отступление в сторону COM.

Обратите внимание, как имея в руках интерфейс типа IDispatch от броузера (параметр pDisp), который закончил загрузку документа (это можно подсмотреть в описании события DocumentComplete в MSDN ), мы посредством "as" получаем интерфейс типаbIWebBrowser на тот же объект (здесь имеем неявный вызов QueryInterface). Этот интерфейс при помощи свойства Documentпbозволяет нам получить интерфейс IHtmlDocument2 к загруженому документу. И вот в конце-концов через этот интерфейс мы можем обратится к интересующему нас свойству URL , которое и возвращает адрес того ресурса, который в действительности загружен в браузер (а property LocationURL говорит только о том, что мы броузеру сказали загружать). Да, нам еще не раз придется продиратся через такие дебри интерфейсов, свойств и запросов. И что наиболее печально - MSDN не всегда внятно говорит где и от кого можно запросить интересующий нас интерфейс ... Также на первых порах вызывает недоумение тот факт, почему тот же IWebBrowser.Document есть типа IDispatch, а не хотя бы тот же IHtmlDocument2. Но это довольно легко понять, если вспомнить во первых, что WebBrowser позволяет работать с ним разного рода скриптовым языкам, а во вторых, что интерфейс IDispatch позволяет вызывать свойства и методы по имени (что собственно и делают скриптовые языки). В принципе, мы бы также работать в Delphi с WebBrowser в стиле скриптовых языков, но я сознательно не привожу примеров такого подхода, так как он чреват возникновением разного рода ошибок, которые можно будет обнаружить только во время выполнения (и которые отсеиваются на этапе компиляции при использовании "нормальных" интерфейсов).

Но довольно теории - сделаем маленький эксперимент: запустим "шедевр" на выполнение и дадим команду навигации на заведомо отсутствующий ресурс. И что же мы видим:



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



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

Как уже отмечалось, для документа самого верхнего уровня это сделать довольно просто:

var doc:IHtmlDocument2; ..... if assigned(WebBrowser1.ControlInterface.Document) then WebBrowser1.ControlInterface.Document.QueryInterface(IHtmlDocument2,doc); Хотел бы обратить Ваше внимание на условие "if" - это связано с тем, что если броузер еще не делал навигации, то свойство Document не будет проинициализировано. Также я надеюсь, Вы помните, почему используется конструкция WebBrowser1.ControlInterface.Document а не WebBrowser1.Document

А как же получить доступ к вложенным фреймам?

Это можно сделать как минимум двумя способами Первый: Использовать OnDocumentComplete для получения интерфейса к броузеру каждого фрейма, примерно так, как приводилось выше в примере Второй: Использовать свойства самого IHtmlDocument2 для получения доступа к фреймам. Понятно, что нужно иметь доступ к IHtmlDocument2 самого верхнего уровня. Пример реализации этого подхода:

type TDoerOneDoc = procedure (iDoc:IHtmlDocument2); procedure DoWithFrames(iDoc:IHtmlDocument2; aDoer:TDoerOneDoc); { процедура aDoer будет вызвана для каждого IHtmlDocument2, начиная с главного и для каждого IHtmlDocument2 с любого уровня вложенности фреймов} var frames:IHTMLFramesCollection2; i:integer; ov1:OleVariant; iDisp:IDispatch; IWindow2:IHTMLWindow2; begin if not assigned(aDoer) then Exit; aDoer(iDoc); frames:=iDoc.frames; if not assigned(frames) then exit; if frames.length=0 then exit; for i:=1 to frames.length do begin ov1:=i-1; try iDisp:=frames.item(ov1); iDisp.QueryInterface(IHTMLWindow2,IWindow2); if assigned(IWindow2) then DoWithFrames(IWindow2.document,aDoer); except { ShowMessage('Find error !!!');} end; end; end; Итак, имея в руках IHtmlDocument2 можно приступить и к парсингу ...
Наиболее простой способ для этого - использование метода All интерфейса IHtmlDocument2, который позволяет получить список или всех тегов или только тегов определенного вида. Посмотрим пример для получения списка всех тегов:

procedure TFormSimpleWB.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); var i : integer; iDoc : IHtmlDocument2; iDisp : IDispatch; iElement : IHTMLElement; iInputElement : IHTMLInputElement; S : string; begin Memo1.Clear; iDoc:=(pDisp as IWebBrowser).Document as IHtmlDocument2; for i:=1 to iDoc.All.Get_length do begin iDisp:=iDoc.Get_all.item(pred(i),0); iDisp.QueryInterface(IHTMLElement, iElement); Str(pred(i),S); S:= S+''; if assigned(iElement) then begin S:=S+'tag='+iElement.Get_tagName+' '; iElement.QueryInterface(IHtmlInputElement,iInputElement); if assigned(iInputElement) then begin S:=S+'name='+iInputElement.Get_name; end; Memo1.Lines.Add(S); end; end; end; Как Вы догадались, здесь тип каждого тега заносится в компонент TMemo. Также делается попытка определить, есть ли очередной тег элементом ввода (поддерживает ли он соответствующий интерфейс), и если это так, то делается попытка получить значение специфического для элементов ввода свойства.

Далее посмотрим пример получения списка тегов определенного типа:

procedure TFormSimpleWB.btPutDataClick(Sender: TObject); var iDoc:IHtmlDocument2; i:integer; ov:OleVariant; iDisp: IDispatch; iColl:IHTMLElementCollection; iInputElement:IHTMLInputElement; begin // WebBrowser1.ControlInterface.Document.QueryInterface(IHtmlDocument2,iDoc); if not assigned(iDoc) then begin ShowMessage(' !!!??? Nothing dowloaded ... '); Exit; end; ov:='INPUT'; IDisp:=iDoc.all.tags(ov); if assigned(IDisp) then begin IDisp.QueryInterface(IHTMLElementCollection,iColl); if assigned(iColl) then begin for i:=1 to iColl.Get_length do begin iDisp:=iColl.item(pred(i),0); iDisp.QueryInterface(IHTMLInputElement,iInputElement); if assigned(iInputElement) then begin if iInputElement.Get_name='mn' then iInputElement.Set_value('Ihor'); if iInputElement.Get_name='pw' then iInputElement.Set_value('PASSWORD'); end; end; end; end; end;

В этом примере получаем список тегов типа "INPUT", а потом для некоторых тегов (которые отбираем по имени) делается попытка сделать "ввод данных". Полностью этих два примера (как проект) можно взять (4k).

Ну, для начала пожалуй и хватит. Если у Вас есть вопросы к является рь Осов'як


Использование Interenet-функций Win32® API


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

Internet так сильно вошел в нашу жизнь, что программа, так или иначе не использующая его возможности, обречена на “вымирание” почти как динозавры. Поэтому всех программистов, вне зависимости от квалификации и специализации так и тянет дописать до порой уже готовой программы какой-то модуль для работы с Internet. Но тут и встает вопрос – как это сделать? Давайте рассмотрим, что нам предлагает среда Borland Delphi и Win32 API.

Во-первых, можно использовать компоненты с вкладки FastNet. Все они написаны фирмой NetMasters и поставляются без исходного кода. По многочисленным откликам различных разработчиков можно сказать, что большинство из них не выдерживает никакой критики, особенно “отличились” компоненты для работы с почтой. Большинство проблем можно было бы исправить, но так как исходные тексты закрыты, то это вряд ли удастся. Даже если вы будете использовать такие вроде бы надежные компоненты как TNMHTTP, TNMFTP, то в случае распространения готовой программы перед вами встает проблема: для полноценной работы программа с этими компонентами требует наличия ряда динамических библиотек. Значит, их надо отыскать, потом поставлять вместе с приложением, копировать в системные папки… Короче говоря, все слишком запутано.

Если вам не требуется всей функциональности этих компонент, например, надо только реализовать функции GET или POST протокола HTTP, то можно поискать на сайтах с компонентами, вроде torry.ru – там обязательно сыщется много различных библиотек, по большей части бесплатных, и с исходным кодом.

Но зачем нам что-то использовать, когда есть доступ к Win32 API ? Если приглядеться, то все эти компоненты всего лишь оболочка для вызова функций более низкого порядка. А раз так, то можно сразу их использовать. Кроме полного контроля над реализацией сетевых функций вы будете иметь и более компактный и быстрый код, так как устраняется прослойка между программой и API. Так что же такое Internet- функции Win32 API?

Все Internet- функции разбиты на категории: General Win32 Internet Functions - общие функции. Automatic Dialing Functions – функции для автодозвона. Uniform Resource Locator (URL) Functions – функции для работы с URL. FTP Functions – FTP- функции. Gopher Functions - Gopher- функции. HTTP Functions - HTTP- функции. Cookie Functions – Работа и управление файлами cookie. Persistent URL Cache Functions - работа с офф-лайном и кешем.


Всего функций довольно много, около 80, но для средних приложений большинство из них не понадобится. Рассмотрим, что можно использовать из первой категории.

Из всех функций наибольший практический интерес представляют следующие:

InternetCheckConnection
позволяет узнать, есть ли уже соединение с Internet.

Синтаксис:

function InternetCheckConnection(lpszUrl: PAnsiChar; dwFlags: DWORD; dwReserved: DWORD): BOOL; stdcall; Если нужно проверить, есть ли соединение по конкретному URL, то параметр lpszUrl должен содержать нужный URL; если интересует, есть ли соединение вообще, установите его в nil. DwFlags может иметь значение только FLAG_ICC_FORCE_CONNECTION. Он делает следующее: если первый параметр не nil, то происходит попытка пропинговать указанный хост. Если параметр lpszUrl установлен в nil и есть соединение с другим сервером, то пингуется этот хост. Последнее значение , dwReserved, зарезервировано, и должно быть установлено в 0.

К сожалению, я не проверял эту функцию, когда писал статью... а жаль... вот что получаеться: константа FLAG_ICC_FORCE_CONNECTION вообще не описана в Дельфи. более того - ее нет ни в Microsoft Visual C++ 5 (!!!!), VBasic 5 тоже! едва нашел в C++ Builder 5.
Вот описание - const FLAG_ICC_FORCE_CONNECTION $00000001 Но! Даже с описанной константой ничего не работает так, как надо! Вот пример: procedure TForm1.Button1Click(Sender: TObject); var h:boolean; begin h:= wininet.InternetCheckConnection(nil,$00000001,0); if h = True then Label1.Caption:='Соеденение с сервером 127.0.0.1 установлено.' else if h = false then Label1.Caption:='Соеденения с сервером 127.0.0.1 нет.'; end; Запускаю вместе с сервером - вроде должно пинговать его. Но первый раз функция показывает что соеденение есть несмотря на то, стоит ли сервер, или нет. Потом все время выдает false.
Если кто из читателей может пролить некоторый свет на проблему этой функции, очень прошу написать мне.
Благодарю Суркиза Максима, который впервые обратил мое внимание на проблему.
InternetOpen


Функция возвращает значение TRUE, если компьютер соединен с Internet, и FALSE - в противном случае. Для получения более подробной информации о причинах неудачного выполнения функции вызовите GetLastError, которая возвратит код ошибки. Например, значение ERROR_NOT_CONNECTED информирует нас, что соединение не может быть установлено или компьютер работает в off-line.

Далее рассмотрим одну из самых важных функций. Ее вы будете использовать всякий раз, когда нужно получить доступ к любому из серверов – будь то HTTP, FTP или Gopher. Речь идет о InternetOpen .

Синтаксис:

function InternetOpen(lpszAgent: PChar; dwAccessType: DWORD; lpszProxy, lpszProxyBypass: PChar; dwFlags: DWORD): HINTERNET; stdcall;

Параметры:

lpszAgent – строка символов, которая передается серверу и идентифицирует программное обеспечение, пославшее запрос. dwAccessType - задает необходимые параметры доступа. Принимает следующие значения: INTERNET_OPEN_TYPE_DIRECT – обрабатывает все имена хостов локально. INTERNET_OPEN_TYPE_PRECONFIG – берет установки из реестра. INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY - берет установки из реестра и предотвращает запуск Jscript или Internet Setup (INS) файлов. INTERNET_OPEN_TYPE_PROXY – использование прокси-сервера. В случае неудачи использует INTERNET_OPEN_TYPE_DIRECT. LpszProxy – адрес прокси-сервера. Игнорируется только если параметр dwAccessType отличается от INTERNET_OPEN_TYPE_PROXY. LpszProxyBypass - список имен или IP- адресов, соединяться с которыми нужно в обход прокси-сервера. В списке допускаются шаблоны. Так же, как и предыдущий параметр, не может содержать пустой строки. Если dwAccessType отличен от INTERNET_OPEN_TYPE_PROXY, то значения игнорируются, и параметр можно установить в nil. DwFlags – задает параметры, влияющие на поведение Internet- функций . Возможно применение комбинации из следующих разрешенных значений: INTERNET_FLAG_ASYNC, INTERNET_FLAG_FROM_CACHE, INTERNET_FLAG_OFFLINE. Функция инициализирует использование Internet- функций Win32 API. В принципе, ваше приложение может неоднократно вызывать эту функцию, например, для доступа к различным сервисам, но обычно ее достаточно вызвать один раз. При последующих вызовах других функций возвращаемый указатель HINTERNET должен передаваться им первым. Таким образом, можно дважды вызвать InternetOpen, и, имея два разных указателя HINTERNET, работать с HTTP и FTP параллельно. В случае неудачи, она возвращает nil, и для более детального анализа следует вызвать GetLastError.



Непосредственно с этой функцией связанна и еще одна, не менее важная: InternetCloseHandle.

InternetCloseHandle
Синтаксис:

function InternetCloseHandle(hInet: HINTERNET): BOOL; stdcall; Как единственный параметр, она принимает указатель, полученный функцией InternetOpen, и закрывает указанное соединение. В случае успешного закрытия сессии возвращается TRUE, иначе - FALSE. Если поток блокирует возможность вызова Wininet.dll, то другой поток приложения может вызвать функцию с тем же указателем, чтобы отменить последнюю команду и разблокировать поток.

Мы уже установили соединение и знаем, как его закрыть. Теперь нам нужно соединиться с конкретным сервером, используя нужный протокол. В этом нам помогут следующие функции:
InternetConnect
function InternetConnect (hInet: HINTERNET; lpszServerName: PChar; nServerPort: INTERNET_PORT; lpszUsername: PChar; lpszPassword: PChar; dwService: DWORD; dwFlags: DWORD; dwContext: DWORD): HINTERNET; stdcall; Функция открывает сессию с указанным сервером, используя протокол FTP, HTTP, Gopher. Параметры: HInet – указатель, полученный после вызова InternetOpen. LpszServerName – имя сервера, с которым нужно установить соединение. Может быть как именем хоста – domain.com.ua, так и IP- адресом – 134.123.44.66. NServerPort – указывает на TCP/IP порт, с которым нужно соединиться. Для задания стандартных портов служат константы: NTERNET_DEFAULT_FTP_PORT (port 21), INTERNET_DEFAULT_GOPHER_PORT (port 70), INTERNET_DEFAULT_HTTP_PORT (port 80), INTERNET_DEFAULT_HTTPS_PORT (port 443), INTERNET_DEFAULT_SOCKS_PORT (port 1080), INTERNET_INVALID_PORT_NUMBER – порт по умолчанию для сервиса, описанного в dwService. Стандартные порты для различных сервисов находятся в файле SERVICES в директории Windows. LpszUsername – имя пользователя, желающего установить соединение. Если установлено в nil , то будет использовано имя по умолчанию, но для HTTP это вызовет исключение. LpszPassword – пароль пользователя для доступа к серверу. Если оба значения установить в nil, то будут использованы параметры по умолчанию. DwService – задает сервис, который требуется от сервера. Может принимать значения INTERNET_SERVICE_FTP, INTERNET_SERVICE_GOPHER, INTERNET_SERVICE_HTTP. DwFlags - Задает специфические параметры для соединения. Например, если DwService установлен в INTERNET_SERVICE_FTP, то можно установить в INTERNET_FLAG_PASSIVE для использования пассивного режима. Функция возвращает указатель на установленную сессию или nil в случае невозможности ее установки.



Итак, мы имеем связь с сервером, нужный нам порт открыт. Теперь следует открыть соответствующй файл. Для этого определена функция InternetOpenUrl. Она принимает полный URL файла и возвращает указатель на него. Кстати, перед ее использованием не нужно вызывать InternetConnect.

InternetOpenUrl


Синтаксис:

function InternetOpenUrl(hInet: HINTERNET; lpszUrl: PChar; lpszHeaders: PChar; dwHeadersLength: DWORD; dwFlags: DWORD; dwContext: DWORD): HINTERNET; stdcall;

Параметры:

HInet – указатель, полученный после вызова InternetOpen. LpszUrl – URL , до которого нужно получить доступ. Обязательно должен начинаться с указания протокола, по которому будет происходить соединение. Поддерживаются следующие протоколы - ftp:, gopher:, http:, https:. LpszHeaders – содержит заголовок HTTP запроса. DwHeadersLength – длина заголовка. Если заголовок nil, то можно установить значение –1, и длина будет вычислена автоматически. DwFlags – флаг, задающий дополнительные параметры перед выполнением функции. Вот некоторые его значения: INTERNET_ FLAG_EXISTING_CONNECT, INTERNET_FLAG_HYPERLINK, INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP, INTERNET_FLAG_NO_AUTO_REDIRECT, INTERNET_FLAG_NO_CACHE_WRITE, INTERNET_FLAG_NO_COOKIES. Возвращается значение TRUE, если соединение успешно, или FELSE - в противном случае.

Теперь можно спокойно считывать нужный файл функцией InternetReadFile.

InternetReadFile
Синтаксис:

function InternetReadFile(hFile: HINTERNET; lpBuffer: Pointer; dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall;

Параметры:

HFile – указатель на файл, полученный после вызова функции InternetOpenUrl. LpBuffer – указатель на буфер, куда будут заноситься данные. DwNumberOfBytesToRead - число байт, которое нужно причитать. lpdwNumberOfBytesRead - содержит количество прочитанных байтов. Устанавливается в 0 перед проверкой ошибок. Функция позволяет считывать данные, используя указатель, полученный в результате вызова InternetOpenUrl, FtpOpenFile, GopherOpenFile, или HttpOpenRequest. Так же, как и все остальные функции, возвращает TRUE или FALSE.



После завершения работы функции нужно освободить указатель Hfile, вызвав InternetCloseHandle(hUrlFile) .

Вот, в принципе, и все об самых основных функциях. Для простейшего приложения можно определить примерно такой упрощенный алгоритм использования Internet- функций Win32 API взамен стандартным компонентов. HSession:= InternetOpen - открывает сессию. HConnect:= InternetConnect - устанавливает соединение. hHttpFile:=httpOpenRequest HttpSendRequest - HttpOpenRequest и HttpSendRequest используются вместе для получения доступа к файлу по HTTP- протоколу. Вызов HttpOpenRequest создает указатель и определяет необходимые параметры, а HttpOpenRequest отсылает запрос HTTP серверу, используя эти параметры. function HttpOpenRequest(hConnect: HINTERNET; lpszVerb: PChar; lpszObjectName: PChar; lpszVersion: PChar; lpszReferrer: PChar; lplpszAcceptTypes: PLPSTR; dwFlags: DWORD; dwContext: DWORD): HINTERNET; stdcall; function HttpSendRequest(hRequest: HINTERNET; lpszHeaders: PChar; dwHeadersLength: DWORD; lpOptional: Pointer; dwOptionalLength: DWORD): BOOL; stdcall; HttpQueryInfo – используется для получения информации о файле. Вызывается после вызова HttpOpenRequest. function HttpQueryInfo(hRequest: HINTERNET; dwInfoLevel: DWORD; lpvBuffer: Pointer; var lpdwBufferLength: DWORD; var lpdwReserved: DWORD): BOOL; stdcall; InternetReadFile - считывает нужный файл. InternetCloseHandle(hHttpFile) – освобождает указатель на файл. InternetCloseHandle(hConnect) - освобождает указатель на соединение. InternetCloseHandle(hSession) - освобождает указатель на сессию. Объем статьи не позволяет подробно рассмотреть все множество функций, предоставляемых Win32 API. Это введение показало вам только вершину айсберга, а дальше дело за вами – внутренний мир WinAPI очень богат и большинство из того, что обеспечивают сторонние компоненты, можно отыскать в его недрах.

Удачи вам!


Специально для
апрель 2001 г.
Новое поколение выбирает... MatrixWB -


Использование интерфейсов ComAdmin


В ряде случаев разработчику необходимо проводить операции по управлению MTS автоматически, без участия пользователя. Оказывается, что все это можно сделать с помощью библиотеки COMAdmin_TLB (\system32\Com\comadmin.dll) (Рисунок 2). Кстати и сама утилита Component Services представляет собой лишь интерфейс для управления данной dll.

Как видим, библиотека предоставляет нам три интерфейса: ICOMAdminCatalog, ICatalogCollection, ICatalogObject.
Первый из них позволяет создать экземпляр объекта, который и предоставит нам все те возможности, что реализует утилита Component Services.



Использование компилятора Delphi (dcc32.exe) в прикладных программах


Раздел Подземелье магов й Гурин,
дата публикации 13 сентября 2001г.



Использование кривых Безье


игорьев,
дата публикации 01 декабря 2003г.


Программа Canvas2 предназначена для демонстрации возможностей Windows по рисованию кривых Безье. Программа включает в себя следующие возможности: Рисование "резиновой" линии Безье Аппроксимация кривой Безье ломаной линией Рисование ломаной линии нестандартным стилем Программа также может служить для иллюстрации базовых принципов реализации анимации без мерцания.

При подготовке программы основным источником информации по кривым Безье была книга Фень Юань - СПб.: Питер, 2002

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



Использование пятого "постулата" Дейта.


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

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

Введение в системы баз данных. К.Дж. Дейт

В этой статье я попробую показать один из возможных способов использования метаданных СУБД в одном конкретном случае.

Входные данные: Существует БД, функционирующая на 2-х серверах (Interbase 6.0, Oracle 8), естественно существуют различия в физической реализации, но состав таблиц и полей идентичны. Следует заметить, что при генерации БД для Interbase для описания полей использовались домены (пользовательские типы данных), в то время как для Oracle, не поддерживающего домены, при генерации полей тип данных указывался явно. Ниже представлены два скрипта для одного и того же обьекта БД.

InterBaseOracle
create table KLSTYPE ( ID_KLSTYPE D_PK_DM not null, IDDEP_KLSTYPE D_PK_DM , NAME_KLSTYPE D_NAME_FULL_DM not null, SHORTNAME_KLSTYPE D_NAME_SHORT_DM , TYPE_KLSTYPE D_SMALLINT_DM , constraint PK_KLSTYPE primary key (ID_KLSTYPE) ); create table KLSTYPE ( ID_KLSTYPE VARCHAR(10) not null, IDDEP_KLSTYPE VARCHAR(10) null , NAME_KLSTYPE VARCHAR2(100) not null, SHORTNAME_KLSTYPE VARCHAR2(45) null , TYPE_KLSTYPE number(5,0) null , constraint PK_KLSTYPE primary key (ID_KLSTYPE) )/

Использование доменов для Interbase оказалось достаточно удобным :). Предположим у нас есть домен описывающий Статус обьекта предметной области определенный на интервале -2 до 15. Ниже приведено описание такого домена. create domain D_STATUS_DM as SMALLINT default 0 check (value between -2 and 15); Предположим нам необходимо расширить интервал статусов или вообще снять ограничение на статусы. В случае Interbase команда DDL выглядит достаточно просто: ALTER DOMAIN D_STATUS_DM DROP CONSTRAINT; Для СУБД ORACLE не все так просто, в общем случае нам необходимо просмотреть все таблицы и найти все поля хранящие статусы и сформировать, а затем выполнить соответствующую команду ALTER TABLE ..... Существует альтернативный вариант - использование CASE средств, но к моему великому сожалению, используемый нами Sybase Power Designer 6.0 не умеет требуемого, в последующих версиях 7,8 появилась возможность сравнения физических моделей, но прослеживается нехорошая тенденция вместо генерации скрипта ALTER выполнять полное убиение таблицы и создания новой. Т.е. использование CASE средств не спасает в подобном случае, хотя дает возможность определить обьекты использующие определенные домены.


Теперь хорошие новости: У нас есть информация о том какие таблицы и какие поля используют данный домен в БД Interbase. Нам просто остается найти ее и использовать. Ниже приведен скрипт извлекающий из "словаря данных" Interbase необходимую информацию: SELECT RDB$FIELD_NAME, RDB$RELATION_NAME FROM RDB$RELATION_FIELDS WHERE (RDB$FIELD_SOURCE = 'D_STATUS_DM')

В результате выполнения запроса мы получили список таблиц и полей использующих наш домен D_STATUS_DM. И что дальше? Опять ручная работа? К счастью, нет. (здесь надо сделать следующее замечание: поскольку генерация БД велась с использованием CASE средства, то имена констраинтов для оракла могут быть сформированы из имени таблицы и поля :). т.е. к примеру для таблицы OBJ содержащей поле STATUS_OBJ был сформирован констраинт с именем CKC_STATUS_OBJ_OBJ.). Формируем запрос для удаления старых ограничений на поля использующие наш домен: SELECT 'ALTER TABLE ' trim(RDB$RELATION_NAME) ' DROP constraint ' 'CKC_' trim(RDB$FIELD_NAME) '_' trim(RDB$RELATION_NAME) ' ;' FROM RDB$RELATION_FIELDS WHERE (RDB$FIELD_SOURCE = 'D_STATUS_DM')

Итак результатом нашего запроса является скрипт практически готовый для исполнения. Что же с ним делать? Если вы используете для работы isql.exe вы можете создать файл, к примеру fordropckc.sql, со следующим текстом: set names win1251; CONNECT "myhost:d:\sqlbase\TERRA_new.GDB" user "sysdba" password "masterkey"; SELECT cast('ALTER TABLE ' trim(RDB$RELATION_NAME) ' DROP constraint ' 'CKC_' trim(RDB$FIELD_NAME) '_' trim(RDB$RELATION_NAME) ' ;' as varchar(100)) FROM RDB$RELATION_FIELDS WHERE (RDB$FIELD_SOURCE = 'D_STATUS_DM'); после выполнения данного файла с помощью командной строки "c:\Program Files\Borland\InterBase\bin\isql.exe" -e -s 1 -input fordropckc.sql -output Result.txt -m Мы получим текстовый файл Result.txt из которого можно сравнительно легко (любым текстовым редактором) можно получить необходимый нам скрипт: ALTER TABLE ADMUSERS DROP constraint CKC_STATUS_ADMUSERS_ADMUSERS ; ALTER TABLE OBJ DROP constraint CKC_STATUS_OBJ_OBJ ; ALTER TABLE MTDENT DROP constraint CKC_NEWSTAT_MTDENT_MTDENT ; ........



Если Вы используете какое-нибудь средство администрирования, к примеру IBExpert, то вы можете просто сохранить результат запроса в файл или скопировать его в буфер обмена. Полученный скрипт готов к выполнению.

Аналогичным образом можно сформировать скрипт для создания новый ограничений.

Естественно, данный пример ни в коем случае не может претендовать на полное освещение темы "словарь данных в СУБД", но приведеный пример можно рассматривать как "привычность мысли надо гнать, столовый нож оружьем может стать" :)

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

за CASE средство PowerDesigner 6 за бесплатный IB 6.0 и политику, преведшую к появлению платного IB 6.5, и бесплатного FireBird. Alexander Khvastunov за отличнейшее средство администрирования . Замечания и помидоры принимаются по адресу.

Max Rezanov.
февраль 2002г.


Использование СOM в среде Delphi


Последнее время много внимания уделяется построение систем электронного бизнеса, или как их еще назыают - B2B (business to business). Учитывая рекомендации по построению обменных потоковых систем координирующего интернет-технологий органа - WWW Consortium: акцент сделан в сторону XML-технологий и построение систем обмена XML-документами.

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

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

Во всех системах обмен, как правило, строится по одинаковой схеме, с использованием HTTP запросов. В качестве протокола защиты информации применяется протокол SSL (но это отдельная тема).

Один из возможных вариантов обработки XML сообщения является построение BIN/CGI (ISAPI)-приложений или COM (серверных) компонент, формирующих или обрабатывающих XML-документы.

С одной стороны, приложение выступает в качестве клиента, которое в режиме POST выдает HTTP запрос, с другой стороны, находится WEB сервер на стороне которого осуществляется обработка запроса и выдача ответа. В информационном обмене используются XML-документы.

Один из наиболее эффективных вариантов реализации - использование существующего XML-парсера, поддерживающего DOM модель. Такой парсер является дистрибутивной поставкой Win`98 или составной частью IE 4,7 и выше (для Win`95) и представляет COM сервер, находящийся в библиотеке msxml.dll.

Модель компонентных объектов (COM) - представляет инкапсулированные данные и методы в единую сущность и способ доступа к ним через систему интерфейсов. Средствами Delphi достаточно просто осуществить доступ к классам COM-объекта (в одном COM-сервере может быть включено несколько классов). Доступ к объектам осуществляется путем инициализации экземпляра класса через систему интерфейсов. Описание интерфейсов осуществляется языком определения интерфейсов (IDL), которое возможно осуществить средствами среды автоматически.


Средствами Delphi осуществляется импорт из COM-сервера msxml.dll, строится файлы описания интерфейса IDL и файл бинарноого описания типов библиотеки - TLB. Данная операция осуществляется через системное меню: Project | Type Library Import… (рис 1). Далее появляется диалоговое окно (рис 2), в котором необходимо выбрать COM-объект (в нашем случае объект зарегистрирован под именем "Microsoft.XMLDom (Version 2.0)" ) и создать TLB-файл (кнопка Create Unit). Используя TLB-файл, среда генерирует "паскалевский" файл описания COM-сервера - MSXML_TLB.pas





Рис 1

Рис 2

В файле MSXML_TLB.pas описаны все интерфейсы, константы и соклассы COM-сервера.

Для доступа к объектам COM-элемента, необходимо в директиве USES добавить имя файла описания библиотеки (MSXML_TLB.pas). Ниже представлена простейшая программа, использующая DOM стандартный анализатор msxml.dll, которая загружает XML-документ и отображает его в элементе текстового поля Memo1.

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OleServer, MSXML_TLB, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.DFM} Procedure TForm1.Button1Click(Sender: Tobject); var coDoc : CoDOMDocument; /* объявление сокласса объекта DOMDocument; */ var Doc: IXMLDOMDocument; /* класс, согласованный с интерфейсом IDOMDocument; */ begin Doc := coDoc.Create; /* создание экземпляра объекта DOMDocument; */ Doc.load('data.xml'); /* вызов метода Load экземпляра объекта DOMDocument; */ Memo1.Text:=Doc.xml; /* доступ к свойстве xml экземпляра объекта DOMDocument; */ end; end.

Использование XML в бизнесе.


Для более ясной картины необходимо пояснение, а зачем все это нужно с тем, что бы понять, как это работает…

При построении B2B или корпоративной ERP системы, при организации информационного обмена XML-документами между предприятиями или филиалами пр-я, используются эффективно себя зарекомендовавшая система передачи информации на основе имеющихся WEB серверов по HTTP протоколам.

С одной стороны, приложение выступает в качестве клиента, которое в режиме POST выдает HTTP запрос, с другой стороны, находится WEB сервер, на стороне которого осуществляется обработка запроса и выдача ответа. В качестве обмена используются XML-документы.

Например, в простой корпоративной ERP системе бухгалтерской программе (АСУ Бухучет) необходимо сформировать некий запрос на выписку накладной и передать его в филиал, который имеет склад (АСУ Склад). АРМ Аналогичная постановка задачи при создании В2В системы, когда Предприятие А запрашивает наличие продукции (делает заказ на приобретение) у Поставщика В.

Предприятие А и его программа выступает в качестве клиента. Склад обслуживает Поставщик В, у которого находится складской комплекс БД на SQL сервере. Обмен осуществляется через корпоративный WEB сервер Поставщика В.

Ниже представлен следующий типовой алгоритм обмена:

Рис 3.

Предприятие А инициирует процесс А (заказ продукции), который выступает в качестве WEB-клиента.

Процесс А формирует XML документ (например запрос- накладная) и передает его как POST запрос http на WEB сервер Поставщика В. В качестве URI - используется идентификатор ресурса обрабатывающего приложения. URI может быть одинаковым как для всех типов документов, либо индивидуальным для каждого типа. Все зависит от структуры B2B (WEB) сервера.

WEB сервер анализирует запрос и порождает серверный Процесс В, передавая в качестве параметра тело XML документа.
Процессе В запускается WEB-сервером и обрабатывается либо как ASP страница,CGI (ISAPI) - приложение или JAVA севрлет (серверное приложение)

Процесс В - формирует запрос на SQL-сервер базы данных.

SQL-сервер производит необходимые операции в БД, формирует ответ и возвращает его Процессу В.

По ответу от SQL-сервера Процесс В формирует XML документ (ответ) и возращает его как на ответ на http запрос клиентскому приложению.

Далее, в зависимости от ситуации на стороне клиента формируется либо новый http запрос, либо заканчивается сеанс.



Использование XML в среде Delphi


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

Данная статья является переработанным вариантом материалов по XML-технологии опубликованных на сайте автора



Итак Что же такое GDI+ ?


Не вдаваясь в тонкости сразу скажу что GDI+ на самом деле является динамической библиотекой GdiPlus.dll. в которой реализованы команды и функции по работе с графикой, начиная от рисования линий заканчивая координатными преобразованиями и работой с прозрачностью. Как говорится на любой вкус. Более подробную информацию вы можете просмотреть в статье Виталия Брусенцева (если Вас не смущает реализация на C++)

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

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

Для начала давайте определимся, те кто работает на Windows XP и .NET Server. могут не беспокоится - данная библиотека уже включена в данные операционные системы. Для других увы - придется скачать с официального сервера Microsoft файл gdiplus_dnld.exe (размером чуть более 1 Mb) и при помощи него установить данную библиотеку в системный каталог Windows 98/ME, Windows NT SP6 или Windows 2000. Сразу-же оговорюсь что поддержка Windows 95 не предусмотрена и о ней нет никакого упоминания на сайте Microsoftа. Причем теоретически я могу предположить что данная библиотека может будет работать. Ну еще раз оговорюсь в Windows 95 пробуйте сами.

Итак файл успешно скачан, установлен и предвидя следующий вопрос сразу же говорю для работы с библиотекой вам потребуются заголовочные файлы для Delphi взять свежие можно с или скачать архив Header_pas.zip прилагаемый со статьей.



Итак, поехали!


Создадим подкаталог для объявления функций PGPsdk, скопировав туда файлики DELPHI PGP API - pgp*.pas и spgp*.pas. Удалим в файлах spgp*.pas - "stdcall;export;"(уже полученные в итоге заголовочные файлы можно взять тут [12]). Теперь к Вашему проекту нужно приписать использование библиотек (это там где uses):

uses // PGPsdk pgpEncodePas, pgpOptionList, pgpBase, pgpPubTypes, pgpUtilities, pgpKeys, pgpErrors, // SPGP spgpGlobals, spgpEncrypt, spgpKeyUtil, spgpUtil, spgpKeyMan, spgpPreferences, spgpKeyProp, spgpKeyIO, spgpKeyGen, spgpMisc, spgpUIDialogs, // always last pgpSdk;

Можно использовать только необходимые модули.
Первое что мы попробуем сделать - это зашифровать и подписать произвольный файл и получить зашифрованный в текстовом виде (ASC). Здесь следует отметить что PGPsdk может работать не только с файлами, но и с памятью, а также комбинировать - память - файл, файл - память.

PGPCheckResult ( 'Ошибка при шифровании файла', spgpencodefile( PChar(edtFileIn.Text), PChar(edtFileOut.Text), 1, // Encrypt.Value 1, // Sign.Value kPGPHashAlgorithm_MD5, 0, kPGPCipherAlgorithm_CAST5, 1, 0, 0, 'Steven R. Heller', // Кто может расшифровать 'Evgeny Dadgoff', // Чем подписывать 'MyPassPhrase', // Хех, это пароль '', PChar(edtComment.Text) ) );

Сравним что получится если переделать пример [9,стр. 18] на Delphi - на чистом API.
Лично для меня проще было использовать spgp-модель чем тяжелые PGPAPI вызовы.

Про преференс.

Для работы библиотеке необходимо знать где лежат файлы с ключиками (pubring.prk и secring.prk). PGP API позволяет сохранять свои настройки в файле PGPsdk.dat (почему то он всегда сохраняется в каталоге с виндами). Для работы с этим файлом предназначены следующие функции: spgpgetpreferences(Prefs: pPreferenceRec; Flags: Longint):LongInt; spgpsetpreferences(Prefs: pPreferenceRec; Flags: Longint):LongInt; Соответственно для получения преференса и установки его (кстати ключики могут лежать не только в файлах). Замечу что это не единственный способ – PGP API позволяет напрямую указывать где расположены ключи, но тогда Вам придется отказаться от SPGP, или поправлять SPGP под себя.


Как получить список всех имеющихся ключей

Здесь я покажу как получить список всех ключей - заполнение LVKeys:TListView именами ключей и шестнадцатеричными ID-значениями ключей, используя SPGP-модель.

Var P : TPreferenceRec; Flags : LongInt; outBuf : array [1..30000] of Char; i,KeyCount : Integer; TempStr,StrKeys : AnsiString; Begin LVKeys.Items.Clear; FillChar(P,1024,0); FillChar(outbuf,30000,0); Flags:= PGPPrefsFlag_PublicKeyring or PGPPrefsFlag_PrivateKeyring or PGPPrefsFlag_RandomSeedFile; if(spgpGetPreferences(@P, Flags)<>0) then ShowEvent('Error!',1); // GetWindowsDirectory if(LowerCase(WinDir+'pubring.pkr')=LowerCase(StrPas(P.PublicKeyring)))or not(FileExists(StrPas(P.PublicKeyring))) then Begin StrPCopy(P.PublicKeyring, ExtractFilePath(Application.ExeName)+'KEYS\pubring.pgp'); StrPCopy(P.PrivateKeyring, ExtractFilePath(Application.ExeName)+'KEYS\secring.pgp'); StrPCopy(P.RandomSeedFile, ExtractFilePath(Application.ExeName)+'KEYS\randseed.bin'); if (CreateDir(ExtractFilePath(Application.ExeName)+'KEYS')) Then ShowEvent('Каталог ключей '+ExtractFilePath(Application.ExeName)+'KEYS'+ ' -- не существует, Будет создан заново... ',0); spgpSetPreferences(@P, Flags); //Создать файлы с ключами - такой хитрый прием. spgpSubKeyGenerate('mmmh', 'sssl', 'ssss', 1, 1024, 0, 0, 0, 0); End; btnPubKeys.Caption:=StrPas(P.PublicKeyring); btnSecKeys.Caption:=StrPas(P.PrivateKeyring); btnRndBin.Caption:=StrPas(P.RandomSeedFile); PGPCheckResult('Ошибка при инициализации PGP-SDK, убедитесь что все DLL установленны правильно', Init(FContext, PubKey, false, false)); spgpKeyRingID(@outBuf, 30000); KeyCount:=spgpkeyringcount; StrKeys:=StrPas(@outBuf); for i:=1 to KeyCount do Begin TempStr:=Copy(StrKeys,1,Pos(#13+#10,StrKeys)); Delete(StrKeys,1,Pos(#13+#10,StrKeys)+1); with(LVKeys.Items.Add)do Begin Caption:=Copy(TempStr,14,Length(TempStr)-14); SubItems.Add(TempStr[1]); SubItems.Add(Copy(TempStr,3,10)); End; End; QuitIt(FContext, PubKey); End;

Как достать SQL запрос из *.mdb без MS Access




Вступление.

Я много видел разных стран..., но это для того, чтобы сказать, что я все-таки зауважал корпорацию Microsoft, после подробного знакомства с Линукс-ом. И вот почему. Операционная система Windows - наиболее простая и доступная для пользователей, кто не посвятил свою жизнь компьютеру. Ни в одной коммерческой, а тем более бесплатной, системе нет настолько простых и доступных элементов настройки как в Windows. И это только моя точка зрения. Я не хочу разводить дебаты на эту тему, потому, что хочу рассказать о своих наработках и исследованиях. Они касаются, по моему мнению, одной из лучших и развитых локальных баз данных - Microsoft Jet или mdb. При определенных усилиях можно написать даже неплохую сетевую программу на базе mdb.

Зачем это нужно?

За годы моей работы с mdb (около 6 лет) я один раз столкнулся с ситуацией, когда базу данных Access не удалось восстановить после внезапного отключения питания (Об UPC-ах и речи не было). Да и необходимость восстановления возникала всего раз 5. К тому же, поддержка Jet встроена в Windows, и нет необходимости искать (покупать) и устанавливать драйвер для базы данных. Все остальные форматы более подвержены разрушению, или состоят из множества файлов; при отсутствии одного из этих файлов говорить о целостности данных сложновато. Я готов обсудить этот факт.

О чем речь?

Речь идет о том, что базой данных mdb можно прекрасно пользоваться, не имея MS Office и Access. Все данные, необходимые для хранения и изменения информации можно хранить в mdb базе данных имея Delphi и подключенный ActiveX ADO и ADOX. Все эти компоненты поставляются с Windows, и вам не нужно приобретать MS Office только для того, чтобы сохранять таблицы и запросы к ним (и не только к ним :-) ) в базе данных mdb. Подробную справку по ADO, ADO MD и ADOX можно получить в составе (13379 Kb), хотя я скачал этот пакет только ради документации. Где-то, летом 2002 года я поставил перед собой задачу - может ли простой программист уйти от использования крякнутых программ (мне было бы обидно за свою 2-3-х летнюю работу, если бы ее крякнули ;)) и пользоваться тем, что дают бесплатно, или за доступные деньги. Так что я пришел к выводу – можно. В настоящий момент у меня уже есть довольно приличное приложение (собственной разработки), которое я использую вместо Access. В базе данных mdb понятия запрос и процедура различны, но для простоты изложения я буду использовать термин запрос.

История.


Начал с простого окна, в котором было TMemo - для текста запроса, и кнопка для выполнения этого запроса. CheckBox - для указания, возвращать мне результат запроса, или нет. Второе окно открывалось с DBGrid-ом, в котором был результат выполнения запроса. Третье окно - ListBox, который содержал список таблиц и запросов базы данных (макросы, отчеты и формы Access я не умею доставать и сейчас, даже не знаю где это прячут). По двойному щелчку на элементе списка открывалось все то-же окно с DBGrid-ом, где можно было посмотреть содержимое таблицы или запроса.

Первую базу данных я создал с помощью системного менеджера ODBC - там есть такая возможность! Первые таблицы приходилось создавать с помощью инструкций SQL. Я был приятно удивлен, что Access умеет через SQL такие вещи, которые нигде в справке по Access не описаны. К этим возможностям относится параметр DEFAULT в инструкции CREATE TABLE. В справке к Access о нем нет ни слова! А в справке по InterBase – есть. Я попробовал – очень прекрасно устанавливаются значения по умолчанию для поля создаваемой таблицы. Короче говоря, кто ищет – найдет. Первые запросы и процедуры приходилось сохранять в текстовом виде, чтобы после корректировки удалить из базы данных сохраненный запрос и внести откорректированный. Потом я попытался достать текст запроса из базы данных через ADO – не получилось, не получилось и до сих пор. Пришлось выбрать другой путь. Если это делает Microsoft – почему не могу это делать я?

Так вот, если посмотреть в системные таблицы, то там есть вся необходимая информация (или почти вся). Используя ее можно написать парсер, который будет собирать текст запроса, используя формат записи самой Microsoft. А сохранить потом измененный запрос (помним: или процедуру) с помощь инструкции CREATE VIEW или CREATE PROCEDURE.

Формат хранения SQL запроса в Access.
Сразу оговорюсь, что все это возможно только с правами администратора на базу данных (Еще один плюс в пользу Access).

Ниже привожу таблицу с описанием всего, что мне удалось раскопать по этому поводу. Используя эту информацию, я написал парсер, который собирает это все в текст запроса. Я не претендую на полноту изложения, потому, что еще не полностью разобрал эту информацию, но возможно это поможет кому-то. Буду рад помощи, если кто что-то знает по этой теме. По крайней мере процентов 70 запросов расшифровываются и выполняются так как было задумано.

Соглашения по обозначениям: Если что-то не описано – я не разбирался – не было необходимости, или не наводило на мысль. Знаки ????? обозначают, что я очень сомневаюсь в правильности описанной информации. Пустые ячейки — в моей практике не встречалось. [Что-то] – обобщенный тип значения, например если в поле встречается только 1 или 2 или 3 – я пишу Integer, даже если тип поля – текстовый. < N > - переменная или значение. ... - часть запроса не критичная для описания. (для наглядности). Описание курсивом – то, что понадобится для разбора запроса. 1. Внешний вид записи таблицы MSysObjects (все объекты базы данных).
Connect Database DateCreate DateUpdate Flags ForeignName Id Lv LvExtra LvModule LvProp Name Owner ParentId RmtInfoLong RmtInfoShort Type
01.10.2003 16:43:35 16.10.2003 15:26:43 0 447 (Blob) (Blob) (Blob) (Blob) r_Cash (VarBytes) 251658241 (Blob) (VarBytes) 1
Где: DateCreate – дата и время создания объекта. DateUpdate – дата и время последнего изменения объекта. Flags – не изучалось. ForeignName – имя во внешней базе данных для связанных таблиц. Id – уникальный код объекта в базе данных. Name – имя объекта. (Многие объекты в таблице не являются хранилищами данных, и найти их в базе данных или через Access нельзя.) Type – тип объекта (1-таблица, 3-контейнер, 5-запрос,8-внешний индекс и.т.д.)



Из этой таблицы мне пригодились всего два параметра – Id и Name. Имя запроса мне известно, а все записи в другой системной таблице, относящиеся к этому запросу я нахожу при помощи поля Id.

2.Внешний вид записей, относящихся к одному запросу в таблице MSysQueries (в ней хранится структура всех запросов и процедур).
Attribute Expression Flag LvExtra Name1 Name2 ObjectId Order
0 0 -2147483636 (VARBYTES)
255 -2147483636 (VARBYTES)
5 Staff_list -2147483636 (VARBYTES)
5 Personal -2147483636 (VARBYTES)
6 [Staff_list].[P_code] 0 -2147483636 (VARBYTES)
6 [Staff_list].[Name] 0 -2147483636 (VARBYTES)
6 [Staff_list].[Br] 0 -2147483636 (VARBYTES)
6 [Staff_list].[Room] 0 -2147483636 (VARBYTES)
6 [Personal].[Fam] 0 -2147483636 (VARBYTES)
7 [Staff_list].[Room]=[Personal].[Room] 2 Staff_list Personal -2147483636 (VARBYTES)
7 [Staff_list].[Br]=[Personal].[Br] 2 Staff_list Personal -2147483636 (VARBYTES)
7 [Staff_list].[P_code]=[Personal].[P_code] 2 Staff_list Personal -2147483636 (VARBYTES)
Хотя в Access и не делается различие между запросом и процедурой, на самом деле оно есть в ADO. Запросом считается простой запрос SQL без параметров, который называется VIEW. Все запросы на изменение структуры таблиц, запросы с параметрами, запросы на объединение и пр... считаются процедурами и выбираютя из базы данных как views или procedures соответственно. Запросы сохраняются в базу данных соответственно с помощью CREATE VIEW, а процедуры – CREATE PROCEDURE. Если вы добавили в запрос параметры, он преобразовался в процедуру, и обратно сохранять его нужно уже с помощью CREATE PROCEDURE. Да, и перед сохранением измененного запроса не забывайте удалять из базы предыдущий – DROP VIEW или DROP PROCEDURE . Кстати запрос (view) удаляется и инструкцией DROP TABLE, однако я бы не рекомендовал ею пользоваться, потому что ошибка в имени, или невнимательность – и вы удалите вместо запроса таблицу. С помощью DROP VIEW таблицу удалить нельзя. Этот вариант более безопасен. С помощью DROP VIEW можно удалить процедуру, но, опять же лучше пользоваться предназначенной инструкцией – по крайней мере вы будете четко понимать, что делаете.

3. Описание полей и их значений относящихся к запросу (процедуре).
Формат хранения запросов в Access (MsysQueries) Значение ObjectID и имя запроса находится в таблице MsysObjects
ПолеЗначениеОписаниеСубПолеЗначениеОписание
Attribute0 Разделитель запросовObjectID[LongInt]Этот же ID содержится во всех остальных записях, относящихся к этому запросу
255 Пустая запись (я не встречал ее заполненой) Идет после Attribute 0 всегда
1Тип запроса, определяется полем Flag. Присутствует не всегда. Если запись отсутствует, то это (скорее всего, да других вариантов и не встречалось) запрос SELECT Flag1SELECT ... FROM
2INSERT ... INTO
3UPDATE ... SET
4UPDATE ... SELECT
5DELETE
6TRANSFORM
7MODIFY, CREATE TABLE, DROP
8
9UNION
10
11EXECUTE
Expression[Text]Параметры для Execute
[Text]Текст процедуры для Flag=7
Name1[Text]Имя процедуры для Execute
2Параметры запроса Flag1Bit (boolean по Delphi)
2Byte (Tinyint)
3Short (SmallInt)
4Integer
5Currency
6Real
7Float
8TdateTime
9
10String([LvExtra]) (Char..., Text...)
11Image !!!
12
13
14
15UNIQUEIDENTIFIER
16Decimal
LvExtra[Integer]Длина параметра для [String] и т. д. где имеет смысл
Запись с аттрибутом 3 я так и не разобрал, это только ход моих размышлений.
3Предикаты (Скорее всего битовое поле) ????? Flag0,1ALL
2DISTINCT
3SELECT DISTINCT *
4WITH OWNERACCESS OPTION
5Выборка *
8DISTINCT ROW ???
16TOP <N> Поле Name1 - <N>
48TOP <N> PERCENT Поле Name1 - <N>
4Внешняя база данныхName1[Text]Путь к внешней базе данных ( IN )
5Исходные таблицы или текст отдельного блока для UNION Expression[Text]Для UNION содержит в каждой строке текст блока UNION SELECT
Для SELECTName1[Text]Имя таблицы для выборки
Для SELECTName2[Text]Алиас таблицы
6Имя поля секции SELECT Expression[Text]Имя поля
Name1[Text]Алиас поля {<Expression> as <Name1>}
7Конструкция и тип объединения JOIN Expression[Text]<Поле1>{ = | <> | > | < }<Поле2>
Flag1INNER JOIN
2LEFT JOIN
3RIGHT JOIN
Name1[Text]Имя или алиас Таблицы1
Name2[Text]Имя или алиас Таблицы2
8Секция WHERE[Expression][Text]Условие WHERE полностью
9Секция GROUP BY[Expression][Text]Условие GROUP BY полностью
10Секция HAVING[Expression][Text]Условие HAVING полностью
11Секция ORDER BY[Expression][Text]Условие ORDER BY полностью
Используя эту информацию можно вытащить и собрать текст запроса из базы данных Access. Если кто знает другой способ, всегда рад помощи, да и сам готов помочь или поделиться знаниями. Создание такого парсера – довольно хорошая возможность разобраться с SQL. Напрмер я не прорабатывал варианты, когда в инструкции SQL используются нестандартные функции, и как в Access это все будет сохранено, я не знаю. Эта статья – не техническая документация, а попытка поделиться опытом.

Всем удачи!

Шкут Александр (AlexS.)
25 декабря 2003г.
Специально для


Как работает программа


Программа использует компонент Graph, о котором я рассказывал в прошлой статье.

Примечание:
Материал раздела

Сейчас я несколько улучшил этот компонент. Плюс, в нем появилось две новых функции: function ReflectData(BaseBitmap, DataBitmap: TBitmap; List: TStrings; Reflection: TReflectionProc; ScatterType: TScatterType; Factor: Integer = 1): TReflectionResult; virtual; function AssemblyData(BaseBitmap, DataBitmap: TBitmap; Assembling: TAssemblingProc): Boolean; virtual; Первая функция создает изображение, содержащее информацию; вторая - получает информацию из двух изображений, как я рассказывал выше. Параметры функции ReflectData: BaseBitmap - Базовое изображение, на его основе создается изображение, содержащее информацию DataBitmap - Изображение, содержащее информацию Reflection - Процедура, которая изменяет соответствующий байт исходного изображения и формирует DataBitmap Эта процедура отвечает за сохранение информации во второй картинке. Но о ней - чуть позже. ScatterType - Тип распределения информации Может принимать два значения: stGiven и stEvenly По умолчанию в программе установлено значение stEvenly. Это означает, что вся информация будет равномерно распределена по всей картинке. Если так, то задавать значение следующего параметра Factor не нужно. Если ScatterType установить в stGiven, то распределение информации зависит от коэффициента распределения. Factor - Коэффициент распределения. Если параметр ScatterType равен stGiven, то фактически Factor означает через сколько байт то начала картинки (не совсем от начала - первые восемь байт идут на длину записываемого текста и на этот коэффициент) будет вписан следующий код символа текста. В программе этот коэффициент задается в компоненте TEdit. Теперь несколько слов о используемой функции Reflection. Эту функцию я вынес в библиотеку. Эта библиотека является специфическим ключем, паролем для соединения двух картинок. В нее могут быть заложены самые разные методы шифрования, в данный же момент использзуется самый примитивный: при шифровании код очередного символа просто прибавляется к значению из картинки BaseBitmap, при расшифровке - наооборот. Эта процедура имеет тип: TReflectionProc = procedure(var Value: Byte; Text: string; Index: Integer); Параметры функции Reflection: Value - Величина из BaseBitmap. Именно это значение шифруется. Text - Текст в виде единой строки. Index - Текущий символ в тексте, который должен быть зашифрован. В эой программе код этого символа складывается с параметром Value при зашифровке. В процедуре AsseblyData происходит обратный процесс, выделение данных на основе двух изображений. Параметры функции AsseblyData: BaseBitmap - Базовое изображение DataBitmap - Изображение, содержащее информацию Assembling - Процедура, формирующая текстовые данные Процедура Assembling имеет следующий тип: TAssemblingProc = procedure(BaseValue, DataValue: Byte); Ее параметры: BaseValue - Текущая величина из BaseBitmap DataValue - Текущая величина из DestBitmap В этой программе каждое значение символа высчитывается путем вычитания DataValue из BaseValue.



Как работать с программой


Для того, чтобы создать "слепок" существующего рисунка, нужно: Загрузить текстовый файл (секция text, кнопка Open) Загрузить понравившиеся рисунки (секция Picture, кнопка Open, можно загружать несколько раз, загруженные ранее картинки не пропадут) Выделить нужный рисунок в компоненте TGraphGrid При желании, отмасштабировать его (кнопка Resize, масштабирует рисунок в соответствии с его пропорциями) Нажать на кнопку Reflect. Через несколько секунд (это если картинка большая, а так - через несколько миллисекунд) в компоненте TGraphGrid появится сгенерированное изображение, созданное на основе выбраной картинки и текстового файла. Новая картинка будет иметь имя "Data". Сохранить при необходимости нужный файл изображения, выбрав его в компоненте TDrawGrid и нажав на кнопку Save. Для того, чтобы получить текст из двух одинаковых (на первый взгляд) картинок, нужно: Загрузить картинку, на основе которой был сделан "слепок" Нажать на кнопку Assembly. При этом появится диалоговое окно загрузки изображения и на этот раз Вам надо будет выбрать файл "слепка", т.е. измененную картинку. Далее, через некоторое время (в зависимости от количества данных, содержащихся в картинке и размера самой картинки) в компоненте TRichEdit появится этот самый закодированный текст.



Команды и функции Script Language.


Основные команды и функции в компоненте реализованы с префиксом "PM_"
Например // Установить текущую страницу публикации procedure PM_Page(const nPages : Integer); virtual; // Получить текущуу страницу в публикации Function PM_GetPageNumber : TPageNumber; virtual; // Получить количество страниц Function PM_GetPages : Integer; virtual; В компоненте я постарался сохранить синтаксис команд Script Language т.е команде Page Script Language соответствует PM_Page компонента. Да и еще более детальную информацию по Script Language можно прочитать в Slguide.hlp. Это позволит вам написать функции и процедуры не реализованные в этом компоненте, а может и создать свой.

Вот в принципе то и все. Удачи вам.

P.S. Хочу напоследок заметить что данный компонент не претендует на завершенность и полную функциональность , многое в нем реализовано не очень хорошо , но учитывая что он был создан для обкатки в короткие сроки то для основ работы он подойдет.Так что критика приниматься не будет.

Скачать: (662 K) (1.2 M)



Компонент для XML сериализации


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

Содержание

Объединяя сказанное о , объектов и соберем полноценный компонент для XML сериализации.

Компонент конвертирует компонент в XML и обратно в соответствии с published-интерфейсом класса компонента. XML формируется в виде пар тегов с вложенными в них значениями. Атрибуты у тегов отсутствуют. Тег верхнего уровня соответствует классу объекта. Вложенные теги соответствуют именам свойств. Для элементов коллекций контейнерный тег соответствует имени класса. Вложенность тегов не ограничена и полностью повторяет published интерфейс класса заданного объекта. Поддерживаются целые типы, типы с плавающей точкой, перечисления, наборы, строки, символы. вариантные типы, классовые типы, стоковые списки и коллекции. Интерфейс: procedure Serialize(Component: TObject; Stream: TStream); - Сериализация объекта в XML procedure DeSerialize(Component: TObject; Stream: TStream); - Загрузка XML в объект property GenerateFormattedXML - создавать форматированный XML код property ExcludeEmptyValues - пропускать пустые значения свойств property ExcludeDefaultValues - пропускать значения по умолчанию property StrongConformity - необходимо наличие в XML соотв. тегов для всех классовых типов property OnGetXMLHeader - позволяет указать свой XML заголовок Ограничения: В объекте допустимо использовать только одну коллекцию каждого типа. Для преодоления этого ограничения требуется некоторая доработка. Наследники класса TStrings не могут иметь published свойств. Процедурные типы не обрабатываются. Для генерации DTD у объекта все свойства классовых типов, одноименные со свойствами агрегированных объектов, должны быть одного класса. Предусловия: Объект для (де)сериализации должен быть создан до вызова процедуры. При StrongConformity == true необходимо присутствие в загружаемом XML тегов для всех классовых типов. Присутствие остальных тегов не проверяется. Дополнительно: При загрузке из XML содержимое коллекций в объекте не очищается, что позволяет дозагружать данные из множества источников в один объект.


unit glXMLSerializer; { Globus Delphi VCL Extensions Library glXMLSerializer Unit 08.2001 component TglXMLSerializer 1.2 Chudin Andrey, avchudin@yandex.ru =================================================================== } interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, comctrls, TypInfo; type TOnGetXMLHeader = procedure (Sender: TObject; var Value: string) of object; XMLSerializerException = class(Exception) end; TglXMLSerializer = class(TComponent) private Buffer: PChar; BufferLength: DWORD; TokenPtr: PChar; OutStream: TStream; FOnGetXMLHeader: TOnGetXMLHeader; FGenerateFormattedXML: boolean; FExcludeEmptyValues: boolean; FExcludeDefaultValues: boolean; FReplaceReservedSymbols: boolean; FStrongConformity: boolean; procedure (Expr: boolean; const Message: string); procedure (Value: string); { Private declarations } protected procedure (Component: TObject; Level: integer = 1); procedure (Component: TObject; const ComponentTagName: string; ParentBlockEnd: PChar = nil); procedure (Component: TObject; DTDList: TStrings; Stream: TStream; const ComponentTagName: string); procedure (Component: TObject; PropInfo: PPropInfo; Value, ValueEnd: PChar; ParentBlockEnd: PChar); public tickCounter, tickCount: DWORD; constructor Create(AOwner: TComponent); override; { Сериализация объекта в XML } procedure (Component: TObject; Stream: TStream); { Загрузка XML в объект } procedure (Component: TObject; Stream: TStream); { Генерация DTD } procedure (Component: TObject; Stream: TStream); published property GenerateFormattedXML: boolean read FGenerateFormattedXML write FGenerateFormattedXML default true; property ExcludeEmptyValues: boolean read FExcludeEmptyValues write FExcludeEmptyValues; property ExcludeDefaultValues: boolean read FExcludeDefaultValues write FExcludeDefaultValues; property ReplaceReservedSymbols: boolean read FReplaceReservedSymbols write FReplaceReservedSymbols; property StrongConformity: boolean read FStrongConformity write FStrongConformity default true; property OnGetXMLHeader: TOnGetXMLHeader read FOnGetXMLHeader write FOnGetXMLHeader; end; procedure ; implementation uses dsgnintf, glUtils; const ORDINAL_TYPES = [tkInteger, tkChar, tkEnumeration, tkSet]; TAB: string = #9; CR: string = #13#10; procedure Register; begin RegisterComponents('Gl Components', [TglXMLSerializer]); end; constructor TglXMLSerializer.Create(AOwner: TComponent); begin inherited; //...defaults FGenerateFormattedXML := true; FStrongConformity := true; end; { пишет строку в выходящий поток. Исп-ся при сериализации } procedure TglXMLSerializer.WriteOutStream(Value: string); begin OutStream.Write(Pchar(Value)[0], Length(Value)); end; { Конвертирует компонент в XML-код в соответствии с published интерфейсом класса объекта. Вход: Component - компонент для конвертации Выход: текст XML в поток Stream } procedure TglXMLSerializer.Serialize(Component: TObject; Stream: TStream); var Result: string; begin TAB := IIF(GenerateFormattedXML, #9, ''); CR := IIF(GenerateFormattedXML, #13#10, ''); Result := ''; { Получение XML заголовка } if Assigned(OnGetXMLHeader) then OnGetXMLHeader(self, Result); OutStream := Stream; WriteOutStream( PChar(CR + '') ); SerializeInternal(Component); WriteOutStream( PChar(CR + '</' + Component.ClassName + '>') ); end; { Внутренняя процедура конвертации объекта в XML Вызывается из: Serialize() Вход: Component - компонент для конвертации Level - уровень вложенности тега для форматирования результата Выход: строка XML в выходной поток через метод WriteOutStream() } 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; { Добавляет открывающий тег с заданным именем } 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; begin // Result := ''; { 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]; { Хочет ли свойство, чтобы его сохранили ? } if not IsStoredProp(Component, PropInfo) then continue; case PropTypeInf^.Kind of tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkWChar, tkLString, tkWString, tkVariant: begin { Получение значения свойства } sPropValue := GetPropValue(Component, PropName, true); { Проверяем на пустое значение и значение по умолчанию } if ExcludeEmptyValues and (sPropValue = '') then continue; if ExcludeDefaultValues and (PropTypeInf^.Kind in ORDINAL_TYPES) and (sPropValue = IntToStr(PropInfo.Default)) then continue; { Замена спецсимволов } if FReplaceReservedSymbols then begin sPropValue := StringReplace(sPropValue, '', '%gt;', [rfReplaceAll]); sPropValue := StringReplace(sPropValue, '&', '%', [rfReplaceAll]); end; { Перевод в XML } addOpenTag(PropName); addValue(sPropValue); { Добавляем значение свойства в результат } addCloseTag(PropName); end; tkClass: { Для классовых типов рекурсивная обработка } begin addOpenTag(PropName); PropObject := GetObjectProp(Component, PropInfo); if Assigned(PropObject)then begin { Для дочерних свойств-классов - рекурсивный вызов } if (PropObject is TPersistent) then SerializeInternal(PropObject, Level); { Индивидуальный подход к некоторым классам } if (PropObject is TStrings) then { Текстовые списки } begin WriteOutStream(TStrings(PropObject).CommaText); end else if (PropObject is TCollection) then { Коллекции } begin 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; end; end; finally FreeMem(PropList, NumProps*sizeof(pointer)); end; end; { Загружает в компонент данные из потока с XML-кодом. Вход: Component - компонент для конвертации Stream - источник загрузки XML Предусловия: Объект Component должен быть создан до вызова процедуры } procedure TglXMLSerializer.DeSerialize(Component: TObject; Stream: TStream); begin GetMem(Buffer, Stream.Size); try { Получаем данные из потока } Stream.Read(Buffer[0], Stream.Size + 1); { Устанавливаем текущий указатель чтения данных } TokenPtr := Buffer; BufferLength := Stream.Size-1; { Вызываем загрузчик } DeSerializeInternal(Component, Component.ClassName); finally FreeMem(Buffer); end; end; { Рекурсивная процедура загрузки объекта их текстового буфера с XML Вызывается из: Serialize() Вход: Component - компонент для конвертации ComponentTagName - имя XML тега объекта ParentBlockEnd - указатель на конец XML описания родительского тега } procedure TglXMLSerializer.DeSerializeInternal(Component: TObject; const ComponentTagName: string; ParentBlockEnd: PChar = nil); var BlockStart, BlockEnd, TagStart, TagEnd: PChar; TagName, TagValue, TagValueEnd: 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 CompareStr(PropList^[i]^.Name, TagName) = 0 then begin Result := i; break; end; end; procedure SkipSpaces(var TagEnd: PChar); begin while TagEnd[0] do inc(TagEnd); 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; 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(''), BufferLength); { Если тег не найден и его наличие необязательно, то не обрабатываем его } if (BlockStart = nil)and not StrongConformity then exit; { иначе проверяем его присутствие } check(BlockStart <> nil, 'Открывающий тег не найден: ' + ''); inc(BlockStart, length(ComponentTagName) + 2); { ищем закрывающий тег } BlockEnd := StrPosExt(BlockStart, PChar('</' + ComponentTagName + '>'), BufferLength); check(BlockEnd <> nil, 'Закрывающий тег не найден: ' + ''); { проверка на вхождение закр. тега в родительский тег } check((ParentBlockEnd = nil)or(BlockEnd < ParentBlockEnd), 'Закрывающий тег не найден: ' + ''); TagEnd := BlockStart; SkipSpaces(TagEnd); { XML парсер } while TagEnd < BlockEnd do begin { быстрый поиск угловых скобок } asm mov CL, '' @@2: inc EDX mov AL, byte[EDX] cmp AL, CL jne @@2 mov TagEnd, EDX end; GetMem(TagName, TagEnd - TagStart + 1); try { TagName - имя тега } StrLCopy(TagName, TagStart + 1, TagEnd - TagStart - 1); { TagEnd - закрывающий тег } TagEnd := StrPosExt(TagEnd, PChar('</' + TagName + '>'), BufferLength); TokenPtr := TagStart; inc(TagStart, length('</' + TagName + '>')-1); TagValue := TagStart; TagValueEnd := TagEnd; { поиск свойства, соответствующего тегу } PropIndex := FindProperty(TagName); check(PropIndex <> -1, 'TglXMLSerializer.DeSerializeInternal: Uncknown property: ' + TagName); SetPropertyValue(Component, PropList^[PropIndex], TagValue, TagValueEnd, BlockEnd); inc(TagEnd, length('</' + TagName + '>')); SkipSpaces(TagEnd); finally FreeMem(TagName); end; end; finally FreeMem(PropList, NumProps*sizeof(pointer)); end; end; { Процедура инициализации свойства объекта Вызывается из: DeSerializeInternal() Вход: Component - инициализируемый объект PropInfo - информация о типе для устанавливаемого свойства Value - значение свойства ParentBlockEnd - указатель на конец XML описания родительского тега Используется для рекурсии } procedure TglXMLSerializer.SetPropertyValue(Component: TObject; PropInfo: PPropInfo; Value, ValueEnd: PChar; ParentBlockEnd: PChar); var PropTypeInf: PTypeInfo; PropObject: TObject; CollectionItem: TCollectionItem; sValue: string; charTmp: char; begin PropTypeInf := PropInfo.PropType^; case PropTypeInf^.Kind of tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkWChar, tkLString, tkWString, tkVariant: begin { имитируем zero terminated string } charTmp := ValueEnd[0]; ValueEnd[0] := #0; sValue := StrPas(Value); ValueEnd[0] := charTmp; { Замена спецсимволов. Актуально только для XML, сохраненного с помощью этого компонента } if FReplaceReservedSymbols then begin sValue := StringReplace(sValue, '%lt;', '', [rfReplaceAll]); sValue := StringReplace(sValue, '%', '&', [rfReplaceAll]); end; { Для корректного преобразования парсером 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 { Текстовые списки } begin charTmp := ValueEnd[0]; ValueEnd[0] := #0; sValue := StrPas(Value); ValueEnd[0] := charTmp; TStrings(PropObject).CommaText := sValue; end else if (PropObject is TCollection) then { Коллекции } begin while true do { Заранее не известно число элементов в коллекции } begin CollectionItem := (PropObject as TCollection).Add; try DeSerializeInternal(CollectionItem, CollectionItem.ClassName, ParentBlockEnd); except { Исключение, если очередной элемент не найден } CollectionItem.Free; break; end; end; end else { Для остальных классов - рекурсивная обработка } DeSerializeInternal(PropObject, PropInfo^.Name, ParentBlockEnd); end; end; end; end; { Процедура генерации DTD для заданного объекта в соответствии с published интерфейсом его класса. Вход: Component - объект Выход: текст DTD в поток Stream } procedure TglXMLSerializer.GenerateDTD(Component: TObject; Stream: TStream); var DTDList: TStringList; begin DTDList := TStringList.Create; try GenerateDTDInternal(Component, DTDList, Stream, Component.ClassName); finally DTDList.Free; end; end; { Внутренняя рекурсивная процедура генерации DTD для заданного объекта. Вход: Component - объект DTDList - список уже определенных элементов DTD для предотвращения повторений. Выход: текст DTD в поток Stream } procedure TglXMLSerializer.GenerateDTDInternal(Component: TObject; DTDList: TStrings; Stream: TStream; const ComponentTagName: string); var PropInfo: PPropInfo; TypeInf, PropTypeInf: PTypeInfo; TypeData: PTypeData; i: integer; AName, PropName, 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 := '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; procedure TglXMLSerializer.check(Expr: boolean; const Message: string); begin if not Expr then raise XMLSerializerException.Create('XMLSerializerException'#13#10#13#10 + Message); end; end. Загрузить последнюю версию библиотеки GlobusLib с исходными текстами можно на странице .


Компонента TAskExceptionHandler


После «перетаскивания» компоненты на главную форму приложения она перехватывает стандартный обработчик исключительных ситуаций и подменяет его своим. При возникновении ИС во время выполнения программы формируется новая запись в LOG-файле, содержащая следующую информацию: ИС Тип Строку сообщения Возможную дополнительную информацию; например, для BDE: BDE Message BDE Category BDE ErrorCode BDE SubCode BDE NativeError Координаты возникновения ИС: Форма (класс и наименование) Компонента (класс и наименование) Версию программы Состояние системы: Общий и доступный объём виртуальной памяти Общий и доступный объём файла подкачки Общий и доступный объём на диске С: Файл журнала имеет имя, соответствующее имени приложения, и расширение LOG. Формат INI выбран как наиболее лёгкий для реализации и ручного просмотра структурированный формат, хотя ничто не мешает использовать, например, XML. Функцию регистрации информации об ИС LogExceptionState можно расширять с целью отобразить максимально полную информацию для каждого типа ИС.

Компонента имеет 2 свойства: DisplayMessage: показывать ли сообщение при возникновении ИС; по умолчанию – true DaysInJournal: как долго должна храниться информация в журнале; по умолчанию – 15 дней. Более давние записи будут удаляться.



Концепция DOM - объектная модель документа


Каждый XML документ представляется в виде набора множества объектов (классов), с помощью которых возможен доступ к отдельным элементам (полям объекта). DOM - интерфейс описывает доступ как к простым объектам типа DOMString или CharacterData, так и к частям или отдельным элементам XML документа: DOMFragmentElement, DOMNode, DOMElement.

Ниже приведены самые важные свойства и методы объектов XMLDOMDocument, XMLDOMNode, XMLDOMNodeList. Необходимо отметить, что представленные ниже методы и функции объектов DOM модели (Document Object Model) используются Microsoft XML-анализатором msxml.dll и несколько шире, чем утвержденная W3C Консорциумом DOM модель.

Более полное описание интерфейса DOM объектов можно найти на www.msdn.microsoft.com/xml

Объект XMLDOMDocument
Представляет верхний уровень объектной иерархии и содержит методы для работы с документом: его загрузки, анализа, создания в нем элементов, атрибутов, комментариев и т.д. .
Свойства
Async Свойство идентифицирующее текущий режим обработки
ParseError Возвращает ссылку на объект обработки ошибки XMLDOMParseError
validateOnParse Включение - выключение верификации документа.
url Возвращает URL документа
documentElement Содержит ссылку на корневой элемент документа в виде объекта XMLDOMElement.
Методы
load(url)
loadXML(xmlString)
Загружает XML документ,
save(objTarget) Сохраняет XML документ в файле
abort Прерывание процесса загрузки и обработки документа.
createAttribute (name) Создает для текущего элемента новый атрибут с указанным именем.
createNode(Type, name, nameSpaceURI) Создает узел указанного типа и названия
createElement(tagName) Создает элемент документа с указанным названием.
createTextNode(data) Создает текст внутри документа
getElementsByTagName(tagname) Возвращает ссылку на коллекцию элементов документа с заданным именем
nodeFromID(idString) Поиск элемента по идентификатору

Объект XMLDOMNode
Объект XMLDOMNode, реализующий базовый DOM интерфейс Node , предназначен для манипулирования с отдельным узлом дерева документа. Его свойства и методы позволяют получать и изменять полную информацию о текущем узле - его тип, название, полное название, его содержимое, список дочерних элементов и т.д.
Свойства
nodeName, baseName Возвращает название текущего узла.
prefix Возвращает Namespace префикс.
dataType Определяет тип содержимого текущего узла
nodeType, nodeTypeString Возвращает тип текущего узла:
attributes Возвращает список атрибутов текущего узла в виде коллекции XMLDOMNamedNodeMap.
text Возвращает содержимое текущего поддерева в виде текста
xml Возвращает XML-представление текущего поддерева.
nodeValue Возвращает содержимое текущего узла.
childNodes Возвращает список дочерних элементов в виде XMLDOMNodeList.
firstChild, lastChild Возвращает первый/последний дочерний элемент
previousSibling ,nextSibling Возвращает предыдущий /следующий сестринский элемент.
parentNode Содержит ссылку на родительский элемент.
ownerDocument Возвращает указатель на документ, в котором находится текущий узел.
Методы
appendChild(newChild) Добавляет текущему узлу новый дочерний элемент.
insertBefore(newChild, refChild) Вставляет дочерний узел, располагая его в текущем поддереве "левее" узла, указанного параметром refChild.
cloneNode (deep) Создание копии текущего элемента.
getAttribute (name)
getAttributeNode (name)
setAttribute(name, value)
setAttributeNode(XMLDOMAttribute)
Доступ к атрибутам (создание, чтение, запись) объекта. Name - имя аттрибута, value - его значение. Возращает значение объект XMLDOMAttribute.
replaceChild(newChild, oldChild) removeChild(oldChild) Замена объекта oldChild текущего списка дочерних объектов на newChild. Удаление объекта oldChild
selectNodes(patternString) selectSingleNode(patternString) Возвращает объект XMLDOMNodeList, выбранное по шаблону поиска или первый узел
transformNode(stylesheet)
transformNodeToObject(stylesheet, outputObject)
Назначает стилевую таблицу для поддерева текущего узла и возвращает строку - результат обработки. В качестве параметра передается ссылка на объект DOMDocument, в котором находятся XSL инструкции.

Объект XMLDOMNodeList
Представляет собой список узлов - поддеревья и содержит методы, при помощи которых можно организовать процедуру обхода дерева.
length число элементов списка узлов
item(i) Выбор i-того элемента из списка. Возвращает объект XMLDOMNode
nextNode() Выбор следующего элемента в списке.



Контрольные суммы и CRC.


й Парунов,
дата публикации 18 февраля 2003г.


Недавно возникла у меня тут потребность в контроле блоков информации. В памяти сразу всплыла магическая фраза "CRC". Вроде эта CRC бывает и 16-, и 32-битной (да хоть 512-битной, но это, пожалуй, перебор). И есть понятие "контрольная сумма". Вот об этом и поговорим, не углубляясь в теорию, а упирая на практическое применение.

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

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

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

Контроль данных - вопрос древний и проработанный. Есть два основных его варианта: Контрольная пломба… ой, сумма. Байты (слова, двойные слова…) просто складываются, складываются по модулю 2, вычитаются в различных комбинациях. Например, складываем все байты (а лучше слова или вообще двойные слова) блока и получаем хэш. Этот метод исторически первый и самый быстрый. CRC. Менее быстрый (раз в шесть в случае 32 бит на Intel32), но более хаотичный метод. "Хаотичный" он потому, что при его вычислении применяется не только сложение, но и сдвиги регистров, что даёт возможность данному биту блока повлиять не на один-два-три бита хэша, а на многие, и очень быстро, таким образом, что для предсказания этого не существует математического аппарата - можно только поставить эксперимент.


А теперь скажем Основную Истину: теоретическая вероятность того, что Вам во Вселенной встретится блок с таким же хэшем, как у вашего блока, равна единице, делённой на два в степени числа разрядов хэша, независимо от того, каким из этих двух способов он посчитан (но: контрольная сумма должна считаться из порций блока того же размера. Нельзя надеяться, что надёжность 32-битной суммы _байтов_, а не двойных слов, будет приемлемой.). Это достаточно очевидно. Однако на практике встречаются различные вариации и искажения блоков: одиночные, групповые, периодические, умышленно искажённые… это уже не полностью случайные блоки. И именно на этом оселке выявляются достоинства и недостатки упомянутых способов.

Итак, если сравнивать достоверность опознания, учитывая именно искажения исходного сообщения, особенно периодические и умышленные, CRC даёт фору контрольным суммам. Например, если поменять буквы в строке, побайтная контрольная сумма этого "не заметит" - от перестановки мест слагаемых, вычитаемых, xor-ящихся данных результат не меняется. То же будет, если поменять местами два бита на расстоянии, кратном размеру байта - собственно, это одно и то же - или прирастить одну букву и уменьшить другую в случае сложения. Есть более сложные варианты контрольных сумм, но все они страдают предсказуемостью и "обходимостью".

С другой стороны, встречаются области применения, где имеются только случайные, "размазанные" (не кусочные) искажения. Особенно часто это бывает в линиях связи. В таких областях для контроля ошибок часто используются именно контрольные суммы благодаря низким затратам. Кроме того, если иметь в виду заточенность CRC под регулярные искажения, можно сказать, что искажения нерегулярные она отлавливает несколько хуже - общая-то эффективность определяется только разрядностью.

А вот для борьбы с людьми :)… вернее, для уверенной верификации информации, защищённой от изменения, применяется CRC. Это не означает, что CRC только борется с мошенничеством - это означает, что два ПОХОЖИХ блока, что часто встречается в жизни людей, CRC обработает лучше, "случайнее", с меньшей вероятностью получения одинаковых хэшей. И сообщение, защищённое CRC32, "подделать" так, чтобы не превратить сообщение в подозрительную кучу байтов (а CRC64 - и без этого условия при длине сообщения больше десятка байт), и сейчас, и в обозримой перспективе невозможно. Разумеется, хэш должен идти по защищённому каналу, иначе следует обратиться к алгоритмам необратимого шифрования, которые тут не обсуждаются, замечу лишь, что они существенно медленнее.

Приведу два модуля для вычисления CRC32 и CRC64. Последний вдвое медленнее. Алгоритм не обсуждается - обсуждать без теории там нечего: с одной стороны, всё просто, с другой - а почему так, а не иначе?.. Неразрешимое противоречие. Желающим овладеть теорией кину линки:

Лирическое отступление:
многие программисты полагают, что переписывание кода на ассемблере способно существенно улучшить скорость. В общем случае это действительно так, но не стоит забывать, что "одна голова хорошо, а две лучше". Современные компиляторы, в том числе и Delphi, знают ассемблер существенно лучше среднего выпускника вуза компьютерной специальности :), и знать ассемблер сейчас нужно, в основном, только чтобы представлять, какой код создаётся из Ваших исходников, поднимая при желании именно их скорость, а не заниматься этим "врукопашную".
Что и показано моим модулем для CRC32 - он в полтора раза быстрее ассемблерного кода й Парунов
февраль 2003г,
Специально для

Смотрите по теме:

Коротко об XSL


Абревиатура XSL происходит от eXtensible Stylesheet Language - язык форматирования таблиц стилей (XML данных). Как понятно из заголовка eXtensible Stylesheet Language (XSL) используется для форматирования XML данных. По определению W3C XSL состоит из двух частей:

XSLT - XSL Transformation. Язык, используемый для преобразования или форматирования (трансформирования) XML документов. Таким образом, при помощи XSLT мы можем получить разные разрезы множества данных и формы представления данных.

Элементы форматирования. К этим элементам относятся все элементы типографического оформления данных, после их обработки их при помощи XSL. Используется только для формирования HTML страниц.

При помощи XSLT мы можем отобрать нужные нам данные из XML файла, и оформить их в виде для предоставления пользователю. Например, в нашем случае мы преобразовали XML данные в виде SQL запроса. Классическое применение XSL - это, как правило форматирование данных в виде HTML страниц или более редкое представление в виде RTF файлов.

XSL файл описывает шаблон (template), согласно которому будет совершаться преобразование XML данных. Возращаясь к xsl-шаблонам, в XSLT можно выделить следующие элементы (директивы):

XSL-директивы описание
xsl:apply-templates Директива, указывающая на применение соответствующих шаблонов аттрибуту select="имя шаблона"
xsl:attribute создает дерево аттрибутов и добавляет его в выходной элемент, пареметр name="имя аттрибута", namespace - URI на пространство имен (преффикс пространства имен)
xsl:call-template вызывает шаблон, аттрибуту name=" URI на шаблон"
xsl:choose
xsl:when
xsl:otherwise
осуществление выбора по условию xsl:when expr="вычисление выражения на script ",
language="language-name"
test= "вычисляемое выражение"
xsl:comment генерирует комментарий в выходной документ
xsl:copy
xsl:copy-of
копирует текущей узел в выходной источник или вставляет фрагмент документа в узел, где аттрибут select="имя узла источника"
xsl:element создает выходной элемент по имени, аттрибут name="имя элемента", namespace="uri сслылка на пространство имен"
xsl:for-each повторно применяет шаблон ко всем узлам списка узлов, аттрибут select задает список узлов
xsl:if проверка условия, задается аттрибутом test в виде выражения
xsl:include включает внешний шаблон, аттрибут href = "URI reference"
xsl:output специфицирует выходной результат, аттрибут method может иметь значения "xml", "html" или "text"
xsl:param специфицирует значение параметров, аттрибут name="имя параметра", select = "значание"
xsl:processing-instruction создает инструкцию обработки, аттрибут name="имя процесс инструкции"
xsl:sort сортирует множество узлов, аттрибуты select = "имя узла", data-type = тип данных {"text" | "number" | Qname}, order = направление сортировки {"ascending" | "descending"}
xsl:stylesheet определяет документ xsl-шаблонов, является корневым элементом для XSLT
xsl:template определяет xsl-шаблон, аттрибут name= " URI преффикс на имя шиблона", match= "указание на узел, к которому применяется шаблон"
xsl:text генерирует текст в выходной поток, аттрибут disable-output-escaping = "yes" или "no", указывает на возможность генерации символов ESC
xsl:value-of вставляет значение выбранного узла как текст, аттрибут select= "указатель на узел" из которого берут значение
xsl:variable специфицирует значение границ переменных, аттрибут name = "имя переменной", select = "вычисление значения переменной"
xsl:with-param применяет параметр к шаблону, аттрибут name ="имя параметра", select = выражение для вычисления текущего контекста, значениие по умолчанию "."



Круг рассматриваемых вопросов


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

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

Материал проиллюстрирован исходными текстами на Borland C++ Builder 6.0; однако все опубликованные идеи справедливы (и применимы с минимальной адаптацией) для любого языка/среды разработки.



L1_dfm


object TbDlgFr: TTbDlgFr

Left = 321

Top = 248

BorderIcons = [biMaximize]

BorderStyle = bsDialog

Caption = 'Новая таблица БД'

ClientHeight = 118

ClientWidth = 392

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

Position = poScreenCenter

OnActivate = FormActivate

OnCreate = FormCreate

PixelsPerInch = 96

TextHeight = 13

object FldNameLbl: TLabel

Left = 4

Top = 7

Width = 80

Height = 13

Caption = 'Имя таблицы'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object FldCaptionLbl: TLabel

Left = 4

Top = 50

Width = 89

Height = 13

Caption = 'Наименование'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object FldDescrLbl: TLabel

Left = 4

Top = 71

Width = 59

Height = 13

Caption = 'Описание'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object Label1: TLabel

Left = 4

Top = 28

Width = 63

Height = 13

Caption = 'Категория'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object TbNameEdit: TEdit

Left = 101

Top = 3

Width = 121

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 0

Text = 'TbNameEdit'

OnKeyPress = TbNameEditKeyPress

OnKeyUp = TbNameEditKeyUp

end

object TbCaptionEdit: TEdit

Left = 100

Top = 46

Width = 201

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False


TabOrder = 2

Text = 'TbCaptionEdit'

OnKeyPress = TbNameEditKeyPress

OnKeyUp = TbNameEditKeyUp

end

object TbDescrEdit: TEdit

Left = 100

Top = 67

Width = 290

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 3

Text = 'TbDescrEdit'

OnKeyPress = TbNameEditKeyPress

OnKeyUp = TbNameEditKeyUp

end

object OkBtn: TButton

Left = 123

Top = 92

Width = 75

Height = 21

Caption = 'Ok'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 4

OnClick = OkBtnClick

end

object CancelBtn: TButton

Left = 203

Top = 92

Width = 75

Height = 21

Caption = 'Отмена'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 5

OnClick = CancelBtnClick

end

object TbDbTypeComboBox: TComboBox

Left = 100

Top = 24

Width = 201

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ItemHeight = 13

ParentFont = False

TabOrder = 1

Text = 'Категория информации'

end

end


L1_pas


unit F_TbDlg;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Db, DBTables, DbItf, Buttons, DbItfT;

type

TTbDlgFr = class (TForm)

TbNameEdit: TEdit;

TbCaptionEdit: TEdit;

TbDescrEdit: TEdit;

OkBtn: TButton;

CancelBtn: TButton;

TbDbTypeComboBox: TComboBox;

Label1: TLabel;

procedure CancelBtnClick(Sender: TObject);

procedure OkBtnClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure TbNameEditKeyPress(Sender: TObject; var Key: Char);

procedure TbNameEditKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

private

FDbInterface : TDbInterface;

FpTInfoCategory : pTInfoCategory;

procedure Set_FDbInterface(const Value: TDbInterface);

Function Init : Bool;

procedure Set_FpTInfoCategory(const Value: pTInfoCategory);

public

function Execute : Bool;

Property ppTInfoCategory : pTInfoCategory read FpTInfoCategory

write Set_FpTInfoCategory;

published

Property DbInterface : TDbInterface read FDbInterface

write Set_FDbInterface;

end;

Var

TbDlgFr : TTbDlgFr;

implementation

uses F_TbDef;

{$R *.DFM}

{ TTbDlgFr }

function TTbDlgFr.Execute: Bool;

Var

k : Integer;

wpTInfoCategory : pTInfoCategory;

begin

k := TbDbTypeComboBox.ItemIndex;

// При приеме данных от пользователя - добавить префикс

wpTInfoCategory := pTInfoCategory(TbDbTypeComboBox.Items.Objects[k]);

FDbInterface.N_pTTableInfo.sTableAttr.Values['sTableName'] :=

wpTInfoCategory.sPrefix + TbNameEdit.Text;

FDbInterface.N_pTTableInfo.sTableAttr.Values['sTableAccess'] := '';

FDbInterface.N_pTTableInfo.sTableAttr.Values['sTableCaption'] := TbCaptionEdit.Text;

FDbInterface.N_pTTableInfo.sTableAttr.Values['sTableDescr'] := TbDescrEdit.Text;

Result := True;

end;

procedure TTbDlgFr.CancelBtnClick(Sender: TObject);

begin

Close;

end;

procedure TTbDlgFr.OkBtnClick(Sender: TObject);

Var

wTableName : String;

begin

// В имя таблицы нужно добавить префикс категории информации


wTableName := FpTInfoCategory.sPrefix + TbNameEdit.Text;

// Создание буферного экземпляра структуры таблицы

// с добавлением ссылки в список ссылочных типов

FDbInterface.Init_NpTTableInfo(wTableName, True);

if not Execute then

Exit;

if TbDefFr = nil then

TbDefFr := TTbDefFr.Create(nil);

try

TbDefFr.DbInterface := FDbInterface;

TbDefFr.ppTTableInfo := FDbInterface.N_pTTableInfo;

TbDefFr.ppTInfoCategory := FpTInfoCategory;

TbDefFr.ShowModal;

// Если таблица не была все же создана..

if not TbDefFr.Execute then

// ..освобождение ресурсов из-под FN_pTTableInfo

begin

// Единичный акт создания таблицы сопровождается обновлением

// списков типов данных системы

FDbInterface.Kill_NpTTableInfo(True);

end;

finally

TbDefFr.Free;

TbDefFr := nil;

end;

Close;

end;

procedure TTbDlgFr.Set_FDbInterface(const Value: TDbInterface);

begin

FDbInterface := Value;

end;

procedure TTbDlgFr.FormCreate(Sender: TObject);

Var

k : Integer;

begin

FpTInfoCategory := nil;

for k := 0 to ComponentCount - 1 do

if TComponent(Components[k]) is TEdit then

TEdit(Components[k]).Clear;

end;

procedure TTbDlgFr.Set_FpTInfoCategory(const Value: pTInfoCategory);

begin

FpTInfoCategory := Value;

end;

Function TTbDlgFr.Init : Bool;

begin

Result := False;

if FDbInterface = nil then

Exit;

// Список категорий информации

TbDbTypeComboBox.Items.Clear;

TbDbTypeComboBox.Items.Assign(FDbInterface.FbDbTypeList);

TbDbTypeComboBox.Sorted := True;

// Если на входе категорию информации на задали - выбрать первую

if FpTInfoCategory = nil then

begin

TbDbTypeComboBox.ItemIndex := 0;

FpTInfoCategory := pTInfoCategory(TbDbTypeComboBox.Items.Objects[0]);

end

else

TbDbTypeComboBox.ItemIndex :=

TbDbTypeComboBox.Items.IndexOfObject(TObject(FpTInfoCategory));

Result := True;

end;

procedure TTbDlgFr.FormActivate(Sender: TObject);

Var

wFullTbName, wS,

wCategPrefix, s : String;

kICateg,

kPrefixL, k : Integer;

wpTInfoCategory : pTInfoCategory;

begin

Init;

kPrefixL := Length(FpTInfoCategory.sPrefix);



wS := TbNameEdit.Text;

// Если название таблицы оказалось не заданным - предлагаем его

if Trim(wS) = '' then

begin { Имя таблицы не задано }

wFullTbName := FDbInterface.Get_UniqueTableName(apDbType);

// Выделяем из wFullTbName префикс для категории информации

wCategPrefix := Copy(wFullTbName, 1, kPrefixL);

// Предварительно ставим неопределенную категорию информфации

wpTInfoCategory := nil;

for k:=0 to FDbInterface.InfoCategoryList.Count-1 do

begin

wpTInfoCategory := pTInfoCategory(FDbInterface.InfoCategoryList[k]);

if wpTInfoCategory.sEnumName = 'icNoCateg' then

Break

else

wpTInfoCategory := nil;

end;

wS := wpTInfoCategory.sInfoDescr;

TbDbTypeComboBox.ItemIndex := TbDbTypeComboBox.Items.IndexOf(wS);

for kICateg := 0 to FDbInterface.InfoCategoryList.Count-1 do

begin

if pTInfoCategory(FDbInterface.InfoCategoryList[kICateg]) = nil then

Continue;

if pTInfoCategory(FDbInterface.InfoCategoryList[kICateg]).sPrefix =

wCategPrefix then

begin

s := pTInfoCategory(FDbInterface.InfoCategoryList[kICateg]).sInfoDescr;

TbDbTypeComboBox.ItemIndex := TbDbTypeComboBox.Items.IndexOf(s);

Break;

end;

end;

{ Заполняем поля информацией по умолчанию }

{ Пользователю префикс не показываем }

System.Delete(wFullTbName, 1, kPrefixL);

TbNameEdit.Text := wFullTbName;

TbCaptionEdit.Text := wFullTbName;

TbDescrEdit.Text := 'Таблица БД ' + wFullTbName;

end;

end;

procedure TTbDlgFr.TbNameEditKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

FindNextControl(Sender as TWinControl, True, True, True).SetFocus;

end;

procedure TTbDlgFr.TbNameEditKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key = VK_UP then

FindNextControl(Sender as TWinControl, False, True, True).SetFocus

else if Key = VK_DOWN then

FindNextControl(Sender as TWinControl, True, True, True).SetFocus;

end;

end.


L2_dfm


object FldDlgFr: TFldDlgFr

Left = 301

Top = 184

BorderIcons = []

BorderStyle = bsDialog

Caption = 'Новый реквизит (поле БД)'

ClientHeight = 116

ClientWidth = 457

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

Position = poScreenCenter

OnActivate = FormActivate

OnCreate = FormCreate

PixelsPerInch = 96

TextHeight = 13

object FldNameLbl: TLabel

Left = 4

Top = 7

Width = 94

Height = 13

Caption = 'Идентификатор'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object FldCaptionLbl: TLabel

Left = 4

Top = 28

Width = 89

Height = 13

Caption = 'Наименование'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object FldDescrLbl: TLabel

Left = 4

Top = 49

Width = 59

Height = 13

Caption = 'Описание'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object FldDataTypeLbl: TLabel

Left = 4

Top = 70

Width = 70

Height = 13

Caption = 'Тип данных'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object Label5: TLabel

Left = 372

Top = 70

Width = 46

Height = 13

Caption = 'Размер'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

Visible = False

end

object Label1: TLabel

Left = 299

Top = 7

Width = 89

Height = 13

Caption = 'Группа данных'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object FldNameEdit: TEdit


Left = 100

Top = 3

Width = 190

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = ' MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 0

Text = 'FldNameEdit'

OnKeyUp = FldNameEditKeyUp

end

object FldCaptionEdit: TEdit

Left = 100

Top = 24

Width = 190

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 1

Text = 'FldCaptionEdit'

OnKeyUp = FldNameEditKeyUp

end

object FldDescrEdit: TEdit

Left = 100

Top = 45

Width = 354

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 2

Text = 'FldDescrEdit'

OnKeyUp = FldNameEditKeyUp

end

object OkBtn: TButton

Left = 147

Top = 92

Width = 75

Height = 20

Caption = 'Ok'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 4

OnClick = OkBtnClick

end

object CancelBtn: TButton

Left = 227

Top = 92

Width = 75

Height = 20

Caption = 'Отмена'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 5

OnClick = CancelBtnClick

end

object FldSizeEdit: TEdit

Left = 419

Top = 66

Width = 35

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 3

Text = 'FldSizeEdit'

Visible = False

OnKeyPress = FldSizeEditKeyPress

end

object TypeGroupCmBox: TComboBox

Left = 299

Top = 24

Width = 155

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ItemHeight = 13

ParentFont = False

TabOrder = 6

Text = 'Группа данных'

OnChange = TypeGroupCmBoxChange

end

object TypesComboBox: TComboBox

Left = 100

Top = 66

Width = 262

Height = 21

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ItemHeight = 13

ParentFont = False

TabOrder = 7

Text = 'TypesComboBox'

OnClick = TypesComboBoxClick

OnKeyPress = TypesComboBoxKeyPress

end

end


L2_pas


unit F_FldDlg;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, DbItf, Db, DbTables, Clipper, TypInfo, MnT, Buttons, DbItfT,

Globs;

Type

TFldDlgFr = class (TForm)

FldNameLbl: TLabel;

FldCaptionLbl: TLabel;

FldDescrLbl: TLabel;

FldDataTypeLbl: TLabel;

Label5: TLabel;

FldNameEdit: TEdit;

FldCaptionEdit: TEdit;

FldDescrEdit: TEdit;

OkBtn: TButton;

CancelBtn: TButton;

FldSizeEdit: TEdit;

TypeGroupCmBox: TComboBox;

TypesComboBox: TComboBox;

Label1: TLabel;

Procedure FormCreate(Sender: TObject);

Procedure CancelBtnClick(Sender: TObject);

Procedure FormActivate(Sender: TObject);

Procedure OkBtnClick(Sender: TObject);

Procedure FldNameEditKeyUp(Sender: TObject; Var Key: Word;

Shift: TShiftState);

procedure TypeGroupCmBoxChange(Sender: TObject);

procedure TypesComboBoxKeyPress(Sender: TObject; var Key: Char);

procedure TypesComboBoxClick(Sender: TObject);

procedure FldSizeEditKeyPress(Sender: TObject; var Key: Char);

private

FModalRes : Boolean;

FpTFbCommonType : pTFbCommonType;

FTFbTypeGroup : TFbTypeGroup;

FTFieldType : TFieldType;

FDbInterface : TDbInterface;

procedure SetTypeGroupLayout(ffTFbTypeGroup: TFbTypeGroup);

procedure Set_FDbInterface(const Value: TDbInterface);

public

Function Execute : Bool;

published

Property DbInterface : TDbInterface read FDbInterface write Set_FDbInterface;

end;

Var

FldDlgFr: TFldDlgFr;

implementation

uses F_TbDef;

{$R *.DFM}

procedure TFldDlgFr.Set_FDbInterface(const Value: TDbInterface);

Var

wTFbTypeGroup : TFbTypeGroup;

begin

FDbInterface := Value;

// Настройка списка групп данных

TypeGroupCmBox.Items.Clear;

for wTFbTypeGroup := Low(TFbTypeGroup) to High(TFbTypeGroup) do

TypeGroupCmBox.Items.AddObject(apTypeGroupNames[wTFbTypeGroup],

TObject(wTFbTypeGroup));

// Выбираем первую группу в списке групп данных

TypeGroupCmBox.ItemIndex := 0;

wTFbTypeGroup := TFbTypeGroup(TypeGroupCmBox.Items.Objects[0]);

// Заполнить универсальный список списком выбранного комб. типа


UpdateFieldTypesN(FDbInterface, TypesComboBox, wTFbTypeGroup);

SetTypeGroupLayout(wTFbTypeGroup);

FpTFbCommonType := nil; // с этого начинаем конкретную работу

end;

Procedure TFldDlgFr.FormCreate(Sender: TObject);

Var

k : Integer;

begin

for k:=0 to ComponentCount-1 do

if TComponent(Components[k]) is TEdit then

TEdit(Components[k]).Clear;

TypesComboBox.Text := '';

FldSizeEdit.Text := '10';

end;

Procedure TFldDlgFr.CancelBtnClick(Sender: TObject);

begin

FModalRes := False;

Close;

end;

Procedure TFldDlgFr.FormActivate(Sender: TObject);

Var

k, i : Integer;

wpTTableInfo : pTTableInfo;

wspTFieldInfo : pTFieldInfo;

wpTFbCommonType : pTFbCommonType;

wTFbTypeGroup : TFbTypeGroup;

wCaptionUnique : Boolean;

wFieldDescr : String;

begin

if FDbInterface = nil then

begin

FbKernelWarning('FDbInterface = nil');

Exit;

end;

if TypesComboBox.Text = '' then

TypesComboBox.Text := 'Тип данных';

if FDbInterface.N_pTFieldInfo = nil then

Exit;

{ В дальнейшем все действия - только с FpTFbCommonType }

FldNameEdit.Text := FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'];

if TrimF(FldNameEdit.Text) <> '' then

begin

FldDescrEdit.Text := FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldDescr'];

FldCaptionEdit.Text := FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldCaption'];

FldSizeEdit.Text := IntToStr(FDbInterface.N_pTFieldInfo.sFieldSize);

end

else

// Если имя поля оказалось не заданным - предлагаем его

begin

if TbDefFr = nil then

FldNameEdit.Text := FDbInterface.Get_UniqueFieldName(

FDbInterface.Current_pTTableInfo, nil, wCaptionUnique, wFieldDescr)

else

FldNameEdit.Text := FDbInterface.Get_UniqueFieldName(

FDbInterface.Current_pTTableInfo, TbDefFr.TbFieldsListBox.Items,

wCaptionUnique, wFieldDescr);

if TrimF(FldCaptionEdit.Text) = '' then

FldCaptionEdit.Text := FldNameEdit.Text;

if TrimF(FldDescrEdit.Text) = '' then

FldDescrEdit.Text := wFieldDescr;

end;

{ Выставка индекса в ComboBox в соответствии с типом поля }



wpTFbCommonType := nil;

{ Определение группы данных по информации в FDbInterface.N_pTFieldInfo }

wTFbTypeGroup := Get_TFbTypeGroup(FDbInterface.N_pTFieldInfo);

k := TypeGroupCmBox.Items.IndexOf(apTypeGroupNames[wTFbTypeGroup]);

TypeGroupCmBox.ItemIndex := k;

case wTFbTypeGroup of

FldGroup :

// Выставка в ComboBox индекса базового типа

begin

TypesComboBox.Text := 'Нет в СИСТЕМЕ ';

for i := 0 to TypesComboBox.Items.Count-1 do

begin

wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[i]);

if wpTFbCommonType.FbFld.sType = FDbInterface.N_pTFieldInfo.sFieldType then

begin

TypesComboBox.ItemIndex := i;

TypesComboBox.Text := TypesComboBox.Items[i];

Break;

end

end;

if wpTFbCommonType <> nil then

FldSizeEdit.Visible := (wpTFbCommonType.FbFld.sType = ftString)

else

FldSizeEdit.Visible := False;

end;

RefGroup :

// Выставка в ComboBox индекса ссылочного типа

begin

TypesComboBox.Text := 'Ссылка на таблицу не найдена';

for i:=0 to TypesComboBox.Items.Count-1 do

begin

wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[i]);

if wpTFbCommonType.FbRef.spTableInfo.sTableAttr.Values['sTableName'] =

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] then

begin

TypesComboBox.ItemIndex := i;

TypesComboBox.Text := TypesComboBox.Items[i];

Break;

end;

end;

end;

PicGroup :

// Выставка в ComboBox индекса списочного типа

begin

TypesComboBox.Text := 'Ссылка на список не найдена';

for i:=0 to TypesComboBox.Items.Count-1 do

begin

wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[i]);

if wpTFbCommonType.FbPic.sDescr =

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] then

begin

TypesComboBox.ItemIndex := i;

TypesComboBox.Text := TypesComboBox.Items[i];

Break;

end;

end;

end;

LUpGroup :

// Выставка в ComboBox индекса следящего типа

begin

TypesComboBox.Text := 'Ссылка на поле не найдена';

for i:=0 to TypesComboBox.Items.Count-1 do

begin

wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[i]);



wpTTableInfo := wpTFbCommonType.FbLUp.spTableInfo;

if wpTTableInfo = nil then

Continue;

if wpTTableInfo.sTableAttr.Values['sTableName'] <>

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] then

Continue;

wspTFieldInfo := wpTFbCommonType.FbLUp.spFieldInfo;

if wspTFieldInfo.sFieldAttr.Values['sFieldName'] <>

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] then

Continue;

TypesComboBox.ItemIndex := i;

TypesComboBox.Text := TypesComboBox.Items[i];

Break;

end;

end;

NoGroup :

begin

end;

end;

end;

Procedure TFldDlgFr.OkBtnClick(Sender: TObject);

Var

k : Integer;

wErrorStr : String;

begin

if not AllCharsLatinic(FldNameEdit.Text) then

begin

Application.MessageBox('Допускаются только латинские буквы',

' Ошибка в идентификаторе поля', MB_OK);

FldNameEdit.SetFocus;

Exit;

end;

k := TypeGroupCmBox.ItemIndex;

if k < 0 then

begin

FbKernelWarning('Не выбрана группа данных');

Exit;

end;

FTFbTypeGroup := TFbTypeGroup(TypeGroupCmBox.Items.Objects[k]);

// Выбор ссылки на объект FpTFbCommonType

FpTFbCommonType := Get_SelectedFbFldTypeN(FDbInterface, TypesComboBox.ItemIndex,

TypesComboBox.Items, FTFbTypeGroup, True);

{ Общий контроль }

wErrorStr := '';

if TrimF(FldNameEdit.Text) = '' then

begin

if wErrorStr = '' then

wErrorStr := 'Не задан идентификатор поля'

else

wErrorStr := wErrorStr + #13'Не задан идентификатор поля';

FldNameEdit.SetFocus;

end;

if TrimF(FldCaptionEdit.Text) = '' then

begin

if wErrorStr = '' then

wErrorStr := 'Не задано наименование поля'

else

wErrorStr := wErrorStr + #13'Не задано наименование поля';

FldCaptionEdit.SetFocus;

end;

if TrimF(FldDescrEdit.Text) = '' then

begin

if wErrorStr = '' then

wErrorStr := 'Не задано описание поля'

else

wErrorStr := wErrorStr + #13'Не задано описание поля';

FldDescrEdit.SetFocus;

end;

if FpTFbCommonType = nil then

begin

if wErrorStr = '' then

wErrorStr := 'Не задан тип данных'

else

wErrorStr := wErrorStr + #13'Не задан тип данных';



TypesComboBox.SetFocus;

end;

{ Предварительная детализация поля }

FTFieldType := ftUnknown;

case FpTFbCommonType.FbTypeGroup of

FldGroup :

begin

FTFieldType := FpTFbCommonType.FbFld.sType;

end;

RefGroup :

begin

FTFieldType := ftInteger;

end;

PicGroup :

begin

FTFieldType := FpTFbCommonType.FbPic.sType;

end;

LUpGroup :

begin

FTFieldType := FpTFbCommonType.FbLUp.sType;

end;

end;

FModalRes := FTFieldType <> ftUnknown;

if not FModalRes then

begin

FbKernelWarning('Не выбран тип поля!');

TypesComboBox.SetFocus;

Exit;

end;

Close;

end;

Function TFldDlgFr.Execute: Bool;

begin

Result := False;

if not FModalRes then

Exit;

try

// Указатель на выбранный тип уже должен быть задан

if FpTFbCommonType = nil then

Exit;



// Результаты передаются в форму TbDefFr

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldCaption'] := FldCaptionEdit.Text;

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldDescr'] := FldDescrEdit.Text;

case FpTFbCommonType.FbTypeGroup of

FldGroup :

begin // базовый тип данных

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'] := FldNameEdit.Text;

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] := '';

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] := '';

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] := '';

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sAgregateExpr']:= '';

FDbInterface.N_pTFieldInfo.sMTTableInfo := nil;

FDbInterface.N_pTFieldInfo.sMTFieldInfo := nil;

FDbInterface.N_pTFieldInfo.sPickList := nil;

FDbInterface.N_pTFieldInfo.sFieldType := FpTFbCommonType.FbFld.sType;

if FldSizeEdit.Visible then

begin

FDbInterface.N_pTFieldInfo.sFieldSize := StrToInt(FldSizeEdit.Text);

FDbInterface.N_pTFieldInfo.sFieldMBytes :=

FDbInterface.N_pTFieldInfo.sFieldSize + 1;

end

else

begin

FDbInterface.N_pTFieldInfo.sFieldSize := FpTFbCommonType.FbFld.sSize;

FDbInterface.N_pTFieldInfo.sFieldMBytes := FpTFbCommonType.FbFld.sBytes;

end;

end;

RefGroup :

begin // ссылка на таблицу



FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'] := FldNameEdit.Text;

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] :=

FpTFbCommonType.FbRef.spTableInfo.sTableAttr.Values['sTableName'];

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] := '';

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] := '';

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sAgregateExpr']:= '';

FDbInterface.N_pTFieldInfo.sMTTableInfo := FpTFbCommonType.FbRef.spTableInfo;

FDbInterface.N_pTFieldInfo.sMTFieldInfo := nil;

FDbInterface.N_pTFieldInfo.sPickList := nil;

FDbInterface.N_pTFieldInfo.sFieldType := FpTFbCommonType.FbFld.sType;

FDbInterface.N_pTFieldInfo.sFieldSize := FpTFbCommonType.FbFld.sSize;

FDbInterface.N_pTFieldInfo.sFieldMBytes := FpTFbCommonType.FbFld.sBytes;

end;

PicGroup :

begin // списочный тип данных

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'] := FldNameEdit.Text;

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] := '';

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] := '';

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] :=

FpTFbCommonType.FbPic.sDescr;

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sAgregateExpr']:= '';

FDbInterface.N_pTFieldInfo.sMTTableInfo := nil;

FDbInterface.N_pTFieldInfo.sMTFieldInfo := nil;

FDbInterface.N_pTFieldInfo.sPickList := FpTFbCommonType.FbPic.sPickList;

FDbInterface.N_pTFieldInfo.sFieldType := FpTFbCommonType.FbFld.sType;

FDbInterface.N_pTFieldInfo.sFieldSize := FpTFbCommonType.FbPic.sSize;

FDbInterface.N_pTFieldInfo.sFieldMBytes := FpTFbCommonType.FbPic.sBytes;

end;

LUpGroup :

begin // следящий тип данных

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'] := FldNameEdit.Text;

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] :=

FpTFbCommonType.FbLUp.spTableInfo.sTableAttr.Values['sTableName'];

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] :=

FpTFbCommonType.FbLUp.spFieldInfo.sFieldAttr.Values['sFieldName'];



FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] := '';

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sAgregateExpr']:= '';

FDbInterface.N_pTFieldInfo.sMTTableInfo := FpTFbCommonType.FbLUp.spTableInfo;

FDbInterface.N_pTFieldInfo.sMTFieldInfo := FpTFbCommonType.FbLUp.spFieldInfo;

FDbInterface.N_pTFieldInfo.sPickList := nil;

FDbInterface.N_pTFieldInfo.sFieldType := FpTFbCommonType.FbLUp.sType;

// Размер поля берется из структуры поля, на которое берется ссылка

FDbInterface.N_pTFieldInfo.sFieldSize :=

FpTFbCommonType.FbLUp.spFieldInfo.sFieldSize;

FDbInterface.N_pTFieldInfo.sFieldMBytes :=

FpTFbCommonType.FbLUp.spFieldInfo.sFieldMBytes;

end;

end;

except

end;

Result := True;

end;

Procedure TFldDlgFr.FldNameEditKeyUp(Sender: TObject; Var Key: Word;

Shift: TShiftState);

begin

if Key = VK_UP then

Self.FindNextControl(Sender as TWinControl, False, True, True).SetFocus

else if Key = VK_DOWN then

Self.FindNextControl(Sender as TWinControl, True, True, True).SetFocus;

end;

procedure TFldDlgFr.TypeGroupCmBoxChange(Sender: TObject);

Var

k : Integer;

wTFbTypeGroup : TFbTypeGroup;

begin

k := TypeGroupCmBox.ItemIndex;

if k < 0 then

Exit;

FldNameEdit.Enabled := True;

FldNameEdit.Color := clWhite;

wTFbTypeGroup := TFbTypeGroup(TypeGroupCmBox.Items.Objects[k]);

// Заполнить универсальный список списком выбранного комб. типа

UpdateFieldTypesN(FDbInterface, TypesComboBox, wTFbTypeGroup);

SetTypeGroupLayout(wTFbTypeGroup);

if wTFbTypeGroup = RefGroup then

begin

FldNameEdit.Enabled := False;

FldNameEdit.Color := clSilver;

end;

// Установим фокус ввода на TypesComboBox

TypesComboBox.SetFocus;

end;

Procedure TFldDlgFr.SetTypeGroupLayout(ffTFbTypeGroup : TFbTypeGroup);

begin

// Типовой вид, который будем уточнять

TypesComboBox.Width := 354;

TypesComboBox.BringToFront;

TypesComboBox.Enabled := True;

case ffTFbTypeGroup of

FldGroup :

begin { базовая группа данных }

TypesComboBox.Width := 262;

end;

RefGroup : ;

PicGroup : ;



LUpGroup : ;

NoGroup :

begin

TypesComboBox.Enabled := False;

TypesComboBox.Color := clSilver;

end;

end;

end;

procedure TFldDlgFr.TypesComboBoxKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

Self.FindNextControl( Sender as TWinControl, True, True, True).SetFocus;

end;

procedure TFldDlgFr.TypesComboBoxClick(Sender: TObject);

Var

k : Integer;

wpTFbCommonType : pTFbCommonType;

wpTTableInfo : pTTableInfo;

wpTFieldInfo : pTFieldInfo;

wFieldName,

wFieldDescr : String;

wCaptionUnique : Boolean;

begin { Отслеживание типов данных при выборе из списка }

k := TypesComboBox.ItemIndex;

wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[k]);

FldNameEdit.Enabled := True;

case wpTFbCommonType.FbTypeGroup of

FldGroup :

begin

FldSizeEdit.Visible := wpTFbCommonType.FbFld.sType = ftString;

Label5.Visible := FldSizeEdit.Visible;

if FldSizeEdit.Visible then

FldSizeEdit.SetFocus;

end;

RefGroup :

begin

FldNameEdit.Enabled := False;

FldNameEdit.Color := clSilver;

wpTTableInfo := wpTFbCommonType.FbRef.spTableInfo;

if CreateRefFieldName(FDbInterface, wpTFbCommonType, wFieldName) then

begin

FldNameEdit.Text := wFieldName;

FldCaptionEdit.Text := wpTTableInfo.sTableAttr.Values['sTableCaption'];

FldDescrEdit.Text := 'Ссылка на таблицу: ' +

wpTTableInfo.sTableAttr.Values['sTableCaption'];

end;

end;

PicGroup :

begin

FldNameEdit.Text := FDbInterface.Get_UniqueFieldName(

FDbInterface.Current_pTTableInfo, nil, wCaptionUnique, wFieldDescr);

FldCaptionEdit.Text := wpTFbCommonType.FbPic.sDescr;

FldDescrEdit.Text := 'Значение из списка: ' +

wpTFbCommonType.FbPic.sDescr;

FldSizeEdit.Text := IntToStr(wpTFbCommonType.FbPic.sSize);

end;

LUpGroup :

begin

FldNameEdit.Enabled := False;

FldNameEdit.Color := clSilver;

wpTTableInfo := wpTFbCommonType.FbLUp.spTableInfo;

wpTFieldInfo := wpTFbCommonType.FbLUp.spFieldInfo;

wFieldName := Get_FbQueryFieldName(wpTTableInfo, wpTFieldInfo);

FldNameEdit.Text := wFieldName;

FldCaptionEdit.Text := Get_FbFullFieldNameS(

wpTTableInfo.sTableAttr.Values['sTableCaption'],

wpTFieldInfo.sFieldAttr.Values['sFieldCaption']);

FldDescrEdit.Text := 'Отлеживание поля: ' +

Get_FbFullFieldNameS(wpTTableInfo.sTableAttr.Values['sTableCaption'],

wpTFieldInfo.sFieldAttr.Values['sFieldCaption']);

end;

NoGroup : ;

end;

end;

procedure TFldDlgFr.FldSizeEditKeyPress(Sender: TObject; var Key: Char);

begin

if not(Key in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']) then

Key := #0;

end;

end.


L3_dfm


object TbDefFr: TTbDefFr

Left = 339

Top = 164

BorderIcons = []

BorderStyle = bsDialog

Caption = 'Реквизиты нового документа (таблицы БД)'

ClientHeight = 318

ClientWidth = 427

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

Position = poScreenCenter

OnActivate = FormActivate

OnCreate = FormCreate

PixelsPerInch = 96

TextHeight = 13

object Bevel1: TBevel

Left = 261

Top = 98

Width = 162

Height = 187

end

object Label1: TLabel

Left = 7

Top = 4

Width = 88

Height = 13

Caption = 'Перечень полей :'

end

object Label2: TLabel

Left = 264

Top = 103

Width = 62

Height = 13

Caption = 'Тип данных:'

Visible = False

end

object Label3: TLabel

Left = 264

Top = 145

Width = 66

Height = 13

Caption = 'Размер поля'

Visible = False

end

object Label4: TLabel

Left = 264

Top = 116

Width = 39

Height = 13

Caption = 'Label4'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object Label5: TLabel

Left = 264

Top = 158

Width = 39

Height = 13

Caption = 'Label5'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object Label6: TLabel

Left = 264

Top = 186

Width = 106

Height = 13

Caption = 'Наименование поля:'

Visible = False

end

object Label7: TLabel

Left = 264

Top = 199

Width = 39

Height = 13

Caption = 'Label7'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object Label8: TLabel

Left = 266

Top = 236

Width = 152

Height = 44

AutoSize = False

Caption = 'Label8'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False


WordWrap = True

end

object Label9: TLabel

Left = 265

Top = 223

Width = 80

Height = 13

Caption = 'Описание поля:'

Visible = False

end

object Label10: TLabel

Left = 209

Top = 4

Width = 46

Height = 13

Caption = 'Таблица:'

Visible = False

end

object TbNameLbl: TLabel

Left = 261

Top = 4

Width = 65

Height = 13

Caption = 'TbNameLbl'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

end

object TbFieldsListBox: TListBox

Left = 7

Top = 20

Width = 247

Height = 291

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ItemHeight = 13

ParentFont = False

TabOrder = 0

OnClick = TbFieldsListBoxClick

end

object NewFieldButton: TButton

Left = 263

Top = 20

Width = 162

Height = 21

Caption = 'Новое поле'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 1

OnClick = NewFieldButtonClick

end

object OkButton: TButton

Left = 261

Top = 290

Width = 80

Height = 21

Caption = 'Ok'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ModalResult = 1

ParentFont = False

TabOrder = 2

OnClick = OkButtonClick

end

object CancelButton: TButton

Left = 343

Top = 290

Width = 80

Height = 21

Caption = 'Отмена'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ModalResult = 2

ParentFont = False

TabOrder = 3

OnClick = CancelButtonClick

end

end