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

  35790931     

Запросы к микшеру.


UINT mixerGetNumDevs(VOID)

возвращает количество микшеров, представленных в системе. Полезна, если в системе уставлено более одной звуковой платы.

MMRESULT mixerGetDevCaps(UINT_PTR uMxId, LPMIXERCAPS pmxcaps, UINT cbmxcaps)
возвращает характеристики указанного микшера
uMxId -- идентификатор или обработчик открытого микшера
pmxcaps -- указатель на структуру MIXERCAPS в которой возвращается информация
cbmxcaps -- размер в байтах структуры MIXERCAPS

MIXERCAPS
структура, описывающая характеристики микшера.

typedef struct { WORD wMid; WORD wPid; MMVERSION vDriverVersion; CHAR szPname[MAXPNAMELEN]; DWORD fdwSupport; DWORD cDestinations; } MIXERCAPS; Для нас практически интересен только элемент cDestinations -- число аудиолиний-приемников, доступных из микшера. Все микшеры должны поддерживать хотя бы одну линию-приемник и возвращать ненулевое значение в этом поле. Значение поля используется при назначении индекса линии-приемника в структуре MIXERLINE в поле dwDestination и изменяется от 0 до cDestinations-1. В поле szPname у нас есть текстовое название микшера, если кому-то нужно.

MMRESULT mixerGetID( HMIXEROBJ hmxobj, UINT_PTR *puMxId, DWORD fdwId );
возвращает идентификатор микшера, соответствующего заданному обработчику.
hmxobj -- обработчик микшера, для которого определяется идентификатор.
puMxId -- указатель на переменную, в которую возвращяется идентификатор.
fdwId -- флаг, определяющий, каким образом понимать hmxobj



Управление микшером.


MMRESULT mixerClose( HMIXER hmx );
закрывает заданный микшер.
hmx -- обработчик микшера, который был возвращен функцией mixerOpen.

MMRESULT mixerOpen( LPHMIXER phmx, UINT uMxId, DWORD_PTR dwCallback, DWORD_PTR dwInstance, DWORD fdwOpen );
открывает заданный микшер и гарантирует, что он не будет удален, пока приложение не закроет обработчик микшера.
phmx -- указатель на обработчик микшера.
uMxId -- идентификатор открываемого микшера
dwCallback -- обработчик окна, которое будет получать сообщения об изменении состояния ассоциированных элементов управления аудолиний. Должен быть 0 если не используется.
dwInstance -- пользовательские данные для функции обратного вызова.
fdwOpen -- флаг открытия микшера.
Заметим, что если fdwOpen установить в значение MIXER_OBJECTF_MIXER, то uMxId можно задавать от 0 и до числа микшеров mixerGetNumDevs()-1.

Уровень 2. Аудиолиния. Структуры и функции, предназначенные для работы с аудиолиниями.



Что такое MapInfo и с чем его едят? Краткое предисловие.


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

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

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



Что такое порт.


Известно что в компьютере очень много собрано различных устройств , возникает вопрос как операционная система общается с ними. Для этого и служит порт, то есть эта «дверь» через которую программа (операционная система) может управлять данным устройством (считывать данные, заносить их).Причем я разделяю порты на две категории (это чисто мое разделение) - порты общеизвестные (COM LPT) и порты внутренние ,служащие для связи с внутренними устройствами ЭВМ.





Генерация кода


На основе исходного представления, которое формулирует технолог, нужно сгенерировать код для компиляции. Исходное представление может быть любым, в простейшем случае - это обычный текст. В процессе генерации кода наибольшее внимание нужно уделить диагностике ошибок. То есть, ошибки желательно выявить во время генерации кода и генерировать уже синтаксически правильный код. Для этого можно использовать любые доступные методы, вплоть до синтаксических анализаторов с рекурсивным спуском - такие анализаторы достаточно просты и описаны во многих книгах, например у Бьерна Страуструпа в "Язык программирования C++" (Третье издание). Если есть возможность, то желательно контролировать также семантическую правильность. Далее я буду рассматривать только те моменты, которые являются общими для всех задач без учета их специфики.

Генерировать исходный текст можно любым способом, например, просто посылая строки текста в файл. Более удобный способ, как мне кажется, это направление текста в строко-ориентированный поток. Такой поток предоставляет дополнительное удобство при диагностике ошибок. Библиотека DccUsing содержит два потоковых класса: TFileCompileOut и TStringCompileOut, которые порождаются от TCompileOut. Классы очень просты, их реализацию можно посмотреть в исходном файле библиотеки, поэтому я дам только обзор. Базовый класс имеет методы:

public procedure IncLevel; procedure DecLevel; procedure AddSpace; procedure AddLine(const aLine: String); procedure AddLines(const aLines: array of String); procedure AddFile(const aFileName: String); procedure AddLineTemplate(const aLine: String; const aArgs: array of String); procedure AddLinesTemplate(const aLines, aArgs: array of String); procedure AddFileTemplate(const aFileName: String; const aArgs: array of String); procedure AddPoint(aPoint: Integer); function FindPoint(aLine: Integer): Integer; property Level: Integer read FLevel; property LinesCount: Integer read FLinesCount;

Первые три метода позволяют управлять форматированием кода. Хотя форматирование совсем не обязательно (код никто не читает), но дает удобства при отладке, а, кроме того, мне нравится, когда программа выглядит эстетично. IncLevel увеличивает отступ текста, DecLevel уменьшает, а AddSpace добавляет в поток пустую строку. Два следующих метода добавляют в поток соответственно строку и массив строк, а метод AddFile - весь указанный файл. Свойства позволяют узнать текущий уровень отступа и текущее число строк в потоке. Назначение методов AddPoint и FindPoint будет объяснено в разделе диагностики ошибок.


Методы AddLineTemplate, AddLinesTemplate и AddFileTemplate более сложны, чем предыдущие методы, представляют собой простые макропроцессоры и позволяют параметризовать генерируемый текст. Параметризующие аргументы - это массив строк, которые заменяют метасимволы в исходном тексте шаблона. Метасимволы выглядят так: {{X}}, где Х - это порядковый номер аргумента, начиная от 1. Макроподстановка производится без всякого учета лексики. Поэтому можно параметризовать все что угодно - идентификаторы, строки, комментарии, операторы и т.д. Например, если шаблон текста таков:
const tFunc: array[0..5] of String = ( 'function {{1}}.SortProc{{2}}(const a1, a2: {{2}}): Integer;', 'begin', ' if a2 > a1 then result := 1', ' else if a2 = a1 then result := 0', ' else result := -1;', 'end;' ); то при использовании
c.AddLinesTemplate(tFunc,['TTestClass1','Integer']); мы получим такой результат:
function TTestClass1.SortProcInteger(const a1, a2: Integer): Integer; begin if a2 > a1 then result := 1 else if a2 = a1 then result := 0 else result := -1; end; а при использовании
c.AddLinesTemplate(tFunc,['TTestClass2','String']); такой:
function TTestClass2.SortProcString(const a1, a2: String): Integer; begin if a2 > a1 then result := 1 else if a2 = a1 then result := 0 else result := -1; end;
Наследуемые классы переопределяют абстрактную процедуру записи строки в поток и имеют специфические методы. Класс TFileCompileOut специализируется на построчном выводе в файл:
public constructor Create(const aFileName: String); destructor Destroy; override; property FileName: String read FFileName;
Конструктор принимает имя файла и открывает файл на чтение, а деструктор закрывает файл.
Класс TStringCompileOut хранит генерируемый текст в памяти:
public procedure Clear; procedure SaveToFile(const aFileName: String); procedure SaveToOut(aOut: TCompileOut); property Capacity: Integer ... property Items[aIndex: Integer]: String ... default;
Методы класса позволяют очистить поток, сохранить поток в файле и добавить его к другому потоку. Свойства позволяют изменить резервируемый объем памяти для списка строк и получить доступ на запись и чтение строк по индексу. Общее число строк определяет наследуемое свойство LinesCount. Примеры использования этих классов смотрите в DccExamples.pas.
Отметим, что часть неизменяемого или шаблонного кода может быть заготовлена заранее, располагаться в файлах и объединяться в нужных местах результирующего кода с помощью AddFile и AddFileTemplate. По ходу генерации кода может быть создано несколько потоков - для деклараций переменных и констант, деклараций и реализаций классов и так далее. После просмотра всей задачи, сформулированной технологом, эти потоки сшиваются в один результирующий поток. Для частных потоков можно использовать строковую реализацию, а для результирующего потока - файловую.

Интеграция инструментальных панелей Maplnfo краткий вводный курс.


Вы не можете переподчинить стандартные инструментальные панели MapInfo. Если Вы хотите, чтобы Ваша клиентская программа имела такие панели вы должны сами создать панели и кнопки на Delphi (например используя Tpanel и Tbutton) и их обработчике посылать специальные команды MapInfo для того что-бы MapInfo включало или переключала режимы работы (например с выбора объекта на перемещения окна карты (ладошка)).

Если Вы хотите, чтобы кнопка панели эмулировала стандартную кнопку MapInfo, используйте метод MapInfo Run Menu Command.
Например в обработчике OnClick пропишите следующею команду KDMapInfoServer1.ExecuteCommandMapBasic('Run Menu Command 1702',[]); Когда пользователь нажмет на эту кнопку, программа вызывовет метод MapInfo - Run Menu Command, который активизирует инструмент под номером 1702 (инструмент перемещение карты "рука" ).

"Магический" номер 1702 ссылается на инструмент "рука" служащий для перемещения (сдвига) карты.

Вместо того, чтобы использовать такие числа. Вы можете использовать идентификаторы, более понятные в тексте программы. MapBasic определяет стандартный идентификатор M_TOOLS_RECENTER который имеет значение 1702. Таким образом, этот пример можно записать так: KDMapInfoServer1.ExecuteCommandMapBasic('Run Menu Command %S', [M_TOOLS_RECENTER]); Использование идентификаторов (типа M_TOOLS_RECENTER) делает Вашу программу более читательной, но перед использование вы должны включить в программу (в Uses) соответствующий заголовочный файл MapBasic. Для Delphi я положил файл Global.pas (содержимое файла опубликовано в приложении 1).

В следующей таблице приведены кратко идентификаторы основных инструментальных кнопок MapInfo (для более побробной информации смотрите документацию по MapBasic).

Кнопки панели Операции НомерИдентификаторПрим.
Выбор1701М_TOOLS_SELECTORПанель ОПЕРАЦИИ
Выбор в прямоугольнике1722M_TOOLS_SEARCH_RECTПанель ОПЕРАЦИИ
Выбор в круге 1703M_TOOLS_SEARCH_RADIUSПанель ОПЕРАЦИИ
Выбор в области1704M_TOOLS_SEARCH_BOUNDARYПанель ОПЕРАЦИИ
Увеличивающая лупа1705M_TOOLS_EXPANDПанель ОПЕРАЦИИ
Уменьшающая лупа1706M_TOOLS_SHRINKПанель ОПЕРАЦИИ
Ладошка (рука)1702M_TOOLS_RECENTERПанель ОПЕРАЦИИ
Информация1707M_TOOLS_PNT_QUERYПанель ОПЕРАЦИИ
Подпись1708M_TOOLS_LABELERПанель ОПЕРАЦИИ
Линейка1710M_TOOLS_RULERПанель ОПЕРАЦИИ
Переноска1734M_TOOLS_DRAGWINDOWПанель ОПЕРАЦИИ
Символ1711M_TOOLS_POINTПанель ПЕНАЛ
Линия1712M_TOOLS_LINEПанель ПЕНАЛ
Полилиния1713M_TOOLS_POLYLINEПанель ПЕНАЛ
Дуга1716M_TOOLS_ARCПанель ПЕНАЛ
Полигон1714M_TOOLS_POLYGONПанель ПЕНАЛ
Эллипс1715M_TOOLS_ELLIPSEПанель ПЕНАЛ
Прямоугольник1717M_TOOLS_RECTANGLEПанель ПЕНАЛ
Прямоугольник скругленный1718M_TOOLS_ROUNDEDRECTПанель ПЕНАЛ
Текст|1709M_TOOLS_TEXTПанель ПЕНАЛ
Рамка1719M_TOOLS_FRAMEПанель ПЕНАЛ



Использование уведомляющих


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

Такой тип уведомления известен как обратный вызов или уведомление (callback).

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



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


Довольно типичным практическим примером проблемы решаемой с использованием динамических структур является сортировка данных, получаемых по запросу из иерархической таблицы реляционной базы данных. Требование отсортированности по алфавиту в пределах уровня иерархии без нарушения иерархического порядка исключает чисто SQL-ные решения. Естественным решением в этом случае было бы накопление данных в иерархической структуре в памяти, с последующей их сортировкой. Причём, учитывая большой объем данных хотелось бы сделать это с максимальной эффективностью и минимальными накладными расходами. Но в стандартном наборе контейнеров Delphi кроме "универсальных" TList и TStringList ничего нет ! Между тем мир программистов C++ не знает забот: у них есть STL и прочие прекрасные вещи. Попробуем и мы, не расчитывая на благодеяния фирмы Borland сделать что-нибудь подобное.

Получение информации об аудиолинии


MMRESULT mixerGetLineInfo ( HMIXEROBJ hmxobj, LPMIXERLINE pmxl, DWORD fdwInfo );
Возвращает информацию о заданной аудиолинии.
hmxobj -- обработчик микшера, управляющего заданной аудиолинией.
pmxl -- указатель на структуру MIXERLINE, которая заполняется информацие об аудиолинии. В элементе cbStruct структуры должен быть ее размер в байтах.
fdwInfo -- флаги, определяющие возвращаемую информацию.

Для нас важны три флага
MIXER_OBJECTF_HMIXER -- параметр hmxobj является обработчиком микшера, открытого функцией mixerOpen.
MIXER_GETLINEINFOF_DESTINATION -- параметр pmxl возвращает информацию о линии-приемнике с индексом, заданным в поле dwDestination структуры MIXERLINE. Этот индекс меняется от 0 до cDestinations-1 из MIXERCAPS.
MIXER_GETLINEINFOF_SOURCE -- параметр pmxl возвращает информацию о линии-источнике с индексом, заданным в поле dwDestination структуры MIXERLINE. Этот индекс меняется от 0 до cDestinations-1 из MIXERCAPS.

Функции вызываем в основном с комбинацией флагов MIXER_OBJECTF_HMIXER or MIXER_GETLINEINFOF_DESTINATION или MIXER_OBJECTF_HMIXER or MIXER_GETLINEINFOF_SOURCE.

Поясню подробнее о получении информации о линиях-приемниках и линиях-источниках. Сколько линий-приемников узнаем из cDestinations структуры MIXERCAPS. Информацию о линии-приемнике узнаем вызовом mixerGetLineInfo с флагом MIXER_GETLINEINFOF_DESTINATION и установленным индексом линии в поле dwDestination структуры MIXERLINE.

Каждая линия-приемник может иметь несколько линий-источников. Поэтому сколько линий-источников для каждой линии-приемника, узнаем при вызове mixerGetLineInfo с флагом MIXER_GETLINEINFOF_DESTINATION из поля cConnections структуры MIXERLINE, т.е. когда получали информацию о линии-приемнике.

И, наконец, информацию о линии-источнике узнаем вызовом mixerGetLineInfo с флагом MIXER_GETLINEINFOF_SOURCE и установленными индексами линии-приемника в поле dwDestination и линии-источника в поле dwSource структуры MIXERLINE. Индекс dwSource меняется от 0 до cConnections-1 из MIXERLINE для линии-приемника. Вот такая вот система, потеряться легко.


MIXERLINE
Структура, описывающая состояние и метрики аудиолинии.

typedef struct { DWORD cbStruct; DWORD dwDestination; DWORD dwSource; DWORD dwLineID; DWORD fdwLine; DWORD dwUser; DWORD dwComponentType; DWORD cChannels; DWORD cConnections; DWORD cControls; CHAR szShortName[MIXER_SHORT_NAME_CHARS]; CHAR szName[MIXER_LONG_NAME_CHARS]; struct { DWORD dwType; DWORD dwDeviceID; WORD wMid; WORD wPid; MMVERSION vDriverVersion; CHAR szPname[MAXPNAMELEN]; } Target; } MIXERLINE;
cbStruct -- размер структуры MIXERLINE в байтах.
dwDestination -- индекс линии-приемника. Изменяется от 0 до cDestinations-1 из MIXERCAPS. (вызов mixerGetDevCaps). Когда mixerGetLineInfo вызывается с флагом MIXER_GETLINEINFOF_DESTINATION, то в этом поле указывается индекс опрашиваемой линии. При этом dwSource должен быть равен 0. Когда используется флаг MIXER_GETLINEINFOF_SOURCE в поле dwSource должен быть индекс опрашиваемой линии-источника, ассоциированной с линией-премником, заданной в dwDestination.
dwSource -- индекс линии-приемника, асоциированной с линией-источником с индексом в dwDestination. Работает с флагом MIXER_GETLINEINFOF_SOURCE и изменяется от 0 до cConnections-1 из структуры, полученной для линии-приемника.
dwLineID -- идентификатор линии.
fdwLine -- флаги статуса и поддерживаемых функций для аудиолинии.
dwUser -- только для особо одаренных. Можно игнорировать.
dwComponentType -- тип аудиолинии. Их много всяких, но нам интересней:
MIXERLINE_COMPONENTTYPE_SRC_LINE -- линейный вход
MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC -- вход с компакт-диска
MIXERLINE_COMPONENTTYPE_DST_SPEAKERS -- выход на колонки
MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE-- микрофон
MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT -- стандартный вход, т.е. источник wave-данных (из файла, например) MIXERLINE_COMPONENTTYPE_DST_WAVEIN -- линия-приемник для записи в файл, например.
В общем, с этими типами дело темное, надо эксперименты устраивать, т.к. у меня драйвер для одной карточки безбожно врал и обзывал линии как хотел. Хотя, если найти соответствие, все работало как часы. Так что если в этом месте ошибочка вышла, простите.
cChannels -- максимальное число раздельных каналов. Это 2 для стерео, 1 для моно. Для навороченных карт может быть больше. cConnections -- число соединений для аудиолинии. Используется только для линий-приемников, а для линий-источников всегда 0. Логично. Прием ведем с многих направлений.
cControls -- число элементов управления (контролов) ассоциированных с данной линией, неважно, приемник или источник. Ели таких нет, то 0.
szShortName -- краткое наименование аудиолинии
szName -- полное наименование аудиолинии.
Target -- структура, описывающая микшер и возвращающая др. данные. Честно говоря, ни разу не использовал. Пропускаю из-за сомнительной ценности.
Уровень 3. Элемент управления (контрол). Структуры и функции, предназначенные для работы с элементами управления аудиолинии.

Что такое интегрированная картография и какой нам от нее смысл.


Интегрированная картография позволяет управлять пакетом MapInfo, используя языки программирования отличные от MapBasic. Например если вам хорошо знакомо программирование на языке Visual Basic или С++ или Delphi (о чем и пойдет речь далее...) вы можете включить окно MapInfo в ваше приложение, тем самым обеспечивая интеграцию пакета MapInfo с логикой (бизнес-правилами) вашей программы.

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

На Рисунок 2 как раз представлен пример интегрированной картографии встроенной в мой проект на Delphi.

Итак приступим : в цикле статей будут рассмотрены следующие вещи

Соединение и загрузка MapInfo Встраивание окна MapInfo и других окон (легенда, информация и т.д) в программу на Delphi Отправка команд MapBasic в пакет MapInfo Получение информации от MapInfo посредством функций Использование уведомляющих вызовов (CallBack) и подключение их к своей программе. Создание собственных уведомляющих вызовов Переопределение уведомляющих вызовов Обработка уведомляющих вызовов Создание простейшего компонента (возможно данная тема будет затрунута) для управления MapInfo. и многое другое.



Компиляция


После того, как исходный код создан, требуется его откомпилировать. Компилятор dcc32 замечательно подходит для этой роли - он очень быстрый, качественный и объединяет в себе все, что необходимо для построения exe-файлов, dll-библиотек и пакетов. Размер файла dcc32.exe (версия 12.0, из Delphi 5) всего 545 Кб, ранние версии имеют еще меньший размер. К нему нужно добавить только три файла - rlink32.dll, sysinit.dcu и system.dcu (это минимум). Компилятор и указанные файлы можно разместить в подкаталоге прикладной программы, например, bin. Генерировать текст целесообразно в подкаталоге компилятора, например, bin\pas, чтобы использовать короткие пути файлов и не засорять каталог компилятора.

