Imports DD_LIB_Standards Public Class frmAdministration Dim PID As Integer Private Sub TBCW_PROFILESBindingNavigatorSaveItem_Click(sender As Object, e As EventArgs) Handles TBCW_PROFILESBindingNavigatorSaveItem.Click Save_Profile() Me.TableAdapterManager.UpdateAll(Me.MyDataset) End Sub Sub Load_Profiles() Try Me.TBCW_PROFILESTableAdapter.Connection.ConnectionString = MyConnectionString Me.TBCW_PROFILESTableAdapter.Fill(Me.MyDataset.TBCW_PROFILES) If MyDataset.TBCW_PROFILES.Rows.Count >= 1 Then grpbxProfiles.Enabled = True End If Catch ex As Exception MsgBox("Unexpected Error in Load Profiles: " & 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.CHANGED_WHOTextBox.Text = Environment.UserName Me.TBCW_PROFILESBindingSource.EndEdit() Me.TBCW_PROFILESTableAdapter.Update(MyDataset.TBCW_PROFILES) Status_Changed("Profil gespeichert - " & Now.ToString, Color.Yellow) Else Status_Changed("Keine Änderung - " & Now.ToString, Color.Transparent) End If Catch ex As Exception MsgBox("Unexpected Error in Save Profile: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub frmAdministration_Load(sender As Object, e As EventArgs) Handles MyBase.Load Load_Profiles() lbllicenseCount.Text = LICENSE_COUNT If LICENSE_DATE.ToString.Contains("2099") Then lblLicenseDate.Text = "Unlimited" Else lblLicenseDate.Text = LICENSE_DATE End If End Sub Sub Status_Changed(text As String, col As System.Drawing.Color) statuslabel.Text = text statuslabel.BackColor = col 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 End Sub Private Sub btnaddSearch_Click(sender As Object, e As EventArgs) Handles btnaddSearch.Click If Not Me.WD_SEARCHTextBox.Text = "" Then Me.OFDWindreamsuche.FileName = Me.WD_SEARCHTextBox.Text End If If Me.OFDWindreamsuche.ShowDialog = System.Windows.Forms.DialogResult.OK Then Me.WD_SEARCHTextBox.Text = Me.OFDWindreamsuche.FileName End If End Sub Private Sub GUIDTextBox_TextChanged(sender As Object, e As EventArgs) Handles GUIDTextBox.TextChanged If GUIDTextBox.Text <> "" Then Refresh_Profile_user() Refresh_Free_Users(GUIDTextBox.Text) Load_Profile_Process() End If End Sub Sub Refresh_Profile_user() Try Try Dim ID = CInt(GUIDTextBox.Text) Catch ex As Exception Exit Sub End Try Me.VWUSER_PROFILETableAdapter.Connection.ConnectionString = MyConnectionString Me.VWUSER_PROFILETableAdapter.Fill(Me.MyDataset.VWUSER_PROFILE, GUIDTextBox.Text) 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) Handles btnAddUser2Profile.Click Try Try Dim i As Integer = CInt(GUIDTextBox.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})", GUIDTextBox.Text, row.Item(5)) If clsDatabase.Execute_non_Query(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 GUIDTextBox.Text <> "" Then Refresh_Free_Users(GUIDTextBox.Text) Refresh_Profile_user() 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 = clsDatabase.Return_Datatable(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.ID = 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 Private Sub btndeleteUserConstructorRel_Click(sender As Object, e As EventArgs) Handles btndeleteUserConstructorRel.Click Try Dim ID = GridViewProfileUser.GetFocusedRowCellValue(GridViewProfileUser.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 clsDatabase.Execute_non_Query(del) = True Then Refresh_Profile_user() If GUIDTextBox.Text <> "" Then Refresh_Free_Users(GUIDTextBox.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 chkRunwindowCheck_CheckedChanged(sender As Object, e As EventArgs) End Sub Private Sub TimerTest_Tick(sender As Object, e As EventArgs) Handles TimerTest.Tick clsWINDOWSApi.Get_ForegroundWindow_Info() If PID <> CurrPROC_PID And CurrPROC_Name <> "DD_Clipboard_Watcher" Then lblprocessCheckActive.Visible = True PID = CurrPROC_PID txtPID.Text = CurrPROC_PID txtProcessName.Text = CurrPROC_Name Else lblprocessCheckActive.Visible = False End If End Sub Private Sub GroupBox2_Enter(sender As Object, e As EventArgs) Handles GroupBox2.Enter End Sub Private Sub Load_Profile_Process() Try If IsNothing(GUIDTextBox.Text) Or GUIDTextBox.Text = "" Then Exit Sub End If Me.TBCW_PROFILE_PROCESSTableAdapter.Connection.ConnectionString = MyConnectionString Me.TBCW_PROFILE_PROCESSTableAdapter.Fill(Me.MyDataset.TBCW_PROFILE_PROCESS, GUIDTextBox.Text) Catch ex As System.Exception MsgBox("Unexpected Error in Load_Profile_Process: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btnLinkProcessPRofile_Click(sender As Object, e As EventArgs) Handles btnLinkProcessPRofile.Click Try If txtProcessName.Text <> "" Then Dim insert = String.Format("INSERT INTO TBCW_PROFILE_PROCESS (PROFILE_ID,PROC_NAME,ADDED_WHO) VALUES ({0},'{1}','{2}')", GUIDTextBox.Text, txtProcessName.Text, Environment.UserName) If clsDatabase.Execute_non_Query(insert) = False Then MsgBox("Could not insert the Process-Profile-Link....Check the logfile!", MsgBoxStyle.Exclamation) End If End If Load_Profile_Process() clsHotkey.Refresh_Profile_Links() Catch ex As Exception MsgBox("Unexpected Error while adding Process-Profile-link: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btndeleteProcessProfileLink_Click(sender As Object, e As EventArgs) Handles btndeleteProcessProfileLink.Click Try Dim ID = GridViewProcessProfile.GetFocusedRowCellValue(GridViewProcessProfile.Columns("GUID")) Try Dim I As Integer = CInt(ID) Catch ex As Exception Exit Sub End Try Dim del = String.Format("DELETE FROM TBCW_PROFILE_PROCESS WHERE GUID = {0}", ID) If clsDatabase.Execute_non_Query(del) = True Then Load_Profile_Process End If Catch ex As Exception MsgBox("Unexpected Error in deleting ProfileProcess-Relation: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub btnStartStopProcess_Click(sender As Object, e As EventArgs) Handles btnStartStopProcess.Click If btnStartStopProcess.Text = "Starte Aktive Fenster-Auswahl" Then Me.Cursor = Cursors.WaitCursor txtPID.Text = "" txtProcessName.Text = "" TimerTest.Start() btnStartStopProcess.Text = "Stoppe Auswertung Fenster" Status_Changed("Auswertung von aktivem Fenster läuft! Wechseln Sie durch die aktiven Anwendungen!", Color.Orange) Else Me.Cursor = Cursors.Default TimerTest.Stop() btnStartStopProcess.Text = "Starte Aktive Fenster-Auswahl" Status_Changed("", Color.Transparent) End If End Sub Private Sub WD_SEARCHTextBox_MouseHover(sender As Object, e As EventArgs) Handles WD_SEARCHTextBox.MouseHover ToolTip1.SetToolTip(WD_SEARCHTextBox, "Replace patterns for string fields: " & vbNewLine & "@Clipboard" & vbNewLine & "@CLIPBOARD" & vbNewLine & "@Zwischenablage" & vbNewLine & "Replace patterns for integer fields: " & vbNewLine & "123456789" & vbNewLine & "4711") ToolTip1.ToolTipTitle = "Replace patterns:" ToolTip1.IsBalloon = True ToolTip1.ToolTipIcon = ToolTipIcon.Info ToolTip1.UseAnimation = True End Sub Private Sub frmAdministration_Shown(sender As Object, e As EventArgs) Handles Me.Shown If GUIDTextBox.Text = "" Then Refresh_Free_Users(0) End If End Sub Private Sub BindingNavigatorDeleteItem_Click(sender As Object, e As EventArgs) Handles BindingNavigatorDeleteItem.Click Dim swl = String.Format("EXEC PRCW_DELETE_PROFILE {0}", GUIDTextBox.Text) Dim result As MsgBoxResult = MsgBox("Sind Sie sicher, dass Sie das Profil löschen wollen?", MsgBoxStyle.YesNo, "Bestätigung erforderlich:") ' wenn Speichern ja If result = MsgBoxResult.Yes Then If clsDatabase.Execute_non_Query(swl) = True Then Load_Profiles() End If End If End Sub Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButton1.Click Load_Profiles() Refresh_Profile_user() Try Dim ID = CInt(GUIDTextBox.Text) Catch ex As Exception Exit Sub End Try Refresh_Free_Users(GUIDTextBox.Text) End Sub Private Sub BindingNavigatorAddNewItem_Click(sender As Object, e As EventArgs) Handles BindingNavigatorAddNewItem.Click grpbxProfiles.Enabled = True End Sub Private Sub ACTIVECheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles ACTIVECheckBox.CheckedChanged End Sub End Class