Index out of Bounds ?

olek

Mitglied
Servus an alle VB-Fans!

Habe ein kleines Programm das die Hardware ausliest.
Die Form besteht aus einem ListView1 mit 2 Spalten (Geräte, PNP-Kennung)
Die Hardware soll in ein Textfile hineingeschrieben werden.
Beim Ausführen folgt jedoch ein Index out of Bounds Fehler bei der Zeile:
Print #Filenum, ListView1.ListItems(j).Text

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 Integer wert (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\"
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

' 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 & "\", "FriendlyName")
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

-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

' Beim Laden der Form die Geräte finden
Private Sub Form_Load()

With ListView1
.ListItems.Clear
.Sorted = True ' Sortierte Anzeige
.SortKey = 0 ' Sortierung nach erster Spalte
.SortOrder = lvwAscending ' Aufsteigende Sortierung

EnumConntectedDevices

Dim Filenum As Integer
Dim j As Integer
Dim itemX As ListItem

' Pfadangabe aus hardware_pfad.ini auslesen und Inhalt in Variable "hpfad" abspeichern
Open "hardware_pfad.ini" For Input As #2
Do While Not EOF(2)
Line Input #2, hpfad
Loop
Close #2

' Ausgelesene Daten in ein .txt File schreiben mit Pfad der aus .ini ausgelesen wurde
Filenum = FreeFile
Open hpfad & GetDomain & "_hardware.txt" For Output As #Filenum
For j = 0 To ListView1.ListItems.Count
Print #Filenum, ListView1.ListItems(j).Text
Next j
Close #Filenum

End With
End Sub

-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

' Hostname ermitteln um diesen als Textdateinamen zu übernehmen
Function GetDomain() As String
On Error Resume Next

' Verweis auf 'Windows Script Host Object Model nötig

' Spätes Binden (late binding)
Dim objWSHNetwork As Object
Set objWSHNetwork = CreateObject("WScript.Network")

'Aktuelle Domäne ermitteln
GetDomain = objWSHNetwork.UserDomain

'Speicher freigeben
Set objWSHNetwork = Nothing
End Function


-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Wo liegt der Fehler
DANKE für jede HILFE

Cya Alex
 
so geht's:
Code:
For j = 1 To ListView1.ListItems.Count 
Print #Filenum, ListView1.ListItems(j).Text
Next j
Du hättest nicht den ganzen Code posten müssen, das macht alles viel zu unübersichtlich!
 
Wow Super!
Jetzt läuft das ganze Ding endlich *hehe*
Danke dir nochmals!
Scheinst der spitzen VB-Guru zu sein. Bist in fast allen Themen aufzufinden und deine Tipps sind auch spitze!

Cya Alex
 
Zurück