vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Dateisystem · Laufwerke   |   VB-Versionen: VB4, VB5, VB621.11.05
Laufwerke aktualisieren

Haben Sie sich auch schon mal gewundert, dass lokal verbundene Netzlaufwerke erst nach dem Anklicken im Windows-Explorer durch VB- bzw. API-Funktionen erkannt werden?

Autor:   Ralf HähnelBewertung:     [ Jetzt bewerten ]Views:  11.525 
www.hippsoft.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Haben Sie sich auch schon mal gewundert, dass lokal verbundene Netzlaufwerke erst nach dem Anklicken im Windows-Explorer durch VB- bzw. API-Funktionen erkannt werden?

Bei diesem Problem hilft uns wieder einmal eine API-Funktion weiter. Diesmal ist es die API-Funktion WNetUseConnection. Leider benötigt diese Funktion neben dem Laufwerksbuchstaben auch den "angebundenen Pfad". Dieser wird bei Netzlaufwerken immer in die Registry geschrieben (außer bei temporären, aber da ist es egal, da beim Anbinden von Netzlaufwerken diese sofort durch das System aktualisiert werden)

Somit sind alle notwendigen Dinge vorhanden und müssen nur noch irgendwie zusammengebracht werden. Und so siehts am Ende aus:

Folgenden Code in ein "normales" Modul kopieren:

Option Explicit
 
' Registry
Private Declare Function RegOpenKey Lib "advapi32.dll" _
  Alias "RegOpenKeyA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  phkResult As Long) 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
 
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
  ByVal hKey As Long) As Long
 
' Netzlaufwerk
Private Declare Function WNetUseConnection Lib "mpr.dll" _
  Alias "WNetUseConnectionA" ( _
  ByVal hwndOwner As Long, _
  ByRef lpNetResource As NETRESOURCE, _
  ByVal lpUserID As String, _
  ByVal lpPassword As String, _
  ByVal dwFlags As Long, _
  ByVal lpAccessName As String, _
  ByRef lpBufferSize As Long, _
  ByRef lpResult As Long) As Long
 
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
 
Private Const REG_SZ = 1
Private Const HKEY_CURRENT_USER = &H80000001
 
Private Const RESOURCE_GLOBALNET As Long = &H2
Private Const RESOURCETYPE_DISK As Long = &H1
Private Const RESOURCEDISPLAYTYPE_SHARE As Long = &H3
Private Const RESOURCEUSAGE_CONTAINER As Long = &H2
 
Private Const CONNECT_REDIRECT As Long = &H80
Public Sub NetDriveRefresh()
  On Error Resume Next
 
  Dim I As Long
  Dim sDrive As String
  Dim sRemotePath As String
  Dim NETDAT As NETRESOURCE
  Dim lRet As Long
  Dim lResult As Long
 
  For I = 65 To 90
    sDrive = Chr(I)
    sRemotePath = GetStringFromRegistry(HKEY_CURRENT_USER, "Network\" & sDrive, "RemotePath", "")
    If sRemotePath <> "" Then
      With NETDAT
        .dwScope = RESOURCE_GLOBALNET
        .dwType = RESOURCETYPE_DISK
        .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
        .dwUsage = RESOURCEUSAGE_CONTAINER
        .lpLocalName = sDrive & ":"
        .lpRemoteName = sRemotePath
        .lpComment = ""
        .lpProvider = ""
      End With
 
      lRet = WNetUseConnection(hWnd, NETDAT, vbNullString, vbNullString, CONNECT_REDIRECT, _
        vbNullChar, Len(NETDAT), lResult)
 
    End If
  Next I
End Sub
Private Function GetStringFromRegistry(ByVal hKey As Long, _
  ByVal Path As String, ByVal Key As String, _
  Optional ByVal Default As String = "") As String
 
  On Error Resume Next
 
  Dim vRet As Variant
  Dim sBuffer As String
  Dim lRes As Long
  Dim lTypeValue As Long
  Dim lBufferSizeData As Long
  Dim iData As Long
 
  If RegOpenKey(hKey, Path, vRet) <> 0 Then
    GetStringFromRegistry = Default
  Else
 
    lRes = RegQueryValueEx(vRet, Key, 0, lTypeValue, ByVal 0, lBufferSizeData)
    If lRes = 0 Then
      If lTypeValue = REG_SZ Then
        sBuffer = String(lBufferSizeData, vbNullChar)
        lRes = RegQueryValueEx(vRet, Key, 0, 0, ByVal sBuffer, lBufferSizeData)
                If lRes = 0 Then
          GetStringFromRegistry = Left$(sBuffer, InStr(1, sBuffer, vbNullChar) - 1)
        Else
          GetStringFromRegistry = Default
        End If
      End If
    Else
      GetStringFromRegistry = Default
    End If
 
  End If
  RegCloseKey vRet
End Function

Anschließend können bspw. mit mit folgendem Aufruf sämtliche Netzlaufwerke aktualisiert werden:

Private Sub Command1_Click()
  NetDriveRefresh
End Sub

Viel Spaß