Hi all

I have developed a couple of 3D applications using DirectX8 library, one in VB and another one in an excel book using VBA. Until Windows XP, I had no issues as the dx8vb.dll came already registered with Windows

Since windows vista, 7, 8 and now 10, I had to go to an "administrator rights free" option of using this library. Until now A friend of mine gave the code I post at the end if this could be useful for somebody (sorry I tried to find the source but I could not get it). It worked fine until I suppose what is a security update don't
let this code work anymore

I wanted to go to the DirectCOM.dll Olaf Schmidt option as I wanted to introduce some nice features included in the RichClient5.

Unfortunately due to my low programming skills I could not go further as a get a complete IDE crash when I try to use it, surely in a wrong way

The original code would be

Code:
Dim dx As DirectX8
Dim D3D As Direct3D8

Sub Main()
    Set dx = New DirectX8
    Set D3D = dx.Direct3DCreate ' Active X cannot create the object bla bla bla, ....
End Sub
This is the code I use following the posts I could read in this forum trying to use DirectCOM

Code:
Option Explicit
Private Declare Function GetInstance Lib "c:\Users\Public\directXTest\DirectCOM.dll" Alias "GETINSTANCE" (FName As String, ClassName As String) As Object
Private Declare Function LoadLibraryW& Lib "kernel32" (ByVal lpLibFileName&)
Dim dx 'As DirectX8


Sub Main()
    Static hDirCOM As Long
    hDirCOM = LoadLibraryW&(StrPtr("c:\Users\Public\directXTest\DirectCOM.dll"))
    Set dx = GetInstance("c:\Users\Public\directXTest\dx8vb.dll", "DirectX8") ' Complete Crash
End Sub

I would welcome any help!

Thanks in advance!

Happy new VB6 - 2018 year

==============================================


Admin wrights free registration in local user (sorry I did not find the source)
Code:
Option Explicit

'All required Win32 SDK functions to register/unregister any ActiveX component

Private Declare Function LoadLibraryRegister Lib "KERNEL32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long

Private Declare Function FreeLibraryRegister Lib "KERNEL32" Alias "FreeLibrary" _
(ByVal hLibModule As Long) As Long

Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long


Private Declare Function GetProcAddress Lib "KERNEL32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function CreateThread Lib "KERNEL32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, _
ByVal lpStartAddress As Long, ByVal lpparameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" 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 WaitForSingleObject Lib "KERNEL32" _
                            (ByVal hHandle As Long, _
                            ByVal dwMilliseconds As Long) As Long

Private Declare Function GetExitCodeThread Lib "KERNEL32" _
(ByVal hThread As Long, lpExitCode As Long) As Long

Private Declare Sub ExitThread Lib "KERNEL32" (ByVal dwExitCode As Long)

Private Const STATUS_WAIT_0 = &H0
Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)




Private Const ERROR_SUCCESS As Long = 0
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001

'Registry-Keys
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" ( _
    ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    phkResult As Long) As Long
Private Declare Function RegOverridePredefKey Lib "advapi32" ( _
    ByVal hKey As Long, _
    ByVal hNewHKey As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal hKey As Long) As Long
    
    Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" ( _
    ByVal lpLibFileName As String) As Long

Private Declare Function FreeLibrary Lib "kernel32.dll" ( _
    ByVal hLibModule As Long) As Long

Public Function Register_DLL(DLLName As String, Optional Unregister As Boolean = False) As Integer

    Dim lRet As Long
    Dim hKey As Long
    Dim hModule As Long
    Dim pAdr As Long
    Dim S As String
    Register_DLL = 0
    S = App.Path
    If Right(S, 1) <> "\" Then S = S & "\"
    S = DLLName

    
    'Override HKEY_CLASSES_ROOT:
    If RegOpenKey(HKEY_CURRENT_USER, "Software\\Classes", hKey) = ERROR_SUCCESS Then
        lRet = RegOverridePredefKey(HKEY_CLASSES_ROOT, hKey)
        RegCloseKey hKey
        If lRet = ERROR_SUCCESS Then
            'Call the normal registration entry:
            hModule = LoadLibrary(S)
            If hModule Then
                If Unregister Then
                    pAdr = GetProcAddress(hModule, "DllUnregisterServer")
                Else
                    pAdr = GetProcAddress(hModule, "DllRegisterServer")
                End If
                Shell DLLName & " /Register"
                If pAdr Then
                    CallWindowProc pAdr, 0, 0, 0, ByVal 0
                Else
                    Register_DLL = 4
                End If
            Else
                MsgBox "DLL-Error " + CStr(Err.LastDllError) + " beim Registrieren von " + DLLName
                Register_DLL = 1
            End If
            FreeLibrary hModule
            'Restore Override of HKEY_CLASSES_ROOT:
            lRet = RegOverridePredefKey(HKEY_CLASSES_ROOT, 0&)
            If lRet <> ERROR_SUCCESS Then
                Register_DLL = 6
            End If
        Else
            Register_DLL = 2
        End If
    Else
        Register_DLL = 3
    End If
End Function