Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.06.18;
Скачать: CL | DM;

Вниз

Как получить интерфейс класса ?   Найти похожие ветки 

 
Sphinx ©   (2006-05-08 17:18) [0]

Имеется динамическая библиотека, в которой содержится примерно следующий код:
unit uInterface;

interface

uses
 Windows;

type
 IPlugInInterface = interface(IUnknown)
   procedure Test; stdcall;
 end;

 PPlugInInterface = ^TPlugInInterface;
 TPlugInInterface = class(TObject, IPlugInInterface)
   private
     FRef : Longword;
   public
     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
     function _AddRef: Integer; stdcall;
     function _Release: Integer; stdcall;
     procedure Test; stdcall;

     constructor Create;
     destructor Destroy; override;
 end;

var
 g_PlugIn : TPlugInInterface;

implementation

constructor TPlugInInterface.Create;
begin
 Inherited Create;
 FRef := 1;
end;

destructor TPlugInInterface.Destroy;
begin
 Inherited Destroy;
end;

function TPlugInInterface.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
 Result := S_OK;
end;

function TPlugInInterface._AddRef: Integer; stdcall;
begin
 Inc(FRef);
 Result := FRef;
end;

function TPlugInInterface._Release: Integer; stdcall;
begin
 Dec(FRef);
 if (FRef = 0) then
   begin
     Free;
     Result := 0;
   end
 else
   Result := FRef;
end;

procedure TPlugInInterface.Test;
begin
 MessageBox(0, "Test", nil, MB_OK);
end;

end.

///////////////////////////////////////////////////////////////////////

library GOES337;

uses
 Windows,
 Forms,
 uInterface in "uInterface.pas";

procedure DllEntry(dwReason: DWORD);
begin
 case dwReason of
   DLL_PROCESS_ATTACH:
     begin
     end;
   DLL_PROCESS_DETACH:
     begin
     end;
   DLL_THREAD_ATTACH:
     begin
     end;
   DLL_THREAD_DETACH:
     begin
     end;
 end;

end;

procedure LoadPlugIn(const App : TApplication; var p: Pointer);
var
 pit : PInterfaceTable;
begin
 Application := App;
 g_PlugIn := TPlugInInterface.Create;
 pit := g_PlugIn.GetInterfaceTable;
 if pit^.EntryCount > 0 then
   p := pit^.Entries[0].VTable;
end;

exports
 LoadPlugIn;

begin
 @DllProc := @DllEntry;
 DllEntry(DLL_PROCESS_ATTACH);
end.


и имеется приложение, в котором эта библиотека используется:
procedure TMainForm.FormCreate(Sender: TObject);
var
 tempStr       : String;
 tempWord      : Word;
 i             : Word;
 tempLibHandle : THandle;
 tempPlugIn    : PPlugIn;
 tempLProc     : TLoadProc;

 tpp : Pointer;
begin
 listPlg := TPlugInList.Create;
 tempStr := ExtractFileDir(ParamStr(0));
 iniF := TIniFile.Create(tempStr + "\dbHelp.ini");

 tempWord := iniF.ReadInteger("Base", "NumBase", 0);
 if tempWord = 0 then Exit;
 for i := 1 to tempWord do
   begin
     tempStr := iniF.ReadString("Base", IntToStr(i), "");
     if FileExists(tempStr) then
       begin
         try
           tempLibHandle := LoadLibrary(PChar(tempStr));
           @tempLProc    := GetProcAddress(tempLibHandle, "LoadPlugIn");
           New(tempPlugIn);
           with tempPlugIn^ do
             begin
               FileName   := "";
               FileHandle := 0;
               PInterface := nil;
             end;
           tempPlugIn^.FileName   := tempStr;
           tempPlugIn^.FileHandle := tempLibHandle;
           tempLProc(Application, tpp);
           tempPlugIn^.PInterface := tpp;
           tempPlugIn^.PInterface^.Test; // тут выскакивает AV
           listPlg.Add(tempPlugIn);
         except
           MessageBox(0, PChar(String("Can""t load library ") + tempStr), "ERROR", MB_OK or MB_ICONERROR)
         end;
       end;
   end;

end;

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

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

Может чего не допонимаю...объясните пожалуйста...


 
jack128 ©   (2006-05-08 17:36) [1]


> function TPlugInInterface.QueryInterface(const IID: TGUID;
>  out Obj): HResult; stdcall;
> begin
>  Result := S_OK;
> end;

Это что за бред??  Ты вообще в курсе что должен делать этот метод?  Типичную реализацию этого метода см в классе TInterfacedObject


 
Sphinx ©   (2006-05-08 17:41) [2]

2 jack128 ©   (08.05.06 17:36) [1]
В курсе...
> Код примерный и довольно кривой, написан что бы разобраться
> как же можно получить интерфейс из библиотеки.

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


 
DiamondShark ©   (2006-05-08 17:42) [3]

