diff --git a/GUIs.ZooFlow/ClassClipboardWatcher.vb b/GUIs.ZooFlow/ClassClipboardWatcher.vb deleted file mode 100644 index 38f4b129..00000000 --- a/GUIs.ZooFlow/ClassClipboardWatcher.vb +++ /dev/null @@ -1,67 +0,0 @@ -Imports System.Runtime.InteropServices -Public Class ClassClipboardWatcher - Inherits NativeWindow - Implements IDisposable - - Private Class Win32 - - Public Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr - End Function - End Class - - Const WM_DRAWCLIPBOARD As Integer = &H308 - - Public Event ClipboardChanged As EventHandler(Of IDataObject) - Public Shared Singleton As New ClassClipboardWatcher - - Private _handle As IntPtr - - Private Sub New() - MyBase.CreateHandle(New CreateParams) - _handle = Win32.SetClipboardViewer(Handle) - End Sub - - Protected Overrides Sub WndProc(ByRef m As Message) - Select Case m.Msg - Case WM_DRAWCLIPBOARD - Dim oData As IDataObject = Clipboard.GetDataObject - RaiseEvent ClipboardChanged(Me, oData) - End Select - MyBase.WndProc(m) - End Sub - -#Region "IDisposable Support" - ' Für diese Klasse ist korrekte Ressourcenbereinigung besonders wichtig, da - ' mit systemübergreifenden Ressourcen gearbeitet wird - - ' So ermitteln Sie überflüssige Aufrufe - Private disposedValue As Boolean = False - - Protected Overridable Sub Dispose(ByVal disposing As Boolean) - If Not disposedValue Then - If disposing Then - ' TODO: Verwaltete Ressourcen freigeben, wenn sie explizit - ' aufgerufen werden - End If - MyBase.DestroyHandle() - Dim H As IntPtr = Win32.SetClipboardViewer(_handle) - End If - disposedValue = True - End Sub - - ' Dieser Code wird von Visual Basic hinzugefügt, um das Dispose-Muster - ' richtig zu implementieren. - Public Sub Dispose() Implements IDisposable.Dispose - ' Sie sollten diesen Code nicht ändern, sondern stattdessen ihren - ' Bereinigungscode oben in - ' Dispose(ByVal disposing As Boolean) einfügen. - Dispose(True) - GC.SuppressFinalize(Me) - End Sub - - Protected Overrides Sub Finalize() - MyBase.Finalize() - Dispose(False) - End Sub -#End Region -End Class diff --git a/GUIs.ZooFlow/ClassConstants.vb b/GUIs.ZooFlow/ClassConstants.vb index e79f15c0..887562b1 100644 --- a/GUIs.ZooFlow/ClassConstants.vb +++ b/GUIs.ZooFlow/ClassConstants.vb @@ -18,7 +18,12 @@ Public Const ATTR_TYPE_INTEGER = "BIG INTEGER" Public Const ATTR_TYPE_DATE = "DATE" Public Const ATTR_TYPE_BOOLEAN = "BIT" + Public Const VECTORSEPARATOR = "╚" + Public Const SERVICE_ADDRESS_SEPARATOR = ":" + + Public Const HOTKEY_TOGGLE_WATCHER = 354522017 + Public Const HOTKEY_TRIGGER_WATCHER = 354523017 Public Const SQLCMD_FLOW_SEARCH1 = "FLOW_SEARCH1" diff --git a/GUIs.ZooFlow/ClassEnvironment.vb b/GUIs.ZooFlow/ClassEnvironment.vb index ead957b1..506114ae 100644 --- a/GUIs.ZooFlow/ClassEnvironment.vb +++ b/GUIs.ZooFlow/ClassEnvironment.vb @@ -1,3 +1,15 @@ -Public Class ClassEnvironment +Imports DigitalData.Modules.ZooFlow +Public Class ClassEnvironment + Public Shared Function GetEnvironment() As Environment + Dim oEnvironment As New Environment() With { + .DatabaseIDB = My.DatabaseIDB, + .Database = My.Database, + .Modules = My.Application.Modules, + .Service = My.Application.Service, + .Settings = My.Application.Settings, + .User = My.Application.User + } + Return oEnvironment + End Function End Class diff --git a/GUIs.ZooFlow/ClassInit.vb b/GUIs.ZooFlow/ClassInit.vb index ac256158..893cdf75 100644 --- a/GUIs.ZooFlow/ClassInit.vb +++ b/GUIs.ZooFlow/ClassInit.vb @@ -14,8 +14,10 @@ Public Class ClassInit Private _MainForm As frmFlowForm Private _Logger As Logger Private _LogConfig As LogConfig - Public Event Completed As EventHandler Private _DataASorDB As ClassDataASorDB + Private _Loader As ClassInitLoader + + Public Event Completed As EventHandler Public Sub New(LogConfig As LogConfig, ParentForm As frmFlowForm) _MainForm = ParentForm @@ -37,22 +39,23 @@ Public Class ClassInit MsgBox("Keine Verbindungs-Informationen hinterlegt. Anwendung wird beendet.", MsgBoxStyle.Critical, _MainForm.Text) Application.Exit() Else - Dim oInit As New ClassInitLoader() + _Loader = New ClassInitLoader() ' === Init Schritte definieren - oInit.AddStep("Checking connectivity..", AddressOf CheckConnectivity, True) - oInit.AddStep("Initializing User..", AddressOf InitializeUser, True) - oInit.AddStep("Initializing IDB Database..", AddressOf InitializeIDBDatabase, True) - oInit.AddStep("Initializing IDB Service..", AddressOf InitializeIDBService, True) - oInit.AddStep("Initializing Language..", AddressOf InitializeLanguage, False) - oInit.AddStep("Loading 3rd-party licenses..", AddressOf Initialize3rdParty, False) - oInit.AddStep("Loading Basic Configs..", AddressOf InitBasicData, False) + _Loader.AddStep("Checking connectivity..", AddressOf CheckConnectivity, True) + _Loader.AddStep("Initializing User..", AddressOf InitializeUser, True) + _Loader.AddStep("Initializing IDB Database..", AddressOf InitializeIDBDatabase, True) + _Loader.AddStep("Initializing IDB Service..", AddressOf InitializeIDBService, True) + _Loader.AddStep("Initializing Language..", AddressOf InitializeLanguage, False) + _Loader.AddStep("Initializing Clipboard Watcher..", AddressOf InitializeClipboardWatcher, False) + _Loader.AddStep("Loading 3rd-party licenses..", AddressOf Initialize3rdParty, False) + _Loader.AddStep("Loading Basic Configs..", AddressOf InitBasicData, False) ' === Init Schritte definieren - AddHandler oInit.ProgressChanged, AddressOf ProgressChanged - AddHandler oInit.InitCompleted, AddressOf InitCompleted + AddHandler _Loader.ProgressChanged, AddressOf ProgressChanged + AddHandler _Loader.InitCompleted, AddressOf InitCompleted - oInit.Run() + _Loader.Run() End If End Sub @@ -97,6 +100,7 @@ Public Class ClassInit My.Application.User = oMyApplication.User My.Application.Modules = oMyApplication.Modules My.Application.ModulesActive = oMyApplication.ModulesActive + My.Application.ClipboardWatcher = oMyApplication.ClipboardWatcher RaiseEvent Completed(sender, Nothing) End If @@ -128,11 +132,9 @@ Public Class ClassInit Dim oRow As DataRow = oDatatable.Rows.Item(0) MyApplication.Settings.GdPictureKey = NotNull(oRow.Item("LICENSE"), String.Empty) - My.Application.Settings.GdPictureKey = NotNull(oRow.Item("LICENSE"), String.Empty) - My.Application.GDPictureLicense = My.Application.Settings.GdPictureKey Catch ex As Exception _Logger.Error(ex) - Throw New InitException("Error initializing3rdParty!") + Throw New InitException("Error initializing3rdParty!", ex) End Try End Sub Private Sub InitBasicData(MyApplication As My.MyApplication) @@ -157,7 +159,7 @@ Public Class ClassInit Next Catch ex As Exception _Logger.Error(ex) - Throw New InitException("Error in InitBasicData") + Throw New InitException("Error in InitBasicData", ex) End Try End Sub @@ -183,7 +185,7 @@ Public Class ClassInit Catch ex As Exception _Logger.Error(ex) - Throw New InitException("Error in InitBasicData") + Throw New InitException("Error in InitBasicData", ex) End Try End Sub @@ -253,7 +255,40 @@ Public Class ClassInit Catch ex As Exception _Logger.Error(ex) - Throw ex + Throw New InitException("Error while initializing user!", ex) + End Try + End Sub + + Private Sub InitializeClipboardWatcher(MyApplication As My.MyApplication) + Try + Dim oUserId = My.Application.User.UserId + Dim oWhereClause = $"T1.USER_ID = {oUserId} OR GROUP_ID IN (SELECT DISTINCT GUID FROM TBDD_GROUPS WHERE GUID IN (SELECT GROUP_ID FROM TBDD_GROUPS_USER WHERE USER_ID = {oUserId}))" + + Dim oProfileSQL As String = $"SELECT DISTINCT GUID, NAME,REGEX_EXPRESSION,COMMENT,PROC_NAME,PROFILE_TYPE FROM VWCW_USER_PROFILE T1 WHERE {oWhereClause}" + Dim oProcessSQL As String = $"SELECT DISTINCT T.GUID, T.PROFILE_ID,T.PROC_NAME FROM TBCW_PROFILE_PROCESS T, VWCW_USER_PROFILE T1 WHERE T.PROFILE_ID = T1.GUID AND ({oWhereClause})" + Dim oWindowSQL As String = $"SELECT DISTINCT T.* FROM VWCW_PROFILE_REL_WINDOW T, VWCW_USER_PROFILE T1 WHERE T.PROFILE_ID = T1.GUID AND ({oWhereClause})" + Dim oControlSQL As String = $"SELECT DISTINCT T.* FROM VWCW_PROFILE_REL_CONTROL T, VWCW_USER_PROFILE T1 WHERE T.PROFILE_ID = T1.GUID AND ({oWhereClause})" + + Dim oUserProfiles = My.Database.GetDatatable(oProfileSQL) + + If oUserProfiles Is Nothing OrElse oUserProfiles.Rows.Count = 0 Then + MyApplication.ClipboardWatcher.Status = ClipboardWatcher.State.EnumStatus.NoProfilesConfigured + End If + + Dim oProfileProcesses = My.Database.GetDatatable(oProcessSQL) + Dim oProfileWindows = My.Database.GetDatatable(oWindowSQL) + Dim oProfileControls = My.Database.GetDatatable(oControlSQL) + + MyApplication.ClipboardWatcher.Status = ClipboardWatcher.State.EnumStatus.OK + MyApplication.ClipboardWatcher.UserProfiles = oUserProfiles + MyApplication.ClipboardWatcher.ProfileProcesses = oProfileProcesses + MyApplication.ClipboardWatcher.ProfileWindows = oProfileWindows + MyApplication.ClipboardWatcher.ProfileControls = oProfileControls + MyApplication.ClipboardWatcher.MonitoringActive = True + Catch ex As Exception + MyApplication.ClipboardWatcher.Status = ClipboardWatcher.State.EnumStatus.Exception + _Logger.Error(ex) + Throw New InitException("Error while initializing clipboard watcher!", ex) End Try End Sub @@ -278,7 +313,6 @@ Public Class ClassInit MyApplication.User.Language = NotNull(oValue.ToString, "de-DE") End Select End Sub - Private Sub HandleModuleInfo(MyApplication As My.MyApplication, ModuleName As String, Row As DataRow) Dim oValue As Object = Row.Item("VALUE") Dim oName As String = Row.Item("NAME").ToString diff --git a/GUIs.ZooFlow/ClassInitLoader.vb b/GUIs.ZooFlow/ClassInitLoader.vb index 74fcf30b..86cf520c 100644 --- a/GUIs.ZooFlow/ClassInitLoader.vb +++ b/GUIs.ZooFlow/ClassInitLoader.vb @@ -1,4 +1,5 @@ Imports System.ComponentModel +Imports DigitalData.GUIs.ZooFlow.My Imports DigitalData.Modules.Logging Public Class ClassInitLoader @@ -52,6 +53,13 @@ Public Class ClassInitLoader Try oStep.Action.Invoke(oMyApplication) + + My.Application.Settings = oMyApplication.Settings + My.Application.User = oMyApplication.User + My.Application.Modules = oMyApplication.Modules + My.Application.ModulesActive = oMyApplication.ModulesActive + My.Application.ClipboardWatcher = oMyApplication.ClipboardWatcher + Catch ex As Exception _Logger.Error(ex) _Logger.Warn("Init Step '{0}' failed!", oStep.Name) diff --git a/GUIs.ZooFlow/ClassWin32.vb b/GUIs.ZooFlow/ClassWin32.vb index e3aa6c82..34c4a014 100644 --- a/GUIs.ZooFlow/ClassWin32.vb +++ b/GUIs.ZooFlow/ClassWin32.vb @@ -1,6 +1,17 @@ Imports System.Runtime.InteropServices Public Class ClassWin32 + Public Const ULW_COLORKEY As Int32 = &H1 + Public Const ULW_ALPHA As Int32 = &H2 + Public Const ULW_OPAQUE As Int32 = &H4 + Public Const AC_SRC_OVER As Byte = &H0 + Public Const AC_SRC_ALPHA As Byte = &H1 + + Public Const WM_NCLBUTTONDOWN As Integer = &HA1 + Public Const HTCAPTION As Integer = &H2 + + Public Const WM_DRAWCLIPBOARD As Integer = &H308 + Public Enum Bool [False] = 0 [True] @@ -44,40 +55,51 @@ Public Class ClassWin32 Public AlphaFormat As Byte End Structure - Public Const ULW_COLORKEY As Int32 = &H1 - Public Const ULW_ALPHA As Int32 = &H2 - Public Const ULW_OPAQUE As Int32 = &H4 - Public Const AC_SRC_OVER As Byte = &H0 - Public Const AC_SRC_ALPHA As Byte = &H1 - - Public Const WM_NCLBUTTONDOWN As Integer = &HA1 - Public Const HTCAPTION As Integer = &H2 - Public Shared Function UpdateLayeredWindow(ByVal hwnd As IntPtr, ByVal hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, ByVal hdcSrc As IntPtr, ByRef pprSrc As Point, ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Bool End Function + Public Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr End Function + Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer End Function + Public Shared Function CreateCompatibleDC(ByVal hDC As IntPtr) As IntPtr End Function + Public Shared Function DeleteDC(ByVal hdc As IntPtr) As Bool End Function + Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr End Function + Public Shared Function DeleteObject(ByVal hObject As IntPtr) As Bool End Function + Public Shared Function ReleaseCapture() As Boolean End Function + Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer End Function + + + Public Shared Function AddClipboardFormatListener(ByVal hWnd As IntPtr) As Boolean + End Function + + + Public Shared Function RemoveClipboardFormatListener(ByVal hWnd As IntPtr) As Boolean + End Function + + + Public Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr + End Function End Class diff --git a/GUIs.ZooFlow/ClipboardWatcher/State.vb b/GUIs.ZooFlow/ClipboardWatcher/State.vb index 795b4ab1..018f3b63 100644 --- a/GUIs.ZooFlow/ClipboardWatcher/State.vb +++ b/GUIs.ZooFlow/ClipboardWatcher/State.vb @@ -1,8 +1,25 @@ -Namespace ClipboardWatcher +Imports DigitalData.Modules.ZooFlow.Params + +Namespace ClipboardWatcher Public Class State - Public UserProfiles As DataTable - Public ProfileProcesses As DataTable - Public ProfileWindows As DataTable - Public ProfileControls As DataTable + Public Enum EnumStatus + OK + NoProfilesConfigured + Exception + End Enum + + Public UserProfiles As DataTable = Nothing + Public ProfileProcesses As DataTable = Nothing + Public ProfileWindows As DataTable = Nothing + Public ProfileControls As DataTable = Nothing + + Public MatchTreeView As TreeView = New TreeView() + + Public Property CurrentMatchingProfiles As List(Of ProfileData) = New List(Of ProfileData) + Public Property CurrentProfilesWithResults As List(Of ProfileData) = New List(Of ProfileData) + Public Property CurrentClipboardContents As String = String.Empty + + Public Property MonitoringActive As Boolean = False + Public Property Status As EnumStatus End Class End Namespace \ No newline at end of file diff --git a/GUIs.ZooFlow/ClipboardWatcher/Watcher.vb b/GUIs.ZooFlow/ClipboardWatcher/Watcher.vb new file mode 100644 index 00000000..9d7b2107 --- /dev/null +++ b/GUIs.ZooFlow/ClipboardWatcher/Watcher.vb @@ -0,0 +1,64 @@ +Imports System.Runtime.InteropServices + +Namespace ClipboardWatcher + Public Class Watcher + Inherits NativeWindow + Implements IDisposable + + Public Event ClipboardChanged As EventHandler(Of IDataObject) + Public Shared Singleton As New Watcher + + Private _Handle As IntPtr + + Private Sub New() + MyBase.CreateHandle(New CreateParams) + _Handle = ClassWin32.SetClipboardViewer(Handle) + End Sub + + Protected Overrides Sub WndProc(ByRef m As Message) + Select Case m.Msg + Case ClassWin32.WM_DRAWCLIPBOARD + Dim oData As IDataObject = Clipboard.GetDataObject + RaiseEvent ClipboardChanged(Me, oData) + End Select + MyBase.WndProc(m) + End Sub + +#Region "IDisposable Support" + ' Für diese Klasse ist korrekte Ressourcenbereinigung besonders wichtig, da + ' mit systemübergreifenden Ressourcen gearbeitet wird + + ' So ermitteln Sie überflüssige Aufrufe + Private _DisposedValue As Boolean = False + + Protected Overridable Sub Dispose(ByVal pDisposing As Boolean) + If Not _DisposedValue Then + If pDisposing Then + ' TODO: Verwaltete Ressourcen freigeben, wenn sie explizit + ' aufgerufen werden + End If + MyBase.DestroyHandle() + Dim H As IntPtr = ClassWin32.SetClipboardViewer(_Handle) + End If + _DisposedValue = True + End Sub + + ' Dieser Code wird von Visual Basic hinzugefügt, um das Dispose-Muster + ' richtig zu implementieren. + Public Sub Dispose() Implements IDisposable.Dispose + ' Sie sollten diesen Code nicht ändern, sondern stattdessen ihren + ' Bereinigungscode oben in + ' Dispose(ByVal disposing As Boolean) einfügen. + Dispose(True) + System.GC.SuppressFinalize(Me) + End Sub + + Protected Overrides Sub Finalize() + MyBase.Finalize() + Dispose(False) + End Sub +#End Region + End Class + +End Namespace + diff --git a/GUIs.ZooFlow/Globix/GlobixControls.vb b/GUIs.ZooFlow/Globix/GlobixControls.vb index a498dbb8..9029b611 100644 --- a/GUIs.ZooFlow/Globix/GlobixControls.vb +++ b/GUIs.ZooFlow/Globix/GlobixControls.vb @@ -2,6 +2,7 @@ Imports DigitalData.Modules.Logging Imports Oracle.ManagedDataAccess.Client Imports DigitalData.Controls.LookupGrid +Imports DigitalData.Modules.Language.Utils Public Class GlobixControls Private Property Form As frmGlobix_Index diff --git a/GUIs.ZooFlow/Globix/GlobixPatterns.vb b/GUIs.ZooFlow/Globix/GlobixPatterns.vb index 3eecfa21..96719f69 100644 --- a/GUIs.ZooFlow/Globix/GlobixPatterns.vb +++ b/GUIs.ZooFlow/Globix/GlobixPatterns.vb @@ -2,6 +2,7 @@ Imports DevExpress.XtraEditors Imports DigitalData.Controls.LookupGrid Imports DigitalData.Modules.Logging +Imports DigitalData.Modules.Language.Utils Public Class GlobixPatterns Private _Logger As Logger diff --git a/GUIs.ZooFlow/ZooFlow.vbproj b/GUIs.ZooFlow/ZooFlow.vbproj index 5f428310..4a14947a 100644 --- a/GUIs.ZooFlow/ZooFlow.vbproj +++ b/GUIs.ZooFlow/ZooFlow.vbproj @@ -113,7 +113,7 @@ - + diff --git a/GUIs.ZooFlow/frmGlobix_Index.vb b/GUIs.ZooFlow/frmGlobix_Index.vb deleted file mode 100644 index 2d5fc5fb..00000000 --- a/GUIs.ZooFlow/frmGlobix_Index.vb +++ /dev/null @@ -1,1840 +0,0 @@ -Imports System.IO -Imports System.Security.AccessControl -Imports System.Security.Principal -Imports DigitalData.Modules.Logging -Imports System.Text.RegularExpressions -Public Class frmGlobix_Index -#Region "+++++ Variablen ++++++" - Public vPathFile As String - Private MULTIFILES As Integer - Private akttxtbox As TextBox - Private DT_INDEXEMAN As DataTable - Private DT_INDEXEAUTO As DataTable - Private DT_DOCTYPE As DataTable - Public FormLoaded As Boolean = False - Dim DropType As String - - Dim sql_history_INSERT_INTO As String - Dim sql_history_Index_Values As String - - Private NewFileString As String - Private CancelAttempts As Integer = 0 - Private Const MaxCancelAttempts = 2 - - Private Property ViewerString As String - - Private Const TEXT_MISSING_INPUT = "Bitte vervollständigen Sie die Eingaben!" - Private _LogConfig As LogConfig - Private _Logger As Logger - Private clsPatterns As GlobixPatterns - Private clswindowLocation As ClassWindowLocation - Private clsPostProcessing As GlobixPostprocessing - Public Const VECTORSEPARATOR = "╚" - - -#End Region - Public Sub New(LogConfig As LogConfig) - - ' Dieser Aufruf ist für den Designer erforderlich. - InitializeComponent() - - ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. - _Logger = LogConfig.GetLogger() - _LogConfig = LogConfig - clswindowLocation = New ClassWindowLocation(_LogConfig) - clsPostProcessing = New GlobixPostprocessing(_LogConfig) - clsPatterns = New GlobixPatterns(_LogConfig) - End Sub - Public Sub DisposeViewer() - DocumentViewer1.Dispose() - End Sub - Sub Refresh_Dokart() - Try - Dim oSql = String.Format("select * from VWGI_DOCTYPE where UPPER(USERNAME) = UPPER('{0}') ORDER BY SEQUENCE", Environment.UserName) - _Logger.Info("SQL DoctypeList: " & oSql) - DT_DOCTYPE = My.Database.GetDatatable(oSql) - cmbDoctype.DataSource = DT_DOCTYPE - cmbDoctype.ValueMember = DT_DOCTYPE.Columns("DOCTYPE_ID").ColumnName - cmbDoctype.DisplayMember = DT_DOCTYPE.Columns("DOCTYPE").ColumnName - cmbDoctype.AutoCompleteMode = AutoCompleteMode.Suggest - cmbDoctype.AutoCompleteSource = AutoCompleteSource.ListItems - cmbDoctype.SelectedIndex = -1 - Catch ex As Exception - _Logger.Warn(" - Unexpected error inm Laden der Dokumentarten - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Laden der Dokumentarten:") - End Try - End Sub - '#Region "+++++ Allgemeine Funktionen ++++++" - Sub ShowError(text As String) - 'lblerror.Visible = True - 'lblerror.Text = text - 'lblerror.ForeColor = Color.Red - labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Always - labelError.Caption = text - End Sub - - Sub ClearError() - labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Never - labelError.Caption = String.Empty - End Sub - - Sub ShowNotice(text As String) - 'lblhinweis.Visible = True - 'lblhinweis.Text = text - labelNotice.Visibility = DevExpress.XtraBars.BarItemVisibility.Always - labelNotice.Caption = text - End Sub - - Sub ClearNotice() - labelNotice.Visibility = DevExpress.XtraBars.BarItemVisibility.Never - labelNotice.Caption = String.Empty - End Sub - Sub addLabel(indexname As String, hinweis As String, ylbl As Integer, anz As String) - Dim lbl As New Label With { - .Name = "lbl" & indexname, - .AutoSize = True, - .Text = hinweis, - .Location = New Point(11, ylbl) - } - - pnlIndex.Controls.Add(lbl) - End Sub - Function Indexwert_checkValueDB(indexname As String, wert As String) - Try - Dim DR As DataRow - 'DT = DD_DMSLiteDataSet.VWINDEX_MAN - For Each DR In DT_INDEXEMAN.Rows - If DR.Item("NAME") = indexname Then - If DR.Item("SQL_CHECK").ToString <> String.Empty Then - Dim connectionString As String - Dim sql As String - connectionString = My.Database.Get_ConnectionStringforID(DR.Item("CONNECTION_ID")).ToString - If connectionString <> "" Then - Dim sqlscalar = DR.Item("SQL_CHECK") - Select Case DR.Item("DATENTYP") - Case "INTEGER" - sqlscalar = sqlscalar.ToString.Replace("@manValue", wert) - Case Else - sqlscalar = sqlscalar.ToString.Replace("@manValue", "'" & wert & "'") - End Select - - sql = sqlscalar - Dim ergebnis As Integer - 'If DR.Item("SQL_PROVIDER") = "Oracle" Then - 'ergebnis = ''--My.Database.o.OracleExecute_Scalar(sql, connectionString) - 'Else - 'MSQL - ergebnis = My.Database.GetScalarValueConStr(sql, connectionString, "Indexwert_checkValueDB") - ' End If - - Select Case ergebnis - Case 1 - Return True - Case 2 - ShowNotice("Indexwert nicht eindeutig: " & sql) - Return False - Case 99 - Return False - End Select - - End If - Else - Return True - End If - - End If - Next - Catch ex As Exception - MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in Indexwert_checkValue:") - _Logger.Info(" - Unvorhergesehener Unexpected error in Indexwert_checkValue - Fehler: " & vbNewLine & ex.Message) - Return False - End Try - End Function - - Function GetManIndex_Value(indexname As String, RequestFor As String, opt As Boolean) - Try - - For Each oDataRow As DataRow In DT_INDEXEMAN.Rows - If oDataRow.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then - If oDataRow.Item("Indexiert") = True Then - _Logger.Info("## Manueller Index: " & indexname) - Select Case RequestFor - Case "FILE" - If oDataRow.Item("Indexwert_File").ToString <> String.Empty Then - _Logger.Info(" >>Es liegt ein separater nachbearbeiteter Wert für die Dateibenennung vor: " & oDataRow.Item("Indexwert_File").ToString) - _Logger.Info(" >>Zurückgegebener NachbearbeitungsWert: " & oDataRow.Item("Indexwert_File")) - Return oDataRow.Item("Indexwert_File") - Else - If oDataRow.Item("Indexwert").ToString <> String.Empty Then - _Logger.Info("Zurückgegebener manueller Indexwert: " & oDataRow.Item("Indexwert")) - Return oDataRow.Item("Indexwert") - Else - If opt = False Then - _Logger.Info("Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!") - ShowNotice("Indexiert = True - Der Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") - Return Nothing - Else - Return "" - End If - - End If - End If - Case Else - If oDataRow.Item("Indexwert").ToString <> String.Empty Then - _Logger.Info(" >>Zurückgegebener manueller Indexwert: " & oDataRow.Item("Indexwert")) - Return oDataRow.Item("Indexwert") - Else - 'Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & CURRENT_DOKART_ID & " AND UPPER(NAME) = UPPER('" & indexname & "')", MyConnectionString, True) - If opt = False Then - _Logger.Info("Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!") - ShowNotice("Indexiert = True - Der Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") - Return Nothing - Else - Return "" - End If - End If - End Select - Else - ShowNotice("Der Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") - Return Nothing - End If - Exit For - End If - Next - Catch ex As Exception - _Logger.Warn(" - Unvorhergesehener Unexpected error in GetManIndex_Value - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in GetManIndex_Value:") - Return Nothing - End Try - End Function - Function GetAutoIndex_Value(indexname As String) - Try - For Each oDataRow As DataRow In DT_INDEXEAUTO.Rows - If oDataRow.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then - Dim oIndexWert = oDataRow.Item("Indexwert") - Dim oIsIndexed = oDataRow.Item("Indexiert") - - If oIsIndexed = True Then - If oIndexWert.ToString <> String.Empty Then - oIndexWert = oIndexWert.ToString - - ' If Index is a vectorfield (read: Value contains the VECTORSEPARATOR character), use the first value - If oIndexWert.Contains(VECTORSEPARATOR) Then - Return oIndexWert.ToString.Split(VECTORSEPARATOR).FirstOrDefault() - Else - ' Else just return the normal value - Return oIndexWert - End If - Else - ShowNotice("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") - Return "" - End If - Else - ShowNotice("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") - Return "" - End If - Exit For - End If - Next - Catch ex As Exception - _Logger.Warn(" - Unvorhergesehener Unexpected error in GetAutoIndex_Value - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in GetAutoIndex_Value:") - Return "" - End Try - End Function - - Function GetAutomaticIndexSQLValue(SQLCommand As String, vconnectionID As Integer, vProvider As String) As String - Try - Dim oConnectionString As String - oConnectionString = My.Database.Get_ConnectionStringforID(vconnectionID) - - If oConnectionString <> "" Then - 'NEU - Dim oErgebnis - 'Welcher Provider? - 'If vProvider.ToLower = "oracle" Then - 'oErgebnis = ClassDatabase.OracleExecute_Scalar(SQLCommand, oConnectionString) - 'Else 'im Moment nur SQL-Server - oErgebnis = My.Database.GetScalarValueConStr(SQLCommand, oConnectionString, "GetAutomaticIndexSQLValue") - 'End If - - _Logger.Debug(" >>SQL-ConnectionString: " & oConnectionString.Substring(0, oConnectionString.LastIndexOf("="))) - - If oErgebnis Is Nothing Then - 'showlblhinweis("Kein Ergebnis für automatisches SQL: " & vsqlstatement) - Return "" - Else - Return oErgebnis - End If - End If - - Catch ex As Exception - _Logger.Warn(" - Unexpected error in Get_AutomatischerIndex_SQL - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Get_AutomatischerIndex_SQL:") - Return "" - End Try - End Function - Private Sub frmGlobix_Index_Load(sender As Object, e As EventArgs) Handles MyBase.Load - ' Abbruchzähler zurücksetzen - CancelAttempts = 0 - - My.Application.Globix.INDEXING_ACTIVE = True - - Try - My.Application.Globix.CURRENT_ISATTACHMENT = False - DropType = My.Database.GetScalarValue("SELECT HANDLE_TYPE FROM TBGI_FILES_USER WHERE GUID = " & My.Application.Globix.CURRENT_WORKFILE_GUID).ToString - - My.Application.Globix.CURR_DELETE_ORIGIN = My.UIConfig.Globix.DeleteOriginalFile - SourceDeleteItem.Enabled = True - SourceDeleteItem.Checked = My.UIConfig.Globix.DeleteOriginalFile - - My.Application.GDPictureLicense = My.Database.GetScalarValue("SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'").ToString - - DocumentViewer1.Init(_LogConfig, My.Application.GDPictureLicense) - - If DropType Is Nothing Then - _Logger.Debug("File with Id [{0}] was not found in TBGI_FILES_USER. Exiting.", My.Application.Globix.CURRENT_WORKFILE_GUID) - CancelAttempts = MaxCancelAttempts - Close() - Else - My.Application.Globix.CURRENT_DROPTYPE = DropType.Replace("|", "") - - If DropType.StartsWith("|FW") Then - ' Eine Datei aus FolderWatch wird IMMER gelöscht, egal wie die Einstellung in der Config lautet - My.Application.Globix.CURR_DELETE_ORIGIN = True - SourceDeleteItem.Visibility = DevExpress.XtraBars.BarItemVisibility.Never - ElseIf DropType.Contains("|OUTLOOK_MESSAGE|") Then - ' Eine (DragDrop)-Outlook Nachricht wird NIE gelöscht, egal wie die Einstellung in der Config lautet - My.Application.Globix.CURR_DELETE_ORIGIN = False - SourceDeleteItem.Visibility = DevExpress.XtraBars.BarItemVisibility.Never - Else - SourceDeleteItem.Visibility = DevExpress.XtraBars.BarItemVisibility.Always - End If - - If DropType = "|DROPFROMFSYSTEM|" Then - If My.Application.User.Language <> "de-DE" Then - Me.Text = "Indexing of dropped file" - Else - Me.Text = "Indexierung der gedroppten Datei" - End If - ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Then - Select Case DropType - Case "|FW_MSGONLY|" - _Logger.Info(".msg-file from folderwatch") - If My.Application.User.Language <> "de-DE" Then - Me.Text = "Indexing of msg-File (without Attachments) - from Folderwatch" - Else - Me.Text = "Indexierung der msg-Datei (ohne Anhang) - aus Folderwatch" - End If - Case "|OUTLOOK_MESSAGE|" - _Logger.Info(".msg-file through dragdrop") - If My.Application.User.Language <> "de-DE" Then - Me.Text = "Indexing of msg-File (without Attachments)" - Else - Me.Text = "Indexierung der msg-Datei (ohne Anhang)" - End If - End Select - - ElseIf DropType = "|MSGONLY|" Then - If My.Application.User.Language = "de-DE" Then - Me.Text = "Indexierung der msg-Datei (ohne Anhang)" - Else - Me.Text = "Indexing of msg-File (without Attachments)" - End If - ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then - My.Application.Globix.CURRENT_ISATTACHMENT = True - - If My.Application.User.Language = "de-DE" Then - Me.Text = "Indexierung eines Email-Attachments" - Else - Me.Text = "Indexing of email-Attachment" - End If - ElseIf DropType = "|FW_SIMPLEINDEXER|" Then - - If My.Application.User.Language = "de-DE" Then - Me.Text = "Indexierung einer Folderwatch-Datei" - Else - Me.Text = "Indexing of Folderwatch-File" - End If - End If - - labelFilePath.Caption = My.Application.Globix.CURRENT_WORKFILE - - clswindowLocation.LoadFormLocationSize(Me) - - SetFilePreview(My.UIConfig.Globix.FilePreview) - - SplitContainerControl1.SplitterPosition = My.UIConfig.Globix.SplitterDistanceViewer - - - - My.Application.Globix.DTTBGI_REGEX_DOCTYPE = My.Database.GetDatatable("SELECT DISTINCT T1.DOCTYPE as DocType, T.* FROM TBGI_REGEX_DOCTYPE T, VWGI_DOCTYPE T1 WHERE T.DOCTYPE_ID = T1.DOCTYPE_ID") - MULTIFILES = My.Database.GetScalarValue("SELECT COUNT(*) FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & My.Application.Globix.CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") - My.Application.Globix.MULTIINDEXING_ACTIVE = False - If MULTIFILES > 0 Then - If My.Application.User.Language = "de-DE" Then - RibbonPageGroupMultiIndex.Text = "Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren" - Else - RibbonPageGroupMultiIndex.Text = "All following files (" & MULTIFILES & ") will be indexed identically" - End If - - chkMultiindexing.Checked = False - chkMultiindexing.Visibility = DevExpress.XtraBars.BarItemVisibility.Always - - Else - - chkMultiindexing.Visibility = DevExpress.XtraBars.BarItemVisibility.Never - - End If - End If - - - Catch ex As Exception - _Logger.Warn(" - Unexpected error in Öffnen des Formulares - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Öffnen des Formulares:") - End Try - End Sub - Private Sub SetFilePreview(ShowPreview As Boolean) - If ShowPreview Then - SplitContainerControl1.Collapsed = False - PreviewFile() - PreviewItem.Checked = True - Else - SplitContainerControl1.Collapsed = True - PreviewItem.Checked = False - End If - End Sub - Sub PreviewFile() - Try - DocumentViewer1.LoadFile(My.Application.Globix.CURRENT_WORKFILE) - Catch ex As Exception - _Logger.Error(ex) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in PreviewFile:") - End Try - End Sub - - Private Sub BarCheckItem5_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles PreviewItem.CheckedChanged - SetFilePreview(PreviewItem.Checked) - My.UIConfig.Globix.FilePreview = PreviewItem.Checked - My.SystemConfigManager.Save() - End Sub - - Private Sub SourceDeleteItem_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles SourceDeleteItem.CheckedChanged - If SourceDeleteItem.Visibility <> DevExpress.XtraBars.BarItemVisibility.Never Then - My.Application.Globix.CURR_DELETE_ORIGIN = SourceDeleteItem.Checked - My.UIConfig.Globix.DeleteOriginalFile = SourceDeleteItem.Checked - My.SystemConfigManager.Save() - End If - End Sub - - Private Sub SaveProfileItem_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemPreselection.CheckedChanged - My.UIConfig.Globix.ProfilePreselection = checkItemPreselection.Checked - My.SystemConfigManager.Save() - End Sub - - Private Sub SkipItem_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles SkipItem.ItemClick - My.Database.ExecuteNonQuery($"DELETE FROM TBGI_FILES_USER WHERE GUID = {My.Application.Globix.CURRENT_WORKFILE_GUID}") - CancelAttempts = 2 - Close() - End Sub - - Private Sub BarCheckItem3_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkMultiindexing.CheckedChanged - If chkMultiindexing.Checked Then - chkMultiindexing.Caption = "Active" - Else - chkMultiindexing.Caption = "Inactive" - End If - End Sub - - Private Sub frmGlobix_Index_Shown(sender As Object, e As EventArgs) Handles Me.Shown - Try - Focus() - Cursor = Cursors.Default - Refresh_Dokart() - pnlIndex.Controls.Clear() - - checkItemTopMost.Checked = My.UIConfig.Globix.TopMost - Me.TopMost = My.UIConfig.Globix.TopMost - BringToFront() - Catch ex As Exception - _Logger.Warn("Unexpected error frmGlobix_Index_Shown Part 1: " & vbNewLine & ex.Message) - End Try - - - FormLoaded = True - - Try - ' Letzte Auswahl merken überschreibt die automatische selektion - If My.UIConfig.Globix.ProfilePreselection Then - checkItemPreselection.Checked = True - - If My.Application.Globix.CURRENT_LASTDOCTYPE <> "" Then - cmbDoctype.SelectedIndex = cmbDoctype.FindStringExact(My.Application.Globix.CURRENT_LASTDOCTYPE) - End If - Else - If My.Application.Globix.DTTBGI_REGEX_DOCTYPE.Rows.Count > 0 Then - For Each oRoW As DataRow In My.Application.Globix.DTTBGI_REGEX_DOCTYPE.Rows - Dim oOnlyFilename = Path.GetFileName(My.Application.Globix.CURRENT_WORKFILE) - If Regex.IsMatch(oOnlyFilename, oRoW.Item("Regex")) Then - - _Logger.Debug("There is a match on REGEX_DOCTYPE: [{0}]", oRoW.Item("DOCTYPE")) - _Logger.Debug("Regex: [{0}], FileName: [{1}]", oRoW.Item("Regex"), oOnlyFilename) - cmbDoctype.SelectedIndex = cmbDoctype.FindStringExact(oRoW.Item("DOCTYPE")) - Exit For - End If - Next - End If - End If - Catch ex As Exception - _Logger.Warn("Unexpected error frmGlobix_Index_Shown Part 2 - ErrorMessage: " & vbNewLine & ex.Message) - End Try - End Sub - - Private Sub checkItemTopMost_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemTopMost.CheckedChanged - If FormLoaded = True Then - TopMost = checkItemTopMost.Checked - My.UIConfig.Globix.TopMost = checkItemTopMost.Checked - My.SystemConfigManager.Save() - End If - End Sub - - Private Sub cmbDoctype_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbDoctype.SelectedIndexChanged - If cmbDoctype.SelectedIndex <> -1 And FormLoaded = True Then - If cmbDoctype.SelectedValue.GetType.ToString = "System.Int32" Then - My.Application.Globix.CURRENT_DOCTYPE_ID = cmbDoctype.SelectedValue - - 'lblhinweis.Visible = False - ClearNotice() - - 'lblerror.Visible = False - ClearError() - - - Me.pnlIndex.Controls.Clear() - Dim oSql As String = "Select WINDREAM_DIRECT, DUPLICATE_HANDLING from TBDD_DOKUMENTART WHERE GUID = " & cmbDoctype.SelectedValue - Dim oDT As DataTable = My.Database.GetDatatable(oSql) - - My.Application.Globix.ECMDirect = oDT.Rows(0).Item("WINDREAM_DIRECT") - My.Application.Globix.CURRENT_DOCTYPE_DuplicateHandling = oDT.Rows(0).Item("DUPLICATE_HANDLING") - Refresh_IndexeMan(cmbDoctype.SelectedValue) - End If - - End If - End Sub - Private Sub Refresh_IndexeMan(dokartid As Integer) - Dim oSql - Try - oSql = "select T1.BEZEICHNUNG AS DOKUMENTART,T.* from TBDD_INDEX_MAN T, TBDD_DOKUMENTART T1 where T.ACTIVE = 1 AND T.DOK_ID = T1.GUID AND T.DOK_ID = " & dokartid & " ORDER BY T.SEQUENCE" - DT_INDEXEMAN = My.Database.GetDatatable(oSql) - pnlIndex.Visible = True - LoadIndexe_Man() - Catch ex As System.Exception - _Logger.Error(ex) - _Logger.Warn("Fehler Refresh_IndexeMan: DOKART-ID: " & dokartid & " - Fehler: " & vbNewLine & ex.Message & vbNewLine & oSql) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Refresh_IndexeMan:") - End Try - End Sub - Private Sub LoadIndexe_Man() - Try - Dim oControlCount As Integer = 1 - Dim oLabelPosition As Integer = 11 - Dim oControlPosition As Integer = 33 - Dim oControls As New GlobixControls(_LogConfig, pnlIndex, Me) - - If DT_INDEXEMAN.Rows.Count = 0 Then - ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDoctype.Text & " definiert") - _Logger.Info(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDoctype.Text & " definiert") - End If - - For Each oRow As DataRow In DT_INDEXEMAN.Rows - Dim oDataType = oRow.Item("DATATYPE") - Dim MultiSelect As Boolean = oRow.Item("MULTISELECT") - Dim AddNewItems As Boolean = oRow.Item("VKT_ADD_ITEM") - Dim PreventDuplicates As Boolean = oRow.Item("VKT_PREVENT_MULTIPLE_VALUES") - Dim oControlName As String = oRow.Item("NAME") - Dim oConnectionId = NotNull(oRow.Item("CONNECTION_ID"), 0) - Dim oSQLSuggestion = oRow.Item("SUGGESTION") - - If oDataType <> "BOOLEAN" Then - addLabel(oControlName, oRow.Item("COMMENT").ToString, oLabelPosition, oControlCount) - End If - - 'Dim DefaultValue = Check_HistoryValues(oControlName, oRow.Item("DOKUMENTART")) - 'If DefaultValue Is Nothing Then - ' DefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) - 'End If - Dim DefaultValue = "" - DefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) - Select Case oDataType - Case "BOOLEAN" - Dim chk As CheckBox = oControls.AddCheckBox(oControlName, oControlPosition, DefaultValue, oRow.Item("COMMENT").ToString) - If Not IsNothing(chk) Then - pnlIndex.Controls.Add(chk) - End If - Case "INTEGER" - If (oSQLSuggestion = True And oRow.Item("SQL_RESULT").ToString.Length > 0) Or MultiSelect = True Then - Dim oControl = oControls.AddVorschlag_ComboBox(oControlName, oControlPosition, oConnectionId, oRow.Item("SQL_RESULT"), MultiSelect, oDataType, DefaultValue, AddNewItems, PreventDuplicates, oSQLSuggestion) - If Not IsNothing(oControl) Then - pnlIndex.Controls.Add(oControl) - End If - Else - 'nur eine Textbox - Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, DefaultValue, oDataType) - If Not IsNothing(oControl) Then - pnlIndex.Controls.Add(oControl) - End If - End If - Case "VARCHAR" - If (oSQLSuggestion = True And oRow.Item("SQL_RESULT").ToString.Length > 0) Or MultiSelect = True Then - Dim oControl = oControls.AddVorschlag_ComboBox(oControlName, oControlPosition, oConnectionId, oRow.Item("SQL_RESULT"), MultiSelect, oDataType, DefaultValue, AddNewItems, PreventDuplicates, oSQLSuggestion) - If Not IsNothing(oControl) Then - pnlIndex.Controls.Add(oControl) - End If - Else - If oControlName.ToString.ToLower = "dateiname" Then - Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, System.IO.Path.GetFileNameWithoutExtension(My.Application.Globix.CURRENT_WORKFILE), oDataType) - If Not IsNothing(oControl) Then - pnlIndex.Controls.Add(oControl) - End If - Else - Dim VORBELGUNG As String = DefaultValue - Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, VORBELGUNG, oDataType) - If Not IsNothing(oControl) Then - pnlIndex.Controls.Add(oControl) - End If - End If - End If - Case "DATE" - Dim oPicker = oControls.AddDateTimePicker(oControlName, oControlPosition, oDataType, DefaultValue) - pnlIndex.Controls.Add(oPicker) - - Case Else - If My.Application.User.Language = "de-DE" Then - MsgBox("Bitte überprüfen Sie den Datentyp des hinterlegten Indexwertes!", MsgBoxStyle.Critical, "Achtung:") - Else - MsgBox("Please check Datatype of Indexvalue!", MsgBoxStyle.Critical, "Warning:") - End If - - _Logger.Warn(" - Datentyp nicht hinterlegt - LoadIndexe_Man") - End Select - - oControlCount += 1 - oLabelPosition += 50 - oControlPosition += 50 - 'make y as height in fom - Next - Dim oPanelHeight = oControlPosition - 30 - - If pnlIndex.Height < oPanelHeight Then - If (Me.Height - 315) < oPanelHeight Then - Me.Height = (Me.Height - 315) + oPanelHeight - End If - pnlIndex.Height = oPanelHeight - End If - - SendKeys.Send("{TAB}") - Catch ex As Exception - _Logger.Error(ex) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in LoadIndexe_Man:") - End Try - End Sub - Function GetPlaceholderValue(InputValue As String, FileName As String, UserShortName As String) As String - Dim oResult As String - - Try - Select Case InputValue.ToString.ToUpper - Case "$filename_ext".ToUpper - oResult = Path.GetFileName(FileName) - Case "$filename".ToUpper - oResult = Path.GetFileNameWithoutExtension(FileName) - Case "$extension".ToUpper - oResult = Path.GetExtension(FileName).Replace(".", "") - Case "$FileCreateDate".ToUpper - Dim oFileInfo As New FileInfo(FileName) - Dim oCreationDate As Date = oFileInfo.CreationTime - oResult = oCreationDate.ToShortDateString - Case "$FileCreatedWho".ToUpper - Dim oFileSecurity As FileSecurity = File.GetAccessControl(FileName) - Dim oSecurityId As IdentityReference = oFileSecurity.GetOwner(GetType(SecurityIdentifier)) - Dim oNTAccount As IdentityReference = oSecurityId.Translate(GetType(NTAccount)) - Dim oOwner As String = oNTAccount.ToString() - oResult = oOwner - Case "$DateDDMMYYY".ToUpper - oResult = System.DateTime.Now.ToShortDateString - Case "$Username".ToUpper - oResult = Environment.UserName - Case "$Usercode".ToUpper - oResult = UserShortName - Case Else - oResult = InputValue - End Select - Catch ex As Exception - _Logger.Warn("Error in ReplacePlaceholders: " & ex.Message) - _Logger.Error(ex.Message) - oResult = Nothing - End Try - - Return oResult - End Function - - Private Sub frmGlobix_Index_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing - If File.Exists(My.Application.Globix.CURRENT_FILENAME) Then - Select Case CancelAttempts - Case 0 - If My.Application.User.Language = "de-DE" Then - MsgBox("Bitte indexieren Sie die Datei vollständig!" & vbNewLine & "(Abbruch 1 des Indexierungsvorgangs)", MsgBoxStyle.Information) - Else - MsgBox("Please Index file completely" & vbNewLine & "(Abort 1 of Indexdialog)", MsgBoxStyle.Information) - End If - CancelAttempts = CancelAttempts + 1 - e.Cancel = True - Case 1 - Dim result As MsgBoxResult - If My.Application.User.Language = "de-DE" Then - result = MessageBox.Show("Sie brechen nun zum zweiten Mal den Indexierungsvorgang ab!" & vbNewLine & "Wollen Sie die Indexierung aller Dateien abbrechen?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) - Else - result = MessageBox.Show("You abort the indexdialog for the 2nd time!" & vbNewLine & "Do You want to abort indexing?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) - End If - - If result = MsgBoxResult.Yes Then - Dim containsfw_file As Boolean = False - Try - My.Application.Globix.ABORT_INDEXING = True - Dim sql As String = "SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')" - Dim DT As DataTable = My.Database.GetDatatable(sql) - - Dim anz = DT.Rows.Count - For Each Filerow As DataRow In DT.Rows - Dim filestring As String = Filerow.Item("FILENAME2WORK") - Dim handletype As String = Filerow.Item("HANDLE_TYPE") - - If handletype = "|MSGONLY|" Or handletype = "|ATTMNTEXTRACTED|" Then - Try - System.IO.File.Delete(filestring) - Catch ex As Exception - - End Try - - ElseIf handletype.StartsWith("|FW") Then - containsfw_file = True - End If - Next - 'Zuerst die Daten des Ablaufs löschen - If My.Database.ExecuteNonQuery("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") = True Then - If containsfw_file = True Then - If My.Application.User.Language = "de-DE" Then - MsgBox("Der Indexierungsprozess beinhaltete (auch) Dateien per Folderwatch!" & vbNewLine & "Diese Dateien wurden nicht gelöscht und verbleiben im Folderwatch-Verzeichnis!" & vbNewLine & "Bitte verschieben Sie die Dateien ggfls.", MsgBoxStyle.Information, "Achtung - Hinweis:") - Else - MsgBox("The Indexingprocess contained (also) files from folderwatch!" & vbNewLine & "These files weren't deleted and will stay in the folderwatch-folder!" & vbNewLine & "Please move these files manually.", MsgBoxStyle.Information, "Achtung - Hinweis:") - End If - - End If - End If - - - Catch ex As Exception - _Logger.Error(ex) - MsgBox("Unexpected Error in Abort Indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) - End Try - - Try - My.Application.Globix.INDEXING_ACTIVE = False - - DocumentViewer1.CloseDocument() - DocumentViewer1.Done() - clswindowLocation.SaveFormLocationSize(Me) - My.Settings.Save() - Catch ex As Exception - _Logger.Info(" - Unexpected error in Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Schliessen des Formulares:") - End Try - - e.Cancel = False - Else - e.Cancel = True - End If - Case Else - Try - My.Application.Globix.INDEXING_ACTIVE = False - - DocumentViewer1.CloseDocument() - DocumentViewer1.Done() - clswindowLocation.SaveFormLocationSize(Me) - My.Settings.Save() - Catch ex As Exception - _Logger.Warn(" - Unexpected error in Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Schliessen des Formulares:") - End Try - End Select - Else - My.Application.Globix.INDEXING_ACTIVE = False - End If - End Sub - - Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick - Pre_Work_File - End Sub - Private Sub Pre_Work_File() - ClearError() - ClearNotice() - - Me.Cursor = Cursors.WaitCursor - Refresh_RegexTable() - For Each rowregex As DataRow In My.Application.BASE_DATA_DT_REGEX.Rows - If rowregex.Item("FUNCTION_NAME").ToString = "CLEAN_FILENAME" Then - My.Application.Globix.REGEX_CLEAN_FILENAME = rowregex.Item("REGEX").ToString - End If - Next - If chkMultiindexing.Checked = True And chkMultiindexing.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Then - 'Die erste Datei indexieren - If Work_File() = True Then - 'Und nun die folgenden - Dim DTFiles2Work As DataTable = My.Database.GetDatatable("SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & My.Application.Globix.CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") - If Not DTFiles2Work Is Nothing Then - Dim err = False - For Each filerow As DataRow In DTFiles2Work.Rows - My.Application.Globix.CURRENT_WORKFILE_GUID = filerow.Item("GUID") - My.Application.Globix.CURRENT_WORKFILE = filerow.Item("FILENAME2WORK") - DropType = filerow.Item("HANDLE_TYPE") - - If Work_File() = False Then - err = True - Exit For - End If - Next - Me.Cursor = Cursors.Default - If err = False Then - If My.Application.User.Language = "de-DE" Then - MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich verarbeitet!", MsgBoxStyle.Information, "Erfolgsmeldung:") - Else - MsgBox("All files were successfully processed through Multiindexing", MsgBoxStyle.Information, "Success") - End If - - 'DTACTUAL_FILES.Clear() - - DocumentViewer1.CloseDocument() - DocumentViewer1.Done() - - CancelAttempts = 2 - Me.Close() - End If - End If - End If - Else - If Work_File() = True Then - Me.Cursor = Cursors.Default - If My.Application.Globix.ShowIndexResult = True Then - If My.Application.User.Language = "de-DE" Then - MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & My.Application.Globix.CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung") - Else - MsgBox("File sucessfully processed!" & vbNewLine & "Path:" & vbNewLine & My.Application.Globix.CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Success") - End If - End If - - DocumentViewer1.CloseDocument() - DocumentViewer1.Done() - - CancelAttempts = 2 - Me.Close() - End If - End If - Me.Cursor = Cursors.Default - End Sub - Private Function WORK_FILE() - Try - - Dim oSQL = $"SELECT * FROM VWDDINDEX_MAN WHERE DOK_ID = {Me.cmbDoctype.SelectedValue}" - My.Application.Globix.CURR_MAN_INDEXE = My.Database.GetDatatable(oSQL) - oSQL = $"SELECT * FROM VWDDINDEX_MAN WHERE VWDDINDEX_AUTOM WHERE DOCTYPE_ID = {Me.cmbDoctype.SelectedValue}" - My.Application.Globix.CURR_AUTO_INDEXE = My.Database.GetDatatable(oSQL) - - _Logger.Debug("Manuelle Indexe geladen") - - If My.Application.Globix.CURR_MAN_INDEXE.Rows.Count > 0 Then - My.Application.Globix.CURRENT_DOCTYPE_ID = Me.cmbDoctype.SelectedValue - If CheckWrite_IndexeMan(Me.cmbDoctype.SelectedValue) = True Then - '##### Manuelle Indexe indexiert ##### - _Logger.Info("Datei [" & My.Application.Globix.CURRENT_WORKFILE & "] wird nun indexiert...") - If FillIndexe_Autom(Me.cmbDoctype.SelectedValue) = True Then - _Logger.Debug(" ...FillIndexe_Autom durchlaufen") - - 'Den Zielnamen zusammenbauen - If Name_Generieren() = True Then - 'Dokumentenviewer ausblenden um keinen Zugriffsfehler zu produzieren - DocumentViewer1.Done() - DocumentViewer1.CloseDocument() - - _Logger.Debug(" ...Viewer geschlossen") - 'Die Datei verschieben - If Move_File2_Target() = True Then - _Logger.Debug(" ...Move_File2_Target durchlaufen") - My.Application.Globix.CURRENT_LASTDOCTYPE = cmbDoctype.Text - _Logger.Info("Datei '" & My.Application.Globix.CURRENT_NEWFILENAME & "' erfolgreich erzeugt.") - Dim oDEL As String = "DELETE FROM TBGI_FILES_USER WHERE GUID = " & My.Application.Globix.CURRENT_WORKFILE_GUID - My.Database.ExecuteNonQuery(oDEL) - Return True - End If - - Else - If My.Application.User.Language = "de-DE" Then - MsgBox("Unerwarteter Fehler in Name_Generieren - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical) - Else - MsgBox("Unexpected error in Name_Generieren - Please check the Logfile", MsgBoxStyle.Critical) - End If - Return False - End If - Else - If My.Application.User.Language = "de-DE" Then - MsgBox("Unerwarteter Fehler in FillIndexe_Autom - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical) - Else - MsgBox("Unexpected error in FillIndexe_Autom - Please check the Logfile", MsgBoxStyle.Critical) - End If - Return False - End If - '#### Automatische Werte indexieren #### - End If - Else - If My.Application.User.Language = "de-DE" Then - MsgBox("Bitte überprüfen Sie die Konfiguration dieser Dokumentart." & vbNewLine & "Es sind KEINE manuellen Indizes konfiguriert oder aktiv geschaltet!", MsgBoxStyle.Exclamation) - Else - MsgBox("Please check the configuration for this document-type." & vbNewLine & "There are NO manual indicies that are either configured or set to active!", MsgBoxStyle.Exclamation) - End If - Return False - End If - Catch ex As Exception - _Logger.Error(ex) - MsgBox("Unexpected Error in WORK_FILE:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) - Return False - End Try - End Function - Private Function Move_File2_Target() - Dim oError As Boolean - Try - Dim oSQL As String = "SELECT FOLDER_FOR_INDEX FROM TBDD_DOKUMENTART WHERE GUID = " & My.Application.Globix.CURRENT_DOCTYPE_ID - Dim oFolderForIndex = My.Database.GetScalarValue(oSQL) - If Not IsDBNull(oFolderForIndex) Then - CreateFolderForIndex(oFolderForIndex) - Else - CreateFolderForIndex(String.Empty) - End If - - - Dim oExportSuccessful As Boolean = False - 'Variable Folder - If DropType = "|DROPFROMFSYSTEM|" Or DropType = "|OUTLOOK_ATTACHMENT|" Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|FW_SIMPLEINDEXER|" Then - oExportSuccessful = SINGLEFILE_2_IDB(My.Application.Globix.CURRENT_BusinessEntity) - ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or DropType = "|FW_OUTLOOK_MESSAGE|" Then - oExportSuccessful = SINGLEFILE_2_IDB(My.Application.Globix.CURRENT_BusinessEntity) - End If - If oExportSuccessful = True Then - 'Kein Fehler in Export2windream - oError = False - If Write_Indizes() = True Then - 'Kein Fehler in Setzen der windream-Indizes - Dim Insert_String As String - Try - Dim tempCur_WF = My.Application.Globix.CURRENT_WORKFILE.Replace("'", "''") - Dim tempCur_New_FN = My.Application.Globix.CURRENT_NEWFILENAME.Replace("'", "''") - Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO) VALUES ('" & tempCur_WF & "','" & tempCur_New_FN & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "')" - My.Database.ExecuteNonQuery(Insert_String) - If DropType.Contains("MSG") Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then - If My.Application.Globix.CURRENT_MESSAGEID <> "" Then - Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY" - Dim GUID = My.Database.ExecuteNonQuery(max) - Try - If GUID > 0 Then - Dim sqlUpdate As String - If DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then - sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 1, MSG_ID = '" & My.Application.Globix.CURRENT_MESSAGEID & "' WHERE GUID = " & GUID - My.Database.ExecuteNonQuery(sqlUpdate) - Else - sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & My.Application.Globix.CURRENT_MESSAGEID & "' WHERE GUID = " & GUID - My.Database.ExecuteNonQuery(sqlUpdate) - End If - End If - Catch ex As Exception - _Logger.Error(ex) - End Try - End If - End If - - Catch ex As Exception - _Logger.Error(ex) - MsgBox("Error in Insert-History - View logfile: " & ex.Message, MsgBoxStyle.Critical) - _Logger.Warn(" - Unexpected error in Insert-History - Fehler: " & vbNewLine & ex.Message) - _Logger.Warn(" - Unexpected error in Insert-History - SQL: " & Insert_String) - oError = True - End Try - Else - oError = True - End If - Else - oError = True - - If My.Application.User.Language = "de-DE" Then - MsgBox("Der Export nach windream war nicht erfolgreich - Check LogFile", MsgBoxStyle.Exclamation) - Else - MsgBox("Export to windream was unsucessful - Check LogFile", MsgBoxStyle.Exclamation) - End If - End If - - If oError = False Then - Return True - Else - 'Fehler aufgetreten - Return False - End If - Catch ex As Exception - _Logger.Error(ex) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected Error in Move File2Target:") - Return False - End Try - End Function - Private Function Write_Indizes() - Try - Dim indexierung_erfolgreich As Boolean = False - 'Manuelle Indexe Indexieren - - If My.Application.Globix.CURR_MAN_INDEXE.Rows.Count > 0 Then - Dim Count As Integer = 0 - For Each row As DataRow In DTMan.Rows - Dim idxvalue = row.Item("Indexwert") - Dim indexname = row.Item("WD_INDEX").ToString - _Logger.Debug($"Write_Indizes - Index [{indexname}]...") - Dim optional_Index = CBool(row.Item("OPTIONAL")) - Dim indexiert = CBool(row.Item("Indexiert")) - If indexiert And idxvalue.ToString <> "" And idxvalue <> "EMPTY_OI" Then - If indexname <> String.Empty Then - If row.Item("SAVE_VALUE") = True Then - 'Den Indexwert zwischenspeichern - Dim DTTemp As DataTable = MyDataset.TBTEMP_INDEXRESULTS - Dim rowexists As Boolean = False - For Each rowTemp As DataRow In DTTemp.Rows - 'Wenn bereits ein Eintrag existiert..... - If rowTemp.Item("Dokumentart") = row.Item("DOKUMENTART") And rowTemp.Item("Indexname") = row.Item("INDEXNAME") Then - rowexists = True - '......überschreiben - rowTemp.Item("Value") = row.Item("Indexwert") - End If - Next - '.....ansonsten neu anlegen - If rowexists = False Then - Dim newRow As DataRow = DTTemp.NewRow() - newRow("Dokumentart") = row.Item("DOKUMENTART").ToString - newRow("Indexname") = row.Item("INDEXNAME").ToString - newRow("Value") = row.Item("Indexwert") - DTTemp.Rows.Add(newRow) - End If - End If - - _Logger.Debug($"Manueller Indexvalue [{idxvalue.ToString}]...NOW THE INDEXING...") - Count += 1 - - - ' den Typ des Zielindexes auslesen - Dim oIndexType As Integer = WINDREAM.GetIndexType(indexname) - _Logger.Debug($"oIndexType [{oIndexType.ToString}]...") - If oIndexType < WINDREAM.WMObjectVariableValueTypeVector Then - _Logger.Debug($"Indexing oIndexType < WINDREAM.WMObjectVariableValueTypeVector...") - indexierung_erfolgreich = WINDREAM.SetFileIndex(My.Application.Globix.CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE) - Else - Dim oSplitArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR) - Dim oListofString As New List(Of String) - If oSplitArray.Count = 0 Then - oListofString.Add(idxvalue) - Else - For Each oStr In oSplitArray - oListofString.Add(oStr) - Next - End If - - - indexierung_erfolgreich = WINDREAM.SetFileIndex(My.Application.Globix.CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE) - End If - - 'indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue) - If indexierung_erfolgreich = False Then - MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical) - Return False - Exit For - End If - Else - - _Logger.Debug("No Indexing: indexname: " & indexname) - _Logger.Debug("No Indexing: is optional? " & optional_Index.ToString) - End If - Else - _Logger.Debug("Indexvalue is empty or field is not indexed - Indexname: " & indexname) - _Logger.Info("Indexvalue is empty or field is not indexed - Indexname: " & indexname) - End If - Next - - End If - 'Automatische Indexe Indexieren - - If My.Application.Globix.CURR_AUTO_INDEXE.Rows.Count > 0 Then - Dim Count As Integer = 0 - For Each row As DataRow In My.Application.Globix.CURR_AUTO_INDEXE.Rows - Dim indexiert = CBool(row.Item("Indexiert")) - Dim Indexvalue = row.Item("Indexwert").ToString - Dim indexname = row.Item("INDEXNAME").ToString - If indexiert = True And Indexvalue <> "" Then - If Indexvalue <> "EMPTY_OI" Then - _Logger.Info("Auto Indexname: " & indexname.ToString) - _Logger.Info("Indexvalue: " & Indexvalue.ToString) - Count += 1 - - ' den Typ des Zielindexes auslesen - Dim indexType As Integer = WINDREAM.GetIndexType(indexname) - - If indexType < WINDREAM.WMObjectVariableValueTypeVector Then - indexierung_erfolgreich = WINDREAM.SetFileIndex(My.Application.Globix.CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE) - Else - Dim oSplitArray = Split(Indexvalue, ClassConstants.VECTORSEPARATOR) - Dim oListofString As New List(Of String) - If oSplitArray.Count = 0 Then - oListofString.Add(Indexvalue) - Else - For Each oStr In oSplitArray - oListofString.Add(oStr) - Next - End If - indexierung_erfolgreich = WINDREAM.SetFileIndex(My.Application.Globix.CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE) - End If - - 'indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE) - If indexierung_erfolgreich = False Then - MsgBox("Error in indexing file - See log", MsgBoxStyle.Critical) - Return False - Exit For - End If - End If - End If - Next - End If - If DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or My.Application.Globix.CURRENT_NEWFILENAME.EndsWith(".msg") Then - indexierung_erfolgreich = SetEmailIndices() - If indexierung_erfolgreich = False Then - MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical) - Return False - End If - ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then - indexierung_erfolgreich = SetAttachmentIndices() - If indexierung_erfolgreich = False Then - MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical) - Return False - End If - End If - Catch ex As Exception - _Logger.Warn("Unexpected error in Write_Indizes - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox("Error in Write_Indizes:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) - Return False - End Try - Return True - End Function - Private Function SINGLEFILE_2_IDB(pBusinessEntity As String) As Boolean - Try - 'CURR_DOKART_OBJECTTYPE = _Objekttyp - 'Dim oWMCheckPath = WINDREAM.VersionWMFilename(My.Application.Globix.CURRENT_NEWFILENAME, System.IO.Path.GetExtension(My.Application.Globix.CURRENT_NEWFILENAME)) - 'If CURRENT_NEWFILENAME.ToUpper <> oWMCheckPath.ToString.ToUpper Then - ' _Logger.Info($"Target [{My.Application.Globix.CURRENT_NEWFILENAME}] already existed!! - NewWMFilename [{oWMCheckPath}]") - ' My.Application.Globix.CURRENT_NEWFILENAME = oWMCheckPath - 'End If - - 'Dim oStreamSuccessful = WINDREAM.NewFileStream(My.Application.Globix.CURRENT_WORKFILE, My.Application.Globix.CURRENT_NEWFILENAME) - 'Dim oTempPath As String = Path.Combine("\\windream\objects", My.Application.Globix.CURRENT_NEWFILENAME) - - '_Logger.Debug("Checks for file [{0}]", oTempPath) - '_Logger.Debug("File streamed to Windream: {0}", oStreamSuccessful) - '_Logger.Debug("File exists in Destination: {0}", File.Exists(oTempPath)) - '_Logger.Debug("File should be deleted: {0}", My.Application.Globix.CURR_DELETE_ORIGIN) - - 'If File.Exists(oTempPath) And oStreamSuccessful Then - ' If My.Application.Globix.CURR_DELETE_ORIGIN = True Then - ' Try - ' My.Computer.FileSystem.DeleteFile(My.Application.Globix.CURRENT_WORKFILE) - ' Catch ex As Exception - ' _Logger.Error(ex) - ' End Try - ' End If - 'End If - - 'Return oStreamSuccessful - Catch ex As Exception - _Logger.Error(ex) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in SINGLEFILE_2_WINDREAM:") - Return False - End Try - End Function - Private Function CreateFolderForIndex(DynamicFolderConfig As String) - Try - Dim oRootFolder As String = Path.GetDirectoryName(My.Application.Globix.CURRENT_NEWFILENAME) - Dim oFilesystem As New DigitalData.Modules.Filesystem.File(_LogConfig) - - - If DynamicFolderConfig <> String.Empty Then - '###### - Dim oRegexString As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" - ' einen Regulären Ausdruck laden - Dim oRegex As Regex = New Regex(oRegexString) - ' die Vorkommen im Folder-String auslesen - Dim oMatches As MatchCollection = oRegex.Matches(DynamicFolderConfig) - '#### - - ' alle Vorkommen innerhalb des Ordnerstrings durchlaufen - For Each oMatch As Match In oMatches - _Logger.Info("Elementname in FolderString: '" & oMatch.ToString & "'") - Select Case oMatch.Value.Substring(2, 1).ToUpper - - 'Manueller Indexwert - Case "M" - Dim oManIndexName = oMatch.Value.Substring(3, oMatch.Value.Length - 4) - - 'Dim oIsOptional As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID & " AND UPPER(NAME) = UPPER('" & oManIndexName & "')", MyConnectionString, True) - Dim oIsOptional As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, $"DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND INDEXNAME = '{oManIndexName}'", "OPTIONAL")) - _Logger.Info("Versuch den Indexwert aus '" & oManIndexName & "' auszulesen.") - Dim oManIndexValue As String = GetManIndex_Value(oManIndexName, "FILE", oIsOptional) - _Logger.Info("Ergebnis/Wert für neuen Ordner: '" & oManIndexName & "'") - If Not oManIndexValue = String.Empty Then - If IsDate(oManIndexValue) Then - oManIndexValue = CDate(oManIndexValue).ToString("yyyyMMdd") - End If - - oManIndexValue = oFilesystem.GetCleanPath(oManIndexValue) - 'oManIndexValue = ClassFilehandle.CleanFilename(oManIndexValue, "") - DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oManIndexValue) - - _Logger.Info("FolderPattern: '" & DynamicFolderConfig & "'") - Else - - If oIsOptional = True Then - _Logger.Info("Optionaler Indexwert ist NICHT gefüllt") - DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, String.Empty) - Else - _Logger.Info(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!") - Return True - End If - End If - Case "A" - Dim oAutoIndexName = oMatch.Value.Substring(3, oMatch.Value.Length - 4) - _Logger.Info("Versuch den Auto-Indexwert aus '" & oAutoIndexName & "' auszulesen.") - Dim oAutoIndexValue As String = GetAutoIndex_Value(oAutoIndexName) - _Logger.Info("Ergebnis/Wert für neuen Ordner: '" & oAutoIndexName & "'") - If Not oAutoIndexValue = String.Empty Then - - oAutoIndexValue = oFilesystem.GetCleanPath(oAutoIndexValue) - 'oAutoIndexValue = ClassFilehandle.CleanFilename(oAutoIndexValue, "") - If oAutoIndexValue = "EMPTY_OI" Then - DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, "") - Else - DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oAutoIndexValue) - _Logger.Info("FolderPattern: '" & DynamicFolderConfig & "'") - End If - - Else - _Logger.Info(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!") - End If - Case "V" - Dim oElementTemp As String - Dim _Month As String = My.Computer.Clock.LocalTime.Month - If _Month.Length = 1 Then - _Month = "0" & _Month - End If - Dim _day As String = My.Computer.Clock.LocalTime.Day - If _day.Length = 1 Then - _day = "0" & _day - End If - Dim type = oMatch.Value.Substring(3, oMatch.Value.Length - 4) - If type.StartsWith("_") Then - type = type.Replace("_", "") - End If - Select Case type - Case "YYYY/MM/DD" - oElementTemp = My.Computer.Clock.LocalTime.Year & "\" & _Month & "\" & _day - Case "YYYY/MM" - oElementTemp = My.Computer.Clock.LocalTime.Year & "\" & _Month - Case "YYYY" - oElementTemp = My.Computer.Clock.LocalTime.Year - Case "YYYY-MM" - oElementTemp = My.Computer.Clock.LocalTime.Year & "-" & _Month - End Select - DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oElementTemp) - _Logger.Info("FolderPatter nach V-Element: '" & DynamicFolderConfig & "'") - Case Else - _Logger.Warn(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper) - - If My.Application.User.Language = "de-DE" Then - MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") - Else - MsgBox("Attention - One element in Namingconvention could not be matched!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") - End If - End Select - Next - End If - - - - - _Logger.Info("Den Root-Folder zusammenfügen>> ") - - Dim oNewFullPath As String = System.IO.Path.Combine(oRootFolder, DynamicFolderConfig) - - _Logger.Info("Fullpath (mit evtl. Sonderzeichen (SZ)) '" & oNewFullPath & "'") - Dim invalidPathChars() As Char = Path.GetInvalidPathChars() - For Each sonderChar As Char In invalidPathChars - 'Sonderzeichen ausser Whitespace entfernen - If Char.IsWhiteSpace(sonderChar) = False Then - If oNewFullPath.Contains(sonderChar) Then - oNewFullPath = oNewFullPath.Replace(sonderChar, "") - End If - End If - Next sonderChar - 'oNewFullPath = WINDREAM.GetCleanedPath(oNewFullPath) - - _Logger.Info("Fullpath (ohne SZ) '" & oNewFullPath & "'") - If Directory.Exists(oNewFullPath) = False Then - Try - Dim oCreatedPath = Directory.CreateDirectory(oNewFullPath) - oNewFullPath = oCreatedPath.FullName - _Logger.Info("Folder '" & oNewFullPath & "' wurde angelegt") - Catch ex As Exception - _Logger.Info("Error in CreateFolderforIndex-Method - Root Folder '" & oNewFullPath & "' could not be created. " & ex.Message) - _Logger.Error(ex.Message) - MsgBox("Attention: Root Folder '" & oNewFullPath & "' could not be created." & vbNewLine & ex.Message, MsgBoxStyle.Critical) - Return False - End Try - End If - - My.Application.Globix.CURRENT_NEWFILENAME = Path.Combine(oNewFullPath, Path.GetFileName(My.Application.Globix.CURRENT_NEWFILENAME)) - - Return True - Catch ex As Exception - MsgBox("Unexpected Error in CreateFolderforIndex-Method:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) - _Logger.Warn("Fehler in CrFolderForIndex: " & ex.Message) - _Logger.Error(ex) - Return False - End Try - End Function - Private Function Filter_Datatable(pDatatable As DataTable, pFilter As String, pColResult As String) As Object - Try - Dim oreturn As Object - Dim odv As DataView = New DataView(pDatatable) - odv.RowFilter = pFilter - Dim dr2 As DataRow() = pDatatable.Select(pFilter) - - For Each row As DataRow In dr2 - oreturn = row.Item(pColResult) - Exit For - Next - Return oreturn - Catch ex As Exception - Return Nothing - End Try - End Function - - Function CheckWrite_IndexeMan(dokartid As Integer) As Boolean - '#### Zuerst manuelle Werte indexieren #### - Try - _Logger.Info("In CheckWrite_IndexeMan") - Dim result As Boolean = False - For Each oControl As Control In Me.pnlIndex.Controls - ' MsgBox(ctrl.Name) - If oControl.Name.StartsWith("txt") Then - Dim box As DevExpress.XtraEditors.TextEdit = oControl - If box.Text = "" Then - Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '" & Replace(box.Name, "txt", ""), "OPTIONAL")) - 'ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(box.Name, "txt", "") & "'", MyConnectionString, True) - If optional_index = False Then - MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, "Fehlende Eingabe:") - box.Focus() - Return False - Else - Indexwert_Postprocessing(Replace(box.Name, "txt", ""), "") - result = True - End If - Else - If Indexwert_checkValueDB(Replace(box.Name, "txt", ""), box.Text) = False Then - _Logger.Info(" - Der eingegebene Wert wurde nicht in der Datenbank gefunden") - MsgBox("Der eingegebene Wert wurde nicht in der Datenbank gefunden!", MsgBoxStyle.Exclamation, "Fehlerhafte Indexierung:") - box.Focus() - Return False - Else - Indexwert_Postprocessing(Replace(box.Name, "txt", ""), box.Text) - result = True - End If - End If - End If - - If oControl.Name.StartsWith("cmbMulti") Then - Dim oLookup = DirectCast(oControl, DigitalData.Controls.LookupGrid.LookupControl2) - Dim values As List(Of String) = oLookup.SelectedValues - - If values.Count = 0 Then - 'Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(oLookup.Name, "cmbMulti", "") & "'", MyConnectionString, True) - Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '" & Replace(oLookup.Name, "cmbMulti", ""), "OPTIONAL")) - If optional_index = False Then - MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) - oLookup.Focus() - Return False - Else - Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), "") - result = True - End If - Else - Dim vectorValue = String.Join(VECTORSEPARATOR, values) - Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), vectorValue) - result = True - End If - ElseIf oControl.Name.StartsWith("cmbSingle") Then - Dim cmbSingle As TextBox = oControl - - If cmbSingle.Text = "" Then - 'Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(cmbSingle.Name, "cmbSingle", "") & "'", MyConnectionString, True) - Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '" & Replace(cmbSingle.Name, "cmbSingle", ""), "OPTIONAL")) - If optional_index = False Then - MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) - cmbSingle.Focus() - Return False - Else - Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), "") - result = True - End If - Else - Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), cmbSingle.Text) - result = True - End If - ElseIf oControl.Name.StartsWith("cmb") Then - Dim cmb As ComboBox = oControl - If cmb.Text = "" Then - 'Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(cmb.Name, "cmb", "") & "'", MyConnectionString, True) - Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '" & Replace(cmb.Name, "cmb", ""), "OPTIONAL")) - If optional_index = False Then - MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) - cmb.Focus() - Return False - Else - Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), "") - result = True - End If - Else - Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), cmb.Text) - result = True - End If - End If - If oControl.Name.StartsWith("dtp") Then - Dim dtp As DevExpress.XtraEditors.DateEdit = oControl - Dim oIndexName As String = Replace(dtp.Name, "dtp", "") - - If dtp.Text = String.Empty Then - 'Dim optional_index As Boolean = My.Database.Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {dokartid} And NAME = '{oIndexName}'", MyConnectionString, True) - Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '{oIndexName}'", "OPTIONAL")) - - If optional_index = False Then - MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) - dtp.Focus() - Return False - Else - Indexwert_Postprocessing(oIndexName, "") - result = True - End If - Else - Indexwert_Postprocessing(Replace(dtp.Name, "dtp", ""), dtp.Text) - result = True - End If - End If - If oControl.Name.StartsWith("chk") Then - Dim chk As CheckBox = oControl - Indexwert_Postprocessing(Replace(chk.Name, "chk", ""), chk.Checked) - result = True - End If - If TypeOf (oControl) Is Button Then - Continue For - End If - If oControl.Name.StartsWith("lbl") = False And result = False Then - _Logger.Info("Die Überprüfung der manuellen Indices ist fehlerhaft. Bitte informieren Sie den Systembetreuer") - Return False - End If - Next - - Return True - Catch ex As Exception - _Logger.Warn(" - Unvorhergesehener Fehler in CheckWrite_IndexeMan - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unerwarteter Unexpected error in CheckWrite_IndexeMan:") - Return False - End Try - End Function - Sub Indexwert_Postprocessing(indexname As String, wert_in As String) - Try - - Dim value_post As String = "" - For Each oRowManIndex As DataRow In My.Application.Globix.CURR_MAN_INDEXE.Rows - If oRowManIndex.Item("INDEXNAME") = indexname Then - Dim idxid As Integer = oRowManIndex.Item("GUID") - If idxid > 0 Then - ' In jedem Fall schon mal den Wert einfügen - oRowManIndex.Item("Indexwert") = wert_in - 'Die Nachbearbeitungsschritte laden - 'FILE AND INDEX - 'Zuerst nur die Fälle für die Variante ONLY FILE/FOLDER - Dim DTNB As DataTable = My.Database.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " AND VARIANT = 'ONLY FILE/FOLDER' ORDER BY SEQUENCE") - If DTNB Is Nothing = False Then - If DTNB.Rows.Count > 0 Then - value_post = clsPostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB) - oRowManIndex.Item("Indexwert") = wert_in - oRowManIndex.Item("Indexwert_File") = value_post - End If - End If - 'Jetzt die Fälle für die Variante FILE AND INDEX - DTNB = Nothing - DTNB = My.Database.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " AND VARIANT = 'FILE AND INDEX' ORDER BY SEQUENCE") - If DTNB Is Nothing = False Then - If DTNB.Rows.Count > 0 Then - value_post = clsPostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB) - oRowManIndex.Item("Indexwert") = value_post - End If - End If - End If - oRowManIndex.Item("Indexiert") = True - End If - Next - Catch ex As Exception - _Logger.Warn(" - Unvorhergesehener Unexpected error in Indexwert_Postprocessing - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Indexwert_Postprocessing:") - End Try - End Sub - Function Name_Generieren() - Try - _Logger.Debug("#### Name_Generieren ####") - Dim sql As String = "select VERSION_DELIMITER, FILE_DELIMITER FROM TBDD_MODULES WHERE GUID = 1" - Dim oFilesystem As New DigitalData.Modules.Filesystem.File(_LogConfig) - Dim DT1 As DataTable = My.Database.GetDatatable(sql) - For Each row As DataRow In DT1.Rows - My.Application.Globix.FILE_DELIMITER = row.Item("FILE_DELIMITER") - My.Application.Globix.VERSION_DELIMITER = row.Item("VERSION_DELIMITER") - Next - - Dim err As Boolean = False - Dim folder_Created As Boolean = False - Dim oRAWZielordner As String - Dim extension As String = System.IO.Path.GetExtension(My.Application.Globix.CURRENT_WORKFILE) - Dim DT As DataTable = My.Database.GetDatatable("SELECT * FROM TBDD_DOKUMENTART WHERE GUID = " & My.Application.Globix.CURRENT_DOCTYPE_ID) - sql_history_INSERT_INTO = "INSERT INTO TBGI_HISTORY (FILENAME_ORIGINAL,FILENAME_NEW" - sql_history_Index_Values = "" - Dim AnzahlIndexe As Integer = 1 - 'CURR_DOKART_OBJECTTYPE = DT.Rows(0).Item("OBJEKTTYP") - My.Application.Globix.CURRENT_WORKFILE_EXTENSION = extension - - 'oRAWZielordner = WINDREAM.GetNormalizedPath(DT.Rows(0).Item("ZIEL_PFAD")) - oRAWZielordner = Path.Combine("\\windream\objects", oRAWZielordner) - - '#### - ' Regulären Ausdruck zum Auslesen der Indexe definieren - Dim preg As String = "\[%{1}[a-zA-Z0-9ß\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" - 'schonmal den gesamten Pfad laden - Dim oNamenkonvention As String = DT.Rows(0).Item("NAMENKONVENTION") & My.Application.Globix.CURRENT_WORKFILE_EXTENSION 'oRAWZielordner & "\" & DT.Rows(0).Item("NAMENKONVENTION") - NewFileString = oNamenkonvention - ' einen Regulären Ausdruck laden - Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) - ' die Vorkommen im SQL-String auslesen - Dim oMatchelements As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(oNamenkonvention) - '#### - If oMatchelements.Count = 0 Then - _Logger.Debug("No RegularExpression Fileds on Nameconvention!") - End If - ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen - For Each oElement As System.Text.RegularExpressions.Match In oMatchelements - Select Case oElement.Value.Substring(2, 1).ToUpper - 'Manueller Indexwert - Case "M" - _Logger.Debug("NameGenerieren: Manueller Index wird geprüft...") - Dim Indexname = oElement.Value.Substring(3, oElement.Value.Length - 4) - Dim optional_index As Boolean = My.Database.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND UPPER(NAME) = UPPER('{Indexname}')") - Dim oManValue As String = GetManIndex_Value(Indexname, "FILE", optional_index) - If oManValue <> String.Empty Then - Dim firstVectorValue = oManValue.Split("~").First() - - oNamenkonvention = oNamenkonvention.Replace(oElement.Value, firstVectorValue) - NewFileString = oNamenkonvention - sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString - AnzahlIndexe += 1 - sql_history_Index_Values = sql_history_Index_Values & ", '" & oManValue.Replace("'", "''") & "'" - Else - - If optional_index = True Then - oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value & "-", "-") - oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value & "_", "_") - oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value & "-", "_") - oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value & "_", "-") - - oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value, "-") - oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value, "_") - oNamenkonvention = oNamenkonvention.Replace(oElement.Value & "-", "-") - oNamenkonvention = oNamenkonvention.Replace(oElement.Value & "_", "_") - - oNamenkonvention = oNamenkonvention.Replace(oElement.Value, oManValue) - - Dim oFilenameWithoutExtension = Path.GetFileNameWithoutExtension(oNamenkonvention) - Dim oExtension = Path.GetExtension(oNamenkonvention) - - If oFilenameWithoutExtension.EndsWith("-") Or oFilenameWithoutExtension.EndsWith("_") Then - oFilenameWithoutExtension = oFilenameWithoutExtension.Substring(0, oFilenameWithoutExtension.Count - 1) - End If - - NewFileString = oFilenameWithoutExtension & oExtension - sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString - AnzahlIndexe += 1 - sql_history_Index_Values = sql_history_Index_Values & ", '" & oManValue.Replace("'", "''") & "'" - Else - _Logger.Debug("Der Indexvalue für Index '" & Indexname & "' ist String.Empty") - err = True - End If - - End If - Case "A" - Dim value As String = GetAutoIndex_Value(oElement.Value.Substring(3, oElement.Value.Length - 4)) - If value <> String.Empty Then - If value = "EMPTY_OI" Then - oNamenkonvention = oNamenkonvention.Replace(oElement.Value, "") - NewFileString = oNamenkonvention - Else - oNamenkonvention = oNamenkonvention.Replace(oElement.Value, value) - NewFileString = oNamenkonvention - sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString - AnzahlIndexe += 1 - sql_history_Index_Values = sql_history_Index_Values & ", '" & value.Replace("'", "''") & "'" - End If - Else - err = True - End If - Case "V" - Dim datetemp As String - Dim _Month As String = My.Computer.Clock.LocalTime.Month - If _Month.Length = 1 Then - _Month = "0" & _Month - End If - Dim _day As String = My.Computer.Clock.LocalTime.Day - If _day.Length = 1 Then - _day = "0" & _day - End If - Dim type = oElement.Value '.ToUpper.Replace("[v%", "") - type = type.Replace("[%v_", "") - type = type.Replace("[%v", "") - type = type.Replace("]", "") - Select Case type - Case "YY_MM_DD" - datetemp = My.Computer.Clock.LocalTime.Year.ToString.Substring(2) & "_" & _Month & "_" & _day - Case "YYYY_MM_DD" - datetemp = My.Computer.Clock.LocalTime.Year & "_" & _Month & "_" & _day - Case "DD_MM_YY" - datetemp = _day & "_" & _Month & "_" & My.Computer.Clock.LocalTime.Year.ToString.Substring(2) - Case "DD_MM_YYYY" - datetemp = _day & "_" & _Month & "_" & My.Computer.Clock.LocalTime.Year - Case "YYMMDD" - datetemp = My.Computer.Clock.LocalTime.Year.ToString.Substring(2) & _Month & _day - Case "YYYYMMDD" - datetemp = My.Computer.Clock.LocalTime.Year & _Month & _day - Case "DDMMYY" - datetemp = _day & _Month & My.Computer.Clock.LocalTime.Year.ToString.Substring(2) - Case "DDMMYYYY" - datetemp = _day & _Month & My.Computer.Clock.LocalTime.Year - Case "OFilename" - oNamenkonvention = oNamenkonvention.Replace(oElement.Value, System.IO.Path.GetFileNameWithoutExtension(My.Application.Globix.CURRENT_WORKFILE)) - Case "Username".ToUpper - oNamenkonvention = oNamenkonvention.Replace(oElement.Value, Environment.UserName) - Case "Usercode".ToUpper - oNamenkonvention = oNamenkonvention.Replace(oElement.Value, My.Application.User.ShortName) - Case "" - End Select - If datetemp <> "" Then - oNamenkonvention = oNamenkonvention.Replace(oElement.Value, datetemp) - End If - NewFileString = oNamenkonvention - Case "[%Version]".ToUpper - Try - Dim version As Integer = 1 - Dim Stammname As String = oRAWZielordner & "\" & oNamenkonvention.Replace(oElement.Value, "") - Dim _neuername As String = oRAWZielordner & "\" & oNamenkonvention.Replace(oElement.Value, "") - Stammname = _neuername.Replace(My.Application.Globix.VERSION_DELIMITER, "") - _neuername = _neuername.Replace(My.Application.Globix.VERSION_DELIMITER, "") - 'Dim MoveFilename As String = DATEINAME.Replace(element.Value, "") - 'Überprüfen ob File existiert - If File.Exists(_neuername) = False Then - NewFileString = _neuername - Else - Do While File.Exists(_neuername) - version = version + 1 - _neuername = Stammname.Replace(extension, "") & My.Application.Globix.VERSION_DELIMITER & version & extension - NewFileString = _neuername - Loop - End If - Catch ex As Exception - _Logger.Warn(" - Unexpected error in NameGenerieren - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Umbenennnen der Datei:") - err = True - End Try - Case Else - _Logger.Info(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oElement.Value.ToUpper) - MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oElement.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") - End Select - Next - - My.Application.Globix.CURRENT_NEWFILENAME = oFilesystem.GetCleanFilename(NewFileString) - 'CURRENT_NEWFILENAME = ClassFilehandle.CleanFilename(NewFileString, "") - My.Application.Globix.CURRENT_NEWFILENAME = Path.Combine(oRAWZielordner, My.Application.Globix.CURRENT_NEWFILENAME) - - _Logger.Debug("#### ENDE Name_Generieren ####") - _Logger.Debug("") - If err = False Then - Return True - Else - Return False - End If - - Catch ex As Exception - _Logger.Warn(" - Unvorhergesehener Unexpected error in Name_Generieren - Fehler: " & vbNewLine & ex.Message) - _Logger.Error(ex.Message) - MsgBox(ex.Message, MsgBoxStyle.Critical, "Allgemeiner Unexpected error in Name_Generieren:") - Return False - End Try - - End Function - Function FillIndexe_Autom(dokart_id As Integer) As Boolean - Try - Dim oRegex As New Regex("\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}") - - If My.Application.Globix.CURR_AUTO_INDEXE.Rows.Count = 0 Then - Return True - End If - - ' 1. Schritt: Einfach-Indexe und Platzhalter ersetzen - For Each oAutoIndexRow As DataRow In My.Application.Globix.CURR_AUTO_INDEXE.Rows - _Logger.Info("Working on AutomaticIndex: " & oAutoIndexRow.Item("INDEXNAME").ToString & "...") - Dim oSqlResult As String = NotNull(oAutoIndexRow.Item("SQL_RESULT"), "") - Dim oSqlActive As Boolean = NotNull(oAutoIndexRow.Item("SQL_ACTIVE"), False) - Dim oSqlConnectionId As Integer = NotNull(oAutoIndexRow.Item("CONNECTION_ID"), -1) - Dim oSqlProvider As String = NotNull(oAutoIndexRow.Item("SQL_PROVIDER"), "") - Dim oEndResult As New List(Of String) - - ' Wenn kein SQL Befehl vorhanden oder aktiv ist, - ' versuchen wir, die Spalte VALUE zu ersetzen - If oSqlResult = String.Empty Or oSqlActive = 0 Then - Dim oPlaceholderResult As String - Dim oValue As String = NotNull(oAutoIndexRow.Item("VALUE"), "") - - oPlaceholderResult = GetPlaceholderValue(oValue, My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) - - If Not IsNothing(oPlaceholderResult) Then - oValue = oPlaceholderResult - End If - - oAutoIndexRow.Item("Indexiert") = True - oAutoIndexRow.Item("Indexwert") = oValue - - Continue For - End If - - ' Wenn ein SQL Befehl vorhanden und aktiv ist - ' Alle Platzhalter finden - Dim oMatches As MatchCollection = oRegex.Matches(oSqlResult) - - For Each oMatch As Match In oMatches - Dim oIndexValue As String = StripPlaceholder(oMatch.Value) - Dim oOptionalIndex = False - Dim oPlaceholderResult As String = Nothing - Dim oManualIndexResult As String = Nothing - - ' Einfachen Platzhalter Wert erzeugen - oPlaceholderResult = GetPlaceholderValue(oIndexValue, My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) - - ' Einfachen Platzhalter ersetzen - If Not IsNothing(oPlaceholderResult) Then - oSqlResult = oSqlResult.Replace(oMatch.Value, oPlaceholderResult) - End If - oOptionalIndex = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID & " AND INDEXNAME = '" & oIndexValue, "OPTIONAL")) - 'oOptionalIndex = ClassDatabase.Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')", MyConnectionString, True) - oManualIndexResult = GetManIndex_Value(oIndexValue, "IDX_AUTO", oOptionalIndex) - - ' Wenn Ergebnis den VektorPlatzhalter enthält, soll nichts ersetzt werden. - ' Werden im nächsten Schritt ersetzt. - If oManualIndexResult.Contains("~") Then - oManualIndexResult = Nothing - End If - - If Not IsNothing(oManualIndexResult) Then - oSqlResult = oSqlResult.Replace(oMatch.Value, oManualIndexResult) - End If - Next - - - 'TODO: Replace Windream Patterns? - oSqlResult = clsPatterns.ReplaceControlValues(oSqlResult, pnlIndex) - oSqlResult = clsPatterns.ReplaceInternalValues(oSqlResult) - If oSqlResult <> String.Empty Then - _Logger.Debug("oSqlResult after Replace [" & oSqlResult & "]") - End If - ' Ergebnis: Es wurden alle einfachen Platzhalter ersetzt, jetzt haben wir einen SQL Befehl, - ' der nur noch vektorfelder-platzhalter enthält - - ' 2. Schritt: Vektorfelder ersetzen - Dim oVectorMatches As MatchCollection = oRegex.Matches(oSqlResult) - If oVectorMatches.Count > 0 Then - _Logger.Info(" There are " & oVectorMatches.Count & " matches for vectors!") - Dim oIsFirstMatch = True - - For Each oVectorMatch As Match In oVectorMatches - Dim oIndexValue As String = StripPlaceholder(oVectorMatch.Value) - Dim oOptionalIndex = False - Dim oManualIndexResult As String = Nothing - oOptionalIndex = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID & " AND INDEXNAME = '" & oIndexValue, "OPTIONAL")) - 'oOptionalIndex = My.Database..Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')", MyConnectionString, True) - oManualIndexResult = GetManIndex_Value(oIndexValue, "IDX_AUTO", oOptionalIndex) - - Dim oVectorIndexValues = oManualIndexResult.Split("~").ToList() - - For Each oVectorIndexValue In oVectorIndexValues - Dim oTempSql = oSqlResult.Replace(oVectorMatch.Value, oVectorIndexValue) - Dim oResult = GetAutomaticIndexSQLValue(oTempSql, oSqlConnectionId, oSqlProvider) - oEndResult.Add(oResult) - Next - - ' Verhindert, dass die Schleife mehrmals durchlaufen wird - If oIsFirstMatch Then - Exit For - End If - oAutoIndexRow.Item("Indexiert") = True - oAutoIndexRow.Item("Indexwert") = String.Join("~", oEndResult.ToArray) - Next - Else - Dim oResult = GetAutomaticIndexSQLValue(oSqlResult, oSqlConnectionId, oSqlProvider) - _Logger.Info("Got a simple SQLResult: " & oResult.ToString) - oAutoIndexRow.Item("Indexiert") = True - oAutoIndexRow.Item("Indexwert") = oResult - - End If - Next - - Return True - Catch ex As Exception - _Logger.Error(ex) - MsgBox(ex.Message) - Return False - End Try - End Function - Function StripPlaceholder(Placeholder As String) As String - Dim oResult = Placeholder - oResult = Regex.Replace(oResult, "^\[%", "") - oResult = Regex.Replace(oResult, "\]$", "") - Return oResult - End Function -End Class \ No newline at end of file diff --git a/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb b/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb index e9d9f6a6..8415f56f 100644 --- a/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb +++ b/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb @@ -26,6 +26,8 @@ Public Class ImportZUGFeRDFiles Public Const ZUGFERD_ATTACHMENTS = "ZUGFeRD Attachments" Public HISTORY_ID As Integer + Private Const DIRECTORY_DONT_MOVE = "DIRECTORY_DONT_MOVE" + ' List of allowed extensions for PDF/A Attachments ' This list should not contain xml so the zugferd xml file will be filtered out Private ReadOnly AllowedExtensions As List(Of String) = New List(Of String) From {"docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"} @@ -406,29 +408,34 @@ Public Class ImportZUGFeRDFiles _logger.Error(ex) oTransaction.Rollback() - Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Out of memory' WHERE GUID = '{HISTORY_ID}'" - _firebird.ExecuteNonQuery(oSQL) + oMoveDirectory = DIRECTORY_DONT_MOVE - AddRejectedState(oMessageId, "OutOfMemoryException", "", ex.Message) + 'Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Out of memory' WHERE GUID = '{HISTORY_ID}'" + '_firebird.ExecuteNonQuery(oSQL) + 'AddRejectedState(oMessageId, "OutOfMemoryException", "", ex.Message) Catch ex As Exception _logger.Warn("Unknown Error occurred: {0}", ex.Message) _logger.Error(ex) oTransaction.Rollback() - Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'" - _firebird.ExecuteNonQuery(oSQL) - - oMoveDirectory = oArgs.ErrorDirectory - - AddRejectedState(oMessageId, "UnexpectedException", "", ex.Message) + oMoveDirectory = DIRECTORY_DONT_MOVE + 'Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'" + '_firebird.ExecuteNonQuery(oSQL) + 'oMoveDirectory = oArgs.ErrorDirectory + 'AddRejectedState(oMessageId, "UnexpectedException", "", ex.Message) Finally oConnection.Close() - ' Move all files of the current group Try - MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory, oIsSuccess) + ' If an application error occurred, dont move files so they will be processed again later + If oMoveDirectory = DIRECTORY_DONT_MOVE Then + _logger.Info("Application Error occurred. Files for message Id {0} will not be moved.", oMessageId) + Else + ' Move all files of the current group + MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory, oIsSuccess) + End If _logger.Info("Finished processing file group {0}", oMessageId) Catch ex As Exception _logger.Warn("Could not move files!") diff --git a/Modules.Jobs/My Project/AssemblyInfo.vb b/Modules.Jobs/My Project/AssemblyInfo.vb index 5b65e562..4ca5ac56 100644 --- a/Modules.Jobs/My Project/AssemblyInfo.vb +++ b/Modules.Jobs/My Project/AssemblyInfo.vb @@ -30,5 +30,5 @@ Imports System.Runtime.InteropServices ' Sie können alle Werte angeben oder die standardmäßigen Build- und Revisionsnummern ' übernehmen, indem Sie "*" eingeben: - - + + diff --git a/Modules.Logging/LogConfig.vb b/Modules.Logging/LogConfig.vb index 22808bd1..f7a1ca7a 100644 --- a/Modules.Logging/LogConfig.vb +++ b/Modules.Logging/LogConfig.vb @@ -56,9 +56,9 @@ Imports NLog.Targets ''' Public Class LogConfig #Region "Private Properties" - Private Const OPEN_FILE_CACHE_TIMEOUT As Integer = 5 + Private Const OPEN_FILE_CACHE_TIMEOUT As Integer = 30 Private Const OPEN_FILE_FLUSH_TIMEOUT As Integer = 5 - Private Const AUTO_FLUSH As Boolean = True + Private Const AUTO_FLUSH As Boolean = False Private Const KEEP_FILES_OPEN As Boolean = False Private Const KEEP_FILES_OPEN_DEBUG As Boolean = True diff --git a/Modules.Logging/My Project/AssemblyInfo.vb b/Modules.Logging/My Project/AssemblyInfo.vb index 0b927d78..53f70417 100644 --- a/Modules.Logging/My Project/AssemblyInfo.vb +++ b/Modules.Logging/My Project/AssemblyInfo.vb @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - - + + diff --git a/Services.ZUGFeRDService/My Project/AssemblyInfo.vb b/Services.ZUGFeRDService/My Project/AssemblyInfo.vb index d4947fdb..16e4f880 100644 --- a/Services.ZUGFeRDService/My Project/AssemblyInfo.vb +++ b/Services.ZUGFeRDService/My Project/AssemblyInfo.vb @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - + diff --git a/Services.ZUGFeRDService/ThreadRunner.vb b/Services.ZUGFeRDService/ThreadRunner.vb index 3b8e9d6d..e91f0ff4 100644 --- a/Services.ZUGFeRDService/ThreadRunner.vb +++ b/Services.ZUGFeRDService/ThreadRunner.vb @@ -25,8 +25,6 @@ Public Class ThreadRunner Private _jobArguments As WorkerArgs Private _mssql As MSSQLServer - Private Const TIMER_INTERVAL_MS = 10_000 - Public Sub New(LogConfig As LogConfig, Firebird As Firebird, Optional MSSQL As MSSQLServer = Nothing) _logConfig = LogConfig _logger = _logConfig.GetLogger() diff --git a/Windows/Hotkey.vb b/Windows/Hotkey.vb new file mode 100644 index 00000000..970dba1d --- /dev/null +++ b/Windows/Hotkey.vb @@ -0,0 +1,84 @@ +Imports System.Windows.Forms + +Public Class Hotkey + Implements IMessageFilter + + Private _OwnerForm As Form + Private _HotkeyList As New Dictionary(Of Short, HotKeyObject) + Private _HotkeyIDList As New Dictionary(Of String, Short) + + ''' + ''' Diesem Event wird immer die zugewiesene HotKeyID übergeben, wenn eine HotKey Kombination gedrückt wurde. + ''' + Public Event HotKeyPressed(ByVal HotKeyID As String) + + ''' + ''' Definiert verfügbare Modfier Keys + ''' + Public Enum ModfierKey As Integer + MOD_ALT = 1 + MOD_CONTROL = 2 + MOD_SHIFT = 4 + MOD_WIN = 8 + End Enum + + Sub New(ByVal pOwnerForm As Form) + _OwnerForm = pOwnerForm + Application.AddMessageFilter(Me) + End Sub + + ''' + ''' Diese Funktion fügt einen Hotkey hinzu und registriert ihn auch sofort + ''' + ''' Den KeyCode für die Taste + ''' Die Zusatztasten wie z.B. Strg oder Alt, diese können auch mit OR kombiniert werden + ''' Die ID die der Hotkey bekommen soll um diesen zu identifizieren + Public Sub AddHotKey(ByVal pKeyCode As Keys, ByVal pModifiers As ModfierKey, ByVal pHotKeyID As Integer) + If _HotkeyIDList.ContainsKey(pHotKeyID) = True Then + Exit Sub + End If + + Dim oHotkeyId As Short = NativeMethods.GlobalAddAtom(pHotKeyID) + _HotkeyIDList.Add(pHotKeyID, oHotkeyId) + _HotkeyList.Add(oHotkeyId, New HotKeyObject(pKeyCode, pModifiers, pHotKeyID)) + + NativeMethods.RegisterHotKey(_OwnerForm.Handle, oHotkeyId, _HotkeyList(oHotkeyId).Modifier, _HotkeyList(oHotkeyId).HotKey) + End Sub + + ''' + ''' Diese Funktion entfernt einen Hotkey und deregistriert ihn auch sofort + ''' + ''' Gibt die HotkeyID an welche entfernt werden soll + Public Sub RemoveHotKey(ByVal pHotKeyID As Integer) + If _HotkeyIDList.ContainsKey(pHotKeyID) = False Then + Exit Sub + End If + + Dim oHotkeyId As Short = _HotkeyIDList(pHotKeyID) + _HotkeyIDList.Remove(pHotKeyID) + _HotkeyList.Remove(oHotkeyId) + NativeMethods.UnregisterHotKey(_OwnerForm.Handle, CInt(oHotkeyId)) + NativeMethods.GlobalDeleteAtom(oHotkeyId) + End Sub + + Private Function PreFilterMessage(ByRef m As Message) As Boolean Implements IMessageFilter.PreFilterMessage + If m.Msg = NativeMethods.WM_HOTKEY Then + If Clipboard.GetText().Trim() <> String.Empty Then + RaiseEvent HotKeyPressed(_HotkeyList(CShort(m.WParam)).HotKeyID) + End If + End If + End Function + + Public Class HotKeyObject + Public Property HotKey() As Keys + Public Property Modifier() As ModfierKey + Public Property HotKeyID() As String + Public Property AtomID() As Short + + Sub New(ByVal NewHotKey As Keys, ByVal NewModifier As ModfierKey, ByVal NewHotKeyID As String) + HotKey = NewHotKey + Modifier = NewModifier + HotKeyID = NewHotKeyID + End Sub + End Class +End Class diff --git a/Windows/My Project/AssemblyInfo.vb b/Windows/My Project/AssemblyInfo.vb index 1bbeb8b0..97a103ef 100644 --- a/Windows/My Project/AssemblyInfo.vb +++ b/Windows/My Project/AssemblyInfo.vb @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - - + + diff --git a/Windows/NativeMethods.vb b/Windows/NativeMethods.vb index d5c328e9..dabda157 100644 --- a/Windows/NativeMethods.vb +++ b/Windows/NativeMethods.vb @@ -79,6 +79,27 @@ Public Class NativeMethods Public Shared Function GetCursorPos(ByRef lpPoint As PointAPI) As Boolean End Function + Public Declare Function RegisterHotKey Lib "user32" ( + ByVal Hwnd As IntPtr, + ByVal ID As Integer, + ByVal Modifiers As Integer, + ByVal Key As Integer + ) As Integer + + Public Declare Function UnregisterHotKey Lib "user32" ( + ByVal Hwnd As IntPtr, + ByVal ID As Integer + ) As Integer + + Public Declare Auto Function GetWindowText Lib "user32" ( + ByVal hWnd As IntPtr, + ByVal lpString As StringBuilder, + ByVal cch As Integer + ) As Integer + + Public Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal IDString As String) As Short + Public Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal Atom As Short) As Short + Public Const STANDARD_RIGHTS_REQUIRED As Integer = &HF0000 Public Const SECTION_QUERY As Short = &H1 Public Const SECTION_MAP_WRITE As Short = &H2 @@ -104,6 +125,7 @@ Public Class NativeMethods Public Const SEE_MASK_INVOKEIDLIST = &HC Public Const SEE_MASK_NOCLOSEPROCESS = &H40 Public Const SEE_MASK_FLAG_NO_UI = &H400 + Public Const WM_HOTKEY As Integer = &H312 Public Enum PageProtection As UInteger NoAccess = &H1 diff --git a/Windows/Windows.vbproj b/Windows/Windows.vbproj index 3bd354be..851b21ec 100644 --- a/Windows/Windows.vbproj +++ b/Windows/Windows.vbproj @@ -76,6 +76,7 @@ +