Imports System.Text.RegularExpressions Imports DigitalData.Modules.Base Imports DigitalData.Modules.Database Imports DigitalData.Modules.Language Public Class frmAdministration Private _SelectedProcessName As String Private _DragDrop As ClassDragDrop Private Const MAX_DATA_SEARCHES = 5 Private Const MAX_DOC_SEARCHES = 5 Private _DataASorDB As ClassDataASorDB Class ProfileType Public Name As String Public Id As Int16 Public Overrides Function ToString() As String Return Name End Function End Class Public Sub New() MyBase.New() ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() End Sub Public Class SQLPlaceholder Public Property Name Public Property Value Public Sub New(Name As String, Value As String) Me.Name = Name Me.Value = Value End Sub Public Overrides Function ToString() As String Return Name End Function End Class Private Function GetPlaceholders() As List(Of SQLPlaceholder) Return New List(Of SQLPlaceholder) From { New SQLPlaceholder("Zwischenablage", "@Clipboard"), New SQLPlaceholder("Benutzer-Vorname", "{#USER#PRENAME}"), New SQLPlaceholder("Benutzer-Nachname", "{#USER#SURNAME}"), New SQLPlaceholder("Benutzer-Email", "{#USER#EMAIL}"), New SQLPlaceholder("Benutzer-Kurzname", "{#USER#SHORTNAME}"), New SQLPlaceholder("Benutzer-Id", "{#USER#USER_ID}"), New SQLPlaceholder("Benutzer-Name", "{#INT#USERNAME}"), New SQLPlaceholder("Computer-Name", "{#INT#MACHINE}"), New SQLPlaceholder("Computer-Domäne", "{#INT#DOMAIN}"), New SQLPlaceholder("Aktuelles Datum", "{#INT#DATE}") } End Function Private Sub frmAdministration_Load(sender As Object, e As EventArgs) Handles MyBase.Load _DataASorDB = New ClassDataASorDB(modCurrent.LogConfig) ' Select first tab to prevent profile textbox from being empty XtraTabControl3.SelectedTabPageIndex = 0 _DragDrop = New ClassDragDrop() _DragDrop.AddGridView(GridViewGroupInProfile) _DragDrop.AddGridView(GridViewGroupNotInProfile) _DragDrop.AddGridView(GridViewUserInProfile) _DragDrop.AddGridView(GridViewUserNotInProfile) Load_Profiles() Load_ProfileTypes() Load_SearchPositions() Load_Connections() Load_Placeholders() End Sub Private Sub TBCW_PROFILESBindingNavigatorSaveItem_Click(sender As Object, e As EventArgs) Save_Profile() ClassInit.Refresh_Profile_Links() TableAdapterManager.UpdateAll(MyDataset) End Sub Private Sub Load_Profiles() Try TBCW_PROFILESTableAdapter.Connection.ConnectionString = MyConnectionString TBCW_PROFILESTableAdapter.Fill(Me.MyDataset.TBCW_PROFILES) Catch ex As Exception MsgBox("Unexpected Error in Load Profiles: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub Load_SearchPositions() Dim oTypeNames As New Dictionary(Of Integer, String) From { {ClassConstants.SEARCH_POSITION_PRIMARY, "Haupttabelle"}, {ClassConstants.SEARCH_POSITION_SECONDARY, "Erste Detailtabelle"}, {ClassConstants.SEARCH_POSITION_TERTIARY, "Zweite Detailtabelle"} } MyDataset.TBWH_SEARCH_POSITION.Rows.Clear() For Each oTypeName As KeyValuePair(Of Integer, String) In oTypeNames Dim oRow = MyDataset.TBWH_SEARCH_POSITION.NewTBWH_SEARCH_POSITIONRow() oRow.POSITION_INDEX = oTypeName.Key oRow.POSITION_NAME = oTypeName.Value MyDataset.TBWH_SEARCH_POSITION.Rows.Add(oRow) Next End Sub Private Sub Load_ProfileTypes() Dim oTypeNames As New Dictionary(Of Integer, String) From { {ClassConstants.PROFILE_TYPE_DATA_DOCS, "Dokumente und Daten"}, {ClassConstants.PROFILE_TYPE_DOCS_ONLY, "Nur Dokumente"}, {ClassConstants.PROFILE_TYPE_DATA_ONLY, "Nur Daten"} } MyDataset.TBWH_PROFILE_TYPE.Rows.Clear() For Each oTypeName As KeyValuePair(Of Integer, String) In oTypeNames Dim oRow = MyDataset.TBWH_PROFILE_TYPE.NewTBWH_PROFILE_TYPERow() oRow.TYPE_ID = oTypeName.Key oRow.TYPE_NAME = oTypeName.Value MyDataset.TBWH_PROFILE_TYPE.Rows.Add(oRow) Next End Sub Private Sub Load_Placeholders() ComboBoxEdit3.Properties.Items.Clear() ComboBoxEdit4.Properties.Items.Clear() ComboBoxEdit5.Properties.Items.Clear() ComboBoxEdit6.Properties.Items.Clear() ComboBoxEdit3.Properties.Items.AddRange(GetPlaceholders()) ComboBoxEdit4.Properties.Items.AddRange(GetPlaceholders()) ComboBoxEdit5.Properties.Items.AddRange(GetPlaceholders()) ComboBoxEdit6.Properties.Items.AddRange(GetPlaceholders()) End Sub Public Sub Load_Connections() Try TBDD_CONNECTIONTableAdapter.Connection.ConnectionString = MyConnectionString TBDD_CONNECTIONTableAdapter.Fill(MyDataset.TBDD_CONNECTION) Catch ex As Exception MsgBox("Unexpected Error in Load Connections: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Save_Profile() Try Me.TBCW_PROFILESBindingSource.EndEdit() If Not IsNothing(MyDataset.TBCW_PROFILES.GetChanges) Then Me.CHANGEDWHOTextBox.Text = Environment.UserName Me.TBCW_PROFILESBindingSource.EndEdit() Me.TBCW_PROFILESTableAdapter.Update(MyDataset.TBCW_PROFILES) Status_Changed("Profil gespeichert") Else Status_Changed("Keine Änderung") End If Catch ex As Exception Logger.Error(ex) 'MsgBox("Unerwarteter Fehler beim Speichern des Profils: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, Text) End Try End Sub Sub Status_Changed(text As String) labelStatus.Visibility = DevExpress.XtraBars.BarItemVisibility.Always labelStatus.Caption = $"{text} - {Now.ToLongTimeString}" End Sub Private Sub TBCW_PROFILESBindingSource_AddingNew(sender As Object, e As System.ComponentModel.AddingNewEventArgs) Handles TBCW_PROFILESBindingSource.AddingNew MyDataset.TBCW_PROFILES.ADDED_WHOColumn.DefaultValue = Environment.UserName MyDataset.TBCW_PROFILES.PROFILE_TYPEColumn.DefaultValue = 0 MyDataset.TBCW_PROFILES.REGEX_EXPRESSIONColumn.DefaultValue = ".+" MyDataset.TBCW_PROFILES.ACTIVEColumn.DefaultValue = True XtraTabControl3.SelectedTabPage = TabPageProfileManagement XtraTabControl1.SelectedTabPage = TabPageGeneralSettings End Sub Private Sub GUIDTextBox_TextChanged(sender As Object, e As EventArgs) Handles PROFILE_IDTextBox.TextChanged If PROFILE_IDTextBox.Text <> "" Then If CtrlApplicationAssignment1.AssignProfileID(PROFILE_IDTextBox.Text) = False Then MsgBox("Unexpected Error while assigning ProfileID!", MsgBoxStyle.Critical) Exit Sub End If Refresh_ProfileData() Refresh_Free_Users(PROFILE_IDTextBox.Text) Refresh_Free_Groups(PROFILE_IDTextBox.Text) Load_Profile_Process() End If End Sub Sub Refresh_ProfileData() Try VWUSER_PROFILETableAdapter.Connection.ConnectionString = MyConnectionString VWUSER_PROFILETableAdapter.Fill(MyDataset.VWUSER_PROFILE, PROFILE_IDTextBox.Text) VWCW_GROUP_PROFILETableAdapter.Connection.ConnectionString = MyConnectionString VWCW_GROUP_PROFILETableAdapter.Fill(MyDataset.VWCW_GROUP_PROFILE, PROFILE_IDTextBox.Text) TBCW_PROF_DOC_SEARCHTableAdapter.Connection.ConnectionString = MyConnectionString TBCW_PROF_DOC_SEARCHTableAdapter.Fill(MyDataset.TBCW_PROF_DOC_SEARCH, PROFILE_IDTextBox.Text) If MyDataset.TBCW_PROF_DOC_SEARCH.Count = 0 Then LayoutControlDocs.Enabled = False Else LayoutControlDocs.Enabled = True End If TBCW_PROF_DATA_SEARCHTableAdapter.Connection.ConnectionString = MyConnectionString TBCW_PROF_DATA_SEARCHTableAdapter.Fill(MyDataset.TBCW_PROF_DATA_SEARCH, PROFILE_IDTextBox.Text) If MyDataset.TBCW_PROF_DATA_SEARCH.Count = 0 Then LayoutControlData.Enabled = False Else LayoutControlData.Enabled = True End If Catch ex As Exception MsgBox("Unexpected Error in Refresh Profile User: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btnAddUser2Profile_Click(sender As Object, e As EventArgs) Try Try Dim i As Integer = CInt(PROFILE_IDTextBox.Text) Catch ex As Exception Exit Sub End Try For Each row As DataRow In MyDataset.TBWH_User.Rows If row.Item(0) = CBool(True) Then Dim insert = String.Format("INSERT INTO TBCW_USER_PROFILE (PROFILE_ID,USER_ID) VALUES ({0},{1})", PROFILE_IDTextBox.Text, row.Item(5)) If Database.ExecuteNonQuery(insert) = False Then MsgBox("Could not insert the User-Definition....Check the logfile!", MsgBoxStyle.Exclamation) End If End If Next For Each row As DataRow In MyDataset.TBWH_User.Rows row.Item(0) = CBool(False) Next If PROFILE_IDTextBox.Text <> "" Then Refresh_Free_Users(PROFILE_IDTextBox.Text) Refresh_ProfileData() End If Catch ex As Exception MsgBox("Unexpected Error while adding user-rights: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Refresh_Free_Users(PROFILE_ID As Integer) Dim Sql = String.Format("SELECT DISTINCT * FROM VWDD_USER_MODULE_CW WHERE GUID NOT IN (SELECT USER_ID FROM TBCW_USER_PROFILE WHERE PROFILE_ID = {0}) ORDER BY USERNAME", PROFILE_ID) Dim DT_USER = Database.GetDatatable(Sql) Try MyDataset.TBWH_User.Clear() For Each row As DataRow In DT_USER.Rows Dim newUserRow As MyDataset.TBWH_UserRow newUserRow = MyDataset.TBWH_User.NewTBWH_UserRow newUserRow.Username = row.Item("USERNAME") newUserRow.Surname = row.Item("NAME") newUserRow.Prename = row.Item("PRENAME") Try newUserRow.Email = row.Item("EMAIL") Catch ex As Exception newUserRow.Email = "" End Try newUserRow.GUID = row.Item("GUID") MyDataset.TBWH_User.Rows.Add(newUserRow) ' chklbxUserForGroup.Items.Add(New MyListBoxItem() With {.Text = row.Item(1), .ExtraData = row.Item(0)}) Next Catch ex As Exception MsgBox("Unexpected Error in Refresh_Free_Users: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Refresh_Free_Groups(PROFILE_ID As Integer) Dim Sql = String.Format("SELECT DISTINCT * FROM TBDD_GROUPS WHERE GUID NOT IN (SELECT GROUP_ID FROM TBCW_GROUP_PROFILE WHERE PROFILE_ID = {0}) ORDER BY NAME", PROFILE_ID) Dim oDataTable = Database.GetDatatable(Sql) Try MyDataset.TBWH_GROUP.Clear() For Each row As DataRow In oDataTable.Rows Dim oNewRow As MyDataset.TBWH_GROUPRow oNewRow = MyDataset.TBWH_GROUP.NewTBWH_GROUPRow oNewRow.NAME = row.Item("NAME") oNewRow.GUID = row.Item("GUID") MyDataset.TBWH_GROUP.Rows.Add(oNewRow) Next Catch ex As Exception MsgBox("Unexpected Error in Refresh_Free_Groups: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btndeleteUserConstructorRel_Click(sender As Object, e As EventArgs) Try Dim ID = GridViewUserInProfile.GetFocusedRowCellValue(GridViewUserInProfile.Columns("GUID")) Try Dim I As Integer = CInt(ID) Catch ex As Exception Exit Sub End Try Dim del = String.Format("DELETE FROM TBCW_USER_PROFILE WHERE GUID = {0}", ID) If Database.ExecuteNonQuery(del) = True Then Refresh_ProfileData() If PROFILE_IDTextBox.Text <> "" Then Refresh_Free_Users(PROFILE_IDTextBox.Text) End If End If Catch ex As Exception MsgBox("Unexpected Error in deleting ProfileUserRelation: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub Load_Profile_Process() If IsNothing(PROFILE_IDTextBox.Text) Or PROFILE_IDTextBox.Text = "" Then Exit Sub End If If CtrlApplicationAssignment1.Process_Load(PROFILE_IDTextBox.Text) = False Then MsgBox("Unexpected Error while loading processes:", MsgBoxStyle.Critical) End If End Sub Private Sub frmAdministration_Shown(sender As Object, e As EventArgs) Handles Me.Shown XtraTabControl1.SelectedTabPage = TabPageGeneralSettings If PROFILE_IDTextBox.Text = "" Then Refresh_Free_Users(0) Refresh_Free_Groups(0) End If End Sub Private Sub TBCW_PROF_DATA_SEARCHBindingSource_AddingNew(sender As Object, e As System.ComponentModel.AddingNewEventArgs) Handles TBCW_PROF_DATA_SEARCHBindingSource.AddingNew If PROFILE_IDTextBox.Text <> String.Empty Then MyDataset.TBCW_PROF_DATA_SEARCH.ADDED_WHOColumn.DefaultValue = Environment.UserName MyDataset.TBCW_PROF_DATA_SEARCH.PROFILE_IDColumn.DefaultValue = PROFILE_IDTextBox.Text MyDataset.TBCW_PROF_DATA_SEARCH.CONN_IDColumn.DefaultValue = 1 MyDataset.TBCW_PROF_DATA_SEARCH.ACTIVEColumn.DefaultValue = True LayoutControlData.Enabled = True Else MsgBox("Es ist kein Profil ausgewählt! Bitte wählen Sie ein Profil aus der Liste links", MsgBoxStyle.Critical, Text) End If End Sub Private Sub TBCW_PROF_DOC_SEARCHBindingSource_AddingNew(sender As Object, e As System.ComponentModel.AddingNewEventArgs) Handles TBCW_PROF_DOC_SEARCHBindingSource.AddingNew If PROFILE_IDTextBox.Text <> String.Empty Then MyDataset.TBCW_PROF_DOC_SEARCH.ADDED_WHOColumn.DefaultValue = Environment.UserName MyDataset.TBCW_PROF_DOC_SEARCH.ACTIVEColumn.DefaultValue = True MyDataset.TBCW_PROF_DOC_SEARCH.PROFILE_IDColumn.DefaultValue = PROFILE_IDTextBox.Text MyDataset.TBCW_PROF_DOC_SEARCH.CONN_IDColumn.DefaultValue = 1 LayoutControlDocs.Enabled = True Else MsgBox("Es ist kein Profil ausgewählt! Bitte wählen Sie ein Profil aus der Liste links", MsgBoxStyle.Critical, Text) End If End Sub Private Sub ToolStripButton3_Click(sender As Object, e As EventArgs) Try TBCW_PROF_DATA_SEARCHBindingSource.EndEdit() If Not IsNothing(MyDataset.TBCW_PROF_DATA_SEARCH.GetChanges) Then CHANGED_WHOTextBox1.Text = Environment.UserName TBCW_PROF_DATA_SEARCHBindingSource.EndEdit() TBCW_PROF_DATA_SEARCHTableAdapter.Update(MyDataset.TBCW_PROF_DATA_SEARCH) End If Catch ex As Exception MsgBox("Unexpected Error in Save Data Search: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub TBCW_PROF_REL_WINDOWBindingSource_AddingNew(sender As Object, e As System.ComponentModel.AddingNewEventArgs) MyDataset.TBCW_PROF_REL_WINDOW.ADDED_WHOColumn.DefaultValue = Environment.UserName End Sub Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick TBCW_PROFILESBindingSource.AddNew() End Sub Private Sub BarButtonItem3_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem3.ItemClick If ObjectEx.NotNull(txtProfileName.EditValue, String.Empty) <> String.Empty Then Save_Profile() Else MsgBox("Profil kann nicht ohne Profil-Name gespeichert werden!", MsgBoxStyle.Exclamation, Text) End If End Sub Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem2.ItemClick Dim swl = String.Format("EXEC PRCW_DELETE_PROFILE {0}", PROFILE_IDTextBox.Text) Dim result As MsgBoxResult = MsgBox("Sind Sie sicher, dass Sie das Profil löschen wollen?", MsgBoxStyle.YesNo Or MsgBoxStyle.Question, Text) ' wenn Speichern ja If result = MsgBoxResult.Yes Then If Database.ExecuteNonQuery(swl) = True Then Refresh_ProfileScreen() End If End If End Sub Private Sub BarButtonItem4_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem4.ItemClick Refresh_ProfileScreen() End Sub Sub Refresh_ProfileScreen() Load_Profiles() If PROFILE_IDTextBox.Text <> "" Then Refresh_ProfileData() Refresh_Free_Users(PROFILE_IDTextBox.Text) Refresh_Free_Groups(PROFILE_IDTextBox.Text) End If End Sub Private Sub BarButtonItem5_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem5.ItemClick If CtrlApplicationAssignment1.Process_CreateAssignment(PROFILE_IDTextBox.Text) = False Then MsgBox("Error while assigning process!", MsgBoxStyle.Critical, Text) Else Status_Changed("Prozess zugeordnet") End If End Sub Private Sub BarButtonItem6_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem6.ItemClick If MsgBox($"Wollen Sie den Prozess löschen?" & vbNewLine & "Dies wird alle Fenster löschen, die diesem Prozess zugeordnet sind!", MsgBoxStyle.Exclamation Or MsgBoxStyle.YesNo, Text) = MsgBoxResult.No Then Exit Sub End If If CtrlApplicationAssignment1.Process_DeleteAssignment() = False Then MsgBox("Error while deleting assignment of process!", MsgBoxStyle.Critical, "Search Flow") End If Status_Changed("Prozesszuordnung gelöscht") End Sub Private Sub BarButtonItem7_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem7.ItemClick Dim oProcesses As Integer = CtrlApplicationAssignment1.ProcessTable.Select($"PROFILE_ID = {PROFILE_IDTextBox.Text}").Length If oProcesses > 0 Then If CtrlApplicationAssignment1.Window_CreateAssignment(PROFILE_IDTextBox.Text) = False Then MsgBox("Error while assigning window!", MsgBoxStyle.Critical, Text) Else Status_Changed("Fenster zugeordnet") End If Else MsgBox($"Es wurden diesem Profi noch keine Prozesse zugeordnet!{vbNewLine}{vbNewLine}Bitte weisen Sie zuerst mind. einen Prozess zu, bevor Sie ein Fenster zuordnen.", MsgBoxStyle.Exclamation, Text) End If End Sub Private Sub BarButtonItem23_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem23.ItemClick Dim oWindows As Integer = CtrlApplicationAssignment1.WindowTable.Select($"PROCESS_ID = {CtrlApplicationAssignment1.SelectedProcessId}").Length If oWindows > 0 Then If CtrlApplicationAssignment1.Control_CreateAssignment() = False Then MsgBox("Error while creating control", MsgBoxStyle.Critical, Text) Else Status_Changed("Feld-Zuordnung angelegt") End If Else MsgBox($"Es wurden diesem Profi noch keine Prozesse/Fenster zugeordnet!{vbNewLine}{vbNewLine}Bitte weisen Sie zuerst mind. einen Prozess und mind. ein Fenster zu, bevor Sie ein Felder zuordnen.", MsgBoxStyle.Exclamation, Text) End If End Sub Private Sub BarButtonItem8_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem8.ItemClick If MsgBox($"Wollen Sie die Fenster-Zuordnung löschen?", MsgBoxStyle.Exclamation Or MsgBoxStyle.YesNo, Text) = MsgBoxResult.No Then Exit Sub End If If CtrlApplicationAssignment1.Window_DeleteAssignment() = False Then MsgBox("Error while deleting assignment of window!", MsgBoxStyle.Critical, "Search Flow") End If Status_Changed("Fensterzuordnung gelöscht") End Sub Private Sub XtraTabControl1_SelectedPageChanged(sender As Object, e As DevExpress.XtraTab.TabPageChangedEventArgs) Handles XtraTabControl1.SelectedPageChanged, XtraTabControl2.SelectedPageChanged Dim oTabName As String = e.Page.Name Try Select Case oTabName Case TabPageProcessAssignment.Name RibbonGroup_Profile.Enabled = False RibbonGroup_Process.Enabled = True RibbonGroup_Window.Enabled = True RibbonGroup_Control.Enabled = True RibbonGroup_DocSearch.Enabled = False RibbonGroup_DataSearch.Enabled = False Case TabPageUserAssignment.Name RibbonGroup_Profile.Enabled = False RibbonGroup_Process.Enabled = False RibbonGroup_Window.Enabled = False RibbonGroup_Control.Enabled = False RibbonGroup_DocSearch.Enabled = False RibbonGroup_DataSearch.Enabled = False Case TabPageGroupAssignment.Name RibbonGroup_Profile.Enabled = False RibbonGroup_Process.Enabled = False RibbonGroup_Window.Enabled = False RibbonGroup_Control.Enabled = False RibbonGroup_DocSearch.Enabled = False RibbonGroup_DataSearch.Enabled = False Case TabPageData.Name RibbonGroup_Profile.Enabled = False RibbonGroup_Process.Enabled = False RibbonGroup_Window.Enabled = False RibbonGroup_Control.Enabled = False RibbonGroup_DocSearch.Enabled = False RibbonGroup_DataSearch.Enabled = True Case TabPageDocuments.Name RibbonGroup_Profile.Enabled = False RibbonGroup_Process.Enabled = False RibbonGroup_Window.Enabled = False RibbonGroup_Control.Enabled = False RibbonGroup_DocSearch.Enabled = True RibbonGroup_DataSearch.Enabled = False Case Else RibbonGroup_Profile.Enabled = True RibbonGroup_Process.Enabled = False RibbonGroup_Window.Enabled = False RibbonGroup_Control.Enabled = False RibbonGroup_DocSearch.Enabled = False RibbonGroup_DataSearch.Enabled = False End Select Catch ex As Exception Logger.Error(ex) End Try End Sub Private Sub BarButtonItem9_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem9.ItemClick If CtrlApplicationAssignment1.Window_SaveAssignment() = False Then MsgBox("Error while saving window", MsgBoxStyle.Critical, Text) Else Status_Changed("Fensterzuordnung gespeichert") End If End Sub Private Sub BarButtonItem15_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem15.ItemClick If TBCW_PROF_DOC_SEARCHBindingSource.Count = MAX_DOC_SEARCHES Then MsgBox($"Es können nicht mehr als {MAX_DOC_SEARCHES} Dokument-Suchen angelegt werden!", MsgBoxStyle.Exclamation, Text) Exit Sub End If TBCW_PROF_DOC_SEARCHBindingSource.AddNew() End Sub Private Sub BarButtonItem21_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem21.ItemClick If txtDATAGUID.Text = String.Empty Then Exit Sub End If Dim result As MsgBoxResult = MsgBox("Sind Sie sicher, dass Sie diese Suche löschen wollen?", MsgBoxStyle.YesNo, Text) If result = MsgBoxResult.Yes Then TBCW_PROF_DATA_SEARCHTableAdapter.Delete(txtDATAGUID.Text) TBCW_PROF_DATA_SEARCHTableAdapter.Fill(MyDataset.TBCW_PROF_DATA_SEARCH, PROFILE_IDTextBox.Text) Status_Changed("Daten-Suche gelöscht") End If End Sub Private Sub Save_DataSearch() Try TBCW_PROF_DATA_SEARCHBindingSource.EndEdit() If Not IsNothing(MyDataset.TBCW_PROF_DATA_SEARCH.GetChanges) Then CHANGED_WHOTextBox1.Text = Environment.UserName TBCW_PROF_DATA_SEARCHBindingSource.EndEdit() TBCW_PROF_DATA_SEARCHTableAdapter.Update(MyDataset.TBCW_PROF_DATA_SEARCH) TBCW_PROF_DATA_SEARCHTableAdapter.Fill(MyDataset.TBCW_PROF_DATA_SEARCH, PROFILE_IDTextBox.Text) Status_Changed("Daten-Suche gespeichert") End If Catch ex As Exception Logger.Error(ex) MsgBox("Unexpected Error while saving Data Search: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, Text) End Try End Sub Private Sub BarButtonItem22_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem22.ItemClick If txtDataSearchName.EditValue <> String.Empty Then Save_DataSearch() Else MsgBox("Daten-Suche kann nicht ohne Titel gespeichert werden!", MsgBoxStyle.Exclamation, Text) End If End Sub Private Sub BarButtonItem20_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem20.ItemClick Try If TBCW_PROF_DATA_SEARCHBindingSource.Count = MAX_DATA_SEARCHES Then MsgBox($"Es können nicht mehr als {MAX_DATA_SEARCHES} Daten-Suchen angelegt werden!", MsgBoxStyle.Exclamation, Text) Exit Sub End If TBCW_PROF_DATA_SEARCHBindingSource.AddNew() Catch ex As Exception MsgBox("Unexpected Error while creating DataSearch: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, Text) End Try End Sub Private Sub BarButtonItem18_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem18.ItemClick Dim result As MsgBoxResult = MsgBox("Sind Sie sicher, dass Sie diese Suche löschen wollen?", MsgBoxStyle.YesNo, Text) If result = MsgBoxResult.Yes Then TBCW_PROF_DOC_SEARCHTableAdapter.Delete(txtDOC_GUID.Text) TBCW_PROF_DOC_SEARCHTableAdapter.Fill(MyDataset.TBCW_PROF_DOC_SEARCH, PROFILE_IDTextBox.Text) Status_Changed("Dokument-Suche gelöscht") End If End Sub Private Sub Save_DocSearch() Try TBCW_PROF_DOC_SEARCHBindingSource.EndEdit() If Not IsNothing(MyDataset.TBCW_PROF_DOC_SEARCH.GetChanges) Then CHANGED_WHOTextBox2.Text = Environment.UserName TBCW_PROF_DOC_SEARCHBindingSource.EndEdit() TBCW_PROF_DOC_SEARCHTableAdapter.Update(MyDataset.TBCW_PROF_DOC_SEARCH) TBCW_PROF_DOC_SEARCHTableAdapter.Fill(MyDataset.TBCW_PROF_DOC_SEARCH, PROFILE_IDTextBox.Text) Status_Changed("Dokument-Suche gespeichert") End If Catch ex As Exception MsgBox("Unexpected Error while saving Document Search: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) Logger.Error(ex) End Try End Sub Private Sub BarButtonItem19_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem19.ItemClick If txtDocSearchName.EditValue <> String.Empty Then Save_DocSearch() Else MsgBox("Dokument-Suche kann nicht ohne Titel gespeichert werden!", MsgBoxStyle.Exclamation, Text) End If End Sub Private Sub frmAdministration_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing _DataASorDB.Refresh_Connections() ClassInit.Refresh_Profile_Links() End Sub Private Sub BarButtonItem24_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem24.ItemClick If CtrlApplicationAssignment1.SelectedControlId = 0 Then Exit Sub End If If MsgBox($"Wollen Sie die Feld-Zuordnung löschen?", MsgBoxStyle.Exclamation Or MsgBoxStyle.YesNo, Text) = MsgBoxResult.No Then Exit Sub End If If CtrlApplicationAssignment1.Control_DeleteAssignment() = False Then MsgBox("Error while deleting assignment of control!", MsgBoxStyle.Critical, Text) End If Status_Changed("Feld-Zuordnung gelöscht") End Sub Private Sub BarButtonItem25_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem25.ItemClick If CtrlApplicationAssignment1.SelectedControlId = 0 Then Exit Sub End If If CtrlApplicationAssignment1.Control_SaveAssignment() = False Then MsgBox("Error while saving control", MsgBoxStyle.Critical, Text) Else Status_Changed("Feld-Zuordnung gespeichert") End If End Sub Private Sub BarButtonItem27_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem27.ItemClick If CtrlApplicationAssignment1.SelectedControlId = 0 Then Exit Sub End If If CtrlApplicationAssignment1.Control_EditAssignment() = False Then MsgBox("Error while saving control", MsgBoxStyle.Critical, Text) Else Status_Changed("Feld-Zuordnung geändert") End If End Sub Private Sub BarButtonItem26_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem26.ItemClick Dim oSQL As String = $"EXEC PRCW_COPY_PROFILE {PROFILE_IDTextBox.Text}, '{USER_USERNAME}'" If Database.ExecuteNonQuery(oSQL) = False Then MsgBox("Profil konnte nicht kopiert werden! Mehr Informationen im Log.", MsgBoxStyle.Exclamation, Text) Else Refresh_ProfileScreen() MsgBox("Profil kopiert! Bitte die Abhängigkeiten überprüfen!", MsgBoxStyle.Information, Text) End If End Sub Private Sub BarButtonItem16_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem16.ItemClick Dim oForm As New frmConnection() oForm.ShowDialog() End Sub Private Sub BarButtonItem17_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem17.ItemClick End Sub Private Sub BarButtonItem28_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem28.ItemClick Dim oForm As New frmConnection() oForm.ShowDialog() End Sub Private Sub BarButtonItem29_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem29.ItemClick Dim oform As New frmLicenseInfo() oform.ShowDialog() End Sub Private Sub frmAdministration_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp If e.KeyCode = Keys.F12 And USER_IS_ADMIN = True Then frmLicense.ShowDialog() End If End Sub Private Sub SimpleButton1_Click(sender As Object, e As EventArgs) Handles SimpleButton1.Click If txtRegexTestString.Text.Count = 0 Then MsgBox("Bitte füllen Sie den Regular Expression Test aus!", MsgBoxStyle.Exclamation, Text) Exit Sub End If If textEdit5.Text.Count = 0 Then MsgBox("Bitte füllen Sie die Regular Expression aus!", MsgBoxStyle.Exclamation, Text) Exit Sub End If Dim oRegex As String = textEdit5.Text Dim oTestString As String = txtRegexTestString.Text If Regex.IsMatch(oTestString, oRegex) Then MsgBox("Der Test war erfolgreich!", MsgBoxStyle.Information, Text) Else MsgBox("Der Test war NICHT erfolgreich!", MsgBoxStyle.Information, Text) End If End Sub Private Sub GridControlUserNotInProfile_DragDrop(sender As Object, e As DragEventArgs) Handles GridControlUserNotInProfile.DragDrop Try If PROFILE_IDTextBox.Text = String.Empty Then Exit Sub End If Dim oSelectedRows = GridViewUserInProfile.GetSelectedRows() For Each oRowHandle As Integer In oSelectedRows Dim oRow As DataRow = GridViewUserInProfile.GetDataRow(oRowHandle) Dim oGuid As Integer = oRow.Item("GUID") Dim del = String.Format("DELETE FROM TBCW_USER_PROFILE WHERE GUID = {0}", oGuid) If Database.ExecuteNonQuery(del) = False Then MsgBox("Error while adding user!", MsgBoxStyle.Exclamation) End If Next Refresh_Free_Users(PROFILE_IDTextBox.Text) Refresh_ProfileData() GridViewUserInProfile.ClearSelection() Status_Changed($"{oSelectedRows.Count} Benutzerzuordnungen gelöscht") Catch ex As Exception Logger.Error(ex) MsgBox("Unexpected Error in deleting ProfileUserRelation: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub GridControlUserInProfile_DragDrop(sender As Object, e As DragEventArgs) Handles GridControlUserInProfile.DragDrop Try If PROFILE_IDTextBox.Text = String.Empty Then Exit Sub End If Dim oSelectedRows = GridViewUserNotInProfile.GetSelectedRows() For Each oRowHandle As Integer In oSelectedRows Dim oRow As DataRow = GridViewUserNotInProfile.GetDataRow(oRowHandle) Dim oGuid As Integer = oRow.Item("GUID") Dim insert = String.Format("INSERT INTO TBCW_USER_PROFILE (PROFILE_ID,USER_ID) VALUES ({0},{1})", PROFILE_IDTextBox.Text, oGuid) If Database.ExecuteNonQuery(insert) = False Then MsgBox("Error while adding user!", MsgBoxStyle.Exclamation) End If Next Refresh_Free_Users(PROFILE_IDTextBox.Text) Refresh_ProfileData() GridViewUserNotInProfile.ClearSelection() Status_Changed($"{oSelectedRows.Count} Benutzer zugeordnet") Catch ex As Exception Logger.Error(ex) MsgBox("Unexpected Error while adding user-rights: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub XtraTabControl2_DragDrop(sender As Object, e As DragEventArgs) Handles XtraTabControl2.DragDrop End Sub Private Sub GridControlGroupNotInProfile_DragDrop(sender As Object, e As DragEventArgs) Handles GridControlGroupNotInProfile.DragDrop Try Dim oSelectedGroups = GridViewGroupInProfile.GetSelectedRows() For Each oRowHandle In oSelectedGroups Dim oRow As MyDataset.VWCW_GROUP_PROFILERow = DirectCast(GridViewGroupInProfile.GetRow(oRowHandle), DataRowView).Row Dim oGroupId As Integer = oRow.GUID Dim oSQL As String = $"DELETE FROM TBCW_GROUP_PROFILE WHERE GUID = ({oGroupId})" If Database.ExecuteNonQuery(oSQL) = False Then MsgBox("Could not delete the Group-Definition....Check the logfile!", MsgBoxStyle.Exclamation) End If Next GridViewGroupInProfile.ClearSelection() Refresh_Free_Groups(PROFILE_IDTextBox.Text) Refresh_ProfileData() Status_Changed($"{oSelectedGroups.Count} Gruppenzuordnungen gelöscht") Catch ex As Exception MsgBox("Unexpected Error in deleting Group-Rights: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub GridControlGroupInProfile_DragDrop(sender As Object, e As DragEventArgs) Handles GridControlGroupInProfile.DragDrop Try Dim oSelectedGroups = GridViewGroupNotInProfile.GetSelectedRows() For Each oRowHandle In oSelectedGroups Dim oRow As MyDataset.TBWH_GROUPRow = DirectCast(GridViewGroupNotInProfile.GetRow(oRowHandle), DataRowView).Row Dim oGroupId As Integer = oRow.GUID Dim oSQL As String = $"INSERT INTO TBCW_GROUP_PROFILE (PROFILE_ID,GROUP_ID) VALUES ({PROFILE_IDTextBox.Text},{oGroupId})" If Database.ExecuteNonQuery(oSQL) = False Then MsgBox("Could not insert the Group-Definition....Check the logfile!", MsgBoxStyle.Exclamation) End If Next GridViewGroupNotInProfile.ClearSelection() Refresh_Free_Groups(PROFILE_IDTextBox.Text) Refresh_ProfileData() Status_Changed($"{oSelectedGroups.Count} Gruppen zugeordnet") Catch ex As Exception MsgBox("Unexpected Error while adding Group-Rights: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub SimpleButton2_Click(sender As Object, e As EventArgs) Handles SimpleButton2.Click If ComboBoxEdit3.SelectedIndex > -1 Then Dim oItem As SQLPlaceholder = ComboBoxEdit3.SelectedItem MemoEdit5.Text &= oItem.Value End If End Sub Private Sub SimpleButton3_Click(sender As Object, e As EventArgs) Handles SimpleButton3.Click If ComboBoxEdit4.SelectedIndex > -1 Then Dim oItem As SQLPlaceholder = ComboBoxEdit4.SelectedItem MemoEdit6.Text &= oItem.Value End If End Sub Private Sub SimpleButton4_Click(sender As Object, e As EventArgs) Handles SimpleButton4.Click If ComboBoxEdit5.SelectedIndex > -1 Then Dim oItem As SQLPlaceholder = ComboBoxEdit5.SelectedItem MemoEdit3.Text &= oItem.Value End If End Sub Private Sub SimpleButton5_Click(sender As Object, e As EventArgs) Handles SimpleButton5.Click If ComboBoxEdit6.SelectedIndex > -1 Then Dim oItem As SQLPlaceholder = ComboBoxEdit6.SelectedItem MemoEdit4.Text &= oItem.Value End If End Sub Private Sub TBCW_PROFILESBindingSource_CurrentChanged(sender As Object, e As EventArgs) Handles TBCW_PROFILESBindingSource.CurrentChanged If PROFILE_IDTextBox.Text <> String.Empty Then CtrlApplicationAssignment1.Process_Load(PROFILE_IDTextBox.Text) End If End Sub Private Sub BarButtonItem30_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem30.ItemClick CtrlApplicationAssignment1.Window_EditRegex() End Sub End Class