| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как получить интерфейс класса ? [D7, WinXP]

Sphinx ©   (2006-05-08 17:18:00) 

Имеется динамическая библиотека, в которой содержится примерно следующий код:
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;
Код примерный и довольно кривой, написан что бы разобраться как же можно получить интерфейс из библиотеки.

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

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

---

DiamondShark   (2006-05-08 18:31:00) [1]

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

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

---

Sphinx   (2006-05-08 18:08:00) [2]

Да не напугал...
Просто интересно, вот на С++ следующий код вполне работает:
   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 17:57:00) [3]

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

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

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

---

Sphinx   (2006-05-08 17:50:00) [4]

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

---

DiamondShark   (2006-05-08 17:46:00) [5]

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

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

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

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

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

---

DiamondShark   (2006-05-08 17:42:00) [6]

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

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;

---

Sphinx   (2006-05-08 17:41:00) [7]

2 jack128 ©   (08.05.06 17:36) [1]
В курсе...
> Код примерный и довольно кривой, написан что бы разобраться
> как же можно получить интерфейс из библиотеки.
Мне не нужен полный СОМ, мне желательно получить интерфейс прямо из функции в библиотеке не используя GID...
Поэтому на данную функцию поставил "заглушку"

---

jack128   (2006-05-08 17:36:00) [8]

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

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

---

Наверх