Модераторы: MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> COM объект, Ошибка какая-то) 
:(
    Опции темы
DragonFire
Дата 24.7.2006, 11:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
Взял я статью про ком объекты из DRKB. Вот раздел один в ней:
Код

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

В начале код dll c объектом. 

library CalcDll; 

uses 
  SysUtils, 
  Classes; 

type 

 HResult=Longint; 

 ICalcBase=interface                      //чисто абстрактный интерфейс 
   procedure SetOperands(x,y:integer); 
   procedure Release; 
 end; 

 ICalc=interface(ICalcBase) 
   ['{149D0FC0-43FE-11D6-A1F0-444553540000}'] 
   function Sum:integer; 
   function Diff:integer; 
 end; 

 ICalc2=interface(ICalcBase) 
   ['{D79C6DC0-44B9-11D6-A1F0-444553540000}'] 
   function Mult:integer; 
   function Divide:integer; 
 end; 

 MyCalc=class(TObject,ICalc,ICalc2)  //два интерфейса 
   fx,fy:integer; 
 public 
   procedure SetOperands(x,y:integer); 
   function Sum:integer; 
   function Diff:integer; 
   function Divide:integer; 
   function Mult:integer; 
   procedure Release; 
   function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 
   function _AddRef:Longint; stdcall; 
   function _Release:Longint; stdcall; 
 end; 

const 
 S_OK = 0; 
 E_NOINTERFACE = HRESULT($80004002); 

procedure MyCalc.SetOperands(x,y:integer); 
begin 
 fx:=x; fy:=y; 
end; 

function MyCalc.Sum:integer; 
begin 
  result:=fx+fy; 
end; 

function MyCalc.Diff:integer; 
begin 
  result:=fx-fy; 
end; 

function MyCalc.Divide:integer; 
begin 
  result:=fx div fy; 
end; 

function MyCalc.Mult:integer; 
begin 
  result:=fx*fy; 
end; 

procedure MyCalc.Release; 
begin 
 Free; 
end; 

function MyCalc.QueryInterface(const IID: TGUID; out Obj): HResult; 
begin 
  if GetInterface(IID, Obj) then 
    Result := S_OK 
  else 
    Result := E_NOINTERFACE; 
end; 

function MyCalc._AddRef; 
begin 
end; 

function MyCalc._Release; 
begin 
end; 

procedure CreateObject(const IID: TGUID; var ACalc); 
var 
 Calc:MyCalc; 
begin 
 Calc:=MyCalc.Create; 
 if not Calc.GetInterface(IID,ACalc) then 
  Calc.Free; 
end; 

exports 
 CreateObject; 

begin 
end. 

А теперь тестер. 

unit tstcl; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls,ComObj; 

type 

 //обратите внимание! Используем один унифицированный интерфейс 
  IUniCalc=interface    
    procedure SetOperands(x,y:integer); 
    procedure Release; 
    function Sum:integer; 
    function Diff:integer; 
  end; 

  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
  end; 

var 
  Form1: TForm1; 
  _Mod:Integer;  //хэндл модуля 
  СreateObject:procedure (IID:TGUID; out Obj); //процедура из dll. 

  Calc:IUniCalc;        //это указатель на интерфейс котрый мы будем получать 
  ICalcGUID:TGUID;    
  ICalc2GUID:TGUID;  
  flag:boolean;         // какой интерфейс активный. 

implementation 

{$R *.DFM} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  _Mod:=LoadLibrary(PChar('C:\Kir\COM\SymplDll\CalcDll.dll')); 

  //Эти GUID я просто скопировал из исходника CalcDll.dll 
  ICalcGUID:=StringToGUID('{149D0FC0-43FE-11D6-A1F0-444553540000}'); 
  ICalc2GUID:=StringToGUID('{D79C6DC0-44B9-11D6-A1F0-444553540000}'); 
  flag:=true; 

  СreateObject:=GetProcAddress(_Mod,'CreateObject'); 

  СreateObject(ICalcGUID,Calc); 
  if Calc<>nil then 
    Calc.SetOperands(10,5); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  if Calc<>nil then 
   Calc.Release; 
  FreeLibrary(_Mod); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
   ShowMessage(IntToStr(Calc.diff)); 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
   ShowMessage(IntToStr(Calc.Sum)); 
end; 

procedure TForm1.Button3Click(Sender: TObject); 
var 
   tmpCalc:IUniCalc; 
begin 
   if flag then 
     Calc.QueryInterface(ICalc2GUID,tmpCalc) 
   else 
     Calc.QueryInterface(ICalcGUID,tmpCalc); 
   flag:=not flag;   
   Calc:=tmpCalc; 
end; 

end. 

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



Попробовал я этот код скомпелировать - все пашет, только при закрытии аксес вуалейшн выдает, причем при отладке он выдается уже ПОСЛЕ последнего END.
В чем проблема? Пишу в Delphi7  


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 24.7.2006, 13:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 15
Всего: 108
вероятно, но не факт: где-то освобождение памяти идёт несколько раз...

Добавлено @ 14:00 
имею виду.. один и тотже объект пытаются освободить несколько раз... 


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 24.7.2006, 16:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
Я вообще удалял вызов Calc.Release; - это ничего не дало.... 
Даже если просто подключаю объект: СreateObject(ICalcGUID,Calc); , то уже при выходе возникает ошибка... 


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 24.7.2006, 22:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 15
Всего: 108
проветь может здесь идет освобождение:
Код

procedure CreateObject(const IID: TGUID; var ACalc);    
var    
 Calc:MyCalc;    
begin    
 Calc:=MyCalc.Create;    
 if not Calc.GetInterface(IID,ACalc) then    
  Calc.Free;    
end;

поставь мессажебок если условие выполнено... 


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 24.7.2006, 22:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
неа оно не выполняется.... условие всмысле... 


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Fantasist
Дата 28.7.2006, 17:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй
***


Профиль
Группа: Участник Клуба
Сообщений: 1517
Регистрация: 24.3.2002

Репутация: 4
Всего: 41
Есть определенные глюки с FreeLibrary в Delphi. Делфийская dll-ка делает множество всяких действий, нам не видимых. В чем именно проблема пока не знаю, но так как обычно библиотеку освобождаешь при окончании приложения, то можно FreeLibrary не вызывать - виндос освободит ее сама. 

В общем, убери FreeLibrary. 


--------------------
Волны гасят ветер...
PM MAIL   Вверх
DragonFire
Дата 29.7.2006, 21:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
О, спс, ща попробую, завтра отпишусь... 


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
jack128
Дата 30.7.2006, 22:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 81
Регистрация: 18.5.2005

Репутация: 2
Всего: 4
вообще то за такие примеры руки мало переломать. Вот, абсолютно коректный пример:
Общий для двух проектов модуль. 

Код

unit Intf.Common;

interface

type
  ICalcBase = interface
  ['{B98E1386-7236-439F-AF77-5D998C22D37A}']
    procedure SetOperands(x,y:integer);
  end;

  ICalc = interface(ICalcBase)
    ['{149D0FC0-43FE-11D6-A1F0-444553540000}']
    function Sum: Integer;
    function Diff: Integer;
  end;

  ICalc2 = interface(ICalcBase)
    ['{D79C6DC0-44B9-11D6-A1F0-444553540000}']
    function Mult: Integer;
    function Divide: Integer;
  end;

implementation

end.


DLL:

Код

library IntfDll;

uses
  SysUtils,
  Classes,
  Intf.Common in 'Intf.Common.pas';

type

// Реализацию _AddRef/_Release/QueryInteface - смотри в TInterfacedObject.
// Посчет ссылок в этом классе реализован таким образом, 
// что объект будет уничтожен тогда когда будут обнилимы все интерфейсные ссылки на него
 TMyCalc = class(TInterfacedObject, ICalcBase, ICalc, ICalc2)  
 private
   fx, fy: Integer;
 public 
   procedure SetOperands(x,y:integer); 
   function Sum: Integer;
   function Diff: Integer;
   function Divide: Integer;
   function Mult: Integer;
 end;

procedure TMyCalc.SetOperands(x,y:integer);
begin 
 fx:=x; fy:=y;
end; 

function TMyCalc.Sum:integer;
begin 
  result:=fx+fy; 
end; 

function TMyCalc.Diff:integer;
begin 
  result:=fx-fy; 
end; 

function TMyCalc.Divide:integer;
begin 
  result:=fx div fy; 
end; 

function TMyCalc.Mult:integer;
begin 
  result:=fx*fy; 
end; 

procedure CreateObject(const IID: TGUID; var ACalc);
var 
  Intf: IUnknown;
begin
  Intf := TMyCalc.Create; 
  if Intf.QueryInterface(IID, ACalc) <> S_OK then
    Pointer(ACalc) := nil;
end;

exports
  CreateObject; 

begin

end.


Exe:

Код

unit IntfExe.MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Intf.Common, StdCtrls;

type
  TMainForm = class(TForm)
    btnSum: TButton;
    btnDiff: TButton;
    btnMult: TButton;
    btnDiv: TButton;
    procedure btnDivClick(Sender: TObject);
    procedure btnMultClick(Sender: TObject);
    procedure btnDiffClick(Sender: TObject);
    procedure btnSumClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FDllHandle: THandle;
    FCalc: ICalc;
    FCalc2: ICalc2;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
var
  CreateObject: procedure (IID:TGUID; out Obj);
begin
  FDllHandle :=LoadLibrary('IntfDll.dll');
  Win32Check(FDllHandle <> 0); // проверка, успешна ли загрузилась DLL

  try
    @CreateObject := GetProcAddress(FDllHandle,'CreateObject');
    Win32Check(Assigned(@CreateObject)); // Проверка, найдена  ли функция для создания объекта

    CreateObject(ICalc, FCalc);

    if Assigned(FCalc) and (FCalc.QueryInterface(ICalc2, FCalc2) = S_OK) then
      FCalc.SetOperands(10, 5)
    else
      raise Exception.Create('Не поддерживается один из необходимых интерфейсов');
  except
   // перед выгрузкой DLL мы должны обнилить все интерфейсные ссылки, 
   // чтобы объект TMyCalc  уничтожился.
    FCalc := nil; FCalc2 := nil; 
    FreeLibrary(FDllHandle);
    FDllHandle := 0;
    raise;
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FCalc := nil; FCalc2 := nil; // опять же - принудительно обниливаем ссылки.
  if FDllHandle <> 0 then
  begin
    FreeLibrary(FDllHandle);
    FDllHandle := 0;
  end;
end;

procedure TMainForm.btnDiffClick(Sender: TObject);
begin
  Assert(Assigned(FCalc));
  ShowMessage(IntToStr(FCalc.Diff));
end;

procedure TMainForm.btnDivClick(Sender: TObject);
begin
  Assert(Assigned(FCalc2));
  ShowMessage(IntToStr(FCalc2.Divide));
end;

procedure TMainForm.btnMultClick(Sender: TObject);
begin
  Assert(Assigned(FCalc2));
  ShowMessage(IntToStr(FCalc2.Mult));
end;

procedure TMainForm.btnSumClick(Sender: TObject);
begin
  Assert(Assigned(FCalc));
  ShowMessage(IntToStr(FCalc.Sum));
end;

end.
    

Это сообщение отредактировал(а) jack128 - 30.7.2006, 22:56
PM MAIL   Вверх
DragonFire
Дата 31.7.2006, 09:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
Fantasist 
Пришлось убрать вообще процедуру Form1.destroy (т.е. все что в ней есть) и тогда заработало)
jack128 
Так ща будем пробовать  smile  


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Fantasist
Дата 1.8.2006, 22:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй
***


