Dark Ranger
Erfahrenes Mitglied
Code:
Option Explicit
' Die Netzwerk-Resource im Klartext
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
' Die Netzwerk-Resource, wie die API sie braucht
Private Type NETRESOURCE_P
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCE_CONNECTED = &H1
Private Const RESOURCE_PRIVATENET = &H2
Private Const RESOURCE_REMEMBERED = &H3
Private Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCETYPE_PRINT = &H2
Private Const RESOURCETYPE_UNKNOWN = &HFFFF
Private Const RESOURCEUSAGE_CONNECTABLE = &H1
Private Const RESOURCEUSAGE_CONTAINER = &H2
Private Const RESOURCEUSAGE_RESERVED = &H80000000
Private Const ERROR_NO_MORE_ITEMS = 259
Private Declare Function lstrcpy Lib "kernel32" ( _
ByVal DestinationStr As String, _
ByVal SourcePtr As Long _
) As Long
Private Declare Function lstrlen Lib "kernel32" ( _
ByVal SourcePtr As Long _
) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" ( _
ByVal EnumHandle As Long _
) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" ( _
ByVal EnumHandle As Long, _
lpcCount As Long, _
lpBuffer As Any, _
lpBufferSize As Long _
) As Long
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" ( _
ByVal dwScope As Long, _
ByVal dwType As Long, _
ByVal dwUsage As Long, _
lpNetResource As NETRESOURCE, _
EnumHandle As Long _
) As Long
Private Function Pointer_to_String(Pointer As Long) As String
' Speicher reservieren
Dim Adresse As Long
Dim Laenge As Long
Dim Puffer As String
' Wenn der Pointer Null ist, dann gibt es einen Fehler
If (Pointer <> 0) Then
' Länge des benötigten Speichers ermitteln
Laenge = lstrlen(Pointer)
' Benötigten Speicher initialisieren
Puffer = Space(Laenge + 1)
' Daten, auf die der Pointer zeigt, in den Speicher kopieren
Adresse = lstrcpy(Puffer, Pointer)
Else
' Keine daten vorhanden
Puffer = vbNullString & vbNullChar
End If
' Das abschließende NullChar beseitigen
Pointer_to_String = Left(Puffer, InStr(Puffer, vbNullChar) - 1)
End Function
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 SubDas ist der gesamte Code!
