如何在不生成Shell到VB6中的regsvr32的情况下注册/注销DLL / OCX

Question

I need to create a VB6 program to register/unregister all dll/ocx files in a given folder (which could have up to 200 such files).

This isn't a one-off task, and need to be run on hundreds of machines at different customer sites, hence the need for a tool to do it efficiently. Shelling out to regsvr32.exe is out of the question here, so no need to go into any discussion on that approach.

There is an example at http://support.microsoft.com/kb/173091 , but this requires hardcoding the name of the dll/ocx in a Declare statement, which makes it pretty much useless in our scenario.

I know the logical process goes along these lines:

1. scan the directory and enumerate all dll/ocx files in it

2. for each such file:

   2.1 call LoadLibrary to load it (exit if the call fails)

   2.2 call GetProcAddress to locate the function "DllRegisterServer" or "DllUnRegisterServer" in the current file (depending on the requested operation: register or unregister)

   2.3 if the function is not found then skip the file; else:

   2.4 call the function to register/unregister the file

   2.5 call FreeLibrary to unload the file

The problem is in step 2.4. In C/C++ based Windows API code, i can simply call the function using the function pointer returned from GetProcAddress(), but in VB6, this seems to be a lot more complicated.

I've seen two suggestions so far: 1) use CallWindowProc() 2) use CreateThread()

For 1) see: http://www.pcreview.co.uk/forums/using-callwindowproc-call-non-wndproc-functions-t2912253.html Someone went so far as to create a generic wrapper that can be used to call any API function pointer by pushing arguments onto the stack, see here http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=32873&lngWId=1

For 2), i lost the website that posted the original code, but it goes something like this:

hMod      = LoadLibrary(sFilePath)
lProcAddr = GetProcAddress(hMod, "DllRegisterServer")
hThread   = CreateThread(ByVal 0&, 0&, ByVal lProcAddr, ByVal 0&, 0&, tid)
lWaitRes  = WaitForSingleObject(hThread, 30000)  'give it 30 seconds to finish

I know these Windows APIs quite well, but am not an expert on the inner workings of VB6 and why it can't just call a simple function pointer. My questions here are:

1. Which of the two approaches is better (ie more efficient, reliable) I suspect 1) won't work if the VB code has just a Sub Main(), ie it runs in cmdline code with no GUI. But Creating a new thread just to call a function seems a bit of an overkill to me.
2. Is there a simpler way? (and no, shelling out to regsvr32.exe is not acceptable here)

Thanks.

Answer 1

There is far more to properly installing ActiveX libraries than merely calling their self-registration entrypoints. Create a proper installer instead. If any of these are shared libraries you risk doing great damage to other applications on the target systems.

Alternatively, create isolated assemblies for these libraries so no registration is needed at all.

The path you propose sounds like a recipe for DLL Hell. This sort of hacking by vocational coders is just one reason why VB (and C++) has such a poor reputation.

Seriously, hire an installation professional.

Answer 2

You can take this for what it's worth, and believe me I understand about decisions made by someone that thinks everything can be done in 2 clicks. I wrote a utility for myself to do this years ago. It also uses a checkbox to optionally suppress any result messages. This code uses a textbox for a specific file name or a wild card, creates an array of file names (with complete paths) and attempts to register all the files that match. You don't see any other programs being launched.

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Dim blnCancel As Boolean

Const WM_CLOSE = &H10
Const WM_QUIT = &H12
Const WM_SYSCOMMAND = &H112
Const WM_COMMAND = &H111
Const SC_CLOSE = &HF060


Private Sub btnRegister_Click()
    Dim aryDLL() As String
    Dim i As Integer
    Dim fName As String
    Dim fPath As String
    Dim Rtn As Double
    Dim hwnd As Long
    Dim strCommand As String

    On Error GoTo errbtnRegister

    Command2.Enabled = False
    Command1.Caption = "Cancel"

    Me.MousePointer = vbHourglass

    If CurDir$ <> ExtractPath(Text1.Text) Then
        If Left$(CurDir$, 1) <> Left$(ExtractPath(Text1.Text), 1) Then
            ChDrive (Left$(Text1.Text, 2))
        End If
        ChDir (ExtractPath(Text1.Text))
    End If

    fName = Dir$(ExtractFile(Text1.Text))

    If fName = "" Then
        MsgBox "There were no files found matching " & Text1.Text & ".", vbOKOnly + vbInformation, "Nothing To Do"
        CleanUp
        Exit Sub
    Else
        While fName > ""
            ReDim Preserve aryDLL(i)
            aryDLL(i) = fName
            fName = Dir$()
            i = i + 1

            If blnCancel = True Then
                CleanUp
                Exit Sub
            End If

        Wend

        i = 0   'reinitialize i
        Label1.Visible = True

        For i = LBound(aryDLL) To UBound(aryDLL)

            If blnCancel = True Then
                CleanUp
                Exit Sub
            End If

            Label1.Caption = "Current File   " & CStr(i + 1) & " of " & CStr(UBound(aryDLL) + 1)
            lblCurrFile.Caption = aryDLL(i)
            lblCurrFile.Refresh
            DoEvents
            If InStr(CurDir$, " ") Then
               strCommand = """" & CurDir$ & "\" & aryDLL(i) & """"
            Else
               strCommand = CurDir$ & "\" & aryDLL(i)
            End If
            If chkSilent.Value = vbChecked Then
                Rtn = Shell("regsvr32.exe /s " & strCommand, vbNormalNoFocus)
            Else
                Rtn = Shell("regsvr32.exe " & strCommand, vbNormalNoFocus)
            End If

            If UBound(aryDLL) > 0 Then
                If CInt(i / UBound(aryDLL)) * 100 <= 100 Then
                    ProgressBar1.Value = CInt(i / UBound(aryDLL) * 100)
                Else
                    ProgressBar1.Value = 100
                End If
            Else
                ProgressBar1.Value = 100
            End If

            Delay 5
            hwnd = FindWindow(vbNullString, "RegSvr32")
            'close the regsvr32 message window
            Rtn = SendMessage(hwnd, WM_COMMAND, SC_CLOSE, vbNull)

        Next i

    End If

    CleanUp
    Exit Sub

