Netzwerkressourcen
Ressourcen, wie Drucker oder freigegebene Dateien und Laufwerke
im Netzwerk liefert diese Funktion. Das gesamte Netzwerk wird durchsucht, weshalb
es bei großen Netzwerken etwas länger dauern kann. Geduld ist dann
gefragt. Da ich es hasse, mehr Code als nötig zu schreiben, benutze ich
gerne Rekursionen, auch wenn der Entwicklungsaufwand dies nicht immer (fast
nie) rechtfertigt. Interessant dabei ist auch meine hier eingesetzte Technik,
Strukturen optional an eine Funktion zu übergeben. Ich habe das gemacht,
um Global- und Modulweite Variablen so weit wie möglich zu vermeiden und
den Funktionsaufruf so einfach wie möglich zu halten, auch auf die Gefahr
hin, den Code nicht unbedingt leichter nachvollziehbar zu machen.
Beispieldatei (netressource.zip 21 kB
'***********************************************************
'* Funktionen und Prozeduren von
'* Michael Schwimmer Juli 2000
'***********************************************************
Private Declare Function WNetCloseEnum Lib "mpr.dll"
_
(ByVal hEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll"
_
Alias "WNetEnumResourceA" ( _
ByVal hEnum 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 Any, _
lphEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32"
( _
ByVal str As Long) As Long
Private Declare Function lstrcpy Lib "kernel32"
( _
ByVal dest As String, _
ByVal src As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32"
_
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Public Type Netzwerkressource
strParent As String
strDisplayType As String
strUsage As String
strLocalName As String
strRemoteName As String
strComment As String
strProvider As String
End Type
Private Type NETRESOURCE_ONLY_POINTER
dwScope As Lon
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 RESOURCEUSAGE_ALL = &H0&
Private Const RESOURCEUSAGE_CONNECTABLE = &H1&
Private Const RESOURCEUSAGE_CONTAINER = &H2&
Private Const RESOURCEDISPLAYTYPE_DIRECTORY = &H9&
Private Const RESOURCEDISPLAYTYPE_DOMAIN = &H1&
Private Const RESOURCEDISPLAYTYPE_FILE = &H4&
Private Const RESOURCEDISPLAYTYPE_GENERIC = &H0&
Private Const RESOURCEDISPLAYTYPE_GROUP = &H5&
Private Const RESOURCEDISPLAYTYPE_NETWORK = &H6&
Private Const RESOURCEDISPLAYTYPE_ROOT = &H7&
Private Const RESOURCEDISPLAYTYPE_SERVER = &H2&
Private Const RESOURCEDISPLAYTYPE_SHARE = &H3&
Private Const RESOURCEDISPLAYTYPE_SHAREADMIN = &H8&
Private Const RESOURCETYPE_ANY = &H0&
Private Const RESOURCETYPE_DISK = &H1&
Private Const RESOURCETYPE_PRINT = &H2&
Private Const RESOURCE_CONNECTED = &H1&
Private Const RESOURCE_GLOBALNET = &H2&
Private Const RESOURCE_REMEMBERED = &H3&
Public Function NetzlaufwerkeLesen(udtNetEnum() As Netzwerkressource,
_
Optional Parent As String, _
Optional ResIndex As Long, _
Optional Container As Long) _
As Long
Dim hZugriffsnummer As Long, lngGröße As Long
Dim zähler As Long, lngRückgabe As Long
Dim Anzahl As Long, IndexRessource As Long
Dim Position As Long, strDisplaytyp As String
Dim strLocalName As String, strRemoteName As String
Dim strComment As String, strProvider As String
Dim udtNetzressource(1024) As NETRESOURCE_ONLY_POINTER
If ResIndex = 0 Then
'Root finden, wenn Beginn
lngRückgabe = WNetOpenEnum(RESOURCE_GLOBALNET,
_
RESOURCETYPE_ANY, _
RESOURCEUSAGE_ALL, _
ByVal 0&, _
hZugriffsnummer)
Else
'Die Struktur udtNetzressource(0)
mit Daten
'füllen. Es wurde ein Pointer
darauf übergeben,
'um die Parameter optional zu machen.
CopyMemory udtNetzressource(0), ByVal Container, 32
'Ressourcen im Container auflisten
lngRückgabe = WNetOpenEnum(RESOURCE_GLOBALNET,
_
RESOURCETYPE_ANY, _
RESOURCEUSAGE_ALL, _
udtNetzressource(0), _
hZugriffsnummer)
'Die Position im Array udtNetzressource(0)
festlegen
Position = ResIndex
End If
'Wenn lngRückgabe<>0 dann Fehler
If lngRückgabe = 0 Then
'Rückgabegröße festlegen
lngGröße = UBound(udtNetzressource) * Len(udtNetzressource(0))
'Anzahl der Ressourcen ermitteln
und Array udtNetzressource füllen
Anzahl = &HFFFFFFFF
lngRückgabe = WNetEnumResource(hZugriffsnummer,
Anzahl, udtNetzressource(0), lngGröße)
If Anzahl > 0 Then
'Ressourcen sind vorhanden
For zähler = 0 To Anzahl - 1
'Alle Ressourcen
durchlaufen
With udtNetzressource(zähler)
Position = Position
+ 1
'Das
Array udtNetEnum an Anzahl Ressourcen anpassen
ReDim Preserve udtNetEnum(0
To Position)
'Entscheiden,
was für ein Typ die Ressource ist
Select Case .dwDisplayType
Case RESOURCEDISPLAYTYPE_DIRECTORY
strDisplaytyp
= "Directory"
Case RESOURCEDISPLAYTYPE_DOMAIN
strDisplaytyp
= "Domäne"
Case RESOURCEDISPLAYTYPE_FILE
strDisplaytyp
= "Datei"
Case RESOURCEDISPLAYTYPE_GENERIC
strDisplaytyp
= "Generic"
Case RESOURCEDISPLAYTYPE_GROUP
strDisplaytyp
= "Group"
Case RESOURCEDISPLAYTYPE_NETWORK
strDisplaytyp
= "Netzwerk"
Case RESOURCEDISPLAYTYPE_ROOT
strDisplaytyp
= "Root"
Case RESOURCEDISPLAYTYPE_SERVER
strDisplaytyp
= "Server"
Case RESOURCEDISPLAYTYPE_SHARE
strDisplaytyp
= "Share"
Case RESOURCEDISPLAYTYPE_SHAREADMIN
strDisplaytyp
= "ShareAdmin"
Case Else
strDisplaytyp
= ""
End Select
'Das
Array udtNetEnum mit ermittelten Daten füllen
strLocalName = StringVonPointer(.lpLocalName)
strRemoteName =
StringVonPointer(.lpRemoteName)
strComment = StringVonPointer(.lpComment)
strProvider = StringVonPointer(.lpProvider)
With udtNetEnum(Position)
strComment
= strComment
strDisplayType
= strDisplaytyp
strLocalName
= strLocalName
.strParent
= Parent
.strProvider
= strProvider
.strRemoteName
= strRemoteName
.strUsage
= "Ressource"
Application.StatusBar
= "Nr.: " & Position & " Remotename = " & strRemoteName
End With
If .dwUsage And
RESOURCEUSAGE_CONTAINER Then
'Wenn das Element ein Container ist, die
'Funktion rekursiv aufrufen
udtNetEnum(Position).strUsage
= "Container"
Position
= NetzlaufwerkeLesen(udtNetEnum, strRemoteName, Position, _
VarPtr(udtNetzressource(zähler)))
End If
End With
Next
End If
Else
End If
'Rückgabewert ist die aktuelle Position
im
'Array udtNetEnum
NetzlaufwerkeLesen = Position
'Enum beenden, Handle schließen
WNetCloseEnum hZugriffsnummer
Application.StatusBar = False
End Function
Private Function StringVonAsciiZ(ASCIIZ As String) As
String
'ASCIIZ String kürzen
If InStr(1, ASCIIZ, Chr(0)) > 0 Then
StringVonAsciiZ = Left$(ASCIIZ, InStr(1, ASCIIZ, Chr(0))
- 1)
Else
StringVonAsciiZ = ASCIIZ
End If
End Function
Private Function StringVonPointer(plngAscii As Long)
As String
'Aus einem Pointer einen String machen
Dim lngAnzahl&, strName$
If plngAscii = 0 Then Exit Function
lngAnzahl = lstrlen(plngAscii)
strName = String(lngAnzahl, 0)
lstrcpy strName, plngAscii
If InStr(1, strName, Chr(0)) <> 0 Then
strName = Left$(strName, InStr(1, strName, Chr(0)) -
1)
End If
StringVonPointer = strName
End Function
'#########################################################
'Code zum Testen
'Eine Listbox lsbNetzwerk mit sieben Spalten ist erforderlich
und
'eine Listbox lsbÜberschrift direkt darüber als
Spaltenüberschrift
Private Sub cmbRessourcen_Click()
Dim NRS() As Netzwerkressource
Dim a, b()
NetzlaufwerkeLesen NRS
lsbNetzwerk.Clear
Überschriften
ReDim b(0 To UBound(NRS), 0 To 6)
For a = 1 To
UBound(NRS)
With NRS(a)
b(a - 1, 0) = .strRemoteName
b(a - 1, 1) = .strParent
b(a - 1, 2) = .strUsage
b(a - 1, 3) = .strDisplayType
b(a - 1, 4) = .strProvider
b(a - 1, 5) = .strLocalName
b(a - 1, 6) = .strComment
End With
Next
lsbNetzwerk.List = b
End Sub
Private Sub Überschriften()
Dim a, b()
lsbÜberschrift.Clear
ReDim b(0 To 0, 0 To 6)
b(0, 0) = "Remote-Name"
b(0, 1) = "Parent"
b(0, 2) = "Ress./Container"
b(0, 3) = "Display-Typ"
b(0, 4) = "Provider"
b(0, 5) = "LocalName"
b(0, 6) = "Kommentar"
lsbÜberschrift.List = b
End Sub