Cannot register COM DLL with GetDelegateForFunctionPointer


I have an website and I have to register a vb6 DLL everytime it updates I figured out how to copy the dll in SYSWOW64 directory and I try to register using that class:

Public Class ComLibrary
Private Delegate Function DllRegUnRegAPI() As UInt32
<DllImport("kernel32", SetLastError:=True, CharSet:=CharSet.Auto)>
Private Shared Function LoadLibrary(ByVal lpFileName As String) As IntPtr

End Function
<DllImport("kernel32.dll", SetLastError:=True)>
Private Shared Function FreeLibrary(ByVal hModule As IntPtr) As Boolean

End Function
<DllImport("kernel32", CharSet:=CharSet.Ansi, ExactSpelling:=True, SetLastError:=True)>
Private Shared Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As IntPtr

End Function
Private Shared Function FormatMessage(ByVal dwFlags As Integer, ByVal lpSource As Integer, ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, ByRef lpBuffer As String, ByVal nSize As Integer, ByVal arguments As Integer) As Integer

End Function

Public Shared Sub Register(ByVal libraryPath As String)
    libraryPath = Path.GetFullPath(libraryPath)
    Dim hModuleDll = LoadLibrary(libraryPath)

    If hModuleDll = IntPtr.Zero Then
        Dim [error] = GetLastErrorMessage()
        Debug.WriteLine("Unable to load DLL : {0} because of {1}", libraryPath, [error])
    End If

    Dim pExportedFunction = GetProcAddress(hModuleDll, "DllRegisterServer")

    If pExportedFunction = IntPtr.Zero Then
        Debug.WriteLine("Unable to get required API from DLL.")
    End If

    Dim pDelegateRegUnReg = CType((Marshal.GetDelegateForFunctionPointer(pExportedFunction, GetType(DllRegUnRegAPI))), DllRegUnRegAPI)
    Dim hResult = pDelegateRegUnReg()

    If hResult <> 0 Then
        Debug.WriteLine("Cannot register {0}", libraryPath)
    End If

    Debug.WriteLine("LogParser.dll registered succesfully")
End Sub

Public Shared Function GetLastErrorMessage() As String
    Dim errorCode As Integer = Marshal.GetLastWin32Error()
    Const formatMessageAllocateBuffer As Integer = &H100
    Const formatMessageIgnoreInserts As Integer = &H200
    Const formatMessageFromSystem As Integer = &H1000
    Const messageSize As Integer = 255
    Dim lpMsgBuf As String = ""
    Const dwFlags As Integer = formatMessageAllocateBuffer Or formatMessageFromSystem Or formatMessageIgnoreInserts
    Dim retVal As Integer = FormatMessage(dwFlags, 0, errorCode, 0, lpMsgBuf, messageSize, 0)
    Return If(retVal = 0, Nothing, lpMsgBuf)
End FunctionEnd Class

But everytime the hresult return me 2147500037 (or 0x80004005) that looks like that the function does not have rights to do that, how can I elevate to admin rights or something else?
asked on Stack Overflow Sep 23, 2020 by DrViente • edited Sep 23, 2020 by DrViente

0 Answers

Nobody has answered this question yet.

User contributions licensed under CC BY-SA 3.0