?
Solved

DLL copy in the right directory and self register (how)?

Posted on 2003-03-29
11
Medium Priority
?
560 Views
Last Modified: 2007-12-19
Hi!

I have made a autoupdate and want to copy automatically a dll in the right directory and that the dll is registering itself.

How can i know the right directory where i must copy the dll (i think it's windows\system) and how i can self register the dll?

Falke
0
Comment
Question by:Falke
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 3
11 Comments
 
LVL 9

Expert Comment

by:rawinnlnx9
ID: 8232431
Have your application search the registry for your DLL name "MyDLL" once it finds MyDLL have it get the InProcServer value. That value will tell you where the DLL is actually at on the box. Then use that value as the argument to your copy function. Then use the following command, "Shell("regsvr32.exe Filepath & Filename", vbhidden)" that should do the trick.

Real example:

Private Function UpdateDLL(ByVal InDLLName As String) As Boolean
   
    Dim DLLPath         As String
    Dim DLLSourceDir    As String
    Dim Ret             As Long
   
    DLLSourceDir = "C:\MyApplication\MyComponents\Updates\NewDLL\"
   
    DLLPath = GetRegKeyValue(InDLLName)
   
   
    If Len(DLLPath) > 0 Then
        If Mid$(DLLPath, Len(DLLPath) - 1, 1) <> "\" Then
            DLLPath = DLLPath & "\"
        End If
    Else
        MsgBox ("Error DLL Name Not Found in Registry")
        UpdateDLL = False
        Exit Function
    End If
   
    If Dir(DLLPath & InDLLName) <> "" Then
        Kill DLLPath & InDLLName
    End If
   
    FileCopy DLLSourceDir, DLLPath
   
    If Dir(DLLPath & InDLLName) <> "" Then
        Ret = Shell("regsvr32.exe " & DLLPath & InDLLName, vbHide)
        If Ret <> 0 Then
            MsgBox ("Error could not register file.")
        Else
            UpdateDLL = True
            Exit Function
        End If
    Else
        MsgBox ("DLL copy failed.")
        UpdateDLL = False
        Exit Function
    End If
       
End Function

Private Function GetRegKeyValue(ByVal InDLLName As String) As String

    '*-- You need to write this code to search the registry. Tons of
    '*-- of great examples at google. You are looking for the InprocServer
    '*-- of your DLL name.

End Function


0
 
LVL 9

Expert Comment

by:rawinnlnx9
ID: 8232447
Search Google for these function names RegEnumKey and RegEnumValue VB and you will see all the code and tutorials you need.

Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
0
 
LVL 9

Expert Comment

by:rawinnlnx9
ID: 8232936
Search Google for these function names RegEnumKey and RegEnumValue VB and you will see all the code and tutorials you need.

Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:Falke
ID: 8233255
Hi!

The GetRegKeyValue has more parameters as one.

And the RegEnumKey and RegEnumValue is to locate the Windows\system directory?

Falke
0
 
LVL 9

Expert Comment

by:rawinnlnx9
ID: 8243413
Falke,

    Okay, this is the full-meal-deal. You should be able to run this code right off. Just go into the ReplaceDLL_Click() sub and change the ProgID I have in there to the ProgID of your DLL. I.E. (MyDLL.ProgID) you can easily find this in the registry if you search for your DLL filename. Once that is done change DLLSourceDir in UpdateDLL to the path where your new DLL is. Then you are up and running and ready to roll.

Might want to add some error handling. I didn't as I don't know which scheme you use.

'===================================================

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
   (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
   ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
   Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal lpReserved As Long, lpType As Long, lpData As Any, _
   lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
   Any, source As Any, ByVal numBytes As Long)

Const KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
' SYNCHRONIZE))

Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234

Private Sub ReplaceDLL_Click()
   
    If UpdateDLL("SmartNetButtonProject.SmartNetButton") = False Then
        MsgBox ("Update Failed.")
    Else
        MsgBox ("Update Completed.")
    End If
   
End Sub

Private Function UpdateDLL(ByVal InProgID As String) As Boolean
   
    Dim DLLPath         As String
    Dim DLLDir          As String
    Dim DLLName         As String
    Dim DLLSourceDir    As String
    Dim Ret             As Long
   
    MsgBox ("You need to change the next line to the path & filename of your new DLL.")
    DLLSourceDir = "C:\MyApplication\MyComponents\Updates\NewDLL\MyDLL.DLL"
   
    DLLPath = GetInProcServer(InProgID)
    DLLDir = DirectoryFromFile(DLLPath)
    DLLName = GetFileName(DLLPath)
   
    If Len(DLLPath) > 0 Then
    Else
        MsgBox ("Error DLL Name Not Found in Registry")
        UpdateDLL = False
        Exit Function
    End If
   
    If Dir(DLLPath) <> "" Then
        Ret = Shell("regsvr32.exe /u " & DLLPath, vbHide)
        If Ret = 0 Then
            MsgBox ("Unregister Failed.")
            UpdateDLL = False
            Exit Function
        Else
            Kill DLLPath
        End If
    End If
   
    FileCopy DLLSourceDir, DLLDir & DLLName
   
    If Dir(DLLPath) <> "" Then
        Ret = Shell("regsvr32.exe " & DLLPath, vbHide)
        If Ret = 0 Then
            MsgBox ("Error could not register file.")
        Else
            UpdateDLL = True
            Exit Function
        End If
    Else
        MsgBox ("DLL copy failed.")
        UpdateDLL = False
        Exit Function
    End If
       
End Function

Function GetInProcServer(ByVal ProgID As String) As String
   
    Dim CLSID As String
    Dim InprocServer As String
   
    Const HKEY_CLASSES_ROOT = &H80000000
   
    On Error Resume Next
   
    'if the ProgID for the OLEDB does not exist, return false

    If Not CheckRegistryKey(HKEY_CLASSES_ROOT, ProgID) Then Exit Function

    'get the clsid
    CLSID = GetRegistryValue(HKEY_CLASSES_ROOT, ProgID & "\CLSID", "")
    'check if the physical file exists
    InprocServer = GetRegistryValue(HKEY_CLASSES_ROOT, _
       "CLSID\" & CLSID & "\InprocServer32", "")
   
    If (GetAttr(InprocServer) And vbDirectory) = 0 Then

        'if the routine arrives here, return True
        GetInProcServer = InprocServer

    End If
   
End Function

Function CheckRegistryKey(ByVal hKey As Long, ByVal KeyName As String) As _
   Boolean

    Dim handle As Long
    ' Try to open the key

    If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) = 0 Then

        ' The key exists
        CheckRegistryKey = True
        ' Close it before exiting
        RegCloseKey handle

    End If

End Function

Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
   ByVal ValueName As String, Optional DefaultValue As Variant) As Variant

    Dim handle As Long
    Dim resLong As Long
    Dim resString As String
    Dim resBinary() As Byte
    Dim length As Long
    Dim retVal As Long
    Dim valueType As Long
   
    ' Prepare the default result
    GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)
   
    ' Open the key, exit if not found.

    If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then

        Exit Function

    End If
   
    ' prepare a 1K receiving resBinary
    length = 1024
    ReDim resBinary(0 To length - 1) As Byte
   
    ' read the registry key
    retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
       length)
    ' if resBinary was too small, try again

    If retVal = ERROR_MORE_DATA Then

        ' enlarge the resBinary, and read the value again
        ReDim resBinary(0 To length - 1) As Byte
        retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
           length)

    End If
   
    ' return a value corresponding to the value type

    Select Case valueType

        Case REG_DWORD
            CopyMemory resLong, resBinary(0), 4
            GetRegistryValue = resLong

        Case REG_SZ, REG_EXPAND_SZ
            ' copy everything but the trailing null char
            resString = Space$(length - 1)
            CopyMemory ByVal resString, resBinary(0), length - 1
            GetRegistryValue = resString

        Case REG_BINARY
            ' resize the result resBinary

            If length <> UBound(resBinary) + 1 Then

                ReDim Preserve resBinary(0 To length - 1) As Byte

            End If

            GetRegistryValue = resBinary()

        Case REG_MULTI_SZ
            ' copy everything but the 2 trailing null chars
            resString = Space$(length - 2)
            CopyMemory ByVal resString, resBinary(0), length - 2
            GetRegistryValue = resString

        Case Else
            RegCloseKey handle
            Err.Raise 1001, , "Unsupported value type"

    End Select
   
    ' close the registry key
    RegCloseKey handle