Для вызова dcc32.exe в библиотеке DccUsing определена функция ExecDcc32. Она устанавливает текущий каталог, создает файл для перехвата ошибок компиляции, вызывает компилятор, дожидается завершения компиляции и определяет наличие ошибок.

function ExecDcc32(const aDccDir, aOptions, aProjectPath, aErrorPath: String; aCheckPaths: Boolean = False): Boolean;

Функция принимает аргументы: aDccDir - каталог, в котором находится компилятор Dcc32, aOptions - опции компилятора (рекомендации по их использованию смотрите в файле DccUsing.pas), aProjectPath - путь файла проекта (обычно dpr), aErrorPath - путь файла, куда будут направляться сообщения об ошибках компиляции. Необязательный аргумент aCheckPaths позволяет разрешить или запретить контроль наличия каталога и файла dcc32.exe. Функция возвращает True, если компиляция была успешной и False в противном случае. Предупреждения (hints и warnings) ошибками не считаются - их выводом можно управлять с помощью опций -H и -W. Опуская детали, рассмотрим немного подробнее эту функцию:

// сохранение текущего каталога и установка нового CurDir := GetCurrentDir; if not SetCurrentDir(DccDir) then raise Exception.Create(SCantChangeDir + DccDir); try hStdOut := INVALID_HANDLE_VALUE; try // установки атрибутов безопасности with SecurAtt do begin nLength := SizeOf(SecurAtt); lpSecurityDescriptor := nil; // разрешить наследование дочернему процессу bInheritHandle := BOOL(True); end; // создание файла, в который будут направляться ошибки hStdOut := CreateFile(PChar(aErrorPath), GENERIC_WRITE, 0, @SecurAtt, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); if hStdOut = INVALID_HANDLE_VALUE then raise Exception.Create(SCantCreateFile + aErrorPath); // заполнение структуры, специфицирующей создание процесса ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); with StartupInfo do begin cb := SizeOf(StartupInfo); // скрывать окно компилятора и наследовать потоки ввода-вывода dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; wShowWindow := SW_HIDE; hStdOutput := hStdOut; end; // создать и стартовать процесс компилятора s := 'dcc32.exe ' + aOptions + ' ' + aProjectPath; if not CreateProcess('dcc32.exe', PChar(s), @SecurAtt, @SecurAtt, BOOL(True), 0, nil, PChar(DccDir), StartupInfo, ProcessInfo) then raise Exception.Create(SCantCreateProcess + 'dcc32.exe'); // ждать завершение компиляции неопределенное время WaitForSingleObject(ProcessInfo.hProcess, INFINITE); // получить результат компиляции ResultCode := 0; GetExitCodeProcess(ProcessInfo.hProcess, ResultCode); result := ResultCode = 0; finally // закрыть файл ошибок if hStdOut <> INVALID_HANDLE_VALUE then CloseHandle(hStdOut); end; finally // восстановить прежний каталог по умолчанию SetCurrentDir(CurDir); end;


Установка каталога компилятора, как текущего, позволяет не заботиться о мелочах, связанных с назначением путей. Компилятор направляет сообщения об ошибках в стандартный файл вывода. Для его перехвата создаем свой файл, дескриптор которого передаем компилятору. Для того, чтобы процесс компилятора мог наследовать дескриптор открытого файла, устанавливаем его атрибут наследования. При заполнении структуры StartupInfo указываем, что окно компилятора должно быть скрытым и порождаемый процесс должен наследовать стандартные потоки ввода-вывода. Атрибуты безопасности, передаваемые функции создания процесса, нужны для правильной работы в NT, в Windows 95-98 их можно было бы опустить. Функция CreateProcess сохраняет параметры процесса в структуре ProcessInfo - мы используем дескриптор процесса, чтобы передать его функции ожидания системного события - в данном случае, завершения процесса. С помощью GetExitCodeProcess получаем значение, которое возвращает компилятор. Если компиляция была успешной, то возвращается 0, иначе - ненулевое значение. Операции закрытия файла ошибок и восстановления предыдущего каталога произойдут независимо от возможных исключительных ситуаций по ходу функции ExecDcc32.
Компилятору, вместе с исходным файлом (файлами), нужно также передать файл проекта (dpr) и уточнить в опциях, что же будет результатом компиляции. Возможных вариантов много - GUI или консольное приложение, dll, пакет, ActiveX (наверное, есть еще варианты). Выбор вида компиляции связан со спецификой задачи, требованиями пользователя и вкусами разработчика. К этому вопросу я еще раз вернусь в разделе Исполнение кода.

Настройка "быстрых" меню Maplnfo


MapInfo вызывает "быстрые" меню, если пользователь нажимает правую кнопку мышки в окне MapInfo. Эти меню появляются даже во внедренных приложениях. В зависимости от характера Вашего приложения Вы можете захотеть модифицировать или даже удалить такое меню. Например, Вы, возможно, захотите удалить команду ДУБЛИРОВАТЬ ОКНО, так как эта команда не работает в OLE-приложении.

Чтобы удалить одну или несколько команд из локального меню, используйте оператор MapBasic Alter Menu... Remove или переопределите меню целиком, используя оператор Create Menu. Подробнее смотрите в Справочнике MapBasic.

Чтобы добавить команду к локальному меню, используйте оператор MapBasic Alter Menu ... Add и синтаксис предложений Calling OLE.

Чтобы удалить "быстрое" меню полностью, используйте оператор MapBasic Create Menu и управляющий код "(-" как новое определение меню. Например, следующий оператор разрушает "быстрое" меню для окон Карты: KDMapInfoServer1.ExecuteCommandMapBasic(' "Create Menu ""MapperShortcut"" ID 17 As ""(-"" " ', []);



Некоторые правила для работы с портами


Следует иметь в виду что при разработке программ имеющих дело работы с портами следует учитывать следующие факторы : а) Стараться использовать функции высокого уровня для доступа к портам (в частности WinAPI) и не прибегать к низкоуровневым операциям чтения/записи портов. Если вы все-таки решили писать низкоуровневое чтение то эти процедуры нужно выносить в отдельную DLL или VXD, по следующим причинам - известно, что операционная система Windows95/98 а особенно NT являются по своей сути многозадачными системами. То есть если ваша программа обращается конкретно к порту не через динамический вызов функции DLL или VXD ( использования механизма DLL) а напрямую то это может сказаться на корректной работе системы или даже завалить ее. И даже если в Windows95/98 такой подход вполне может работать то в Windows NT вследствие его архитектуры не разрешит непосредственное чтение/запись напрямую, а использование механизма DLL или VXD позволяет обойти эту проблему. б)Если вы работаете с каким-то нестандартным портом ввода-вывода (например портом хранящим состояние кнопок пульта ДУ TVTunera то наверняка в комплекте поставки родного софта найдется DLL или VXD для управления этим устройством и отпадет нужда писать код, так я при работе с пультом ДУ TVTunerа использую стандартную DLL поставляемую в комплекте, это сразу решило вопросы связанные с управлением портами данного тюнера) Итак, отступление — немного практики…
Маленький пример для работы с портами (первый пример был уже опубликован в королевстве Дельфи и представлял собой пример работы с весами ПетрВес) function PortInit : boolean; //инициализация var f: THandle; ct: TCommTimeouts; dcb: TDCB; begin f := Windows.CreateFile(PChar('COM1'), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if (f < 0) or not Windows.SetupComm(f, 2048, 2048)or not Windows.GetCommState(f, dcb) then exit; //init error dcb.BaudRate := скоpость; dcb.StopBits := стоп-биты; dcb.Parity := четность; dcb.ByteSize := 8; if not Windows.SetCommState(f, dcb) or not Windows.GetCommTimeouts(f, ct) then exit; //error ct.ReadTotalTimeoutConstant := 50; ct.ReadIntervalTimeout := 50; ct.ReadTotalTimeoutMultiplier := 1; ct.WriteTotalTimeoutMultiplier := 0; ct.WriteTotalTimeoutConstant := 10; if not Windows.SetCommTimeouts(f, ct) or not Windows.SetCommMask(f, EV_RING + EV_RXCHAR + EV_RXFLAG + EV_TXEMPTY) then exit; //error result := true; end; function DoneComm: boolean; //закpыть поpт begin result := Windows.CloseHandle(f); end; function PostComm(var Buf; size: word): integer; //пеpедача в поpт var p: pointer; i: integer; begin p := @Buf; result := 0; while size > 0 do begin if not WriteFile(f, p^, 1, i, nil) then exit; inc(result, i); inc(integer(p)); dec(size); Application.ProcessMessages; end; end; function ReadComm(var Buf; size: word): integer; //пpием из поpта var i: integer; ovr: TOverlapped; begin fillChar(buf, size, 0); fillChar(ovr, sizeOf(ovr), 0); i := 0; result := -1; if not windows.ReadFile(f, buf, size, i, @ovr) then exit; result := i; end; Данный пример был взят мной из многочисленный FAQ посвященных в DELPHI в сети ФИДО


Итак,для работы с портами COM и LPT нам понадобится знание функций Windows API.
Вот подробное описание функций, которые нам нужны (в эквиваленте C) для работы с портами.
(извините за возможный местами неточный перевод ,если что поправьте меня если что не так перевел)
CreateFile

HANDLE CreateFile( LPCTSTR lpFileName, // указатель на строку PCHAR с именем файла DWORD dwDesiredAccess, // режим доступа DWORD dwShareMode, // share mode LPSECURITY_ATTRIBUTES lpSecurityAttributes, // указатель на атрибуты DWORD dwCreationDistribution, // how to create DWORD dwFlagsAndAttributes, // атрибуты файла HANDLE hTemplateFile // хендл на temp файл ); Пример кода на Дельфи CommPort := 'COM2'; hCommFile := CreateFile(Pchar(CommPort), GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Параметры LpFileNameУказатель на строку с нулевым символом в конце (PCHAR) , которая определяет название создаваемого объекта (файл, канал, почтовый слот, ресурс связи (в данном случае порты), дисковое устройство, приставка, или каталог) DwDesiredAccessУказывает тип доступа к объекту ,принимает значение GENERIC_READ - для чтения GENERIC_WRITE - для записи (смешивание с GENERIC_READ операцией GENERIC_READ and GENERIC_WRITE предостовляет полный доступ ) dwShareModeНабор разрядных флагов, которые определяют как объект может быть разделен по доступу к нему. Если dwShareMode - 0, объект не может быть разделен. Последовательные операции открытия объекта будут терпеть неудачу, пока маркер(дескриптор) открытого объекта не будет закрыт. Фактически предоставляется монопольный доступ.
Чтобы разделять объект(цель), используйте комбинацию одних или большее количество следующих значений: FILE_SHARE_DELETE (Только для Windows NT) FILE_SHARE_READ FILE_SHARE_WRITE LpSecurityAttributesУказатель на структуру SECURITY_ATTRIBUTES, которая определяет может ли возвращенный дескриптор быть унаследован дочерними процессами. Если lpSecurityAttributes НУЛЕВОЙ, маркер не может быть унаследован. Используется только в windows NT. dwCreationDistributionОпределяет поведение функции если объект уже существует и как он будет открыт в этом случае Принимает одно из следующих значений : CREATE_NEW Создает новый объект (файл) Выдает ошибку если указанный объект (файл) уже существует. CREATE_ALWAYS Создает новый объект (файл) Функция перезаписывает существующий объект (файл) OPEN_EXISTING Открывает объект (файл) Выдает ошибку если указанный объект (файл) не существует.(Для более детального смотрите SDK) OPEN_ALWAYS Открывает объект (файл), если он существует. Если объект (файл) не существует, функция создает его, как будто dwCreationDistribution были CREATE_NEW. TRUNCATE_EXISTING Открывает объект (файл). После этого объект (файл) будет усечен до нулевого размера.Выдает ошибку если указанный объект (файл) не существует. DwFlagsAndAttributesАтрибуты объекта (файла) , атрибуты могут комбинироваться FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_COMPRESSED FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY HTemplateFileОпределяет дескриптор с GENERIC_READ доступом к временному объекту(файлу). Временный объект(файл)поставляет атрибуты файла и расширенные атрибуты для создаваемого объекта (файла) ИСПОЛЬЗУЕТСЯ ТОЛЬКО В WINDOWS NT Windows 95: Это значение должно быть установлено в Nil.


Возвращаемые значения
Если функция преуспевает, возвращаемое значение - открытый дескриптор к указанному объекту(файлу). Если файл не существует - 0.
Если произошли функциональные сбои, возвращаемое значение - INVALID_HANDLE_VALUE. Чтобы получить расширенные данные об ошибках, вызовите GetLastError.
Обратите внимание !
Для портов, dwCreationDistribution параметр должен быть OPEN_EXISTING, и hTemplate должен быть Nil. Доступ для чтения-записи должен быть определен явно.
SECURITY_ATTRIBUTES

Структура содержит описание защиты для объекта и определяет,может ли дескриптор быть унаследован дочерними процессами. typedef struct _SECURITY_ATTRIBUTES { DWORD nLength; LPVOID lpSecurityDescriptor; BOOL bInheritHandle; } SECURITY_ATTRIBUTES;
Параметры
NLengthОпределяет размер, в байтах, этой структуры. Набор это значение к размеру структуры SECURITY_ATTRIBUTES В Windows NT функции которые используют структуру SECURITY_ATTRIBUTES, не проверяют значение nLength. LpSecurityDescriptorДескриптор указывающий на описатель защиты для объекта, Если дескриптор ПУСТОЙ объект может быть назначен в наследование дочерними процессами. BInheritHandleОпределяет, унаследован ли возвращенный дескриптор, когда новый дескриптор, создан. Если это значение принимает ИСТИНУ новый дескриптор наследует от головного. Замечания
Указатель на структуру SECURITY_ATTRIBUTES используется как параметр в большинстве функций работы с окнами в Win32 API.
Продолжение следует...
, часть II

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

Почему Perl ?


Благодаря возможности использования технологии поиска по шаблонам языка Perl становится возможной реализация техники "выборочного разбора" (selective parsing), то есть поиск и обнаружение интерпретируемых фрагментов текста, погружённых в тело сканируемого текста. Если сканируемым текстом является исходный код, то интерпретируемые фрагменты можно погружать в тело коментариев, и обрабатывать их на стадии препроцессирования.

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

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



Требования к функциям уведомления


Программа должна быть способна функционировать, как DDE-сервер или как сервер Автоматизации OLE. Предопределенные процедуры SetStatusText, WindowContentsChanged. Если Вы хотите имитировать строку состояния MapInfo, создайте метод, называемый SetStatusText. Определите этот метод так, чтобы у него был один аргумент: строка. метод WindowContentsChanged, MapInfo посылает четырехбайтовое целое число (ID окна MapInfo), чтобы указать, какое из окон Карты изменилось. Напишите код, делающий необходимую обработку.

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



Получение контролов аудиолинии.


MMRESULT mixerGetLineControls( HMIXEROBJ hmxobj, LPMIXERLINECONTROLS pmxlc, DWORD fdwControls );
Возвращает один или более контролов, ассоциированных с аудиолинией.
hmxobj -- обработчик микшера, которого мы опрашиваем.
pmxlc -- указатель на структуру MIXERLINECONTROLS.. Эта структура используется для ссылки на одну или более структур MIXERCONTROL, которые заполняются информацией о контролах. Поле cbStruct -- размер в байтах структуры MIXERLINECONTROLS должно быть заполнено.
fdwControls -- флаги, определяющие возвращаемую информацию. Мы задаем комибинацию MIXER_GETLINECONTROLSF_ALL or MIXER_OBJECTF_HMIXER. MIXER_GETLINECONTROLSF_ALL -- параметр pmxlc ссылается на список структур MIXERCONTROL, которые заполняются информацией обо всех контролах данной аудиолинии. В поле cControls должно быть записано число контролов, а взять его можно из cControls структуры MIXERLINE данной линии.
Поле сbmxctrl содержит размер одиночной структуры MIXERCONTROL и должно быть установлено. Поле pamxctrl должно содержать указатель на первую структуру MIXERCONTROL. Остальные флаги не рассматриваю, сделайте это самостоятельно.

MIXERLINECONTROLS
Структура с информацией о контролах аудиолинии.

typedef struct { DWORD cbStruct; DWORD dwLineID; union { DWORD dwControlID; DWORD dwControlType; }; DWORD cControls; DWORD cbmxctrl; LPMIXERCONTROL pamxctrl; } MIXERLINECONTROLS; cbStruct -- размер структуры в байтах.
dwLineID -- идентификатор линии, про которую мы спрашиваем. Берем его из MIXERLINE.
dwControlID -- работает с флагом MIXER_GETLINECONTROLSF_ONEBYID и нам пока неинтересен.
dwControlType -- работает с флагом MIXER_GETLINECONTROLSF_ONEBYTYPE и нам пока неинтересен.
cControls -- число элементов MIXERCONTROL в списке. Не может быть нулевым. Мы устанавливаем его из cControls структуры MIXERLINE.
cbmxctrl -- размер в байтах одиночной структуры MIXERCONTROL
pamxctrl -- указатель на первую структуру MIXERCONTROL в списке.

MIXERCONTROL
Структура с информацией об одиночном элементе управления аудиолинии.


typedef struct { DWORD cbStruct; DWORD dwControlID; DWORD dwControlType; DWORD fdwControl; DWORD cMultipleItems; CHAR szShortName[MIXER_SHORT_NAME_CHARS]; CHAR szName[MIXER_LONG_NAME_CHARS]; union { struct { LONG lMinimum; LONG lMaximum; }; struct { DWORD dwMinimum; DWORD dwMaximum; }; DWORD dwReserved[6]; } Bounds; union { DWORD cSteps; DWORD cbCustomData; DWORD dwReserved[6]; } Metrics; } MIXERCONTROL, *PMIXERCONTROL, FAR *LPMIXERCONTROL;
cbStruct -- размер структуры в байтах.
dwControlID -- идентификатор контрола, про который мы спрашиваем.
dwControlType -- тип контрола, про который мы спрашиваем.
Типов опять же много, но нам интересны пока два:
MIXERCONTROL_CONTROLTYPE_MUTE -- включение/выключение звука
MIXERCONTROL_CONTROLTYPE_VOLUME -- громкость звука
Остальные типы можно посмотреть сами знаете где.
fdwControl -- флаги статуса и поддерживаемых свойств. Их тоже хватает. Смотрите.
cMultipleItems -- число элементов для многоэлементных контролов. Нам пока неинтересен.
szShortName -- короткое имя контрола
szName -- полное именование контрола
Bounds -- граничные значения для параметра контрола. Полезно проверять.
Metrics -- граничные значения для метрик. Зачем это, без стакана не понять.

Уровень 4. Свойства элементов управления (control details). Структуры и функции, предназначенные для работы со свойствами контролов аудиолинии.
Все контролы подразделяются на несколько типов:
Audio mixer custom controls Faders Lists Meters Numbers Sliders Switches Time controls
Нам интересны фейдеры и свитчи. Фейдер - обычный контрол с линейной вертикальной шкалой и ползунком, который перемещается вверх и вниз. Например, громкость именно таким контролом и регулируется. Для громкости шкала назначена от 0 и до 65535. Свитч - контрол, имеющий только два состояния. Например, чекбокс для MUTE. А больше и сказать особо нечего. Все остальное посмотреть можно сами знаете где :)

Cервер автоматизации OLE для обработки CallBack.


Данный сервер я разместил в ActiveX DLL.(данная DLL называется MICallBack.dll) в виде Automation Object.-а.
Что-бы вам просмотреть методы и свойства данногоAutomation Object.-а. откройте MICallBack.dpr и в меню Run Delphi выбирите TypeLibrary
Откроется окно - Где я реализовал CallBack методы MapInfo и создал сервер автоматизации MICallBack. Обратите внимание, что у данного сервера помимо присутствия интерфейса IMapInfoCallBack присутствует и еще интерфейс ImapInfoCallBackEvents (он нам нужен будет для перенаправления событий в компонент и далее в обработчик).

