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>