Imports DD_LIB_Standards Public Class frmAdministration Dim PID As Integer Private Sub TBCBS_PROFILESBindingNavigatorSaveItem_Click(sender As Object, e As EventArgs) Handles TBCBS_PROFILESBindingNavigatorSaveItem.Click Save_Profile() Me.TableAdapterManager.UpdateAll(Me.MyDataset) End Sub Sub Load_Profiles() Try Me.TBCBS_PROFILESTableAdapter.Connection.ConnectionString = MyConnectionString Me.TBCBS_PROFILESTableAdapter.Fill(Me.MyDataset.TBCBS_PROFILES) Catch ex As Exception MsgBox("Unexpected Error in Load Profiles: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Save_Profile() Try Me.TBCBS_PROFILESBindingSource.EndEdit() If Not IsNothing(MyDataset.TBCBS_PROFILES.GetChanges) Then Me.CHANGED_WHOTextBox.Text = Environment.UserName Me.TBCBS_PROFILESBindingSource.EndEdit() Me.TBCBS_PROFILESTableAdapter.Update(MyDataset.TBCBS_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 TBCBS_PROFILESBindingSource_AddingNew(sender As Object, e As System.ComponentModel.AddingNewEventArgs) Handles TBCBS_PROFILESBindingSource.AddingNew MyDataset.TBCBS_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 = 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 Refresh_Profile_user() Refresh_Free_Users() Load_Profile_Process() 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 TBCBS_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 Refresh_Free_Users() Refresh_Profile_user() Catch ex As Exception MsgBox("Unexpected Error while adding user-rights: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Refresh_Free_Users() Try Dim ID = CInt(GUIDTextBox.Text) Catch ex As Exception Exit Sub End Try Dim Sql = String.Format("SELECT * FROM TBDD_USER WHERE MODULE_DDCBSEARCHER = 1 AND GUID NOT IN (SELECT USER_ID FROM TBCBS_USER_PROFILE WHERE PROFILE_ID = {0}) ORDER BY USERNAME", GUIDTextBox.Text) 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 TBCBS_USER_PROFILE WHERE GUID = {0}", ID) If clsDatabase.Execute_non_Query(del) = True Then Refresh_Profile_user() Refresh_Free_Users() 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 <> PROC_PID And PROC_Name <> "DD_Clipboard_Watcher" Then PictureBox1.Visible = True PID = PROC_PID txtPID.Text = PROC_PID txtProcessName.Text = PROC_Name Else PictureBox1.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.TBCBS_PROFILE_PROCESSTableAdapter.Connection.ConnectionString = MyConnectionString Me.TBCBS_PROFILE_PROCESSTableAdapter.Fill(Me.MyDataset.TBCBS_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 TBCBS_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 TBCBS_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! Alle 5 Sekunden Prüfung! - 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 End Class