Профиль
Группа: Участник Клуба
Сообщений: 1517
Регистрация: 24.3.2002

Репутация: 4
Всего: 41
Да, jack128 прав - нужно все ссылки обнулить перед освобождением библиотеки. В данном случае присвоить nil интерфейсной переменной Calc.


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


--------------------
Волны гасят ветер...
PM MAIL   Вверх
DragonFire
Дата 2.8.2006, 09:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
У меня все заработало... Я думаю вся проблема была в этом:
Код

function MyCalc.QueryInterface(const IID: TGUID; out Obj): HResult; 
begin 
  if GetInterface(IID, Obj) then 
    Result := S_OK 
  else 
    Result := E_NOINTERFACE; 
end; 

function MyCalc._AddRef; 
begin 
end; 

function MyCalc._Release; 
begin 
end; 

А теперь с использованием TInterfacedObject все проблемы решились... Даже без этих строк все пашет: 
Код

FCalc := nil; FCalc2 := nil;



--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
DragonFire
Дата 2.8.2006, 09:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
И сразу новый вопрос - как сделать так, чтобы можно было в EXE делать так: Calc.X:=20; ??
Тоесть у меня есть класс:
Код

TWindow = class(TInterfacedObject, IWindow)
  private
    FWindow:HWND; 
  public
    function SetCursor(FileName:ShortString):HCURSOR;
    property Window:HWND read FWindow write FWindow;
  end;