Листинг интерфейсного модуля

unit Call; {$WARN SYMBOL_PLATFORM OFF} interface uses ComObj, ActiveX, Dialogs, AxCtrls, Classes, MICallBack_TLB, StdVcl; type TMapInfoCallBack = class(TAutoObject, IConnectionPointContainer, IMapInfoCallBack) private { Private declarations } FConnectionPoints: TConnectionPoints; FConnectionPoint: TConnectionPoint; FEvents: IMapInfoCallBackEvents; { note: FEvents maintains a *single* event sink. For access to more than one event sink, use FConnectionPoint.SinkList, and iterate through the list of sinks. } public procedure Initialize; override; protected { Protected declarations } property ConnectionPoints: TConnectionPoints read FConnectionPoints implements IConnectionPointContainer; procedure EventSinkChanged(const EventSink: IUnknown); override; procedure SetStatusText(const Status: WideString); safecall; procedure WindowContentsChanged(ID: Integer); safecall; procedure MyEvent(const Info: WideString); safecall; end; var FDLLCall : THandle; implementation uses ComServ; procedure TMapInfoCallBack.EventSinkChanged(const EventSink: IUnknown); begin FEvents := EventSink as IMapInfoCallBackEvents; end; procedure TMapInfoCallBack.Initialize; begin inherited Initialize; FConnectionPoints := TConnectionPoints.Create(Self); if AutoFactory.EventTypeInfo <> nil then FConnectionPoint := FConnectionPoints.CreateConnectionPoint( AutoFactory.EventIID, ckSingle, EventConnect) else FConnectionPoint := nil; end; procedure TMapInfoCallBack.SetStatusText(const Status: WideString); begin IF FEvents <> nil Then begin FEvents.OnChangeStatusText(Status); end; end; procedure TMapInfoCallBack.WindowContentsChanged(ID: Integer); begin IF FEvents <> nil Then begin FEvents.OnChangeWindowContentsChanged(ID); end; end; procedure TMapInfoCallBack.MyEvent(const Info: WideString); begin IF FEvents <> nil Then begin FEvents.OnChangeMyEvent(Info); end; end; initialization TAutoObjectFactory.Create(ComServer, TMapInfoCallBack, Class_MapInfoCallBack, ciMultiInstance, tmApartment); end. Обратите внимание на присутствие двух предопределенных методов MapInfo SetStatusText и WindowContentsChanged.
Метод MyEvent я пока зарезервировал для реализации своих сообщений (более подробно будет изложено в 3 части цикла)
И так что мы видим. IF FEvents <> nil Then // если есть обработчик begin FEvents.OnChangeStatusText(Status); // Отправка сообщения далее - в данном случае в компонент



Диагностика ошибок


Идеальный вариант - это генерация синтаксически и семантически правильного кода. Но проверка семантики в большинстве случаев вряд ли возможна, поэтому желательно генерировать, по крайней мере, синтаксически правильный код. В этом случае компиляция всегда будет успешной. Если проверка синтаксической корректности затруднительна или невозможна, то приходится полагаться на диагностику, которую сформирует компилятор. Конечно, давать эту диагностику технологу - это самый последний случай, когда уже ничего не остается. Более спокойный вариант - это извлечь из файла ошибок номера ошибочных строк и определить, чему они соответствуют в том описании, который сделал технолог. Для разбора файла ошибок, библиотека DccUsing содержит класс TParseDcc32Errors. Класс весьма прост, поэтому я только обрисую его интерфейс:

TCompileMessageStatus = (cmsNone, cmsHint, cmsWarning, cmsError, cmsFatal);

public procedure ParseFile(const aFileName: String); function MessagesCount: Integer; function StatusCount(aStatus: TCompileMessageStatus): Integer; function MessageText(aIndex: Integer): String; function MessageStatus(aIndex: Integer): TCompileMessageStatus; function MessageFile(aIndex: Integer): String; function MessageLine(aIndex: Integer): Integer;

TCompileMessageStatus перечисляет все возможные статусы ошибок. Процедура ParseFile выполняет разбор файла ошибок и сохраняет результат в своем приватном списке. Функция MessagesCount возвращает общее количество сообщений, а StatusCount - количество сообщений с заданным статусом. Оставшиеся 4 функции разбирают строку сообщения компилятора на составляющие - текст сообщения, статус, имя файла, в котором обнаружена ошибка и номер строки.

Вот теперь можно вернуться к необъясненным методам TCompileOut. Метод AddPoint добавляет в поток контрольную точку. Контрольная точка - это просто целое число, которое помечает уникальным номером начало некоторой части генерируемого кода и жестко связывается с номером строки. Контрольная точка может служить, например, индексом в таблице ошибок. Расставив при генерации кода такие точки-метки, мы можем локализовать место ошибки. Для поиска ошибки нужно повторить генерацию кода без вызова компилятора (чтобы опять сформировать выходной поток), а затем, для результирующего выходного потока, вызвать функцию FindPoint, передав ей номер ошибочной строки. Эта функция определит ближайшую точку ошибки. Если генерируется несколько файлов исходных кодов, то выбор ошибочного файла сделать с помощью функции, возвращающей имя файла - MessageFile.



Концепции Интегрированной Картографии


Для создания приложения с Интегрированной Картой Вы должны написать программу - но не программу на языке MapBasic. Приложения с Интегрированной Картой могут быть написаны на нескольких языках программирования, среди которых наиболее часто используются С,Visual Basic,Delphi.

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

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



Особенности объектной модели Object Pascal


Особенностью объектной модели Object Pascal, сказывающейся на реализации описанным в статье методом шаблонов, является отсутствие операционной идентичности объектных типов языка базовым, то есть наличие отдельных правил создания, деструкции и присваивания значений переменных для объектных типов. Это свойство приводит к необходимости реализации отдельных шаблонов для объектных типов данных. Реализация их, впрочем возможна на основе шаблонов для базовых типов языка.



Переинсталяция компонента TKDMapInfoServer.


Удалите старый компонент.2. Зарегистрируете в системе библиотеку MICallBack.dll , для этого откройте MICallBack.dpr и в меню Run Delphi выбирите Register ActiveX Server.После этого скопируйте саму DLL в каталог Windows Установите пакет KDPack.dpk в Delphi Вот в принципе и все.



Создание собственных уведомляющих вызовов (Callbacks).


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

Если Вы хотите, чтобы MapInfo сообщало Вашей клиентской программе, когда пользователь применяет инструментальную кнопку, создайте такую кнопку оператором Alter ButtonPad... Add. Определите кнопку в соответствии с именем метода для обработки (прим. Этот метод определен мной как MyEnvent в OLE объекте)
Пример : KDMapInfoServer1.ExecuteCommandMapBasic('Alter ButtonPad ID 1 Add ToolButton calling ole "MyEvent" ID 1 Icon 0 Cursor 0 DrawMode 34 uncheck',[]); Заметьте, что инструментальные панели MapInfo скрыты, подобно остальной части интерфейса пользователя MapInfo. Пользователь не будет видеть новую кнопку. Вы можете добавить иконку, кнопку или другой видимый элемент управления к интерфейсу пользователя Вашей клиентской программы. Когда пользователь укажет на него мышкой, пошлите MapInfo оператор Run Menu Command ID , c индентификатором созданной кнопки чтобы активизировать этот инструмент. KDMapInfoServer1.ExecuteCommandMapBasic('Run Menu Command ID 1',[]);

Примечание:
Информацию по Alter Button Pad смотрите в документации.

Если Вы хотите, чтобы MapInfo сообщала Вашей клиентской программе, когда пользователь выбирает созданную Вами команду меню, определите такую кнопку оператором Alter Menu... Add с указанием имени OLE метода (см. выше).

Внутри метода (в данном случае в обработчике компонента MyEventChange) обработайте аргументы (Info), посланные MapInfo.



Теория.


Windows Management Instrumentation (WMI) - технология, входящая в состав ядра Windows 2000 и предоставляющая доступ с помощью интерфейсов к объектам системы.

Представлю несколько упрощённую архитектуру WMI в том виде, в котором она нас будет интересовать в нашем конкретном случае. Быстро пробежимся по всем её компонентам.

Объекты Win32 - с этим элементом ассоциированы компоненты Win32, к данным которых мы желаем получить доступ Провайдер Win32 - представители объектов Win32, т.е. провайдер осуществляет связь между "внешним миром" и компонентами системы. Нас провайдеры будут интересовать как COM (DCOM) серверы, которые могут быть реализованы как внутренние (в виде DLL), так и внешние (в виде самостоятельных приложений). CIM Object Manager - попросту говоря, это служба координации данных передаваемых в обоих направлениях (будь то запрос от управляющей программы к провайдеру или данные предоставляемые провайдером приложению). Классы CIM - вернее база данных, содержащая классы, которые есть не что иное, как шаблоны управляемых элементов, т.е. каждый класс описывает какой-то элемент и содержит свойства и методы для работы с этим элементом. Windows Management API - интерфейс прикладного программирования, по средствам которого управляющие приложения обращаются к объектам, а провайдеры поставляют данные и определения класса. Наша программа является в данном случае не чем иным как контроллером, работающим с помощью Windows Management API с провайдерами (серверами).

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



Получение значений свойств контрола аудиолинии


MMRESULT mixerGetControlDetails( HMIXEROBJ hmxobj, LPMIXERCONTROLDETAILS pmxcd, DWORD fdwDetails );
Возвращает харатеристики одиночного контрола аудиолинии.
hmxobj -- обработчик микшера, которого мы опрашиваем.
pmxcd -- указатель на структуру MIXERCONTROLDETAILS, которая заполняется информацией о контроле.
fdwDetails -- флаги, определяющие возвращаемую информацию. Используем MIXER_GETCONTROLDETAILSF_VALUE or MIXER_OBJECTF_HMIXER.
MIXER_GETCONTROLDETAILSF_VALUE -- возвращается текущее значение контрола. PaDetails структуры MIXERCONTROLDETAILS указывает на структуры с детальной информацией по контролу.



Установка значений свойств контрола аудиолинии


MMRESULT mixerSetControlDetails( HMIXEROBJ hmxobj, LPMIXERCONTROLDETAILS pmxcd, DWORD fdwDetails );
Устанавливает харатеристики одиночного контрола аудиолинии.
hmxobj -- обработчик микшера, которого мы опрашиваем.
pmxcd -- указатель на структуру MIXERCONTROLDETAILS, которая заполнена информацией о контроле предыдущим вызовом mixerGetControlDetails.
fdwDetails -- флаги, определяющие возвращаемую информацию. Используем MIXER_OBJECTF_HMIXER or MIXER_SETCONTROLDETAILSF_VALUE.
MIXER_SETCONTROLDETAILSF_VALUE -- устанавливается новое значение контрола.
PaDetails из структуры MIXERCONTROLDETAILS указывает на структуру, соответствующую типу контрола.

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

typedef struct { DWORD cbStruct; DWORD dwControlID; DWORD cChannels; union { HWND hwndOwner; DWORD cMultipleItems; }; DWORD cbDetails; LPVOID paDetails; } MIXERCONTROLDETAILS;

cbStruct -- размер структуры в байтах.
dwControlID -- идентификатор контрола, свойства которого мы читаем/изменяем
cChannels - число каналов, свойства которых меняются. Ставьте значение 0, 1 или MIXERLINE.cChannels, если свойства контрола относятся ко всем каналам аудиолинии. Других значений не ставьте.
hwndOwner - указатель окна. Для наших целей неважно. Ставьте 0.
cMultipleItems - ставьте 0 и будет хорошо
cbDetails - размер структуры, содержащей конкретную информацию по контролу.
paDetails - указатель на одну или более структур, содержащих конкретную информацию по контролу.

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

MIXERCONTROLDETAILS_BOOLEAN
Возвращает или устанавливает значение свойства контрола булевского типа.

typedef struct { LONG fValue; } MIXERCONTROLDETAILS_BOOLEAN;

fValue - значение логического типа ( 0- FALSE, ненулевое - TRUE)
Подходит для управления контролом типа MIXERCONTROL_CONTROLTYPE_MUTE.


MIXERCONTROLDETAILS_UNSIGNED
Возвращает или устанавливает значение свойства контрола целого беззнакового типа.
typedef struct { DWORD dwValue; } MIXERCONTROLDETAILS_UNSIGNED;
dwValue - Целое беззнаковое
Подходит для управления контролом типа MIXERCONTROL_CONTROLTYPE_VOLUME
Без уровня. Поддержка сообщений. Отправка определенного пользователем сообщения.
DWORD mixerMessage( HMIXER hmx, UINT uMsg, DWORD_PTR dwParam1, DWORD_PTR dwParam2 );
Посылка пользовательского сообщения напрямую драйверу микшера
hmx -- обработчик открытого микшера
uMsg -- пользовательское сообщение Должно быть больше или равно MXDM_USER.
dwParam1, dwParam2 -- параметры сообщения.
MM_MIXM_CONTROL_CHANGE
Сообщение, которое посылается микшером приложению чтобы уведомить об изменении состояния контрола.
wParam = (WPARAM) hMixer
lParam = (LPARAM) dwControlID
hMixer -- обработчик микшера, который послал сообщение.
dwControlID -- идентификатор контрола, который изменил состояние.
MM_MIXM_LINE_CHANGE
Сообщение, которое посылается микшером приложению чтобы уведомить об изменении состояния аудиолинии.
wParam = (WPARAM) hMixer
lParam = (LPARAM) dwLineID
hMixer -- обработчик микшера, который послал сообщение.
dwLineID -- идентификатор аудиолинии, которая изменила свое состояние.

И еще немножко :)
Вот, собственно, и все, что желательно знать, чтобы начать работать с микшером. Да и этого многовато ;) В качестве примера приведена программа, которая прочитывает все, что связано с микшером и отображает это в виде дерева
Далее по плану: как записать звук и что такое fullduplex.

Исполнение кода


Как я уже говорил, возможны различные варианты того, в какой вид будет скомпилирована задача, сформулированная технологом. Если технолог передает результаты своей работы конечному пользователю, то удобный вариант - exe-файл. Если технолог решает некоторую задачу и сразу же пользуется результатами решения, то сам факт компиляции должен быть для него полностью прозрачен (или максимально незаметен). Технолог работает в программе, которая сделана разработчиком и, по большому счету, ему совершенно безразлично, каким конкретно способом разработчик предоставляет возможность изменять функциональность программы. Существует несколько технологий построения гибко подгружаемых модулей, и они описаны в литературе. Я остановлюсь только на одной технологии - динамическая загрузка и выгрузка DLL. Если результирующий проект, который нужен технологу, содержит визуальные формы (а их можно генерировать как dfm-файлы), то вероятно, более предпочтительными будут пакеты.

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

Для работы с DLL, в библиотеку DccUsing добавлен класс TDllWrap - простая оболочка, инкапсулирующая дескриптор загруженной DLL. Основные методы класса:

public constructor Create(const aDllPath: String); destructor Destroy; override; function Execute(const aFunctionName: String; const aInterface: Pointer): Pointer;

Конструктор Create просто сохраняет путь к файлу DLL и больше ничего не делает, деструктор Destroy выгружает DLL из памяти, если она была загружена. Основную работу делает метод Execute - он вызывает экспортируемую функцию DLL по имени и передает ей указатель на интерфейс вызывающей части. Экспортируемая функция возвращает интерфейс вызываемой части. Более подробно о взаимодействии вызывающей и вызываемой частей поговорим в следующем разделе, а пока рассмотрим реализацию метода Execute.


function TDllWrap.Execute( const aFunctionName: String; const aInterface: Pointer): Pointer; var f: TDllFunction; begin if FDllInst = 0 then begin if not FileExists(FDllPath) then raise Exception.Create(SFileNotFound + FDllPath); FDllInst := LoadLibrary(PChar(FDllPath)); if FDllInst = 0 then raise Exception.Create(SCantLoadDll + SysErrorMessage(GetLastError)); end; f := TDllFunction(GetProcAddress(FDllInst, PChar(aFunctionName))); if not Assigned(f) then raise Exception.Create(SCantFindFunction + aFunctionName); result := f(aInterface); end;
Вначале метод Execute контролирует - загружена ли DLL? и, если DLL еще не загружена, то она загружается. Если загрузка была успешной, то с помощью функции GetProcAddress получаем адрес экспортируемой функции по ее символическому имени (можно также использовать индекс). Если адрес функции успешно получен, то вызываем ее и передаем ей аргумент - указатель на вызывающий интерфейс. Функция возвращает указатель на вызываемый интерфейс. Из этой реализации видно, что вызывающая часть может обратиться с помощью метода Execute к нескольким различным функциям DLL или многократно к одной и той же функции - DLL будет загружена только один раз.

Как заставить MapInfo пересылать


