在 Visual Basic 控件中实现 IObjectSafety

最近项目中要封装ocx，网上找了下，比较乱，基本就把微软的那篇文章复制了下。
这里总结下，尽量简洁，易懂：
1. 你的项目已经基本完成，或者说框架已经搭建好了。
2. 从 Visual Basic 6.0 光盘获取 OLE 自动化类型库生成器。若要执行此操作，所有四个文件从 \Common\Tools\VB\Unsupprt\Typlib\ 文件夹复制到你的项目文件夹。
（当然，也可以到这里下载TYPLIB）
3. 将以下文本复制到记事本中，并在 Objsafe.odl 的项目文件夹中保存该文件：

 

 1 [

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

 3  helpstring("VB IObjectSafety Interface"),

 4  version(1.0)

 5  ]

 6  library IObjectSafetyTLB

 7  {

 8  importlib("stdole2.tlb");

 9  [

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

11  helpstring("IObjectSafety Interface"),

12  odl

13  ]

14  interface IObjectSafety:IUnknown {

15  [helpstring("GetInterfaceSafetyOptions")]

16  HRESULT GetInterfaceSafetyOptions(

17  [in] long riid,

18  [in] long *pdwSupportedOptions,

19  [in] long *pdwEnabledOptions);

20 

21 [helpstring("SetInterfaceSafetyOptions")]

22  HRESULT SetInterfaceSafetyOptions(

23  [in] long riid,

24  [in] long dwOptionsSetMask,

25  [in] long dwEnabledOptions);

26  }

27  }

4. 打开cmd，使用cd命令进入到项目目录下，然后执行

MKTYPLIB objsafe.odl /tlb objsafe.tlb

生成.tlb 文件；
5. 在项目菜单上单击引用，浏览到并添加 Objsafe.tlb到你的项目。
6. 在你的项目中新建模块basSafeCtl，并且内容为：

 1 Option Explicit

 2 

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

 4  Public Const IID_IPersistStorage = _

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

 6  Public Const IID_IPersistStream = _

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

 8  Public Const IID_IPersistPropertyBag = _

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

10 

11 Public Const INTERFACESAFE_FOR_UNTRUSTED_CALLER = &H1

12  Public Const INTERFACESAFE_FOR_UNTRUSTED_DATA = &H2

13  Public Const E_NOINTERFACE = &H80004002

14  Public Const E_FAIL = &H80004005

15  Public Const MAX_GUIDLEN = 40

16 

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

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

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

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

21 

22 Public Type udtGUID

23  Data1 As Long

24  Data2 As Integer

25  Data3 As Integer

26  Data4(7) As Byte

27  End Type

28 

29 Public m_fSafeForScripting As Boolean

30  Public m_fSafeForInitializing As Boolean

31 

32 Sub Main()

33  m_fSafeForScripting = True

34  m_fSafeForInitializing = True

35  End Sub

7. 从项目属性，将更改为Sub Main来执行上述 Sub Main 的启动对象。
8. 打开控件的代码窗口,添加

 Implements IObjectSafety

到声明部分。
9. 在紧接着复制下面代码到代码窗口中：

 1 Private Sub IObjectSafety_GetInterfaceSafetyOptions(ByVal riid As _

 2  Long, pdwSupportedOptions As Long, pdwEnabledOptions As Long)

 3 

 4 Dim Rc As Long

 5  Dim rClsId As udtGUID

 6  Dim IID As String

 7  Dim bIID() As Byte

 8 

 9 pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or _

10  INTERFACESAFE_FOR_UNTRUSTED_DATA

11 

12 If (riid <> 0) Then

13  CopyMemory rClsId, ByVal riid, Len(rClsId)

14 

15 bIID = String$(MAX_GUIDLEN, 0)

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

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

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

19 

20 Select Case IID

21  Case IID_IDispatch

22  pdwEnabledOptions = IIf(m_fSafeForScripting, _

23  INTERFACESAFE_FOR_UNTRUSTED_CALLER, 0)

24  Exit Sub

25  Case IID_IPersistStorage, IID_IPersistStream, _

26  IID_IPersistPropertyBag

27  pdwEnabledOptions = IIf(m_fSafeForInitializing, _

28  INTERFACESAFE_FOR_UNTRUSTED_DATA, 0)

29  Exit Sub

30  Case Else

31  Err.Raise E_NOINTERFACE

32  Exit Sub

33  End Select

34  End If

35  End Sub

36 

37 Private Sub IObjectSafety_SetInterfaceSafetyOptions(ByVal riid As _

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

39  Dim Rc As Long

40  Dim rClsId As udtGUID

41  Dim IID As String

42  Dim bIID() As Byte

43 

44 If (riid <> 0) Then

45  CopyMemory rClsId, ByVal riid, Len(rClsId)

46 

47 bIID = String$(MAX_GUIDLEN, 0)

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

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

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

51 

52 Select Case IID

53  Case IID_IDispatch

54  If ((dwEnabledOptions And dwOptionsSetMask) <> _

55  INTERFACESAFE_FOR_UNTRUSTED_CALLER) Then

56  Err.Raise E_FAIL

57  Exit Sub

58  Else

59  If Not m_fSafeForScripting Then

60  Err.Raise E_FAIL

61  End If

62  Exit Sub

63  End If

64 

65 Case IID_IPersistStorage, IID_IPersistStream, _

66  IID_IPersistPropertyBag

67  If ((dwEnabledOptions And dwOptionsSetMask) <> _

68  INTERFACESAFE_FOR_UNTRUSTED_DATA) Then

69  Err.Raise E_FAIL

70  Exit Sub

71  Else

72  If Not m_fSafeForInitializing Then

73  Err.Raise E_FAIL

74  End If

75  Exit Sub

76  End If

77 

78 Case Else

79  Err.Raise E_NOINTERFACE

80  Exit Sub

81  End Select

82  End If

83  End Sub

10. 然后你就可以生成你的ocx了。。

<本人vb完全是赶鸭子上架,有问题欢迎看到的兄弟指出来>