Zurück zur Homepage

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