用delphi制作无界面的activex控件

曾经终败给现在 2021-11-23 18:34 342阅读 0赞

首先，您要了解：
    •COM的基本原理
    •能被网页调用的非可视ActiveX控件必须是一种至少实现了IOleObject接口的TAutoObject组件
    •利用Delphi向导生成的ActiveX控件必须继承自WinControl，所以您不能用Delphi向导生成非可视的ActiveX控件
    
     以下例子，实现了一个非可视ActiveX，调用此控件的exeWB，相当于调用IE的打印，预览，页面设置等功能。再此基础上，还可以扩展其它的功能。
    
    制作步骤：
    
    1.打开delphi,新建一个ActiveX包。   File|new|other...|ActiveX|AxtiveX library 2.利用delphi向导，添加一个Automation Object。   File|new|other...|ActiveX|Automation Object   我这个项目叫WebPrint 3.在接下来弹出的TLB编辑窗口里面定义自己需要的接口函数   我添加需要的接口IWebPrint.print(),IWebPrint.preview()等 4.实现IOleObject接口，将代码改成如下形式,红色为修改部分      将Windows添加到uses引用   uses   ComObj, ActiveX, Project1_TLB, Windows;     修改   TWebPrint = class(TAutoObject,IWebPrint)   为   TWebPrint = class(TAutoObject,IOleObject , IWebPrint)     添加下段代码到TWebPrint的private段     private     FOleClientSite: IOleClientSite;
    
      添加下段代码到TWebPrint的public段
    
    public
    
        {
         IOleObject}     
    　　function SetClientSite(const clientSite: IOleClientSite): HResult;stdcall;
    function GetClientSite(out clientSite: IOleClientSite): HResult;stdcall;
    function SetHostNames(szContainerApp: POleStr;szContainerObj: POleStr): HResult; stdcall;
    function Close(dwSaveOption: Longint): HResult; stdcall;
    function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;stdcall;
    function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;out mk: IMoniker): HResult; stdcall;
    function InitFromData(const dataObject: IDataObject; fCreation: BOOL;dwReserved: Longint): HResult; stdcall;
    function GetClipboardData(dwReserved: Longint;out dataObject: IDataObject): HResult; stdcall;
    function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;stdcall;
    function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;
    function Update: HResult; stdcall;
    function IsUpToDate: HResult; stdcall;
    function GetUserClassID(out clsid: TCLSID): HResult; stdcall;
    function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;stdcall;
    function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;stdcall;
    function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;stdcall;
    function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;stdcall;
    function Unadvise(dwConnection: Longint): HResult; stdcall;
    function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
    function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;stdcall;
    function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;
    
       //在implementation段实现IOleObject的函数功能
    
    implementation
    
    {
         IOleObject}
    
    function TWebPrint.SetClientSite(const ClientSite: IOleClientSite): HResult; 
    begin   
    　　if ClientSite <> nil then
    　　   begin     
    　　　　　　if FOleClientSite <> nil then
    　　　　　　　　begin
    　　　　　　　　　　Result := E_FAIL;
    　　　　　　       Exit;
    　　　　　　　　end;
    　　　　　　　　FOleClientSite := ClientSite;
    　　　　end
    　　　　else
    　　　　begin
    　　　　　　FOleClientSite := nil;   
    　　　　end;
    　　　　Result := S_OK;
    end;
    
    function TWebPrint.GetClientSite(out clientSite: IOleClientSite): HResult;
    begin
       ClientSite := FOleClientSite;
       Result := S_OK; 
    end;
    
    function TWebPrint.SetHostNames(szContainerApp: POleStr;   szContainerObj: POleStr): HResult;
    begin
       Result := S_OK;
    end;
    
    function TWebPrint.Close(dwSaveOption: Longint): HResult; 
    begin
    　　Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult; 
    begin
       Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;   out mk: IMoniker): HResult; 
    begin
       Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.InitFromData(const dataObject: IDataObject; fCreation: BOOL;   dwReserved: Longint): HResult; 
    begin   
    　　Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.GetClipboardData(dwReserved: Longint;   out dataObject: IDataObject): HResult; 
    begin
       Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;   lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult; 
    begin
       Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; 
    begin   
    　　Result := OleRegEnumVerbs(Factory.ClassID, enumOleVerb); 
    end;
    
    function TWebPrint.Update: HResult; 
    begin
       Result := S_OK; 
    end;
    
    function TWebPrint.IsUpToDate: HResult; 
    begin   
    　　Result := S_OK; 
    end;
    
    function TWebPrint.GetUserClassID(out clsid: TCLSID): HResult; 
    begin   
    　　clsid := Factory.ClassID;   
    　　Result := S_OK; 
    end;
    
    function TWebPrint.GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult; 
    begin
       Result := OleRegGetUserType(Factory.ClassID, dwFormOfType, pszUserType); 
    end;
    
    function TWebPrint.SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult; 
    begin
       Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult; 
    begin
      Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult; 
    begin  
    　　Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.Unadvise(dwConnection: Longint): HResult; 
    begin
       Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.EnumAdvise(out enumAdvise: IEnumStatData): HResult; 
    begin
      Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult; 
    begin
       Result := E_NOTIMPL; 
    end;
    
    function TWebPrint.SetColorScheme(const logpal: TLogPalette): HResult; 
    begin
       Result := E_NOTIMPL; 
    end;
    
    5.实现您自己定义的接口函数功能
    
    {
         ITWebPrint}
    
    procedure TWebPrint.exeWB(cmdID:TOleEnum); 
    var
      spDoc:IHTMLDocument2;
      spContainer:IOleContainer;
      spIE:IWebBrowser2; 
    begin   
    　　FOleClientSite.GetContainer(spContainer);
    if not Assigned(spContainer) then   
    　　begin
    　　  messagebox(0,'此对象必须作为OLE对象使用','使用方法错误',0);     
    　　　exit;
    end;
      if spContainer.QueryInterface(IID_IHTMLDocument2,spDoc)=S_OK then
      begin
    　　 if (spDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebBrowser2, spIE)=S_OK then
        begin
    　　　　if spIE.QueryStatusWB(cmdID)=3 then
              spIE.ExecWB(cmdID, OLECMDEXECOPT_DODEFAULT,EmptyParam,EmptyParam);      
    　　end 
    　　else
    　　　　begin
             messagebox(0,'请使用IE5.5以上版本','运行环境不正确',0);
             exit;
       　　end;
    end 
    　　else
    　　 begin
    　　     messagebox(0,'找不到网页内容','使用方法错误',0);     
    　　　　　　exit;
    end;
    
    end;
    
    全部源码如下：
    
    unit Unit1;
    
    {
         $WARN SYMBOL_PLATFORM OFF}
    
    interface
    
    uses   ComObj, ActiveX, Project1_TLB, Windows;
    
    type
    
    　　TWebPrint = class(TAutoObject,IOleObject , IWebPrint) 
    　　private
    　　   FOleClientSite: IOleClientSite; 
    　　public
         {
         IOleObject}
         function SetClientSite(const clientSite: IOleClientSite): HResult; stdcall;
    function GetClientSite(out clientSite: IOleClientSite): HResult;       stdcall;     function SetHostNames(szContainerApp: POleStr;       szContainerObj: POleStr): HResult; stdcall;     function Close(dwSaveOption: Longint): HResult; stdcall;     function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;       stdcall;     function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;       out mk: IMoniker): HResult; stdcall;     function InitFromData(const dataObject: IDataObject; fCreation: BOOL;       dwReserved: Longint): HResult; stdcall;     function GetClipboardData(dwReserved: Longint;       out dataObject: IDataObject): HResult; stdcall;     function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;       lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;       stdcall;     function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;     function Update: HResult; stdcall;     function IsUpToDate: HResult; stdcall;     function GetUserClassID(out clsid: TCLSID): HResult; stdcall;     function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;       stdcall;     function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;       stdcall;     function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;       stdcall;     function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;       stdcall;     function Unadvise(dwConnection: Longint): HResult; stdcall;     function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;     function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;       stdcall;     function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;         {
         IWebPrint}     procedure exeWB(cmdID:TOleEnum);
    
    implementation
    
    {
         IOleObject}
    
    function TWebPrint.SetClientSite(const ClientSite: IOleClientSite): HResult; begin   if ClientSite <> nil then   begin     if FOleClientSite <> nil then     begin       Result := E_FAIL;       Exit;     end;     FOleClientSite := ClientSite;   end else   begin     FOleClientSite := nil;   end;   Result := S_OK; end;
    
    function TWebPrint.GetClientSite(out clientSite: IOleClientSite): HResult; begin   ClientSite := FOleClientSite;   Result := S_OK; end;
    
    function TWebPrint.SetHostNames(szContainerApp: POleStr;   szContainerObj: POleStr): HResult; begin   Result := S_OK; end;
    
    function TWebPrint.Close(dwSaveOption: Longint): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;   out mk: IMoniker): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.InitFromData(const dataObject: IDataObject; fCreation: BOOL;   dwReserved: Longint): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.GetClipboardData(dwReserved: Longint;   out dataObject: IDataObject): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;   lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; begin   Result := OleRegEnumVerbs(Factory.ClassID, enumOleVerb); end;
    
    function TWebPrint.Update: HResult; begin   Result := S_OK; end;
    
    function TWebPrint.IsUpToDate: HResult; begin   Result := S_OK; end;
    
    function TWebPrint.GetUserClassID(out clsid: TCLSID): HResult; begin   clsid := Factory.ClassID;   Result := S_OK; end;
    
    function TWebPrint.GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult; begin   Result := OleRegGetUserType(Factory.ClassID, dwFormOfType, pszUserType); end;
    
    function TWebPrint.SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult; begin  Result := E_NOTIMPL; end;
    
    function TWebPrint.Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult; begin  Result := E_NOTIMPL; end;
    
    function TWebPrint.Unadvise(dwConnection: Longint): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.EnumAdvise(out enumAdvise: IEnumStatData): HResult; begin  Result := E_NOTIMPL; end;
    
    function TWebPrint.GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult; begin   Result := E_NOTIMPL; end;
    
    function TWebPrint.SetColorScheme(const logpal: TLogPalette): HResult; begin   Result := E_NOTIMPL; end;
    
    {
         ITWebPrint}
    
    procedure TWebPrint.exeWB(cmdID:TOleEnum); 
    var     
    　　spDoc:IHTMLDocument2;
       spContainer:IOleContainer;
    　　spIE:IWebBrowser2; 
    begin   
    　　FOleClientSite.GetContainer(spContainer);
    if not Assigned(spContainer) then
       begin     
    　　　　messagebox(0,'此对象必须作为OLE对象使用','使用方法错误',0);     
    　　　　exit;
    end;
      if spContainer.QueryInterface(IID_IHTMLDocument2,spDoc)=S_OK then   
    　begin
          if (spDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebBrowser2, spIE)=S_OK then
    　　   begin
    　　      if spIE.QueryStatusWB(cmdID)=3 then
               spIE.ExecWB(cmdID, OLECMDEXECOPT_DODEFAULT,EmptyParam,EmptyParam);
          　　end 
    　　　　　　else
          begin
             messagebox(0,'请使用IE5.5以上版本','运行环境不正确',0);  
           exit;     
    end;  
    end 
    else
     begin
         messagebox(0,'找不到网页内容','使用方法错误',0);     
    　　exit;   
    end;
    
    end;

转载于:https://www.cnblogs.com/MaxWoods/p/4012966.html