Что дальше?

Вы думаете это все? Кроме класса TRttiObject в прилагаемом файле Вы найдете следующие классы: TRttiList = class(TObjectList, IStreamPersist)

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

TAsyncRttiList = class(TRttiList)

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

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

(zip-архив, 2.3 K) (обновление от 3/27/2006 2:10:00 AM)

Реализация

Класс TRttiObject // Сохраняет и читает из потока все Published свойства TRttiObject = class(TInterfacedPersistent, IStreamPersist) public procedure SaveToStream(Stream: TStream); procedure LoadFromStream(Stream: TStream); constructor Create; virtual; end;

Тут нужно немного пояснить. Класс будет записывать/читать все свойства, тип которых целый (в том числе логический), перечислимый, вещественный, символьный, строковый, а также некоторые классы, которые поддерживают работу с потоками. Отличить эти классы от других, можно запросив у них интерфейс IStreamPersist, который объявлен в Classes.pas так:

IStreamPersist = interface ['{B8CD12A3-267A-11D4-83DA-00C04F60B2DD}'] procedure LoadFromStream(Stream: TStream); procedure SaveToStream(Stream: TStream); end;

Этот класс реализуют, например, все потомки TGraphic, такие как TBitmap, TIcon, TMetafile, а также наш класс TRttiObject.

Почему в качестве предка выбран TInterfacedPersistent, а не TObject или TInterfacedObject. Тут несколько причин: во-первых, он является потомком TPersistent, который объявлен с директивой {$M+} (правда ничего не мешало бы сделать это самим), а во-вторых, в нем наиболее удачно для нас реализованы методы интерфейса IInterface (подсчет ссылок, реализованный в TInterfacedObject, нам ни к чему, а если взять TObject, то эти методы нужно будет реализовать самому).

procedure TRttiObject.SaveToStream(Stream: TStream); var TypeData: PTypeData; PropList: PPropList; Count,i: Integer; // Локальные процедуры procedure WriteOrdProp; // Запись целых и перечислимых данных var Value: Integer; begin Value:=GetOrdProp(self,PropList[i]); Stream.Write(Value,SizeOf(Value)); end; procedure WriteFloatProp; // Запись вещественных данных var Value: Extended; begin Value:=GetFloatProp(self,PropList[i]); Stream.Write(Value,SizeOf(Value)); end; procedure WriteStringProp; // Запись строки var Value: String; L: Integer; begin Value:=GetStrProp(self,PropList[i]); L:=Length(Value); Stream.Write(L,SizeOf(L)); Stream.Write(PChar(Value)^,Length(Value)); end; procedure WriteClassProp; // Запись класса var Obj: TObject; SaveLoader: IStreamPersist; IsEmpty: Boolean; begin Obj:=GetObjectProp(self,PropList[i]); if (Obj is TGraphic) then begin IsEmpty:=TGraphic(Obj).Empty; Stream.Write(IsEmpty,SizeOf(Boolean)); end; if Supports(Obj,IStreamPersist,SaveLoader) then begin SaveLoader.SaveToStream(Stream); end; end; // Собственно сама процедура поиска свойств и записи begin TypeData:=GetTypeData(ClassInfo); // Получаем указатель на информацию Count:=TypeData.PropCount; // Получаем количество свойств if Count>0 then begin // Выделяем память для списка свойств GetMem(PropList,SizeOf(PPropInfo)*Count); Try // Получаем список свойств GetPropInfos(ClassInfo,PropList); // Перебираем все свойства из списка и сохраняем их // в поток в соответствии с их типом for i:=0 to Count - 1 do begin case PropList[i].PropType^.Kind of tkEnumeration, tkInteger, tkChar, tkWChar: WriteOrdProp; tkFloat: WriteFloatProp; tkString, tkLString: WriteStringProp; tkClass: WriteClassProp; end; end; finally // Освобождаем память FreeMem(PropList,SizeOf(PPropInfo)*Count); end; end; end;

Я не буду подробно комментировать каждую функцию из TypInfo.pas, по комментариям сами разберетесь, прошу только обратить внимание на локальную процедуру записи класса. Сначала мы получаем экземпляр самого объекта. Потом проверяем, не является ли он потомком TGraphic. Далее записываем в поток, является ли графический объект пустым. Дело в том, что если объект (например Bitmap) пустой, то вызов SaveToStream не запишет в поток ничего. При чтении объект не сможет узнать о том, что он должен быть пустым, и будет, как ни в чем не бывало читать следующие по очереди данные из потока. Само собой это вызовет ошибку. Честно говоря, мне не очень нравится, как я решил эту проблему. Если у Вас есть идеи получше - пишите в обсуждении статьи.

И в конце процедуры WriteClassProp самое главное. Запрашиваем интерфейс IStreamPersist и заодно проверяем, поддерживает ли вообще его объект. Если да, то вызываем метод интерфейса SaveToStream.

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

Совсем немного теории

Для тех, кто знает, что скрывается за страшной аббревиатурой RTTI, рекомендую пропустить этот раздел, ничего нового Вы здесь не найдете. А остальных попытаюсь немного ввести в курс дела.

RTTI (Run-time type information) - как видно из названия, это механизм, позволяющий определить тип данных во время выполнения. Суть его в том, что компилятор генерирует расширенную информацию для почти всех классов, используемых в вашей программе. Я сказал почти? Да, только для классов, объявленных с директивой {$M+} и их потомков, а таким классом, в частности является TPersistent. Потомками этого класса являются все компоненты, графические классы (TFont, TBitmap, TIcon и т.д.) и многие другие. Так вот, я отвлекся, эта информация активно используется самой средой разработки (инспектор объектов, редакторы свойств) и может быть использована программистом. Необходимые средства для работы с RTTI находятся в модуле TypInfo.pas. Проблема лишь в том, что по неизвестным мне причинам, Borland решила не документировать эти возможности (в справке по Delphi7, не нашел ничего связанного с RTTI, кроме упомянутой ранее директивы {$M+/-}, метода TObject.ClassInfo и операторов is и as).

И еще: RTTI позволяет получить информацию о свойствах и методах, объявленных ТОЛЬКО в разделе published. Зачем нам это нужно и как это нам поможет - увидите далее.

Ставим задачу

Поставим себе такую задачу: создать класс, который будет искать все свои published-свойства и сохранять их в поток (в файл, в частности). Программисту нужно только ОДИН раз написать код, который реализует сказанное выше, создать потомка этого класса, объявить в нем все необходимые свойства, и вызвать метод SaveToStream (его не надо будет перекрывать для каждого потомка) для сохранения самого себя в поток. Аналогично, метод LoadFromStream прочитает все свойства из потока. Ну-с, приступим-с.

Упрощаем работу с потоками (TStream)

Юрий Спектор,

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

CryptoAPI

Криптографические функции являются частью операционной системы Windows, и обратится к ним можно посредством интерфейса CryptoAPI. Основные возможности доступны еще с Windows 95, но со временем они расширялись. Описание функций CryptoAPI можно найти в , литературе[2] или в справочном файле к Delphi. Функции содержаться в библиотеках advapi32.dll и crypt32.dll. Их можно импортировать самостоятельно, а можно воспользоваться файлом Wcrypt2.pas, который прилагается к данной статье.

Подключение к криптопровайдеру. Контейнеры ключей.

Первая функция, которую мы рассмотрим, будет function CryptAcquireContext(phProv :PHCRYPTPROV; pszContainer :LPAWSTR; pszProvider :LPAWSTR; dwProvType :DWORD; dwFlags :DWORD) :BOOL; stdcall;

В большинстве случаев, работа с криптографическими возможностями Windows начинается с вызова именно этой функции, которая выполняет подключение к криптопровайдеру и возвращает его дескриптор в параметре phProv. Криптопровайдер представляет собой dll, независимый программный модуль, который фактически исполняет криптографические алгоритмы. Криптопровайдеры бывают различные и отличаются составом функций (например, некоторые криптопровайдеры ограничиваются лишь цифровыми подписями), используемыми алгоритмами (некоторые шифруют алгоритмом RC2, другие - DES) и другими возможностями. В каждой операционной системе свой состав криптопровайдеров, однако в каждой присутствует Microsoft Base Cryptographic Provider v1.0. При вызове функции CryptAcquireContext, необходимо указать имя провайдера и его тип (соответственно в параметрах pszProvider и dwProvType). Тип провайдера определяет состав функций и поддерживаемые криптоалгоритмы, например:

Тип PROV_RSA_FULL Обмен ключами - алгоритм RSA Цифровая подпись - алгоритм RSA Шифрование - алгоритм RC2 и RC4 Хэширование - алгоритмы MD5 и SHA Тип PROV_RSA_SIG Обмен ключами - не поддерживается Цифровая подпись - алгоритм RSA Шифрование - не поддерживается Хэширование - алгоритмы MD5 и SHA

Microsoft Base Cryptographic Provider v1.0 относится к типу PROV_RSA_FULL и для этого типа используется по умолчанию (если в параметре pszProvider указать nil). В параметре pszContainer необходимо указать имя контейнера ключей, который мы собираемся использовать. Дело в том, что каждый криптопровайдер содержит базу данных, в которой хранятся ключи пользователей. Эти ключи группируются в контейнерах. Сохраняются только ключевые пары для асимметричных алгоритмов, сеансовые ключи не сохраняются, так как их не рекомендуют использовать повторно. Таким образом, каждый контейнер имеет имя и содержит по одному ключу (точнее паре открытый-закрытый ключ) для цифровой подписи и обмена ключами (помните, я говорил, что из-за низкого быстродействия асимметричные алгоритмы используются в основном только для шифрования сеансовых ключей и подписи хэша). В зависимости от криптопровайдера, база данных может храниться в файлах, реестре или в каких-либо аппаратных средствах, но это не влияет на работу программиста с контейнерами ключей. Если в качестве параметра pszContainer указать nil, то будет использоваться контейнер ключей, название которого совпадает именем пользователя, под которым был осуществлен вход в систему. Но так делать не рекомендуется: дело в том, что если два приложения использует один и тот же контейнер, одно из них может изменить или уничтожить ключи, необходимые для корректной работы другого приложения. Поэтому рекомендуют использовать контейнеры, имена которых совпадает с именем приложения.

Параметр dwFlags может быть нулевым или принимать одно из следующих значений: CRYPT_VERIFYCONTEXT - этот флаг предназначен для приложений, которые не должны иметь доступ к закрытым ключам контейнера. Такие приложения могут обращаться только к функциям хеширования, проверки цифровой подписи или симметричного шифрования. В этом случае параметр pszContainer должен быть равен nil. CRYPT_NEWKEYSET - создает новый контейнер ключей, но сами ключи не создаются. CRYPT_DELETEKEYSET - удаляет контейнер вместе с хранящимися там ключами. Если задан этот флаг, то подключение к криптопровайдеру не происходит и параметр phProv неопределен. CRYPT_MACHINE_KEYSET - по умолчанию контейнеры ключей сохраняются как пользовательские. Для основных криптопровайдеров это означает, что контейнеры ключей сохраняются в пользовательских профилях. Этот флаг можно устанавливать в комбинации с другими, чтобы указать, что контейнер является машинным, то есть хранится в профиле All Users.

В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.

function CryptReleaseContext(hProv :HCRYPTPROV; dwFlags :DWORD) :BOOL; stdcall;

Освобождает контекст криптопровайдера и контейнера ключей. hProv - дескриптор криптопровайдера, полученный при вызове CryptAcquireContext. dwFlags - зарезервирован и должен равняться нулю.

В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.

Приведем пример работы с этими функциями: uses Wcrypt2; ... procedure CryptProc; var Prov: HCRYPTPROV; begin CryptAcquireContext(@Prov,nil,nil,PROV_RSA_FULL,CRYPT_VERIFYCONTEXT); // Работаем с функциями CryptoAPI ... CryptReleaseContext(Prov,0); end;

Прежде, чем перейти непосредственно к криптографическим функциям, упомяну еще о таких функциях как CryptSetProvider, CryptGetDefaultProvider, CryptGetProvParam, CryptSetProvParam, CryptEmunProviders, CryptEnumProviderTypes, описание которых вы найдете сами.

Хэширование и электронно-цифровая подпись.

function CryptCreateHash(hProv :HCRYPTPROV; Algid :ALG_ID; hKey :HCRYPTKEY; dwFlags :DWORD; phHash :PHCRYPTHASH) :BOOL; stdcall;

Функция создает в системе хэш-объект и возвращает в параметре phHash его дескриптор. Данные, поступающие на вход хэш-объекта, там преобразуются, и их отпечаток сохраняется внутри хэш-объекта.

В параметре hProv нужно указать дескриптор провайдера, полученный с помощью CryptAcquireContext. Параметр Algid указывает на то, какой алгоритм хэширования будет использоваться. Для Microsoft Base Cryptographic Provider может принимать следующие значения: CALG_MAC, CALG_MD2, CALG_MD5, CALG_SHA. Смысл этих значений, думаю, понятен. Параметр hKey подробно рассматривать не будем, вы можете почитать о нем сами. Скажу лишь, что обычно (если не используется алгоритм с секретным ключом, такой как MAC) его указывают равным нулю. Параметр dwFlags зарезервирован на будущее и должен быть равен нулю.

В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.

function CryptDestroyHash(hHash :HCRYPTHASH) :BOOL; stdcall;

Функция уничтожает хэш-объект, созданный с помощью CryptCreateHash. В параметре hHash указывается дескриптор хэш-объекта.

В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.

function CryptHashData(hHash :HCRYPTHASH; const pbData :PBYTE; dwDataLen :DWORD; dwFlags :DWORD) :BOOL; stdcall;

Функция позволяет добавлять данные к объекту хэш-функции. Функция может вызываться несколько раз, данные, от которых мы вычисляем хэш, разбиты на порции. В параметре hHash указывается дескриптор хэш-объекта, созданный с помощью CryptCreateHash. pbData содержит указатель на данные, а dwDataLen содержит размер этих данных в байтах. Для Microsoft Base Cryptographic Provider параметр dwFlags должен быть равен нулю.

В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.

function CryptSignHash(hHash :HCRYPTHASH; dwKeySpec :DWORD; sDescription :LPAWSTR; dwFlags :DWORD; pbSignature :PBYTE; pdwSigLen :PDWORD) :BOOL; stdcall;

Функция вычисляет значение электронно-цифровой подписи от значения хэша. В параметре hHash указывается дескриптор хэш-объекта, созданный с помощью CryptCreateHash. dwKeySpec указывает, какой ключ будет использован для создания подписи. Как уже говорилось, в хранилище ключей содержится две ключевые пары: для подписи и для обмена ключами. Соответственно этот параметр может принимать значения AT_SIGNATURE или AT_KEYEXCHANGE (логичнее использовать AT_SIGNATURE). Ключи должны существовать в контейнере. sDescription может содержать произвольную строку описания. Эта строка будет добавлена к хэшу и должна быть известна приемной стороне. Использовать этот параметр не рекомендуется, так как это снижает безопасность системы. Параметр dwFlags не поддерживается в Microsoft Base Cryptographic Provider и на его месте следует указать ноль. pbSignature указывает на буфер, куда будет помещена цифровая подпись, а pdwSigLen - размер этого буфера. Если размер заранее не известен, то можно указать pbSignature равным nil, и тогда в параметре pdwSigLen мы получим необходимый размер буфера.

В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.

function CryptVerifySignature(hHash :HCRYPTHASH; const pbSignature :PBYTE; dwSigLen :DWORD; hPubKey :HCRYPTKEY; sDescription :LPAWSTR; dwFlags :DWORD) :BOOL; stdcall;

Функция осуществляет проверку цифровой подписи. hHash - дескриптор хэш-объекта, значение которого является отпечатком сообщения, подпись которого мы проверяем. pbSignature - указатель на буфер, содержащий подпись, dwSigLen - размер этого буфера. hPubKey - дескриптор открытого ключа, с помощью которого мы будем проверять подпись. Открытый ключ должен соответствовать закрытому, которым осуществлялась подпись. О том, как получить этот ключ, поговорим позже. Параметры sDescription и dwFlags должны соответствовать параметрам функции CryptSignHash при осуществлении подписи.

В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.

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

1. Создание подписи. uses Wcrypt2; ... function SignMessage(Message: String): String; var Prov: HCRYPTPROV; Hash: HCRYPTHASH; BufLen: DWORD; begin Result:=''; CryptAcquireContext(@Prov,nil,nil,PROV_RSA_FULL,0); CryptCreateHash(Prov,CALG_MD5,0,0,@Hash); CryptHashData(Hash,PByte(Message),Length(Message),0); BufLen:=0; CryptSignHash(Hash,AT_SIGNATURE,nil,0,nil,@BufLen); if BufLen>0 then begin SetLength(Result,BufLen); CryptSignHash(Hash,AT_SIGNATURE,nil,0,PByte(Result),@BufLen); end; CryptDestroyHash(Hash); CryptReleaseContext(Prov,0); end; 2. Проверка подписи. В коде будут упущены некоторые фрагменты, о которых мы поговорим позже.

function VerifySign(Message, Sign: String): Boolean; var Prov: HCRYPTPROV; Hash: HCRYPTHASH; PublicKey: HCRYPTKEY; begin CryptAcquireContext(@Prov,nil,nil,PROV_RSA_FULL,0); CryptCreateHash(Prov,CALG_MD5,0,0,@Hash); CryptHashData(Hash,PByte(Message),Length(Message),0); // Здесь должен быть импорт открытого ключа для проверки подписи ... Result:=CryptVerifySignature(Hash,PByte(Sign),Length(Sign), PublicKey,nil,0); // Здесь должно быть уничтожение открытого ключа ... CryptDestroyHash(Hash); CryptReleaseContext(Prov,0); end;

Рекомендую ознакомиться самостоятельно с функциями CryptHashSessionKey, CryptGetHashParam и CryptSetHashParam.

Шифрование на основе пользовательских данных или пароля.

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

function CryptDeriveKey(hProv :HCRYPTPROV; Algid :ALG_ID; hBaseData :HCRYPTHASH; dwFlags :DWORD; phKey :PHCRYPTKEY) :BOOL; stdcall;

В параметре hProv нужно указать дескриптор провайдера, полученный с помощью CryptAcquireContext. Algid - идентификатор алгоритма, для которого генерируется ключ. Для Microsoft Base Cryptographic Provider может принимать следующие значения: CALG_RC2 и CALG_RC4. Пользовательские данные (пароль) предварительно хэшируются и дескриптор хэш-объекта передается в функцию в качестве параметра hBaseData. Старшие 16 бит параметра dwFlags могут содержать размер ключа в битах или быть нулевыми (в этом случае будет создан ключ с размером по умолчанию). Младшие 16 бит могут быть нулевыми или принимать следующие значения или их комбинации: CRYPT_EXPORTABLE, CRYPT_CREATE_SALT, CRYPT_USER_PROTECTED, CRYPT_UPDATE_KEY. К первым двум мы еще вернемся, а со смыслом остальных вы можете ознакомиться самостоятельно. В параметре phKey возвращается дескриптор созданного ключа.

В случае успеха, функция возвращает true, в противном случае - false. GetLastError вернет код ошибки.

Когда ключ есть, можно приступать непосредственно к шифрованию. Для этого нам понадобятся функции CryptEncrypt и CryptDecrypt.

function CryptEncrypt(hKey :HCRYPTKEY; hHash :HCRYPTHASH; Final :BOOL; dwFlags :DWORD; pbData :PBYTE; pdwDataLen :PDWORD; dwBufLen :DWORD) :BOOL; stdcall;

В параметре hKey передается дескриптор ключа, необходимый для шифрования. Этот ключ также определяет алгоритм шифрования. Параметр hHash используется, если данные одновременно шифруются и хэшируются (шифроваться и хэшироваться будут исходные данные). В этом случае в параметре hHash передается дескриптор заранее созданного хэш-объекта. Эту возможность удобно использовать, если необходимо одновременно зашифровать и подписать сообщение. Иначе этот параметр следует установить в ноль. Параметр Final следует установить в true, если переданный в функцию блок данных является единственным или последним. В этом случае он будет дополнен до необходимого размера. Параметр dwFlags не используется в Microsoft Base Cryptographic Provider и на его месте следует указать ноль. pbData - указатель на буфер, в котором содержаться данные для зашифрования. Зашифрованыые данные помещаются в тот же буфер. pdwDataLen - размер данных, которые будут зашифрованы. dwBufLen - размер выходного буфера, для блочных шифров может быть больше, чем pdwDataLen. Узнать необходимый размер, можно передав в параметре pbData nil, в параметре pdwDataLen - размер данных, которые необходимо зашифровать, а в параметре dwBufLen - что угодно, например ноль. После такого вызова, необходимый размер буфера будет содержаться в параметре pdwDataLen (именно pdwDataLen, а не dwBufLen, немного нелогично, ну да ладно). Чтобы не было путаницы, приведу простой пример:

var Message: String; BufLen, DataLen: DWORD; ... begin ... Message:='Hello World!'; BufLen:=Length(Message); DataLen:=Length(Message); // Вычисляем необходимый размер выходного буфера CryptEncrypt(Key,0,true,0,nil,@BufLen,0); // Выделяем память для буфера и шифруем SetLength(Message,BufLen); CryptEncrypt(Key,0,true,0,PByte(Message),@DataLen,BufLen); Теперь, рассмотрим функцию, которая позволяет расшифровать сообщение. function CryptDecrypt(hKey :HCRYPTKEY; hHash :HCRYPTHASH; Final :BOOL; dwFlags :DWORD; pbData :PBYTE; pdwDataLen :PDWORD) :BOOL; stdcall;

Даже не буду подробно описывать все параметры - тут все очевидно. Скажу лишь, что в параметр pdwDataLen нужно передать число байт шифротекста, а после вызова в него будет помещена длина открытого сообщения. Если используется параметр hHash, то данные после расшифровки хэшируются. Это удобно использовать, если нужно одновременно расшифровать сообщение и проверить подпись.

После того, как работа с ключом закончена, необходимо освободить дескриптор:

function CryptDestroyKey(hKey :HCRYPTKEY) :BOOL; stdcall;

Если hKey относится к сеансовому ключу или импортированному открытому ключу (об этом ниже), то дескриптор освобождается, а ключ уничтожается. Если hKey относится к паре открытый/закрытый ключ, то дескриптор освобождается, а ключевая пара сохраняется в контейнере ключей.

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

Генерация случайных ключей. Импорт/экспорт ключей.

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

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

function CryptGenKey(hProv :HCRYPTPROV; Algid :ALG_ID; dwFlags :DWORD; phKey :PHCRYPTKEY) :BOOL; stdcall;

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

uses Wcrypt2; ... var Prov: HCRYPTPROV; ExchangeKey, SignKey: HCRYPTKEY; begin CryptAcquireContext(@Prov,'My_Container',nil,PROV_RSA_FULL,CRYPT_NEWKEYSET); // Создаем ключевые пары CryptGenKey(Prov,AT_KEYEXCHANGE,0,@ExchangeKey); CryptGenKey(Prov,AT_SIGNATURE,0,@SignKey); // Работаем с функциями CryptoAPI ... // Освобождаем дескрипторы ключевых пар. Сами ключи сохраняются в контейнере CryptDestroyKey(SignKey); CryptDestroyKey(ExchangeKey); CryptReleaseContext(Prov,0); end; Созданные таким образом ключевые пары, впоследствии можно извлечь из контейнера, воспользовавшись функцией function CryptGetUserKey(hProv :HCRYPTPROV; dwKeySpec :DWORD; phUserKey :PHCRYPTKEY) :BOOL; stdcall;

Параметр dwKeySpec может принимать два значения: AT_KEYEXCHANGE и AT_SIGNATURE, значения которых очевидны. Дескриптор ключа возвращается в параметре phUserKey.

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

function CryptExportKey(hKey :HCRYPTKEY; hExpKey :HCRYPTKEY; dwBlobType :DWORD; dwFlags :DWORD; pbData :PBYTE; pdwDataLen :PDWORD) :BOOL; stdcall;

Функция позволяет экспортировать ключ в двоичный буфер, который впоследствии можно будет сохранить в файл и передать кому-либо. В параметре hKey должен содержаться дескриптор экспортируемого ключа. Экспортировать можно не только открытые ключи, а также ключевые пары целиком и сеансовые ключи. В последних двух случаях, ключи и ключевые пары должны быть созданы функциями CryptGenKey или CryptDeriveKey с параметрами dwFlags равными CRYPT_EXPORTABLE. Открытые же ключи всегда экспортируемы. Сеансовые ключи и ключевые пары экспортируются только в зашифрованном виде. Параметр hExpKey определяет ключ, которым они будут зашифрованы. Если экспортируется открытая часть ключа, то этот параметр следует установить в ноль, если экспортируется ключевая пара целиком, то здесь обычно передают дескриптор сеансового ключа (обычно полученный с помощью CryptDeriveKey), которым пара будет зашифрована, если экспортируется сеансовый ключ, то обычно он шифруется открытым ключом получателя (обычно используется ключ обмена, но никто не запрещает использовать ключ подписи). Параметр dwBlobType определяет тип экспортируемого ключа и может принимать следующие значения: SIMPLEBLOB - сеансовый ключ, PUBLICKEYBLOB - открытый ключ, PRIVATEKEYBLOB - ключевая пара целиком. Существуют и другие значения, но они не поддерживаются стандартным криптопровайдером. Параметр dwFlags для Microsoft Base Cryptographic Provider должен быть равен нулю. pbData - буфер, куда будут скопированы данные, pdwDataLen - размер этого буфера. Если он заранее не известен, то можно указать в качестве параметра pbData nil, и в pdwDataLen будет получен необходимый размер.

Вот пример экспорта открытого ключа: procedure ExportPublicKey(FileName: TFileName); var Prov: HCRYPTPROV; SignKey: HCRYPTKEY; Stream: TMemoryStream; BufSize: DWORD; begin CryptAcquireContext(@Prov,'My_Container',nil,PROV_RSA_FULL,0); CryptGetUserKey(Prov,AT_SIGNATURE,@SignKey); Stream:=TMemoryStream.Create; CryptExportKey(SignKey,0,PUBLICKEYBLOB,0,nil,@BufSize); Stream.SetSize(BufSize); CryptExportKey(SignKey,0,PUBLICKEYBLOB,0,PByte(Stream.Memory),@BufSize); Stream.SaveToFile(FileName); Stream.Free; CryptDestroyKey(SignKey); CryptReleaseContext(Prov,0); end; Импорт ключа осуществляется с помощью функции function CryptImportKey(hProv :HCRYPTPROV; pbData :PBYTE; dwDataLen :DWORD; hPubKey :HCRYPTKEY; dwFlags :DWORD; phKey :PHCRYPTKEY) :BOOL; stdcall;

Тут практически все понятно. Поясню лишь, что в параметре hPubKey необходимо передать дескриптор ключа, которым будет расшифрован импортированный ключ. Если импортируется ключевая пара целиком, то параметр dwFlags можно установить в CRYPT_EXPORTABLE, тогда импортированная пара может быть впоследствии также экспортирована. В параметре phKey вернется дескриптор полученного ключа. Если это ключевая пара, то она будет сохранена в контейнере.

Вот пример импорта открытого ключа: function ImportPublicKey(FileName: TFileName): HCRYPTKEY; var Prov: HCRYPTPROV; Stream: TMemoryStream; begin Stream:=TMemoryStream.Create; Stream.LoadFromFile(FileName); CryptImportKey(Prov,PByte(Stream.Memory),Stream.Size,0,0,@Result); Stream.Free; end;

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

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

Говоря о сеансовых ключах, используемых в Microsoft Base Cryptographic Provider нужно упомянуть об одной неприятности: до начала 2000 года действовал запрет на экспорт программного обеспечения, использующего средства "сильной криптографии" за пределами США и Канады. По этой причине в базовом криптопровайдере не поддерживаются ключи для симметричных алгоритмов длиной более 40 бит. Ключи длиной 56 бит разрешалось использовать только заграничным отделениям американских компаний. Для алгоритмов RC2 и RC4 рекомендуемая длина ключа должна составлять 128 бит, поэтому недостающее количество бит заполняется нулями либо случайными значениями, которые должны передаваться открыто. Надежность защиты из-за этого, разумеется, сильно страдает. В состав Windows XP входит Microsoft Enhanced Cryptographic Provider, в котором этой проблемы нет, но при использовании базового криптопровайдера, необходимо дополнять ключ до нужной длины, используя т.н. солт-значения (salt-values). Сгенерировать salt-value и внести его в ключ можно несколькими способами, но самый простой и очевидный - при вызове CryptGenKey или CryptDeriveKey передать в параметре dwFlags значение CRYPT_CREATE_SALT, примерно так:

CryptGenKey(Prov,CALG_RC2,CRYPT_EXPORTABLE or CRYPT_CREATE_SALT,@Key); При экспорте ключа солт-значение не сохраняется, о нем должен позаботиться сам программист. var SaltLen: DWORD; Stream: TMemoryStream; ... begin ... // Определяем размер буфера для солт-значения CryptGetKeyParam(Key,KP_SALT,nil,@SaltLen,0); // Сохраняем его в файл Stream:=TMemoryStream.Create; Stream.SetSize(SaltLen); CryptGetKeyParam(Key,KP_SALT,PByte(Stream.Memory),@SaltLen,0); Stream.SaveToFile('Salt.dat'); Stream.Free; ... Сохраненное таким образом солт-значение необходимо передать вместе с сеансовым ключом, а на приемной стороне "вживить" его туда снова. var Stream: TMemoryStream; ... begin ... Stream:=TMemoryStream.Create; Stream.LoadFromFile('Salt.dat'); CryptSetKeyParam(Key,KP_SALT,PByte(Stream.Memory),Stream.Size); Stream.Free; ...

Для работы с солт-значениями мы воспользовались функциями CryptGetKeyParam и CryptSetKeyParam, однако их возможности на этом не заканчиваются. Рекомендую ознакомиться с ними самостоятельно, а также с другими функциями, которые в данной статье не упоминались: CryptGenRandom, CryptDuplicateKey, CryptDublicateHash.

Другие полезности

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

HashLib! 1.03 (C) Alex Demchenko, 2002, Moldova, Chishinev - очень хорошая и удобная библиотека, в которой реализовано множество алгоритмов хэширования: MD4, MD5, CRC32, HAVAL-128, SHA-1, SHA-256, TIGER-128, GOST, RIPEMD-128 и другие. FGInt copyright 2000, Walied Othman - отличная библиотека для работы с гигантскими целыми числами, необходимыми для работы алгоритма RSA и с самим RSA. DCPCrypt Copyright (c) 1999-2003 David Barton - огромная библиотека компонент, для работы с криптографическими функциями. RSATool2v17 - Генератор чисел p, q, e, n, d для алгоритма RSA.

К материалу прилагаются файлы: Demo-проект на Delphi (171 K) Заголовочные файлы для CryptoAPI (52 K) Генератор RSAToo2v17 (56 K) Библиотека HashLib! (182 K) Библиотека FGInt (19 K) Библиотека DCPCrypt (182 K)

Использование инструментов криптографии в Delphi-приложениях

Юрий Спектор,

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

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

Брюс Шнайер - "Прикладная криптография". Щербаков Л.Ю. Домашен А.В. - "Прикладная криптография".

Основные понятия

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

