[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/e39af8c8/attachment.html>