dll文件的注册与删除

regsvr32 dllname.dll
regsvr32/u dllname.dll

---

up

---

Function RegisterDll(strDllFileName As String, strProgID As String, strClsID As String, Optional bVerify As Boolean = True) As Long
' 函数说明
'     注册 ActiveX DLL。
'     注册校验：如果 strProgID 不为空，则注册后检查 strProgID 对应的 CLSID 是否与 strCLSID 相等，
'     如不相等，则认为未注册成功。
'
' 参数说明
'     strDllFileName    :(in) DLL 文件名，包括路径
'     strProgID         :(in) ProgID，如 "AutoYuanjuanProject.AutoYuejuan"
'     strCLSID          :(in) CLSID，如 "37048527-7337-43A8-A041-18DDA083F9F3"
'     bVerify           :(in) 是否校验注册成功，默认为是
'
' 返回值
'     0 = 正常
'     1 = 程序运行错误
'
' 算法或程序流程
'     1. regsvr32 /s /u .dll
'     2. regsvr32 /s .dll
'     3. CLSIDFromProgID
'     4. StringFromCLSID
'     5. CLSID 的 String 与 strCLSID 比较，如果相同，说明注册成功
   Dim strSystemPath       As String
   Dim strRegsvr32         As String
   Dim strCmdLine          As String
   Dim lnProcess           As Long
   Dim lnProcessID         As Long
   Dim lnExitCode          As Long
   Dim sgStartTimer        As Single
   Dim tClsID              As tp_GUID
   Dim pOLESTR             As Long
   Dim strNewClsID         As String
   Dim lnReturn            As Long
   Dim ln1                 As Long
   
   On Error GoTo err_RegisterDll
   
   ' 取得系统路径
   strSystemPath = String(MAX_PATH, Chr(0))
   lnReturn = GetSystemDirectory(strSystemPath, MAX_PATH)
   If lnReturn > 0 Then
      strSystemPath = Left(strSystemPath, lnReturn)
   Else
      ' 取得系统路径失败
      RegisterDll = 1
      Exit Function
   End If
   If Right(strSystemPath, 1) <> "/" Then strSystemPath = strSystemPath & "/"
   
   ' 计算 regsvr32.exe 的文件名
   strRegsvr32 = strSystemPath & "regsvr32.exe"
   
   ' 注册 DLL
   'strCmdLine = strRegsvr32 & " /s " & strDllFileName
   strCmdLine = strRegsvr32 & " /s """ & strDllFileName & """"
   lnProcessID = Shell(strCmdLine, vbNormalFocus)
   If lnProcessID = 0 Then
      ' 运行失败
      RegisterDll = 1
      Exit Function
   End If
   
   lnProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, lnProcessID)
   If lnProcess <> 0 Then
      sgStartTimer = Timer
      Do
          Call GetExitCodeProcess(lnProcess, lnExitCode)
          DoEvents
          DoEvents
          DoEvents
      Loop While (lnExitCode = STATUS_PENDING) And (Timer - sgStartTimer < 5)    ' 5 秒超时
      CloseHandle lnProcess
      If lnExitCode = STATUS_PENDING Then
         ' regsvr32 运行超时
         RegisterDll = 1
         Exit Function
      End If
   End If
      
   ' 校验注册结果
   If Not bVerify Then
      RegisterDll = 0
      Exit Function
   Else
      ' 计算 CLSIDFromProgID
      If strProgID = "" Then
         ' 不进行 ProgID 与 CLSID 的校验
         RegisterDll = 0
         Exit Function
      End If
      lnReturn = CLSIDFromProgID(StrPtr(strProgID), tClsID)
      If lnReturn <> 0 Then
         ' 运行失败
         RegisterDll = 1
         Exit Function
      End If
      
      ' 计算 StringFromCLSID
      strNewClsID = String(160, Chr(0))
      lnReturn = StringFromCLSID(tClsID, pOLESTR)
      If lnReturn <> 0 Then
         ' 运行失败
         RegisterDll = 1
         Exit Function
      End If
      If GetComString(pOLESTR, 100, strNewClsID) <> 0 Then
         ' 运行失败
         CoTaskMemFree pOLESTR
         RegisterDll = 1
         Exit Function
      End If
      CoTaskMemFree pOLESTR
      
      ' CLSID 的 String 与 strCLSID 比较，如果相同，说明注册成功
      If strNewClsID = strClsID Then
         RegisterDll = 0
         Exit Function
      Else
         RegisterDll = 1
         Exit Function
      End If
   End If
   
err_RegisterDll:
      
   RegisterDll = 1
   
'debug
'MsgBox "err_RegisterDll"
'Err.Clear
'On Error GoTo err_RegisterDll
'Resume Next
End Function
Function UnRegisterDll(strDllFileName As String) As Long
' 函数说明
'     注销 ActiveX DLL
'
' 参数说明
'     strDllFileName    :(in) DLL 文件名，包括路径
'
' 返回值
'     0 = 正常
'     1 = 程序运行错误
'
' 算法或程序流程
'     1 regsvr32 /s /u .dll
   Dim strSystemPath       As String
   Dim strRegsvr32         As String
   Dim strCmdLine          As String
   Dim lnReturn            As Long
   Dim lnProcessID         As Long
   
   On Error GoTo err_UnRegisterDll
   
   ' 取得系统路径
   strSystemPath = String(MAX_PATH, Chr(0))
   lnReturn = GetSystemDirectory(strSystemPath, MAX_PATH)
   If lnReturn > 0 Then
      strSystemPath = Left(strSystemPath, lnReturn)
   Else
      ' 取得系统路径失败
      UnRegisterDll = 1
      Exit Function
   End If
   If Right(strSystemPath, 1) <> "/" Then strSystemPath = strSystemPath & "/"
   
   ' 计算 regsvr32.exe 的文件名
   strRegsvr32 = strSystemPath & "regsvr32.exe"
   
   ' 注销 DLL
   strCmdLine = strRegsvr32 & " /s /u " & strDllFileName
   lnProcessID = Shell(strCmdLine, vbNormalFocus)
   If lnProcessID = 0 Then
      ' 运行失败
      UnRegisterDll = 1
      Exit Function
   End If
      
   UnRegisterDll = 0
   Exit Function
   
err_UnRegisterDll:
   UnRegisterDll = 1
   
End Function