在 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完全是赶鸭子上架,有问题欢迎看到的兄弟指出来>

 

posted @ 2013-03-07 11:22  蘑菇大叔  阅读(948)  评论(0)    收藏  举报