der obige Code funktioniert super. Nun wollte ich diesen erweitern, um auch die Beschreibung bzw. weitere Infos (FriendlyName) über den ermittelten PNP-Schlüssel aus der Registry zu holen - das führt dann aber regelmäßig zum Absturz, wenn ein Schlüssel nicht existiert.
Es muß mit dem Code zum ermitteln der PNP zusammenhängen, denn die Registryroutine funktioniert ansonsten problemlos.
Code: Alles auswählen
; Registry code: Stephen Rodriguez,
; Based upon code found at : http://www.purebasic.fr/german/viewtopic.php?p=177460#177460
; and http://forums.purebasic.com/german/viewtopic.php?f=8&t=1833
Procedure.s RegGetValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
Protected lpData.s=Space(255), GetValue.s
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l, lpcbData.l, lType.l, lpType.l
Protected lpDataDWORD.l
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_READ, @hKey)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_READ, @hKey)
EndIf
If GetHandle = #ERROR_SUCCESS
lpcbData = 255
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
If GetHandle = #ERROR_SUCCESS
Select lType
Case #REG_SZ
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
If GetHandle = 0
GetValue = Left(lpData, lpcbData - 1)
Else
GetValue = ""
EndIf
Case #REG_DWORD
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lpType, @lpDataDWORD, @lpcbData)
If GetHandle = 0
GetValue = Str(lpDataDWORD)
Else
GetValue = "0"
EndIf
Case #REG_BINARY
*bdat=AllocateMemory(lpcbdata)
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lpType, *bdat, @lpcbData)
If GetHandle = 0
While a = < lpcbData -1
GetValue + RSet(Hex(PeekB(*bdat+a) & $FF,1),2,"0")
a+1
Wend
Else
GetValue = ""
EndIf
FreeMemory(*bdat)
EndSelect
EndIf
EndIf
RegCloseKey_(hKey)
ProcedureReturn GetValue
EndProcedure
Structure SP_DEVINFO_DATA
cbSize.l
ClassGuid.GUID
DevInst.l
Reserved.l
EndStructure
Procedure GetHardware()
#DIGCF_PRESENT = 2
#DIGCF_ALLCLASSES = 4
Protected shwd$
Protected g$,ab$,ab1$
Protected g1$,i,sg$
hDeviceInfoSet = SetupDiGetClassDevs_(0,0,0,#DIGCF_PRESENT|#DIGCF_ALLCLASSES)
DeviceInfoData.SP_DEVINFO_DATA
DeviceInfoData\cbSize=SizeOf(DeviceInfoData)
i=0
OpenLibrary(1,"cfgmgr32.dll")
*F1 = GetFunction(1, "CM_Get_Device_IDA")
Repeat
If SetupDiEnumDeviceInfo_(hDeviceInfoSet,i,@DeviceInfoData) <> 0
i+1
pnplen = 256
pnp.s = Space(bufferlen)
;CallFunction(1,"CM_Get_Device_IDA",DeviceInfoData\DevInst,@pnp,pnplen,0)
CallFunctionFast(*F1,DeviceInfoData\DevInst,@pnp,pnplen,0)
shwd$+Trim(pnp)+Chr(13)
Else
Break
EndIf
ForEver
CloseLibrary(1)
SetupDiDestroyDeviceInfoList_(hDeviceInfoSet)
gf=CountString(shwd$,Chr(13))-1
For i=1 To gf
g$= StringField(shwd$,i,Chr(13))
sg$="SYSTEM\CurrentControlSet\Enum\"+g$+"\"
ab$=RegGetValue(#HKEY_LOCAL_MACHINE,sg$,"DeviceDesc")
ab1$=RegGetValue(#HKEY_LOCAL_MACHINE,sg$,"Mfg")
If ab1$=""
ab1$=RegGetValue(#HKEY_LOCAL_MACHINE,sg$,"FriendlyName")
EndIf
Debug g$+ " ("+Trim(ab$+" "+ab1$)+")"
Next
EndProcedure
GetHardware()
