Imports System.IO Imports System.Runtime.InteropServices Imports DigitalData.Modules.Logging Public Class Map_Drive Private ReadOnly _Logger As Logger Private ReadOnly _LogConfig As LogConfig #Region "Windows API Deklarationen" Private Shared Function WNetAddConnection2(ByRef lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUsername As String, ByVal dwFlags As Integer) As Integer End Function Private Shared Function WNetCancelConnection2(ByVal lpName As String, ByVal dwFlags As Integer, ByVal fForce As Boolean) As Integer End Function Private Structure NETRESOURCE Public dwScope As Integer Public dwType As Integer Public dwDisplayType As Integer Public dwUsage As Integer Public lpLocalName As String Public lpRemoteName As String Public lpComment As String Public lpProvider As String End Structure Private Const RESOURCETYPE_DISK As Integer = 1 Private Const CONNECT_UPDATE_PROFILE As Integer = 1 Private Const ERROR_SUCCESS As Integer = 0 Private Const ERROR_ALREADY_ASSIGNED As Integer = 85 #End Region Public Sub New(LogConfig As LogConfig) _LogConfig = LogConfig _Logger = LogConfig.GetLogger() End Sub ''' ''' Struktur für Netzlaufwerk-Informationen ''' Public Structure NetworkDriveInfo Public DriveLetter As String Public NetworkPath As String Public DriveType As IO.DriveType Public IsReady As Boolean Public TotalSize As Long Public FreeSpace As Long End Structure ''' ''' Ermittelt den nächsten freien Laufwerksbuchstaben (alphabetisch absteigend von Z bis A) ''' ''' Liste der nicht erlaubten Laufwerksbuchstaben (z.B. "Y,M,V") ''' Nächster freier Laufwerksbuchstabe mit Doppelpunkt (z.B. "Z:") oder String.Empty wenn keiner frei Public Function GetNextFreeDriveLetter(Optional blacklist As String = "") As String Try ' Blacklist verarbeiten (Großbuchstaben ohne Doppelpunkte) Dim blacklistArray As New List(Of Char) If Not String.IsNullOrEmpty(blacklist) Then For Each item In blacklist.Split(","c) Dim letter = item.Trim().ToUpper().Replace(":", "") If letter.Length = 1 AndAlso Char.IsLetter(letter(0)) Then blacklistArray.Add(letter(0)) End If Next End If ' Alle aktuell verwendeten Laufwerksbuchstaben ermitteln Dim usedDrives As New List(Of Char) For Each drive As IO.DriveInfo In IO.DriveInfo.GetDrives() Dim letter As Char = drive.Name(0) usedDrives.Add(Char.ToUpper(letter)) Next ' Alphabetisch absteigend von Z bis A durchgehen For i As Integer = Asc("Z"c) To Asc("A"c) Step -1 Dim currentLetter As Char = Chr(i) ' Prüfen ob Buchstabe verfügbar ist If Not usedDrives.Contains(currentLetter) AndAlso Not blacklistArray.Contains(currentLetter) Then _Logger.Debug($"Nächster freier Laufwerksbuchstabe gefunden: {currentLetter}:") Return currentLetter & ":" End If Next _Logger.Warn("Kein freier Laufwerksbuchstabe gefunden!") Return String.Empty Catch ex As Exception _Logger.Error($"Fehler beim Ermitteln des nächsten freien Laufwerksbuchstabens: {ex.Message}") _Logger.Error(ex) Return String.Empty End Try End Function ''' ''' Prüft ob ein Laufwerksbuchstabe verfügbar ist (nicht verwendet und nicht in Blacklist) ''' ''' Zu prüfender Laufwerksbuchstabe ''' Liste der nicht erlaubten Laufwerksbuchstaben ''' True wenn verfügbar, False wenn bereits verwendet oder in Blacklist Public Function IsDriveLetterAvailable(driveLetter As String, Optional blacklist As String = "") As Boolean Try ' Formatierung sicherstellen driveLetter = driveLetter.Trim().ToUpper().Replace(":", "") If driveLetter.Length <> 1 OrElse Not Char.IsLetter(driveLetter(0)) Then _Logger.Warn($"Ungültiger Laufwerksbuchstabe: {driveLetter}") Return False End If Dim letter As Char = driveLetter(0) ' Blacklist prüfen If Not String.IsNullOrEmpty(blacklist) Then For Each item In blacklist.Split(","c) Dim blacklistedLetter = item.Trim().ToUpper().Replace(":", "") If blacklistedLetter.Length = 1 AndAlso blacklistedLetter(0) = letter Then _Logger.Debug($"Laufwerk {letter}: ist in der Blacklist") Return False End If Next End If ' Prüfen ob bereits verwendet For Each drive As IO.DriveInfo In IO.DriveInfo.GetDrives() If Char.ToUpper(drive.Name(0)) = letter Then _Logger.Debug($"Laufwerk {letter}: ist bereits verwendet") Return False End If Next Return True Catch ex As Exception _Logger.Error($"Fehler beim Prüfen der Laufwerksverfügbarkeit: {ex.Message}") _Logger.Error(ex) Return False End Try End Function ''' ''' Mappt ein Netzlaufwerk mit automatischer Laufwerksbuchstabenwahl oder spezifischem Buchstaben ''' ''' Gewünschter Laufwerksbuchstabe (leer = automatisch den nächsten freien wählen) ''' UNC-Pfad des Netzwerkshares ''' Komma-getrennte Liste verbotener Laufwerksbuchstaben (z.B. "Y,M,V") ''' Optionaler Benutzername für Authentifizierung ''' Optionales Passwort für Authentifizierung ''' Soll das Mapping persistent sein? ''' Verwendeter Laufwerksbuchstabe bei Erfolg, String.Empty bei Fehler Public Function MapNetworkDrive(driveLetter As String, networkPath As String, Optional blacklist As String = "", Optional userName As String = Nothing, Optional password As String = Nothing, Optional persistent As Boolean = True) As String Try Dim targetDriveLetter As String = "" ' Szenario 1: Kein Laufwerksbuchstabe angegeben -> Automatische Auswahl If String.IsNullOrEmpty(driveLetter) Then _Logger.Info("Kein Laufwerksbuchstabe angegeben - suche nächsten freien Buchstaben...") targetDriveLetter = GetNextFreeDriveLetter(blacklist) If String.IsNullOrEmpty(targetDriveLetter) Then _Logger.Error("❌ Kein freier Laufwerksbuchstabe verfügbar!") Return String.Empty End If _Logger.Info($"Automatisch gewählter Laufwerksbuchstabe: {targetDriveLetter}") Else ' Szenario 2: Spezifischer Laufwerksbuchstabe angegeben targetDriveLetter = driveLetter.Trim().ToUpper() If Not targetDriveLetter.EndsWith(":") Then targetDriveLetter &= ":" End If ' ========== NEU: Prüfen ob Laufwerk verfügbar ist ========== If Not IsDriveLetterAvailable(targetDriveLetter, blacklist) Then _Logger.Warn($"⚠️ Laufwerk {targetDriveLetter} ist nicht verfügbar (bereits verwendet oder in Blacklist)") ' NICHT abbrechen - weiter versuchen (alte Logik beibehalten) End If ' ========== ENDE NEU ========== End If ' ========== NEU: Prüfung ob Laufwerk bereits existiert ========== Dim driveExists As Boolean = False Try Dim driveInfo As New System.IO.DriveInfo(targetDriveLetter) driveExists = driveInfo.IsReady Catch ' Laufwerk existiert nicht - das ist OK driveExists = False End Try ' Nur trennen wenn Laufwerk wirklich existiert If driveExists Then _Logger.Debug($"ℹ️ Laufwerk {targetDriveLetter} existiert bereits - wird getrennt") DisconnectNetworkDrive(targetDriveLetter, force:=True) Else _Logger.Debug($"✓ Laufwerk {targetDriveLetter} existiert noch nicht - kein Disconnect nötig") End If ' ========== ENDE NEU ========== ' Laufwerk mappen (bestehende Logik) If MapNetworkDriveInternal(targetDriveLetter, networkPath, userName, password, persistent) Then _Logger.Info($"✓ Netzlaufwerk {targetDriveLetter} erfolgreich gemappt zu {networkPath}") Return targetDriveLetter Else _Logger.Error($"❌ Fehler beim Mappen von {targetDriveLetter}") Return String.Empty End If Catch ex As Exception _Logger.Error($"❌ Fehler in MapNetworkDrive: {ex.Message}") _Logger.Error(ex) Return String.Empty End Try End Function ''' ''' Interne Methode zum tatsächlichen Mappen eines Netzlaufwerks ''' Private Function MapNetworkDriveInternal(driveLetter As String, networkPath As String, userName As String, password As String, persistent As Boolean) As Boolean Try ' Erst trennen falls vorhanden (ohne Fehler wenn nicht vorhanden) DisconnectNetworkDrive(driveLetter, True) ' NETRESOURCE-Struktur vorbereiten Dim netResource As New NETRESOURCE With { .dwType = RESOURCETYPE_DISK, .lpLocalName = driveLetter, .lpRemoteName = networkPath } Dim flags As Integer = If(persistent, CONNECT_UPDATE_PROFILE, 0) ' WICHTIG: Credentials als Nothing übergeben = Verwende aktuelle Windows-Credentials ' Wenn der Share öffentlich oder mit aktuellen Credentials erreichbar ist, funktioniert es Dim result As Integer = WNetAddConnection2(netResource, password, userName, flags) Select Case result Case ERROR_SUCCESS _Logger.Debug($"✓ Laufwerk {driveLetter} erfolgreich gemappt") Return True Case 1326 ' ERROR_LOGON_FAILURE _Logger.Error($"❌ Authentifizierungsfehler (1326): Anmeldung fehlgeschlagen für [{networkPath}]") _Logger.Error($" → Der UNC-Pfad erfordert möglicherweise spezielle Credentials") _Logger.Error($" → Oder der aktuelle Benutzer hat keine Berechtigung") Return False Case 53 ' ERROR_BAD_NETPATH _Logger.Error($"❌ Netzwerkpfad nicht gefunden (53): [{networkPath}]") Return False Case 67 ' ERROR_BAD_NET_NAME _Logger.Error($"❌ Netzwerkname ungültig (67): [{networkPath}]") Return False Case 85 ' ERROR_ALREADY_ASSIGNED _Logger.Warn($"⚠️ Laufwerk {driveLetter} ist bereits zugewiesen (85)") ' Versuche es zu trennen und erneut zu verbinden DisconnectNetworkDrive(driveLetter, force:=True) System.Threading.Thread.Sleep(500) ' Kurze Pause result = WNetAddConnection2(netResource, password, userName, flags) If result = ERROR_SUCCESS Then _Logger.Info($"✓ Laufwerk {driveLetter} nach erneutem Versuch erfolgreich gemappt") Return True Else Return False End If Case Else _Logger.Error($"❌ WNetAddConnection2 Error Code: {result}") Return False End Select Catch ex As Exception _Logger.Error($"Fehler in MapNetworkDriveInternal: {ex.Message}") _Logger.Error(ex) Return False End Try End Function ''' ''' Test-Funktion um UNC-Pfad-Zugriff zu prüfen ''' Public Function TestUNCAccess(uncPath As String) As Boolean Try _Logger.Info($"🔍 Teste Zugriff auf UNC-Pfad: [{uncPath}]") ' Teste ob Pfad existiert und erreichbar ist If System.IO.Directory.Exists(uncPath) Then _Logger.Info($"✓ UNC-Pfad ist direkt erreichbar ohne Mapping") ' Teste Lese-Berechtigung Try Dim files = System.IO.Directory.GetFiles(uncPath) _Logger.Info($"✓ Lese-Berechtigung vorhanden ({files.Length} Dateien gefunden)") Return True Catch permEx As UnauthorizedAccessException _Logger.Error($"❌ Keine Lese-Berechtigung: {permEx.Message}") Return False End Try Else _Logger.Error($"❌ UNC-Pfad nicht erreichbar oder existiert nicht") Return False End If Catch ex As Exception _Logger.Error($"❌ Fehler beim Testen des UNC-Zugriffs: {ex.Message}") _Logger.Error(ex) Return False End Try End Function ''' ''' Trennt ein Netzlaufwerk mit Windows-API ''' Public Function DisconnectNetworkDrive(driveLetter As String, Optional force As Boolean = True) As Boolean Try ' Formatierung sicherstellen driveLetter = driveLetter.Trim().ToUpper() If Not driveLetter.EndsWith(":") Then driveLetter &= ":" End If Dim driveExists As Boolean = False Try Dim driveInfo As New System.IO.DriveInfo(driveLetter) driveExists = driveInfo.IsReady Catch driveExists = False End Try If Not driveExists Then _Logger.Debug($"ℹ️ Laufwerk {driveLetter} existiert nicht - Disconnect übersprungen") Return True ' Kein Fehler, da das gewünschte Ergebnis erreicht ist (Laufwerk ist nicht verbunden) End If Dim flags As Integer = CONNECT_UPDATE_PROFILE Dim result As Integer = WNetCancelConnection2(driveLetter, flags, force) If result = ERROR_SUCCESS Then _Logger.Debug($"✓ Netzlaufwerk {driveLetter} erfolgreich getrennt") Return True ElseIf result = 2250 Then ' ERROR_NOT_CONNECTED ' Von WARN auf DEBUG herabgestuft, da es kein echter Fehler ist _Logger.Debug($"ℹ️ Laufwerk {driveLetter} war nicht verbunden (Code 2250)") Return True ElseIf result = ERROR_ALREADY_ASSIGNED Then _Logger.Debug($"ℹ️ Netzlaufwerk {driveLetter} war nicht verbunden") Return True Else _Logger.Warn($"⚠️ Warnung beim Trennen von {driveLetter}: Error Code {result}") Return False End If Catch ex As Exception _Logger.Debug($"⚠️ Fehler beim Trennen von {driveLetter} (ignoriert): {ex.Message}") Return False End Try End Function ''' ''' Ermittelt alle gemappten Netzlaufwerke ''' Public Function GetMappedNetworkDrives() As List(Of NetworkDriveInfo) Dim mappedDrives As New List(Of NetworkDriveInfo) Try For Each drive As IO.DriveInfo In IO.DriveInfo.GetDrives() If drive.DriveType = IO.DriveType.Network Then Dim driveInfo As New NetworkDriveInfo With { .DriveLetter = drive.Name, .NetworkPath = GetNetworkPath(drive.Name), .DriveType = drive.DriveType, .IsReady = drive.IsReady } If drive.IsReady Then Try driveInfo.TotalSize = drive.TotalSize driveInfo.FreeSpace = drive.AvailableFreeSpace Catch ex As Exception _Logger.Debug($"Konnte Größeninformationen für {drive.Name} nicht ermitteln: {ex.Message}") End Try End If mappedDrives.Add(driveInfo) End If Next _Logger.Debug($"Insgesamt {mappedDrives.Count} Netzlaufwerk(e) gefunden") Return mappedDrives Catch ex As Exception _Logger.Error($"Fehler beim Ermitteln der Netzlaufwerke: {ex.Message}") _Logger.Error(ex) Return mappedDrives End Try End Function ''' ''' Ermittelt den UNC-Pfad eines gemappten Laufwerks ''' Public Function GetNetworkPath(driveLetter As String) As String Try driveLetter = driveLetter.Trim().ToUpper() If Not driveLetter.EndsWith(":") Then driveLetter &= ":" End If Dim network As Object = CreateObject("WScript.Network") Dim enumDrives As Object = network.EnumNetworkDrives() For i As Integer = 0 To enumDrives.Count - 1 Step 2 If enumDrives.Item(i).ToString.Equals(driveLetter, StringComparison.OrdinalIgnoreCase) Then Return enumDrives.Item(i + 1).ToString() End If Next Return String.Empty Catch ex As Exception _Logger.Debug($"Fehler beim Ermitteln des Netzwerkpfads für {driveLetter}: {ex.Message}") Return String.Empty End Try End Function ''' ''' Prüft ob ein bestimmtes Laufwerk als Netzlaufwerk gemappt ist ''' Public Shared Function IsDriveMapped(driveLetter As String) As Boolean Try driveLetter = driveLetter.Trim().ToUpper() If Not driveLetter.EndsWith(":") Then driveLetter &= ":" End If If Not driveLetter.EndsWith("\") Then driveLetter &= "\" End If Dim driveInfo As New IO.DriveInfo(driveLetter) Return driveInfo.DriveType = IO.DriveType.Network AndAlso driveInfo.IsReady Catch ex As Exception Return False End Try End Function ''' ''' Gibt eine formatierte Übersicht aller gemappten Netzlaufwerke zurück ''' Public Function GetMappedDrivesInfo() As String Dim result As New System.Text.StringBuilder() Dim drives = GetMappedNetworkDrives() If drives.Count = 0 Then Return "Keine Netzlaufwerke gefunden." End If result.AppendLine($"Gemappte Netzlaufwerke ({drives.Count}):") result.AppendLine(New String("-"c, 60)) For Each drive In drives result.AppendLine($"Laufwerk: {drive.DriveLetter}") result.AppendLine($" Pfad: {drive.NetworkPath}") result.AppendLine($" Status: {If(drive.IsReady, "Verfügbar", "Nicht verfügbar")}") If drive.IsReady AndAlso drive.TotalSize > 0 Then Dim totalGB As Double = drive.TotalSize / (1024.0 ^ 3) Dim freeGB As Double = drive.FreeSpace / (1024.0 ^ 3) result.AppendLine($" Größe: {totalGB:N2} GB (Frei: {freeGB:N2} GB)") End If result.AppendLine() Next Return result.ToString() End Function ''' ''' Mappt ein spezifisches Laufwerk (z.B. "V") mit Blacklist-Prüfung ''' Public Function MapSpecificDrive(driveLetter As String, blacklist As String, networkPath As String) As Boolean Try ' Formatierung sicherstellen driveLetter = driveLetter.Trim().ToUpper().Replace(":", "") If String.IsNullOrEmpty(driveLetter) OrElse driveLetter.Length <> 1 Then _Logger.Warn($"⚠️ Ungültiger Laufwerksbuchstabe: [{driveLetter}]") Return False End If Dim driveWithColon As String = driveLetter & ":" ' Prüfen ob Laufwerk verfügbar ist If Not IsDriveLetterAvailable(driveWithColon, blacklist) Then _Logger.Warn($"⚠️ Laufwerk {driveWithColon} ist nicht verfügbar (bereits verwendet oder in Blacklist)") Return False End If ' UNC-Pfad vorbereiten (ohne abschließenden Backslash) Dim uncPath As String = networkPath.TrimEnd("\"c) ' Laufwerk mappen (OHNE Credentials, persistent=False für temporäres Mapping) Dim result = MapNetworkDrive(driveWithColon, uncPath, blacklist, userName:=Nothing, password:=Nothing, persistent:=False) If Not String.IsNullOrEmpty(result) Then _Logger.Debug($"✓ Laufwerk {driveWithColon} erfolgreich gemappt zu [{uncPath}]") Return True Else _Logger.Error($"❌ Fehler beim Mappen von {driveWithColon}") Return False End If Catch ex As Exception _Logger.Error($"Fehler in MapSpecificDrive: {ex.Message}") _Logger.Error(ex) Return False End Try End Function ''' ''' Mappt automatisch den nächsten freien Laufwerksbuchstaben (Z→A) ''' Public Function MapDriveAutomatic(blacklist As String, networkPath As String) As String Try ' UNC-Pfad vorbereiten (ohne abschließenden Backslash) Dim uncPath As String = networkPath.TrimEnd("\"c) _Logger.Debug($"🔍 Suche automatisch freien Laufwerksbuchstaben...") _Logger.Debug($" Blacklist: [{blacklist}]") _Logger.Debug($" Netzwerkpfad: [{uncPath}]") ' Automatisches Mapping (leer = automatische Auswahl, persistent=False) Dim result = MapNetworkDrive("", uncPath, blacklist, userName:=Nothing, password:=Nothing, persistent:=False) If Not String.IsNullOrEmpty(result) Then _Logger.Debug($"✓ Automatisch gewähltes Laufwerk: {result}") Return result Else _Logger.Error($"❌ Kein freier Laufwerksbuchstabe verfügbar") Return String.Empty End If Catch ex As Exception _Logger.Error($"Fehler in MapDriveAutomatic: {ex.Message}") _Logger.Error(ex) Return String.Empty End Try End Function End Class