Итак представляю переработанный компонент - unit KDMapInfoServer; interface uses Stdctrls,Dialogs,ComObj,Controls,Variants,ExtCtrls,Windows,ActiveX, Messages,SysUtils,Classes,MICallBack_TLB; // - сгенерировано из DLL Type // запись "типа" Variant TEvalResult = record AsVariant: OLEVariant; AsString: String; AsInteger: Integer; AsFloat: Extended; AsBoolean: Boolean; end; type // Событие на изменение SetStatusText // генерируется при обратном вызове TSetStatusTextEvent = procedure(Sender : TObject; StatusText: WideString) of object; // WindowContentsChanged TWindowContentsChanged = procedure(Sender : TObject; ID : Integer) of object; // Для собственных событий TMyEvent = procedure(Sender : TObject; Info : WideString) of object; TEvent = class(TInterfacedObject,IUnknown,IDispatch) private FAppConnection : Integer; FAppDispatch : IDispatch; FAppDispIntfIID : TGUID; protected function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; function GetTypeInfoCount(out Count: Integer): HResult; stdcall; function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; public Constructor Create( AnAppDispatch : IDispatch; Const AnAppDispIntfIID : TGUID); Destructor Destroy ; override; end; TKDMapInfoServer = class(TComponent) private FOwner : TWinControl; // Владелец Responder : Variant; // Для OLE Disp FServer : Variant; FHandle : THandle; // Зарезервировано FActive : Boolean; // Запущен/ незапущен FPanel : TPanel; // Панель вывода srv_OLE : OLEVariant; srv_disp : IMapInfoCallBackDisp; srv_vTable : IMapInfoCallBack; FEvent : TEvent; FSetStatusTextEvent : TSetStatusTextEvent; // события компонента FWindowContentsChanged : TWindowContentsChanged; FMyEvent : TMyEvent; Connected : Boolean; // Установлено ли соединение MapperID : Cardinal; // ИД окна procedure SetActive(const Value: Boolean); procedure SetPanel(const Value: TPanel); procedure CreateMapInfoServer; procedure DestroyMapInfoServer; { Private declarations } protected { Protected declarations } public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; // Данная процедура выполеняет метод сервера MapInfo - Do procedure ExecuteCommandMapBasic(Command: String; const Args: array of const); function Eval(Command: String; const Args: array of const): TEvalResult; virtual; procedure WindowMapDef; procedure OpenMap(Path : String); procedure RepaintWindowMap; // Дополнил для генерации события SetStatus при изменении строки состояния // в MapInfo procedure DoSetStatus(StatusText: WideString); // Дополнил.для генерации события WindowContentsChanged при изменении окна // в MapInfo procedure DoWindowContentsChanged(ID : Integer); // Дополнил для генерации собственно события в MapInfo procedure DoMyEvent(Info: WideString); published { Published declarations } // Создает соединение с сервером MapInfo property Active: Boolean read FActive write SetActive; property PanelMap : TPanel read FPanel write SetPanel; // Событие возникающее при изменении строки состояния MapInfo property StatusTextChange : TSetStatusTextEvent read FSetStatusTextEvent write FSetStatusTextEvent; Property WindowContentsChanged : TWindowContentsChanged read FWindowContentsChanged write FWindowContentsChanged; Property MyEventChange : TMyEvent read FMyEvent write FMyEvent; end; var // О это вообще хитрость - используеться для определения созданного компонента // TKDMapInfoServer (см. SetStatusText и Create KDMapInfoServ : TKDMapInfoServer; procedure Register; implementation // Вот тут то и хитрость если сервер создан то тогда и вызываем SetStatus //// IF KDMapInfoServ <> nil Then /// KDMapInfoServ.SetStatus(StatusText); procedure Register; begin RegisterComponents('Kuzan', [TKDMapInfoServer]); end; { TKDMapInfoServer } constructor TKDMapInfoServer.Create(AOwner: TComponent); begin inherited Create(AOwner); FOwner := AOwner as TWinControl; KDMapInfoServ := Self; // **** Вот тут и указываеться созданный компонент // TKDMapInfoServer FHandle := 0; FActive := False; Connected := False; end; destructor TKDMapInfoServer.Destroy; begin DestroyMapInfoServer; inherited Destroy; end; //------------------------------------------------------------------------------ procedure TKDMapInfoServer.CreateMapInfoServer; begin try FServer := CreateOleObject('MapInfo.Application'); except FServer := Unassigned; end; // Скрываем панели управления MapInfo ExecuteCommandMapBasic('Alter ButtonPad ID 4 ToolbarPosition (0, 0) Show Fixed', []); ExecuteCommandMapBasic('Alter ButtonPad ID 3 ToolbarPosition (0, 2) Show Fixed', []); ExecuteCommandMapBasic('Alter ButtonPad ID 1 ToolbarPosition (1, 0) Show Fixed', []); ExecuteCommandMapBasic('Alter ButtonPad ID 2 ToolbarPosition (1, 1) Show Fixed', []); ExecuteCommandMapBasic('Close All', []); ExecuteCommandMapBasic('Set ProgressBars Off', []); ExecuteCommandMapBasic('Set Application Window %D', [FOwner.Handle]); ExecuteCommandMapBasic('Set Window Info Parent %D', [FOwner.Handle]); FServer.Application.Visible := True; if IsIconic(FOwner.Handle)then ShowWindow(FOwner.Handle, SW_Restore); BringWindowToTop(FOwner.Handle); srv_ole := CreateOleObject('MICallBack.MapInfoCallBack') as IDispatch; srv_vtable := CoMapInfoCallBack.Create; srv_disp := CreateComObject(CLASS_MapInfoCallBack) as IMapInfoCallBackDisp; FEvent := TEvent.Create(srv_disp,IMapInfoCallBackEvents); // Указываем MapInfo что нужно передовать обратные вызовы нашему OLE // а тм далее по цепочке (см.начало) FServer.SetCallBack(srv_disp); end; procedure TKDMapInfoServer.DestroyMapInfoServer; begin ExecuteCommandMapBasic('End MapInfo', []); FServer := Unassigned; end; //------------------------------------------------------------------------------ procedure TKDMapInfoServer.ExecuteCommandMapBasic(Command: String; const Args: array of const); begin if Connected then try FServer.Do(Format(Command, Args)); except on E: Exception do MessageBox(FOwner.Handle, PChar(Format('Ошибка выполнения () - %S', [E.Message])), 'Warning', MB_ICONINFORMATION OR MB_OK); end; end; //------------------------------------------------------------------------------ function TKDMapInfoServer.Eval(Command: String; const Args: array of const): TEvalResult; Function IsInt(Str : String): Boolean; var Pos : Integer; begin Result := True; For Pos := 1 To Length(Trim(Str)) do begin IF (Str[Pos] <> '0') and (Str[Pos] <> '1') and (Str[Pos] <> '2') and (Str[Pos] <> '3') and (Str[Pos] <> '4') and (Str[Pos] <> '5') and (Str[Pos] <> '6') and (Str[Pos] <> '7') and (Str[Pos] <> '8') and (Str[Pos] <> '9') and (Str[Pos] <> '.') Then Begin Result := False; Exit; end; end; end; var ds_save: Char; begin if Connected then begin Result.AsVariant := FServer.Eval(Format(Command, Args)); Result.AsString := Result.AsVariant; Result.AsBoolean := (Result.AsString = 'T') OR (Result.AsString = 't'); IF IsInt(Result.AsVariant) Then Begin try ds_save := DecimalSeparator; try DecimalSeparator := '.'; Result.AsFloat := StrToFloat(Result.AsString); finally DecimalSeparator := ds_save; end; except Result.AsFloat := 0.00; end; try Result.AsInteger := Trunc(Result.AsFloat); except Result.AsInteger := 0; end; end else Begin Result.AsInteger := 0; Result.AsFloat := 0.00; end; end; end; //------------------------------------------------------------------------------ procedure TKDMapInfoServer.SetActive(const Value: Boolean); begin FActive := Value; IF FActive then begin CreateMapInfoServer; WindowMapDef; Connected := True; end else begin IF Connected then begin DestroyMapInfoServer; Connected := False; end; end; end; //------------------------------------------------------------------------------ procedure TKDMapInfoServer.SetPanel(const Value: TPanel); begin FPanel := Value; end; procedure TKDMapInfoServer.WindowMapDef; begin ExecuteCommandMapBasic('Set Next Document Parent %D Style 1', [FPanel.Handle]); RepaintWindowMap; end; procedure TKDMapInfoServer.OpenMap(Path: String); begin ExecuteCommandMapBasic('Run Application "%S"', [Path]); MapperID := Eval('WindowInfo(FrontWindow(),%D)',[12]).AsInteger; RepaintWindowMap; end; procedure TKDMapInfoServer.DoSetStatus(StatusText: WideString); begin IF Assigned(FSetStatusTextEvent) then FSetStatusTextEvent(Self,StatusText); end; procedure TKDMapInfoServer.DoWindowContentsChanged(ID: Integer); begin IF Assigned(FWindowContentsChanged) then FWindowContentsChanged(Self,ID); end; procedure TKDMapInfoServer.DoMyEvent(Info: WideString); begin IF Assigned(FWindowContentsChanged) then FMyEvent(Self,Info); end; procedure TKDMapInfoServer.RepaintWindowMap; begin with PanelMap do MoveWindow(MapperID, 0, 0, FPanel.ClientWidth, FPanel.ClientHeight, True); end; { TEvent } function TEvent._AddRef: Integer; begin Result := 2; // Заглушка end; function TEvent._Release: Integer; begin Result := 1; // Заглушка end; constructor TEvent.Create(AnAppDispatch: IDispatch; const AnAppDispIntfIID: TGUID); begin Inherited Create; FAppDispatch := AnAppDispatch; FAppDispIntfIID := AnAppDispIntfIID; // Передадим серверу InterfaceConnect(FAppDispatch,FAppDispIntfIID,self,FAppConnection); end; destructor TEvent.Destroy; begin InterfaceDisConnect(FAppDispatch,FAppDispIntfIID,FAppConnection); inherited; end; function TEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; begin // Заглушка не реализовано Result := E_NOTIMPL; end; function TEvent.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; begin // Заглушка не реализовано Result := E_NOTIMPL; end; function TEvent.GetTypeInfoCount(out Count: Integer): HResult; begin // Заглушка не реализовано Count := 0; Result := S_OK; end; function TEvent.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; var Info,Status : String; IDWin : Integer; begin Case DispID of 1 : begin Status := TDispParams(Params).rgvarg^[0].bstrval; IF KDMapInfoServ <> nil Then KDMapInfoServ.DoSetStatus(Status); end; 2 : begin IDWin := TDispParams(Params).rgvarg^[0].bval; IF KDMapInfoServ <> nil Then KDMapInfoServ.DoWindowContentsChanged(IDWin); end; 3 : begin Info := TDispParams(Params).rgvarg^[0].bstrval; IF KDMapInfoServ <> nil Then KDMapInfoServ.DoMyEvent(Info); end; end; Result := S_OK; end; function TEvent.QueryInterface(const IID: TGUID; out Obj): HResult; begin Result := E_NOINTERFACE; IF GetInterface(IID,Obj) Then Result := S_OK; If IsEqualGUID(IID,FAppDispIntfIID) and GetInterface(IDispatch,Obj) Then Result := S_OK; end; end. И так что добавилось - Метод CreateMapInfoServer; // Создаем наш сервер OLE srv_ole := CreateOleObject('MICallBack.MapInfoCallBack') as IDispatch; srv_vtable := CoMapInfoCallBack.Create; // Получаем Idispatch созданного сервера srv_disp := CreateComObject(CLASS_MapInfoCallBack) as IMapInfoCallBackDisp; FEvent := TEvent.Create(srv_disp,IMapInfoCallBackEvents); // Указываем MapInfo что нужно передовать обратные вызовы нашему OLE серверу // а там далее по цепочке (см.начало) FServer.SetCallBack(srv_disp); end; Здесь мы столкнулись с еще одним методом MapInfo помимо рассмотренных ранее методов Do и Eval- Метод SetCallBack(IDispatch) Описание -
Регистрирует объект механизма-управления объектами OLE (OLE Automation) как получатель уведомлений, генерируемых программой MapInfo. Только одна функция уведомления может быть зарегистрирована в каждый данный момент. Параметр интерфейс Idispatch объекта OLE (COM)


Реализация FServer.SetCallBack(srv_disp); - данным кодом мы заставили MapInfo уведомлять наш OLE сервер.
Хорошо, скажете вы, ну заставили но он то уведомляет сервер OLE а не нашу программу, для этого я ввел следующий код (прим. Реализацию использования интерфейса событий OLE сервера я подробно расписывать не стану - для этого читайте в книгах главы по COM)
Я сделал так: ввел класс отвечающий за принятие событий от COM(OLE) объекта TEvent = class(TInterfacedObject,IUnknown,IDispatch) private FAppConnection : Integer; FAppDispatch : IDispatch; FAppDispIntfIID : TGUID; protected function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; function GetTypeInfoCount(out Count: Integer): HResult; stdcall; function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; public Constructor Create( AnAppDispatch : IDispatch; Const AnAppDispIntfIID : TGUID); Destructor Destroy ; override; end; создание этого класса в компоненте реализовано так FEvent := TEvent.Create(srv_disp,IMapInfoCallBackEvents); В методе Invoke и происходит прием и получение сообщений и пересылка их в обработчик моего компонента.
Еще раз на последующие вопросы касательно COM (OLE) серверов отвечу: данная тема выходит за рамки данной статьи - советую почитать книгу Александроского А.Д - Delphi 5 разработка корпоративных приложений.
Напоследок — модуль MICallBack_TLB.pas импортирован из DLL командой меню DELPHI Import Type Libray.
Примечание:
при импорте данный сервер инсталировать не нужно, нет смысла он нам нужен только для приема сообщений из MapInfo.
Вот в принципе все во второй части; создание пользовательских событий и обработка их в следующей главе.
До встречи
Скачать компонент (540 К)
2002 год.
Специально для

Обработка переданных данных


Когда пользователь использует команды или кнопки, MapInfo посылает Вашему OLE-методу строку, содержащую восемь элементов, разделенных запятыми. Например, строка, посланная MapInfo, может выглядеть так: "MI:-73.5548,42.122,F,F,-72.867702,43.025,202," Содержание такой строки проще понять, если Вы уже знакомы с функцией MapBasic CommandInfo(). Когда Вы пишете приложения, Вы можете создать новые команды меню и кнопки, вызывающие MapBasic-процедуры. Внутри процедуры-обработчика вызовите функцию CommandInfo(), чтобы получить информацию. Например, следующее обращение к функции определяет, координату Х и У места на карте где пользователи применил инструмент. var X,Y : String; begin KDMapInfoServer1.ExecuteCommandMapBasic('Set CoordSys Layout Units "mm"',[]); X := KDMapInfoServer1.Eval('CommandInfo(%S)',[CMD_INFO_X]).AsString; Y := KDMapInfoServer1.Eval('CommandInfo(%S)',[ CMD_INFO_Y]).AsString; ShowMessage('X= ' + X + ' Y = ' + Y);

ЗначениеКод для событий, связанных с меню Код для событий, связанных с кнопкой
1 CMD_INFO_X
2 CMD_INFO_Y
3 CMD_INFO_SHIFT
4 CMD_INFO_CTRL
5 CMD_INFO_X2
6 CMD_INFO_Y2
7 CMD_INFO_TOOLBTN
8CMD_INFO_MENUITEM

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

Строка, которую MapInfo посылает Вашему методу, выглядит следующим образом: "MI:" + CommandInfo(l) + "," + CommandInfo (2) + "," + CommandInfo(3) + "," + CommandInfo (4) + "," + CommandInfo(5) + "," + CommandInfo (6) + "," + CommandInfo (7) + "," + CommandInfo (8) Предположим, что Ваше приложение добавляет команду меню к локальному меню OLE-методу строку. Если команда меню имеет номер 101 , строка будут выглядеть следующим образом: "Ml :,,,,,,, 101" В этом случае большинство элементов строки пусто, потому что функция CommandInfo( ) может возвращать только эту одну часть информации.

Теперь предположим что вы создаете кнопку которая позволяет пользователю выбирать линии на карте.Строка теперь примет вид - "MI:-73.5548,42.122,F,F,-72.867702,43.025,202," Теперь строка включает несколько элементов.

Первые два элемента содержат х- и у координаты точки на которые пользователь указал мышкой
Следующие два элемента сообщают, была ли нажата клавиша SHIFT или CTRL
Предпоследнии два элемента содержат координаты точки где пользователь отпустил кнопку мышки.
И последний - указывает номер идентификатора кнопки.

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



Реализация и использование


Обработка текста реализована в модуле tem.pm. Процедура tem() получает три параметра: temname, outname и params. Первые два задают, соответственно имя файла шаблона и имя выходного генерируемого файла. Оба они могут быть неопределённы (undef). В этом случае случае будут использованы стандартный вводной поток (STDIN) и стандартный выводной поток соответственно. Третьим параметром передаётся в текстовом виде список параметров шаблона. Всю работу по замене вхождений параметров шаблона в текст их значениями выполняет процедура tem_process(). Хендлы файлов шаблона и генерируемого файла предаются ей параметрами, а наименования параметров и соответствующих им ключей - через переменную модуля хеш-таблицу params, в виде ключей хеша и их значений соответственно. Она обрабатывет текстовой файл построчно, и производит поочерёдно замену всех вхождений параметров значениями в тексте каждой строки. Сформированая при замене строка выводится как строка сгенерированного файла. Ниже приведён текст модуля tem.pm:

use File::Basename; my %params; sub tem_process { my $fin = shift; my $fout = shift; while () { chomp($l = $_); foreach (keys(%params)) { my $ppp = qr/\/; my $val = $params{$_}; $l =~ s/$ppp/$val/g; } print $fout $l,"\n"; } } sub tem { $temname = shift; $outname = shift; $params = shift; if ($temname) { open FIN,$temname die "can't open TEM\n"; } else { FIN = STDIN; } if ($outname) { open FOUT,'>',$outname die "can't open tem OUT\n"; } else { FOUT = STDOUT; } %params = eval '('.$params.')'; $params{"ModName"} = basename($outname,".pas",".PAS"); # а кроме pas ? tem_process(FIN,FOUT); close(FIN) if ($temname); close(FOUT) if ($outname); } 1; __END__

Просмотр исходных файлов и выполнение запросов на инстанциацию (генерацию экземляра исходного модуля по шаблону) осуществляется скриптом temss.pl (ss - это сокращение от "scan sources" - сканирование исходных). Пояснений здесь требует, пожалуй только шаблон поиска запросов: "/!TEM!(\s|\n)*(\S+)(\s|\n)*(\S+)(\s|\n)*((.|\n)*?)(\s|\n)*!MET!/" Он соответствует текстовым последовательностям, заключенным между "!TEM!" и "!MET!" (расположенных на отдельных строках), состоящим из двух строк с ненулевыми непробельными последовательностями, и любого количества строк с последовательностями любых символов. Значимые строки запроса могут перемежаться любым количеством пустых строк. Текстовой файл загружается в память целиком (обычная практика в Perl, он это умеет делать очень быстро) и по нему осуществляется глобальный поиск с приведённым выше шаблоном с последующим выполнением обнаруженных запросов. Ниже приведён текст скрипта:


temss. pl require Tem; sub ss { $src = shift; open FH,$src; my $l = join('',); close(FH); while ($l =~ /!TEM!(\s|\n)*(\S+)(\s|\n)*(\S+)(\s|\n)*((.|\n)*?)(\s|\n)*!MET!/g) { my $temname = $2; my $modname = $4; my $params = $6; print "generate $modname by $temname with\n>>\n"; tem($temname,$modname,$params); } } while () { ss($_); }

Скрипт запускается в директории с исходными модулями, использующими шаблоны. Он сканирует все файлы с расширениями ".pas" и ".dpr" и генерирует тексты исходных модулей по запросам. Если наличествует более одного уровня вложения шаблонов (т.е. одни шаблоны используют другие), то скрипт должен быть запущен соответствующее (количеству уровней вложения) количество раз.
Шаблоны оформляются в виде файлов с расширением ".tem". На текстовое содержание шаблона никаких ограничений не накладывается. Текст шаблона может содержать в себе последовательности вида "", где "ИМЯ_ПАРАМЕТРА" заменяется именем конкретного параметра шаблона (например "<ModName>"). Ниже приведён пример шаблона модуля с функциями Min, и Max (которые кажется первыми были реализованы в виде шаблонов в C++):
MinMax.tem unit <ModName>; interface function Min<Type>(X,Y: <Type>): <Type>; function Max<Type>(X,Y: <Type>): <Type>; implementation function Min<Type>; begin if X < Y then Result := X else Result := Y; end; function Max<Type>; begin if X > Y then Result := X else Result := Y; end; end.

Запрос на инстанциацию шаблона оформляется в тексте исходного модуля, использующего шаблон следующим образом: ... {!TEM! ИМЯ_ФАЙЛА_ШАБЛОНА ИМЯ_ГЕНЕРИРУЕМОГО_МОДУЛЯ ИМЯ_ПАРАМЕТРА1=>ЗНАЧЕНИЕ_ПАРАМЕТРА1, ИМЯ_ПАРАМЕТРА2=>ЗНАЧЕНИЕ_ПАРАМЕТРА2, ... !MET!} ... Имеется один дополнительный параметр - ModName (имя модуля), значение которого определяется именем генерируемого модуля (с отбрасыванием расширения). Приведённый выше шаблон может быть использован следующим образом: ... {!TEM! MinMax.tem MinMaxInt.pas Type=>Integer !MET!} ... В результате выполнения такого запроса получим приведённый ниже модуль:


MinMaxInt. pas unit MinMaxInt; interface function MinInteger(X,Y: Integer): Integer; function MaxInteger(X,Y: Integer): Integer; implementation function MinInteger; begin if X < Y then Result := X else Result := Y; end; function MaxInteger; begin if X > Y then Result := X else Result := Y; end; end.

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

Системные требования


Интегрированная картография требует наличия на компьютере MapInfo версии 4.0 или выше.Вы можете использовать полную версию MapInfo или так называемый исполняемый (Runtime) модуль (усеченная версия MapInfo поставляемая в качестве основы для специализированных приложений) Вы должны иметь опыт работы с Handle. Ваша программа должна быть способна действовать в качестве контроллера механизма управления объектами OLE (OLE Automation Controller) или клиента динамического обмена данных DDE. Рекомендуется применение OLE контроллера как более быстрого и надежного метода по сравнению c DDE. Его то мы и будем рассматривать



Получение данных о центральном процессоре.


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

Создаём новый проект и добавляем к нему компоненту TSWbemLocator, которая должна появиться в палитре компонент после импортирования указанных выше библиотек типов. Далее я буду давать комментарии непосредственно в коде программы.

unit Unit1; interface uses …, WbemScripting_TLB, OleServer, ActiveX; type TForm1 = class(TForm) … SWbemLocator1: TSWbemLocator; …; private { Private declarations } procedure ShowProp(SProp: SWBemProperty); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var Service: ISWbemServices; ObjectSet: ISWbemObjectSet; SObject: ISWbemObject; PropSet: ISWbemPropertySet; SProp: ISWbemProperty; PropEnum, Enum: IEnumVariant; TempObj: OleVariant; Value: Cardinal; StrValue: string; begin // Service:= SWbemLocator1.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil); // SObject:= Service.Get('Win32_Processor', wbemFlagUseAmendedQualifiers, nil); // ObjectSet:= SObject.Instances_(0, nil); { Далее нам нужно из коллекции ObjectSet получить экземпляр объекта, соответствующий классу Win32_Processor. Делается это с помощью метода Item объекта ObjectSet. В качестве первого параметра этого метода указывается путь к объекту, экземпляр которого вы желаете извлечь из коллекции. Данный метод возвращает объект типа SWbemObject. Но нам не известно, как выглядит этот путь. Использовать дополнительный класс SwbemObjectPath тоже нет никакого желания. Так что делаю "финт ушами": } // SObject:= ObjectSet.Item('???', 0); Enum:= (ObjectSet._NewEnum) as IEnumVariant; Enum.Next(1, TempObj, Value); SObject:= IUnknown(TempObj) as SWBemObject; { Полагаю, что данный приём понятен читателю и в комментариях не нуждается. Вот практически и всё - осталось прочитать интересующие нас свойства. Сколько было слов и как всё просто оказалось в действительности :) Перебираем свойства объекта SObject: } while (PropEnum.Next(1, TempObj, Value) = S_OK) do begin SProp:= IUnknown(TempObj) as SWBemProperty; StrValue:= ''; ListBox1.AddItem(SProp.Name, nil); ShowProp(SProp); end; end; procedure TForm1.ShowProp(SProp: SWBemProperty); begin if (SProp.Get_Value <> null) then begin with SProp do begin if Name = 'Name' then Label2.Caption:= Get_Value else if Name = 'Manufacturer' then …. end; { with } end; { if } end; end.

Пояснения к коду: Примечание 1 Подсоединяемся к пространству имён 'root\CIMV2' нашего компьютера. Метод ConnectServer принимает следующие параметры: objwbemServices = ConnectServer( [ strServer = "" ], [ strNameSpace = "" ], [ strUser = "" ], [ strPassword = "" ], [ strLocale = "" ], [ strAuthority = "" ], [ iSecurityFlags = 0 ], [ objwbemNamedValueSet = null ] ) strServer - необязательный к указанию параметр, содержащий имя компьютера к пространству имён которого вы желаете подключиться. Если не указан, имеется в виду данный компьютер; strNameSpace - необязательный к указанию параметр, содержащий строку, указывающую к какому пространству имён вы собираетесь подключиться. Если не указан, то устанавливается в значение по умолчанию. StrUser - необязательный к указанию параметр, содержащий строку с именем пользователя, которое будет использовано при подключении. При применении на локальной машине должна содержать нулевую строку. Применяется только при подключении к удалённой машине. StrPassword - см. StrUser. StrLocale - необязательный к указанию параметр, содержащий код местности (localization code). Должен содержать нулевую строку для применения действующего кода местности. StrAuthority - необязательный к указанию параметр, предназначенный для работы в сетях с системой Kerberos. ISecurityFlags - необязательный к указанию параметр. Если содержит 0, то метод ConnectServer вернёт результат только после того, как соединение с сервером будет установлено, т.е. если соединение установить не удалось - ваша программа повиснет. Если содержит значение wbemConnectFlagUseMaxWait, то приложение ждёт две минуты после чего возвращает код ошибки. ObjwbemNamedValueSet - необязательный к указанию параметр. Обычно его не определяют (nil). Вообще говоря, можно указать объект типа SWbemNamedValueSet, который будет содержать информацию, которая может быть использована провайдером, обслуживающим данный запрос. Подробнее обо всех свойствах см. Platform SDK.

Примечание 2 Теперь получим описание интересующего нас класса, т.е. Win32_Processor.
Делается это с помощью метода Get полученного нами объекта Service.
Метод Get принимает следующие параметры: objWbemObject = Get( [ strObjectPath = "" ], [ iFlags = 0 ], [ objWbemNamedValueSet = null ] ) strObjectPath - необязательный к указанию параметр, содержащий название класса, описание которого мы желаем получить. Если данный параметр будет содержать нулевую строку, то будет создан новый класс. IFlags - необязательный к указанию параметр. Принимает только одно значение: wbemFlagUseAmendedQualifiers. ObjWbemNamedValueSet - см. выше. Подробнее обо всех свойствах см. Platform SDK.

Примечание 3 Теперь надо получить коллекцию экземпляров класса Win32_Processor.
Делается это с помощью метода Instances_ объекта SObject.
Метод Instances_ принимает следующие параметры: objWbemObjectSet = Instances_( [ iFlags = wbemFlagReturnImmediately ], [ objwbemNamedValueSet = null ] ) iFlags - необязательный к указанию параметр, содержащий числовое значение типа Integer, определяющее поведение данного запроса. ObjwbemNamedValueSet - см. выше. Подробнее обо всех свойствах см. Platform SDK.

Исходный код и exe-файл данного примера вы сможете найти в прилагаемом к статье архиве в каталогах \source\GetProcessorData и \Exe-files соответственно.

Вот что у меня получилось:



Получение данных о запущенных процессах.


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

… var Form1: TForm1; ListItem: TListItem; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var Service: ISWbemServices; ObjectSet: ISWbemObjectSet; SObject: ISWbemObject; PropSet: ISWbemPropertySet; SProp: ISWbemProperty; PropEnum, Enum: IEnumVariant; TempObj: OleVariant; Value: Cardinal; Column: TListColumn; begin ListView1.Items.BeginUpdate; ListView1.Items.Clear; Service:= SWbemLocator1.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil); SObject:= Service.Get('Win32_Process', wbemFlagUseAmendedQualifiers, nil); ObjectSet:= SObject.Instances_(0, nil); Enum:= (ObjectSet._NewEnum) as IEnumVariant; { На данном этапе начинаются некоторые незначительные отличия от первого примера. В предыдущем примере, мы знали, что у нас был единственный экземпляр класса Win32_Processor, характеризующий центральный процессор. В данном примере мы имеем столько экземпляров, сколько запущенных процессов, поэтому их все необходимо перебрать и получить их свойства: } // в этом цикле перебираю все имеющиеся экземпляры while (Enum.Next(1, TempObj, Value) = S_OK) do begin SObject:= IUnknown(TempObj) as SWBemObject; PropSet:= SObject.Properties_; PropEnum:= (PropSet._NewEnum) as IEnumVariant; ListItem:= ListView1.Items.Add; // перебираю свойства while (PropEnum.Next(1, TempObj, Value) = S_OK) do begin SProp:= IUnknown(TempObj) as SWBemProperty; if ListView1.Items.Count = 1 then begin Column := ListView1.Columns.Add; Column.Width := 100; Column.Caption := SProp.Name; end; ShowProp(SProp); end; end; { while } ListView1.Items.EndUpdate; end; // В процедуре ShowProp происходит определение типа свойства // и соответствующие приведение типа. procedure TForm1.ShowProp(SProp: ISWbemProperty); var StrValue: string; Count: Cardinal; begin StrValue:= ''; if VarIsNull(SProp.Get_Value) then StrValue:= '<empty>' else case SProp.CIMType of //******************************************************************// wbemCimtypeUint8, wbemCimtypeSint8, wbemCimtypeUint16, wbemCimtypeSint16, wbemCimtypeUint32, wbemCimtypeSint32, wbemCimtypeSint64: if VarIsArray(SProp.Get_Value) then begin if VarArrayHighBound(SProp.Get_Value, 1) > 0 then for Count:= 1 to VarArrayHighBound(SProp.Get_Value, 1) do StrValue:= StrValue + ' ' + IntToStr(SProp.Get_Value[Count]); end else StrValue:= IntToStr(SProp.Get_Value); //******************************************************************// wbemCimtypeReal32, wbemCimtypeReal64: StrValue:= FloatToStr(SProp.Get_Value); //******************************************************************// … //******************************************************************// else MessageBox(0, PChar('Unknown type'), PChar(Form1.Caption), MB_OK); end; {case} if ListItem.Caption = '' then ListItem.Caption := StrValue else ListItem.SubItems.Add(StrValue); end; end.

Исходный код и exe-файл данного примера вы сможете найти в прилагаемом к статье архиве в каталогах \source\ GetProcessData и \Exe-files соответственно.

А выглядит это так:



Запуск приложений и выключение компьютера.


В данном примере я продемонстрирую, как использовать методы, предоставляемые провайдерами.

… var Form1: TForm1; Service: ISWbemServices; InParam, OutParam, SObject, Process: ISWbemObject; Method: ISWbemMethod; SProp1, SProp2, MyProperty: ISWbemProperty; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var PropValue: OleVariant; begin Service:= SWbemLocator1.ConnectServer('.', 'root\cimv2', '', '', '', '', 0, nil); // Service.Security_.Set_ImpersonationLevel(wbemImpersonationLevelImpersonate); Process:= Service.Get('Win32_Process', 0, nil); // Method:= Process.Methods_.Item('Create', 0); // InParam:= Method.InParameters.SpawnInstance_(0); // MyProperty:= InParam.Properties_.Add('CommandLine', wbemCimtypeString, False, 0); { С помощью метода Set_Value объекта ISWbemProperty присваеваем свойству CommandLine значение Notepad.exe } PropValue:= 'Notepad.exe'; MyProperty.Set_Value(PropValue); // После того, как все входные свойства определены, запускаем приложение. // OutParam - объект, возвращаемый методом ExecMethod_ OutParam:= Process.ExecMethod_('Create', InParam, 0, nil); // Получения выходных параметров из возвращённого объекта OutParam типа SWbemObject SProp1:= outParam.Properties_.Item('ReturnValue', 0); // Проверяю, удалось ли запустить приложение. Если свойство ReturnValue не равно 0, // то произошла ошибка. if SProp1.Get_Value = 0 then begin SProp2:= outParam.Properties_.Item('ProcessID', 0); Button2.Enabled:= True; Button1.Enabled:= False; sleep(300); SetForegroundWindow(Form1.Handle); end else MessageBox(0, PChar('Не удалось запустить приложение.'), PChar(Form1.Caption), MB_OK); end; procedure TForm1.Button2Click(Sender: TObject); var PropValue: OleVariant; begin SObject:= Service.Get('Win32_Process.Handle="' + WideString(SProp2.Get_Value) + '"', 0, nil); Method:= SOBject.Methods_.Item('Terminate', 0); InParam:= Method.InParameters.SpawnInstance_(0); MyProperty:= InParam.Properties_.Add('Reason', wbemCimtypeUint32, False, 0); PropValue:= 0; MyProperty.Set_Value(PropValue); OutParam:= SObject.ExecMethod_('Terminate', InParam, 0, nil); SProp1:= outParam.Properties_.Item('ReturnValue', 0); if SProp1.Get_Value = 0 then begin Button1.Enabled:= True; Button2.Enabled:= False; end else MessageBox(0, PChar('Не удалось закрыть приложение.'), PChar(Form1.Caption), MB_OK); end; procedure TForm1.Button3Click(Sender: TObject); var ObjectSet: ISWbemObjectSet; Enum: IEnumVariant; TempObj: OleVariant; Value: Cardinal; begin // Выключение компьютера - использование Shutdown без свойств. if MessageBox(0, PChar('Если вы выберете ''Да'', ваш компьютер выключится!'), PChar(Form1.Caption), MB_YESNO or MB_ICONEXCLAMATION or MB_DEFBUTTON2) = mrYes then begin Service:= SWbemLocator1.ConnectServer('.', 'root\cimv2', '', '', '', '', 0, nil); Service.Security_.Privileges.Add(wbemPrivilegeShutdown, True); // // SObject:= Service.Get('Win32_OperatingSystem', wbemFlagUseAmendedQualifiers, nil); // ObjectSet:= SObject.Instances_(0, nil); ObjectSet:= Service.ExecQuery('SELECT * FROM Win32_OperatingSystem WHERE Primary=True', 'WQL', wbemFlagReturnImmediately, nil); Enum:= (ObjectSet._NewEnum) as IEnumVariant; while (Enum.Next(1, TempObj, Value) = S_OK) do begin SObject:= IUnknown(tempObj) as SWBemObject; SObject.ExecMethod_('Shutdown', nil, 0, nil); end; end; { if MessageBox } end; end.

Пояснения к коду: Примечание 1 Security_ - данное свойство используется в том случае, когда вы собираетесь считать или установить настройки безопасности для объекта SWbemServices. Объект SWbemSecurity имеет следующие свойства: AuthenticationLevel, ImpersonationLevel, Privileges. Нас в данном случае будет интересовать только второе свойство. ImpersonationLevel - Числовое значение. Данное свойство определяет, может ли процесс, владельцем которого является WMI, пользоваться правами вашей учётной записи, что может быть необходимо при обращении к другим процессам. Я буду пользоваться значением '3' (wbemImpersonationLevelImpersonate), что означает, что я наделяю данный объект правами того, кто его вызвал. Об остальных уровнях наследования прав читайте в SDK.

Примечание 2 Свойство Methods_ объекта SWbemObject представляет собой объект типа SWbemMethodSet, который является не чем иным, как коллекцией методов данного класса (или экземпляра класса).
Данное свойство предназначено только для чтения (read-only).

Единственный метод Item объекта SWbemMethodSet возвращает объект типа SWbemMethod.
Метод Item принимает следующие параметры: objMethod = Item( strName, [ iFlags = 0 ] ) strName - необходимый параметр. Имя метода, указатель на который должен быть возвращён данным методом.

Примечание 3 Свойство InParameters объекта SWbemMethod определяет входные параметры для данного метода. Метод SpawnInstance_ объекта SWbemObject создаёт новый экземпляр класса.
Данный метод имеет следующие входные параметры: objNewInstance = SpawnInstance_( [ iFlags = 0 ] ) Единственный параметр iFlags зарезервирован и не обязателен к указанию.
Если указывается, то должен быть равен 0.

Примечание 4 Свойство Properties_ объекта SWbemObject представляет собой объект типа SWbemPropertySet, который является коллекцией свойств для данного класса или экземпляра.
Метод Add объекта SWbemPrivilegeSet добавляет объект типа SWbemProperty к объекту SWbemPrivilegeSet.
Данный метод имеет следующие входные параметры: objProperty = Add( strName, iCIMType, [ bIsArray = FALSE ], [ iFlags = 0 ] ) strName - обязательный к указанию параметр. Имя нового свойства. iCIMType - обязательный к указанию параметр. Определяет тип (CIMType) свойства. bIsArray - необязательный к указанию параметр. Определяющий является ли данное свойство массивом. По умолчанию False. iFlags - необязательный к указанию параметр. Зарезервирован. Если указывается, то должен быть равен 0.

Примечание 5 Для получения коллекции экземпляров Win32_OperatingSystem я намеренно воспользовался методом ExecQuery объекта ISWbemServices, что бы продемонстрировать работу данной ф-ии.
Использование данного метода равносильно используемой мною ранее конструкции.

Кстати, синтаксис WQL вам ничего не напоминает? ;) Правильно - WQL прямой потомок ANSI SQL, и соответствует синтаксису SQL. В WQL введены незначительные семантические изменения необходимые для работы с WMI. Так что вам даже не придётся учить новый язык запросов, для того что бы использовать WMI - Microsoft оказалась гуманной и мудрой в этом отношении и в очередной раз не усложнила нашу жизнь :)
Для интересующихся правилами составления запросов: откруваем SDK, раздел "Querying with WQL", всё понятно и доступно.
Исходный код и exe-файл данного примера вы сможете найти в прилагаемом к статье архиве в каталогах \source\ UseMethods и \Exe-files соответственно.



Получения значений c температурных сенсоров и с установленных вентиляторов.


Данный пример не содержит каких-либо новых решений или приёмов, кроме проверки на существование провайдера (вернее возможности работать с ним), осуществляющего связь между требуемым компонентом системы и программой. У меня (Chaintech 7VJL (Apogee) VIA KT333 / Athlon XP 1600+ / Windows 2000 Professional SP3) не удаётся получить свойства некоторых классов, например, Win32_Fan и Win32_TemperatureProbe. Выражается это в том, что не удаётся получить экземпляр ни одного из этих классов. Дело в том, что WMI не может получить доступ к WMI провайдеру. Но, т.к. данные классы имеются в хранилище CIM классов, то получить описание данных классов удаётся: Service:= SWbemLocator1.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil); SObject:= Service.Get('Win32_Fan', wbemFlagUseAmendedQualifiers, nil); Но при выполнении: ObjectSet:= SObject.Instances_(0, nil); Метод Instances_ не возвращает требуемой коллекции экземпляров и функция Enum.Next(1, TempObj, Value) вернёт значение S_FALSE, а при попытке выполнить PropSet := SObject.Properties_; как я сделал в первом примере, вы получите отказ в доступе (Access Violation), причина понятна….

Я проверял работу данного примера и на материнской плате Gigabyte VIA KT266 с аналогичным процессором и операционной системой - результат тот же.

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

Между тем, имеется информация о том, что данные параметры удаётся без проблем получить на материнских платах с чипсетами (chipset) фирмы Intel. Ничего по этому поводу сказать не могу - у меня в момент написания данной статьи не было возможности протестировать данный пример на компьютерах на базе чипсетов от Intel.

Исходный код и exe-файл данного примера вы сможете найти в прилагаемом к статье архиве в каталогах \source\ FanAndTemperature и \Exe-files соответственно.



Другие краткие технические замечания


Интегрированная картография использует механизм управления OLE , но не использует OLE - внедрение. Интегрированная картография не использует элементы управления VBX или OCX (дело не совсем так - существует OCX модуль MapX - для работы с ГИС MapInfo (не входит в стандартный комплект поставки) , но это уже не интегрированная картография и он рассматриваться не будет). Интегрированная картография не предоставляет вам какие либо заголовочные файлы и библиотеки Интегрированная картография включает несколько DLL библиотек но не предоставляет к ним доступ напрямую.



Примечание 1: Описание констант MapInfo (Global.pas)


Примечание - данный файл был взят мной с Интернета. Хочу сразу сделать предупреждение - разработчики MapInfo заявляют что набор констант может быть подвергнут изменениям в следующих редакциях MapInfo.Данный набор констант адаптирован под пятую версию. К сожалению шестой версии у меня нет (может кто поделиться ;-) ) и соответственно нет возможности проверить изменился ли набор констант или нет.

Скачать Посмотреть

Вот в принципе и все что нужно для работы с MapInfo в Delphi, дерзайте

Скачать компонент (527 К)

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



Пример


Рассмотрим более сложный пример - шаблон дерева для базовых типов языка (атомарных - числовых, строковых, указателей, перечислымых и множеств; конструируемых - записей и массивов). Дерево состоит из узлов (nodes), каждый из которых содержит список подчинённых ему узлов дерева, ссылку на следующий элемент по списку родительского узла, ссылку на следующий по списку всех узлов, ссылку на родительский узел и собственно данные узла. Этот шаблон использует шаблон "несамостоятельного" списка (inferior list), состоящий из двух частей - шаблона типа, и шаблона процедур списка. Модули, полученные в результате инстанциации этих шаблонов, используются в модуле, полученном в результате инстанциации шаблона дерева прямым включением (директива компиллятора "{$I ...}"). Учитывая вложенность шаблонов скрипт temss нужно запустить два раза. Ниже приведён отрывок файла README из прилагаемого к статье архива с перечислением файлов, относящихся к данному примеру:

inferiorlist_type.tem Шаблон "несамостоятельного" списка temss1.out temss2.out Снимки протоколов первого и второго прохода препроцессора для модуля xTree.pas tree.tem Шаблон дерева treeStr.pas treeStr_AllNodes_Procs.pas treeStr_AllNodes_Type.pas treeStr_NodesList_Procs.pas treeStr_NodesList_Type.pas Инстант дерева для типа типа String xTree.exe xTree.pas Пример использования шаблона дерева EXE слинкован с runtime-пакетами (Delphi 3.0) !

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



Взаимодействие с DLL


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

TDllFunction = function(aInterface: Pointer): Pointer; StdCall;

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

IMaster = class public procedure Method1; virtual; abstract; ............. end;

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

