定制DLL规避受控环境下IE浏览器控件的不安全控件警告

我们有一款长期使用的32位遗留Windows窗体应用，内嵌Web浏览器控件加载数据库中的页面（仅内部办公环境使用，安全性无需担忧）。页面中通过ActiveX对象完成操作时，创建Scripting.FileSystemObject这类实例会触发ActiveX安全警告，示例代码：

Set oFSO = CreateObject("Scripting.FileSystemObject")

计划通过开发本地安装并标记为安全的DLL消除警告，用VB.NET改写C#示例代码后，注册DLL时曾遇错误（已解决），当前精简VB.NET代码如下：

Option Strict On
Imports System.Runtime.InteropServices
Imports System.IO

Namespace API
  Public Interface IAccupay
    <DispId(1)>
    Function GetFiles(ByVal Folder As String) As List(Of String)
End Interface

<Guid("8B4B5CEF-8B3A-49A1-9053-E909F82D9E73"),
    ProgId("AddIn.Accupay"), ClassInterface(ClassInterfaceType.None),
        ComDefaultInterface(GetType(IAccupay)), ComVisible(True)>
Public Class Accupay
    Implements IAccupay

    Private Function GetFiles(Folder As String) As List(Of String) Implements IAccupay.GetFiles
        Return Directory.GetFiles(Folder).ToList
    End Function
End Class

该DLL可在VB.NET中正常调用（测试代码如下），但无法在VBScript/HTML页面中创建对象，调用代码：

Set Test = CreateObject("Test.Accupay") 

会提示错误：ActiveX Component can't create object: Test.Accupay。

另外，不知道如何实现ObjectSafetyOption来标记DLL为安全，需解决以下问题：

• 指出VBScript无法创建对象的代码问题及解决方案
• 提供ObjectSafetyOption的实现方法

一、修复VBScript无法创建对象的问题 #

1. 匹配ProgId #

代码中类的ProgId是AddIn.Accupay，但VBScript调用的是Test.Accupay，两者不匹配，修改VBScript调用代码为：

Set Test = CreateObject("AddIn.Accupay") 

2. 强制32位注册 #

宿主是32位应用，必须使用32位版本的RegAsm注册DLL，否则64位注册的COM对象无法被32位进程调用：

• 32位RegAsm路径：C:\Windows\Microsoft.NET\Framework\v4.0.30319\RegAsm.exe
• 管理员权限执行注册命令：

C:\Windows\Microsoft.NET\Framework\v4.0.30319\RegAsm.exe Z:\VBNet2017\APIInternal\APIInternal\bin\Debug\APIinternal.dll /tlb /codebase

• /codebase参数：指定DLL路径，避免COM找不到文件（内部环境使用安全风险可控）

3. 兼容VBScript数据类型 #

VBScript不支持.NET List(Of String)类型，需将接口返回值改为String()数组，修改代码：

' 接口定义
Public Interface IAccupay
    <DispId(1)>
    Function GetFiles(ByVal Folder As String) As String()
End Interface

' 类实现
Private Function GetFiles(Folder As String) As String() Implements IAccupay.GetFiles
    Return Directory.GetFiles(Folder)
End Function

二、实现ObjectSafety标记DLL为安全 #

要让内嵌浏览器信任该ActiveX，需实现IObjectSafety接口，步骤如下：

1. 定义IObjectSafety接口 #

在VB.NET代码中添加COM接口定义：

<ComImport(), Guid("CB5BDC81-93C1-11CF-8F20-00805F2CD064"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IObjectSafety
    <PreserveSig()>
    Function GetInterfaceSafetyOptions(ByVal riid As IntPtr, ByRef pdwSupportedOptions As UInteger, ByRef pdwEnabledOptions As UInteger) As Integer

    <PreserveSig()>
    Function SetInterfaceSafetyOptions(ByVal riid As IntPtr, ByVal dwOptionSetMask As UInteger, ByVal dwEnabledOptions As UInteger) As Integer
End Interface

2. 在Accupay类中实现IObjectSafety #

Public Class Accupay
    Implements IAccupay
    Implements IObjectSafety

    ' IObjectSafety常量定义
    Private Const INTERFACESAFE_FOR_UNTRUSTED_CALLER As UInteger = &H1
    Private Const INTERFACESAFE_FOR_UNTRUSTED_DATA As UInteger = &H2

    ' 实现GetInterfaceSafetyOptions
    Public Function GetInterfaceSafetyOptions(ByVal riid As IntPtr, ByRef pdwSupportedOptions As UInteger, ByRef pdwEnabledOptions As UInteger) As Integer Implements IObjectSafety.GetInterfaceSafetyOptions
        pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or INTERFACESAFE_FOR_UNTRUSTED_DATA
        pdwEnabledOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or INTERFACESAFE_FOR_UNTRUSTED_DATA
        Return 0
    End Function

    ' 实现SetInterfaceSafetyOptions
    Public Function SetInterfaceSafetyOptions(ByVal riid As IntPtr, ByVal dwOptionSetMask As UInteger, ByVal dwEnabledOptions As UInteger) As Integer Implements IObjectSafety.SetInterfaceSafetyOptions
        Return 0
    End Function

    ' 原有GetFiles实现...
End Class

3. 注册表额外配置（可选增强兼容性） #

手动添加注册表项标记控件为安全初始化和安全脚本：

1. 打开注册表编辑器（regedit），定位到HKEY_CLASSES_ROOT\CLSID\{8B4B5CEF-8B3A-49A1-9053-E909F82D9E73}\Implemented Categories（GUID为代码中类的Guid值）
2. 添加两个子项：
   • 7DD95801-9882-11CF-9FA9-00AA006C42C4（标记为安全初始化）
   • 7DD95802-9882-11CF-9FA9-00AA006C42C4（标记为安全脚本）

三、验证步骤 #

1. 编译项目时确保目标平台为x86（项目属性→生成→目标平台选择x86）
2. 用32位RegAsm重新注册DLL
3. VBScript测试：

Set Test = CreateObject("AddIn.Accupay")
Dim files = Test.GetFiles("C:\Windows\")
For Each file In files
    WScript.Echo file
Next

4. HTML页面测试（内嵌到32位窗体应用的WebBrowser控件）：

<script type="text/vbscript">
    Set Test = CreateObject("AddIn.Accupay")
    Dim files = Test.GetFiles("C:\Windows\")
    For Each file In files
        document.write(file & "<br>")
    Next
</script>

内容的提问来源于stack exchange，提问作者Fred Kerber