936 lines
40 KiB
VB.net
936 lines
40 KiB
VB.net
Imports System.Data.SqlClient
|
||
Imports System.Data.OracleClient
|
||
Imports System.IO
|
||
Imports WINDREAMLib
|
||
Imports DevExpress.Utils.CommonDialogs
|
||
Imports System.Runtime.InteropServices
|
||
|
||
Public Class ClassAllgemeineFunktionen
|
||
Public Shared Function GUI_LANGUAGE_INFO(pTITLE As String)
|
||
Try
|
||
Dim oFilteredDatatable As DataTable = BASEDATA_DT_GUI_LANGUAGE_PHRASES.Clone()
|
||
Dim oExpression = $"LANGUAGE ='{USER_LANGUAGE}' AND TITLE = '{pTITLE}'"
|
||
BASEDATA_DT_GUI_LANGUAGE_PHRASES.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges)
|
||
If oFilteredDatatable.Rows.Count = 1 Then
|
||
If oFilteredDatatable.Rows(0).Item("CAPT_TYPE") = "MsgBox" Or oFilteredDatatable.Rows(0).Item("CAPT_TYPE") = "MsgboxResult" Then
|
||
Return oFilteredDatatable
|
||
Else
|
||
If oFilteredDatatable.Rows(0).Item("STRING2") <> String.Empty Then
|
||
Return oFilteredDatatable
|
||
Else
|
||
Return oFilteredDatatable.Rows(0).Item("STRING1")
|
||
End If
|
||
|
||
End If
|
||
|
||
Else
|
||
If oFilteredDatatable.Rows.Count = 0 Then 'KEIN EINTRAG FÜR SPRACHE
|
||
oExpression = $"LANGUAGE ='de-DE' AND TITLE = '{pTITLE}'"
|
||
BASEDATA_DT_GUI_LANGUAGE_PHRASES.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges)
|
||
Try
|
||
Return oFilteredDatatable.Rows(0).Item("STRING1")
|
||
Catch ex As Exception
|
||
Return $"ERR-LANG(NoTranslationFor [{oExpression}]"
|
||
End Try
|
||
|
||
Else
|
||
Return oFilteredDatatable
|
||
End If
|
||
|
||
End If
|
||
Catch ex As Exception
|
||
LOGGER.Info($"Unexpected error in GUI_LANGUAGE_INFO FOR [{pTITLE}]...")
|
||
LOGGER.Error(ex)
|
||
End Try
|
||
|
||
End Function
|
||
Public Shared Function GUI_LANGUAGE_MSGBOX(pTITLE As String)
|
||
Try
|
||
Dim oFilteredDatatable As DataTable = BASEDATA_DT_GUI_LANGUAGE_PHRASES.Clone()
|
||
Dim oExpression = $"LANGUAGE = '{USER_LANGUAGE}' AND TITLE = '{pTITLE}'"
|
||
BASEDATA_DT_GUI_LANGUAGE_PHRASES.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges)
|
||
If oFilteredDatatable.Rows.Count = 1 Then
|
||
Return oFilteredDatatable.Rows(0)
|
||
Else
|
||
Return ""
|
||
End If
|
||
Catch ex As Exception
|
||
LOGGER.Info($"Unexpected error in GUI_LANGUAGE_MSGBOX FOR [{pTITLE}]...")
|
||
LOGGER.Error(ex)
|
||
End Try
|
||
|
||
End Function
|
||
Public Shared Function LoginOut(LoginorOut As String) As Boolean
|
||
Try
|
||
If USER_EXISTS = False Then
|
||
Return False
|
||
End If
|
||
Dim oSql As String
|
||
If LoginorOut = "LOGIN" Then
|
||
oSql = String.Format($"INSERT INTO TBDD_USER_MODULE_LOG_IN (USER_ID,CLIENT_ID,MODULE,VERSION_CLIENT,MACHINE_NAME,LANGUAGE_OVERRIDE) VALUES
|
||
({USER_ID},1,'{MODULE_PM}','{My.Application.Info.Version.ToString}','{Environment.MachineName}','')")
|
||
Else
|
||
If INACTIVITYRecognized = True Then
|
||
oSql = $"UPDATE TBDD_USER_LOGIN_OUT SET COMMENT = 'Inactivity Detected',LOGOUT = GETDATE() WHERE USER_ID = {USER_ID} AND MODULE = '{MODULE_PM}' AND LOGOUT IS NULL"
|
||
If DatabaseFallback.ExecuteNonQueryECM(oSql) = True Then
|
||
|
||
End If
|
||
End If
|
||
|
||
oSql = $"DELETE FROM TBDD_USER_MODULE_LOG_IN WHERE USER_ID = {USER_ID} AND MODULE = '{MODULE_PM}'"
|
||
End If
|
||
If DatabaseFallback.ExecuteNonQueryECM(oSql) = True Then
|
||
LOGGER.Debug($"{LoginorOut} of User successfully!")
|
||
Return True
|
||
Else
|
||
LOGGER.Info("User could not be logged in/out....")
|
||
Return False
|
||
End If
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
LOGGER.Info("Error in LoginOut: " & ex.Message)
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Public Function ExecuteonMSSQL(ByVal sqlcommand As String, ConString As String)
|
||
Try
|
||
' die nötigen Variablen definieren
|
||
Dim Connection As SqlConnection
|
||
|
||
Dim Command As SqlCommand = Nothing
|
||
Dim DataAdapter As SqlDataAdapter = Nothing
|
||
|
||
' ConnectionString aufbauen (aus Settings auslesen)
|
||
Connection = New SqlConnection(ConString)
|
||
|
||
|
||
' Verbindung zur Datenbank aufbauen
|
||
Try
|
||
Connection.Open()
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
' DB-Connection schliessen
|
||
Me.CloseMssqlDb(Connection)
|
||
LOGGER.Debug("ExecuteonMSSQL.Connection definieren - Error: " & ex.Message, True)
|
||
Return "ExecuteonMSSQL.Connection definieren - Error: " & ex.Message
|
||
End Try
|
||
|
||
|
||
' SQL-Abfrage definieren
|
||
Try
|
||
Command = New SqlCommand(sqlcommand, Connection)
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
LOGGER.Debug("ExecuteonMSSQL.sqlcommand definieren - Error: " & ex.Message, True)
|
||
' DB-Connection schliessen
|
||
Me.CloseMssqlDb(Connection)
|
||
Return "ExecuteonMSSQL.sqlcommand definieren - Error: " & ex.Message
|
||
End Try
|
||
|
||
' *** Ausführen des Command ***
|
||
If Command IsNot Nothing Then
|
||
|
||
Try
|
||
Command.ExecuteNonQuery()
|
||
' DB-Connection schliessen
|
||
Me.CloseMssqlDb(Connection)
|
||
Return ""
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
'bei einem Fehler einen Eintrag in der Logdatei erzeugen
|
||
LOGGER.Info("ExecuteonMSSQL.Execute Command - Error: " & ex.Message, True)
|
||
LOGGER.Info("Command-Befehl: " & Command.CommandText, True)
|
||
' DB-Connection schliessen
|
||
Me.CloseMssqlDb(Connection)
|
||
Return "ExecuteonMSSQL.Execute Command - Error: " & ex.Message
|
||
|
||
End Try
|
||
Else
|
||
' kann eintreten, wenn entweder die SQL-Anweisung falsch ist oder wenn die DataConnection nicht richtig aufgebaut werden konnte
|
||
' Eintrag in Logdatei machen
|
||
LOGGER.Info("ExecuteonMSSQL.SQL-Command ist ungültig. Command-Objekt konnte nicht erstellt werden")
|
||
Return "ExecuteonMSSQL.SQL-Command ist ungültig. Command-Objekt konnte nicht erstellt werden"
|
||
End If
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
' an dieser Stelle sollte jeder unvorhergesehene Fehler der Funktion abgefangen werden
|
||
LOGGER.Info("ExecuteonMSSQL.Ein unbekannter Fehler in ExecuteonMSSQL - Error: " & ex.Message, True)
|
||
Return "ExecuteonMSSQL.Ein unbekannter Fehler in ExecuteonMSSQL - Error: " & ex.Message
|
||
End Try
|
||
|
||
End Function
|
||
Private Sub CloseMssqlDb(ByRef Connection As SqlConnection)
|
||
' wenn eine Datenbank-Connection aufgebaut ist
|
||
If Connection IsNot Nothing Then
|
||
' diese schliessen
|
||
Connection.Close()
|
||
Connection = Nothing
|
||
End If
|
||
|
||
End Sub
|
||
Public Function Move2Folder(ByVal vMove_File As String, ByVal vZiel_Pfad As String, Profile_ID As Integer, clsWD As ClassWindream_allgemein)
|
||
Try
|
||
|
||
Dim extension As String = IO.Path.GetExtension(vMove_File)
|
||
Dim Filename As String = IO.Path.GetFileName(vMove_File)
|
||
Dim path As String = IO.Path.GetDirectoryName(vMove_File)
|
||
Dim _Ziel As String
|
||
_Ziel = vZiel_Pfad & "\" & Filename
|
||
Dim version As Integer = 1
|
||
If vZiel_Pfad <> path Then
|
||
Dim Stammname As String = IO.Path.GetFileNameWithoutExtension(vMove_File)
|
||
Do While Check_File_exists(_Ziel, clsWD) = True
|
||
Dim neuername As String = Stammname & "~" & version & extension
|
||
_Ziel = neuername
|
||
version += 1
|
||
Loop
|
||
My.Computer.FileSystem.MoveFile(vMove_File, _Ziel)
|
||
LOGGER.Info("Datei erfolgreich verschoben - Ziel: " & _Ziel)
|
||
Else
|
||
LOGGER.Info("Ziel und Quellpfad sind identisch!")
|
||
End If
|
||
|
||
Return ""
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
LOGGER.Info("Fehler bei Move2Folder", True)
|
||
LOGGER.Info("Fehlermeldung")
|
||
LOGGER.Info(ex.Message)
|
||
Return ex.Message
|
||
End Try
|
||
End Function
|
||
Public Function Check_File_exists(ByVal _file As String, clsWD As ClassWindream_allgemein)
|
||
Try
|
||
Return clsWD.CheckFileExists(_file)
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
LOGGER.Info("Fehler in Funktion file_exists - Fehler: ", ex.Message)
|
||
Return False
|
||
End Try
|
||
End Function
|
||
Public Function CheckValue_Exists(sqlbefehl As String, Replace_value As String, Check_value As String, Typ As String, connString As String, profilid As Integer)
|
||
Try
|
||
Dim sql As String
|
||
Dim CONNTYPE As String
|
||
If connString <> "" Then
|
||
If connString.StartsWith("%MS") Then
|
||
CONNTYPE = "MS-SQL"
|
||
connString = connString.Replace("%MS", "")
|
||
ElseIf connString.StartsWith("%OR") Then
|
||
CONNTYPE = "ORACLE"
|
||
connString = connString.Replace("%OR", "")
|
||
End If
|
||
|
||
Dim sqlscalar = sqlbefehl
|
||
Select Case Typ
|
||
Case "INTEGER"
|
||
'@manValue
|
||
sqlscalar = sqlscalar.ToString.Replace(Replace_value, Check_value)
|
||
Case Else
|
||
sqlscalar = sqlscalar.ToString.Replace(Replace_value, "'" & Check_value & "'")
|
||
End Select
|
||
|
||
sql = sqlscalar
|
||
Dim ergebnis As Integer
|
||
If CONNTYPE = "ORACLE" Then
|
||
ergebnis = Execute_Scalar_Oracle(sql, connString, True)
|
||
Else
|
||
ergebnis = Execute_Scalar_SQLServer(sql, connString, True)
|
||
End If
|
||
|
||
Select Case ergebnis
|
||
Case 1
|
||
Return True
|
||
Case Else
|
||
Return False
|
||
End Select
|
||
End If
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error checkValue_Exists:")
|
||
LOGGER.Info(" - Unvorhergesehener Fehler bei checkValue_Exists - Fehler: " & vbNewLine & ex.Message)
|
||
Return False
|
||
End Try
|
||
End Function
|
||
|
||
Function Execute_Scalar_SQLServer(vsql_statement As String, vconnectionString As String, check As Boolean)
|
||
Try
|
||
Dim cnn As SqlConnection
|
||
cnn = New SqlConnection(vconnectionString)
|
||
Dim cmd As SqlCommand
|
||
cnn.Open()
|
||
cmd = New SqlCommand(vsql_statement, cnn)
|
||
If check = True Then
|
||
'ERgebnis muss immer 1 oder mehr ergeben
|
||
Dim count As Int32 = Convert.ToInt32(cmd.ExecuteScalar())
|
||
If count = 1 Then
|
||
cmd.Dispose()
|
||
cnn.Close()
|
||
Return 1
|
||
Else
|
||
cmd.Dispose()
|
||
cnn.Close()
|
||
Return 2
|
||
End If
|
||
Else
|
||
'Ergebnis
|
||
Dim ergebnis As String = cmd.ExecuteScalar()
|
||
Return ergebnis
|
||
End If
|
||
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
MsgBox("Unexpected error Execute_Scalar_SQLServer" & vbNewLine & "Automatic Index (j/n): " & check.ToString & vbNewLine & "ERROR:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error Execute_Scalar_SQL sql:")
|
||
LOGGER.Info(" - Unvorhergesehener Fehler bei Execute_Scalar_SQLServer" & vbNewLine & "Automatischer Index (j/n): " & check.ToString & vbNewLine & "Fehler: " & vbNewLine & ex.Message)
|
||
LOGGER.Info(" - SQL: " & vsql_statement)
|
||
LOGGER.Info(" - Connection: " & vconnectionString)
|
||
Return 99
|
||
End Try
|
||
End Function
|
||
Function Execute_Scalar_Oracle(vsql_statement As String, vconnectionString As String, check As Boolean)
|
||
Try
|
||
Dim cnn As System.Data.OleDb.OleDbConnection
|
||
cnn = New System.Data.OleDb.OleDbConnection(vconnectionString)
|
||
Dim cmd As System.Data.OleDb.OleDbCommand
|
||
cnn.Open()
|
||
cmd = New System.Data.OleDb.OleDbCommand(vsql_statement, cnn)
|
||
|
||
If check = True Then
|
||
'Ergebnis muss immer 1 oder mehr ergeben
|
||
Dim count As Int32 = Convert.ToInt32(cmd.ExecuteScalar())
|
||
If count = 1 Then
|
||
Return 1
|
||
Else
|
||
Return 2
|
||
End If
|
||
Else
|
||
'Ergebnis
|
||
Dim ergebnis As String = cmd.ExecuteScalar()
|
||
Return ergebnis
|
||
End If
|
||
|
||
cmd.Dispose()
|
||
cnn.Close()
|
||
Catch ex As Exception
|
||
LOGGER.Error(ex)
|
||
MsgBox("Unexpected error Execute_Scalar_Oracle" & vbNewLine & "Automatic Index (y/n): " & check.ToString & vbNewLine & "Error:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error Execute_Scalar_oracle sql:")
|
||
LOGGER.Info(" - Unvorhergesehener Fehler bei Execute_Scalar_Oracle" & vbNewLine & "Automatischer Index (j/n): " & check.ToString & vbNewLine & "Fehler: " & vbNewLine & ex.Message)
|
||
LOGGER.Info(" - SQL: " & vsql_statement)
|
||
LOGGER.Info(" - Connection: " & vconnectionString)
|
||
Return 99
|
||
End Try
|
||
End Function
|
||
Public Shared Sub Save_Logfiles()
|
||
Try
|
||
Dim saveFileDialog1 As New SaveFileDialog()
|
||
If File.Exists(LOGCONFIG.LogFile) Then
|
||
saveFileDialog1.Filter = "log file|*.log"
|
||
saveFileDialog1.FileName = Path.GetFileName(LOGCONFIG.LogFile)
|
||
If saveFileDialog1.ShowDialog() = DialogResult.OK Then
|
||
If File.Exists(saveFileDialog1.FileName) Then
|
||
File.Delete(saveFileDialog1.FileName)
|
||
End If
|
||
File.Copy(LOGCONFIG.LogFile, saveFileDialog1.FileName)
|
||
End If
|
||
End If
|
||
|
||
If DEBUG = True Then
|
||
Dim oDebuglogFilename_only = Path.GetFileNameWithoutExtension(LOGCONFIG.LogFile) + "-Debug.log"
|
||
Dim oDebuglogFilename = LOGCONFIG.LogDirectory + "\" + oDebuglogFilename_only
|
||
If File.Exists(oDebuglogFilename) Then
|
||
saveFileDialog1.Filter = "log file|*.log"
|
||
saveFileDialog1.FileName = oDebuglogFilename_only
|
||
If saveFileDialog1.ShowDialog() = DialogResult.OK Then
|
||
If File.Exists(saveFileDialog1.FileName) Then
|
||
File.Delete(saveFileDialog1.FileName)
|
||
End If
|
||
File.Copy(oDebuglogFilename, saveFileDialog1.FileName)
|
||
End If
|
||
End If
|
||
End If
|
||
Dim oErrorlogFilename_only = Path.GetFileNameWithoutExtension(LOGCONFIG.LogFile) + "-Error.log"
|
||
Dim oErrorlogFilename = LOGCONFIG.LogDirectory + "\" + oErrorlogFilename_only
|
||
If File.Exists(oErrorlogFilename) Then
|
||
saveFileDialog1.Filter = "log file|*.log"
|
||
saveFileDialog1.FileName = oErrorlogFilename_only
|
||
If saveFileDialog1.ShowDialog() = DialogResult.OK Then
|
||
If File.Exists(saveFileDialog1.FileName) Then
|
||
File.Delete(saveFileDialog1.FileName)
|
||
End If
|
||
File.Copy(oErrorlogFilename, saveFileDialog1.FileName)
|
||
End If
|
||
End If
|
||
Dim oMSG = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("ExportLogFiles_Result")
|
||
MsgBox(oMSG, MsgBoxStyle.Information, ADDITIONAL_TITLE)
|
||
Catch ex As Exception
|
||
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error saving log file")
|
||
End Try
|
||
End Sub
|
||
Public Shared Function NotNull(Of T)(value As Object, defaultValue As T) As T
|
||
If value Is Nothing OrElse Convert.IsDBNull(value) Then
|
||
Return defaultValue
|
||
End If
|
||
|
||
' Versuche den Wert in den gewünschten Typ zu konvertieren
|
||
Try
|
||
Return CType(value, T)
|
||
Catch ex As InvalidCastException
|
||
' Falls die Konvertierung fehlschlägt, gib den Default zurück
|
||
Return defaultValue
|
||
End Try
|
||
End Function
|
||
Public Shared Function NotNullNullable(Of T As Structure)(value As Object, defaultValue As Nullable(Of T)) As Nullable(Of T)
|
||
If value Is Nothing OrElse Convert.IsDBNull(value) Then
|
||
Return defaultValue
|
||
End If
|
||
Try
|
||
' Direkte Casts sind robust, wandeln aber DBNull nicht – das ist bereits oben abgefangen.
|
||
Return DirectCast(value, Nullable(Of T))
|
||
Catch
|
||
Try
|
||
' Fallback: in T casten und zu Nullable machen
|
||
Return New Nullable(Of T)(DirectCast(value, T))
|
||
Catch
|
||
Return defaultValue
|
||
End Try
|
||
End Try
|
||
End Function
|
||
Public Shared Function NotNullString(value As Object, defaultValue As Object) As String
|
||
If value Is Nothing OrElse Convert.IsDBNull(value) Then Return defaultValue
|
||
Return CStr(value)
|
||
End Function
|
||
|
||
Public Shared Function NotNullDate(value As Object, defaultValue As DateTime) As DateTime?
|
||
If value Is Nothing OrElse Convert.IsDBNull(value) Then Return defaultValue
|
||
Return DirectCast(value, DateTime)
|
||
End Function
|
||
Public Shared Function NewShortGuid() As String
|
||
' Neue GUID erzeugen
|
||
Dim g As Guid = Guid.NewGuid()
|
||
|
||
' In Base64 umwandeln
|
||
Dim b64 As String = Convert.ToBase64String(g.ToByteArray())
|
||
|
||
' Unerwünschte Zeichen ersetzen/entfernen
|
||
b64 = b64.Replace("=", "").Replace("+", "-").Replace("/", "_")
|
||
|
||
' Ergebnis zurückgeben
|
||
Return b64
|
||
End Function
|
||
#Region "Windows API Deklarationen"
|
||
<DllImport("mpr.dll", CharSet:=CharSet.Auto)>
|
||
Private Shared Function WNetAddConnection2(ByRef lpNetResource As NETRESOURCE,
|
||
ByVal lpPassword As String,
|
||
ByVal lpUsername As String,
|
||
ByVal dwFlags As Integer) As Integer
|
||
End Function
|
||
|
||
<DllImport("mpr.dll", CharSet:=CharSet.Auto)>
|
||
Private Shared Function WNetCancelConnection2(ByVal lpName As String,
|
||
ByVal dwFlags As Integer,
|
||
ByVal fForce As Boolean) As Integer
|
||
End Function
|
||
|
||
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
|
||
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
|
||
|
||
''' <summary>
|
||
''' Struktur für Netzlaufwerk-Informationen
|
||
''' </summary>
|
||
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
|
||
|
||
''' <summary>
|
||
''' Ermittelt den nächsten freien Laufwerksbuchstaben (alphabetisch absteigend von Z bis A)
|
||
''' </summary>
|
||
''' <param name="blacklist">Liste der nicht erlaubten Laufwerksbuchstaben (z.B. "Y,M,V")</param>
|
||
''' <returns>Nächster freier Laufwerksbuchstabe mit Doppelpunkt (z.B. "Z:") oder String.Empty wenn keiner frei</returns>
|
||
Public Shared 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
|
||
|
||
''' <summary>
|
||
''' Prüft ob ein Laufwerksbuchstabe verfügbar ist (nicht verwendet und nicht in Blacklist)
|
||
''' </summary>
|
||
''' <param name="driveLetter">Zu prüfender Laufwerksbuchstabe</param>
|
||
''' <param name="blacklist">Liste der nicht erlaubten Laufwerksbuchstaben</param>
|
||
''' <returns>True wenn verfügbar, False wenn bereits verwendet oder in Blacklist</returns>
|
||
Public Shared 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
|
||
|
||
''' <summary>
|
||
''' Mappt ein Netzlaufwerk mit automatischer Laufwerksbuchstabenwahl oder spezifischem Buchstaben
|
||
''' </summary>
|
||
''' <param name="driveLetter">Gewünschter Laufwerksbuchstabe (leer = automatisch den nächsten freien wählen)</param>
|
||
''' <param name="networkPath">UNC-Pfad des Netzwerkshares</param>
|
||
''' <param name="blacklist">Komma-getrennte Liste verbotener Laufwerksbuchstaben (z.B. "Y,M,V")</param>
|
||
''' <param name="userName">Optionaler Benutzername für Authentifizierung</param>
|
||
''' <param name="password">Optionales Passwort für Authentifizierung</param>
|
||
''' <param name="persistent">Soll das Mapping persistent sein?</param>
|
||
''' <returns>Verwendeter Laufwerksbuchstabe bei Erfolg, String.Empty bei Fehler</returns>
|
||
Public Shared 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
|
||
|
||
' Prüfen ob Laufwerk verfügbar ist
|
||
If Not IsDriveLetterAvailable(targetDriveLetter, blacklist) Then
|
||
LOGGER.Error($"Laufwerk {targetDriveLetter} ist nicht verfügbar (bereits verwendet oder in Blacklist)")
|
||
Return String.Empty
|
||
End If
|
||
End If
|
||
|
||
' Laufwerk mappen
|
||
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
|
||
|
||
''' <summary>
|
||
''' Interne Methode zum tatsächlichen Mappen eines Netzlaufwerks
|
||
''' </summary>
|
||
Private Shared 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
|
||
''' <summary>
|
||
''' Test-Funktion um UNC-Pfad-Zugriff zu prüfen
|
||
''' </summary>
|
||
Public Shared 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
|
||
''' <summary>
|
||
''' Trennt ein Netzlaufwerk mit Windows-API
|
||
''' </summary>
|
||
Public Shared 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 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 = 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
|
||
|
||
''' <summary>
|
||
''' Ermittelt alle gemappten Netzlaufwerke
|
||
''' </summary>
|
||
Public Shared 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
|
||
|
||
''' <summary>
|
||
''' Ermittelt den UNC-Pfad eines gemappten Laufwerks
|
||
''' </summary>
|
||
Public Shared 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
|
||
|
||
''' <summary>
|
||
''' Prüft ob ein bestimmtes Laufwerk als Netzlaufwerk gemappt ist
|
||
''' </summary>
|
||
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
|
||
|
||
''' <summary>
|
||
''' Gibt eine formatierte Übersicht aller gemappten Netzlaufwerke zurück
|
||
''' </summary>
|
||
Public Shared 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
|
||
''' <summary>
|
||
''' Mappt ein spezifisches Laufwerk (z.B. "V") mit Blacklist-Prüfung
|
||
''' </summary>
|
||
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
|
||
|
||
''' <summary>
|
||
''' Mappt automatisch den nächsten freien Laufwerksbuchstaben (Z→A)
|
||
''' </summary>
|
||
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
|