代码改变世界

Delphi 开发ActiveX控件(非ActiveForm)

2011-12-23 16:28  一人游走  阅读(2873)  评论(1)  编辑  收藏  举报

　　Q：为什么不采用ActiveForm工程？通过它可以快速开发带窗体控件，创建过程也非常简单(都不用考虑安全接口问题)，很省事！

　　A：如果要实现的功能用不上窗口，而一个带窗口的空程序就500多KB，不便于ActiveX的发布，本实现方法可降到100多KB，CAB打包后只有几十KB； 好吧，我承认我有点体积控。

 

1. 新建一个ActiveX Library工程

　　

 

2. 在该工程中新建一个 Automation Object对象

　　

填写类名

　　

3.建一个测试方法(Test)

　　

　　

 向导会自动生成相关代码！

注意：

　　如果需要发布到Internet，还需要实现一个IObjectSafety接口，标记脚本是安全的，运行时才不会被IE阻止。如果想在线安装ActiveX控件还需要数字证书签名后才可以。

代码：

{
 * created by HouSoft
 * 2011/11/18
}
unit AXDemo_u;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, AXDemo_TLB, StdVcl,
  Windows;

type
  TAXDemoCtrl = class(TAutoObject, IAXDemoCtrl, IObjectSafety)
  private
    FObjectSafetyFlags: DWORD;
    { 实现IObjectSafety 接口用于将控件标记为安全，否则IE加载时可能会被阻止！}
    function GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions,
      pdwEnabledOptions: PDWORD): HResult; stdcall;
    function SetInterfaceSafetyOptions(const IID: TIID; dwOptionSetMask,
      dwEnabledOptions: DWORD): HResult; stdcall;
  protected
    procedure Test(const Msg: WideString); safecall;
  end;

implementation

uses ComServ;

function TAXDemoCtrl.GetInterfaceSafetyOptions(const IID: TIID;
  pdwSupportedOptions, pdwEnabledOptions: PDWORD): HResult;
var
  Unk               : IUnknown;
begin
  if (pdwSupportedOptions = nil) or (pdwEnabledOptions = nil) then
  begin
    Result := E_POINTER;
    Exit;
  end;
  Result := QueryInterface(IID, Unk);
  if Result = S_OK then
  begin
    pdwSupportedOptions^ := INTERFACESAFE_FOR_UNTRUSTED_CALLER or
      INTERFACESAFE_FOR_UNTRUSTED_DATA;
    pdwEnabledOptions^ := FObjectSafetyFlags and
      (INTERFACESAFE_FOR_UNTRUSTED_CALLER or INTERFACESAFE_FOR_UNTRUSTED_DATA);
  end
  else
  begin
    pdwSupportedOptions^ := 0;
    pdwEnabledOptions^ := 0;
  end;
end;

function TAXDemoCtrl.SetInterfaceSafetyOptions(const IID: TIID;
  dwOptionSetMask, dwEnabledOptions: DWORD): HResult;
var
  Unk               : IUnknown;
begin
  Result := QueryInterface(IID, Unk);
  if Result <> S_OK then
    Exit;
  FObjectSafetyFlags := dwEnabledOptions and dwOptionSetMask;
end;

procedure TAXDemoCtrl.Test(const Msg: WideString);
begin
  MessageBox(GetActiveWindow,
    PChar(string(Msg)),
    'ActiveX测试',
    0);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TAXDemoCtrl, Class_AXDemoCtrl,
    ciMultiInstance, tmApartment);
end.

部署测试：

<html>
<head>
<title>ActiveX Test Page</title>
</head>
<H1>ActiveX Test Page</H1>
<hr>
<p>
<body>
<object name="AXDemo" classid="clsid:C7C16439-AFF0-48A4-A22D-4655400FC4BE" codebase="AXDemo.cab#version=1,0,0,0">
</object>

<script>
function Test(){
    try
    {
        AXDemo.Test('Hello World!');
    }catch(e){
        alert('ActiveX测试失败!\r\n'+e.description);
    }
}
</script>

<a href="javascript:Test()">Hello (点我)</a>
</body>
</html>

推荐:

　　CAB打包工具可以选择使用：数字签名工具