用delphi制作無界面的activex控件－互聯網

文章出處
首先，您要了解：
•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;