Wenn es wirklich etwas mit der Grenze zu tun hätte dann würde doch das Programm überhaupt nicht funktionieren oder? ich meine es funkt ja auf einigen PCs. kann doch kein Zufall sein.
Hier einmal der Hauptcode wobei ich nichts falsches erkennen kann:
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 RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) 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
' Einige RegOpenKeyEx samDesired-Konstanten
Private Const KEY_ENUMERATE_SUB_KEYS = &H8 ' Öffnen zum Enumerieren
Private Const KEY_READ = &H20019 ' Öffnen zum Lesen
' RegEnumValue lpType-Konstanten
Private Const REG_DWORD = 4 ' Ein 32-Bit Integerwert (Little Endian)
Private Const REG_SZ = 1 ' Ein VBNullChar-Zeichen Terminierter String
' Allgemeine (ROOT) hKey-Konstanten für die Registry Funktionen
Private Const HKEY_LOCAL_MACHINE = &H80000002 ' Local Machine Schlüssel
Private Const DevClassPath = "SYSTEM\ControlSet001\Control\DeviceClasses\"
Private Const EnumPath = "System\CurrentControlSet\Enum\"
Private Const ClassPath = "System\CurrentControlSet\Control\Class\"
' API Deklaration: Hostname
Const MAX_COMPUTERNAME_LENGTH = 15
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long
' Wert eines Eintrags ermitteln (String)
Private Function GetValueStr(ByVal DevicePath As String, ByVal Value As String) As String
Dim hKey As Long, TmpStr As String * 256
' Schlüssel öffnen
Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, DevicePath, 0&, KEY_READ, hKey)
If hKey <> 0 Then
' Eintrag lesen
Call RegQueryValueEx(hKey, Value, 0&, REG_SZ, ByVal TmpStr, 256)
GetValueStr = Left$(TmpStr, InStr(1, TmpStr, vbNullChar) - 1)
RegCloseKey hKey
End If
End Function
' Wert eines Eintrags ermitteln (Long)
Private Function GetValueLng(ByVal DevicePath As String, ByVal Value As String) As Long
Dim hKey As Long, TmpLng As Long
' Schlüssel öffnen
Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, DevicePath, 0&, KEY_READ, hKey)
If hKey <> 0 Then
' Eintrag lesen
Call RegQueryValueEx(hKey, Value, 0&, REG_SZ, TmpLng, 4)
GetValueLng = TmpLng
RegCloseKey hKey
End If
End Function
' Enumerieren aller installierten Geräte
Public Function EnumConntectedDevices()
Dim hKey As Long, TmpStr As String * 256, RegClass As String * 256, i As Integer, Retval As Long
' Schlüssel der installierten Hardwareklassen öffnen
Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, DevClassPath, 0&, KEY_ENUMERATE_SUB_KEYS, hKey)
If hKey <> 0 Then
Do
' Hardwareklassen Enumerieren
Retval = RegEnumKeyEx(hKey, i, TmpStr, Len(TmpStr), ByVal 0&, RegClass, Len(RegClass), ByVal 0&)
If Retval <> 0 Then
Exit Do
End If
i = i + 1
' Hardwaregeräte Enumerieren
Call EnumDevices(DevClassPath & Left$(TmpStr, InStr(1, TmpStr, vbNullChar) - 1) & "\")
Loop
RegCloseKey hKey
End If
End Function
' Geräte einer Klasse Enumerieren
Private Function EnumDevices(ByVal DevicePath As String)
Dim hKey As Long, TmpStr As String * 256, RegClass As String * 256, i As Integer, Retval As Long
' Schlüssel der Geräte öffnen
Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, DevicePath, 0&, KEY_ENUMERATE_SUB_KEYS Or KEY_READ, hKey)
If hKey <> 0 Then
Do
' Geräte der Hardwareklasse Enumerieren
Retval = RegEnumKeyEx(hKey, i, TmpStr, Len(TmpStr), ByVal 0&, RegClass, Len(RegClass), ByVal 0&)
If Retval <> 0 Then
Exit Do
End If
i = i + 1
' Emulierte Netzwekgeräte filtern
If Right$(DevicePath, 39) = "{ad498944-762f-11d0-8dcb-00c04fc3358c}\" Then
If UCase(Left$(TmpStr, 8)) <> "##?#ROOT" And UCase(Left$(TmpStr, 6)) <> "##?#SW" Then
Call EnumSubDevices(DevicePath & Left$(TmpStr, InStr(1, TmpStr, vbNullChar) - 1) & "\")
End If
Else
Call EnumSubDevices(DevicePath & Left$(TmpStr, InStr(1, TmpStr, vbNullChar) - 1) & "\")
End If
Loop
RegCloseKey hKey
End If
End Function
' Instanzen der selben Hardware Enumerieren (z.B. Wave & Midi einer Soundkarte)
Private Function EnumSubDevices(ByVal DevicePath As String)
Dim hKey As Long, TmpStr As String * 256, RegClass As String * 256, i As Integer, Retval As Long
Dim DevInstance As String, DevDesc As String, LI As ListItem, DExist As Boolean, j As Integer
Call RegOpenKeyEx(HKEY_LOCAL_MACHINE, DevicePath, 0&, KEY_ENUMERATE_SUB_KEYS Or KEY_READ, hKey)
For i = 0 To GetValueLng(DevicePath & "Control\", "ReferenceCount")
' Untergerät ermitteln
Retval = RegEnumKeyEx(hKey, i, TmpStr, Len(TmpStr), ByVal 0&, RegClass, Len(RegClass), ByVal 0&)
' Gerät angeschlossen?
If GetValueLng(DevicePath & Left$(TmpStr, InStr(1, TmpStr, vbNullChar) - 1) & "\Control\", "Linked") = 1 Then
' DeviceInstance Pfad ermitteln
DevInstance = GetValueStr(DevicePath, "DeviceInstance")
DevDesc = GetValueStr(EnumPath & DevInstance & "\", "DeviceDesc")
If DevDesc = "" Then DevDesc = GetValueStr(EnumPath & DevInstance & "\", "DeviceDesc")
' Doppelte Einträge?
DExist = False
For j = 1 To ListView1.ListItems.Count
If ListView1.ListItems(j).SubItems(1) = DevInstance Then DExist = True
Next j
' Doppelte, Storage, System und SW Geräte wollen wir nicht!
If Not DExist And UCase(Left$(DevInstance, 2)) <> "SW" And UCase(Left$(DevInstance, 7)) <> "STORAGE" And _
UCase(GetValueStr(EnumPath & GetValueStr(DevicePath, "DeviceInstance"), "Class")) <> "SYSTEM" Then
Set LI = ListView1.ListItems.Add(, , DevDesc)
LI.SubItems(1) = DevInstance
End If
End If
Next i
RegCloseKey hKey
End Function