Открытый текст - собственно, это и есть та информация, которую мы будем пытаться защитить от несанкционированного доступа. "Открытый текст" - это вовсе не обязательно именно текст, это также могут быть двоичные данные, программный код, и т.д. Шифрованный текст - результат преобразования открытого текста, с использованием криптографических алгоритмов и дополнительного параметра (ключа) недоступный для восприятия. Шифрование - процесс создание шифрованного текста при наличии открытого текста и ключа. Дешифрование - процесс восстановления открытого текста из шифрованного при помощи ключа. Ключ - параметр шифра, необходимый для шифрования и/или дешифрования. Шифры подразделяются на две группы: Симметричные - для шифрования и дешифрования используется один и тот же ключ. Очевидно, что "секретность" шифрованного текста зависит от "секретности" ключа, поэтому такие ключи так и называются "секретными". Тут есть одна проблема: при передаче сообщения собеседнику, необходимо чтобы у него был тот же ключ, что и у Вас. А где гарантия, что при передаче ключа собеседнику, его никто не перехватит? Эта проблема решается с помощью асимметричных алгоритмов шифрования. Симметричные алгоритмы могут быть блочными (сообщение разбивается на блоки фиксированной длины, каждый из которых шифруется отдельно) и потоковыми (сообщение шифруется посимвольно). При использовании блочных шифров размер сообщения должен быть кратен размеру блока, в противном случае последний блок дополняется до необходимой длины. Блочные шифры считаются более надежными. Асимметричные - для шифрования и дешифрования используются разные ключи. Один из ключей держится в строжайшем секрете (он называется "закрытый"), другой - публикуется ("открытый"). Теперь представьте, что вы хотите передать какую-либо секретную информацию вашему другу или коллеге. Вы возьмете его открытый ключ (как уже было сказано - он не является секретным, и узнать его может кто угодно) и зашифруете с помощью его свое сообщение. Получив шифрованный текст, он попытается расшифровать его с помощью своего закрытого ключа. Так как закрытый ключ кроме него не известен никому, то полученное сообщение не сможет восстановить никто посторонний.

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

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

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

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

Хэш-функция - это такая функция, значение которой является необратимым преобразованием исходного значения. Другими словами, пусть у нас есть число A. Вычислим Y=H(A). Функция H будет необратимой, если зная значение Y восстановить A будет невозможно. Такому условию удовлетворяет, например, простейшая контрольная сумма, однако к хэш-функциям есть еще одно серьезное требование: очень сложной задачей должно являться нахождение такого числа B не равного A, что H(B) также будет равняться Y (такие случаи называются коллизиями). Число Y называют дайджестом или отпечатком сообщения.

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

А теперь вернемся к цифровым подписям. Как уже было сказано, подписывать целое сообщение неразумно. В цифровой подписи главное не секретность самого сообщения, а гарантия того, что отправитель тот за кого себя выдает, и текст сообщения не был изменен после подписания. Обычно поступают так: высчитывается отпечаток сообщения (обычно он составляет 16-64 байт), шифруется закрытым ключом отправителя и передается вместе с самим сообщением. Получатель вычисляет отпечаток сообщения, расшифровывает подпись открытым ключом отправителя и сравнивает полученные значения. Эта процедура называется верификацией.

I. Слежение за процессами

На первый взгляд, задача кажется малорешаемой. На второй - после поиска в MSDN - понимаешь, что она не решаема в User-mode в том смысле, что нет соответствующих API. А впрочем, когда это было проблемой для настоящих программистов?

В режиме ядра задача решается тривиально - в драйвере регистрируешь callback функцией PsSetCreateProcessNotifyRoutine и он будет вызван при создании/удалении процесса. Но нам нужна реализация в user-mode...

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

получить список процессов просмотреть его на предмет появления новых процессов переход на 1) Реализуем его с помощью NATIVE API.

Отступление: Native API - это набор API, не документированный Microsoft (или документированный частично). С его помощью можно сделать все то же что можно сделать с помощью обычных API и многое другое. Мне в Native API нравится его структура, например с помощью одной функции ZwQuerySystemInformation можно получить очень большое количество информации (перечислить хэндлы, получить информацию о процессе и многое другое).

Для Delphi порт заголовочных файлов существует в нескольких вариантах, наиболее распространен вариант JEDI. Только, при использовании JEDI, придется все Zw-функции заменить на их Nt-аналоги. Впрочем, в режиме пользователя эти функции абсолютно идентичны. Разница наблюдается только в режиме ядра, подробнее читайте статью http://www.osronline.com/article.cfm?article=257 (она доступна только по подписке, или в кэше Google )

program process_seeker; {$APPTYPE CONSOLE} uses SysUtils, windows, tintlist; type NTStatus = cardinal; PVOID = pointer; USHORT = WORD; UCHAR = byte; PWSTR = PWideChar; CONST //Статус константы STATUS_SUCCESS = NTStatus($00000000); STATUS_ACCESS_DENIED = NTStatus($C0000022); STATUS_INFO_LENGTH_MISMATCH = NTStatus($C0000004); const SystemProcessesAndThreadsInformation = 5; type PClientID = ^TClientID; TClientID = packed record UniqueProcess:cardinal; UniqueThread:cardinal; end; PUnicodeString = ^TUnicodeString; TUnicodeString = packed record Length: Word; MaximumLength: Word; Buffer: PWideChar; end; PVM_COUNTERS = ^VM_COUNTERS; VM_COUNTERS = packed record PeakVirtualSize, VirtualSize, PageFaultCount, PeakWorkingSetSize, WorkingSetSize, QuotaPeakPagedPoolUsage, QuotaPagedPoolUsage, QuotaPeakNonPagedPoolUsage, QuotaNonPagedPoolUsage, PagefileUsage, PeakPagefileUsage: dword; end; PIO_COUNTERS = ^IO_COUNTERS; IO_COUNTERS = packed record ReadOperationCount, WriteOperationCount, OtherOperationCount, ReadTransferCount, WriteTransferCount, OtherTransferCount: LARGE_INTEGER; end; PSYSTEM_THREADS = ^SYSTEM_THREADS; SYSTEM_THREADS = packed record KernelTime, UserTime, CreateTime: LARGE_INTEGER; WaitTime: dword; StartAddress: pointer; ClientId: TClientId; Priority, BasePriority, ContextSwitchCount: dword; State: dword; WaitReason: dword; end; PSYSTEM_PROCESSES = ^SYSTEM_PROCESSES; SYSTEM_PROCESSES = packed record NextEntryDelta, ThreadCount: dword; Reserved1 : array [0..5] of dword; CreateTime, UserTime, KernelTime: LARGE_INTEGER; ProcessName: TUnicodeString; BasePriority: dword; ProcessId, InheritedFromProcessId, HandleCount: dword; Reserved2: array [0..1] of dword; VmCounters: VM_COUNTERS; IoCounters: IO_COUNTERS; // Windows 2000 only Threads: array [0..0] of SYSTEM_THREADS; end; Function ZwQuerySystemInformation(ASystemInformationClass: dword; ASystemInformation: Pointer; ASystemInformationLength: dword; AReturnLength:PCardinal): NTStatus; stdcall;external 'ntdll.dll'; { Получение буфера с системной информацией } Function GetInfoTable(ATableType:dword):Pointer; var mSize: dword; mPtr: pointer; St: NTStatus; begin Result := nil; mSize := $4000; //начальный размер буфера repeat mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE); if mPtr = nil then Exit; St := ZwQuerySystemInformation(ATableType, mPtr, mSize, nil); if St = STATUS_INFO_LENGTH_MISMATCH then begin //надо больше памяти VirtualFree(mPtr, 0, MEM_RELEASE); mSize := mSize * 2; end; until St <> STATUS_INFO_LENGTH_MISMATCH; if St = STATUS_SUCCESS then Result := mPtr else VirtualFree(mPtr, 0, MEM_RELEASE); end; var info, info2: PSystem_Processes; i, j, k: integer; t, t1: LARGE_INTEGER; process_id: tintegerlist; begin process_id := TIntegerList.Create; //СОЗДАЕМ СПИСОК ПРОЦЕССОВ НА МОМЕНТ СОЗДАНИЯ НАШЕГО ПРОЦЕССА info := GetInfoTable(SystemProcessesAndThreadsInformation); info2 := info; while (info2^.NextEntryDelta <> 0) do begin if (process_id.IndexOf(info2^.ProcessId)=-1) then process_id.Add(info2^.ProcessId); info2 := Pointer(dword(info2)+info2^.NextEntryDelta); end; VirtualFree(info, 0, MEM_RELEASE); //А теперь смотрим что добавилось while true do begin Sleep(200); info := GetInfoTable(SystemProcessesAndThreadsInformation); info2 := info; while (info2^.NextEntryDelta <> 0) do begin if (process_id.IndexOf(info2^.ProcessId)=-1) then begin writeln(info2^.ProcessId, ' - created'); process_id.Add(info2^.ProcessId); end; info2 := Pointer(dword(info2)+info2^.NextEntryDelta); end; VirtualFree(info, 0, MEM_RELEASE); end; end.

Вы можете легко переделать этот код для того, чтобы отслеживать также и терминирование процессов :) Оставим это читателю в качестве домашнего задания :)

II. Слежение за файлами

Здесь можно применить либо тот же подход что описан выше для процессов либо воспользоваться портами завершения.

Приведем реализацию первого метода program file_seeker; {$APPTYPE CONSOLE} uses SysUtils, windows, tintlist; type NTStatus = cardinal; PVOID = pointer; USHORT = WORD; UCHAR = byte; PWSTR = PWideChar; CONST //Статус константы STATUS_SUCCESS = NTStatus($00000000); STATUS_ACCESS_DENIED = NTStatus($C0000022); STATUS_INFO_LENGTH_MISMATCH = NTStatus($C0000004); SEVERITY_ERROR = NTStatus($C0000000); const SystemHandleInformation = 16; OB_TYPE_FILE = 28; type PClientID = ^TClientID; TClientID = packed record UniqueProcess:cardinal; UniqueThread:cardinal; end; PUnicodeString = ^TUnicodeString; TUnicodeString = packed record Length: Word; MaximumLength: Word; Buffer: PWideChar; end; PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION; SYSTEM_HANDLE_INFORMATION = packed record ProcessId: dword; ObjectTypeNumber: byte; Flags: byte; Handle: word; pObject: pointer; GrantedAccess: dword; end; PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX; SYSTEM_HANDLE_INFORMATION_EX = packed record NumberOfHandles: dword; Information: array [0..0] of SYSTEM_HANDLE_INFORMATION; end; Function ZwQuerySystemInformation(ASystemInformationClass: dword; ASystemInformation: Pointer; ASystemInformationLength: dword; AReturnLength:PCardinal): NTStatus; stdcall;external 'ntdll.dll'; { Включение заданой привилегии для процесса } function EnablePrivilegeEx(Process: dword; lpPrivilegeName: PChar):Boolean; var hToken: dword; NameValue: Int64; tkp: TOKEN_PRIVILEGES; ReturnLength: dword; begin Result:=false; //Получаем токен нашего процесса OpenProcessToken(Process, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken); //Получаем LUID привилегии if not LookupPrivilegeValue(nil, lpPrivilegeName, NameValue) then begin CloseHandle(hToken); exit; end; tkp.PrivilegeCount := 1; tkp.Privileges[0].Luid := NameValue; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; //Добавляем привилегию к процессу AdjustTokenPrivileges(hToken, false, tkp, SizeOf(TOKEN_PRIVILEGES), tkp, ReturnLength); if GetLastError() <> ERROR_SUCCESS then begin CloseHandle(hToken); exit; end; Result:=true; CloseHandle(hToken); end; { включение заданной привилегии для текущего процесса } function EnablePrivilege(lpPrivilegeName: PChar):Boolean; begin Result := EnablePrivilegeEx(INVALID_HANDLE_VALUE, lpPrivilegeName); end; { Включение привилегии SeDebugPrivilege для процесса } function EnableDebugPrivilegeEx(Process: dword):Boolean; begin Result := EnablePrivilegeEx(Process, 'SeDebugPrivilege'); end; { Включение привилегии SeDebugPrivilege для текущего процесса } function EnableDebugPrivilege():Boolean; begin Result := EnablePrivilegeEx(INVALID_HANDLE_VALUE, 'SeDebugPrivilege'); end; { Получение буфера с системной информацией } Function GetInfoTable(ATableType:dword):Pointer; var mSize: dword; mPtr: pointer; St: NTStatus; begin Result := nil; mSize := $4000; //начальный размер буфера repeat mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE); if mPtr = nil then Exit; St := ZwQuerySystemInformation(ATableType, mPtr, mSize, nil); if St = STATUS_INFO_LENGTH_MISMATCH then begin //надо больше памяти VirtualFree(mPtr, 0, MEM_RELEASE); mSize := mSize * 2; end; until St <> STATUS_INFO_LENGTH_MISMATCH; if St = STATUS_SUCCESS then Result := mPtr else VirtualFree(mPtr, 0, MEM_RELEASE); end; var HandlesInfo: PSYSTEM_HANDLE_INFORMATION_EX; r: integer; hProcess, tHandle: dword; file_h: tintegerlist; begin file_h := tintegerlist.Create; EnableDebugPrivilege(); HandlesInfo := GetInfoTable(SystemHandleInformation); for r := 0 to HandlesInfo^.NumberOfHandles do if HandlesInfo^.Information[r].ObjectTypeNumber = OB_TYPE_FILE then begin file_h.Add(HandlesInfo^.Information[r].Handle); end; VirtualFree(HandlesInfo, 0, MEM_RELEASE); //а теперь смотрим что изменилось while true do begin Sleep(200); HandlesInfo := GetInfoTable(SystemHandleInformation); for r := 0 to HandlesInfo^.NumberOfHandles do if HandlesInfo^.Information[r].ObjectTypeNumber = OB_TYPE_FILE then begin if file_h.IndexOf(HandlesInfo^.Information[r].Handle)=-1 then begin file_h.Add(HandlesInfo^.Information[r].Handle); writeln(HandlesInfo^.Information[r].Handle, ' - added a file handle'); end; end; VirtualFree(HandlesInfo, 0, MEM_RELEASE); end; readln; end.

Вторая технология - использование ReadDirectoryChangesA(W) и портов завершения ввода/вывода, реализация несложная, исходники (не мои, откомментированные) брать здесь.

III. Outro

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

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

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

К материалу прилагаются файлы:

Книга Excel с приведенными в статье макросами (17.8 K) обновление от 4/24/2006 7:00:00 AM Demo-проект на Delphi (6 K) обновление от 4/24/2006 7:00:00 AM Demo-проект на C# (392 K) обновление от 4/24/2006 7:00:00 AM

Перенос VBA-макросов в Delphi

Александр Шабля,

Запись макроса (меню Excel "Сервис\Макрос\Начать запись…") незаменимая вещь при написании отчетов или создания диаграмм в Excel'е, особенно для тех, кто только начинает с ним работать. Но, записанный в Excel макрос, иногда выглядит довольно громоздко и читается с трудом. В данной статье я хочу рассмотреть методы перевода записанных макросов в более удобный вид для использования их в Delphi. Также будет рассмотрены некоторые нестыковки в объектной модели Excel'я в записанных макросах и методы их исправления.

