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ß Dieser Tipp wurde bereits 11.566 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |