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:
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:
Thanks.
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.
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
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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.