So richtig Spaß macht das Programmieren doch erst, wenn man über seine eigene Festplatte hinausschaut. Der Wunsch auf Netzlaufwerke, also freigegebene Netzwerkresourcen anderer Computer im LAN, zugreifen zu können. Um das Ihrem Programm beibringen zu können, brauchen Sie zwei Funktionen:
Genau diese Funktionen und die dazugehörigen API's möchten wir Ihnen heute vorstellen. Fügen Sie den folgenden Code in ein Modul ein: Option Explicit ' Benötigte API-Deklarationen Const RESOURCETYPE_DISK = &H1 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 Declare Function WNetAddConnection2 Lib "mpr.dll" _ Alias "WNetAddConnection2A" ( _ lpNetResource As NETRESOURCE, _ ByVal lpPassword As String, _ ByVal lpUserName As String, _ ByVal dwFlags As Long) As Long Private Declare Function WNetCancelConnection2 Lib "mpr.dll" _ Alias "WNetCancelConnection2A" ( _ ByVal lpName As String, _ ByVal dwFlags As Long, _ ByVal fForce As Long) As Long Private Declare Function GetLogicalDriveStrings Lib "kernel32" _ Alias "GetLogicalDriveStringsA" ( _ ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long ' Laufwerk auf Existenz prüfen Public Function DriveExists(sDrive As String) As Boolean Dim sDrives As String ' Laufwerksliste ermitteln sDrives = Space$(255) If GetLogicalDriveStrings(Len(sDrives), sDrives) Then ' ist der Laufwerksbuchstabe enthalten? DriveExists = InStr(1, sDrives, sDrive, vbTextCompare) End If End Function ' alle bereits existierenden Laufwerke ermitteln Public Function GetNextDrive() As String Dim sDrives As String Dim i As Integer sDrives = Space$(255) GetLogicalDriveStrings Len(sDrives), sDrives ' alle Laufwerke von D bis Z durchlaufen For i = 68 To 90 If InStr(1, sDrives, Chr$(i), vbTextCompare) = 0 Then GetNextDrive = Chr$(i) & ":" Exit For End If Next i End Function Um jetzt auf den Festplatten (Freigaben) anderer Computer zaubern zu können, müssen wir jetzt eine Verbindung herstellen. Die dafür hilfreichen Funktionen fügen Sie jetzt ebenfalls in dem Modul ein: ' Netzlaufwerk verbinden Public Function AddNetworkDrive(sDriveLetter As String, _ sNetWorkPath As String, _ Optional sUserName As String, _ Optional sPassword As String) As Boolean Dim nResult As Long Dim udtRES As NETRESOURCE ' Plausi auf die Parameter AddNetworkDrive = False If Len(sDriveLetter) <> 2 Or Right$(sDriveLetter, 1) <> ":" Then Exit Function If Len(sNetWorkPath) < 4 Then Exit Function ' ist der Laufwerksbuchstabe schon vergeben? If DriveExists(sDriveLetter) Then Exit Function ' NETRESOURCE-Struktur füllen With udtRES .dwType = RESOURCETYPE_DISK .lpLocalName = sDriveLetter .lpRemoteName = sNetWorkPath End With ' Netzlaufwerk verbinden nResult = WNetAddConnection2(udtRES, sPassword, sUserName, 0) If nResult = 0 Then AddNetworkDrive = True End If End Function ' Netzlaufwerk trennen Public Function RemoveNetworkDrive(sDriveLetter As String, _ bForce As Boolean) As Boolean Dim nResult As Long nResult = WNetCancelConnection2(sDriveLetter, 0, True) RemoveNetworkDrive = (nResult = 0) End Function Jetzt haben wir alles zusammen, um erfolgreich per API eine Verbindung zu einem Netzlaufwerk herstellen und auch wieder trennen zu können. Verwendet werden die Funktionen wie folgt: <font color>' nächsten freien Laufwerksbuchstaben ermitteln Dim sDrive As String sDrive = GetNextDrive() ' Netzlaufwerk verbinden If AddNetworkDrive(sDrive, "\\Rechnername\Freigabe") = True Then MsgBox "Laufwerk verbunden (" & sDrive & ")" End If ' Laufwerk trennen If RemoveNetworkDrive(sDrive, True) = True Then MsgBox "Laufwerk " & sDrive & " wurde erfolgreich getrennt" End If Dieser Tipp wurde bereits 32.842 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 März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevCommand 4.0 Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. |
||||||||||||||||
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. |