Для начала рассмотрим записанные в Excel'е макросы и попробуем сократить их VBA-код для переноса в Delphi. Откроем в Excel'e новую книгу и выполним, к примеру, простые действия - запустим запись макроса, выделим область "A1:D5" и в тулбаре "Границы" выберем "Все границы". Остановим запись макроса и посмотрим, что у нас получилось. Должен появиться примерно такой код (чтоб открыть VBA редактор в Excel'е нажмите Alt+F11): Sub Макрос1() ' Range("A1:D5").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub Да, многовато… Давайте посмотрим, что содержит полученный VBA-код: Выделили область и убрали диагональные линии (а они у нас были?). Нарисовали последовательно левую, верхнюю, правую, нижнюю границы. Нарисовали внутренние горизонтальные и вертикальные границы. Теперь попробуем сократить этот макрос, например, так (скопируйте код, приведенный ниже в VBA редактор): Sub Макрос1_1() ' With Range("A1:D5").Borders .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub

Очистим область "A1:D5" от границ и запустим наш макрос (перейдите в Excel из редактора, нажмите Alt+F8, выберите Макрос1_1 и нажмите "Выполнить"). Код намного короче, а результат тот же! Что мы сделали? Во-первых, убрали Select, просто указав какую область мы будем "обордюривать", во-вторых, вообще не указали какие границы будем заполнять, просто написав Borders без параметров (т.е. все). Почему понадобилось убирать Select? Потому что, во-первых, можно обойтись без него, а во-вторых, Select вызывает доп. перерисовку экрана, а это, как известно, самые долгие операции.

Теперь перейдем к другой "особенности" записи макроса, а именно к непонятному свойству объекта [Excel.]Application Selection. Что это такое? В данном макросе, как можно догадаться это область ячеек (Range). Давайте запишем еще один макрос: добавим окно инструментов "Рисование", включим запись макроса, выберем тулбар "Надпись", поместим ее на наш лист и наберем текст "Наша надпись". Выделим ячейку A1 и остановим запись макроса. Должен получиться примерно такой код: Sub Макрос2() ' ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 19.5, 88.5, _ 191.25, 86.25).Select Selection.Characters.Text = "Наша надпись" With Selection.Characters(Start:=1, Length:=7).Font .Name = "Arial" .FontStyle = "обычный" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("A1").Select End Sub Опять попробуем сократить код: Sub Макрос2_2() Dim MyShape As Shape Set MyShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ 19.5, 88.5, 191.25, 86.25) MyShape.Characters.Text = "Наша надпись" End Sub

Перейдем в Excel, удалим нашу надпись и выполним макрос Макрос2_2. Получим ошибку "Объект не поддерживает данное свойство или метод" на строке с кодом MyShape.Characters.Text = "Наша надпись". Почему Selection его поддерживает, а Shape нет? Посмотрев на объект Shape мы не найдем свойства Characters. Что же скрывается за загадочным Selection? Для того чтобы это понять давайте в Макрос2, добавим строку MsgBox TypeName(Selection) после строки Selection.Characters.Text = "Наша надпись" и выполним макрос. Получим сообщение "TextBox".

Вот оно что! Значит Selection - это TextBox. Попробуем создать такой объект и… Нет такого объекта! Есть только TextFrame. Замена Shape на TextFrame тоже не увенчается успехом… Что же делать?

Посмотрим на свойства объекта Shape и увидим там свойство TextFrame, у которого уже есть свойство Characters… Посмотрев справку по VBA можно убедиться, что Characters - это метод и принадлежит объекту TextFrame. Пробуем: Sub Макрос2_2() ' Dim MyShape As Shape Set MyShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ 19.5, 88.5, 191.25, 86.25) MyShape.TextFrame.Characters.Text = "Наша надпись" End Sub

Запустим макрос - работает! Оставим мифический TextBox на совести Microsoft… Примечание:
объект TextBox таки существует, но только как Control для Form.

Еще небольшой пример на VBA про Selection и займемся непосредственно переносом кода из VBA в Delphi. Откройте файл Книга1.xls, который приложен к статье и перейдите на Лист2. Там таблица и график. Включим запись макроса, выделим первый столбик, вызовем "Формат рядов данных" и изменим цвет на темно синий. Остановим запись. Должен получиться примерно такой код: Sub Макрос3() ' ActiveSheet.ChartObjects("Диагр. 1").Activate ActiveChart.SeriesCollection(1).Select With Selection.Border .Weight = xlThin .LineStyle = xlAutomatic End With Selection.InvertIfNegative = False With Selection.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub

Проверим, как он работает - перейдем в Excel, вызовем макросы и запустим Макрос3… Ошибка на первой же строке! Записанный макрос не работает. Почему? Попробуем сделать так, чтоб он заработал. Напишем небольшой макрос (руками) и будем вставлять в него код и тестировать. Начнем с определения имен имеющихся на листе диаграмм: Sub Test1() Dim i As Integer For i = 1 To ActiveSheet.ChartObjects.Count MsgBox ActiveSheet.ChartObjects(i).Name Next i End Sub

Запустив макрос, получим имя диаграммы "Chart 1" - почему не "Диагр. 1", как в записанном макросе - это очередная загадка. Исправим макрос и проверим: Sub Макрос3() ' ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.SeriesCollection(1).Select With Selection.Border .Weight = xlThin .LineStyle = xlAutomatic End With Selection.InvertIfNegative = False With Selection.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub Работает :o).

Дальше определим тип объекта после строки ActiveChart.SeriesCollection(1).Select известной строкой MsgBox TypeName(Selection). Получим Series. Сократим макрос и избавимся от Selection. Sub Макрос3_3() ' Dim ch As Chart, s As Series Set ch = ActiveSheet.ChartObjects("Chart 1").Chart Set s = ch.SeriesCollection(1) With s.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub

Если посмотреть на код Макрос3 и Макрос3_3, то видно, что код в Макрос3 использует Selection как промежуточный буфер для передачи управления между объектами, т.е. Activate, Select и для "безликого" вызова свойств и методов. Чтобы получить объект типа Chart нам понадобилось добавить обращение к свойству ChartObject.Chart Set ch = ActiveSheet.ChartObjects("Chart 1").Chart Дальше мы просто поменяли цвет столбика без использования Select.

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

Сразу оговорюсь, что в статье не рассматриваются методы подключения к Excel'ю (по данному вопросу можно почитать здесь ), также используется раннее связывание (что это такое читайте здесь).

Я считаю позднее связывание не "паскалевким" подходом, так как везде используется один тип Variant (как в языке "Основняк"), что, по моему, сродни шаманизму — что-то происходит, что-то куда то записывается, но никто не понимает, почему это работает.

Начнем с Макрос1. Да, именно с него, а не сокращенного варианта. Попытаемся написать код для первых трех строк:

Delphi ASheet.Range['A1:D5', EmptyParam].Select; XL.Selection[lcid].Borders[xlDiagonalDown].LineStyle := xlNone; XL.Selection[lcid].Borders[xlDiagonalUp].LineStyle := xlNone;

Попробовав скомпилировать данный участок, сразу же получим ошибку компилятора "E2003 Undeclared identifier: 'Borders'". Посмотрим, какой тип имеет Selection (в данном примере смотрим файл Excel2000.pas): property ExcelApplication.Selection[lcid: Integer]: IDispatch;

Посмотрев на интерфейс IDispatch, мы в самом деле не найдем такого свойства и метода... Попробуем подправить код:

Delphi ASheet.Range['A1:D5', EmptyParam].Select; (XL.Selection[lcid] As ExcelRange).Borders[xlDiagonalDown].LineStyle := xlNone; (XL.Selection[lcid] As ExcelRange).Borders[xlDiagonalUp].LineStyle := xlNone; With (XL.Selection[lcid] As ExcelRange).Borders[xlEdgeLeft] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End; With (XL.Selection[lcid] As ExcelRange).Borders[xlEdgeTop] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End; With (XL.Selection[lcid] As ExcelRange).Borders[xlEdgeBottom] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End; With (XL.Selection[lcid] As ExcelRange).Borders[xlEdgeRight] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End;

C# ASheet.get_Range("A1:D5", Type.Missing).Select(); ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlDiagonalDown).LineStyle = Excel.XlLineStyle.xlLineStyleNone; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlDiagonalUp).LineStyle = Excel.XlLineStyle.xlLineStyleNone; // левая граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // верхняя граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // нижняя граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // правая граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic;

Работает… Что мы для этого сделали? Привели тип IDispatch к ExcelRange: XL.Selection[lcid] as ExcelRange). Но такой перевод записанного макроса в Delphi поистине героический труд, да и нужен ли нам Select для того чтоб нарисовать границы (а глядя на C# код, вообще можно сразу отказаться на нем программировать)? Ведь всякая перерисовка - лишняя трата времени и, следовательно, скорости. Поэтому займемся Макросом1_1:

Delphi With ASheet.Range['A1:D5', EmptyParam].Borders do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End;

C# oRng = ASheet.get_Range("A1:D5", Type.Missing); // установим две границы oRng.Borders.LineStyle = Excel.XlLineStyle.xlContinuous; oRng.Borders.Weight = Excel.XlBorderWeight.xlThin; oRng.Borders.ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic;

Различия есть? Мы не делали Select и не использовали безликий Selection, обратившись непосредственно к области ExcelRange. Или все же лучше с Selection? Сравните:

Delphi ASheet.Range['A1:D5', EmptyParam].Select; With (XL.Selection[lcid] As ExcelRange).Borders do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; End;

Все то же самое, но что-то рябит в глазах при Select, не правда ли? И вроде как-то медленнее или мне показалось? Перейдем к Макрос2, вернее к уже подготовленному Макрос2_2:

Delphi MyShape := (XL.ActiveWorkbook.ActiveSheet As _Worksheet).Shapes.AddTextbox( msoTextOrientationHorizontal, 19.5, 88.5, 191.25, 86.25); MyShape.TextFrame.Characters(EmptyParam, EmptyParam).Text := 'Наша надпись';

C# myShape = (Excel.Shape) ASheet.Shapes.AddTextbox( Office.MsoTextOrientation.msoTextOrientationHorizontal, (float) 19.5, (float) 88.5, (float) 191.25, (float) 86.25); myShape.TextFrame.Characters(Type.Missing, Type.Missing).Text = "Наша надпись";

В коде на Delphi практически никаких отличий, кроме указания двух обязательных параметров: начала изменяемых символов и их длины. Мы написали EmptyParam, тем самым указав, что обрабатывается весь текст.

И, наконец, Макрос3_3. Усложним его - полностью создадим таблицу с данными, создадим график и изменим цвет первого столбца:

Delphi oSheet.Cells.Item[1, 1] := 'First Name'; oSheet.Cells.Item[1, 2] := 'Last Name'; oSheet.Cells.Item[1, 3] := 'Full Name'; oSheet.Cells.Item[1, 4] := 'Salary'; //Format A1:D1 as bold, vertical alignment := center. oSheet.Range['A1', 'D1'].Font.Bold := True; oSheet.Range['A1', 'D1'].VerticalAlignment := xlVAlignCenter; // Create an array to multiple values at once. saNames := VarArrayCreate([0, 4, 0, 1], varVariant); saNames[0, 0] := 'John'; saNames[0, 1] := 'Smith'; saNames[1, 0] := 'Tom'; saNames[1, 1] := 'Brown'; saNames[2, 0] := 'Sue'; saNames[2, 1] := 'Thomas'; saNames[3, 0] := 'Jane'; saNames[3, 1] := 'Jones'; saNames[4, 0] := 'Adam'; saNames[4, 1] := 'Johnson'; oSheet.Range['A2', 'B6'].Formula := saNames; oRng := oSheet.Range['C2', 'C6']; oRng.Formula := '=A2 & " " & B2'; oRng := oSheet.Range['D2', 'D6']; oRng.Formula := '=RAND()*100000'; oSheet.Range['A1', 'D1'].EntireColumn.AutoFit; // создадим график на листе в обласи E8:L29 Ch := (oSheet.ChartObjects As ChartObjects).Add( oSheet.Range['B8', EmptyParam].Left, oSheet.Range['B8', EmptyParam].Top, oSheet.Range['I8', EmptyParam].Left - oSheet.Range['B8', EmptyParam].Left, oSheet.Range['B30', EmptyParam].Top - oSheet.Range['B8', EmptyParam].Top).Chart As _Chart; oRng := oSheet.Range['C1', 'D6']; With Ch do begin SetSourceData(oRng, xlRows); ChartType := xl3DColumnClustered; HasTitle[lcid] := True; ChartTitle[lcid].Characters[EmptyParam, EmptyParam].Text := 'Диаграмма 1'; (Axes(xlCategory, xlPrimary, lcid) As Axis).HasTitle := False; (Axes(xlValue, xlPrimary, lcid) As Axis).HasTitle := True; (Axes(xlValue, xlPrimary, lcid) As Axis).AxisTitle. Characters[EmptyParam, EmptyParam].Text := 'Деньги'; (Axes(xlValue, xlPrimary, lcid) As Axis).AxisTitle.Orientation := xlUpward; End; // здесь код замены цвета у первого столбика // взятый из Макрос3_3 With (Ch.SeriesCollection(1, lcid) As Series) do begin Interior.ColorIndex := 23; Interior.Pattern := xlSolid; End;

C# oSheet.Cells[1, 1] = "First Name"; oSheet.Cells[1, 2] = "Last Name"; oSheet.Cells[1, 3] = "Full Name"; oSheet.Cells[1, 4] = "Salary"; //Format A1:D1 as bold, vertical alignment := center. oSheet.get_Range("A1", "D1").Font.Bold = true; oSheet.get_Range("A1", "D1").VerticalAlignment = Excel.XlVAlign.xlVAlignCenter; oSheet.get_Range("A1", "D1").HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter; // Create an array to multiple values at once. string[,] saNames = new string[5, 2]; saNames[0, 0] = "John"; saNames[0, 1] = "Smith"; saNames[1, 0] = "Tom"; saNames[1, 1] = "Brown"; saNames[2, 0] = "Sue"; saNames[2, 1] = "Thomas"; saNames[3, 0] = "Jane"; saNames[3, 1] = "Jones"; saNames[4, 0] = "Adam"; saNames[4, 1] = "Johnson"; oSheet.get_Range("A2", "B6").Formula = saNames; //Fill C2:C6 with a relative formula (=A2 & " " & B2). oRng = oSheet.get_Range("C2", "C6"); oRng.Formula = "=A2 & \" \" & B2"; //Fill D2:D6 with a formula(=RAND()*100000) and apply format. oRng = oSheet.get_Range("D2", "D6"); // oRng.Formula = "=RAND()*100000"; oRng.Formula = "=СЛЧИС()*100000"; // oRng.NumberFormat = "0.00"; //AutoFit columns A:D. oRng = oSheet.get_Range("A1", "D1"); oRng.EntireColumn.AutoFit(); // создадим график на листе в обласи E8:L29 Ch = ((Excel.ChartObjects) oSheet.ChartObjects(Type.Missing)).Add( (double) oSheet.get_Range("B8", Type.Missing).Left, (double) oSheet.get_Range("B8", Type.Missing).Top, (double) oSheet.get_Range("I8", Type.Missing).Left - (double) oSheet.get_Range("B8", Type.Missing).Left, (double) oSheet.get_Range("B30", Type.Missing).Top - (double) oSheet.get_Range("B8", Type.Missing).Top ).Chart; oRng = oSheet.get_Range("C1", "D6"); Ch.SetSourceData(oRng, Excel.XlRowCol.xlRows); Ch.ChartType = Excel.XlChartType.xl3DColumnClustered; Ch.HasTitle = true; Ch.ChartTitle.get_Characters(Type.Missing, Type.Missing).Text = "Диаграмма 1"; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlCategory, Excel.XlAxisGroup.xlPrimary)).HasTitle = false; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).HasTitle = true; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).AxisTitle. get_Characters(Type.Missing, Type.Missing).Text = "Деньги"; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).AxisTitle.Orientation = Excel.XlOrientation.xlUpward; // здесь код замены цвета у первого столбика // взятый из Макрос3_3 ((Excel.Series) Ch.SeriesCollection(1)).Interior.ColorIndex = 23; ((Excel.Series) Ch.SeriesCollection(1)).Interior.Pattern = Excel.XlPattern.xlPatternSolid;

Из перенесенных строк из Макрос3_3 видно, что коллекция Ch.SeriesCollection(1, lcid) тоже возвращает интерфейс IDispatch, поэтому мы привели ее к типу Series. Почему в библиотеке типов сразу не использован тип Series остается только гадать. Еще в только что описанном примере приведен код задания титулов для осей (axes) и здесь метаморфоза превращения Axes в Axis, т.е. Axes - это коллекция Axis, хотя в VBA это ни как не отображается.

Мы рассмотрели несколько примеров перевода

Мы рассмотрели несколько примеров перевода VBA кода, созданного записью макроса в Excel в Delphi. Увидели, как можно сократить ненужный код, избавившись от Select. Как уйти от безликого Selection (тип IDispatch) во избежание ошибок и возможных недоразумений. Также обнаружили несоответствие записанного кода (к примеру, имени объекта "Наша надпись") и типов реальным типам объектов. Т.е. записанный код VBA не всегда оказывается работоспособным. Для правильного перевода VBA в Delphi требуется представление об объектной модели Excel'я, обращение к справке Excel VBA, а также большое желание достигнуть результата. Все примеры тестировались на BDS 2006 и Microsoft Office 2003 К статье прилагается Книга1.xls с приведенными в статье макросами и Demo-проект на Delphi и C#. Для работы проекта на C# требуется Framework 1.1

Используемая литература

1.	Круглински Д., Уингоу С., Шеферд Дж. Программирование на Microsoft Visual C++ 6.0 для профессионалов Пер. с англ. – СПб: Питер; М.:Издательско-торговый дом «Русская редакция», 2001 – 864 с.:ил.
2.	Кэнту М. Delphi 6 для профессионалов (+СD). – Питер, 2002. – 1088с.: ил.
3.	Лишнер Р. Delphi. Справочник. – Пер. с англ. – СПб: Символ-Плюс, 2001. – 640 с., ил.
4.	С. Тейксейра, К. Пачеко Delphi 5. Руководство разработчика.
5.	Озеров В. Delphi. Советы программистов. – СПб: Символ-Плюс, 2002.-912 с.,ил.

К материалу прилагаются файлы: Проекты, используемые в качестве примера (276 K) обновление от 8/15/2006 4:15:00 AM

Немного практики

Для примера будет использован несложный и бесполезный класс на С++, состряпанный на ходу. В MS VC++ создадим проект, используя MFC AppWizard(exe), без использования представления «Документ-вид», на основе диалога, и обзовем его «example_exe». Добавим два новых файла – example.cpp и example.h.

Файл example.h:
//***************************************************************************** // традиционный финт ушами во избежание // повторного включения файла .h #if !defined(EXAMPLE__INCLUDED) #define EXAMPLE__INCLUDED // введем парочку структур для демонстрации работы с ними typedef struct { int n; int i; short j; char k; }struct_1; typedef struct { int n2; short a[3]; }struct_2; // Класс-пример. Ничего полезного, просто демонстрация. class CExample { private: int Field; CString Name; void Show(CString str); public: // конструктор и деструктор, как полагается CExample(int F, CString N); ~CExample(); // просто сообщение void Message(CString str, int Digit); // «процедура» и «функция» void Proc(int * Digit); int Func(int Number); // работа с закрытым полем void SetF(int F); int GetF(); // работа со структурами struct_2 * Struct1to2(struct_1 s1); }; #endif //if !defined(EXAMPLE__INCLUDED) //*****************************************************************************

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

Файл example.срр:
//***************************************************************************** #include "stdafx.h" #include "Example.h" // конструктор инициализирует два закрытых поля // и выдает сообщение об успешном создании // при помощи закрытой функции CExample::CExample(int F, CString N) { this->Field = F; this->Name = N; this->Show(N + " Created successfully"); } // деструктор только сообщает о самоликвидации CExample::~CExample() { this->Show("Deleted successfully"); } // закрытая функция, по сути – оболочка MessageBox'а // заголовком бокса будет имя класса void CExample::Show(CString str) { ::MessageBox(NULL, str, this->Name, MB_OK); } // открытая функция, выводит строку и число в десятичном виде. void CExample::Message(CString str, int Digit) { str.Format(str + " %d", Digit); this->Show(str); } // "процедура" не возвращает значение, зато изменяет параметр void CExample::Proc(int * Digit) { *Digit *= 2; } // "функция" не изменяет параметр, зато возвращает значение int CExample::Func(int Number) { int Result; Result = Number * 2; return Result; } // банально присваиваем значение параметра закрытому полю. void CExample::SetF(int F) { this->Field = F; } // еще банальнее... int CExample::GetF() { return this->Field; } // присваиваем значения полей одной структуры полям другой struct_2 * CExample::Struct1to2(struct_1 s1) { struct_2 * s2 = new struct_2; s2->n2 = s1.n * 2; s2->a[0] = s1.i; s2->a[1] = s1.j; s2->a[2] = s1.k; return s2; } //*****************************************************************************

Для примера более, чем достаточно. Теперь надо посмотреть, как это работает.

В файле Example_exeDlg.h в описании класса CExample_exeDlg где-нибудь в секции public надо вписать
CExample * ex;
то есть, объявить переменную-член, указатель на наш учебно-тренировочный класс, и в конструкторе Example_exeDlg вписать
ex = NULL;
Можно ex сделать и не членом, в принципе, и инициализировать при объявлении. И, конечно, не забыть наверху этого же файла вклеить заголовочный файл класса:
#include "Example.h"

На диалоговую форму накидаем кнопок и создадим их обработчики: void CExample_exeDlg::OnBtCreate()
{
if (ex == NULL)
ex = new CExample(7, "Example");
}
Если объект еще не создан – создаем и инициализируем пару закрытых полей.

void CExample_exeDlg::OnBtDestroy()
{
delete ex;
ex = NULL;
}
Освобождаем память и устанавливаем указатель в «пусто»

void CExample_exeDlg::OnBtMessage()
{
ex->Message("Any digit - ", 3);
}
Демонстрационное сообщение.

void CExample_exeDlg::OnBtProc()
{
int k = 5;
ex->Message("before K = ", k);
ex->Proc(&k);
ex->Message("after K = ", k);
}
Показываем в последовательных сообщениях, какое значение переменная имела до выполнения процедуры, и какое стала иметь после.

void CExample_exeDlg::OnBtFunc()
{
int k = 5, l;
ex->Message("before K = ", k);
l = ex->Func(k);
ex->Message("after K = ", k);
ex->Message("Result of Func = ", l);
}
Примерно то же самое – значение до выполнения, значение после выполнения и результат выполнения.

void CExample_exeDlg::OnBtGet()
{
ex->Message("", ex->GetF());
}

void CExample_exeDlg::OnBtSet()
{
ex->SetF(ex->GetF() + 1);
}

Эти две – без комментариев. Должно быть так все понятно... Функцию для работы со структурами в этом проекте не буду трогать, не интересно, тут весь фокус, как их передать через границу DLL. Кроме того, не будем возиться с полями ввода, а передадим параметры непосредственно в коде. Наглядность это уменьшает ненамного, а работы меньше. Еще момент – ID кнопок по-умолчанию поменял с BUTTON1 на BT_CREATE и так далее, для наглядности.

Всё! На форме только кнопки, вывод информации через MessageBox. Можно проверить работу.

Сделаем DLL для этого класса. В MS VC++ создадим проект, используя MFC AppWizard(dll), назовем «example_dll». В каталог этого проекта копируем готовые example.cpp и example.h, добавим их к проекту. Будем изменять, в соответствии с выясненными правилами. Начнем с объявления класса:

// Можно использовать AFX_EXT_CLASS, это синонимы.
class AFX_CLASS_EXPORT CExample

Затем из
void Message(CString str, int Digit);
делаем
virtual void __stdcall Message(CString str, int Digit);
и так со всеми открытыми методами, кроме конструктора и деструктора. И на этом бы всё, да CString – несовместимый, опасный тип. Меняем объявление:
virtual void __stdcall Message (char * str, int Digit);
и определение:
void CExample::Message (char* str, int Digit)
{
//добавляем CString:
CString s = str;
//и немного изменяем работу со строкой:
//str.Format(str + " %d", Digit);
s.Format(s + " %d", Digit);
//this->Show(str);
this->Show(s);
}
то есть, приходим к совместимому типу «указатель на нуль-терминальную строку», но, чтобы не потерять функциональность класса CString, объявляем локальную переменную этого класса и используем ее. Осталось еще полторы детали.
Первая деталь – в файле example_dll.cpp в конце пишем:

// вставляем функцию инициализации..
CExample * __stdcall InitExample(int F, char * N)
{
CExample * ex;
// транслируем конструктору принятые параметры
ex = new CExample(F, N);
// и возвращаем указатель на созданный объект
return ex;
}

// ..и ликвидации
void __stdcall DelExample(CExample * ex)
{
delete ex;
}

И половина детали – в файле EXAMPLE_DLL.def в конце дописываем пару строчек, так, чтобы получилось:

;*****************************************************************************
; EXAMPLE_DLL.def : Declares the module parameters for the DLL.

LIBRARY "EXAMPLE_DLL"
DESCRIPTION 'EXAMPLE_DLL Windows Dynamic Link Library'

EXPORTS
; Explicit exports can go here
InitExample
DelExample
;*****************************************************************************

После компиляции DLL готова. Подготовим проект в Delphi, чтобы продемонстрировать ее работу. Создадим проект «Example_Delphi», и в модуле главной формы, перед объявлением класса формы, впишем четыре типа. Два - структуры struct1 и 2:

TRec1 = record
n : integer;
i : integer;
j : smallint;
k : shortint;
end;
TRec2 = record
n2 : integer;
a : array[0..2] of smallint;
end;

Третий – указатель на вторую структуру:

PRec2 = ^TRec2;

А четвертый – наш класс, с которым будем работать:

TExample = class
public
procedure Mess_(str : PChar; Digit : integer); virtual; stdcall; abstract;
procedure Proc(var Digit : integer); virtual; stdcall; abstract;
function Func(Number : integer): integer; virtual; stdcall; abstract;
procedure SetF(F : integer); virtual; stdcall; abstract;
function GetF(): integer; virtual; stdcall; abstract;
function Struct1to2(rec1 : TRec1): PRec2; virtual; stdcall; abstract;
end;

Директивы virtual и stdcall в пояснениях не нуждаются. О них сказано выше. А зачем abstract? Очень просто. Без нее компилятор будет ругаться на неправильное упреждающее объявление функции, ведь описания ее у нас нет, описание – в DLL. Директивы должны идти именно в этом порядке. Иначе компилятору не нравится.

Обратите внимание на первый метод. Остальные названы так же, как и в С++, но слово Message в Delphi зарезервированное, и использовать его не по назначению не стоит. Хорошо, назовем иначе, важно, что она стоит на первом месте среди виртуальных функций, как и в С++, значит, ее найдут по номеру в VMT. Имя роли не играет.

Еще надо добавить объявление экспортируемых функций создания/ликвидации, в конце секции interface: function InitExample(F: integer; N : PChar) : TExample; stdcall;
external '..\Example_DLL\debug\Example_DLL.dll';
procedure DelExample(ex : TExample); stdcall;
external '..\Example_DLL\debug\Example_DLL.dll';

Здесь предполагается, что DLL лежит там, где и появилась после компиляции, а директории «Example_dll» и «Example_Delphi» имеют общую родительскую. Больше нигде ее искать не будут. Если же указать только имя, приложение будет искать библиотеку в своей папке, папках WINDOWS, SYSTEM32 и прописанных в переменной окружения PATH. Впрочем, это азбука.

Всё, класс можно использовать. Давайте опять наделаем кнопок, а вывод в поле Memo, благо, в Delphi с ним работать быстрее и проще, чем в MS VС++.

Вот обработчики кнопок: procedure TForm1.Button1Click(Sender: TObject); begin if not Assigned(Self.ex) then Self.ex := InitExample(10, 'Ex_Delphi'); end; procedure TForm1.Button2Click(Sender: TObject); begin DelExample(Self.ex); Self.ex := nil; end; procedure TForm1.Button3Click(Sender: TObject); begin Self.ex.Mess_(PChar('Некоторая цифра – '), 5); end; procedure TForm1.Button4Click(Sender: TObject); var j : integer; begin j := 15; Self.Memo1.Lines.Add('j До – ' + IntToStr(j)); Self.ex.Proc(j); Self.Memo1.Lines.Add('j После – ' + IntToStr(j)); end; procedure TForm1.Button5Click(Sender: TObject); var j : integer; begin j := 20; Self.Memo1.Lines.Add('j До – ' + IntToStr(j)); Self.Memo1.Lines.Add('Результат – ' + IntToStr(Self.ex.Func(j))); Self.Memo1.Lines.Add('j После – ' + IntToStr(j)); end; procedure TForm1.Button6Click(Sender: TObject); begin Self.Memo1.Lines.Add(IntToStr(Self.ex.GetF)); end; procedure TForm1.Button7Click(Sender: TObject); begin Self.ex.SetF(Self.ex.GetF + 1); end;

То же самое, что и в С++, и работает так же. Что и требовалось. И добавим кнопку для функции, которая принимает и возвращает структуры. Вот ее обработчик:

procedure TForm1.Button8Click(Sender: TObject); var s1 : TRec1; s2 : PRec2; begin // здесь компилятор будет ругаться, но в данном // случае это не важно. Просто посмотрим, что // до инициализации s2 - это всякая чушь... Self.Memo1.Lines.Add('s2 до:' + #9 + IntToStr(s2.n2) + #9 + IntToStr(s2.a[0]) + #9 + IntToStr(s2.a[1]) + #9 + IntToStr(s2.a[2]) ); // инициализация s1 s1.n := 10; s1.i := 1; s1.j := 2; s1.k := 3; // если функция возвращает указатель на запись (структуру) - // надо подготовить указатель. Это вам не класс. // s2 - типа PRec2, а не TRec2 s2 := Self.ex.Struct1to2(s1); // ... а потом - то, что мы требовали. Self.Memo1.Lines.Add('s2 после:' + #9 + IntToStr(s2.n2) + #9 + IntToStr(s2.a[0]) + #9 + IntToStr(s2.a[1]) + #9 + IntToStr(s2.a[2]) ); end;

Что делает функция – понятно, тут другая тонкость. Конструктор возвращает (в коде на С++) указатель на класс, а мы присваиваем возвращаемое значение переменной, которая, вроде бы, не указатель. Struct1to2 тоже возвращает указатель – и его надо подготовить. Это объясняется в []: «Объект – это динамический экземпляр класса. Объект всегда создается динамически, в «куче», поэтому ссылка на объект фактически является указателем (но при этом не требует обычного оператора разыменования «^»). Когда вы присваиваете переменной ссылку на объект, Delphi копирует только указатель, а не весь объект. Используемый объект должен быть освобожден явно.»

А в С++ структура отличается от класса несколько меньше, и работа с ними почти одинакова.

И еще пара тонкостей. Если в DLL добавить еще виртуальную функцию-член, обязательно в конце, после имеющихся, такая DLL будет совместима со старой программой, где в абстрактном классе эта функция не объявлена. И если изменить имеющуюся функцию, добавив в конец параметров параметр по-умолчанию, такая DLL будет совместима со старой программой, где в абстрактном классе эта функция не имеет такого параметра.

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

Немного теории

Передать, точнее, экспортировать несколько функций из DLL – не проблема. Приводим типы, соглашения о вызовах, заполняем список экспортируемых функций – и всё (в основном). Об этом написано немало, например, в [], в параграфе «Использование DLL, разработанных в С++».

Экспортировать класс несколько сложнее. Даже если и DLL, и основная программа написаны на Delphi, возникают проблемы с распределением памяти, которые решаются использованием модуля ShаreMem, первым в списке uses как проекта, так и DLL [, ]. Причем, этот модуль можно, в принципе, заменить самодельным менеджером памяти []. Но как использовать ShаreMem, если DLL написана на другом языке, или написать собственный менеджер для двух языков? Наверное, можно и так, но, напоминаю, срок сдачи проекта – вчера. Если есть и другие возражения, часто время – определяющий фактор.

Можно создавать экземпляр класса при загрузке DLL, ликвидировать при выгрузке (используя события DLL_PROCESS_ATTACH/DETACH), а для методов класса (функций-членов, раз уж класс на С++) написать однострочные функции-обертки, не являющиеся членами, а просто вызывающие соответствующие функции-члены. Некрасиво, и много лишней работы. Попробуем все же экспортировать класс.

В [], сказано: «Библиотеки DLL не могут экспортировать классы и объекты, если только вы не используете специализированную технологию Microsoft под названием СОМ или какую-либо другую усовершенствованную технологию». Впрочем, там же есть замечание: «На самом деле объекты могут быть переданы из DLL в вызывающую программу в случае, если эти объекты спроектированы для использования в качестве интерфейсов или чистых абстрактных классов». Кроме этого замечания, в [] об экспорте объектов почти всё, но уже хорошо, что есть шанс «сделать это по-быстрому».

И, наконец, в [] находим параграф «Экспорт объектов из DLL». Там сказано: «К объекту и его методам можно получить доступ, даже если этот объект содержится внутри DLL. Но к определению такого объекта внутри DLL и его использованию предъявляются определенные требования. Иллюстрируемый здесь подход применяется в весьма специфических ситуациях, и, как правило, такого же эффекта можно достичь путем применения пакетов или интерфейсов». Наша ситуация вполне специфическая; пакеты здесь неприменимы, так как они все же для использования с Delphi, про использование интерфейсов и СОМ уже сказано, а использовать интерфейсы без СОМ вне Delphi, судя по [], нельзя.

И, пожалуй, самое важное из []:
«На экспорт объектов из DLL накладываются следующие ограничения: Вызывающее приложение может использовать лишь те методы объекта, которые были объявлены как виртуальные. Экземпляры объектов должны создаваться внутри DLL. Экспортируемый объект должен быть определен как в DLL, так и в вызывающем приложении с помощью методов, определенных в том же порядке. Из объекта, содержащегося вутри DLL, нельзя создать объект-потомок. Здесь перечислены лишь основные ограничения, но возможны и некоторые другие.»

Далее там рассказывается о работе с DLL, написанной в Delphi, но полученной информации достаточно для работы с DLL, создаваемой в MS VC++.

Мастер MS VC++ позволяет создать обычную (regular) DLL и DLL-расширение (extension). Обычная DLL может экспортировать только С-функции и не способна экспортировать С++-классы, функции-члены или переопределенные функции []. Стало быть, надо использовать DLL-расширение. Мастер создаст заготовку, затем в каталог проекта надо будет скопировать два файла – заголовочный и файл кода (*.h и *.cpp), содержащие класс, с экземпляром которого предстоит поработать. Затем подключить их к проекту DLL и немного доработать в соответствии с указанными ограничениями.

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

Далее в файл .срр проекта DLL нужно добавить функции создания и ликвидации объекта. Пример в [] обходится без функции ликвидации, видимо, потому, что в приведенном там примере и DLL и импортирующее приложение написаны на Delphi, так что можно освободить память методом Free, который есть у всех наследников TObject и отсутствует у объектов С++, не имеющих общего класса-предка. Функция создания объекта должна просто вызывать конструктор, передать ему полученные от приложения параметры и вернуть указатель на созданный объект. Функция ликвидации принимает указатель на объект и вызывает деструктор. И обязятельно вписать эти функции в список экспортируемых.

И всё! Пятнадцать минут работы, при минимальном знании С++. Остальное в Delphi.

В импортирующей программе необходимо объявить класс, содержащий виртуальные открытые функции в том же порядке. Также необходимо объявить сложные структуры данных, используемые в DLL и передаваемые через ее границу в любом направлении. Имеются в виду структуры С++, они же записи Паскаля. И, конечно же, нужно объявить импортируемые функции создания и уничтожения класса. Теперь для создания экземпляра класса вызывается соответствующая функция DLL, когда объект перестает быть нужным – снова вызывается соответствующая функция DLL, а методы вызываются традиционно – «Объект.Метод(Параметры)». При этом обзывать методы в Delphi можно как угодно, важен лишь порядок их следования и списки параметров.

Если в С++ функция-член возвращает значение, в Delphi соответствующий метод должен быть тоже функцией. Если же функция-член возвращает void, в Delphi соответствующий метод – процедура.

Если в С++ параметр передается по значению, то и в Delphi тоже, если же по ссылке (то есть как указатель), то в Delphi такой параметр должен быть объявлен с ключевым словом var.

Чуть подробнее о параметрах и их типах. Практически везде, где говорится о DLL, упоминается, что, если хотите обеспечить совместимость DLL с программами на других языках, необходимо обеспечить совместимость типов. То есть, стремиться использовать стандартные типы ОС Windоws. Такие типы, как string или file вообще не совместимы с С++, с TDateTime можно поэкспериментировать, вообще-то, он соответствует стандарту, принятому в OLE-автоматизации ([]). Опять же, [] заявляет о соответствии типов single и double Delphi с float и double в С++ соответственно. Хотя в [] есть такой совет со ссылкой на News Group: «Если вы создаете DLL не с помощью Delphi, то избегайте чисел с плавающей точкой в возвращаемом значении. Вместо этого используйте var-параметр (указатель или ссылочный параметр в С++) Причина кроется в том, что Borland и Microsoft применяют различные способы возврата чисел с плавающей точкой. Borland С++ и Delphi могут использовать один и тот же метод».

Тип С++БайтовТип Delphi

int	?(4)	integer
unsigned int	?(4)	cardinal
char, __int8	1	shortint
short, __int16	2	smallint
long, __int32 (int)	4	longint (integer)
__int64	8	int64
unsigned char	1	byte
unsigned short	2	word
unsigned long	4	longword
float	4	single
double	8	double
char *		PChar

Таблица соответствия типов Delphi и С++

Обоснование

Необходимость использования чужого кода в своей программе возникает регулярно. Вставка готовых удачных решений позволяет не изобретать велосипед заново. В хороших случаях чужой код написан на том же языке, что и свой, либо решение оформлено в виде DLL или компонента. Однако, бывают случаи похуже. Например, приобретается PCI-плата расширения с программным обеспечением для нее, а это ПО оказывается файлами исходного кода на С или С++, в то время как проект уже начат на Delphi, и, кроме того, в команде разработчиков С++ знают плохо.

Требования

Предполагается: знание Delphi на уровне использования DLL, а также написания собственных; знание С++ на уровне написания простейшего приложения в среде MS VC++.

Желательно: общее понимание соглашений о вызове функций; общее представление о способах передачи параметров и возврата значения.
Используемые инструменты: Borland Delphi 6, MS VC++ 6.0

Варианты решения

В принципе, можно весь проект писать на С++. Если такая возможность есть – не исключено, что это лучший выход. Но пользовательский интерфейс в Delphi разрабатывается быстрее, чем в MS VC++ (не только мое мнение, но хорошую цитату не нашел), кроме того, в группе могут плохо знать С++. И если даже С++ знают хорошо, но проект уже начат на Delphi, переписывать готовое – значит, тратить неоплачиваемое время.

Можно переписать код С++ на Delphi. Для этого требуется время, и, возможно, немалое, а главное – знание С++ на уровне существенно выше начального («читаю со словарем»). При этом, многие языковые конструкции С++ не имеют прямых аналогов в Delphi, и их перенос чреват появлением ошибок, в том числе, совершенно дурацких, и потому трудноотлавливаемых. В частности, прекрасный пример из обсуждения статьи «ЯП, ОПП и т.д. и т.п. в свете безопасности программирования»:

for(;P('\n'),R-;P('|')) for(e=C;e-;P('_'+(*u++/8)%2))P('| '+(*u/4)%2);

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

Можно воспользоваться интерфейсами и технологией СОМ (пожалуй, точнее – моделью СОМ и технологией ActiveX). Но – вот цитата из [], глава «Модель многокомпонентных объектов»:
«И еще одно замечание: не думайте, что путь будет легким. Крейг Брокшмидт говорил, что перед тем, как он начал понимать эти концепции, у него был « шесть месяцев туман в голове.» Минимальная предпосылка – исчерпывающее знание языка С++.» Конец цитаты. И, хотя «модель СОМ предоставляет унифицированный, открытый, объектно-ориентированный протокол связи между программами» (цитата оттуда же), она требует такой квалификации от программиста, которая редко встречается в среде непрофессионалов.

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

С учетом того, что в группе разработчиков в основном о С++ поверхностные представления, а СОМ – незнакомая аббревиатура, и, при этом, срок сдачи проекта – традиционно – вчера, ничего лучше варианта с DLL у нас придумать не получилось.

При таком подходе нельзя обращаться

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

Дополнительные особенности.

В процессе работы, к стандартному механизму SOAP, были добавлены такие возможности как:

сжатие передаваемого по сети контента(используется библитека ZLib); так называемые NotifyEvents для модулей данных. вызов удаленных методов минуя IInvokable интерфейсы(wssIntf.pas : IModuleAuth.CallMethod).

Клиент

Создаем новый проект. На форме распологаем компонент TwssSoapConnection. Устанавливаем значения свойств как приведено на скриншоте.

При помощи утилиты WSDL Importer импортируем в наш проект модуль с описанием интерфейса IWSSTest(получаем модуль IWSSTest1.pas). Устанавливаем: wssSoapConnection1.URL=http://localhost:8888/soap, wssSoapConnection1.AppID="TEST" и заполняем поля wssSoapConnection1.SessionUserName и wssSoapConnection1.SessionPassword. Пишем обработчики для кнопок:
1: unit Unit1; 2: 3: interface 4: 5: uses 6: Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7: Dialogs, StdCtrls, DB, DBClient, wssSoapConn; 8: 9: type 10: TForm1 = class(TForm) 11: wssSoapConnection1: TwssSoapConnection; 12: Button1: TButton; 13: Label1: TLabel; 14: Button3: TButton; 15: procedure Button1Click(Sender: TObject); 16: procedure Button2Click(Sender: TObject); 17: procedure Button3Click(Sender: TObject); 18: private 19: { Private declarations } 20: public 21: { Public declarations } 22: end; 23: 24: var 25: Form1: TForm1; 26: 27: implementation 28: 29: uses IWSSTest1; 30: 31: {$R *.dfm} 32: 33: procedure TForm1.Button1Click(Sender: TObject); 34: begin 35: wssSoapConnection1.Open; 36: Label1.Caption := wssSoapConnection1.SessionID; 37: end; 38: 39: procedure TForm1.Button2Click(Sender: TObject); 40: begin 41: wssSoapConnection1.Close; 42: end; 43: 44: procedure TForm1.Button3Click(Sender: TObject); 45: begin 46: ShowMessage( (wssSoapConnection1.RIO as IWSSTest).TestMethod('Client.')); 47: end; 48: 49: end. Готово. Запускаем.
Клиент:

Сервер:

Исходный код примера .(11,7Kb)

Клиент

TXXXConnection заменяется на TwssSoapConnection. Вызовы методов через TCustomRemoteServer.AppServer заменяются на TwssSoapConnection.RIO as IMyAppIntf.

Проблемы и их решения.

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

Следующая проблема - это обеспечение прозрачного вызова базовых методов интерфейса IAppServer с клиента соответствующих методов требуемого провайдера(TCustomProvider) на сервере в контексте сессии. Решением данной проблемы является создание наследника от TCustomRemoteServer, который инкапсулирует данные(контекст сессии) и методы по взаимодействию с менеджером сессий средствами SOAP-протокола. На стороне сервера создается наследник от TInvokableClass (TSOAPSessionManeger), и соответствующий ему IInvokable интерфейс ISOAPSessionManeger, который реализует базовые, но модифицированные, методы интерфейса IAppServer, и дополнительные методы, необходимые для авторизации, контроля состояния и др. .

1: ISOAPSessionManeger = interface(IInvokable) 2: ['{59AD0E15-EF0F-4DF3-A782-18B5FEC70AC4}'] 3: {IAppServer support} 4: function WS_AS_ApplyUpdates(const SessionID:WideString; const ProviderName: WideString; Delta: OleVariant; 5: MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; stdcall; 6: function WS_AS_GetRecords(const SessionID:WideString; const ProviderName: WideString; Count: Integer; out RecsOut: Integer; 7: Options: Integer; const CommandText: WideString; 8: var Params: OleVariant; var OwnerData: OleVariant): OleVariant; stdcall; 9: function WS_AS_DataRequest(const SessionID:WideString; const ProviderName: WideString; Data: OleVariant): OleVariant; stdcall; 10: function WS_AS_GetProviderNames(const SessionID:WideString): TWideStringDynArray; stdcall; 11: function WS_AS_GetParams(const SessionID:WideString;const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; stdcall; 12: function WS_AS_RowRequest(const SessionID:WideString; const ProviderName: WideString; Row: OleVariant; RequestType: Integer; 13: var OwnerData: OleVariant): OleVariant; stdcall; 14: procedure WS_AS_Execute(const SessionID:WideString; const ProviderName: WideString; const CommandText: WideString; 15: var Params: OleVariant; var OwnerData: OleVariant); stdcall; 16: {Authorithation support} 17: function WS_Login(const AUserName, APassword: WideString ; var SessionID, ErrMsg:WideString):Integer; stdcall; 18: function WS_Logout(const SessionID:WideString):Integer; stdcall; 19: function WS_GetSessionState(const SessionID:WideString):Integer;stdcall; 20: {Data-exchange support} 21: function WS_GetValue(const SessionID, AName: WideString):OleVariant;stdcall; 22: procedure WS_SetValue(const SessionID, AName: WideString; const AData: OleVariant);stdcall; 23: function WS_CallMethod(const SessionID, MethodName: WideString; const Params: OleVariant):OleVariant;stdcall; 24: end;

Базовым понятием в данной модели является понятие сессии (класс TWSSession) . Сессия - это объект, который идентефицирует клиетское соединение на стороне сервера, ассоциирует с ним наборы модулей данных(наследники TDataModule), обеспечивает регистрацию провайдеров из соответствующих модулей, вызов базовых методов интерфейса IAppServer, и методы авторизации для конкретной сессии. Ключевые понятия сессии:

SessionID - id сессии в менеджере сессий. UserName, Password - данные для авторизации. AppID - наименование набора классов(модулей данных), которые будут создаваться при регистрации нового клиента. AppID вместе с SessionID клиент передается в заголовке каждого SOAP-сообщения на сервер.

Для того, чтобы определить, какие модули данных необходимо создавать для данного AppID - их классы предварительно регистрируются. Поскольку интерфейс ISOAPSessionManeger является своеобразным "переходником" между клиентом и стандартным интерфейсами IAppServer посредством менеджера сессий, обеспечивая бинарную совместимость передаваемых пакетов данных, что позволяет прозрачно вызывать методы провайдеров уже в контексте сессии(т.е. только из тех дата-модулей, которые определены для данного AppID в конкретной сессии)

Вызов методов IInvokable интерфейсов в котнексте сессии. Для решения этой проблемы пришлось изменить стандартное поведение класса TSoapPascalInvoker. При определении экземпляра объекта для выполнения метода, запрашиваемого клиентом интерфейса, Delphi ищет в собственном реестре(объект InvRegistry) класс, его реализующий, а затем создает его экземпляр(Per request), или процедуру, возвращающую ссылку на этот объект(Global). Поскольку в каждом SOAP-сообщении содержится SessionID, можно определить сессиию клиента, и как следствие, получить ссылки на дата-модули, существующие в ее контексте. Далее находим дата-модуль, реализующий запрашиваемый интерфейс и возвращаем на него ссылку. Далее работает стандартная схема, а метод уже вызывается именно в контексте сессии. Поскольку предварительно мы реализуем стандартный код, вышеприведенные изменения ни в коем случае не изменяют установленного поведения компонентов и их методов. Таким образом задача создания своих собственных state-full объектов с поддержкой сессий становится тривиальной задачей: Создание наследника TDataModule TMyDM, объявление IInvokeble интерфейса IMyIntf и его регистрация в InvRegistry, включение интерфеса IMyIntf в класс TMyDM и его регистрация в системе(WSReg.RegisterDataModule(TMyDM,'MyApp')), реализация методов интерфейса.

Неожиданной оказалась проблема автоматического включения в каждый заголовок SOAP-сообщения идентификационной информации. Класс TRIO не содержит событий, которые позволили добавить в заголовок нужную информацию c использованием сдандартных для этого методов(Класс TSOAPHeader). Событие OnBeforeExecute вызывается уже полсе того, как заголовки упакованы в сообщение. Исходный код TRIO пришлось модифицировать, добавлением события OnBeforeRequest(добавить метод DoBeforeRequest) и полученный класс TWSRIO использовать в классе TwssSoapConnection(наследник TCustomRemoteServer, реализующий взаимодействие сервером приложений). Вызов удаленных методов интерфейсов предпочтительно осуществлять с использованием этого класса, или же, для компонента TRIO самостоятельно добавлять нужные заголовки(класс TWSSHeader).

Как следствие, вышеприведенных изменений вполне достаточно как для портации серверных приложений на базе TRemoteDataModule под Web Services, так и создания новых state-full, state-less Web Services приложений в привычных для программиста условиях.

Реализация

Исходники и примеры (112 Кб). Для реализации примера установите у себя пакет wss.dpk. Пропишите необходимые пути в Library Path.

Сервер

Сервер будем реализовывать как standalone Web Service(Требуется библиотека Indy).

Создаем консольное приложение. Добавляем к нему TDataModule. Объявляем интерфейс(Классом реализации будет наш дата-модуль):
1: { Invokable interface IWSSTest } 2: 3: unit WSSTestIntf; 4: 5: interface 6: 7: uses InvokeRegistry, Types, XSBuiltIns; 8: 9: type 10: 11: { Invokable interfaces must derive from IInvokable } 12: IWSSTest = interface(IInvokable) 13: ['{15907745-68B1-47A3-86A6-9EF2A3530493}'] 14: 15: { Methods of Invokable interface must not use the default } 16: { calling convention; stdcall is recommended } 17: function TestMethod(const s : string): string ;stdcall; 18: end; 19: 20: implementation 21: 22: initialization 23: { Invokable interfaces must be registered } 24: InvRegistry.RegisterInterface(TypeInfo(IWSSTest)); 25: 26: end. Реализуем поддержку нашего интерфейса в дата-модуле:
1: unit Unit2; 2: 3: interface 4: 5: uses 6: SysUtils, Classes, WSSTestIntf, 7: WSObj{WSS Core}; 8: 9: type 10: TDataModule2 = class(TDataModule, IWSSTest, IWSSessionNotifyEvents) 11: private 12: { Private declarations } 13: //добавление совершенно не обязательно, но удобно, а иногда и полезно:) 14: procedure WSSessionNotifyEvent(const SessionClient : TWSSesClient; 15: const EventName : string; 16: const Data: OleVariant); 17: public 18: { Public declarations } 19: function TestMethod(const s : string): string ;stdcall; 20: end; 21: 22: var 23: DataModule2: TDataModule2; 24: 25: implementation 26: 27: {$R *.dfm} 28: 29: { TDataModule2 } 30: 31: function TDataModule2.TestMethod(const s: string): string; 32: begin 33: Result := 'Hello from server: '+ s; 34: writeln('Method call: '+ s); 35: end; 36: 37: procedure TDataModule2.WSSessionNotifyEvent( 38: const SessionClient: TWSSesClient; const EventName: string; 39: const Data: OleVariant); 40: begin 41: writeln('EVENT:',EventName,' - sessionid:',SessionClient.SessionID); 42: end; 43: 44: end. Модифицируем dpr-файл как показано ниже.
1: program Project2; 2: 3: {$APPTYPE CONSOLE} 4: 5: uses 6: SysUtils, 7: IndyHttpServerApp,{Под Apache2 заменить на Apache2ServerApp} 8: WSSTestIntf in 'WSSTestIntf.pas', 9: Unit2 in 'Unit2.pas' {DataModule2: TDataModule}; 10: 11: begin 12: { TODO -oUser -cConsole Main : Insert code here } 13: ServerApplication.Initialize; 14: {register TDataModule2 class for AppID="TEST"} 15: ServerApplication.RegisterDataModuleClass(TDataModule2,'TEST'); 16: ServerApplication.Run; 17: end. Готово. Запускаем сервер. Видим Service Info Page страницу по адресу: http://localhost:8888/

Сервер

Создаем серверный проект как показано в примере. Добавляем к проекту TRemoteDataModule.(Меняем наследника на TDataModule) Убираем все, что связано с DCOM.(Factrory и прочее...) На базе You Project_TLB.pas создаем IInvokeble интерфейс и объявляем его поддержку для модуля данных. Выполняем ServerApplication.RegisterDataModule(TMyDM,'MyApp');

State-full Web Services на Delphi

Александр Шагин, ведущий программист отдела "ИНФОВУЗ", Волгоградский Государственный Педагогический Университет

и 7) предоставляет достаточно удобные

Среда Borland Delphi (версии 6 и 7) предоставляет достаточно удобные инструменты по созданию Web Services application. В сочетании с технологией Midas у программиста есть очень эффективный инструмент по созданию N-звенных приложений доступа к корпоративным БД. Тем не менее реализация Web Services в Delphi содержит некоторые существенные ограничения, которые, в целом оправданы, но при переходе на новую платформу, будут вызывать у программистов, привыкших работать с TDCOMConnection, TSocketConnection и т.п. дополнительные сложности. SOAP Server applications - это, в общем случае, statelss приложения - сервер не хранит информацию о предыдущих вызовах клиента, что не позволяет использовать привычный подход и технологию программирования, а тем более говорить о прозрачном переходе на новый тип соединения(Например,так как это происходит при переходе с TDCOMConnection на TSocketConnection или наоборот). Конечно, отсутствие statefull-объектов на сервере оправдывается тем, что потенциально Web Services должны будут обрабатывать огромное количество входящих соединений, и выделение для каждого из них оперативной памяти приведет, в конце концов, к выводу сервера или сервиса из строя, но тем не менее отсутствие прозрачного механизма портации существующих проектов(если, конечно, таковая вообще требуется) может остановить от реализации этой идеи даже очень опытных программистов.
В процессе работы у нас возникла следующая задача. Корпоративная система работала в пределах локальной сети. Соеденение клиентов осуществлялось с помощью SocketConnection, что обеспечивало вполне приличную скорость и масштабируемость. Со временем появились новые удаленные рабочие места, но соеденение по локальной сети установить уже не было возможности, только Internet. Требовалось обеспечить работу пользователей в точности с тем же набором приложений (чтобы не приходилость дополнительно тратить времени на обучение по работе с новым софтом или на дополнительную организацию их взаимодействия с основной корпоративной системой), который они использовали ранее. Для коммуникации клиентских приложений с основным сервером идеально подходил SOAP-протокол, но отсутствие statefull соединений могло сильно затянуть время адаптации серверов приложений. Посколько в параллельных проектах уже был опыт использования Web Services , и появление вышеобозначенных проблем вполне предсказывалось, велась разработка механизма прозрачного перевода MIDAS-серверов и клиентов на использование протокола SOAP. Детали, проблемы и подходы в решении этой задачи я бы и хотел осветить в этой статье.

это всего лишь субъективный взгляд

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

Архитектура WEB-сервиса

По большому счету WEB-сервис представляется всего одним файлом, с расширением Asmx, который должен как минимум иметь примерно такой заголовок: <%@ WebService Language="c#" Class="WebService1.TWebService1" %>

Далее может идти код, собственно реализующий функциональность WEB-сервиса. Этот код должен быть написан на одном из языков .NET платформы (например C#).

К великому сожалению, создать WEB-сервис на Object-Pascal таким образом пока нельзя. Однако разработчики платформы .NET предусмотрели возможность перенести код WEB-сервиса в отдельно компилируемую DLL(фоновый код). Частично для того, чтобы была возможность разрабатывать WEB-приложения на языках, непосредственно не поддерживающих ASP.NET, частично для того, чтобы диагностировать ошибки компиляции до развертывания самого сервиса.

Как вы уже догадались, Delphi 8 создает проект, компилируемый в DLL( которая, в свою очередь, помещается в корневой каталог приложения) и состоящий из таких частей: Автоматически сгенерированный файл <Имя сервиса>.asmx, состоящий из заголовка примерно такого вида: <%@ WebService Language="c#" Debug="true" Codebehind="WebService1.pas" Class="WebService1.TWebService1" %> <Имя сервиса>.pas с которым мы успешно работали :-) Global.asax, и его Pascal-реализация. Для чего он нужен, можно почитать в .

Как вы наверняка уже догадались для тестирования сервиса достаточно в браузере набрать строку

http://localhost/<путь к сервису>/<имя сервиса>.asmx

Для вызова метода

http://localhost/<путь к сервису>/
<имя сервиса>.asmx /? Op= <имя операции>.

Атрибут WebMethod

Как и было заявлено выше, обычный метод класса отличается от метода, публикуемого WEB-сервисом только наличием атрибута WebMethod. Данный атрибут имеет составной характер, т.е может содержать следующие податрибуты (Рассмотрим лишь некоторые из них): CacheDuration - Кэширование результатов работы метода на заданное количество секунд. (например, метод с такими атрибутами будет хранить результат своей работы в течении 15 секунд : [WebMethod(CacheDuration="15")] ). Description - Добавляет текстовое описание WEB-метода. MessageName - Имя WEB-метода. Полезно, например, когда нужно опубликовать перегруженный метод класса.(наличие двух одноименных WEB-методов запрещено)

В качестве примера давайте добавим к нашему классу еще два метода и добавим описание к существующему методу HelloWorld:

TWebService1 = class(System.Web.Services.WebService) // Экономия места public constructor Create; // Sample Web Service Method [WebMethod (MessageName = 'HelloWorld' , Description = 'Простой метод')] function HelloWorld:String; [WebMethod (MessageName = 'IntegerSubstract')] function Substract(a,b:Integer):Integer;overload; [WebMethod (MessageName = 'FloatSubstract')] function Substract(a,b:Single):Single;overload; Реализация методов тривиальна: function TWebService1.Substract(a,b:Integer):Integer; begin Result := a - b; end; function TWebService1.Substract(a,b:Single):Single; begin Result:= a - b; end;

Запустите добавленные WEB-методы. Обратите внимание, что мы использовали механизм перегрузки функций, но при этом не пострадали от ограничений связанных с именованием WEB-методов: WEB-сервис предоставляет их как методы с различными именами.

Что такое WEB-сервис ?

Что такое WEB-сервис наверное знает каждый. WEB-сервисы не собственность компании Microsoft, а целый промышленный стандарт на основе открытых протоколов HTTP и SOAP, однако использование в качестве средства разработки платформы .NET позволит создавать WEB-сервисы очень быстро и просто.

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

На этом позволим себе временно отстраниться от теории и перейти к практике

Прокси WEB-сервиса

В общем-то, ничего особенно не изменилось, за исключением того, что в проект был добавлен файл localhost.WebService1.pas, содержащий в себе класс TWebService1. Этот класс называется прокси WEB-сервиса, это локальный представитель WEB-сервиса для нашего клиентского приложения. Файл localhost.WebService1.pas сгенерирован автоматически, и менять его реализацию не рекомендуется, однако если посмотреть на него ближе () можно сделать некоторые выводы.

Итак: Прокси WEB-сервиса не выполняет никаких действий, но переправляет вызовы методов WEB-сервису. Прокси обязательно должен знать, с каким WEB-сервисов он связан, что подтверждается реализацией его конструктора: constructor TWebService1.Create; begin inherited Create; Self.Url := 'http://localhost/SampleWebService /WebService1.asmx'; end; Прокси обеспечивает вызов WEB-методов в синхронном и асинхронном режимах.

Простейший WEB-сервис

Давайте запустим Delphi 8 и создадим WEB-сервис, который назовем SampleWebService

Рис.1 Выбор типа создаваемого приложения

Рис.2 Диалог создания проекта.

Delphi 8 создаст для нас простейший WEB-сервис. Состав файлов в проекте WEB-сервиса требует отдельного описания, которое будет дано немного позже. Сейчас же рассмотрим файл WebService1.pas, который содержит описание класса TWebService1 TWebService1 = class(System.Web.Services.WebService) {$REGION 'Designer Managed Code'} strict private /// <summary> /// Required designer variable. /// </summary> components: IContainer; /// <summary> /// Required method for Designer support - do not /// modify the contents of this method with /// the code editor. /// </summary> procedure InitializeComponent; {$ENDREGION} strict protected /// <summary> /// Clean up any resources being used. /// </summary> procedure Dispose(disposing: boolean); override; private { Private Declarations } public constructor Create; (* // Sample Web Service Method [WebMethod] function HelloWorld: string; *) end;

Обратите внимание на закомментированный метод WEB-метод HelloWorld, (WEB-метод он потому, что ему назначен атрибут [WebMethod]). Давайте попробуем раскоментировать его и его реализацию. Вот и все. Наш первый WEB-сервис готов. Как его протестировать? Очень просто, нажмите F9.

Результат не заставить себя долго ждать, вы увидите страницу подобную приведенной на рис. 3.

Рис 3. Автоматически сгенерированная страница-описание WEB-сервис

Как протестировать WEB-метод Вы наверное уже догадались? Если нет, то кликните по ссылке HelloWorld.

рис 4. Тестирование WEB-метода

После нажатия на кнопку "Invoke" наш WEB-сервис стартует и вернет потрясающий результат в виде XML: <?xml version="1.0" encoding="utf-8" ?> <string xmlns="http://tempuri.org/">Hello World

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

Сложные типы данных в WEB-методах

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

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

Итак, курс доллара будет представлен следующим классом: TDollarRate = class public Cost:Integer; Date:TDateTime; constructor Create; end; constructor TDollarRate.Create; begin inherited Create; Cost:=20 + Random(5); Date:=DateToStr(DateTime.Now); end;

Перед добавлением WEB-метода объявим тип TDollarRates = Array of TDollarRate, в секцию uses добавим Borland.Vcl.SysUtils. Метод имеет вид:

[WebMethod] function GetRatesForDays (ADays:Integer):TDollarRates; function TWebService1.GetRatesForDays (ADays:Integer):TDollarRates; var i:Integer; begin SetLength(Result,ADays); for i:=ADays-1 downto 0 do Result[i]:=TDollarRate.Create; end;

Попробуем протестировать метод (рис 5).

Рис. 5 Тестирование метода, возвращающего массив объектов Результат превзошел все ожидания: <?xml version="1.0" encoding="utf-8" ?> - <ArrayOfTDollarRate xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://tempuri.org/"> - <TDollarRate> <Cost>23 <Date>28.04.2004 </TDollarRate> - <TDollarRate> <Cost>23 <Date>28.04.2004 </TDollarRate> - <TDollarRate> <Cost>20 <Date>28.04.2004 </TDollarRate> </ArrayOfTDollarRate>

В процессе разработки этого примера мы были неприятно удивлены одной деталью (версия Delphi 8 7.1.1146.610): мы попытались объявить новый конструктор с параметрами: TDollarRate = class public Cost:Integer; Date:TDateTime; constructor Create(Adays:Integer); end; constructor TDollarRate.Create(Adays:Integer); var sDate:TDateTime; begin inherited Create; {Код} end;

и получили следующую ошибку при старте WEB-сервиса:

рис 6. Как же переопределить конструктор ?

Как сделать новый конструктор Default public в Delphi 8 не совсем понятно, однако выручило переименование конструктора следующим образом: TDollarRate = class public Cost:Integer; Date:String; constructor TDollarRate(Adays:Integer); end;

Результат работы стал таким: "?xml version="1.0" encoding="utf-8" ?> - <ArrayOfTDollarRate xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://tempuri.org/"> - <TDollarRate> <Cost>21 <Date>26.04.2004 </TDollarRate> - <TDollarRate> <Cost>24 <Date>26.04.2004 </TDollarRate> </ArrayOfTDollarRate>

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

Создание клиента для WEB-сервиса.

После стольких усилий по изучению WEB-сервисов пришло время научится их использовать. Как и всегда ничего сложного в этом нет. В качестве примера создадим VCL Forms приложение. Его главная и единственная форма должна выглядеть примерно так:

Рис. 7. Форма Веб-Калькулятора

Осталось только "оживить" нашу форму. Для этого выберите пункт меню Project/Web Reference.

В диалоге, который откроется, укажите URL к WSDL описанию нашего сервиса В нашем случае это -

http://localhost/SampleWebService/WebService1.asmx?WSDL

Нажмите кнопку "GO" а потом "AddReference".

Рис. 8. Добавление ссылки на WEB-сервис.

Вызов WEB-методов. Асинхронный режим.

Ниже приведен код нашего клиентского приложения, умеющего выполнить WEB-метод, и отобразить результат: unit Umain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Borland.Vcl.StdCtrls, System.ComponentModel, localhost.WebService1; type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Edit3: TEdit; Button1: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); private FWEBProxy:TWebService1; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.nfm} procedure TForm1.FormCreate(Sender: TObject); begin FWEBProxy:=TWebService1.Create; end; procedure TForm1.Button1Click(Sender: TObject); begin Edit3.Text:= IntToStr(FWEBProxy.Substract (StrToInt(Edit1.Text),StrToInt(Edit2.Text) )); end; end.

