如何用VB寫安全控件

總述

本文叙述了如何在VB中實作控件的IobjectSafety接口，以标志該控件是腳本安全和初始化安全的。VB控件預設的處理方式是在系統資料庫中注冊元件類來辨別其安全性，但實作IobjectSafety接口是更好的方法。本言語包括了實作過程中所需的所有代碼。

請注意，控件隻有确确實實是安全的，才能被辨別為“安全的”。本文并未論及如何確定控件的安全性，這個問題請參閱Internet Client Software Development Kit (SDK)中的相關文檔 "Safe Initialization and Scripting for ActiveX Controls"，它在Component Development 欄目中。

相關資訊：

<此處略去了一段也許無關緊要的警告>

現在開始循序漸進地舉例說明怎樣建立一個簡單的VB控件，以及怎樣将它辨別為腳本安全和初始化安全。

首先建立一個檔案夾來存放在本例中所産生的檔案。

從VB CD-ROM取得OLE 自動化類庫的制作工具。将VB安裝CD光牒中/Common/Tools/VB/Unsupprt/Typlib/目錄下所有内容一并拷貝到前面建立的項目檔案夾中。

把下列内容拷貝到“記事本”中，然後儲存到上述檔案夾，檔案名為Objsafe.odl：

[

uuid(C67830E0-D11D-11cf-BD80-00AA00575603),

helpstring("VB IObjectSafety Interface"),

version(1.0)

]

library IObjectSafetyTLB

{

importlib("stdole2.tlb");

[

uuid(CB5BDC81-93C1-11cf-8F20-00805F2CD064),

helpstring("IObjectSafety Interface"),

odl

]

interface IObjectSafety:IUnknown {

[helpstring("GetInterfaceSafetyOptions")]

HRESULT GetInterfaceSafetyOptions(

[in] long riid,

[in] long *pdwSupportedOptions,

[in] long *pdwEnabledOptions);

[helpstring("SetInterfaceSafetyOptions")]

HRESULT SetInterfaceSafetyOptions(

[in] long riid,

[in] long dwOptionsSetMask,

[in] long dwEnabledOptions);

}

}

在指令行提示符下切換到項目檔案夾，輸入下列指令建立一個.tlb 檔案：

MKTYPLIB objsafe.odl /tlb objsafe.tlb

在VB中建立一個ActiveX Control 項目。修改屬性，把項目命名為IobjSafety，控件命名為DemoCtl。在控件上放置一個按鈕，命名為cmdTest，在它的Click事件中加入一句代碼 MsgBox "Test" 。

打開菜單“工程->引用”，點“浏覽”，找到剛剛建立的Objsafe.tlb，把它加入到引用中。

增加一個新module名為basSafeCtl，并在其中加入下列代碼：

Option Explicit

Public Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"

Public Const IID_IPersistStorage = _

"{0000010A-0000-0000-C000-000000000046}"

Public Const IID_IPersistStream = _

"{00000109-0000-0000-C000-000000000046}"

Public Const IID_IPersistPropertyBag = _

"{37D84F60-42CB-11CE-8135-00AA004BB851}"

Public Const INTERFACESAFE_FOR_UNTRUSTED_CALLER = &H1

Public Const INTERFACESAFE_FOR_UNTRUSTED_DATA = &H2

Public Const E_NOINTERFACE = &H80004002

Public Const E_FAIL = &H80004005

Public Const MAX_GUIDLEN = 40

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

(pDest As Any, pSource As Any, ByVal ByteLen As Long)

Public Declare Function StringFromGUID2 Lib "ole32.dll" (rguid As _

Any, ByVal lpstrClsId As Long, ByVal cbMax As Integer) As Long

Public Type udtGUID

Data1 As Long

Data2 As Integer

Data3 As Integer

Data4(7) As Byte

End Type

Public m_fSafeForScripting As Boolean

Public m_fSafeForInitializing As Boolean

Sub Main()

m_fSafeForScripting = True

m_fSafeForInitializing = True

End Sub

在工程屬性中把啟動對象改成Sub Main確定上述代碼會被執行。m_fSafeForScripting 和m_fSafeForInitializing兩件變量的值分别指定了腳本安全和初始化安全取值。

打開控件代碼視窗，在聲明部分加入如下代碼(如果有Option Explicit語句，當然要保證代碼放在其後)：

Implements IObjectSafety

把下面兩個過程代碼拷貝到控件代碼中：

Private Sub IObjectSafety_GetInterfaceSafetyOptions(ByVal riid As _

Long, pdwSupportedOptions As Long, pdwEnabledOptions As Long)

Dim Rc As Long

Dim rClsId As udtGUID

Dim IID As String

Dim bIID() As Byte

pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or _

INTERFACESAFE_FOR_UNTRUSTED_DATA

If (riid <> 0) Then

CopyMemory rClsId, ByVal riid, Len(rClsId)

bIID = String$(MAX_GUIDLEN, 0)

Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)

Rc = InStr(1, bIID, vbNullChar) - 1

IID = Left$(UCase(bIID), Rc)

Select Case IID

Case IID_IDispatch

pdwEnabledOptions = IIf(m_fSafeForScripting, _

INTERFACESAFE_FOR_UNTRUSTED_CALLER, 0)

Exit Sub

Case IID_IPersistStorage, IID_IPersistStream, _

IID_IPersistPropertyBag

pdwEnabledOptions = IIf(m_fSafeForInitializing, _

INTERFACESAFE_FOR_UNTRUSTED_DATA, 0)

Exit Sub

Case Else

Err.Raise E_NOINTERFACE

Exit Sub

End Select

End If

End Sub

Private Sub IObjectSafety_SetInterfaceSafetyOptions(ByVal riid As _

Long, ByVal dwOptionsSetMask As Long, ByVal dwEnabledOptions As Long)

Dim Rc As Long

Dim rClsId As udtGUID

Dim IID As String

Dim bIID() As Byte

If (riid <> 0) Then

CopyMemory rClsId, ByVal riid, Len(rClsId)

bIID = String$(MAX_GUIDLEN, 0)

Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)

Rc = InStr(1, bIID, vbNullChar) - 1

IID = Left$(UCase(bIID), Rc)

Select Case IID

Case IID_IDispatch

If ((dwEnabledOptions And dwOptionsSetMask) <> _

INTERFACESAFE_FOR_UNTRUSTED_CALLER) Then

Err.Raise E_FAIL

Exit Sub

Else

If Not m_fSafeForScripting Then

Err.Raise E_FAIL

End If

Exit Sub

End If

Case IID_IPersistStorage, IID_IPersistStream, _

IID_IPersistPropertyBag

If ((dwEnabledOptions And dwOptionsSetMask) <> _

INTERFACESAFE_FOR_UNTRUSTED_DATA) Then

Err.Raise E_FAIL

Exit Sub

Else

If Not m_fSafeForInitializing Then

Err.Raise E_FAIL

End If

Exit Sub

End If

Case Else

Err.Raise E_NOINTERFACE

Exit Sub

End Select

End If

End Sub