Проблемы с OleCreate и реализацией IOleClientSite

[polymorph]

Здравствуйте!

Пытаюсь перетащить реализацию cwebpage http://www.codeproject.com/KB/COM/cwebpage.aspx на родной fp. Хочу всё сделать не так, как в исходном примере - интерфейсы на структурах, а используя концепцию интерфейсов фрипаскаля.

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

Ошибка возникает при вызове OleCreate(...) - Access violation ... . Судя по всему, накосячил с реализацией интерфейсов, а где понять не могу.

Если кто-либо сталкивался с аналогичной проблемой - ткните носом пожалуйста.
Заранее спасибо.

Основной модуль:

Код: Выделить всё

...
// Глобальные переменные
var
    HostWnd: HWND;
    iost: IStorage;
    iocs: IOleClientSite;
    ioips: IOleInPlaceSite;
    ioipf: IOleInPlaceFrame;

    browserObject: IOleObject;
    webBrowser2: IWebBrowser2;

    hr: WINOLEAPI;
...

    HostWnd := Panel1.Handle; // Хоститься будет на панель

    iost := TOleStorage.Create();
    iocs := TOleClientSite.Create();
    ioips := TOleInPlaceSite.Create();
    ioipf := TOleInPlaceFrame.Create();

    hr := OleCreate(CLSID_WebBrowser, IID_IOleObject, OLERENDER_DRAW, nil, iocs, iost, browserObject);

    if hr = S_OK then MessageBox(Form1.Handle, 'S_OK', 'Mess', MB_OK);
...


Модуль с реализацией IStorage

Код: Выделить всё

unit OleStorage;

{$mode DELPHI}

interface

uses
  Windows, ActiveX, ComObj, Ole2;

type
    TOleStorage = class(TInterfacedObject, IStorage)
    protected
       function QueryInterface(constref iid: tguid; out obj): longint; stdcall;
       function _AddRef: longint; stdcall;
       function _Release: longint; stdcall;

       Function CreateStream(pwcsname:POleStr;GrfMode,Reserved1,Reserved2 : DWord; Out stm : IStream):HResult; StdCall;
       Function OpenStream(pwcsname:POleStr;Reserved1:Pointer;GrfMode,Reserved2 : DWord; Out stm : IStream):HResult; StdCall;
       Function CreateStorage(pwcsname:POleStr;GrfMode,Reserved1,Reserved2 : DWord; Out stm : IStorage):HResult; StdCall;
       Function OpenStorage(pwcsname:POleStr;Const stgPriority:IStorage;grfmode : DWord;Const SNBExclude :SNB;reserved:DWord;Out stm : IStorage):HResult; StdCall;
       Function CopyTo(ciidExclude:DWord; rgiidexclude:piid; const snbexclude:SNB;const pstg : IStorage):HResult;StdCall;
       Function MoveElementTo(wcsName:POleStr;Const pstgDest : IStorage;
                                wcvsNewName:POleStr; GrfFlags:DWord):Hresult; StdCall;
       Function Commit(grfCommitFlags:Dword):Hresult; StdCall;
       Function Revert:HResult; StdCall;
       Function EnumElements(Reserved1 :Dword;Reserved2:Pointer;Reserved3:DWord;Out penum:IEnumStatStg):HResult;StdCall;
       Function RemoteEnumElements(Reserved1 :Dword;cbReserved2:ULong;Reserved2:pbyte;reserved3:DWord;Out penum:IEnumStatStg):HResult;StdCall;
       Function DestroyElement(wcsName: POleStr):HResult;StdCall;
       Function RenameElement(wcsoldName: POleStr;wcsnewName: POleStr):HResult;StdCall;
       Function SetElementTimes(wcsName:POleStr; Const pctime,patime,pmtime : FileTime):HResult;StdCall;
       Function SetClass(Const ClasId: TClsID):HResult;StdCall;
       Function SetStateBits(grfStateBits:DWord;grfMask:DWord):HResult;StdCall;
       Function Stat(Out pStatStg:StatStg;grfStatFlag:DWord):HResult;StdCall;
    end;


implementation


function TOleStorage.QueryInterface(constref iid: tguid; out obj): longint; stdcall;
begin
    Result := E_NOTIMPL;
end;

function TOleStorage._AddRef: longint; stdcall;
begin
    Result := 1;
end;

function TOleStorage._Release: longint; stdcall;
begin
    Result := 1;
end;

Function TOleStorage.CreateStream(pwcsname:POleStr;GrfMode,Reserved1,Reserved2 : DWord; Out stm : IStream):HResult; StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.OpenStream(pwcsname:POleStr;Reserved1:Pointer;GrfMode,Reserved2 : DWord; Out stm : IStream):HResult; StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.CreateStorage(pwcsname:POleStr;GrfMode,Reserved1,Reserved2 : DWord; Out stm : IStorage):HResult; StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.OpenStorage(pwcsname:POleStr;Const stgPriority:IStorage;grfmode : DWord;Const SNBExclude :SNB;reserved:DWord;Out stm : IStorage):HResult; StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.CopyTo(ciidExclude:DWord; rgiidexclude:piid; const snbexclude:SNB;const pstg : IStorage):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.MoveElementTo(wcsName:POleStr;Const pstgDest : IStorage;
                                wcvsNewName:POleStr; GrfFlags:DWord):Hresult; StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.Commit(grfCommitFlags:Dword):Hresult; StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.Revert:HResult; StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.EnumElements(Reserved1 :Dword;Reserved2:Pointer;Reserved3:DWord;Out penum:IEnumStatStg):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.RemoteEnumElements(Reserved1 :Dword;cbReserved2:ULong;Reserved2:pbyte;reserved3:DWord;Out penum:IEnumStatStg):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.DestroyElement(wcsName: POleStr):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.RenameElement(wcsoldName: POleStr;wcsnewName: POleStr):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.SetElementTimes(wcsName:POleStr; Const pctime,patime,pmtime : FileTime):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.SetClass(Const ClasId: TClsID):HResult;StdCall;
begin
    Result := S_OK;
end;

Function TOleStorage.SetStateBits(grfStateBits:DWord;grfMask:DWord):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

Function TOleStorage.Stat(Out pStatStg:StatStg;grfStatFlag:DWord):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;


initialization

end.


Модуль с реализацией IOleClientSite

Код: Выделить всё

unit OleClientSite;

{$mode DELPHI}

interface

uses
    SysUtils, Windows, ActiveX, ComObj, Ole2,
    Global;

type
    { TOleClientSite }

    TOleClientSite = class(TInterfacedObject, IOleClientSite)
    protected
        function QueryInterface(constref iid: tguid; out obj): longint; stdcall;
        function _AddRef: longint; stdcall;
        function _Release: longint; stdcall;

        function IOleClientSite.SaveObject = IOCS_SaveObject;
        function IOleClientSite.GetMoniker = IOCS_GetMoniker;
        function IOleClientSite.GetContainer = IOCS_GetContainer;
        function IOleClientSite.ShowObject = IOCS_ShowObject;
        function IOleClientSite.OnShowWindow = IOCS_OnShowWindow;
        function IOleClientSite.RequestNewObjectLayout = IOCS_RequestNewObjectLayout;


        function IOCS_SaveObject: HResult; StdCall;
        function IOCS_GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; OUT mk: IMoniker):HResult; StdCall;
        function IOCS_GetContainer(OUT container: IOleContainer):HResult; StdCall;
        function IOCS_ShowObject:HResult; StdCall;
        function IOCS_OnShowWindow(fShow: BOOL):HResult; StdCall;
        function IOCS_RequestNewObjectLayout:HResult; StdCall;
    end;

implementation


function TOleClientSite.QueryInterface(constref iid: tguid; out obj): longint; stdcall;
begin
    if IsEqualGUID(IID_IOleClientSite, iid) or IsEqualGUID(IID_IUnknown, iid) then
    begin
        IOleClientSite(obj) := iocs;
        Result := S_OK;
        exit;
    end;

    if IsEqualGUID(IID_IOleInPlaceSite, iid) then
    begin
        IOleInPlaceSite(obj) := ioips;
        Result := S_OK;
        exit;
    end;

    Pointer(obj) := nil;
    Result := E_NOINTERFACE;
end;

function TOleClientSite._AddRef: longint; stdcall;
begin
    Result := 1;
end;

function TOleClientSite._Release: longint; stdcall;
begin
    Result := 1;
end;


function TOleClientSite.IOCS_SaveObject: HResult; StdCall;
begin
    Result := E_NOTIMPL;
end;

function TOleClientSite.IOCS_GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint; OUT mk: IMoniker):HResult; StdCall;
begin
    mk := nil;
    Result := E_NOTIMPL;
end;

function TOleClientSite.IOCS_GetContainer(OUT container: IOleContainer):HResult; StdCall;
begin
    container := nil;
    Result := E_NOINTERFACE;
end;

function TOleClientSite.IOCS_ShowObject:HResult; StdCall;
begin
    Result := NOERROR;
end;

function TOleClientSite.IOCS_OnShowWindow(fShow: BOOL):HResult; StdCall;
begin
    Result := E_NOTIMPL;
end;

function TOleClientSite.IOCS_RequestNewObjectLayout:HResult; StdCall;
begin
    Result := E_NOTIMPL;
end;


initialization

end.


Модуль с реализацией IOleInPlaceSite

Код: Выделить всё

unit OleInPlaceSite;

{$mode DELPHI}

interface