errbtnRegister:
    If Err.Number = 9 Then  'no files found
        MsgBox "There were no files found matching " & Text1.Text & ".", vbOKOnly + vbInformation, "Nothing To Do"
    Else
        MsgBox "There was an error registering " & Text1.Text & " files." & vbLf & vbLf _
            & "Error = " & CStr(Err.Number) & ", " & Err.Description, vbOKOnly + vbInformation, "Program Error"
    End If

    Exit Sub

End Sub

Answer 3

You can use a delegator light-weight object if you have to implement it all in VB6.

First you'll need a typelib with a custom interface with long retvals by its methods because methods of a VB6 "interface" class always return HRESULT and this will interfere with the delegator retvals (negative retvals will raise errors).

[
  uuid(a4d82779-ed39-437c-9f42-89048603a82b),
  version(1.0),
  helpstring("Delegator Typelib 1.0")
]
library DelegatorLib
{
    importlib("stdole2.tlb");

    [
      odl,
      uuid(fdb250f4-4175-444f-8a53-72ecfcaf8fd0),
      version(1.0),
    ]    
    interface IDelegator : IUnknown {
        long Call0([in] long pfn);
        long Call1([in] long pfn, [in] long A1);
        long Call2([in] long pfn, [in] long A1, [in] long A2);
        long Call3([in] long pfn, [in] long A1, [in] long A2, [in] long A3);
        long Call4([in] long pfn, [in] long A1, [in] long A2, [in] long A3, [in] long A4);
        long Call5([in] long pfn, [in] long A1, [in] long A2, [in] long A3, [in] long A4, [in] long A5);
        long Call6([in] long pfn, [in] long A1, [in] long A2, [in] long A3, [in] long A4, [in] long A5, [in] long A6);
        long Call7([in] long pfn, [in] long A1, [in] long A2, [in] long A3, [in] long A4, [in] long A5, [in] long A6, [in] long A7);
    };
}

Then in a standard module you can implement the light-weight object -- a very minimal implementation would be enough.

Option Explicit

'--- for VirtualQuery'
Private Const PAGE_EXECUTE_READWRITE            As Long = &H40

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private m_aThunk(0 To 1)        As Long
Private m_aVtbl(0 To 9)         As Long

Public Type DelegatorData
    pVTable             As Long
End Type

Public Function InitDelegator(This As DelegatorData) As IDelegator
    Dim dwDummy         As Long
    Dim lIdx            As Long

    If m_aVtbl(0) = 0 Then
        m_aThunk(0) = &H51585859
        m_aThunk(1) = &H9090E0FF
        Call VirtualProtect(m_aThunk(0), 8, PAGE_EXECUTE_READWRITE, dwDummy)
        m_aVtbl(0) = pvAddr(AddressOf pvQueryInterface)
        m_aVtbl(1) = pvAddr(AddressOf pvAddRefRelease)
        m_aVtbl(2) = pvAddr(AddressOf pvAddRefRelease)
        For lIdx = 3 To 9
            m_aVtbl(lIdx) = VarPtr(m_aThunk(0))
        Next
    End If
    This.pVTable = VarPtr(m_aVtbl(0))
    Call CopyMemory(InitDelegator, VarPtr(This), 4)
End Function

Private Function pvAddr(ByVal lPtr As Long) As Long
    pvAddr = lPtr
End Function

Private Function pvQueryInterface(This As DelegatorData, ByVal riid As Long, pvObj As Long) As Long
    pvObj = VarPtr(This)
End Function

Private Function pvAddRefRelease(This As DelegatorData) As Long
    '--- do nothing
End Function

The thunk code is really the funny part, this is the assembly

00401030 59                   pop         ecx
00401031 58                   pop         eax
00401032 58                   pop         eax
00401033 51                   push        ecx
00401034 FF E0                jmp         eax

So basicly it preserves return address in ecx , gets rid of the first argument ( this ) then pops and jumps to the second one ( pfn ) and leaves the rest of the arguments intact. Then delegated function's epilog takes care of the stack (delegated function has to be in stdcall calling convention).

You can initialize a (singleton) delegator like this

Private m_uDelegator        As DelegatorData
Private m_pDelegator        As IDelegator

Set m_pDelegator = InitDelegator(m_uDelegator)

And later use m_pDelegator var directly like this

ret = m_pDelegator.Call0(AddressOf Test)

No clean-up necessary.

The rest of the CallN functions use the same thunk but you can cut them out as you don't need these for your purposes.