Рис 9. Веб калькулятор в действии

Теперь давайте усложним задачу? Заставим метод Substract возвращать результат через определенное время? В этом случае наше клиентское приложение попросту будет "висеть" пока WEB-метод не отработает. Давай добавим в WEB-метод Substract нашего WEB-сервиса имитацию бурной деятельности:

function TWebService1.Substract(a,b:Integer):Integer; var i:Integer; begin Sleep(5000); Result := a - b; end;

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

Обратите внимание на то что в описании интерфейса прокси класса есть методы Begin<имя WEB-метод> и End<WEB-метод>, например BeginSubstract, EndSubstract. Схема их использования примерно таковы: BeginSubstract, EndSubstract procedure TForm1.Button1Click(Sender: TObject); var asyncres:IAsyncResult; begin asyncres:=FWEBProxy.BeginSubstract (StrToInt(Edit1.Text), StrToInt(Edit2.Text),nil,nil); // какой-то код Edit3.Text:= IntToStr(FWEBProxy.EndSubstract (asyncres)); end;

Это означает, что метод BeginSubstract инициирует выполнение WEB-метода, но при этом не останавливает выполнение основного приложения. В момент вызова EndSubstract завершается выполнение WEB-метода. Если последний еще не отработал - клиентское приложение блокируется до завершения работы метода. Использование свойства IsCompleted интерфейса IAsyncResult. procedure TForm1.Button1Click(Sender: TObject); var asyncres:IAsyncResult; begin asyncres:=FWEBProxy.BeginSubstract (StrToInt(Edit1.Text), StrToInt(Edit2.Text),nil,nil); while not asyncres.IsCompleted do Application.ProcessMessages; Edit3.Text:= IntToStr(FWEBProxy.EndSubstract (asyncres)); end; Подписка за событие о завершении асинхронного вызова. unit Umain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Borland.Vcl.StdCtrls, System.ComponentModel, localhost.WebService1; type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Edit3: TEdit; Button1: TButton; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); private FWEBProxy:TWebService1; procedure SubstratctFinished (Res:IAsyncResult); { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.nfm} procedure TForm1.FormCreate(Sender: TObject); begin FWEBProxy:=TWebService1.Create; end; procedure TForm1.Button1Click(Sender: TObject); begin FWEBProxy.BeginSubstract(StrToInt(Edit1.Text), StrToInt(Edit2.Text), SubstratctFinished,nil); end; procedure TForm1.SubstratctFinished (Res: IAsyncResult); begin Edit3.Text:= IntToStr (FWEBProxy.EndSubstract(Res)); end; end.