Как в интерфейт запихнуть  property если такое вообще возможно?


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
jack128
Дата 3.8.2006, 00:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 81
Регистрация: 18.5.2005

Репутация: 2
Всего: 4
Цитата(DragonFire @  2.8.2006,  09:30 Найти цитируемый пост)
... Даже без этих строк все пашет: 

а у меня AV.  собственно - у тебя тоже ФМ должно быть. Где именно ты эти строчки закоментировал? Закоментируй в деструкторе и посмотри, что выдет.

Цитата(DragonFire @  2.8.2006,  09:50 Найти цитируемый пост)
Как в интерфейт запихнуть  property если такое вообще возможно? 

возможно.

Код

type
  ICalcBase = interface
  ['{B98E1386-7236-439F-AF77-5D998C22D37A}']
    function GetX: Integer;
    procedure SetX(const Value: Integer);
    function GetY: Integer;
    procedure SetY(const Value: Integer);

    property X: Integer read GetX write SetX;
    property Y: Integer read GetY write SetY;
    procedure SetOperands(x,y:integer);
  end;


и реализуешь в классе TMyCalc 4 новых метода. Соответственно в EXE вместо FCalc.SetOperands(10, 5) ты можешь написать       
Код

  FCalc.X := 10;
  FCalc.Y := 5;


Это сообщение отредактировал(а) jack128 - 3.8.2006, 00:47
PM MAIL   Вверх
DragonFire
Дата 3.8.2006, 07:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
Ага понял, типо так вот, да?
Код

TWindow = class(TInterfacedObject, IWindow)
  private
    FWindow:HWND;
    function GetFWindow:HWND;
  public
    function SetCursor(FileName:ShortString):HCURSOR;    
    property Window:HWND read FWindow write FWindow;
  end;
IWindow = interface
  ['{B98E1386-7236-439F-AF77-5D998C22D37A}']
    function GetFWindow: HWND;
    procedure SetFWindow(const Value: HWND);

    property Window: Integer read GetFWindow write SetFWindow;
  end;


Но тогда у меня будут достыпны еще и функции GetFWindow и SetFWindow в EXE, так? а нельзя их спрятать как-нибудь, как в классе все это делается через private



--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
DragonFire
Дата 3.8.2006, 10:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9
Все вопрос отпал, все отлично работает по схеме приведенной мной ваше... Delphi умный smile


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: ActiveX/СОМ/CORBA"

Rrader
Girder

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

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


  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Delphi
  • Вопросы по SQL и вопросы по базам данных, не связанные с Delphi, задавать здесь

Если Вам помогли, и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Rrader, Girder.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: ActiveX/СОМ/CORBA | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1311 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.