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