WSDL - язык описания WEB-сервисов.

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

http://localhost/<путь к сервису>/<имя сервиса>.asmx?wsdl

Ниже приведено описание TDollarRates и TDollarRate нашего примера: - <s:complexType name="ArrayOfTDollarRate"> - <s:sequence> <s:element minOccurs="0" maxOccurs="unbounded" name="TDollarRate" nillable="true" type="s0:TDollarRate" /> </s:sequence> </s:complexType> - <s:complexType name="TDollarRate"> - <s:sequence> <s:element minOccurs="1" maxOccurs="1" name="Cost" type="s:int" /> <s:element minOccurs="0" maxOccurs="1" name="Date" type="s:string" /> </s:sequence> </s:complexType>

В этой статье мы показали

В этой статье мы показали особенности создания WEB-сервисов при помощи Delphi 8. Надеемся, что она поможет Вам в работе. document.write('');

Новости мира IT: 02.08 - 02.08 - 02.08 - 02.08 - 02.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 01.08 - 31.07 - 31.07 - 31.07 - 31.07 - 31.07 -
Архив новостей

Последние комментарии: (66)
2 Август, 17:53 (19)
2 Август, 17:51 (34)
2 Август, 15:40 (42)
2 Август, 15:35 (1)
2 Август, 14:54 (3)
2 Август, 14:34 (3)
2 Август, 14:15 (2)
2 Август, 13:34 (7)
2 Август, 13:04 (3)
2 Август, 12:28

