Private Sub cmdSchauen_Click()
' Speicher reservieren
Dim txtComputer As String
Dim Count As Long
Dim EnumHandle As Long
Dim NullString As NETRESOURCE
Dim ReturnValue As Long
Dim SizeTestR As Long
Dim StringPtr As String
Dim TestR(4096) As NETRESOURCE_P
Dim Zaehler As Long
Dim MicrosoftRoot As NETRESOURCE
Dim MachineContainer As NETRESOURCE
Dim NetResult As Integer
Dim hEnum As Long
Dim i As Long
Dim cbCount As Long
Dim lString As String
Dim ParentNodeName As String
' Root-Struktur definieren
NullString.dwDisplayType = 0
NullString.dwScope = 0
NullString.dwType = 0
NullString.dwUsage = 0
NullString.lpComment = vbNullChar
NullString.lpLocalName = vbNullChar
NullString.lpProvider = vbNullChar
NullString.lpRemoteName = vbNullChar
' leere Root-Struktur auf Microsoft übertragen
MicrosoftRoot = NullString
' Wurzel des Netzwerkes finden
ReturnValue = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_CONTAINER, NullString, EnumHandle)
' Fehler aufgetreten?
If (ReturnValue = 0) Then
' Nein, Größe des Zwischenspeichers festlegen
SizeTestR = 4096 * 5
' Maximale Anzahl der Resourcen festlegen
Count = &HFFFFFFFF
' Resourcen auslesen
ReturnValue = WNetEnumResource(EnumHandle, Count, TestR(0), SizeTestR)
' Ist ein Fehler aufgetreten?
If (ReturnValue = 0) Then
' Nein, Puffer in lokalen Array aus NETRESOURCE Struktur kopieren und nach "Microsoft" Provider suchen
For Zaehler = 0 To Count
' String an der Adresse auslesen
StringPtr = Pointer_to_String(TestR(Zaehler).lpRemoteName)
' Enthält der Text das Wort "Microsoft"?
If (UCase(Left(StringPtr, 9)) = "MICROSOFT") Then
' Ja, also Informationen in die Root-Struktur kopieren
MicrosoftRoot.dwDisplayType = TestR(Zaehler).dwDisplayType
MicrosoftRoot.dwScope = TestR(Zaehler).dwScope
MicrosoftRoot.dwType = TestR(Zaehler).dwType
MicrosoftRoot.dwUsage = TestR(Zaehler).dwUsage
MicrosoftRoot.lpComment = Pointer_to_String(TestR(Zaehler).lpComment)
MicrosoftRoot.lpLocalName = Pointer_to_String(TestR(Zaehler).lpLocalName)
MicrosoftRoot.lpProvider = Pointer_to_String(TestR(Zaehler).lpProvider)
MicrosoftRoot.lpRemoteName = StringPtr
End If
Next Zaehler
' Resourcen schließen
WNetCloseEnum EnumHandle
End If
End If
' Wurde eine Resource benannt?
If (txtComputer <> vbNullString) Then
' Ja, handelt es sich um einen Computer?
If (Left(txtComputer, 2) = "\\") Then
' Ja, also die Freigaben des Netzes ermitteln
MachineContainer.lpProvider = MicrosoftRoot.lpProvider
MachineContainer.lpRemoteName = txtComputer
' Handle zum Auslesen erstellen
NetResult = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, MachineContainer, hEnum)
' Erfolgreich?
If (NetResult = 0) Then
' Wiederholen, bis keine Freigaben mehr vorhanden sind.
Do While (NetResult <> ERROR_NO_MORE_ITEMS)
' Systemevents verarbeiten
DoEvents
' Speicher initialisieren
Count = &HFFFFFFFF
SizeTestR = 4096 * 5
' Die Freigaben ermitteln
NetResult = WNetEnumResource(hEnum, Count, TestR(0), SizeTestR)
' Ist ein Fehler aufgetreten?
If ((NetResult <> 0) And (NetResult <> ERROR_NO_MORE_ITEMS)) Then
' Ja, also Schleife verlassen
Exit Do
Else
For i = 0 To Count - 1
' Die Daten kopieren
lString = Pointer_to_String(TestR(i).lpRemoteName)
' Wurde eine Freigabe ermittelt?
If (lString <> vbNullString) Then
' Den Computer wegschneiden
lString = Right(lString, Len(lString) - Len(ParentNodeName))
' Freigabe ausgeben
txtAusgabe.Text = txtAusgabe.Text & lString & vbTab
' Typ der Freigabe ermitteln
If TestR(i).dwType = RESOURCETYPE_DISK Then
Debug.Print " ist ein Laufwerk"
Else
Debug.Print " ist ein Drucker"
End If
End If
Next i
End If
Loop
End If
' Aufzählungshandle schließen oder Memory Leak erzeugen
WNetCloseEnum hEnum
End If
End If
End Sub