[AccessD] OT - Registrering DLL's

Erwin Craps Erwin.Craps at ithelps.be
Thu Oct 2 14:41:05 CDT 2003


should that not be regsvr32 ???
I always used this.

	-----Oorspronkelijk bericht-----
	Van: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] Namens John Skolits
	Verzonden: donderdag 2 oktober 2003 20:25
	Aan: Access Developers discussion and problem solving
	Onderwerp: RE: [AccessD] OT - Registrering DLL's
	
	
	Here ya' go. Found this on the web. To use it, just paste all
the code below the line into a module. Then, run the code:
	 
	call RegDLL("c:\winnt\system32\COMDLG32.OCX",TRUE). 
	 
	You can put any dll file in there you want. Include the path.
	 
	Place a true or false in there if you want a message box to show
up.
	 
	John Skolits
	_____________________________________________

		Option Compare Database
		 
		Option Explicit
		 
		Private Declare Function LoadLibraryA Lib "kernel32"
(ByVal lLibFileName As String) As Long
		Private Declare Function CreateThread Lib "kernel32"
(lThreadAttributes As Any, _
		    ByVal lStackSize As Long, ByVal lStartAddress As
Long, ByVal larameter As Long, _
		    ByVal lCreationFlags As Long, lThreadID As Long) As
Long
		Private Declare Function WaitForSingleObject Lib
"kernel32" (ByVal hHandle As Long, _
		    ByVal lMilliseconds As Long) As Long
		Private Declare Function GetProcAddress Lib "kernel32"
(ByVal hModule As Long, _
		    ByVal lProcName As String) As Long
		Private Declare Function CallWindowProc Lib "user32"
Alias "CallWindowProcA" _
		    (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long,
ByVal Msg As Long, _
		    ByVal wParam As Long, ByVal lParam As Long) As Long
		Private Declare Function FreeLibrary Lib "kernel32"
(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, lExitCode As Long) As Long
		Private Declare Sub ExitThread Lib "kernel32" (ByVal
lExitCode As Long)
		 
		Function RegDLL(strDLL_Name As String, Optional
bolShowMsg As Boolean)
		    If RegisterComponent(strDLL_Name) = True Then
		        If bolShowMsg Then MsgBox "Component
Successfully Registered"
		    Else
		        If bolShowMsg Then MsgBox "Failed to Registered
Component"
		    End If
		End Function
		 
		

		'Purpose   :    This function registers and Unregisters
OLE components
		'Inputs    :    sFilePath       The path to the DLL/OCX
or ActiveX EXE
		'               bRegister                       If True
Registers the control,
		'               else unregisters control
		'Outputs   :    Returns True if successful
		'Author    :    Andrewb
		'Date      :    04/09/2000
		'Notes     :    This is the API equivalent of
RegSvr32.exe.
		'Revisions :    1/Jan/2002. Updated to include code for
registering ActiveX Exes.
		 
		Function RegisterComponent(ByVal sFilePath As String,
Optional bRegister As Boolean = True) As Boolean
		    Dim lLibAddress As Long, lProcAddress As Long,
lThreadID As Long, _
		        lSuccess As Long, lExitCode As Long, lThread As
Long
		    Dim sRegister As String
		    Const clMaxTimeWait As Long = 20000     'Wait 20
secs for register to complete
		    
		    On Error GoTo ErrFailed
		    If Len(sFilePath) > 0 And Len(Dir(sFilePath)) > 0
Then
		        'File exists
		        If UCase$(Right$(sFilePath, 3)) = "EXE" Then
		            'Register/Unregister ActiveX EXE
		            If bRegister Then
		                'Register EXE
		                Shell sFilePath & " /REGSERVER", vbHide
		            Else
		                'Unregister ActiveX EXE
		                Shell sFilePath & " /UNREGSERVER",
vbHide
		            End If
		            RegisterComponent = True
		        Else
		            'Register/Unregister DLL
		            If bRegister Then
		                sRegister = "DllRegisterServer"
		            Else
		                sRegister = "DllUnRegisterServer"
		            End If
		            
		            'Load library into current process
		            lLibAddress = LoadLibraryA(sFilePath)
		            
		            If lLibAddress Then
		                'Get address of the DLL function
		                lProcAddress =
GetProcAddress(lLibAddress, sRegister)
		                If lProcAddress Then
		                    lThread = CreateThread(ByVal 0&, 0&,
ByVal lProcAddress, ByVal 0&, 0&, lThread)
		                    If lThread Then
		                        'Created thread and wait for it
to terminate
		                        lSuccess =
(WaitForSingleObject(lThread, clMaxTimeWait) = 0)
		                        If Not lSuccess Then
		                            'Failed to register, close
thread
		                            Call
GetExitCodeThread(lThread, lExitCode)
		                            Call ExitThread(lExitCode)
		                            RegisterComponent = False
		                        Else
		                            'Successfully registered
component
		                            RegisterComponent = True
		                            Call CloseHandle(lThread)
		                        End If
		                    End If
		                    Call FreeLibrary(lLibAddress)
		                Else
		                    'Object doesn't expose OLE interface
		                    Call FreeLibrary(lLibAddress)
		                End If
		            End If
		        End If
		    End If
		    Exit Function
		 
		ErrFailed:
		    Debug.Print Err.Description
		    Debug.Assert False
		    On Error GoTo 0
		End Function
		

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://databaseadvisors.com/pipermail/accessd/attachments/20031002/b3bed843/attachment-0001.html>


More information about the AccessD mailing list