PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

GPU Name

https://www.purebasic.fr/english/viewtopic.php?t=46991

Page 1 of 2

GPU Name

Posted: Mon Jul 25, 2011 2:07 am
by IdeasVacuum
How to find (programmatically) the Graphics Card/GPU Manufacturer/Name/Model and, if OpenGL is supported, the OpenGL version?

Performed a manual search of the registry, nothing man readable in the Hardware list but in the Software list some graphics apps have recorded this info - how did they find it though?

Edit: Possibly using WMI

Re: GPU Name

Posted: Mon Jul 25, 2011 7:15 pm
by RASHAD
Hi

Code: Select all

#COINIT_MULTITHREAD=0 
#RPC_C_AUTHN_LEVEL_CONNECT=2 
#RPC_C_IMP_LEVEL_IDENTIFY=2 
#EOAC_NONE=0 
#RPC_C_AUTHN_WINNT=10 
#RPC_C_AUTHZ_NONE=0 
#RPC_C_AUTHN_LEVEL_CALL=3 
#RPC_C_IMP_LEVEL_IMPERSONATE=3 
#CLSCTX_INPROC_SERVER=1 
#wbemFlagReturnImmediately=16 
#wbemFlagForwardOnly=32 
#IFlags = #wbemFlagReturnImmediately + #wbemFlagForwardOnly 
#WBEM_INFINITE=$FFFFFFFF 
#WMISeparator="," 

Procedure.l ansi2bstr(ansi.s) 
  size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0) 
  Dim unicode.w(size) 
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size) 
  ProcedureReturn SysAllocString_(@unicode()) 
EndProcedure 

Procedure bstr2string (bstr) 
  Shared WMIResult.s 
  WMIResult.s = "" 
  pos=bstr 
  While PeekW (pos) 
    WMIResult=WMIResult+Chr(PeekW(pos)) 
    pos=pos+2 
  Wend 
  ProcedureReturn @WMIResult 
EndProcedure 