uses
    Windows, ActiveX, ComObj, Ole2,
    Global;

type
    { TOleInPlaceSite }

    TOleInPlaceSite = class(TInterfacedObject, IOleInPlaceSite)
    protected
        function QueryInterface(constref iid: tguid; out obj): longint; stdcall;
        function _AddRef: longint; stdcall;
        function _Release: longint; stdcall;

        function IOleInPlaceSite.GetWindow = IOIPS_GetWindow;
        function IOleInPlaceSite.ContextSensitiveHelp = IOIPS_ContextSensitiveHelp;

        function IOleInPlaceSite.CanInPlaceActivate = IOIPS_CanInPlaceActivate;
        function IOleInPlaceSite.OnInPlaceActivate  = IOIPS_OnInPlaceActivate;
        function IOleInPlaceSite.OnUIActivate = IOIPS_OnUIActivate;
        function IOleInPlaceSite.GetWindowContext = IOIPS_GetWindowContext;
        function IOleInPlaceSite.Scroll = IOIPS_Scroll;
        function IOleInPlaceSite.OnUIDeactivate = IOIPS_OnUIDeactivate;
        function IOleInPlaceSite.OnInPlaceDeactivate = IOIPS_OnInPlaceDeactivate;
        function IOleInPlaceSite.DiscardUndoState = IOIPS_DiscardUndoState;
        function IOleInPlaceSite.DeactivateAndUndo = IOIPS_DeactivateAndUndo;
        function IOleInPlaceSite.OnPosRectChange = IOIPS_OnPosRectChange;

        function IOIPS_GetWindow(out wnd: HWnd): HResult; stdcall;
        function IOIPS_ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;

        function IOIPS_CanInPlaceActivate : HResult;
        function IOIPS_OnInPlaceActivate : HResult;
        function IOIPS_OnUIActivate : HResult;
        function IOIPS_GetWindowContext(out ppframe:IOleInPlaceFrame;out ppdoc:IOleInPlaceUIWindow;lprcposrect:LPRECT;lprccliprect:LPRECT;lpframeinfo:LPOLEINPLACEFRAMEINFO):hresult; stdcall;
        function IOIPS_Scroll(scrollExtant:TSIZE):hresult; stdcall;
        function IOIPS_OnUIDeactivate(fUndoable:BOOL):hresult; stdcall;
        function IOIPS_OnInPlaceDeactivate :hresult; stdcall;
        function IOIPS_DiscardUndoState :hresult; stdcall;
        function IOIPS_DeactivateAndUndo :hresult; stdcall;
        function IOIPS_OnPosRectChange(lprcPosRect:LPRect):hresult; stdcall;

    end;


implementation

function TOleInPlaceSite.QueryInterface(constref iid: tguid; out obj): longint; stdcall;
begin
    if IsEqualGUID(IID_IOleClientSite, iid) or IsEqualGUID(IID_IUnknown, iid) then
    begin
        IOleClientSite(obj) := iocs;
        Result := S_OK;
        exit;
    end;

    if IsEqualGUID(IID_IOleInPlaceSite, iid) then
    begin
        IOleInPlaceSite(obj) := ioips;
        Result := S_OK;
        exit;
    end;

    Pointer(obj) := nil;
    Result := E_NOINTERFACE;
end;

function TOleInPlaceSite._AddRef: longint; stdcall;
begin
    Result := 1;
end;

function TOleInPlaceSite._Release: longint; stdcall;
begin
    Result := 1;
end;

function TOleInPlaceSite.IOIPS_GetWindow(out wnd: HWnd): HResult; stdcall;
begin
    wnd := HostWnd;
    Result := S_OK;
end;

function TOleInPlaceSite.IOIPS_ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceSite.IOIPS_CanInPlaceActivate : HResult;
begin
    Result := S_OK;
end;

function TOleInPlaceSite.IOIPS_OnInPlaceActivate : HResult;
begin
    Result := S_OK;
end;

function TOleInPlaceSite.IOIPS_OnUIActivate : HResult;
begin
    Result := S_OK;
end;

function TOleInPlaceSite.IOIPS_GetWindowContext(out ppframe: IOleInPlaceFrame; out ppdoc: IOleInPlaceUIWindow;
    lprcposrect: LPRECT; lprccliprect: LPRECT; lpframeinfo: LPOLEINPLACEFRAMEINFO):hresult; stdcall;
begin
    ppframe := ioipf;
    ppdoc := nil;

    lpframeinfo.fMDIApp := False;
    lpframeinfo.cAccelEntries := 0;
    lpframeinfo.haccel := 0;
    lpframeinfo.hwndFrame := HostWnd;

    GetClientRect(HostWnd, lprcPosRect);
   GetClientRect(HostWnd, lprcClipRect);

    Result := S_OK;
end;

function TOleInPlaceSite.IOIPS_Scroll(scrollExtant:TSIZE):hresult; stdcall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceSite.IOIPS_OnUIDeactivate(fUndoable:BOOL):hresult; stdcall;
begin
    Result := S_OK;
end;

function TOleInPlaceSite.IOIPS_OnInPlaceDeactivate :hresult; stdcall;
begin
    Result := S_OK;
end;

function TOleInPlaceSite.IOIPS_DiscardUndoState :hresult; stdcall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceSite.IOIPS_DeactivateAndUndo :hresult; stdcall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceSite.IOIPS_OnPosRectChange(lprcPosRect:LPRect):hresult; stdcall;
begin
    Result := S_OK;
end;


initialization

end.


Модуль с реализацией IOleInPlaceFrame

Код: Выделить всё

unit OleInPlaceFrame;

{$mode DELPHI}

interface

uses
  Windows, ActiveX, ComObj, Ole2,
  Global;

type

    TOleInPlaceFrame = class(TInterfacedObject, IOleInPlaceFrame)
    protected
      function QueryInterface(constref iid: tguid; out obj): longint; stdcall;
      function _AddRef: longint; stdcall;
      function _Release: longint; stdcall;

      function GetWindow(out wnd: HWnd): HResult; stdcall;
      function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;

      function GetBorder(out rectBorder: TRect):HResult;StdCall;
      function RequestBorderSpace(const borderwidths: TRect):HResult;StdCall;
      function SetBorderSpace(const borderwidths: TRect):HResult;StdCall;
      function SetActiveObject(const activeObject: IOleInPlaceActiveObject;pszObjName: POleStr):HResult;StdCall;


      function InsertMenus(hmenuShared: HMenu; var menuWidths: TOleMenuGroupWidths): HResult;StdCall;
      function SetMenu(hmenuShared: HMenu; holemenu: HMenu; hwndActiveObject: HWnd): HResult;StdCall;
      function RemoveMenus(hmenuShared: HMenu): HResult;StdCall;
      function SetStatusText(pszStatusText: POleStr): HResult;StdCall;
      function EnableModeless(fEnable: BOOL): HResult;StdCall;
      function TranslateAccelerator(var msg: TMsg; wID: Word): HResult;StdCall;
    end;


implementation


function TOleInPlaceFrame.QueryInterface(constref iid: tguid; out obj): longint; stdcall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceFrame._AddRef: longint; stdcall;
begin
    Result := 1;
end;

function TOleInPlaceFrame._Release: longint; stdcall;
begin
    Result := 1;
end;

function TOleInPlaceFrame.GetWindow(out wnd: HWnd): HResult; stdcall;
begin
    wnd := HostWnd;
    Result := S_OK;
end;

function TOleInPlaceFrame.ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
begin
    Result := E_NOTIMPL;
end;


function TOleInPlaceFrame.GetBorder(out rectBorder: TRect):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceFrame.RequestBorderSpace(const borderwidths: TRect):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceFrame.SetBorderSpace(const borderwidths: TRect):HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceFrame.SetActiveObject(const activeObject: IOleInPlaceActiveObject;pszObjName: POleStr):HResult;StdCall;
begin
    Result := S_OK;
end;


function TOleInPlaceFrame.InsertMenus(hmenuShared: HMenu; var menuWidths: TOleMenuGroupWidths): HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceFrame.SetMenu(hmenuShared: HMenu; holemenu: HMenu; hwndActiveObject: HWnd): HResult;StdCall;
begin
    Result := S_OK;
end;

function TOleInPlaceFrame.RemoveMenus(hmenuShared: HMenu): HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;

function TOleInPlaceFrame.SetStatusText(pszStatusText: POleStr): HResult;StdCall;
begin
    Result := S_OK;
end;

function TOleInPlaceFrame.EnableModeless(fEnable: BOOL): HResult;StdCall;
begin
    Result := S_OK;
end;

function TOleInPlaceFrame.TranslateAccelerator(var msg: TMsg; wID: Word): HResult;StdCall;
begin
    Result := E_NOTIMPL;
end;


initialization

end.


[polymorph]

Говорить саммому-с-собой -- плохая примета, но все же отвечу сам себе.

Ошибку я победил, всё заработало. Проблемы были в определениях интерфейсов IStorage и IOleInPlaceSite в модуле ActiveX.pp.
В IStorage - не закомментирован лишний метод RemoteEnumElements, в IOleInPlaceSite - первые три метода не имели спецификатора stdcall.

Если кому интересен вопрос, прилагаю рабочий проект приложения с прицепленным на форму WebBrowser-компонентом.
Код чисто тестовый, кошерных классов-оберток в нём нет, только проверка "а получится или нет?". Думаю что кто захочет допилит сам.

CWebPagePort.rar