OLE-шлюз
- Evchic
- партнер
- Сообщения: 88
- Зарегистрирован: Пн, 17/09/2007 07:57
- Имя Фамилия: Евгений Ильин
- Откуда: Галактика ЮГ г.Ростов-на-Дону
- Контактная информация:
OLE-шлюз
Добрый день!
Скажите пожалуйста есть какой нибудь пример по использованию OLE шлюза на Delphi... откомпилировать пример из ASDK неполучается...
Скажите пожалуйста есть какой нибудь пример по использованию OLE шлюза на Delphi... откомпилировать пример из ASDK неполучается...
- Evchic
- партнер
- Сообщения: 88
- Зарегистрирован: Пн, 17/09/2007 07:57
- Имя Фамилия: Евгений Ильин
- Откуда: Галактика ЮГ г.Ростов-на-Дону
- Контактная информация:
Вот это...
Все умирает вот здесь
Код: Выделить всё
// вызовы объектных интерфейсов из предыдущего раздела
// описания интерфейсов получаются из tlb
program TestCOM;
uses activeX, sysutils, windows;
type
IAtlantisAppSrv = interface(IDispatch)
['{13AAEF50-CE08-11D5-A27B-00204CE40998}']
function Connect(const uName: WideString; const uPass: WideString): HResult; stdcall;
function ExecVip(const Name: WideString; argc: Integer; var argv: OleVariant;
out aRetVal: Integer): HResult; stdcall;
function LoadVip(const Name: WideString; out ifc: IDispatch): HResult; stdcall;
end;
IAtlantisAppSrvDisp = dispinterface
['{13AAEF50-CE08-11D5-A27B-00204CE40998}']
procedure Connect(const uName: WideString; const uPass: WideString); dispid 100;
function ExecVip(const Name: WideString; argc: Integer; var argv: OleVariant): Integer; dispid 101;
function LoadVip(const Name: WideString): IDispatch; dispid 102;
end;
MainObj = interface(IUnknown)
['{9637AC80-F2EC-11D5-A2C6-00204CE40998}']
function TestFunc(p1: Integer; p2: Integer; out aRetVal: Integer): HResult; stdcall;
function TestProc(var p1: WideString; out aRetVal: WideString): HResult; stdcall;
function TestProc2(p1: Double; var p2: Double): HResult; stdcall;
function getComp(out aRetVal: Int64): HResult; stdcall;
function CompHandl(c1: Int64; var c2: Int64): HResult; stdcall;
function Get_TestProp(out aRetVal: WideString): HResult; stdcall;
function Set_TestProp(const aRetVal: WideString): HResult; stdcall;
function Get_TestProp2(out aRetVal: Integer): HResult; stdcall;
end;
MAINREC = packed record
f1: Integer;
f2: WideString;
f3: Smallint;
end;
MainObj2 = interface(IUnknown)
['{B1A1C670-F3BF-11D5-A2C7-00204CE40998}']
function TestRec(var r: MAINREC): HResult; stdcall;
function TestRec2(r: MAINREC): HResult; stdcall;
end;
MainObj4 = interface;
MainObj3 = interface(IUnknown)
['{B1A1C671-F3BF-11D5-A2C7-00204CE40998}']
function TestObjRef(out aRetVal: MainObj2): HResult; stdcall;
function TestVipRef(out aRetVal: IDispatch): HResult; stdcall;
function TestRef(out aRetVal: MainObj4): HResult; stdcall;
function TestCallRef(const ref: MainObj4; out aRetVal: Integer): HResult; stdcall;
end;
MainObj4 = interface(IUnknown)
['{B1A1C672-F3BF-11D5-A2C7-00204CE40998}']
function Test4(p1: Integer; p2: Integer; out aRetVal: Integer): HResult; stdcall;
end;
IAtlantisApp = IAtlantisAppSrv;
IAtlantisIfc = IDispatch;
const IID_IAtlantisAppSrv : TIID = '{13AAEF50-CE08-11d5-A27B-00204CE40998}';
const CLSID_AtlantisAppSrv : TIID = '{2C4CF260-DAA2-11d5-A29D-00204CE40998}';
const LIBID_DebugLib : TGUID = '{9637AC81-F2EC-11D5-A2C6-00204CE40998}';
const IID_MainObj : TGUID = '{9637AC80-F2EC-11D5-A2C6-00204CE40998}';
const IID_MainObj2 : TGUID = '{B1A1C670-F3BF-11D5-A2C7-00204CE40998}';
const IID_MainObj3 : TGUID = '{B1A1C671-F3BF-11D5-A2C7-00204CE40998}';
const IID_MainObj4 : TGUID = '{B1A1C672-F3BF-11D5-A2C7-00204CE40998}';
var
hr : HRESULT;
pIAtlantisApp : IAtlantisApp;
pIAtlantisIfc : IAtlantisIfc;
vPar : WideString;
p : OleVariant;
ret : longint;
pMainObj : MainObj;
pMainObj2 : MainObj2;
pMainObj3 : MainObj3;
pMainObj4 : MainObj4;
d : double;
s : WideString;
c1,c2 : int64;
rec : MAINREC;
label quit;
begin
pIAtlantisApp := nil;
pIAtlantisIfc := nil;
hr := CoInitialize (nil);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := CoCreateInstance (CLSID_AtlantisAppSrv,
nil, CLSCTX_LOCAL_SERVER,
IID_IAtlantisAppSrv,
pIAtlantisApp);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := pIAtlantisApp.Connect ('aa','aa');
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
p := 5;
hr := pIAtlantisApp.ExecVip ('aTestVip',1,p,ret);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
WriteLn ('Result = ',ret);
hr := pIAtlantisApp.LoadVip ('aTestVip',pIAtlantisIfc);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := pIAtlantisIfc.QueryInterface (IID_MainObj,pMainObj);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := pMainObj.TestFunc (2,5,ret);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', ret);
s := 'QQ';
hr := pMainObj.TestProc (s,vPar);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', vPar, '; ', s);
hr := pMainObj.TestProc2 (2.5,d);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', d);
hr := pMainObj.get_TestProp (vPar);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', vPar);
hr := pMainObj.set_TestProp (vPar);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := pMainObj.get_TestProp2 (ret);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', ret);
hr := pMainObj.getComp (c1);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', c1);
c1 := 12;
c2 := 17;
hr := pMainObj.CompHandl (c1,c2);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', c2);
hr := pIAtlantisIfc.QueryInterface (IID_MainObj3,pMainObj3);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := pMainObj3.TestObjRef (pMainObj2);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
rec.f1 := 5;
rec.f2 := 'record';
rec.f3 := 7;
hr := pMainObj2.TestRec (rec);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := pMainObj2.TestRec2 (rec);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := pMainObj3.TestRef (pMainObj4);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
hr := pMainObj4.Test4 (1,2,ret);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', ret);
hr := pMainObj3.TestCallRef (pMainObj4,ret);
WriteLn (intToHex (hr,8));
if hr <> 0 then goto quit;
writeln ('result = ', ret);
quit :
pMainObj := nil;
pMainObj2 := nil;
pMainObj3 := nil;
pMainObj4 := nil;
pIAtlantisIfc := nil;
pIAtlantisApp := nil;
CoUninitialize;
end.
Код: Выделить всё
hr := CoCreateInstance (CLSID_AtlantisAppSrv,
nil, CLSCTX_LOCAL_SERVER,
IID_IAtlantisAppSrv,
pIAtlantisApp);
- Screw
- топ-софт
- Сообщения: 73
- Зарегистрирован: Пт, 14/09/2007 22:54
- Имя Фамилия: Виталий Корзюк
- Откуда: ТопСофт
- Контактная информация:
Интерфейс в реестре и не нужен.
Предложенный пример собирается и работает. Правда вот сервис у меня пока не захотел стартовать - пытается раскочегариться в течение 2-х минут (CoCreateInstance), после чего отваливается, и управление возвращается в тестовую программу. Код возврата - CO_E_SERVER_EXEC_FAILURE (0x80080005). Пытаюсь выяснить, что не так с сервисом. О результатах сообщу отдельно.
Предложенный пример собирается и работает. Правда вот сервис у меня пока не захотел стартовать - пытается раскочегариться в течение 2-х минут (CoCreateInstance), после чего отваливается, и управление возвращается в тестовую программу. Код возврата - CO_E_SERVER_EXEC_FAILURE (0x80080005). Пытаюсь выяснить, что не так с сервисом. О результатах сообщу отдельно.
- Evchic
- партнер
- Сообщения: 88
- Зарегистрирован: Пн, 17/09/2007 07:57
- Имя Фамилия: Евгений Ильин
- Откуда: Галактика ЮГ г.Ростов-на-Дону
- Контактная информация:
Вот таже ситуация и у меня получиласьScrew писал(а):Интерфейс в реестре и не нужен.
Предложенный пример собирается и работает. Правда вот сервис у меня пока не захотел стартовать - пытается раскочегариться в течение 2-х минут (CoCreateInstance), после чего отваливается, и управление возвращается в тестовую программу. Код возврата - CO_E_SERVER_EXEC_FAILURE (0x80080005). Пытаюсь выяснить, что не так с сервисом. О результатах сообщу отдельно.
- Screw
- топ-софт
- Сообщения: 73
- Зарегистрирован: Пт, 14/09/2007 22:54
- Имя Фамилия: Виталий Корзюк
- Откуда: ТопСофт
- Контактная информация:
Помогла правильная настройка сервера и клиента. Ниже приведены существенные для данной ситуации значения ключей реестра.
Для клиента:
Для сервера:
Упомянутых в примере тестовых интерфесов у меня нет, поэтому его нормальное выполнение завершилось на вызове
Для клиента:
Код: Выделить всё
[HKEY_LOCAL_MACHINE\SOFTWARE\Galaktika Corp\Client]
"Protocol"="comdrv.dll"
Код: Выделить всё
[HKEY_LOCAL_MACHINE\SOFTWARE\Galaktika Corp\Server]
"Protocols"="comdrv.dll"
"ReceiverProtocol"=dword:00000000
Код: Выделить всё
hr := pIAtlantisApp.ExecVip ('aTestVip',1,p,ret);
- Evchic
- партнер
- Сообщения: 88
- Зарегистрирован: Пн, 17/09/2007 07:57
- Имя Фамилия: Евгений Ильин
- Откуда: Галактика ЮГ г.Ростов-на-Дону
- Контактная информация:
А можете привести полный список параметров для веткот
[HKEY_LOCAL_MACHINE\SOFTWARE\Galaktika Corp\Client]
[HKEY_LOCAL_MACHINE\SOFTWARE\Galaktika Corp\Server]
Я сделал "Protocol"="comdrv.dll"
но по прежнему Код возврата - CO_E_SERVER_EXEC_FAILURE (0x80080005)
При выполнении
запускается galsrv.exe на 1-2 секунды и закрывается передавая управления основной проге... и pIAtlantisApp остается равным nil
[HKEY_LOCAL_MACHINE\SOFTWARE\Galaktika Corp\Client]
[HKEY_LOCAL_MACHINE\SOFTWARE\Galaktika Corp\Server]
Я сделал "Protocol"="comdrv.dll"
но по прежнему Код возврата - CO_E_SERVER_EXEC_FAILURE (0x80080005)
При выполнении
Код: Выделить всё
hr := CoCreateInstance (CLSID_AtlantisAppSrv,
nil, CLSCTX_LOCAL_SERVER,
IID_IAtlantisAppSrv,
pIAtlantisApp);
- Evchic
- партнер
- Сообщения: 88
- Зарегистрирован: Пн, 17/09/2007 07:57
- Имя Фамилия: Евгений Ильин
- Откуда: Галактика ЮГ г.Ростов-на-Дону
- Контактная информация:
Да можно было бы через обычный Atlexec.app сделать...
но напригает то факт что происходит отображения картинки галактики....
Код: Выделить всё
// Инициализация OLE
Iface:= CreateOleObject('Atlexec.app');
My:= Iface.LoadVip('Utils::Users');
// Функция передачи пути на файл
My.test('.....'); // ваш поток
//Выгрузка OLE
My:= UnAssigned;
Iface:= UnAssigned;
- Screw
- топ-софт
- Сообщения: 73
- Зарегистрирован: Пт, 14/09/2007 22:54
- Имя Фамилия: Виталий Корзюк
- Откуда: ТопСофт
- Контактная информация:
Ну разумеется!
Регистрируем pxcomdrv.dll:
Регистрируем pxcomdrv.dll:
Код: Выделить всё
regsvr32 pxcomdrv.dll
- Evchic
- партнер
- Сообщения: 88
- Зарегистрирован: Пн, 17/09/2007 07:57
- Имя Фамилия: Евгений Ильин
- Откуда: Галактика ЮГ г.Ростов-на-Дону
- Контактная информация:
Огромное спасибо все получилосьScrew писал(а):Ну разумеется!
Регистрируем pxcomdrv.dll:Код: Выделить всё
regsvr32 pxcomdrv.dll
Неплохо было бы это в документацию добавить!!!
- Evchic
- партнер
- Сообщения: 88
- Зарегистрирован: Пн, 17/09/2007 07:57
- Имя Фамилия: Евгений Ильин
- Откуда: Галактика ЮГ г.Ростов-на-Дону
- Контактная информация:
Виталий Корзюк
Подскажите вчем может проблема
имею
получаю ошибку
Подскажите вчем может проблема
имею
Код: Выделить всё
unit Gal_COM;
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses
activeX,Windows, Messages, SysUtils, Variants, Classes, StdVCL, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
IAtlantisAppSrv = interface(IDispatch)
['{13AAEF50-CE08-11D5-A27B-00204CE40998}']
function Connect(const uName: WideString; const uPass: WideString): HResult; stdcall;
function ExecVip(const Name: WideString; argc: Integer; var argv: OleVariant;
out aRetVal: Integer): HResult; stdcall;
function LoadVip(const Name: WideString; out ifc: IDispatch): HResult; stdcall;
end;
IAtlantisAppSrvDisp = dispinterface
['{13AAEF50-CE08-11D5-A27B-00204CE40998}']
procedure Connect(const uName: WideString; const uPass: WideString); dispid 100;
function ExecVip(const Name: WideString; argc: Integer; var argv: OleVariant): Integer; dispid 101;
function LoadVip(const Name: WideString): IDispatch; dispid 102;
end;
IUsers = interface(IUnknown)
['{CA477FE3-A426-4F3E-949E-8EDF6725F4EB}']
function GhostMethod_IUsers_0_1: HResult; stdcall;
function GhostMethod_IUsers_4_2: HResult; stdcall;
function GhostMethod_IUsers_8_3: HResult; stdcall;
function SendMessageToActiveUsers(const msg: WideString): HResult; stdcall;
end;
IAtlantisApp = IAtlantisAppSrv;
IAtlantisIfc = IDispatch;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const IID_IAtlantisAppSrv : TIID = '{13AAEF50-CE08-11d5-A27B-00204CE40998}';
const CLSID_AtlantisAppSrv : TIID = '{2C4CF260-DAA2-11d5-A29D-00204CE40998}';
const LIBID_FULLLib: TGUID = '{BBB198A1-11BF-42B0-A066-B9D80B6DC746}';
const IID_IUsers: TGUID = '{CA477FE3-A426-4F3E-949E-8EDF6725F4EB}';
var
Form1: TForm1;
hr : HRESULT;
pIAtlantisApp : IAtlantisApp;
pIAtlantisIfc : IAtlantisIfc;
vPar : Integer;
p : OleVariant;
ret : longint;
pMainObj : IUsers;
d : double;
s : WideString;
c1,c2 : int64;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
pIAtlantisApp := nil;
pIAtlantisIfc := nil;
//pMainObj := nil;
hr := CoInitialize (nil);
if hr <> 0 then ShowMessage ('Ev1 '+intToHex (hr,8));
hr := CoCreateInstance (CLSID_AtlantisAppSrv,
nil, CLSCTX_LOCAL_SERVER,
IID_IAtlantisAppSrv,
pIAtlantisApp);
ShowMessage (intToHex(CO_E_SERVER_EXEC_FAILURE,8)+' Ev2 '+intToHex (hr,8));
hr := pIAtlantisApp.Connect ('aa','aa');
ShowMessage ('Ev3 '+intToHex (hr,8));
p := 5;
hr := pIAtlantisApp.LoadVip ('UTILS::Users',pIAtlantisIfc);
ShowMessage ('Ev4 '+intToHex (hr,8));
hr := pIAtlantisIfc.QueryInterface (IID_IUsers,pMainObj);
ShowMessage ('Ev5 '+intToHex (hr,8));
s := 'QQ';
hr := pMainObj.SendMessageToActiveUsers(s);
ShowMessage ('Ev6 '+intToHex (hr,8));
end;
end.
вот в этом месте---------------------------
Gal_com_prj
---------------------------
Access violation at address 00000000. Read of address 00000000.
---------------------------
ОК
---------------------------
Код: Выделить всё
hr := pMainObj.SendMessageToActiveUsers(s);