Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Низкоуровневое программирование > Win Api
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 23.09.2014, 11:09   #1
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию Вызов интерфейса из СОМ сервера.

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

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

Так вот у меня не получается вызов методов класса, который я запрашиваю через интерфейс:
Код:
program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,SysUtils, comserv, comobj,  activex,  variants
  { you can add units after this };

const
  IID: TGUID = '{E21520C9-542C-4702-9FA1-FB307F8B3C6B}';
  CLS: TGUID = '{81718B73-2BDA-417E-97D5-84ACB754E5E1}';
var
  fox,v:variant; cid:TGuid; ifox:IUnknown;
begin
 // ListBox1.Items.Append('DllRegisterServer='+IntToStr(DllRegisterServer));
 // ListBox1.Items.Append('DllGetClassObject='+IntToStr(DllGetClassObject(CLS,IID,fox)));
try
 writeln('CLSIDFromProgID=',CLSIDFromProgID('tfoxpro.tfoxpro',cid));
 CoInitialize(nil);
 //ListBox1.Items.Append('DllGetClassObject='+IntToStr(DllGetClassObject(cid,IID,fox)));
 ifox:=CreateComObject(cid);
 writeln('Assigned(ifox)=',Assigned(ifox));
 writeln('ifox.QueryInterface(IID,fox)=',(ifox.QueryInterface(IID,fox)));
 writeln('not VarIsClear(fox)=',not VarIsClear(fox));
 //v:=fox.myfunc('2+2');
 fox.myproc('close all');
 writeln('not VarIsClear(v)=',not VarIsClear(v));

 ifox:=nil;
 CoUninitialize;
 // ListBox1.Items.Append('DllUnRegisterServer='+IntToStr(DllUnRegisterServer));
except
  on e:Exception do writeln(e.Message);
end;
 readln;

end.
Падение происходит на строке fox.myproc('close all'); с ошибкой: Invalid variant Operation
Отработка программы до этого момента такова:
Цитата:
CLSIDFromProgID=0
Assigned(ifox)=TRUE
ifox.QueryInterface(IID,fox)=0
not VarIsClear(fox)=TRUE
Я подсмотрел в отладчике - fox какой-то адрес всетки получает.
И я точно знаю что у него должна быть процедура myproc:
Цитата:
// Generated .IDL/C++ pseudo source equivalent of Win32 type library ..\tfoxpro.dll
[
uuid({0499DA9A-DAE8-4E3A-834C-01D45703755D}),
version(1.0),
helpstring("tfoxpro Type Library")
]
library tfoxpro
{
// Forward references and typedefs
dispinterface Itfoxpro;

[
uuid({E21520C9-542C-4702-9FA1-FB307F8B3C6B}),
helpstring("tfoxpro.tfoxpro")
]
dispinterface Itfoxpro
{
properties:
methods:
[id(0), restricted] void QueryInterface(
[id(1), restricted] unsigned long AddRef();
[id(2), restricted] unsigned long Release();
[id(3), restricted] void GetTypeInfoCount([out] unsigned int* pctinfo);
[id(4), restricted] void GetTypeInfo(
[id(5), restricted] void GetIDsOfNames(
[id(6), restricted] void Invoke(
[id(7), propget, helpstring("Specifies the file name of the user-defined class library that contains the object's class.")] BSTR ClassLibrary();
[id(8), propget, helpstring("Specifies the graphics file or field to display on the control.")] BSTR Picture();
[id(9)] VARIANT myproc(void lcrun);
[id(10)] VARIANT myfunc([in] BSTR lcrun);

... };

[
uuid({81718B73-2BDA-417E-97D5-84ACB754E5E1}),
helpstring("tfoxpro.tfoxpro")
]
coclass tfoxpro
{
[default] dispinterface Itfoxpro;
};
};
Вопрос: Что я могу делать не так, что происходит такое падение?
Вложения
Тип файла: rar tfoxpro.rar (14.0 Кб, 7 просмотров)
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 23.09.2014, 14:50   #2
waleri
Старожил
 
Регистрация: 13.07.2012
Сообщений: 6,493
По умолчанию

А кто делает из '' строчек BSTR строчки?
Вызов myfunc происходит или нет, т.е. ломается до или после вызова?
Если после, то что делает myfunc?
waleri на форуме Ответить с цитированием
Старый 23.09.2014, 17:03   #3
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
А кто делает из '' строчек BSTR строчки?
Этого я не описывал. По крайней мере еще лет пять назад эта схема работала на D6.
Сейчас ХЕ уже сливаются в такую ошибку.
Хотя возможно сам фокспро и преобразует, всетки эта ДЛЛ на нем написана.
Цитата:
Если после, то что делает myfunc?
Да ничего такого:
Код:
PROCEDURE myfunc
LPARAMETERS lcrun as String
 STORE &lcrun TO mret	&&-	Сохраняем выполнение команды в переменную
 RETURN mret	&&-	которую потом возвращаем.
ENDPROC
Работает со строкой.
Не могу в толк взять почему раньше эта схема работала, когда я на D6+ForPro7 работал а сейчас... Что могло поменяться то?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 23.09.2014, 17:49   #4
waleri
Старожил
 
Регистрация: 13.07.2012
Сообщений: 6,493
По умолчанию

Я бы начал с того, что сделал бы myfunc пустой и потом добавлял строчку за строчкой, пока сломается.
Я ставлю на то, что проблема в RETURN mret...
Ни в Дельфи ни фохпро не разбираюсь, шарю только в СОМ.
waleri на форуме Ответить с цитированием
Старый 23.09.2014, 20:49   #5
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Хорошая идея, чет сам не допер (хорошо что спросил).
Убрал. Сделал метод процедурой. Все равно ошибка та же. Тело процедуры пустым оставил... как будто Фокспро компилирует совсем не то что заявлено...
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 23.09.2014, 21:52   #6
waleri
Старожил
 
Регистрация: 13.07.2012
Сообщений: 6,493
По умолчанию

А если сделать аргумент не BSTR а INT (ну и передавать что-то типа 1234)?
Если тогда заработает, значит проблема преобразования из '' в BSTR
waleri на форуме Ответить с цитированием
Старый 23.09.2014, 22:48   #7
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Так я вообще убрал все аргументы. Тупо процедура пустая.
Тут еще момент всплыл - фокспро без некоторых run-time ДЛЛ не работает. Я этот момент наверное упустил. Не думал что обертке они понадобятся но на стадии регистрации (regsvr32) обертка мне так и сказала - не хватает ДЛЛ, но уже завтра буду ДЛЛ эти подкидывать к проекту.
К тому же удалось раскопать из своих наработок это:
Код:
  Ifox = interface(IDispatch)
    ['{188CC67E-A7E4-454E-8211-4006FB5B4C71}']
    function  Get_ClassLibrary: WideString; safecall;
    function  Get_Picture: WideString; safecall;
    function  aproc(const lcrun: WideString): OleVariant; safecall;
    function  afunc(const lcrun: WideString): OleVariant; safecall;
    function  Get_Name: WideString; safecall;
    procedure Set_Name(const Name: WideString); safecall;
    function  Destroy: OleVariant; safecall;
    function  Error(nError: Integer; const cMethod: WideString; nLine: Integer): OleVariant; safecall;
    function  Init(InitParm1: OleVariant; InitParm2: OleVariant): OleVariant; safecall;
    function  ReadExpression(const cPropertyName: WideString): OleVariant; safecall;
    function  ReadMethod(const cMethod: WideString): OleVariant; safecall;
    function  ResetToDefault(cProperty: Integer): OleVariant; safecall;
    function  SaveAsClass(const cClassLibName: WideString; const cClassName: WideString;
                          const cDescription: WideString): OleVariant; safecall;
    function  WriteExpression(const cPropertyName: WideString; const cExpression: WideString): OleVariant; safecall;
    function  WriteMethod(const cMethodName: WideString; const cMethodText: WideString;
                          const lCreateMethod: WideString): OleVariant; safecall;
    function  AddProperty(const cPropertyName: WideString; vNewValue: OleVariant): OleVariant; safecall;
    function  Get_BaseClass: WideString; safecall;
    function  Get_Class_: WideString; safecall;
    function  Get_ParentClass: WideString; safecall;
    function  Get_Parent: Integer; safecall;
    function  Get_Comment: WideString; safecall;
    procedure Set_Comment(const Comment: WideString); safecall;
    function  Get_Tag: WideString; safecall;
    procedure Set_Tag(const Tag: WideString); safecall;
    function  Get_Height: Integer; safecall;
    procedure Set_Height(Height: Integer); safecall;
    function  Get_Width: Integer; safecall;
    procedure Set_Width(Width: Integer); safecall;
    function  AddObject(const cName: WideString; const cClass: WideString;
                        const cOLEClass: WideString; aInit1: OleVariant): OleVariant; safecall;
    function  NewObject(const cName: WideString; const cClass: WideString;
                        const cModule: WideString; const cInApplication: WideString;
                        const cOLEClass: WideString; aInit1: OleVariant): OleVariant; safecall;
    function  RemoveObject(const cObjectName: WideString): OleVariant; safecall;
    function  Get_HelpContextID: Integer; safecall;
    procedure Set_HelpContextID(HelpContextID: Integer); safecall;
    function  Get_WhatsThisHelpID: Integer; safecall;
    procedure Set_WhatsThisHelpID(WhatsThisHelpID: Integer); safecall;
    function  ShowWhatsThis: OleVariant; safecall;
    function  Get_Controls: Integer; safecall;
    function  Get_ControlCount: Integer; safecall;
    function  Get_Objects: Integer; safecall;
    property ClassLibrary: WideString read Get_ClassLibrary;
    property Picture: WideString read Get_Picture;
    property Name: WideString read Get_Name write Set_Name;
    property BaseClass: WideString read Get_BaseClass;
    property Class_: WideString read Get_Class_;
    property ParentClass: WideString read Get_ParentClass;
    property Parent: Integer read Get_Parent;
    property Comment: WideString read Get_Comment write Set_Comment;
    property Tag: WideString read Get_Tag write Set_Tag;
    property Height: Integer read Get_Height write Set_Height;
    property Width: Integer read Get_Width write Set_Width;
    property HelpContextID: Integer read Get_HelpContextID write Set_HelpContextID;
    property WhatsThisHelpID: Integer read Get_WhatsThisHelpID write Set_WhatsThisHelpID;
    property Controls: Integer read Get_Controls;
    property ControlCount: Integer read Get_ControlCount;
    property Objects: Integer read Get_Objects;
  end;
Завтра буду внимательнее разбираться. Интерфейсы никогда толком не использовал, а тут понадобилось.

P.S. А скорее всего что я тупо неверно интерфейсы использую. Всетки ДЛЛ рантаймовые стоят в системе, и фокспро работает...
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 24.09.2014, 00:32   #8
waleri
Старожил
 
Регистрация: 13.07.2012
Сообщений: 6,493
По умолчанию

Цитата:
Сообщение от Stilet Посмотреть сообщение
Тут еще момент всплыл - фокспро без некоторых run-time ДЛЛ не работает.
Тогда класс вообще создать будет нельзя, т.е. до вызова дело не дойдет.
waleri на форуме Ответить с цитированием
Старый 24.09.2014, 08:15   #9
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

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

P.S. Итак все решилось. Действительно не нужно было работать через variant. После того как подтянул в проект вышеуказанный класс-интерфейс все запустилось и заработало.
I'm learning to live...

Последний раз редактировалось Stilet; 24.09.2014 в 10:24.
Stilet вне форума Ответить с цитированием
Старый 23.12.2016, 03:51   #10
IvanVL
 
Регистрация: 27.09.2016
Сообщений: 3
По умолчанию

Всем доброго времени суток.

Цитата:
Сообщение от Stilet Посмотреть сообщение
Та вот жеж и я думаю... Все равно все ДЛЛ установлены, а метод на этом же компе не вызывается. Надо наверное действительно не вариантами работать а сесть и описать интерфейс.

P.S. Итак все решилось. Действительно не нужно было работать через variant. После того как подтянул в проект вышеуказанный класс-интерфейс все запустилось и заработало.
А можно увидеть окончательный код?
Уж очень надо, а разобраться не могу, не опытен.

Спасибо.
IvanVL вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вызов деструктора класса при присвоении ссылке на метод реализуемого интерфейса nil LISTAT Общие вопросы Delphi 1 02.07.2012 20:56
настройка СОМ-сервера mureno Компоненты Delphi 0 12.12.2010 15:35
Система СОМ на базе сервера МТS s2dentishe Общие вопросы Delphi 4 17.09.2010 10:10
Вызов рантайм сервера в матлабе Kracozebr Помощь студентам 0 04.08.2010 12:35
Расширение интерфейса сервера приложений malevich Общие вопросы Delphi 2 22.03.2008 02:05