BrainBoard.ru
Море работы для программистов, сисадминов, вебмастеров.
Иди и выбирай!

Loading google.load('search', '1', {language : 'ru'}); google.setOnLoadCallback(function() { var customSearchControl = new google.search.CustomSearchControl('018117224161927867877:xbac02ystjy'); customSearchControl.setResultSetSize(google.search.Search.FILTERED_CSE_RESULTSET); customSearchControl.draw('cse'); }, true);

IT-консалтинг

Software Engineering

Программирование

СУБД

Безопасность

Internet

Сети

Операционные системы

Hardware

PR-акции, размещение рекламы — ,
тел. +7 495 6608306, ICQ 232284597

Пресс-релизы —

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

Товар для Вас: от именитой компании.

Delphi и Flash. Совмещение несовместимого!

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

Итак, как же совместить Флэш и Дельфи? (Надеюсь, что у вас Флэш установлен:))

Запустите Дельфи и выберите пункт меню Component->Import ActiveX Control... Перед вами откроется диалоговое окно с заголовком Import ActiveX Control. В разделе Registered Controls выберите Shockwave Flash. В разделе Pallete Page... Выберите страницу в палитре компонентов, на которой будет располагаться установленный компонент (по умолчанию это ActiveX). В разделе Unit Dir Name... путь к папке куда будет установлен компонент.

Нажмите на кнопку Install. Перед вами появится окно, в котором вам нужно будет выбрать в какой пакет будет установлен компонент (вы можете установить как в уже существующий, так и в новый пакет). Затем перед вами появится окно редактирования выбранного пакета и Дельфи вас спросит: "...Package will be rebuilt. Continue?". Ответьте Yes. Все готово теперь можно использовать флэш в ваших приложениях!!!

Теперь, чтобы показать вам как пользоваться этим компонентом, попробуем вместе сделать программу для просмотра *.SWF файлов. Для этого нам понадобятся следующие компоненты: TShockwaveFlash (для удобства назовите его просто Flash1), TTrackBar, TTimer, TOpendialog и три кнопки TButton ("открыть", "старт" и "стоп").

Для начала установим необходимые свойства OpenDialog'a

Свойство Filter может быть таким: Флэш-ролики|*.swf

Свойство DefaultExt должно быть: *.swf

Для Timer'a нужно установить свойство Interval равным 1.

Для TShockwaveFlash:

Name сделайте равным Flash1

Свойство Playing установите в false

Свойство BGColor, установите как вам хочется (цвет фона)

Теперь напишем обработчик события OnClick для кнопки, которая вызывать OpenDialog:

if open1.Execute then begin
flash1.Movie:=open1.FileName;
trackbar1.Max:=flash1.TotalFrames; {это делается для того, чтобы потом можно было перемещаю ползунок посмотреть каждый кадр ролика}

В обработчик события OnClick для второй кнопки ("Старт") напишем:

flash1.Play;

Ну тут вообще все просто! Почти таким же образом это будет выглядеть для третьей кнопки ("Стоп"):

flash1.Stop;

Теперь сделаем, чтобы при перемещении ползунка Trackbar'a мы могли посмотреть каждый кадр (событие OnChange):

if Flash1.IsPlaying=true then Flash1.Stop; {если ролик проигрывается, то надо его остановить}
flash1.GotoFrame(trackbar1.position); {открываем кадр номер которого соответствует позиции ползунка}

Ну и наконец осталось сделать чтобы при проигрывании ролика ползунок перемещался, указывая сколько осталось и сколько прошло. Для этого то мы и используем Timer. В обработчик события OnTimer, напишем:

trackbar1.Position:=flash1.CurrentFrame;

Приведу полный код приложения:

unit flash;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, OleCtrls, ShockwaveFlashObjects_TLB, ExtCtrls;

type
TForm1 = class(TForm)
Flash1: TShockwaveFlash;
Button1: TButton;
TrackBar1: TTrackBar;
Open1: TOpenDialog;
Button2: TButton;
Button3: TButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
if open1.Execute then begin
flash1.Movie:=open1.FileName;
trackbar1.Max:=flash1.TotalFrames;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
flash1.Play;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
if Flash1.IsPlaying=true then Flash1.Stop;
flash1.GotoFrame(trackbar1.position);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
flash1.Stop;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
trackbar1.Position:=flash1.CurrentFrame;
end;

end.

Ну вот и все. Как оказалось ничего сложного.

(С) Автор статьи: // ().

Секция Interface

Interface

uses System.Diagnostics, System.Xml.Serialization, System.Web.Services.Protocols, System.ComponentModel, System.Web.Services, System.Web.Services.Description;

type TDollarRate = class; TArrayOfTDollarRate = array of TDollarRate; /// <remarks/> [System.Diagnostics.DebuggerStepThroughAttribute] [System.ComponentModel.DesignerCategoryAttribute('code')] [System.Web.Services.WebServiceBindingAttribute(Name='TWebService1Soap', Namespace='http://tempuri.org/')] TWebService1 = class(System.Web.Services.Protocols.SoapHttpClientProtocol) /// <remarks/> public constructor Create; /// <remarks/> [System.Web.Services.Protocols.SoapDocumentMethodAttribute( 'http://tempuri.org/HelloWorld', RequestNamespace='http://tempuri.org/', ResponseNamespace='http://tempuri.org/', Use=System.Web.Services.Description.SoapBindingUse.Literal, ParameterStyle=System.Web.Services.Protocols.SoapParameterStyle.Wrapped)] function HelloWorld: string; /// <remarks/> function BeginHelloWorld(callback: System.AsyncCallback; asyncState: System.Object): System.IAsyncResult; /// <remarks/> function EndHelloWorld(asyncResult: System.IAsyncResult): string; /// <remarks/> [System.Web.Services.Protocols.SoapDocumentMethodAttribute( 'http://tempuri.org/IntegerSubstract', RequestElementName='IntegerSubstract', RequestNamespace='http://tempuri.org/', ResponseElementName='IntegerSubstractResponse', ResponseNamespace='http://tempuri.org/', Use=System.Web.Services.Description.SoapBindingUse.Literal, ParameterStyle=System.Web.Services.Protocols.SoapParameterStyle.Wrapped)] [result: System.Xml.Serialization.XmlElementAttribute('IntegerSubstractResult')] function Substract(a: Integer; b: Integer): Integer; overload; /// <remarks/> function BeginSubstract(a: Integer; b: Integer; callback: System.AsyncCallback; asyncState: System.Object): System.IAsyncResult; /// <remarks/> function EndSubstract(asyncResult: System.IAsyncResult): Integer; /// <remarks/> [System.Web.Services.WebMethodAttribute(MessageName='Substract1')] [System.Web.Services.Protocols.SoapDocumentMethodAttribute( 'http://tempuri.org/FloatSubstract', RequestElementName='FloatSubstract', RequestNamespace='http://tempuri.org/', ResponseElementName='FloatSubstractResponse', ResponseNamespace='http://tempuri.org/', Use=System.Web.Services.Description.SoapBindingUse.Literal, ParameterStyle=System.Web.Services.Protocols.SoapParameterStyle.Wrapped)] [result: System.Xml.Serialization.XmlElementAttribute('FloatSubstractResult')] function Substract(a: System.Single; b: System.Single): System.Single; overload; /// <remarks/> function BeginSubstract1(a: System.Single; b: System.Single; callback: System.AsyncCallback; asyncState: System.Object): System.IAsyncResult; /// <remarks/> function EndSubstract1(asyncResult: System.IAsyncResult): System.Single; /// <remarks/> [System.Web.Services.Protocols.SoapDocumentMethodAttribute( 'http://tempuri.org/GetRatesForDays', RequestNamespace='http://tempuri.org/', ResponseNamespace='http://tempuri.org/', Use=System.Web.Services.Description.SoapBindingUse.Literal, ParameterStyle=System.Web.Services.Protocols.SoapParameterStyle.Wrapped)] function GetRatesForDays(ADays: Integer): TArrayOfTDollarRate; /// <remarks/> function BeginGetRatesForDays(ADays: Integer; callback: System.AsyncCallback; asyncState: System.Object): System.IAsyncResult; /// <remarks/> function EndGetRatesForDays(asyncResult: System.IAsyncResult): TArrayOfTDollarRate; end;

/// <remarks/> [System.Xml.Serialization.XmlTypeAttribute(Namespace='http://tempuri.org/')] TDollarRate = class /// <remarks/> public Cost: Integer; /// <remarks/> Date: string; end;

Что дальше?

Реализация

Совсем немного теории

Ставим задачу

Упрощаем работу с потоками (TStream)

CryptoAPI

Другие полезности

Использование инструментов криптографии в Delphi-приложениях

Основные понятия

Популярные алгоритмы

I. Слежение за процессами

II. Слежение за файлами

III. Outro

К материалу прилагаются файлы:

Перенос VBA-макросов в Delphi

Мы рассмотрели несколько примеров перевода

Используемая литература

Немного практики

Немного теории

Обоснование

Требования

Варианты решения

При таком подходе нельзя обращаться

Дополнительные особенности.

Клиент

Клиент

Проблемы и их решения.

Реализация

Сервер

Сервер

State-full Web Services на Delphi

и 7) предоставляет достаточно удобные

это всего лишь субъективный взгляд

Архитектура WEB-сервиса

Атрибут WebMethod

Что такое WEB-сервис ?

Прокси WEB-сервиса

Простейший WEB-сервис

Сложные типы данных в WEB-методах

Создание клиента для WEB-сервиса.

Вызов WEB-методов. Асинхронный режим.

WSDL - язык описания WEB-сервисов.

В этой статье мы показали

Delphi и Flash. Совмещение несовместимого!

Секция Interface