-
Jan 3rd, 2018, 04:44 AM
#1
Thread Starter
Junior Member
[RESOLVED] Regfree DirectX dx8vb.dll usage with DirectCOM.dll
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
-
Jan 3rd, 2018, 10:32 AM
#2
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
Last edited by dreammanor; Jan 3rd, 2018 at 11:28 AM.
Reason: Error Links
-
Jan 3rd, 2018, 12:42 PM
#3
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
Per your registration code - It doesn't make any sense to call DllRegisterServer / DllUnregisterServer using CallWindowProc.
I would automatically think stack corruption. Use DispCallFunc instead.
Better yet - why don't you just run regsvr32 from an elevated prompt?
-
Jan 3rd, 2018, 01:40 PM
#4
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
See DX8VB.DLL, DX7VB.DLL, VB6 and Vista Compatibility
These DLLs are not included in an OS after Windows XP and there is no legal way to install them.
Thus this thread is about piracy and violates the Terms here.
-
Jan 3rd, 2018, 02:04 PM
#5
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
According to the license, a developer has the rights to everything in the DX8 redist folder which includes dx8vb.dll.
You can obtain the license with the DX8 SDK.
-
Jan 3rd, 2018, 02:06 PM
#6
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
That thread linked to is nearly 11 years old, is a discussion between people without any particular authority, and it seems like all the 'further reference' links are now dead. At least none of them worked for me.
So, is this really the case? Was DirectX8 the last release of DirectX that worked for VB6 and no other solution has come forwards in the last decade? Has the EULA never changed in it's back-door denial of the right to install the dlls?
My usual boring signature: Nothing
-
Jan 3rd, 2018, 02:22 PM
#7
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
Originally Posted by Shaggy Hiker
Was DirectX8 the last release of DirectX that worked for VB6 and no other solution has come forwards in the last decade?
DX8 only worked in VB because MS made an ActiveX Shim for it. If one is inclined it's not difficult to make an ActiveX shim or Typelib for DX9, or use one someone else created. In the Codebank Trick has posted a typelib and replacement functions for the static lib (for those that don't know how to use static libs in VB) Someone else also created a shim DLL for VB - so there's at least 2 solutions for updated DX versions for VB. But that's for DX9.
Originally Posted by Shaggy Hiker
Has the EULA never changed in it's back-door denial of the right to install the dlls?
I must be missing something. Is there some clause in the Developer license that denies the right to install the DLLs?
edit:
According to this.
Code:
DISTRIBUTION REQUIREMENTS. You may reproduce and distribute an unlimited
number of copies of the Sample Code and/or Redistributable Code, (collectively "REDISTRIBUTABLE
COMPONENTS") as described above, provided that (a) you distribute the REDISTRIBUTABLE COMPONENTS only
as part of, or for use in conjunction with your Application; (b) your Application adds significant and primary
functionality to the REDISTRIBUTABLE COMPONENTS; (c) the REDISTRIBUTABLE COMPONENTS only operate in
conjunction with Microsoft Windows operating system products including Microsoft Windows 98, Millennium
Edition or Windows 2000 and subsequent versions thereof, (d) you distribute your Application containing the
REDISTRIBUTABLE COMPONENTS pursuant to an End-User License Agreement (which may be "break-the-seal",
"click-wrap", or signed), with terms no less protective than those contained herein; (e) you do not permit
further redistribution of the REDISTRIBUTABLE COMPONENTS by your end-user customers; (f) you must use
the setup utility included with the REDISTRIBUTABLE COMPONENTS to install the Redistributable Code; (g) you
do not use Microsoft's name, logo, or trademarks to market your Application; (h) you include all copyright and
trademark notices contained in the REDISTRIBUTABLE COMPONENTS; (i) you include a valid copyright notice
on your Application; and (j) you agree to indemnify, hold harmless, and defend Microsoft from any against any
claims or lawsuits, including attorneys' feeds, that arise or result from the use or distribution of your
Application.
If you distribute the Redistributable Code separately for use with your Application (such as on your web site or
as part of an update to your Application), you must include an end user license agreement in the install
program for the Redistributable Code in the form of DXF\DXSDK\license\directx end user eula.txt. Contact
Microsoft for the applicable royalties due and other licensing terms for all other uses and/or distribution of the
REDISTRIBUTABLE COMPONENTS.
So technically I can get around clause (f) and redist the entire package separately (but still as part of my program). Whereby it's up to the End user to figure out how to install it on a modern OS. The EULA doesn't specify how the end user installs the package. Clause (f) only limits a developer from installing the DLLs separately in a custom installer.
If it were me - I would just use DX9.
Last edited by DEXWERX; Jan 3rd, 2018 at 02:38 PM.
-
Jan 3rd, 2018, 02:42 PM
#8
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
That't the answer I was expecting to get. DX8 is OLD, so I'd be surprised if people hadn't found a way to move on....hmmm, I'm not going to say more on that.
Still, I think that may be a good interpretation of the EULA. You can distribute DX8 as long as it stays together. Frankly, I would think that you could also come up with a solution that would install what was needed, as well.
My usual boring signature: Nothing
-
Jan 3rd, 2018, 02:53 PM
#9
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
Originally Posted by Shaggy Hiker
Frankly, I would think that you could also come up with a solution that would install what was needed, as well.
Like a utility that extracts the needed DLLs for newer OS. Considering it's no longer supported on newer O/S, there would be limited legal exposure to something like that.
Eventually I'd like to put out a DX9 dll, but in the mean time the OP should really jump to DX9 using the Trick's typelib. http://www.vbforums.com/showthread.p...-VB6-Direct3D9
Last edited by DEXWERX; Jan 3rd, 2018 at 03:12 PM.
-
Jan 3rd, 2018, 03:53 PM
#10
Thread Starter
Junior Member
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
First of all thank you all for the help!!
Originally Posted by dreammanor
Sorry, I just posted some wrong links, the following links may be useful to you:
Thanks a lot dreammanor!
I had already read some of them
I did not know one of them, the modTrickUnregCOM one
Unfortunately it also crashed
Originally Posted by DEXWERX
Per your registration code - It doesn't make any sense to call DllRegisterServer / DllUnregisterServer using CallWindowProc.
I would automatically think stack corruption. Use DispCallFunc instead.
It just worked fine until now, I will try the DispCallFunc you tell me
Originally Posted by DEXWERX
Better yet - why don't you just run regsvr32 from an elevated prompt?
Of course everithing works fine with regsvr32 form admin, the problems is the users do not have this rights
Originally Posted by dilettante
I have read all the threat you mentioned, not a single answer from Microsoft. I have the same problem as a person that post there. I used 20 years ago a technology that worked fine, and still works fine today in W10, that is VB6 and DX8 for VB. I had the bad luck that Microsoft decided to kill both technologies. Thousands of lines of codes, bla bla bla, the same history as I suppose lots of you have.
I don't sell the software, it is just for internal use. I don't know if I am being illegal, but I think ethically Microsoft are being the bad guys
Originally Posted by Shaggy Hiker
That thread linked to is nearly 11 years old, is a discussion between people without any particular authority, and it seems like all the 'further reference' links are now dead. At least none of them worked for me.
So, is this really the case? Was DirectX8 the last release of DirectX that worked for VB6 and no other solution has come forwards in the last decade? Has the EULA never changed in it's back-door denial of the right to install the dlls?
I believe it is the case, that is Microsoft, ...
Originally Posted by DEXWERX
DX8 only worked in VB because MS made an ActiveX Shim for it. If one is inclined it's not difficult to make an ActiveX shim or Typelib for DX9, or use one someone else created. In the Codebank Trick has posted a typelib and replacement functions for the static lib (for those that don't know how to use static libs in VB) Someone else also created a shim DLL for VB - so there's at least 2 solutions for updated DX versions for VB. But that's for DX9.
If it were me - I would just use DX9.
That would be the next solution, but for sure this will be more effort, If DirectCOM or any other admin free registry tool allows me to use directX8, that would be the quiker solution
Originally Posted by DEXWERX
Like a utility that extracts the needed DLLs for newer OS. Considering it's no longer supported on newer O/S, there would be limited legal exposure to something like that.
Eventually I'd like to put out a DX9 dll, but in the mean time the OP should really jump to DX9 using the Trick's typelib. http://www.vbforums.com/showthread.p...-VB6-Direct3D9
I will definitively have a try on it and I come to you back
**** Edited -> I had a look, it looks great but there are several important missing features that we intensively use as Meshes, and support to sound and input (as joystick) that came with Dx8.
Thank you all for you time!!
Last edited by nicopeis; Jan 3rd, 2018 at 04:24 PM.
Reason: Quoting and joining all responces
-
Jan 3rd, 2018, 04:56 PM
#11
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
and if you want to use directx10/11, check this site: https://sites.google.com/site/dawoodoz/home
-
Jan 3rd, 2018, 06:02 PM
#12
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
Wow, I've got a DirectX8 VB6 application I hadn't played around with for a while.
I just took a look at it, and found the DX81SDK_VB.exe and tried to install it. I couldn't get it to install on Win10-64 no matter what I tried. I tried several compatibility settings, and nothing I did would work.
I guess DX8 is now officially dead.
All The Best,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
-
Jan 4th, 2018, 01:31 AM
#13
Thread Starter
Junior Member
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
Thanks again for your time
Originally Posted by baka
It looks awesome I will for sure have a look at it
I found another DirectX9 library that looks quite complete Here it is if somebody found it useful
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=59767&lngWId=1
Originally Posted by Elroy
I guess DX8 is now officially dead.
Elroy
Hi Elroy, of course it is not dead on W10, it is working absolutely fine just need to register a single file (regsvr32 dx8vb.dll) with admin rights, you don't need all the SDK to developp your code with VB6
It looks that the newer versions of DirectX continue having what is needed for this library to work
Apart on trying to move to a newer version of DirectX with unofficial libraries, I am still wondering why the DirectCOM crashes, does anybody has an explanation for that? Is the code that I have posted wrong??
-
Jan 4th, 2018, 05:58 AM
#14
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
Originally Posted by nicopeis
Apart on trying to move to a newer version of DirectX with unofficial libraries, I am still wondering why the DirectCOM crashes, does anybody has an explanation for that?
It crashes, because DirectCOM.dll can only create regfree instances, which "derive from IDispatch" (which is the case with all VB6-Dlls - and most other MS-ActiveX-Objects).
The DX8-Interfaces all derive directly from IUnknown (no LateBound-mode possible) - so you will have to
do what DirectCOM does internally, but avoid the final Cast to "As Object".
Here is code, which works without problems (creating a DX8-Instance regfree) - but it requires Eduardo Morcillos olelib.tlb currently, to keep the example short:
Code:
Option Explicit
Private Declare Function LoadLibraryW Lib "kernel32" (ByVal lpLibFileName As Long) As Long
Private Declare Function DllGetClassObject Lib "dx8vb" (REFCLSID As UUID, RefIID As UUID, CF As IClassFactory) As Long
Public DX8 As DirectX8
Sub Main()
Set DX8 = LoadDX8RegFree(App.path & "\dx8vb.dll")
Debug.Print DX8.GetDSEnum.GetCount 'just a short test-method-call against the retrieved instance
End Sub
Function LoadDX8RegFree(DX8DllPath As String) As DirectX8
Static hLib As Long
If hLib = 0 Then hLib = LoadLibraryW(StrPtr(DX8DllPath))
Dim IIDCF As UUID, IIDDX8CoCls As UUID, IIDDX8 As olelib.UUID, CF As IClassFactory
olelib.CLSIDFromString "{E7FF1300-96A5-11D3-AC85-00C04FC2C602}", IIDDX8CoCls
olelib.CLSIDFromString "{E7FF1301-96A5-11D3-AC85-00C04FC2C602}", IIDDX8
olelib.CLSIDFromString "{00000001-0000-0000-C000-000000000046}", IIDCF
If DllGetClassObject(IIDDX8CoCls, IIDCF, CF) Then Err.Raise vbObjectError, , "Couldn't open ClassFactory"
CF.CreateInstance Nothing, IIDDX8, LoadDX8RegFree
End Function
I've tested the above with an unregistered DX8VB.dll in the Projects App.Path on a Win8.1 machine, which does not have this Dll in SysWow64.
HTH
Olaf
-
Jan 4th, 2018, 08:41 AM
#15
Thread Starter
Junior Member
Re: Regfree DirectX dx8vb.dll usage with DirectCOM.dll
YOU ARE ALL AWESOME!!!
Thanks Olaf the code you wrote worked perfectly! But I needed to have access to another object in the library (D3DX8) and I had some troubles following your explanations due to my low level skills. I am not familiar with the "derive from IDispatch" and after googling some time I could not get where you got these numbers ("{E7FF1300-96A5-11D3-AC85-00C04FC2C602}") from. If you have a second I would be glad if you tell me where I can search information to learn about that
BUT you code and structures used by Eduardo looked pretty similar to the one use in the post dreammanor provided me
Originally Posted by dreammanor
So I tried to rewrite a little code inspired from the one you provided and I worked fine, without the need of the Eduardo Morcillos olelib.tlb and placing the dx8vb.dll in any folder
That is what I did
First of all importing the modTrickUnregCOM.bas module coming from dreammanor post from Krivous Anatolii Anatolevich
Code:
' The module modTrickUnregCOM.bas - for working with COM libraries without registration.
' © Krivous Anatolii Anatolevich (The trick), 2015
Option Explicit
Public Type GUID
data1 As Long
data2 As Integer
data3 As Integer
data4(7) As Byte
End Type
Private Declare Function CLSIDFromString Lib "ole32.dll" ( _
ByVal lpszCLSID As Long, _
ByRef clsid As GUID) As Long
Private Declare Function GetMem4 Lib "msvbvm60" ( _
ByRef src As Any, _
ByRef dst As Any) As Long
Private Declare Function SysFreeString Lib "oleaut32" ( _
ByVal lpbstr As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryW" ( _
ByVal lpLibFileName As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleW" ( _
ByVal lpModuleName As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" ( _
ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" ( _
ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Declare Function DispCallFunc Lib "oleaut32" ( _
ByVal pvInstance As Any, _
ByVal oVft As Long, _
ByVal cc As Integer, _
ByVal vtReturn As Integer, _
ByVal cActuals As Long, _
ByRef prgvt As Any, _
ByRef prgpvarg As Any, _
ByRef pvargResult As Variant) As Long
Private Declare Function LoadTypeLibEx Lib "oleaut32" ( _
ByVal szFile As Long, _
ByVal regkind As Long, _
ByRef pptlib As IUnknown) As Long
Private Declare Function memcpy Lib "kernel32" _
Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long) As Long
Private Declare Function CreateStdDispatch Lib "oleaut32" ( _
ByVal punkOuter As IUnknown, _
ByVal pvThis As IUnknown, _
ByVal ptinfo As IUnknown, _
ByRef ppunkStdDisp As IUnknown) As Long
Private Const IID_IClassFactory As String = "{00000001-0000-0000-C000-000000000046}"
Private Const IID_IUnknown As String = "{00000000-0000-0000-C000-000000000046}"
Private Const CC_STDCALL As Long = 4
Private Const REGKIND_NONE As Long = 2
Private Const TKIND_COCLASS As Long = 5
Private Const TKIND_DISPATCH As Long = 4
Private Const TKIND_INTERFACE As Long = 3
Dim iidClsFctr As GUID
Dim iidUnk As GUID
Dim isInit As Boolean
' // Get all co-classes described in type library.
Public Function GetAllCoclasses( _
ByRef path As String, _
ByRef listOfClsid() As GUID, _
ByRef listOfNames() As String, _
ByRef countCoClass As Long) As Boolean
Dim typeLib As IUnknown
Dim typeInf As IUnknown
Dim ret As Long
Dim count As Long
Dim index As Long
Dim pAttr As Long
Dim tKind As Long
ret = LoadTypeLibEx(StrPtr(path), REGKIND_NONE, typeLib)
If ret Then
Err.Raise ret
Exit Function
End If
count = ITypeLib_GetTypeInfoCount(typeLib)
countCoClass = 0
If count > 0 Then
ReDim listOfClsid(count - 1)
ReDim listOfNames(count - 1)
For index = 0 To count - 1
ret = ITypeLib_GetTypeInfo(typeLib, index, typeInf)
If ret Then
Err.Raise ret
Exit Function
End If
ITypeInfo_GetTypeAttr typeInf, pAttr
GetMem4 ByVal pAttr + &H28, tKind
If tKind = TKIND_COCLASS Then
memcpy listOfClsid(countCoClass), ByVal pAttr, Len(listOfClsid(countCoClass))
ret = ITypeInfo_GetDocumentation(typeInf, -1, listOfNames(countCoClass), vbNullString, 0, vbNullString)
If ret Then
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
Err.Raise ret
Exit Function
End If
countCoClass = countCoClass + 1
End If
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
Set typeInf = Nothing
Next
End If
If countCoClass Then
ReDim Preserve listOfClsid(countCoClass - 1)
ReDim Preserve listOfNames(countCoClass - 1)
Else
Erase listOfClsid()
Erase listOfNames()
End If
GetAllCoclasses = True
End Function
' // Create IDispach implementation described in type library.
Public Function CreateIDispatch( _
ByRef obj As IUnknown, _
ByRef typeLibPath As String, _
ByRef interfaceName As String) As Object
Dim typeLib As IUnknown
Dim typeInf As IUnknown
Dim ret As Long
Dim retObj As IUnknown
Dim pAttr As Long
Dim tKind As Long
ret = LoadTypeLibEx(StrPtr(typeLibPath), REGKIND_NONE, typeLib)
If ret Then
Err.Raise ret
Exit Function
End If
ret = ITypeLib_FindName(typeLib, interfaceName, 0, typeInf, 0, 1)
If typeInf Is Nothing Then
Err.Raise &H80004002, , "Interface not found"
Exit Function
End If
ITypeInfo_GetTypeAttr typeInf, pAttr
GetMem4 ByVal pAttr + &H28, tKind
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
If tKind = TKIND_DISPATCH Then
Set CreateIDispatch = obj
Exit Function
ElseIf tKind <> TKIND_INTERFACE Then
Err.Raise &H80004002, , "Interface not found"
Exit Function
End If
ret = CreateStdDispatch(Nothing, obj, typeInf, retObj)
If ret Then
Err.Raise ret
Exit Function
End If
Set CreateIDispatch = retObj
End Function
' // Create object by Name.
Public Function CreateObjectEx2( _
ByRef pathToDll As String, _
ByRef pathToTLB As String, _
ByRef className As String) As IUnknown
Dim typeLib As IUnknown
Dim typeInf As IUnknown
Dim ret As Long
Dim pAttr As Long
Dim tKind As Long
Dim clsid As GUID
ret = LoadTypeLibEx(StrPtr(pathToTLB), REGKIND_NONE, typeLib)
If ret Then
Err.Raise ret
Exit Function
End If
ret = ITypeLib_FindName(typeLib, className, 0, typeInf, 0, 1)
If typeInf Is Nothing Then
Err.Raise &H80040111, , "Class not found in type library"
Exit Function
End If
ITypeInfo_GetTypeAttr typeInf, pAttr
GetMem4 ByVal pAttr + &H28, tKind
If tKind = TKIND_COCLASS Then
memcpy clsid, ByVal pAttr, Len(clsid)
Else
Err.Raise &H80040111, , "Class not found in type library"
Exit Function
End If
ITypeInfo_ReleaseTypeAttr typeInf, pAttr
Set CreateObjectEx2 = CreateObjectEx(pathToDll, clsid)
End Function
' // Create object by CLSID and path.
Public Function CreateObjectEx( _
ByRef path As String, _
ByRef clsid As GUID) As IUnknown
Dim hLib As Long
Dim lpAddr As Long
Dim isLoad As Boolean
hLib = GetModuleHandle(StrPtr(path))
If hLib = 0 Then
hLib = LoadLibrary(StrPtr(path))
If hLib = 0 Then
Err.Raise 53, , Error(53) & " " & Chr$(34) & path & Chr$(34)
Exit Function
End If
isLoad = True
End If
lpAddr = GetProcAddress(hLib, "DllGetClassObject")
If lpAddr = 0 Then
If isLoad Then FreeLibrary hLib
Err.Raise 453, , "Can't find dll entry point DllGetClasesObject in " & Chr$(34) & path & Chr$(34)
Exit Function
End If
If Not isInit Then
CLSIDFromString StrPtr(IID_IClassFactory), iidClsFctr
CLSIDFromString StrPtr(IID_IUnknown), iidUnk
isInit = True
End If
Dim ret As Long
Dim out As IUnknown
ret = DllGetClassObject(lpAddr, clsid, iidClsFctr, out)
If ret = 0 Then
ret = IClassFactory_CreateInstance(out, 0, iidUnk, CreateObjectEx)
Else
If isLoad Then FreeLibrary hLib
Err.Raise ret
Exit Function
End If
Set out = Nothing
If ret Then
If isLoad Then FreeLibrary hLib
Err.Raise ret
End If
End Function
' // Unload DLL if not used.
Public Function UnloadLibrary( _
ByRef path As String) As Boolean
Dim hLib As Long
Dim lpAddr As Long
Dim ret As Long
If Not isInit Then Exit Function
hLib = GetModuleHandle(StrPtr(path))
If hLib = 0 Then Exit Function
lpAddr = GetProcAddress(hLib, "DllCanUnloadNow")
If lpAddr = 0 Then Exit Function
ret = DllCanUnloadNow(lpAddr)
If ret = 0 Then
FreeLibrary hLib
UnloadLibrary = True
End If
End Function
' // Call "DllGetClassObject" function using a pointer.
Private Function DllGetClassObject( _
ByVal funcAddr As Long, _
ByRef clsid As GUID, _
ByRef iid As GUID, _
ByRef out As IUnknown) As Long
Dim params(2) As Variant
Dim types(2) As Integer
Dim list(2) As Long
Dim resultCall As Long
Dim pIndex As Long
Dim pReturn As Variant
params(0) = VarPtr(clsid)
params(1) = VarPtr(iid)
params(2) = VarPtr(out)
For pIndex = 0 To UBound(params)
list(pIndex) = VarPtr(params(pIndex)): types(pIndex) = VarType(params(pIndex))
Next
resultCall = DispCallFunc(0&, funcAddr, CC_STDCALL, vbLong, 3, types(0), list(0), pReturn)
If resultCall Then Err.Raise 5: Exit Function
DllGetClassObject = pReturn
End Function
' // Call "DllCanUnloadNow" function using a pointer.
Private Function DllCanUnloadNow( _
ByVal funcAddr As Long) As Long
Dim resultCall As Long
Dim pReturn As Variant
resultCall = DispCallFunc(0&, funcAddr, CC_STDCALL, vbLong, 0, ByVal 0&, ByVal 0&, pReturn)
If resultCall Then Err.Raise 5: Exit Function
DllCanUnloadNow = pReturn
End Function
' // Call "IClassFactory:CreateInstance" method.
Private Function IClassFactory_CreateInstance( _
ByVal obj As IUnknown, _
ByVal punkOuter As Long, _
ByRef riid As GUID, _
ByRef out As IUnknown) As Long
Dim params(2) As Variant
Dim types(2) As Integer
Dim list(2) As Long
Dim resultCall As Long
Dim pIndex As Long
Dim pReturn As Variant
params(0) = punkOuter
params(1) = VarPtr(riid)
params(2) = VarPtr(out)
For pIndex = 0 To UBound(params)
list(pIndex) = VarPtr(params(pIndex)): types(pIndex) = VarType(params(pIndex))
Next
resultCall = DispCallFunc(obj, &HC, CC_STDCALL, vbLong, 3, types(0), list(0), pReturn)
If resultCall Then Err.Raise resultCall: Exit Function
IClassFactory_CreateInstance = pReturn
End Function
' // Call "ITypeLib:GetTypeInfoCount" method.
Private Function ITypeLib_GetTypeInfoCount( _
ByVal obj As IUnknown) As Long
Dim resultCall As Long
Dim pReturn As Variant
resultCall = DispCallFunc(obj, &HC, CC_STDCALL, vbLong, 0, ByVal 0&, ByVal 0&, pReturn)
If resultCall Then Err.Raise resultCall: Exit Function
ITypeLib_GetTypeInfoCount = pReturn
End Function
' // Call "ITypeLib:GetTypeInfo" method.
Private Function ITypeLib_GetTypeInfo( _
ByVal obj As IUnknown, _
ByVal index As Long, _
ByRef ppTInfo As IUnknown) As Long
Dim params(1) As Variant
Dim types(1) As Integer
Dim list(1) As Long
Dim resultCall As Long
Dim pIndex As Long
Dim pReturn As Variant
params(0) = index
params(1) = VarPtr(ppTInfo)
For pIndex = 0 To UBound(params)
list(pIndex) = VarPtr(params(pIndex)): types(pIndex) = VarType(params(pIndex))
Next
resultCall = DispCallFunc(obj, &H10, CC_STDCALL, vbLong, 2, types(0), list(0), pReturn)
If resultCall Then Err.Raise resultCall: Exit Function
ITypeLib_GetTypeInfo = pReturn
End Function
' // Call "ITypeLib:FindName" method.
Private Function ITypeLib_FindName( _
ByVal obj As IUnknown, _
ByRef szNameBuf As String, _
ByVal lHashVal As Long, _
ByRef ppTInfo As IUnknown, _
ByRef rgMemId As Long, _
ByRef pcFound As Integer) As Long
Dim params(4) As Variant
Dim types(4) As Integer
Dim list(4) As Long
Dim resultCall As Long
Dim pIndex As Long
Dim pReturn As Variant
params(0) = StrPtr(szNameBuf)
params(1) = lHashVal
params(2) = VarPtr(ppTInfo)
params(3) = VarPtr(rgMemId)
params(4) = VarPtr(pcFound)
For pIndex = 0 To UBound(params)
list(pIndex) = VarPtr(params(pIndex)): types(pIndex) = VarType(params(pIndex))
Next
resultCall = DispCallFunc(obj, &H2C, CC_STDCALL, vbLong, 5, types(0), list(0), pReturn)
If resultCall Then Err.Raise resultCall: Exit Function
ITypeLib_FindName = pReturn
End Function
' // Call "ITypeInfo:GetTypeAttr" method.
Private Sub ITypeInfo_GetTypeAttr( _
ByVal obj As IUnknown, _
ByRef ppTypeAttr As Long)
Dim resultCall As Long
Dim pReturn As Variant
pReturn = VarPtr(ppTypeAttr)
resultCall = DispCallFunc(obj, &HC, CC_STDCALL, vbEmpty, 1, vbLong, VarPtr(pReturn), 0)
If resultCall Then Err.Raise resultCall: Exit Sub
End Sub
' // Call "ITypeInfo:GetDocumentation" method.
Private Function ITypeInfo_GetDocumentation( _
ByVal obj As IUnknown, _
ByVal memid As Long, _
ByRef pBstrName As String, _
ByRef pBstrDocString As String, _
ByRef pdwHelpContext As Long, _
ByRef pBstrHelpFile As String) As Long
Dim params(4) As Variant
Dim types(4) As Integer
Dim list(4) As Long
Dim resultCall As Long
Dim pIndex As Long
Dim pReturn As Variant
params(0) = memid
params(1) = VarPtr(pBstrName)
params(2) = VarPtr(pBstrDocString)
params(3) = VarPtr(pdwHelpContext)
params(4) = VarPtr(pBstrHelpFile)
For pIndex = 0 To UBound(params)
list(pIndex) = VarPtr(params(pIndex)): types(pIndex) = VarType(params(pIndex))
Next
resultCall = DispCallFunc(obj, &H30, CC_STDCALL, vbLong, 5, types(0), list(0), pReturn)
If resultCall Then Err.Raise resultCall: Exit Function
ITypeInfo_GetDocumentation = pReturn
End Function
' // Call "ITypeInfo:ReleaseTypeAttr" method.
Private Sub ITypeInfo_ReleaseTypeAttr( _
ByVal obj As IUnknown, _
ByVal ppTypeAttr As Long)
Dim resultCall As Long
resultCall = DispCallFunc(obj, &H4C, CC_STDCALL, vbEmpty, 1, vbLong, VarPtr(CVar(ppTypeAttr)), 0)
If resultCall Then Err.Raise resultCall: Exit Sub
End Sub
Then writing this little piece of code
Code:
Function LoadObjectRegFree(DllPath As String, ObjName As String) As Object
Dim listOfClsid() As GUID, listOfNames() As String, countCoClass As Long, countiIDs As Long
GetAllCoclasses DllPath, listOfClsid, listOfNames, countCoClass
Dim i As Integer
For i = LBound(listOfNames) To UBound(listOfNames)
If listOfNames(i) = ObjName Then
Set LoadObjectRegFree = CreateObjectEx(DllPath, listOfClsid(i))
Exit Function
End If
Next i
End Function
The code works perfect, no matter where the library is!! and the casting is done without bugging I can simply load my objects by
Code:
Private Sub Class_Initialize()
Dim DX8 As DirectX8
Dim DDX As D3DX8
Set DX8 = LoadObjectRegFree("c:\Users\Public\dx8vb.dll", "DirectX8")
Set DDX = LoadObjectRegFree("c:\Users\Public\dx8vb.dll", "D3DX8")
End Sub
I hope this wil be useful for somebody, for me it has been extremely useful!
THANKS A LOT TO EVERYONE!!!
Last edited by nicopeis; Jan 4th, 2018 at 08:47 AM.
-
Jan 4th, 2018, 09:09 AM
#16
Re: [RESOLVED] Regfree DirectX dx8vb.dll usage with DirectCOM.dll
I've also used Trick's code with success in the past (as has Elroy). Very similar to Olaf's DirectCOM.
Thanks for posting the code that worked for you!
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|