|
game_maker
Knave
Saudi Arabia
83 Posts |
 Posted - Jun 19 2004 : 8:54:04 PM
|
Hi
How to get DirectX version using native VB ?
|
|
|
Sr. Guapo
Swordmaster
USA
272 Posts |
Posted - Jun 19 2004 : 9:27:58 PM
|
Do you mean no D3DCaps or anything, just VB? I don't know... Why would you need to detect the DX version w/out DX calls in the first place?
|
 |
|
|
Eric Coleman
Gladiator
USA
811 Posts |
|
|
game_maker
Knave
Saudi Arabia
83 Posts |
Posted - Jun 20 2004 : 12:54:44 AM
|
Sr. Guapo :
I need to tell the user what version he has to tell him if he/she can play my game or not 
Eric :
exactly what I want 100% 
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal numBytes As Long)
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
Function GetDirectXVersion() As Long
Dim handle As Long, resString As String, resBinary() As Byte
If RegOpenKeyEx(&H80000002, "SOFTWARE\Microsoft\DirectX", 0, &H20019, handle) Then Exit Function
ReDim resBinary(1023) As Byte
Call RegQueryValueEx(handle, "Version", 0, 0, resBinary(0), 1024)
resString = Space$(1023)
CopyMemory ByVal resString, resBinary(0), 1023
RegCloseKey handle
resString = Left(resString, 12)
If Not StrComp(resString, "4.05.00.0155", vbBinaryCompare) Then GetDirectXVersion = 50
If Not StrComp(resString, "4.05.01.1721", vbBinaryCompare) Then GetDirectXVersion = 50
If Not StrComp(resString, "4.05.01.1998", vbBinaryCompare) Then GetDirectXVersion = 50
If Not StrComp(resString, "4.06.02.0436", vbBinaryCompare) Then GetDirectXVersion = 60
If Not StrComp(resString, "4.07.00.0700", vbBinaryCompare) Then GetDirectXVersion = 70
If Not StrComp(resString, "4.07.00.0716", vbBinaryCompare) Then GetDirectXVersion = 71
If Not StrComp(resString, "4.08.00.0400", vbBinaryCompare) Then GetDirectXVersion = 80
If Not StrComp(resString, "4.08.01.0881", vbBinaryCompare) Then GetDirectXVersion = 85
If Not StrComp(resString, "4.09.00.0900", vbBinaryCompare) Then GetDirectXVersion = 90
If Not StrComp(resString, "4.09.00.0901", vbBinaryCompare) Then GetDirectXVersion = 91
If Not StrComp(resString, "4.09.00.0902", vbBinaryCompare) Then GetDirectXVersion = 92
End Function
Private Function SwapEndian(ByVal dw As Long) As Long
CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
End Function
Private Sub Form_Load()
MsgBox GetDirectXVersion
End Sub
x1 ,x2 ; 1 and 2 stands for alpha, beta
x5 ..... x9 ; stands for .1 to .5
|
|
|
|
VBBR
Moderator
Brazil
617 Posts |
Posted - Jun 20 2004 : 06:52:23 AM
|
Or you can use the dsetup DLL... I got this from the SDK Setup1 installer:
Option Explicit
Private Const DSETUP_DDRAWDRV As Long = 8
Private Const DSETUP_DSOUNDDRV As Long = 16
Private Const DSETUP_DXCORE As Long = 65536
Private Const DSETUP_DIRECTX As Long = (DSETUP_DXCORE Or DSETUP_DDRAWDRV Or DSETUP_DSOUNDDRV)
Private Const DSETUP_TESTINSTALL As Long = 131072
Private Const DSETUP_NTINSTALL As Long = 524288
Private Const DSETUPERR_SUCCESS_RESTART As Long = 1
Private Const DSETUPERR_SUCCESS As Long = 0
Private Const DSETUP_VERSION As Long = &H40000
Private Declare Function DirectXSetup Lib "dsetup.dll" Alias "DirectXSetupA" (ByVal hWnd As Long, ByVal lpszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function DirectXSetupGetVersion Lib "dsetup.dll" (dwVersion As Long, dwRevision As Long) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Const EWX_FORCE = 4
Public Const EWX_LOGOFF = 0
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Sub Main()
Dim fInstall As Boolean, ret As Long
Dim lMajor As Long, lMinor As Long
Dim gfDXReboot As Boolean
Dim sTemp As String, sRootPath As String
sRootPath = Trim$(Command$)
If sRootPath = "" Or Dir(sRootPath & "dsetup.dll") = "" Then
MsgBox "Invalid command-line path.", vbCritical + vbOKOnly, "Error"
End
End If
fInstall = False ret = DirectXSetupGetVersion(lMajor, lMinor)
If ret = 0 Then
fInstall = True
Else
lMajor = lMajor - (lMajor And DSETUP_VERSION)
If lMajor < 8 Then fInstall = True
Else
End If
End If
If fInstall Then ret = DirectXSetup(0, sRootPath, DSETUP_DIRECTX)
If ret = DSETUPERR_SUCCESS Then
ElseIf ret = DSETUPERR_SUCCESS_RESTART Then
gfDXReboot = True
Else
MsgBox "An error occured whilst trying to install DirectX 8.0 on your computer. The program may not function properly.", vbCritical + vbOKOnly, "DirectX 8.0"
End If
End If
If gfDXReboot Then
If MsgBox("The computer needs to be restarted to finish the DirectX8.0 Setup. Click ExitWindowsEx EWX_REBOOT, 0
End If
End If
End Sub
Create a new project, add a module and voila. Start this program with an argument that is a folder with the DIrectX8 install program. DSETUP.DLL must be on the same folder as the program. Then execute it and it will check the version THEN install the right version if it is needed. (You can just use your method above and mix it with the DirectSetup commands that are here) |
Whatever. Who knows... |
|
|
|
Eric Coleman
Gladiator
USA
811 Posts |
Posted - Jun 20 2004 : 10:26:09 AM
|
Game_maker, that list of directx versions isn't complete, and there is some variation with the last four numbers, so your test won't always work. And it will fail for testing for DirectX 9 because you're testing "4.09.00.0900" versus "4.09.0000.0900". Notice the extra zero's in the DirectX 9 versions.
I think this might work a bit better,
Sub ParseVersion(ByVal strVersion As String, _
ByRef v1 As Long, _
ByRef v2 As Long, _
ByRef v3 As Long, _
ByRef v4 As Long)
Dim strArray() As String
strArray = Split(strVersion, ".")
If UBound(strArray) >= 3 Then
v1 = CLng(strArray(0))
v2 = CLng(strArray(1))
v3 = CLng(strArray(2))
v4 = CLng(strArray(3))
End If
End Sub
Instead of a large section of "If...Then..." statements, you could use the following code to check to see if the minimum version is installed. This also prevents your function from failing when a different version of directX is released that your function doesn't check for.
Dim DxVersion(0 to 3) As Long
Call ParseVersion(resString, DxVersion(0), DxVersion(1), DxVersion(2), DxVersion(3))
If (DxVersion(1) < MinMajorVersion) Then Return False
If (DxVersion(2) < MinMinorVersion) Then Return False
If (DxVersion(3) < MinRevisionVersion) Then Return False
Return True
|
|
|
|
game_maker
Knave
Saudi Arabia
83 Posts |
Posted - Jun 21 2004 : 5:58:56 PM
|
VBBR / Eric : Very nice Code 
But I don't know why I am getting 4.09.00.0900 in my computer !
But even if it's .0000000000000. your code will work
|
|
|
|
|
How to get DirectX version using native VB