uses UnitIMaster, UnitISlave; type TSlaveObject = class(ISlave) private FMain: IMain; public constructor Create(aMain: IMain); destructor Destroy; override; procedure Method1; override; ............ end; function CreateSlave(aInterface: Pointer): Pointer; stdcall; function DestroySlave(aInterface: Pointer): Pointer; stdcall; implementation var SlaveObject: TSlaveObject; // Реализация TSlaveObject ............ function CreateSlave(aInterface: Pointer): Pointer; begin SlaveObject := TSlaveObject.Create(IMaster(aInterface)); result := SlaveObject; end; function DestroySlave(aInterface: Pointer): Pointer; begin SlaveObject.Free; SlaveObject := nil; result := nil; end; initialization SlaveObject := nil; finalization SlaveObject.Free; end.



Запуск и связывание с сервером MapInfo


Итак рассмотрим простейший компонент для запуска и управления MapInfo (TKDMapInfoServer),следует заметить что мной не ставилась написание специализированного компонента - я представляю основы. unit KDMapInfoServer; interface uses ComObj,Controls,Variants,ExtCtrls,Windows,Messages,SysUtils,Classes; const scMapInfoWindowClass = 'xvt320mditask100'; icWinMapinfo = 1011; icWinInfoWindowid = 13; type TEvalResult = record AsVariant: OLEVariant; AsString: String; AsInteger: Integer; AsFloat: Extended; AsBoolean: Boolean; end; TKDMapInfoServer = class(TComponent) private // Владелец FOwner : TWinControl; // OLE сервер FServer : Variant; FHandle : THandle; FActive : Boolean; FPanel : TPanel; Connected : Boolean; MapperID : Cardinal; MapperNum : Cardinal; procedure SetActive(const Value: Boolean); procedure SetPanel(const Value: TPanel); procedure CreateMapInfoServer; procedure DestroyMapInfoServer; { Private declarations } protected { Protected declarations } public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; // Данная процедура выполеняет метод сервера MapInfo - Do procedure ExecuteCommandMapBasic(Command: String; const Args: array of const); // Данная процедура выполеняет метод сервера MapInfo - Eval function Eval(Command: String; const Args: array of const): TEvalResult; virtual; procedure WindowMapDef; procedure OpenMap(Path : String); published { Published declarations } // Создает соединение с сервером MapInfo property Active: Boolean read FActive write SetActive; property PanelMap : TPanel read FPanel write SetPanel; end; procedure Register; implementation procedure Register; begin RegisterComponents('Kuzan', [TKDMapInfoServer]); end; { TKDMapInfoServer } constructor TKDMapInfoServer.Create(AOwner: TComponent); begin inherited Create(AOwner); FOwner := AOwner as TWinControl; FHandle := 0; FActive := False; Connected := False; end; destructor TKDMapInfoServer.Destroy; begin DestroyMapInfoServer; inherited Destroy; end; //------------------------------------------------------------------------------ procedure TKDMapInfoServer.CreateMapInfoServer; begin try FServer := CreateOleObject('MapInfo.Application'); except FServer := Unassigned; end; // Скрываем панели управления MapInfo ExecuteCommandMapBasic('Alter ButtonPad ID 4 ToolbarPosition (0, 0) Show Fixed', []); ExecuteCommandMapBasic('Alter ButtonPad ID 3 ToolbarPosition (0, 2) Show Fixed', []); ExecuteCommandMapBasic('Alter ButtonPad ID 1 ToolbarPosition (1, 0) Show Fixed', []); ExecuteCommandMapBasic('Alter ButtonPad ID 2 ToolbarPosition (1, 1) Show Fixed', []); // Переопределяем окна ExecuteCommandMapBasic('Close All', []); ExecuteCommandMapBasic('Set ProgressBars Off', []); ExecuteCommandMapBasic('Set Application Window %D', [FOwner.Handle]); ExecuteCommandMapBasic('Set Window Info Parent %D', [FOwner.Handle]); FServer.Application.Visible := True; if IsIconic(FOwner.Handle)then ShowWindow(FOwner.Handle, SW_Restore); BringWindowToTop(FOwner.Handle); end; procedure TKDMapInfoServer.DestroyMapInfoServer; begin ExecuteCommandMapBasic('End MapInfo', []); FServer := Unassigned; end; //------------------------------------------------------------------------------ procedure TKDMapInfoServer.ExecuteCommandMapBasic(Command: String; const Args: array of const); begin if Connected then try FServer.Do(Format(Command, Args)); except on E: Exception do MessageBox(FOwner.Handle, PChar(Format('Ошибка выполнения () - %S', [E.Message])),'Warning',MB_ICONINFORMATION OR MB_OK); end; end; //------------------------------------------------------------------------------ function TKDMapInfoServer.Eval(Command: String; const Args: array of const): TEvalResult; Function IsInt(Str : String): Boolean; var Pos : Integer; begin Result := True; For Pos := 1 To Length(Trim(Str)) do begin IF (Str[Pos] <> '0') and (Str[Pos] <> '1') and (Str[Pos] <> '2') and (Str[Pos] <> '3') and (Str[Pos] <> '4') and (Str[Pos] <> '5') and (Str[Pos] <> '6') and (Str[Pos] <> '7') and (Str[Pos] <> '8') and (Str[Pos] <> '9') and (Str[Pos] <> '.') Then Begin Result := False; Exit; end; end; end; var ds_save: Char; begin if Connected then begin Result.AsVariant := FServer.Eval(Format(Command, Args)); Result.AsString := Result.AsVariant; Result.AsBoolean := (Result.AsString = 'T') OR (Result.AsString = 't'); IF IsInt(Result.AsVariant) Then Begin try ds_save := DecimalSeparator; try DecimalSeparator := '.'; Result.AsFloat := StrToFloat(Result.AsString);//Result.AsVariant; finally DecimalSeparator := ds_save; end; except Result.AsFloat := 0.00; end; try Result.AsInteger := Trunc(Result.AsFloat); except Result.AsInteger := 0; end; end else Begin Result.AsInteger := 0; Result.AsFloat := 0.00; end; end; end; //------------------------------------------------------------------------------ procedure TKDMapInfoServer.SetActive(const Value: Boolean); begin FActive := Value; IF FActive then begin CreateMapInfoServer; WindowMapDef; Connected := True; end else begin IF Connected then begin DestroyMapInfoServer; Connected := False; end; end; end; //------------------------------------------------------------------------------ procedure TKDMapInfoServer.SetPanel(const Value: TPanel); begin FPanel := Value; end; procedure TKDMapInfoServer.WindowMapDef; begin ExecuteCommandMapBasic('Set Next Document Parent %D Style 1', [FPanel.Handle]); end; procedure TKDMapInfoServer.OpenMap(Path: String); begin ExecuteCommandMapBasic('Run Application "%S"', [Path]); MapperID := Eval('WindowInfo(FrontWindow(),%D)',[12]).AsInteger; with PanelMap do MoveWindow(MapperID, 0, 0, FPanel.ClientWidth, FPanel.ClientHeight, True); end; end. И так что мы имеем - Мы установили связь с сервером MapInfo. Мы узнали что у сервера MapInfo есть метод Do - он предназначен для посылки команд MapBasic серверу точно так-же как если бы пользователь набирал их в окне MapBasic-а самой программы MapInfo. Мы узнали что у сервера MapInfo есть метод Eval- он предназначен для получения значение функций после посылки команд MapBasic серверу. Мы познакомились с командами переопределения направления вывода MapInfo. Для начала неплохо



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


Larry Wall - за силу и красоту языка Perl Bjarne Stroustrup - за язык C++ вообще, и за идею шаблонов (templates) в частности.

Скачать архив : (8 К)
Архив Src.ZIP содержит все упомянутые в статье скрипты и исходные модули.
Perl-модули отлажены и проверены в среде Windows c Perl 5.6.1 (инсталляция собственной сборки с MinGW32 - GNU C 2.95.3-4).

Гусев А.В.




А теперь о перемещениях.


Существуют 2 вида перемещений мыши с помощью клавиатуры: явные-визуальные и событийные (компонентов). 1. Явные перемещения мыши производятся объектом Mouse Что бы переместить мышь в любую область экрана нужно написать: Mouse.CursorPos:=point(0,0) Размеры экрана мы знаем из объекта Screen.
Вызвать нажатие кнопки можно : SendMessage(Button1.handle, BM_CLICK, 0, 0); 2. Вызов СОБЫТИЙ перемещения и нажатий кнопок мыши. Это то, что нам и нужно для программирования интерфейсов в VCL. а) Нужно получить доступ к процедурам обрабатывающим события мыши. Как правило они находятся в приватной секции и доступ к ним осуществляется в эмуляции создания класса-наследника. Type HackSplitter=class(TSplitter); // кто не знает Доступ к приватным методам осуществляется так: HackSplitter(SplitterLeft).MouseDown

А теперь рабочий пример:

Замечание:
Обработчик эмуляции мыши нужно обязательно ставить на TForm указав свойство KeyPreview:=true в инспекторе объектов.

const iInc:byte=1;// медленное перемещение iIncSpeed:byte=10; // быстрое перемещение iStartSpeed:byte=10;// счетчик когда вкл быстрое перемещение var bDown:boolean; mX,mY, // перемещения мыши iIncCountL,iIncCountR:integer; // счетчики Type HackSplitter=class(TSplitter); // доступ к протект свойствам procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState); Procedure SetSplit; // процедура установки события MouseDown var iSysCaption:integer; // размер заголовка окна begin bDown:=True; // мы нажали мышь // получили высоту заголовка iIncCountL:=0;iIncCountR:=0; // сброс счетчиков iSysCaption:=GetSystemMetrics(SM_CYCAPTION); // размер высоты заголовка mX:=SplitterLeft.Left+2; // записали позицию SplitterLeft mY:=SplitterLeft.Top; // вызвали событие нажатия кнопки в позиции над SplitterLeft HackSplitter(SplitterLeft).MouseDown(mbLeft,Shift+[ssLeft],mX,mY); end; begin case Key of VK_LEFT://PanelLeft.Width:=PanelLeft.Width-20; - вот оно "грязное перемещение" первого варианта, попробуйте для примера и его :) begin If ssShift in Shift then // перемещаем на ssShift begin If not bDown then SetSplit; // Эмуляция события нажатия кнопки // Выставляем впереди, а не по begin else begin, потому что // нужно обрабатывать еденичные перемещения If iIncCountL>iStartSpeed then // время включения "скоростного" перемещения mX:=mX-iIncSpeed else mX:=mX-iInc; //mY:=mY - по высоте мы не перемещаем HackSplitter(SplitterLeft).MouseMove(Shift+[ssLeft],mX,mY); iIncCountR:=0; // счетчики inc(iIncCountL); end; end; VK_RIGHT://PanelLeft.Width:=PanelLeft.Width+20; begin If ssShift in Shift then begin If not bDown then SetSplit; If iIncCountR>iStartSpeed then mX:=mX+iIncSpeed else mX:=mX+iInc; HackSplitter(SplitterLeft).MouseMove(Shift+[ssLeft],mX,mY); iIncCountL:=0; inc(iIncCountR); end; end; end; end; procedure TForm1.FormShow(Sender: TObject); begin bDown:=False;// авто сброс end; procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin If bDown and (not (ssCtrl in Shift)) then begin bDown:=False; HackSplitter(SplitterLeft).MouseUp(mbLeft,Shift+[ssLeft],mX,mY); end; end; Замечание при использования перемещения 2-х TSplitter одновременно.
Когда я сделал тестовый пример, где 2 TSplitter были в виде "прицела", в рабочей форме, это вызывало переполнение стека после изменения размеров. С каким компонентом происходил "конфликт" или между самими TSplitter я не разбирался, просто сделал переключатель на монопольное перемешение одного TSplitter.

Переполнение исчезло.

Шевченко Владимир aka AWS
сентябрь 2002г.
Специально для



А теперь - примеры.


Разумеется, вам нужно вставить в секцию uses модуль ShellAPI, в котором определена функция SHFileOperation.

Рассмотрим самое простое - удаление файлов.

procedure TForm1.Button1Click(Sender: TObject); var SHFileOpStruct : TSHFileOpStruct; From : array [0..255] of Char; begin SetCurrentDirectory( PChar( 'C:\' ) ); From := 'Test1.tst' + #0 + 'Test2.tst' + #0 + #0; with SHFileOpStruct do begin Wnd := Handle; wFunc := FO_DELETE; pFrom := @From; pTo := nil; fFlags := 0; fAnyOperationsAborted := False; hNameMappings := nil; lpszProgressTitle := nil; end; SHFileOperation( SHFileOpStruct ); end; Обратите внимание, что ни один из флагов не установлен. Если вы хотите не просто удалить файлы, а переместить их в корзину, должен быть установлен флаг FOF_ALLOWUNDO.

Для удобства дальнейших экспериментов напишем функцию, создающую из массива строк буфер для передачи его в качестве параметра pFrom. После каждой строки в буфер вставляется нулевой байт, в конце списка - два нулевых байта. type TBuffer = array of Char; procedure CreateBuffer( Names : array of string; var P : TBuffer ); var I, J, L : Integer; begin for I := Low( Names ) to High( Names ) do begin L := Length( P ); SetLength( P, L + Length( Names[ I ] ) + 1 ); for J := 0 to Length( Names[ I ] ) - 1 do P[ L + J ] := Names[ I, J + 1 ]; P[ L + J ] := #0; end; SetLength( P, Length( P ) + 1 ); P[ Length( P ) ] := #0; end; Выглядит ужасно, но работает. Можно написать красивее, просто лень.

И, наконец, функция, удаляющая файлы, переданные ей в списке Names. Параметр ToRecycle определяет, будут ли файлы перемещены в корзину или удалены. Функция возвращает 0, если операция выполнена успешно, и ненулевое значение, если руки у кого-то растут не из того места, и этот кто-то всунул функции имена несуществующих файлов. function DeleteFiles( Handle : HWnd; Names : array of string; ToRecycle : Boolean ) : Integer; var SHFileOpStruct : TSHFileOpStruct; Src : TBuffer; begin CreateBuffer( Names, Src ); with SHFileOpStruct do begin Wnd := Handle; wFunc := FO_DELETE; pFrom := Pointer( Src ); pTo := nil; fFlags := 0; if ToRecycle then fFlags := FOF_ALLOWUNDO; fAnyOperationsAborted := False; hNameMappings := nil; lpszProgressTitle := nil; end; Result := SHFileOperation( SHFileOpStruct ); Src := nil; end; Обратите внимание, что мы освобождаем буфер Src простым присваиванием значения nil. Если верить документации, потери памяти при этом не происходит, а напротив, происходит корректное уничтожение динамического массива. Каким образом, правда - это рак мозга :-).


Проверяем : procedure TForm1.Button1Click(Sender: TObject); begin DeleteFiles( Handle, [ 'C:\Test1', 'C:\Test2' ], True ); end; Вроде все работает.

Кстати, обнаружился забавный глюк - вызовем процедуру DeleteFiles таким образом: procedure TForm1.Button1Click(Sender: TObject); begin SetCurrentDirectory( PChar( 'C:\' ) ); DeleteFiles( Handle, [ 'Test1', 'Test2' ], True ); end; Файлы 'Test1' и 'Test2' удаляются совсем, без помещения в корзину, несмотря на установленный флаг FOF_ALLOWUNDO. Мораль: при использовании функции SHFileOperation используйте полные пути всегда, когда это возможно.
Ну, с удалением файлов разобрались.

Теперь очередь за копированием и перемещением.

Следующая функция перемещает файлы указанные в списке Src в директорию Dest. Параметр Move определяет, будут ли файлы перемещаться или копироваться. Параметр AutoRename указывает, переименовывать ли файлы в случае конфликта имен. function CopyFiles( Handle : Hwnd; Src : array of string; Dest : string; Move : Boolean; AutoRename : Boolean ) : Integer; var SHFileOpStruct : TSHFileOpStruct; SrcBuf : TBuffer; begin CreateBuffer( Src, SrcBuf ); with SHFileOpStruct do begin Wnd := Handle; wFunc := FO_COPY; if Move then wFunc := FO_MOVE; pFrom := Pointer( SrcBuf ); pTo := PChar( Dest ); fFlags := 0; if AutoRename then fFlags := FOF_RENAMEONCOLLISION; fAnyOperationsAborted := False; hNameMappings := nil; lpszProgressTitle := nil; end; Result := SHFileOperation( SHFileOpStruct ); SrcBuf := nil; end; Ну, проверим. procedure TForm1.Button1Click(Sender: TObject); begin CopyFiles( Handle, [ 'C:\Test1', 'C:\Test2' ], 'C:\Temp', True, True ); end; Все в порядке (а кудa ж оно денется).

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

Осталась последняя операция - переименование. function RenameFiles( Handle : HWnd; Src : string; New : string; AutoRename : Boolean ) : Integer; var SHFileOpStruct : TSHFileOpStruct; begin with SHFileOpStruct do begin Wnd := Handle; wFunc := FO_RENAME; pFrom := PChar( Src ); pTo := PChar( New ); fFlags := 0; if AutoRename then fFlags := FOF_RENAMEONCOLLISION; fAnyOperationsAborted := False; hNameMappings := nil; lpszProgressTitle := nil; end; Result := SHFileOperation( SHFileOpStruct ); end;

И проверка ...

procedure TForm1.Button1Click(Sender: TObject); begin RenameFiles( Handle, 'C:\Test1' , 'C:\Test3' , False ); end; Пока все ...
Mодуль (3K) прилагается.

ADO и файлы формата MS Access


- Учитель, почему ты обманул меня? Ты сказал, что Вейдер предал и убил моего отца, а теперь оказалось, что он и есть мой отец!
- Твой отец… Его соблазнила темная сторона силы. Он больше не был Анекином Скайукером и стал Дартом Вейдером. Поэтому хороший человек, который был твоим отцом, был уничтожен. Так что, то, что я тебе сказал, было правдой… с определенной точки зрения…
- С определенной точки зрения?
- Люк… ты вот увидишь сам… что очень многие истины зависят от нашей точки зрения.
(Звездные войны. Эпизод 6.)

К чему я привел эту цитату - в результате всей этой работы я пришел к выводу, что у нас, программистов, и у Microsoft разный взгляд на фразу 'Обеспечивается доступ к данным'. Мы (ну или, по крайней мере, я) в этой фразе видим следующее содержание 'обеспечивается доступ к данным для их просмотра и РЕДАКТИРОВАНИЯ (т.е. редактирование, удаление и добавление новых данных)'. Что имеет в виду Microsoft можно только догадываться, но явно, что без особых проблем достигается только просмотр данных. Кроме того, практически все примеры в литературе ограничиваются получением данных именно для просмотра, после чего следует несколько бодрых фраз и все заканчивается. Как говорится выше - разные точки зрения…

Итак, прежде всего, работа была ограничена условием разработки в Delphi 4. Причин этому много, но к этой статье это отношения не имеет. Просто - программа, разработанная в Delphi 4 должна работать через ADO. Поэтому приступили к поиску компонент, обеспечивающих такую работу. Нашли их довольно много, как платных, так и бесплатных. Все, что будет написано, одинаково и для всех вариантов и даже для Delphi5. Исключение составляет только работа с закладками в Delphi 5.

ADO была взята на тот момент самая последняя версия с сайта Microsoft - это ADO 2.6.

Итак, возьмем файл mdb формата MS Access 97. Его можно сделать с помощью хотя бы самого Access. И создадим там небольшую таблицу, к примеру, такую: Object_ID Integer - идентификатор объекта на карте Object_Description Text (50) - описание объекта на карте Введем туда какие-либо данные (абсолютно все равно какие). Только надо учесть, что в силу специфики работы у нас могут быть описания, которым пока объекты не соответствуют. Такая связка будет выполнена позже пользователем. Ну, попробуем вывести содержимое таблицы в DBGrid. Ага, получилось. Например, как на картинке:

Вроде как все нормально и доступ к данным мы получили.
А теперь давайте, вообразим себя пользователями и попробуем что-нибудь исправить или добавить. Например, добавим несколько пустых записей и попробуем внести туда данные. Добавляем. Нормально. Теперь внесем данные и нажмем POST. И что мы видим?


Ага. Интересно, а при чем тут ключ, если у нас на таблицу ключ не наложен? Пробуем добавить новую запись, удалить запись без Object_ID. Результат одинаков - все то же сообщение об ошибке. И что же делать? Запускаем MS Access, пробуем там, и видим, что там все отлично. Стало быть, что-то не так мы делаем с ADO. И тут мы вспоминаем, что когда мы создавали таблицу в MS Access, он предлагал создать ключевые поля для этой таблицы. А после долгих поисков в ADO SDK я нашел этому такое объяснение: ADO предполагает, что таблица будет в первой нормальной форме. Если кто не помнит главное требование первой формы - отсутствие повторяющихся записей.

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


Что здесь интересного? А то, что содержимое Internal_ID для всех этих записей равно нулю, хотя это автоинкрементное поле! И Table.Refresh здесь не помогает! Только закрытие и последующее открытие таблицы приводит к тому, что мы видим то, что и ожидалось.



А пока мы не имеем правильных идентификаторов, наличие такого поля не дает ничего. Выше приведенные ошибки будут продолжать сыпаться как из рога изобилия. Но вот только закрывать - открывать таблицу каждый раз после добавления новой записи для того, чтобы автоинкрементное поле принимало правильные значения - это сильно. Так не пойдет. Вот так ADO, подумал я, а давай-ка попробуем MS Access 2000. И тут оказалось, что там все нормально работает: добавляем запись, делаем сохранение (Post) автоинкрементное поле тут же принимает правильное значение.

В результате я могу сделать только один вывод - Microsoft активно, всеми доступными средствами, пытается заставить пользователей переходить к своим новым продуктам.



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

Ну а чтобы пользователь не видел этого внутреннего идентификатора (он ведь нужен только нам) делаем это поле невидимым. Надеюсь, что все знают, что это делается через TField.Visible := FALSE.

Кто-нибудь может возразить: а зачем нам такой идентификатор, мы можем записи идентифицировать по каким-нибудь своим полям. Ради Бога! Но тут есть еще одна проблема и эта проблема называется закладки.
Проблемы закладок нет в Delphi 5, потому что там вокруг Bookmark сделан класс ими управляющий, а я имею в виду работу с закладками через ADO. Смотрим опять же в ADO SDK и видим там такое описание: 'Recordset.Bookmark: Устанавливает или возвращает закладку, которая однозначно определяет текущую запись в Recordset. При создании или открытии объекта Recordset каждая из его записей получает уникальную закладку. Для того чтобы запомнить положение текущей записи, следует присвоить текущее значение свойства Bookmark переменной. Для быстрого возвращения к сохраненному в переменной указателю текущей записи в любое время после перехода на другую запись следует указать в значении свойства Bookmark объекта Recordset значение этой переменной'. Казалось бы, какие проблемы? А вот какие: возвращаемое значение всегда одно и тоже для любой записи. И когда мы устанавливаем этот, с позволения сказать, Bookmark, ничего не происходит. И только наш внутренний идентификатор поможет в такой ситуации, кроме того, его значение всегда имеет смысл, даже после закрытия и повторного открытия таблицы, что, в общем-то, удобно.
После того как все заработало, я решил проверить скорость работы ADO. У нас может быть ситуации, когда в таблицу добавляется сразу большое количество записей, к примеру, 50-60 тысяч записей за раз. Так вот, когда использовалась BDE, такая операция занимала максимум 10 минут. Угадайте, чему стало равно это время при использовании ADO? Минимум 25 минут на той же самой машине. Если после этого мне будут говорить, что ADO быстрее BDE чуть ли не в 2 раза - позвольте мне с Вами не согласиться.

Итак, для нормальной работы мы должны иметь таблицы в первой нормальной форме, для этого делаем автоинкрементное поле с уникальным индексом. Кроме того, если мы можем добавлять больше одной записи за один раз и потом сразу возможно будем их редактировать, нам надо использовать файлы MS Access 2000.


ADO и файлы xBASE и Paradox


Итак, мы смогли наладить работу через ADO к файлам формата MS Access. Но ведь мы можем и должны использовать файлы xBase и Paradox в качестве обменных файлов.

Попробуем это сделать. Все примеры какие я видел в книгах работают одинаково - через 'Microsoft OLE DB provider for ODBC'. А все редакторы, которые делают строку подключения, всегда показывают только mdb файлы в диалоге, в котором задается путь к файлу БД. Что-то тут нечисто, подумал я - а как же тот же самый Access это делает? Ведь явно не через ODBC, стало быть, есть какая-то хитрость.

После примерно недельных поисков в Интернете решение было найдено. Да, действительно можно использовать 'Microsoft Jet 4.0 OLE DB Provider'. Чтобы не рассказывать долго, представим, что у нас на диске D в корне лежит файл Test.dbf формата dBase 5.0.
Строка коннекта для этого случая будет выглядеть так:
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\; Extended Properties=dBase 5.0; Mode=Read|Write|Share Deny None; Persist Security Info=True';

И это все. Самое интересное во всей это строке - секция 'Extended Properties'.
Чтобы знать, что конкретно для разных форматов надо писать в Extended properties, загляните в реестр Windows на следующую ветку:
HKEY_LOCAL_MACHINE\Software\Microsoft\Jet\4.0\ISAM Formats

Там перечислены все поддерживаемые в данном случае форматы.

После опытов над форматом dbf оказалось, что все выше сказанное для формата mdb совершенно не относится к этому формату - и все требования про первую форму можно и не соблюдать! В общем, загадка природы.

А вот формат Paradox - это оказалась песня на меньшая, чем mdb. И вот почему - здесь все требования о первой форме таблицы в действии, но ведь мы не можем создавать таблицу, потом говорить пользователю 'Слышь, мужик, а теперь метнулся, запустил Paradox и создал первичный ключ на эту таблицу. А потом нажмешь на ОК и мы продолжим'. Это несерьезно. Стало быть, этот ключ надо создавать нам самим.

Хорошо, запускаем справку по MS Jet SQL и ищем раздел создания индексов или первичных ключей. Находим следующее: CREATE INDEX имя_индекса ON название_таблицы (название_поля) WITH PRIMARY. ALTER TABLE название_таблицы ADD CONSTRAINT имя_ограничения PRIMARY KEY (название_поля) Все далее сказанное абсолютно одинаково для обоих вариантов.


Предположим, что наша таблица называется ExpTbl.db и поле, на которое мы хотим наложить первичный ключ, называется IntrernalID. Хорошо, подключаемся к таблице и задаем такую строку SQL для исполнения: CREATE INDEX My_Index ON ExpTable (InternalID) WITH PRIMARY

Запустим на выполнение. Ого, а что это мы видим? Вот те на - очередное сообщение об ошибке. При этом сообщение как всегда очень содержательное применительно к нашему случаю.
Неправильных символов нет, синтаксис правильный, длина названия ключа тоже нормальная. Я так думаю потому, что если выполнить это через BDE, все будет работать со свистом.

Вывод один - опять очередное требование ADO, которое сразу не поймешь. Ладно, запускаем он-лайн MS MSDN и делаем запрос на PARADOX. Видим что-то около 50 документов. И где-то в 35-36 документе я нашел ответ маленькими буковками внизу экрана! Сейчас я вам скажу в чем проблема - держитесь крепче: имя первичного ключа должно совпадать с названием таблицы, а имена индексов с именами полей. Неслабо.
Исправляем SQL: CREATE INDEX ExpTable ON ExpTable (InternalID) WITH PRIMARY Запускаем, смотрим - все отлично.

Чтобы никто больше мучился с этим делом, я хотел бы привести самые значащие ограничения для драйвера PARADOX, которые я нашел в MSDN: Для того, чтобы Вы имели возможность производить действия по добавлению, удалению записей или редактированию данных в таблице, таблица должна иметь первичный ключ. Первичный ключ должен быть определен для первых 'n' полей таблицы. Вы не можете создавать для таблицы индексы, если для нее не определен первичный ключ. Первый создаваемый для таблицы уникальный индекс будет создан как первичный ключ. Первичный ключ может быть создан для таблицы только в том случае, если в ней нет ни одной записи. Действия по добавлению или удаления полей в таблице должны быть произведены до того, как для нее создан первичный ключ. Кстати, по моему опыту удалить однажды созданный первичный ключ для таблицы невозможно.

Итак, для работы через ADO с файлами xBase или Paradox, нам необходимо указывать нужный драйвер в секции Extended Properties и в секции Data Source только путь до файла. Для xBase на этом все трудности закончены, а вот для Paradox необходимо задание первичного ключа как для формата MS Access, при этом есть определенные ограничения при задании названий ключей, так же как и возможных индексов.



То, о чем речь пойдет далее уже не относится к организации работы с таблицами xBase и Paradox через ADO, а скорее упоминание об одном полезном опыте.
Для добавления данных в эти таблицы, мы можем вставлять их по одной (Table.Append (Insert); Table.Post), а можем воспользоваться вариантом SELECT … INTO, INSERT … INTO. Поговорим теперь именно о втором варианте работы.

Смотрим файл справки MS Jet SQL. SELECT поле_1 [, поле_2 [, ...]] INTO новаяТаблица [IN внешняяБазаДанных] FROM источник

Ладно, пробуем. Пусть мы имеем в качестве источника данных mdb файл и хотим сохранить данные из таблицы SourceTable в таблицу формата Paradox 7.0 TestTable.db, расположенную в корне диска D:. Казалось бы: SELECT * INTO [TestTable.DB] IN 'D:\' FROM SourceTable

Нет, очередная ошибка. Вот, что мы видим.

Ага, хорошо, давайте попробуем указать таблицу в пути: SELECT * INTO [TestTable] IN 'D:\ TestTable.DB' FROM SourceTable

Получим очередное сообщение об ошибке.



Ага, стало быть, файл для экспорта должен уже существовать? Ладно, не проблема, давайте создадим его и попробуем еще раз.



Ну, в общем, желающие могут еще поэкспериментировать, а для остальных я скажу как делается: SELECT * INTO [Paradox 7.x;DATABASE=D:\].[TestTable#DB] FROM SourceTable

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

Самое потрясающее это название раздела MSDN, где я нашел этот ответ - 'Как, используя ADO, открыть таблицу Paradox, защищенную паролем'. Как ЭТО имеет отношение к этому синтаксису SQL, я так и не понял, честно говоря.

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

Иванов Денис Михайлович.
14 мая 2001г.
Специально для

При написании статьи использовались следующие материалы: Материалы . Справочные файлы Delphi 4 и Delphi 5. Исходные коды VCL Delphi 4 и Delphi 5. и примеры MS ADO SDK. . А.Я. Архангельский 'Язык SQL в Delphi 5'.

Алгоритм обхода препятствий.


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

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

Елена Филиппова

Предлагаемый алгоритм обхода препятствий - это, так называемый, обобщенный алгоритм Дейкстры. В англоязычной литературе он называется алгоритмом A*.

Реализация алгоритма: (191 К)

1. Карта разбита на квадратные части, назовем их клетками. 2. Каждая клетка имеет несколько показателей: 1) стоимость прохождения по этой клетке, 2) предыдущая клетка - клетка из которой пришли в эту клетку, 3) статус клетки (непосещенная, граничная, отброшенная), 4) оценка пройденного пути, 5) оценка оставшегося пути. 3. Имеется две клетки - начальная и конечная. 4. Сосед клетки - клетка в которую можно попасть из рассматриваемой за 1 шаг. Общий принцип: на каждой итерации из всех граничных точек выбирается та, для которой сумма уже пройденного пути и пути до конца по прямой является минимальной, и от нее осуществляется дальнейшее продвижение.

Алгоритм этот проще реализовать, чем описать:

Start - начальная клетка
Finish - конечная клетка.
Алгоритм итерационный
1 шаг: Помечаем Start как граничную точку.
2 шаг: Среди всех граничных точек находим Клетку1 - клетку с минимальной суммой оценки пройденного пути g и оценки оставшегося пути h.
3 шаг: Для Клетки 1 рассматриваем соседей. Если сосед имеет статус непосещенного, то мы обозначаеми его как граничную клетку, и указываем Клетку1 как предыдущую для него. Оценку g1 для соседа принимаем равной g+p, где p-стоимость прохождения по клетке сосед, а g - оценка пройденного пути для Клетки1 . Оценка h для любой клетки равна длине кратчайшего пути (по прямой от рассматриваемой клетки до клетки Finish) Рассматриваемую Клетку1 помечаем как отброшенную.
4 шаг: Если на предыдущем шаге один из соседей оказался равен клетке Finish, то путь найден. Если ни одного нового соседа не существует, то нет и пути.
5 шаг: Переход на шаг 2.

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



Альтернатива


Есть, конечно, альтернатива User таймерам - это ожидаемые таймера, реализованные в ядре и поэтому менее тяжеловесные и более надежные. Они не посылают сообщений и должны ожидаться с помощью функции WaitForSingleObject или подобной. К ним имеют прямое отношение следующие функции API:

CreateWaitableTimer SetWaitableTimer CancelWaitableTimer

Но, к сожалению, эти функции реализованы только в Windows NT/2000 и, следовательно не подходят для программы, рассчитанной на любую платформу Win32.



Архитектура микшера.


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



Архитектура платформы


Платформа реализована по схеме клиент - сервер на СУБД MS SQL Server 2000. Перевести ее в разряд трехуровневой архитектуры – голубая мечта понять основную идею архитектуры платформы из описания ее функционирования. А уж потом перейдем к описанию ее программных элементов.

Платформа имеет два режима запуска: КОНФИГУРАТОР и ПОЛЬЗОВАТЕЛЬСКИЙ РЕЖИМ, напоминая чем -то 1С. Идея этих режимов действительно навеяна 1С.

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

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

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

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

TDbInterface = class (TComponent) private FDatabaseName : String; // Список указателей на структуры категорий информации FInfoCategoryList : TInfoCategoryList; // Список указателей на структуры таблиц FTablesList : TList; // Список имен таблиц FTableNames : TStrings; // Список ссылок на комбинированные типы данных FFbCommonTypeList : TFbCommonTypeList; // Тип драйвера доступа к данным FDrvType : TDrvType; // Загрузка системной информации - установка имени FDatabaseName Procedure Set_DatabaseName(Value : String); public Constructor Create(AOwner : TComponent); Override; Destructor Destroy; Override; // Создание новой структуры таблицы Function New_pTTableInfo(ATableName : String; AUpdateTypes : Boolean) : pTTableInfo; // Создание новой структуры поля Function New_pTFieldInfo : pTFieldInfo; // Освобождение памяти, занятой структурой таблицы Function Dispose_pTTableInfo(ApTTableInfo: pTTableInfo; ADisposeFields, AUpdateTypes : Boolean): Bool; // Освобождение памяти, занятой структурой поля Function Dispose_pTFieldInfo(ApTFieldInfo: pTFieldInfo): Bool; Property TablesList : TTablesList read FTablesList; // Список категорий информации БД Property FbCommonTypeList : TFbCommonTypeList read FFbCommonTypeList; Property InfoCategoryList : TInfoCategoryList read FInfoCategoryList; // Новая таблица, поле published Property DrvType : TDrvType read FDrvType write FDrvType; Property DatabaseName : String read FDatabaseName write Set_DatabaseName; end;

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

TArmInterface = class (TObject) private FDatabaseName : String; FFbSUObjectL : TFbSUObjectList; // Обобщенный список элементов СУ FFbMedTreeV : TTreeView; // Дерево конфигурации АРМ FArmMainMenu : TMainMenu; // Главное меню конфигурации АРМ FForm : TForm; FDbInterface : TDbInterface; // Загрузка системной информации - установка имени FDatabaseName Procedure Set_DatabaseName(Value : ShortString); // Запуск прикладной функции, вызываемой по номеру ID - приводится в // действие при выборе пункта меню, по значению его свойства Tag Procedure StartFb_Procedure(Sender : TObject); Public // Создание структуры TFbSUObject и возврат ссылки на нее Function New_pTFbSUObject(AFbSUType : TFbSUType) : pTFbSUObject; // Освобождение памяти, занимаемой структурой TFbSUObject по ссылке Procedure Free_pTFbSUObject(ApTFbSUObject: pTFbSUObject); // Создание меню АРМ по информации в FFbMedTreeV Procedure LoadArmMenu(ApTFbSUObject : pTFbSUObject); published Property DatabaseName : String read FDatabaseName write Set_DatabaseName; Property DbInterface : TDbInterface read FDbInterface write Set_FDbInterface; end;

В обоих компонентах есть ключевая операция – установка имени поля FDatabaseName, которая приводит в действие процедуру Set_DatabaseName. При загрузке приложения сначала нужно создать экземпляр TDbInterface, т.к. в компоненте TArmInterface нужно указывать ссылку FDbInterface на существующий экземпляр TDbInterface.

В процессе выполнения процедуры Set_DatabaseName осуществляются следующие действия.

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


// Структура таблицы TTableInfo = record // Атрибуты sTableAttr : TStrings; { sTableName - имя таблицы } { sTableCaption - наименование } { sTableDescr - описание } sFieldsL : TList; // Связанные DataSet и DataSource ... sQuery : TQuery; sQrDataSource : TDataSource; end;
В этой структуре показана только часть полей, смысл которых понятен из комментариев к структуре. Обратите внимание, что структура содержит компоненты TQuery и TDataSource. Это – принципиальный момент. Платформа не имеет других компонент доступа к данным, кроме тех, что содержатся в структурах TTableInfo и аналогичных им, применяемых для работы с запросами пользователей. Впрочем, имеются очень редкие исключения из этого правила, не носящие принципиального характера. Следующий принципиальный момент – для каждой таблицы в памяти создается только одна структура TTableInfo. Для того, чтобы структуру таблицы можно было использовать в самых различных местах приложения, ведется список FTablesList ссылок pTTableInfo в объекте TDbInterface. Список имен таблиц FTableNames также содержит ссылки pTTableInfo в поле Objects. Избыточность информации здесь вполне оправдана, т.к. в приложении масса случаев, когда нужно получить ссылку на структуру таблицы, зная имя таблицы.

Обратим внимание на список sFieldsL, содержащий список ссылок на структуры полей. Упрощенный вид структуры поля имеет вид

// Структура поля TFieldInfo = record // Атрибуты sFieldAttr : TStrings; { sFieldName - Имя поля } { sFieldCaption - Наименование } { sFieldDescr - Описание } sFieldType : TFieldType; sFieldSize : Integer; sFieldMBytes : Integer; end;
В этой структуре sFieldType тип поля, sFieldSize – размер поля согласно BDE, а sFieldMBytes – количество байт, занимаемых в памяти данным типом. Остальные поля структуры ясны из комментариев.

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


Архитектура событий в COM+


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

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

Временная подписка (transient) создается средствами административного API. Для более детальной информации можно обратиться в MSDN. Управлять жизненным циклом такой подписки нужно программными средствами. А не средствами ComponentServices.

Постоянная подписка (persistent) создается средствами ComponentServices. Такая подписка в состоянии пережить перезапуск системы.

Фильтрация существует только в системе COM+. Такой возможности нет в системе жестко связанных событий. Её суть мы рассмотрим дальше, при более детальном изучении примера.



Асинхронный режим чтения из Com-порта


Вступление

Порядок запуска и работы "службы" (назовем все описываемое ниже так) Com-портов состоит из нескольких достаточно хорошо описанных шагов ( ): Инициализация Com-порта посредством вызова функции CreateFile. Установка параметров Com-порта посредством последовательного вызова функций GetCommState и SetCommState, а также SetupComm. Установка параметров тайм-аутов для чтения и записи - GetCommTimeouts и SetCommTimeouts. Собственно записи в Com-порт - WriteFile и чтения из него - ReadFile. Закрытие порта по окончанию работ CloseHandle. Очень большой сложности описанные выше шаги не представляют, однако реализация чтения данных из порта в асинхронном (неблокирующем) режиме заставляет почесать затылок. Об этом и поговорим.

Чтение из Com-порта.

Судя по контексту справки, касающейся функции CreateFile, для "отлова" момента поступления данных в Com-порт следует использовать функцию WaitCommEvent. Предварительно установив маску SetCommMask на то событие, которое хотелось бы отследить. Нужное событие наступает - вызываем функцию ReadFile для чтения поступающих данных.

Казалось бы все в порядке, но... Вызов функции WaitCommEvent насмерть тормозит приложение, пока какие-либо данные не поступят в Com-порт.

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

Как выход из ситуации многие предлагают использовать потоки (thread), забывая при этом описать как это делать :)

