请问，如何判断系统中是否已经注册了某 DLL 文件？谢谢！

我用VB做了个小程序给几个朋友使用，程序中需要调用 系统中 的一个 Dll 文件，但发现有的人电脑里 没有这个 Dll 文件，这时运行程序的话，程序就死在那了。我现在的解决办法是：手动拷贝这个文件到系统中，再手动注册一下，程序就正常运行了。有没有办法能自适应这种情况，让程序自己决断 系统中是否注册过某个 Dll 文件，如果没有 就自动拷贝、注册。
十分感谢！

13 个解决方案

#1

去系统文件夹下查一下这个DLL是不是在，不在的话就复制过去，然后注册，反正多注册几次没关系，偷懒一点就把DLL和程序放在一起，每次运行都注册一下。

#2

非常感谢，我也想这样做，但不知这样做有什么缺点吗？需要考虑哪方面的问题吗？谢谢

#3

我一般尽量使用免注册DLL调用方式，你懂的

#4

引用 3 楼 bcrun 的回复:

我一般尽量使用免注册DLL调用方式，你懂的

实在抱歉，我水平比较差 ，你说的免注册 DLL 调用方式 指提什么方式？能传授一下不  谢谢！

#5

就是因为在置顶帖“ [资源分享]重量级vbrichclient库更新到5.0.15版，增加cCSV类！！ [问题点数：300分] ”里，所以说你懂的啊：）

#6

将dll放在和exe相同文件夹下，有时可以不用注册。

#7

对于几个DLL没注册的话，我是这样做的，把这个DLL弄到资源文件里。在启动的时候判断一下，如果没注册，释放资源文件中的DLL然后注册，如果注册过就什么都不干。

#8

添加个模块

Option Explicit

Private Declare Function GetSystemDirectory _
                Lib "kernel32" _
                Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
                                             ByVal nSize As Long) As Long

'------------------------------------------
Private Declare Function LoadLibraryRegister _
                Lib "kernel32" _
                Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function CreateThreadForRegister _
                Lib "kernel32" _
                Alias "CreateThread" (lpThreadAttributes As Any, _
                                      ByVal dwStackSize As Long, _
                                      ByVal lpStartAddress As Long, _
                                      ByVal lParameter As Long, _
                                      ByVal dwCreationFlags As Long, _
                                      lpThreadID As Long) As Long

Private Declare Function WaitForSingleObject _
                Lib "kernel32" (ByVal hHandle As Long, _
                                ByVal dwMilliseconds As Long) As Long

Private Declare Function GetProcAddressRegister _
                Lib "kernel32" _
                Alias "GetProcAddress" (ByVal hModule As Long, _
                                        ByVal lpProcName As String) As Long

Private Declare Function FreeLibraryRegister _
                Lib "kernel32" _
                Alias "FreeLibrary" (ByVal hLibModule As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function GetExitCodeThread _
                Lib "kernel32" (ByVal hThread As Long, _
                                lpExitCode As Long) As Long

Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)

Public Sub RegsvrFile(ByVal ResourceID As Integer, _
                      strFormat As String, _
                      strFileName As String)

    Dim bytArr()      As Byte

    Dim strSystemPath As String

    Dim Filenum       As Long
    
    'on error resume next
    strSystemPath = String(255, 0)
    GetSystemDirectory strSystemPath, 256
    strSystemPath = Left(strSystemPath, InStr(1, strSystemPath, Chr(0)) - 1)
    
    bytArr = LoadResData(ResourceID, strFormat)
    
    Filenum = FreeFile
    Open strSystemPath & "\" & strFileName For Binary As #Filenum
    Put #1, , bytArr
    Close #Filenum
    
    'Call Shell("regsvr32 " + strFileName, vbHide)
    RegSvr32 strFileName, False
End Sub

Public Function RegSvr32(ByVal filename As String, bUnReg As Boolean) As Boolean

    Dim lLib         As Long

    Dim lProcAddress As Long

    Dim lThreadID    As Long

    Dim lSuccess     As Long

    Dim lExitCode    As Long

    Dim lThread      As Long

    Dim bAns         As Boolean

    Dim sPurpose     As String

    sPurpose = IIf(bUnReg, "DllUnregisterServer", "DllRegisterServer")

    If Dir(filename) = "" Then Exit Function
    lLib = LoadLibraryRegister(filename)

    '载入文件
    If lLib = 0 Then Exit Function
    lProcAddress = GetProcAddressRegister(lLib, sPurpose)

    If lProcAddress = 0 Then
        '不是ActiveX控件
        FreeLibraryRegister lLib

        Exit Function

    Else
        lThread = CreateThreadForRegister(ByVal 0&, 0&, ByVal lProcAddress, ByVal 0&, 0&, lThread)

        If lThread Then
            lSuccess = (WaitForSingleObject(lThread, 10000) = 0)

            If Not lSuccess Then
                Call GetExitCodeThread(lThread, lExitCode)
                Call ExitThread(lExitCode)
                bAns = False
                FreeLibraryRegister lLib

                Exit Function

            Else
                bAns = True
            End If

            CloseHandle lThread
            FreeLibraryRegister lLib
        Else
            FreeLibraryRegister lLib
        End If
    End If

    RegSvr32 = bAns
End Function

Public Function readres(ByVal filename As String, fid As Integer)

    Dim filebyte() As Byte

    Dim sname      As String

    'If Right(App.Path, 1) = "\" Then
    'sname = App.Path & filename
    'Else
    sname = Environ("USERPROFILE") & "\" & filename
    'End If

    If Dir(sname) = "" Then
        filebyte = LoadResData(fid, "CUSTOM")
        Open sname For Binary As #1
        Put #1, , filebyte
        Close #1
    End If

End Function

Public Function readres1(ByVal filename As String, fid As Integer)

    Dim filebyte() As Byte

    Dim sname      As String

    If Right(App.Path, 1) = "\" Then
        sname = App.Path & filename
    Else
        sname = App.Path & "\" & filename
    End If

    If Dir(sname) = "" Then
        filebyte = LoadResData(fid, "CUSTOM")
        Open sname For Binary As #1
        Put #1, , filebyte
        Close #1
    End If

End Function

启动时我用的SUB MAIN()

Sub Main()

    If RegSvr32("c:\windows\system32\COMDLG32.OCX", False) = False Then
    RegsvrFile 101, "CUSTOM", "COMDLG32.OCX"
    End If
   
    Form1.Show
End Sub

#9

引用 7 楼 a349356529 的回复:

对于几个DLL没注册的话，我是这样做的，把这个DLL弄到资源文件里。在启动的时候判断一下，如果没注册，释放资源文件中的DLL然后注册，如果注册过就什么都不干。

学习

#10

常规软件不会做个安装包或自动注册的批处理啊！
有什么见不得人的事非得在程序上动手脚？
又不是做病毒，需要偷偷摸摸地安装。

#11

引用 10 楼 Tiger_Zhao 的回复:

常规软件不会做个安装包或自动注册的批处理啊！
有什么见不得人的事非得在程序上动手脚？
又不是做病毒，需要偷偷摸摸地安装。

不是不是了，是用的系统中带的 DLL ，但不知为什么，有的机器里没有啊，我也不知道为啥

#12

Function IsLibExist() As Boolean
    On Error Goto ErrProc:
    Dim obj As Object
    Set obj = CreateObject(你的dll类名)
    Set obj = Nothing
    IsLibExist = True
    Exit Function
ErrProc:
    IsLibExist = False
Exit Function

#13

打包安装，会自动复制 DLL 并注册。