2000的系统,计算机管理中的用户管理显示红×,并提示:无法访问计算机xxx.错误是:库没有注册

以前在CSDN上提交的FAQ，现CSDN的FAQ只有CSDN用户才能正常访问，也不能通过搜索引擎来搜索CSDN的FAQ，固转到BLOG。
http://faq.csdn.net/FAQUnfurl.aspx?id=206651

运行用户管理(usrmgr.msc)时会加载activeds.dll
文件共享权限管理时会加载activeds.tlb
尝试将activeds.tlb删除就会出现同样问题，所以估计就是activeds.tlb没注册。

到网上找了段代码，然后在问题机上把activeds.tlb注册后，问题得到解决。 

 

Option     Explicit    
   '    
   '    Brad   Martinez,   http://www.mvps.org   
   '    
  Declare    Function    LoadTypeLib   Lib    " oleaut32 "    _   
                                                              (ByVal   szFileName    As     String ,   _   
                                                              lplptlib    As    Any)    As     Long         '    lplptlib   As   Long   
    
  Declare    Function    RegisterTypeLib   Lib    " oleaut32 "    _   
                                                              (ByVal   ptlib    As    Any,   _   
                                                              ByVal   szFullPath    As     String ,   _   
                                                              ByVal   szHelpDir    As     String )    As     Long    
    
  Declare    Function    UnRegisterTypeLib   Lib    " oleaut32 "    _   
                                                              (GUID    As    GUID,   _   
                                                              ByVal   wVerMajor    As     Long ,   _   
                                                              ByVal   wVerMinor    As     Long ,   _   
                                                              ByVal   lcid    As     Long ,   _   
                                                              ByVal   SYSKIND    As    SYSKIND)    As     Long    
    
   Public     Const    S_OK    =     0         '    indicates   successful   HRESULT   
    
   '    "Error   accessing   the   OLE   registry."   Typically   means   that   
   '    the   GUID   passed   to   UnRegisterTypeLib   wasn't   found   in   
   '    the   registry   (i.e   the   typelib   was   already   unregistered)   
   Public     Const    TYPE_E_REGISTRYACCESS    =     & H8002801C   
    
  Declare    Sub    MoveMemory   Lib    " kernel32 "    Alias    " RtlMoveMemory "    (pDest    As    Any,   pSource    As    Any,   ByVal   dwLength    As     Long )   
  Declare    Function    LocalAlloc   Lib    " kernel32 "    (ByVal   uFlags    As     Long ,   ByVal   uBytes    As     Long )    As     Long    
  Declare    Function    LocalSize   Lib    " kernel32 "    (ByVal   hMem    As     Long )    As     Long    
  Declare    Function    LocalFree   Lib    " kernel32 "    (ByVal   hMem    As     Long )    As     Long    
    
   '    LocalAlloc   uFlags   values   
   Public     Const    LMEM_FIXED    =     & H0   
   Public     Const    LMEM_ZEROINIT    =     & H40   
   Public     Const    LPTR    =    (LMEM_FIXED    Or    LMEM_ZEROINIT)   
    
  Declare    Function    FormatMessage   Lib    " kernel32 "    Alias    " FormatMessageA "    _   
                                                          (ByVal   dwFlags    As    FM_dwFlags,   _   
                                                          lpSource    As    Any,   _   
                                                          ByVal   dwMessageId    As     Long ,   _   
                                                          ByVal   dwLanguageId    As     Long ,   _   
                                                          ByVal   lpBuffer    As     String ,   _   
                                                          ByVal   nSize    As     Long ,   _   
                                                          Arguments    As    Any)    As     Long    
        
   Public    Enum   FM_dwFlags   
   '      FORMAT_MESSAGE_ALLOCATE_BUFFER   =   &H100   
   '      FORMAT_MESSAGE_ARGUMENT_ARRAY   =   &H2000   
   '      FORMAT_MESSAGE_FROM_HMODULE   =   &H800   
   '      FORMAT_MESSAGE_FROM_STRING   =   &H400   
      FORMAT_MESSAGE_FROM_SYSTEM    =     & H1000   
      FORMAT_MESSAGE_IGNORE_INSERTS    =     & H200   
      FORMAT_MESSAGE_MAX_WIDTH_MASK    =     & HFF   
   End    Enum   
    
   '    FormatMessage   dwLanguageId   value   
   Public     Const    LANG_USER_DEFAULT    =     & H400 &    
   '    
    
   '    Registers   the   specified   typelib.   
    
   '        sTypelibPath     -   typelib's   path,   either   explicit,   or   relative   if   the   system   can   find   it   
   '        sHelpPath             -   typelib's   help   file   path,   should   be   explicit   
   '        fSilent                         -   specifies   that   a   messagebox   will   not   be   shown   indicating   the   result   of   the   function   
    
   '    Returns   True   on   success,   False   otherwise.   
    
   Public     Function    RegTypelib(sTypelibPath    As     String ,   _   
                                                                                          Optional   sHelpPath    As     String     =    vbNullChar,   _   
                                                                                          Optional   fSilent    As     Boolean     =     False )    As     Boolean    
       Dim    hr    As     Long    
   '      Dim   lptlb   As   Long   
       Dim    itlb    As    ITypeLib   
        
      hr    =    LoadTypeLib(StrConv(sTypelibPath,   vbUnicode),   itlb)   
       If    (hr    =    S_OK)    Then    
          hr    =    RegisterTypeLib(itlb,   StrConv(sTypelibPath,   vbUnicode),   _   
                                                                                              StrConv(sHelpPath,   vbUnicode))   
       End     If    
            
       If    (fSilent    =     False )    Then    
           If    (hr    =    S_OK)    Then    
               MsgBox     " Successfully   registered    "     &    sTypelibPath   
              RegTypelib    =     True    
           Else    
               MsgBox     " Failed   to   register    "     &    sTypelibPath    &    _   
                                          vbCrLf    &    vbCrLf    &    GetAPIErrStr(hr),   vbExclamation   
           End     If    
       End     If    
        
   End     Function    
    
   '    Unregisters   the   specified   typelib.   
   '        sTypelibPath     -   typelib's   path,   either   explicit,   or   relative   if   the   system   can   find   it   
   '        fSilent                         -   specifies   that   a   messagebox   will   not   be   shown   indicating   the   result   of   the   function   
    
   '    Returns   True   on   success,   False   otherwise.   
    
   Public     Function    UnregTypelib(sTypelibPath    As     String ,   _   
                                                                                                Optional   fSilent    As     Boolean     =     False )    As     Boolean    
       Dim    hr    As     Long    
       Dim    itlb    As    ITypeLib   
       Dim    lptlba    As     Long    
       Dim    tlba    As    TLIBATTR   
        
      hr    =    LoadTypeLib(StrConv(sTypelibPath,   vbUnicode),   itlb)   
       If    (hr    =    S_OK)    Then    
    
   '    can't   do   this   since   VB   DWORD   aligns   the   struct   !!!   (it   has   3   WORD   members)   
   '          If   itlb.GetLibAttr(tlba)   =   S_OK   Then   
            
           '    allocate   memory   for   the   TLIBATTR   struct   
          lptlba    =    LocalAlloc(LPTR,    Len (tlba))   
          hr    =    Err.LastDllError   
           If    lptlba    Then    
                
               '    Fill   the   struct's   pointer   
              hr    =    itlb.GetLibAttr(lptlba)   
               If    (hr    =    S_OK)    Then    
                    
                   '    Fill   the   struct   from   its   pointer   
                   '    VB   doesn't   DWORD   align   the   struct   on   this   call...   (?)   
                  MoveMemory   tlba,   ByVal   lptlba,    Len (tlba)   
                    
                   '    Unregister   the   typelib   using   the   info   from   the   TLIBATTR   struct   
                   With    tlba   
                      hr    =    UnRegisterTypeLib(.GUID,   .wMajorVerNum,   .wMinorVerNum,   .lcid,   .SYSKIND)   
                   End     With    
    
                   '    Don't   do   this   since   we're   de-allocating   
                   '    below   what   we   allocated   above   
   '                  Call   itlb.ReleaseTLibAttr(tlba)   
   '                  Set   itlb   =   Nothing   
               End     If    
                
               Call    LocalFree(lptlba)   
            
           End     If         '    lptlba   
       End     If         '    LoadTypeLib   
        
       If    (fSilent    =     False )    Then    
           If    (hr    =    S_OK)    Then    
               MsgBox     " Successfully   unregistered    "     &    sTypelibPath   
              UnregTypelib    =     True    
           ElseIf    (hr    =    TYPE_E_REGISTRYACCESS)    Then    
               MsgBox     " Type   library   is   not   registered:    "     &    sTypelibPath   
           Else    
               MsgBox     " Failed   to   unregister    "     &    sTypelibPath    &    _   
                                          vbCrLf    &    vbCrLf    &    GetAPIErrStr(hr),   vbExclamation   
           End     If    
       End     If    
        
      UnregTypelib    =    (hr    =    S_OK)   
        
   End     Function    
    
   '    Returns   the   system-defined   description   of   an   API   error   code   
    
   Public     Function    GetAPIErrStr(dwErrCode    As     Long )    As     String    
       Dim    sErrDesc    As     String     *     256         '    max   string   resource   len   
        
       If    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM    Or    _   
                                                                  FORMAT_MESSAGE_IGNORE_INSERTS    Or    _   
                                                                  FORMAT_MESSAGE_MAX_WIDTH_MASK,   _   
                                                                  ByVal    0 & ,   dwErrCode,   LANG_USER_DEFAULT,   _   
                                                                  ByVal   sErrDesc,    256 ,    0 )    Then    
        
          GetAPIErrStr    =     Left $(sErrDesc,    InStr (sErrDesc,   vbNullChar)    -     1 )   
       End     If    
   End     Function