Это называется: "переучился".

unit uInterface;

interface

uses
Windows;

type
IPlugInInterface = interface(IUnknown)
  ["{CFD8220A-5EF3-4095-B0AD-A922FB4A20CF}"] // а как, по-вашему, QueryInterface должен работать?
  procedure Test; stdcall;
end;

PPlugInInterface = ^TPlugInInterface;
TPlugInInterface = class(TInterfacedObject, IPlugInInterface)
protected // IPlugInInterface Members
    procedure Test; stdcall;
end;

var
g_PlugIn : IPlugInInterface; // з0чем глобальный? он один для всех?

implementation

procedure TPlugInInterface.Test;
begin
MessageBox(0, "Test", nil, MB_OK);
end;

initialization

finalization
 g_PlugIn := nil;
 
end.

///////////////////////////////////////////////////////////////////////

library GOES337;

uses
Windows,
Forms,
uInterface in "uInterface.pas";

procedure LoadPlugIn(const App : TApplication; out p: IPlugInInterface);
var
pit : PInterfaceTable;
begin
Application := App;
if g_PlugIn = nil then
 try
   g_PlugIn := TPlugInInterface.Create as IPlugInInterface;
 except
   g_PlugIn := nil;
 end
p := g_PlugIn
end;

exports
LoadPlugIn;

begin
end.

----
var
 zzz: IPlugInInterface;
...
@tempLProc    := GetProcAddress(tempLibHandle, "LoadPlugIn");
tempLProc(Application, zzz);
if zzz <> nil zzz.Test;


 
DiamondShark ©   (2006-05-08 17:46) [4]


> Поэтому на данную функцию поставил "заглушку"

Эта функция обязана быть реализована.
Какой, нафиг, S_OK, если не возвращается корректная ссылка на интерфейс?!

Заглушка, если уж на то пошло, должна быть такой:

function TPlugInInterface.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
Pointer(Obj) := nil;
Result := E_FAIL;
end;

Только такая "заглушка" означает отсутствие реализации каких-бы то ни было интерфейсов...
Даже (гы!) IUnknown %-) Иными, словами, бред


 
Sphinx ©   (2006-05-08 17:50) [5]

2 DiamondShark ©
Значит без GUID не обойтись ???
Спасибо...буду искать какой-нибудь другой путь =)


 
DiamondShark ©   (2006-05-08 17:57) [6]


> Значит без GUID не обойтись ???
> Спасибо...буду искать какой-нибудь другой путь =)

Нет. Никак. TObject.GetInterface ищет в таблице интерфейсов именно по IID.

А чем он так напугал?


 
Sphinx ©   (2006-05-08 18:08) [7]

Да не напугал...
Просто интересно, вот на С++ следующий код вполне работает:
   interface ICustomInterface: public IUnknown
   {
       public:
           // увеличение количества ссылок на класс
           virtual GEjiULONG __stdcall AddRef()
               {
                   InterlockedIncrement(&m_lRef);
                   return m_lRef;
               };

           // уменьшение количества ссылок на класс
           // как только количество ссылок становится равным нулю
           // класс автоматически удаляется
           virtual GEjiULONG __stdcall Release()
               {
                   InterlockedDecrement(&m_lRef);
                   if ((m_lRef == 0) || (m_lRef < 0))
                   {
                       delete this;
                       return 0;
                   }
                   else
                       return m_lRef;
               };

           // получение интерфейса, унастледовано от IUnknown
           virtual HRESULT __stdcall QueryInterface(REFIID riid, GEjiVOID_PTR* ppv)
               {
                   // заглушка
                   ppv = NULL;
                   return GEji_OK;
               };

           GEjiLONG m_lRef;
   };

И смущает, что для полноценного СОМ-сервера GUID необходимо регистрировать в реестре (чего бы не хотелось).
Хотя на счет регистрации - может я и недопонял...
Если я вручную загружаю .dll - то наверно GUID в реестр писать не надо ???


 
DiamondShark ©   (2006-05-08 18:31) [8]

Не надо ничего регистрировать.

Базовая реализация IUnknown -- часть RTL дельфи, забудьте про ужасы Ц++



Страницы: 1 вся ветка

Текущий архив: 2006.06.18;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.043 c
15-1148318340
TUser
2006-05-22 21:19
2006.06.18
"Доктор Живаго"


2-1149168121
Revan
2006-06-01 17:22
2006.06.18
Listbox


3-1145611175
Boojum
2006-04-21 13:19
2006.06.18
Delphi +MySQL через ADO+ODBC проблемы с залогиниванием HELP!!!


1-1147243260
Шмель
2006-05-10 10:41
2006.06.18
Перегрузка операторов в Delphi


2-1149078542
zxcv
2006-05-31 16:29
2006.06.18
array to image