Delphi 开发ActiveX控件(非ActiveForm)

  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打包工具可以选择使用:数字签名工具

原文地址:https://www.cnblogs.com/yryz/p/2296429.html