Итак потоки.

В модуле Classes для потоков определен специальный класс TThread. Для создания потоков специалисты рекомендуют использовать именно его, а не создавать потоки используя BeginThread и EndThread, т.к. библиотека VCL не является защищенной для потоков в такой реализации. Следуя советам экспертов, для организации контроля поступающих данных в Com-порт и будем использовать готовый класс TThread.

В раздел interface определим тип переменных этого класса, переопределив только один метод класса - Execute, ну и дополнительно объявим свой метод, который и займется опросом Com-порта.

Type //определим тип TComThread - наследника класса TThread TCommThread = class(TThread) private //процедура, занимающаяся опросом порта Procedure QueryPort; protected //переопределим метод запуска потока Procedure Execute; override; end;

Далее в разделе глобальных переменных определим поток-переменную полученного выше типа CommThread:TCommThread; //наш поток, в котором будет работать процедура опроса порта Затем в разделе implementation начинаем ваять.
ВНИМАНИЕ!!!
К этому времени порт уже должен быть инициализирован функцией CreateFile. 1. Инициализируем поток, используя метод Create.


Procedure StartComThread; //инициализация нашего потока Begin {StartComThread} //пытаемся инициализировать поток CommThread:=TCommThread.Create(False); // проверяем получилось или нет If CommThread = Nil Then Begin {Nil} //ошибка, все выключаем и выходим SysErrorMessage(GetLastError); fmMain.btnStop.Click; Exit; End; {Nil} End; {StartComThread}
Куски кода взяты из файла проекта, поэтому нажимание на кнопку btnStop главной формы fmMain - это "примочки" примера, не обращайте внимания.

Запускаем процедуру опроса порта в нашем потоке.

Procedure TCommThread.Execute; Begin {Execute} Repeat QueryPort;//процедура опроса порта будет производиться пока поток не будет прекращен Until Terminated; End; {Execute}
Реализуем асинхронные опрос порта и чтение из него данных

Procedure TCommThread.QueryPort; Var MyBuff:Array[0..1023] Of Char;//буфер для чтения данных ByteReaded:Integer; //количество считанных байт Str:String; //вспомогательная строка Status:DWord; //статус устройства (модема) Begin {QueryPort} //получим статус COM-порта устройства (модема) If Not GetCommModemStatus(hPort,Status) Then Begin {ошибка при получении статуса модема} //ошибка, все выключаем и выходим SysErrorMessage(GetLastError); fmMain.btnStop.Click; Exit; End; {ошибка при получении статуса модема} //Обработаем статус устройства (модема) и будем включать(выключать) лампочки //готовность устройства (модема) получать данные fmMain.imgCTSOn.Visible:=((Status AND MS_CTS_ON)=MS_CTS_ON); //готовность устройства (модема) к сеансу связи fmMain.imgDSROn.Visible:=((Status AND MS_DSR_ON)=MS_DSR_ON); //принимаются данные с линии сигнала fmMain.imgRLSDOn.Visible:=((Status AND MS_RLSD_ON)=MS_RLSD_ON); //входящий звонок fmMain.imgRingOn.Visible:=((Status AND MS_RING_ON)=MS_RING_ON); //читаем буфер из Com-порта FillChar(MyBuff,SizeOf(MyBuff),#0); If Not ReadFile(hPort,MyBuff,SizeOf(MyBuff),ByteReaded,Nil) Then Begin {ошибка при чтении данных} //ошибка, все закрываем и уходим SysErrorMessage(GetLastError); fmMain.btnStop.Click; Exit; End; {ошибка при чтении данных} //данные пришли If ByteReaded>0 Then Begin {ByteReaded>0} //посчитаем общее количество прочитанных байтов ReciveBytes:=ReciveBytes+ByteReaded; //преобразуем массив в строку Str:=String(MyBuff); //отправим строку на просмотр fmMain.Memo1.Text:=fmMain.Memo1.Text+ Str; //покажем количество считанных байтов fmMain.lbRecv.Caption:='recv: '+IntToStr(ReciveBytes)+' bytes...'; End; {ByteReaded>0} End; {QueryPort}




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

Прилагающийся пример
Следуя правилам хорошего тона, прикладываю ко всему написанному работающий пример.
В примере используется самое доступное устройство для пользователей интернет - модем (на Com-порту). В качестве "примочек" я использовал лампочки, которые включаются (или выключаются) при изменении статуса модема. Можно было прикрутить лампочки-детекторы входящих-выходящих сигналов, но вместо них используются счетчики байтов.
Реализация кода включения-выключения не самая лучшая: можно было бы использовать TImageList для хранения изображений лампочек. Но почему-то ??? (кто знает почему - напишите) использование ImageList.GetBitmap при наличии запущенного потока "подвешивает" приложение насмерть. Причем это происходит под Windows'98, если тоже самое делать под Windows'95, то все в порядке.

Для проверки работоспособности примера попробуйте понабирать AT-команды ATZ - инициализировать модем ATH - положить трубку ATH1 - поднять трубку ATS0=1 - включить автоподнятие трубки на первый сигнал ATS0=0 - выключить автоподнятие трубки ATDP_номер_телефона_интернет_провайдера - мне нравится больше всего :) ATDP - набор в импульсном режиме, ATDT - набор в тоновом режиме

Да, еще. Проект написан под Delphi3, при использовании Delphi более свежих версий возможны ошибки "несовпадения типов".
В этом случае поменяйте типы "ошибочных" переменных с Integer на Cardinal.

Скачать проект — (17K)
архив обновлен
Другие небольшие статьи,
примеры и программы можете найти на

Смотрите также :



Атрибуты АРМ


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

АРМ, т.е. автоматизированное рабочее место. Этот атрибут носит смысл вывески на фасаде здания, т.к. попросту используется для обозначения рабочего места. В частности, наименование АРМ выводится в заголовки экранных форм.

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

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

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

Функция – это последний уровень в иерархии системы управления функциональностью платформы. Она обязательно содержит указатель на программный компонент - форму, процедуру или функцию на языке Object Pascal. Все перечисленные атрибуты хранятся в памяти в специальных схожих по типу структурах. Например, для хранения реквизитов АРМ используется структура

// Структура АРМ TArm = record sTopInfo : TTopInfo; sOknoPtrL : TList; end; где TTopInfo – представляет собой структуру // Структура универсальной шапки TTopInfo = packed record sFbSUType : TFbSUType; // Тип структуры sID : TFbMedID; // Идентификатор sCaption : TFbMedName; // Наименование sDescr : TFbMedDesc; // Описание end;

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

// Тип структуры объекта управления TFbSUType = (apArmType, apOknoType, apMItemType, apAlgorType, apFuncType, apChannelBox, apNoneType);

Вот теперь можно раскрыть вид структуры TFbSUObject, входящей в компоненту TArmInterface. Она представляет собой вариантную запись:

// Обобщенная структура объекта управления TFbSUObject = packed record FbSUType : TFbSUType; case TFbSUType of apArmType : (Arm : pTArm); apOknoType : (Okno : pTOkno); apMItemType : (MItem : pTMItem); apAlgorType : (Algor : pTAlgor); apFuncType : (Func : pTFunc); apChannelBox : (); apNoneType : (); end;

В этой структуре pTArm, pTOkno, pTMItem и т.д. – ссылки на соответствующие структуры TArm, TOkno, TMItem и т.д.


Компонента TArmInterface содержит набор функций для работы с приведенными атрибутами. Две из них, - для создания и удаления нового атрибута типа TFbSUObject, приведены выше.

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

// Структура функции TFunc = record sTopInfo : TTopInfo; sFormName : TFbMedFormName; sAddressPtr: Pointer; end;
Если это имя не задано, то должен быть задан указатель sAddressPtr процедуры или функции. Если ни то, ни другое не задано, структура функции теряет свой смысл. При обращении к такой структуре система генерирует исключение.

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

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

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

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


Буферы для потоков


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

Стандартные потоки, широко применяющиеся в Delphi, резко упрощают повседневную работу с потоковыми данными. Но и у них есть недостаток. Дело в том, что в VCL потоки, и, главное, их базовый класс TStream, реализованы "в лоб": без всяких хитростей данные немедленно препровождаются по назначению (например, в файл). И такие операции занимают весьма значительное время (многие сотни машинных команд). Хорошо, если надо работать с "крупными" данными (килобайт и выше) - а если данные небольшие и разнообразные, замедление достигает 100 и более раз (на типе Char).

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

Ввиду этих проблем мной были написаны сравнительно простые буферные классы (работают на Delphi версий 4-5, должны работать и на последующих, а вот 3 версия уже не поддерживает перегрузку методов - в принципе, переписать и тут несложно), позволяющие производить буферизованный обмен с любыми потоками. В целях максимального ускорения работы классы эти, во-первых, не "thread-safe", а во-вторых, это два разных класса - для записи и для чтения - унаследованных от одного базового (кроме TObject, разумеется). Классы "пристёгиваются" к потоку (кстати, в C++ это делается практически так же) - и пользуются ими только для "крупного" обмена, осуществляя "мелкий" самостоятельно со своим буфером.

ByteArray = packed array of Byte; psnAbstractStreamBuffer = class { Абстрактный предок классов для БЫСТРОЙ (буферизованно: вся цепочка до API-функций задействуется только при переполнении буфера, что даёт ускорение на порядок для данных длиной несколько байт) и УДОБНОЙ (перегруженные методы для разных типов данных позволяют не задавать их размер, хотя можно и так) бинарной работы с потоками заданной структуры. Принцип действия прост: накопление данных в буфере и сброс в поток - у буфера записи; чтение из потока и раздача данных из буфера - у буфера чтения. О позиции потока буфер не заботится - просто пишет или читает в текущей. А иначе будет монстр. Опасно что-то делать с потоком (хотя кому это надо?), когда к нему присоединён буфер, ведь буфер может переписать поток, прочитать устаревшие данные или сделать это не там, где надо. Перед подобными операциями сбрасывйте буфер методом Flush (при смене присоединённого потока (свойство Stream) и разрушении буфера это делается автоматически). Это касается и попеременной работы буферов чтения и записи с одним потоком... хотя зачем тогда буфер - чтобы постоянно его сбрасывать и устанавливать позицию потока? При ошибках чтения и записи возникают стандартные VCL-исключения EReadError и EWriteError.} private FStream: TStream; {присоединённый поток} FSize: Cardinal; {размер буфера} FBuffer, {буфер} FBufferEnd: PChar; {конец буфера (сразу за последним байтом) - понятно, что вместе с FSize и FBuffer избыточно, но это повысит скорость и упростит код} procedure SetStream(const Value: TStream); protected FCurrPos: PChar; {текущая позиция в буфере} property Size: Cardinal read FSize; property Buffer: PChar read FBuffer; property BufferEnd: PChar read FBufferEnd; constructor Create(const Stream: TStream; const Size: Cardinal); public property Stream: TStream read FStream write SetStream; {<> Nil !!!} procedure Flush; virtual; abstract; {сброс} destructor Destroy; override; {Stream разрушайте сами, если надо, ПОСЛЕ разрушения буфера} end; psnStreamWriter = class(psnAbstractStreamBuffer) public constructor Create( const Stream: TStream; {присоединённый поток, меняется свойством Stream} const Size: Cardinal = 1024 {размер буфера} ); procedure Flush; override; procedure WriteBuffer(const Data; const Count: Cardinal); {Этот метод не перегружен с Write, так как Delphi (4-5, во всяком случае) плохо выносит перегруженные методы, когда один из них имеет бестиповые параметры: Code Explorer сходит с ума, а Code Completion вообще хулиганит - самовольно добавляет раздел Private и дублирует объявление метода (без overload!!!) там, а потом ругается: мол, первый метод не был объявлен как overload).} procedure Write(const Data: Byte ); overload; procedure Write(const Data: Word ); overload; procedure Write(const Data: LongWord ); overload; procedure Write(const Data: Integer ); overload; procedure Write(const Data: Single ); overload; procedure Write(const Data: Double ); overload; procedure Write(const Data: Extended ); overload; procedure Write(const Data: String ); overload; procedure Write(const Data: ByteArray); overload; end; psnStreamReader = class(psnAbstractStreamBuffer) public constructor Create( const Stream: TStream; {присоединённый поток, меняется свойством Stream} const Size: Cardinal = 1024 {размер буфера} ); procedure Flush; override; procedure ReadBuffer(out Data; const Count: Cardinal); procedure Read(out Data: Byte ); overload; procedure Read(out Data: Word ); overload; procedure Read(out Data: LongWord ); overload; procedure Read(out Data: Integer ); overload; procedure Read(out Data: Single ); overload; procedure Read(out Data: Double ); overload; procedure Read(out Data: Extended ); overload; procedure Read(out Data: String ); overload; procedure Read(out Data: ByteArray); overload; end;

Их методы WriteBuffer и ReadBuffer работают аналогично одноименным методам класса TStream, то есть они генерируют стандартные VCL-исключения EWriteError и EReadError при невозможности осуществления операции. Причина этого в том, что, в конце концов, вы должны знать формат своего файла, а не я :). Кроме того, если кто не знает, исключения ускоряют работу по сравнению с постоянной проверкой результата (если секция try...finally или try...except содержит цикл, а не наоборот).

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

В силу того, что "мелкий" обмен с потоками часто производится типизированно - например, чтение строк или чисел с плавающей точкой - классы дополнены перегруженными методами Write и Read для распространённых типов, позволяющими не раздувать исходный (и машинный) код, постоянно указывая размеры передаваемых данных. Эти методы настолько просты, что расширение их набора не представляет проблем - фактически они просто транслируются в вызовы WriteBuffer и ReadBuffer.

В заключение остаётся предупредить, что во избежание ошибок прежде, чем что-то делать с потоком (позицию сменить, прочитать/записать что-то помимо данного буферного класса), необходимо сбросить буфер методом Flush.

Сергей Парунов

Скачать (3 K)



Часть 1.


Давайте сделаем базовый проект, обеспечивающий динамическую подгрузку пакета. На самом деле это достаточно тривиально, но нам необходимо начать с чего-нибудь привычного (а кому это не привычно - он прочувствует, что это не так сложно, как это кажется на первый взгляд) просто иметь некоторую стартовую точку показать, что и разработанные на текущий момент проекты могут быть легко модернизированы с учетом данной методики (возможно, их придется переписывать заново (или начисто, в зависимости от того, как к этому относиться!), - но это даже иногда полезно ). Для начала спроектируем первое приближение главного приложения. Я хочу показать использование как диалоговых, так и дочерних окон, поэтому главное окно приложения сделаем MDIFrom с созданием всех сопутствующих MDI атрибутов (типа меню Window). Помимо прочего, делаем меню Help (дань привычки J делать приложения со справкой). В качестве основы для обработки команд меню будем использовать TActionList .

Завершив эти "магические пассы", добавляем следующее: в секцию private вносим переменную FPackageHandle типа THandle. Она будет хранить дескриптор пакета. Туда же добавляем процедуру LoadPluginPackage, которая будет непосредственно выполнять загрузку пакета plugin.bpl.

Вот текст этой процедуры procedure TForm1.LoadPluginPackage; var FileName: TFileName; Begin // предполагаем, что пакет хранится в том же каталоге, что и исполняемое приложение FileName := ExtractFilePath(Application.ExeName); FileName := FileName + 'plugin.bpl'; // Загружаем пакет FPackageHandle := LoadPackage(FileName); if FPackageHandle = 0 then RaiseLastWin32Error() // пакет не загружен, выбрасываем исключение else MessageBox(Handle, 'Пакет plugin загружен', 'Информация', MB_APPLMODAL+MB_ICONINFORMATION+MB_OK); end; Теперь сделаем собственно пакет . В него поместим две формы, одну из которых сделаем дочерней (MDIChild), а на другую положим две кнопки (Ok и Cancel).

Далее организуем в главной форме загрузку пакета и вызов из него форм. Для этого на OnShow делаем вызов LoadPluginPackage и добавляем actions в ActionList:


Для дочерней формы procedure TForm1.aOpenExecute(Sender: TObject); var frmClass: TFormClass; frm: TForm; 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); // создаем дочернее окно end;

Для диалога procedure TForm1.aOpenDialogExecute(Sender: TObject); var frmClass: TFormClass; 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 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; Плюс ко всему добавляем обработчик OnUpdate на все action'ы для обеспеченя корректного вызова procedure TForm1.aOpenUpdate(Sender: TObject); begin aOpen.Enabled := FPackageHandle > 0; aOpenDialog.Enabled := FPackageHandle > 0; end; Полный исходный код находится в архиве (каталог Step1)


Часть 1. MapX - библиотека разработчика приложений. Немного теории.




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

Итак, что такое MapX.:

MapX - это картографический ActiveX компонент, который можно использовать в языках программирования Visual Basic, Delphi, Visual C++, PowerBuilder и др. Используя карты, Вы можете отображать информацию в виде, легко понятном каждому. Карты более информативны, чем диаграммы и графики, и их интерпретация более наглядная и быстрая по сравнению с таблицами. MapX имеет обширный набор функций и позволяет разработчикам использовать в своих программах средства анализа и управления пространственными данными. МарХ основан на тех же картографических технологиях, которые используются в других продуктах MapInfo, таких как MapInfo Professional и Microsoft Map.

Обзор основных возможностей :

Разработчик получает доступ к выполнению различных операций с картографическими данными, типа - нахождение пересечений и вложенности объектов; построение буферов; объединение объектов и т.д. Создание тематических карт - мощное средство анализа и наглядного представления пространственных данных. Тематические карты выявляют связи между объектами и тенденции в развитии явлений. Возможно создание тематических карт следующими способами: картограммы, картодиаграммы, способы значков и плотности точек, метод качественного фона, построение непрерывной поверхности по неравномерно распределенным значениям. Редактирование объектов. На электронной карте можно интерактивно создавать новые объекты, а также их изменять и удалять. Визуальный выбор. Используя стандартные средства, можно выбирать элементы, попадающие в прямоугольник, произвольный полигон и окружность. Управление слоями. Имеются функции позволяющие оперировать слоями географической информации, назначать способы отображения объектов и формирования подписей, изменять масштаб карты, управлять видимостью слоя, определять порядок показа и масштабный эффект для слоев картографических объектов и подписей. Анимационный слой динамически отображает движущиеся объекты, например, в приложениях работающих с информацией от GPS-приемников в режиме реального времени. Поддержка растровых изображений позволяет использовать спутниковые и аэрофотоснимки, сканированные карты и другие изображения как не редактируемые слои карты. Поддержка стандартного языка запросов - SQL. Доступ к серверу пространственных данных SSA - новое мощное средство, предоставляющее доступ к информации, хранящейся на удаленном сервере пространственных данных. Помимо основных возможностей MapX постоянно находится в развитии и от версии к версии происходит модернизация и наращивания возможностей, так например в версии 4.5 были добавлены и улучшены следующие возможности: Поддержка файлов поверхности и прозрачных растров (TrueСolor). Автоматическая регистрация растровых изображений. Поддержка технологий для связывания данных ADO и RDO. Поддержка серверов баз данных DB2 и Oracle 8.1.6. Кэширование картографических данных расположенных на сервере. Разграничение прав доступа к картографической информации. Инструменты для создания и редактирования объектов карты. Добавлены четыре новых инструмента создания объектов. Стандартные диалоги MapX на русском языке. Создание новых видов курсоров. Всплывающие подсказки при выборе обектов. Поддержка векторных символов совместимых с MapInfo 3.0 Значительно улучшены и/или расширены следующие возможности MapX Скорость отображения карты. Производительность повторяющихся операций со слоями. Расширены возможности работы с геословарем. Быстрый доступ к объектам карты для редактирования объектов и полей атрибутов. Поддержка импорта большего числа графических форматов, включая GIF, JPEG, и PNG. Методы построения и оформления тематических карт (картограммы, картодиаграммы и др.) . Поддержка методов преобразования координат NADCON, Molodensky и Bursa Wolfe (Начиная с версии MapX 3.5) Максимальное число узлов для регионов и полилиний увеличено до 1,048,572 для одного региона или полилинии.

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



Часть 1 - Вызов MapInfo и встраивание его в свою программу (Основы интегрированной картографии)


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

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

Итак начнем.