如何在VB中实现ActiveX控件的IobjectSafety接口

如何在VB中实现ActiveX控件的IobjectSafety接口      
   
   
  总述  
  本文叙述了如何在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安装光盘中\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  
  保存后，把工程编译成OCX文件。现在控件已经实现了IObjectSafety   接口。在.htm中加入这件控件试一试吧。