Rubrik: Dateisystem · Laufwerke | VB-Versionen: VB4, VB5, VB6 | 21.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ähnel | Bewertung: | Views: 11.577 |
www.hippsoft.de | System: 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ß