End Function


Public Function DirectoryFromFile(FullPath As String) As String

    Dim FilePath As String
   
    FilePath = Trim(FullPath)

    If Len(FilePath) = 0 Then Exit Function

    If InStr(FilePath, "\") = 0 Then Exit Function

    If Right(FilePath, 1) = "\" Then
        DirectoryFromFile = FilePath
        Exit Function
    End If

    Do Until Right(FilePath, 1) = "\"
        FilePath = Left(FilePath, Len(FilePath) - 1)
    Loop

    DirectoryFromFile = FilePath

End Function

Public Function GetFileName(FullPath As String) As String
   
    Dim posn As Integer, i As Integer
    Dim FileName As String
   
    posn = 0
    'find the position of the last "\" character in filename
    For i = 1 To Len(FullPath)
        If (Mid(FullPath, i, 1) = "\") Then posn = i
    Next i

    'get filename without path
    FileName = Right(FullPath, Len(FullPath) - posn)

    'get filename without extension
    posn = InStr(FileName, ".")
        If posn <> 0 Then
            FileName = Left(FileName, posn - 1)
        End If
    GetFileName = FileName
End Function
0
 
LVL 9

Accepted Solution

by:
rawinnlnx9 earned 375 total points
ID: 8243420
Credit goes to VB2TheMax for the registry code. I was not all that motivated to write it so I went for some proven error free code.

http://www.vb2themax.com
0
 

Author Comment

by:Falke
ID: 8523254
what is the SmartNetButtonProject.SmartNetButton?

DLLPath is at every time 0 :(

What do i have to do?

Falke
0
 
LVL 9

Expert Comment

by:rawinnlnx9
ID: 8534634
Oops, that is the DLL I was using to test with. That is the progid of the library. SmartNetButtonProject.SmartNetButton is the progid used to search the registry.
0
 
LVL 9

Expert Comment

by:rawinnlnx9
ID: 8534644
I should have mentioned that all you need to do is pass in the progid of what you want to find and replace. For example, MyDLLProject.MyDLL.
0
 

Author Comment

by:Falke
ID: 8536125
and if i doesn't know it?

Falke
0
 

Expert Comment

by:CleanupPing
ID: 8899827
Falke:
This old question needs to be finalized -- accept an answer, split points, or get a refund.  For information on your options, please click here-> http:/help/closing.jsp#1 
Experts: Post your closing recommendations!  Who deserves points here?
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Suggested Courses
Course of the Month10 days, 4 hours left to enroll

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question