ProcedureDLL.s WMI(WMICommand.s) 
  CoInitializeEx_(0,#COINIT_MULTITHREAD) 
  hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0) 
  If hres <> 0: MessageRequester("ERROR", "unable to call CoInitializeSecurity", #MB_OK): Goto cleanup: EndIf 
  hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator) 
  If hres <> 0: MessageRequester("ERROR", "unable to call CoCreateInstance", #MB_OK): Goto cleanup: EndIf 
  hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices) 
  If hres <> 0: MessageRequester("ERROR", "unable to call IWbemLocator::ConnectServer", #MB_OK): Goto cleanup: EndIf 
  hres=svc\QueryInterface(?IID_IUnknown,@pUnk.IUnknown) 
  hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
  If hres <> 0: MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK): Goto cleanup: EndIf 
  hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
  If hres <> 0: MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK): Goto cleanup: EndIf 
  pUnk\Release() 
  
  
  k=CountString(WMICommand,#WMISeparator) 
  Dim wmitxt$(k) 
  For i=0 To k 
    wmitxt$(i) = StringField(WMICommand,i+1,#WMISeparator) 
  Next 
  
  hres=svc\ExecQuery(ansi2bstr("WQL"),ansi2bstr(wmitxt$(0)), #IFlags,0,@pEnumerator.IEnumWbemClassObject) 
  If hres <> 0: MessageRequester("ERROR", "unable to call IWbemServices::ExecQuery", #MB_OK): Goto cleanup: EndIf 
  hres=pEnumerator\reset() 
  Repeat 
  hres=pEnumerator\Next(#WBEM_INFINITE, 1, @pclsObj.IWbemClassObject, @uReturn) 
  For i=1 To k 
    mem=AllocateMemory(1000) 
    hres=pclsObj\get(ansi2bstr(wmitxt$(i)), 0, mem, 0, 0) 
    Type=PeekW(mem) 
    Select Type 
      Case 8 
        val.s=PeekS(bstr2string(PeekL(mem+8))) 
      Case 3 
        val.s=Str(PeekL(mem+8)) 
      Default 
        val.s="" 
    EndSelect 
    If uReturn <> 0: wmi$=wmi$+wmitxt$(i)+" = "+val+Chr(10)+Chr(13): EndIf 
    FreeMemory(mem) 
  Next 
Until uReturn = 0 

cleanup: 
svc\Release() 
loc\Release() 
pEnumerator\Release() 
pclsObj\Release() 
CoUninitialize_() 

ProcedureReturn wmi$ 
EndProcedure 

DataSection 
CLSID_IEnumWbemClassObject:
Data.l $1B1CAD8C 
Data.w $2DAB, $11D2 
Data.b $B6, $04, $00, $10, $4B, $70, $3E, $FD 
IID_IEnumWbemClassObject:
Data.l $7C857801 
Data.w $7381, $11CF 
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
CLSID_WbemLocator:
Data.l $4590F811 
Data.w $1D3A, $11D0 
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24 
IID_IWbemLocator:
Data.l $DC12A687 
Data.w $737F, $11CF 
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
IID_IUnknown:
Data.l $00000000 
Data.w $0000, $0000 
Data.b $C0, $00, $00, $00, $00, $00, $00, $46 

EndDataSection 



MessageRequester("WMI",WMI("SELECT * FROM Win32_VideoController,DeviceID,Caption,AdapterDACType,DriverVersion,InstalledDisplayDrivers,CurrentBitsPerPixel,CurrentRefreshRate,CurrentHorizontalResolution,CurrentVerticalResolution" ))

Re: GPU Name

Posted: Mon Jul 25, 2011 10:34 pm
by luis
IdeasVacuum wrote:How to find (programmatically) the Graphics Card/GPU Manufacturer/Name/Model and, if OpenGL is supported, the OpenGL version?
OpenGL would require some work. In the end you can use glGetString_(#GL_VERSION), but to call that you must have a valid opengl compatible device context. Look for nehe opengl lesson #1 on internet or the port available in this forum, cut and paste and add the glGetString_ above !

http://www.opengl.org/wiki/GlGetString# ... VERSION.29

Re: GPU Name

Posted: Tue Jul 26, 2011 12:01 am
by IdeasVacuum
Hi Rashad

That's a meaty piece of code, thank you :D

It's totally foreign to me so I'm struggling with the errors. Line 42 pops-up an error message "unable to call IWbemLocator::ConnectServer", and then redirects to cleanup, which crashes with an invalid memory access. That apparently is because the svc struct is not defined?

Re: GPU Name

Posted: Tue Jul 26, 2011 12:38 am
by IdeasVacuum
Hi Luis

Thank you - I think I should be able to figure that one out. I'm not actually creating a program that uses OpenGL but I need to check the OpenGL version available as my app is an add-on to another app that does depend on it, but is not necessarily compatible with all OpenGL versions.

Have got a strange thing going on with PB already though, with incomplete code. I have set OpenGL as the only Library Subsystem.

Code: Select all

#GL_VERSION = $1F02

sGlVersion.s = glGetString_(#GL_VERSION)

Debug sGlVersion
With the above code, the PB compiler fails with this error message:

Line 3: Can't write a numerical value into a string variable.

If I change the var to a long, PB is happy with it but of course the function is going to return a string.......tricky.

EDIT: Tried the following instead, same failure:

Code: Select all

#GL_VERSION = $1F02

Import "Opengl32.lib"
   glGetString(a.l)
EndImport

sGlVersion.s = glGetString(#GL_VERSION)

Debug sGlVersion

Re: GPU Name

Posted: Tue Jul 26, 2011 3:24 am
by citystate
my guess would be that glGetString_() is returning a pointer
try

Code: Select all

sGlVersion.s = PeekS(glGetString_(#GL_VERSION))
or (as a last resort)

Code: Select all

sGlVersion.s = Str(glGetString_(#GL_VERSION))

Re: GPU Name

Posted: Tue Jul 26, 2011 6:09 am
by netmaestro
The opengl functions require a valid rendering surface. You must choose "opengl" as subsystem in your compiler options, choose ansi executable (not unicode), then you may try this code and you should get something:

Code: Select all

#GL_VERSION = $1F02

Import "Opengl32.lib"
  glGetString(a)
EndImport

InitSprite()
OpenScreen(800,600,32,"")

; Now we have a valid context, let's try a function..
sGlVersion$ = PeekS(glGetString(#GL_VERSION))

CloseScreen()

Debug sGlVersion$
I get "1.4.0 - Build 8.15.10.1912" here. Your mileage may vary. Proceed to cash 'n carry.

Re: GPU Name

Posted: Tue Jul 26, 2011 11:56 am
by IdeasVacuum
Ah, should have realised it would not simply be a string.

That works well netmaestro, my result is "2.1.2".

I think my customers will find the 'whole screen goes black' alarming (they are infrequent users of PCs). So, I changed the OpenScreen() size to 100*100, which draws a mini screen of that size but fails the glGetString function '[ERROR] Specified address is null'. That seems strange to me, but a tiny WindowedScreen works OK. If anyone else needs it, here is the final code snippet:

Code: Select all

#GL_VERSION = $1F02

Import "opengl32.lib"
  glGetString(a)
EndImport

InitSprite()
WinId = OpenWindow(0, 0, 0, 100, 100, "OpenGL")
OpenWindowedScreen(WinId,0,0,100,100,0,0,0)

; Now we have a valid context, let's try a function..
sGlVersion$ = PeekS(glGetString(#GL_VERSION))

CloseScreen()

Debug sGlVersion$

Re: GPU Name

Posted: Tue Jul 26, 2011 12:10 pm
by luis
Sorry I was sleeping :)

Yes, if you can use the opengl subsystem shortcut then the code from netmaestro is the fastest way!

BTW, you can avoid to import the ogl function for this simple snippets if you like.

Keep in mind the OGL version is X.Y the rest is vendor dependent.

This should always work:

Code: Select all

#GL_VERSION = $1F02

InitSprite()
WinId = OpenWindow(0, 0, 0, 100, 100, "OpenGL")
OpenWindowedScreen(WinId,0,0,100,100,0,0,0)

; Now we have a valid context, let's try a function..
sGlVersion$ = PeekS(glGetString_(#GL_VERSION))
sGlVersion$ = StringField(sGlVersion$, 1, " ")

CloseScreen()

Debug StringField(sGlVersion$, 1, ".") ; major
Debug StringField(sGlVersion$, 2, ".") ; minor

Re: GPU Name

Posted: Tue Jul 26, 2011 12:14 pm
by luis
netmaestro wrote: I get "1.4.0 - Build 8.15.10.1912" here. Your mileage may vary. Proceed to cash 'n carry.
What card is that ? Maybe an Intel integrated ? Thanks.

Re: GPU Name

Posted: Tue Jul 26, 2011 12:44 pm
by IdeasVacuum
citystate 100% correct, definitely not talking out of his hat :mrgreen:

Re: GPU Name

Posted: Tue Jul 26, 2011 12:49 pm
by IdeasVacuum
glGetString_(#GL_VERSION)

good tip Luis, thank you.

Re: GPU Name

Posted: Tue Jul 26, 2011 1:03 pm
by IdeasVacuum
My wife's laptop result: OpenGL version: 2.1.0 - Build 8.15.10.2302

That's built-in Intel HD Graphics (i3)

Re: GPU Name

Posted: Tue Jul 26, 2011 1:07 pm
by luis
IdeasVacuum wrote: That's built-in Intel HD Graphics (i3)
I see, thanks. Same format so I guess netmaestro's is an Intel too.

Bye!

Re: GPU Name

Posted: Tue Jul 26, 2011 5:41 pm
by IdeasVacuum
Extensive info about the GPU is delivered by the DirectX Diagnostic Tool, dxdiag.exe

So, that's great thinks me, as it will output a text file in command line mode which can be parsed. Unfortunately, it takes a month of Sundays to write the file :cry:
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited