You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
981 lines
37 KiB
981 lines
37 KiB
Imports C1.Win.C1TrueDBGrid
|
|
Imports DevComponents
|
|
Public Class DPMSecurity
|
|
Dim SecurityData As DataSet = Globals.SecurityDaten
|
|
Dim db As New clsDB
|
|
Dim IntForm As Object
|
|
Dim ctlcol As New Collection
|
|
Dim formname As String = ""
|
|
Public Function List_Form_Controls(ByRef f As Form) As String
|
|
Dim counter As Integer = 0
|
|
Me.ctlcol.Clear()
|
|
formname = f.Name
|
|
For Each ctl As Control In f.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
' Exit Function
|
|
Dim i As Integer
|
|
Dim s As String = ""
|
|
' Dim cc As New ControlsCollection(f, ctlcol)
|
|
'For i = 1 To ctlcol.Count
|
|
'Dim secobj As MyFormControls = ctlcol(i)
|
|
' Try
|
|
'ReadContextMenu(secobj.MyControl.contextmenustrip)
|
|
'Catch
|
|
'End Try
|
|
'Next
|
|
For i = 1 To ctlcol.Count
|
|
Dim secobj As MyFormControls = ctlcol(i)
|
|
|
|
s = s + vbCrLf + secobj.write_to_text()
|
|
Next
|
|
|
|
Return s
|
|
End Function
|
|
|
|
Public Sub Reset_Mainmenu(ByRef f As Form)
|
|
If Globals.UseSecurityObjects = False Then Exit Sub
|
|
IntForm = f
|
|
formname = f.Name
|
|
'Load form DB
|
|
Load_Data(f.Name)
|
|
'Load FormObjects
|
|
Me.ctlcol.Clear()
|
|
formname = f.Name
|
|
For Each ctl As Control In f.Controls
|
|
Dim typ As System.Type = ctl.GetType
|
|
If LCase(typ.Name) = "menustrip" Then
|
|
Dim tmpmnu As MenuStrip = ctl
|
|
level = 0
|
|
For Each xx As Object In tmpmnu.Items
|
|
Dim objtype As System.Type = xx.GetType
|
|
If LCase(objtype.Name) = "toolstripmenuitem" Then
|
|
Dim tsm As ToolStripMenuItem = xx
|
|
tsm.Visible = True
|
|
tsm.Enabled = True
|
|
For Each subobj As Object In xx.DropDownItems
|
|
If LCase(subobj.GetType.Name) = "toolstripmenuitem" Then
|
|
Dim tsm1 As ToolStripMenuItem = subobj
|
|
tsm1.Enabled = True
|
|
tsm1.Visible = True
|
|
End If
|
|
Next
|
|
End If
|
|
Next
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
''' <summary>
|
|
''' Formularsecurity setzen
|
|
''' </summary>
|
|
''' <param name="f">Aktuelles Formular</param>
|
|
''' <returns></returns>
|
|
''' <remarks></remarks>
|
|
Public Function Set_Form_Security(ByRef f As Form)
|
|
If Globals.UseSecurityObjects = False Then Exit Function
|
|
|
|
IntForm = f
|
|
formname = f.Name
|
|
'Load form DB
|
|
Load_Data(f.Name)
|
|
'Load FormObjects
|
|
Me.ctlcol.Clear()
|
|
formname = f.Name
|
|
For Each ctl As Control In f.Controls
|
|
Objectanalysis(ctl)
|
|
' AddHandler ctl.HelpRequested, AddressOf Object_MouseDown
|
|
'ctl.ContextMenuStrip = Globals.TTContextMenuStrip
|
|
'AddHandler ctl.KeyDown, AddressOf Object_MouseDown
|
|
Next
|
|
Set_Security()
|
|
|
|
End Function
|
|
|
|
Public Function Set_Class_Security(ByRef f As Object, FName As String)
|
|
IntForm = f
|
|
formname = FName
|
|
'Load form DB
|
|
Load_Data(formname)
|
|
'Load FormObjects
|
|
Me.ctlcol.Clear()
|
|
formname = f.Name
|
|
For Each ctl As Control In f.Controls
|
|
Objectanalysis(ctl)
|
|
' AddHandler ctl.HelpRequested, AddressOf Object_MouseDown
|
|
'ctl.ContextMenuStrip = Globals.TTContextMenuStrip
|
|
'AddHandler ctl.KeyDown, AddressOf Object_MouseDown
|
|
Next
|
|
Set_Security()
|
|
|
|
End Function
|
|
|
|
Public Function Set_Menu_Security(ByRef f As Form, ByRef menu As ToolStripMenuItem, ByVal Menuname As String)
|
|
IntForm = f
|
|
formname = f.Name
|
|
Load_Data(f.Name)
|
|
Me.ctlcol.Clear()
|
|
formname = f.Name
|
|
Dim ctl As Object = menu
|
|
Dim typ As System.Type = ctl.GetType
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, Menuname, ctl.Name))
|
|
|
|
Set_Security()
|
|
'If Globals.Set_ToolTips = True Then
|
|
' tt.Edit_ToolTips(f, ctlcol)
|
|
'Else
|
|
' tt.Set_ToolTips(f)
|
|
'End If
|
|
|
|
End Function
|
|
|
|
Public Function ControlReadonly(ByRef ctlin As Control)
|
|
Me.ctlcol.Clear()
|
|
For Each ctl As Control In ctlin.Controls
|
|
Objectanalysis_readonly(ctl)
|
|
Next
|
|
|
|
End Function
|
|
|
|
Public Function Set_Form_Readonly(ByRef f As Form)
|
|
IntForm = f
|
|
Me.formname = f.Name
|
|
Load_Data(f.Name)
|
|
Me.ctlcol.Clear()
|
|
For Each ctl As Control In f.Controls
|
|
Objectanalysis_readonly(ctl)
|
|
Next
|
|
End Function
|
|
Public Function Set_Form_Default(ByRef f As Form)
|
|
IntForm = f
|
|
Me.formname = f.Name
|
|
Load_Data(f.Name)
|
|
Me.ctlcol.Clear()
|
|
For Each ctl As Control In f.Controls
|
|
Objectanalysis_default(ctl)
|
|
Next
|
|
End Function
|
|
|
|
Private Function Objectanalysis_readonly(ByRef ctl As Object) As String
|
|
Dim typ As System.Type = ctl.GetType
|
|
Select Case LCase(typ.Name)
|
|
Case "splitcontainer"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmpsplit As SplitContainer = ctl
|
|
For Each ctrl As Object In tmpsplit.Panel1.Controls
|
|
Objectanalysis_readonly(ctrl)
|
|
Next
|
|
For Each ctrl As Object In tmpsplit.Panel2.Controls
|
|
Objectanalysis_readonly(ctrl)
|
|
Next
|
|
Case "tabcontrol", "clsmytabcontrol"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabcontrol As TabControl = ctl
|
|
For Each ctl In tmptabcontrol.TabPages
|
|
Objectanalysis_readonly(ctl)
|
|
Next
|
|
Case "tabpage"
|
|
Dim tmptabpage As TabPage = ctl
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, tmptabpage.Parent.Name, 1))
|
|
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis_readonly(ctl)
|
|
Next
|
|
Case "groupbox"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As GroupBox = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis_readonly(ctl)
|
|
Next
|
|
|
|
Case "panel"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmppanel As Panel = ctl
|
|
For Each ctl In tmppanel.Controls
|
|
Objectanalysis_readonly(ctl)
|
|
Next
|
|
Case "textbox"
|
|
Dim x As TextBox = ctl
|
|
x.BackColor = Color.LightGray
|
|
x.ForeColor = Color.Black
|
|
x.ReadOnly = True
|
|
Case "maskedtextbox"
|
|
Dim x As MaskedTextBox = ctl
|
|
x.BackColor = Color.LightGray
|
|
x.ForeColor = Color.Black
|
|
x.ReadOnly = True
|
|
Case "combobox"
|
|
Dim x As ComboBox = ctl
|
|
x.Enabled = False
|
|
x.BackColor = Color.LightGray
|
|
x.ForeColor = Color.Black
|
|
Case "checkbox"
|
|
Dim x As CheckBox = ctl
|
|
x.Enabled = False
|
|
Case "radiobutton"
|
|
Dim x As RadioButton = ctl
|
|
x.Enabled = False
|
|
Case "comboboxtree"
|
|
Dim x As Object = ctl
|
|
x.enabled = False
|
|
x.BackColor = Color.LightGray
|
|
x.ForeColor = Color.Black
|
|
Case "richtextbox"
|
|
Dim x As Object = ctl
|
|
x.BackColor = Color.LightGray
|
|
x.ForeColor = Color.Black
|
|
x.ReadOnly = True
|
|
Case "button"
|
|
Dim x As Button = ctl
|
|
x.Enabled = False
|
|
Case "listbox"
|
|
Dim x As Object = ctl
|
|
ctl.enabled = False
|
|
Case "checkedlistbox"
|
|
Dim x As Object = ctl
|
|
ctl.enabled = False
|
|
Case "datetimepicker"
|
|
Dim x As Object = ctl
|
|
ctl.enabled = False
|
|
|
|
Case Else
|
|
End Select
|
|
End Function
|
|
|
|
Private Function Objectanalysis_default(ByRef ctl As Object) As String
|
|
Dim typ As System.Type = ctl.GetType
|
|
Select Case LCase(typ.Name)
|
|
Case "splitcontainer"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmpsplit As SplitContainer = ctl
|
|
For Each ctrl As Object In tmpsplit.Panel1.Controls
|
|
Objectanalysis_default(ctrl)
|
|
Next
|
|
For Each ctrl As Object In tmpsplit.Panel2.Controls
|
|
Objectanalysis_default(ctrl)
|
|
Next
|
|
Case "tabcontrol", "clsmytabcontrol"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabcontrol As TabControl = ctl
|
|
For Each ctl In tmptabcontrol.TabPages
|
|
Objectanalysis_default(ctl)
|
|
Next
|
|
Case "tabpage"
|
|
Dim tmptabpage As TabPage = ctl
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, tmptabpage.Parent.Name, 1))
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis_default(ctl)
|
|
Next
|
|
Case "groupbox"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As GroupBox = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis_default(ctl)
|
|
Next
|
|
Case "panel"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmppanel As Panel = ctl
|
|
For Each ctl In tmppanel.Controls
|
|
Objectanalysis_default(ctl)
|
|
Next
|
|
Case "textbox"
|
|
Dim x As TextBox = ctl
|
|
x.BackColor = Color.White
|
|
x.ForeColor = Color.Black
|
|
x.Enabled = True
|
|
x.ReadOnly = False
|
|
Case "maskedtextbox"
|
|
Dim x As MaskedTextBox = ctl
|
|
x.BackColor = Color.White
|
|
x.ForeColor = Color.Black
|
|
x.Enabled = True
|
|
x.ReadOnly = False
|
|
Case "combobox"
|
|
Dim x As ComboBox = ctl
|
|
x.Enabled = True
|
|
x.BackColor = Color.White
|
|
x.ForeColor = Color.Black
|
|
Case "checkbox"
|
|
Dim x As CheckBox = ctl
|
|
x.Enabled = True
|
|
Case "radiobutton"
|
|
Dim x As RadioButton = ctl
|
|
x.Enabled = True
|
|
Case "comboboxtree"
|
|
Dim x As Object = ctl
|
|
x.enabled = True
|
|
x.BackColor = Color.White
|
|
x.ForeColor = Color.Black
|
|
Case "richtextbox"
|
|
Dim x As Object = ctl
|
|
x.BackColor = Color.White
|
|
x.ForeColor = Color.Black
|
|
x.enabled = True
|
|
Case "button"
|
|
Dim x As Button = ctl
|
|
x.Enabled = True
|
|
Case "listbox"
|
|
Dim x As Object = ctl
|
|
ctl.enabled = True
|
|
Case "checkedlistbox"
|
|
Dim x As Object = ctl
|
|
ctl.enabled = True
|
|
Case "datetimepicker"
|
|
Dim x As Object = ctl
|
|
ctl.enabled = True
|
|
Case Else
|
|
End Select
|
|
End Function
|
|
|
|
|
|
|
|
''' <summary>
|
|
''' Daten ab Datenbank laden
|
|
''' </summary>
|
|
''' <remarks></remarks>
|
|
|
|
Private Sub Load_Data(ByVal Formname As String)
|
|
|
|
db.Get_Tabledata("Security", "", "Select * from Berechtigungen where aktiv=1 and (funktionsstufe='' or funktionsstufe like '%" + Globals.ActUser.ToString + "%')")
|
|
|
|
End Sub
|
|
''' <summary>
|
|
''' Prüft die DB-Einträge mit den Formcontrols und bei Übereinstimmung werden die Security-Einstellungen gesetzt
|
|
''' </summary>
|
|
''' <remarks></remarks>
|
|
Private Sub Set_Security()
|
|
If Globals.UseSecurityObjects = False Then Exit Sub
|
|
Dim i As Integer
|
|
For i = 0 To db.dsDaten.Tables(0).Rows.Count - 1
|
|
Dim SecurityObject As String = db.dsDaten.Tables(0).Rows(i).Item("SecurityObject")
|
|
Dim SecurityObjectitem As String = db.dsDaten.Tables(0).Rows(i).Item("SecurityObjectItem")
|
|
Dim read_only As Boolean = db.dsDaten.Tables(0).Rows(i).Item("readonly")
|
|
Dim invisible As Boolean = db.dsDaten.Tables(0).Rows(i).Item("Ausblenden")
|
|
Dim Bezeichnung As String = db.dsDaten.Tables(0).Rows(i).Item("Bezeichnung")
|
|
Dim ii As Integer
|
|
For ii = 1 To ctlcol.Count
|
|
Dim secobj As MyFormControls = ctlcol(ii)
|
|
If secobj.MySecurityObjectItem = SecurityObjectitem Then
|
|
'secobj.MySecurityObject = SecurityObject And secobj.MySecurityObjectItem = SecurityObjectitem Then
|
|
Set_Preferences(secobj.MyControl, read_only, invisible, SecurityObjectitem, Bezeichnung)
|
|
End If
|
|
Next
|
|
Next
|
|
End Sub
|
|
|
|
''' <summary>
|
|
''' Security-Einstellungen setzen
|
|
''' </summary>
|
|
''' <param name="obj">Betroffenes Objeckt (Menuitem, Conrol usw.)</param>
|
|
''' <param name="read_only">Readonly ja/nein</param>
|
|
''' <param name="invisible">Sichtbar ja/nein</param>
|
|
''' <param name="SecurityObjectItem">Name des Unterobjektes - wird für die Spalteneinstellungen von C1TruedbGrids verwendet</param>
|
|
''' <remarks></remarks>
|
|
Private Sub Set_Preferences(ByRef obj As Object, ByVal read_only As Boolean, ByVal invisible As Boolean, ByVal SecurityObjectItem As String, ByVal bezeichnung As String)
|
|
Dim objtype As System.Type = obj.GetType
|
|
Select Case LCase(objtype.Name)
|
|
Case "button"
|
|
Dim ctl As Button = obj
|
|
If read_only Then ctl.Enabled = False
|
|
If invisible Then
|
|
ctl.Visible = False
|
|
ctl.Enabled = False
|
|
End If
|
|
Try
|
|
If bezeichnung <> "" Then ctl.Text = bezeichnung
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
Case "groupbox"
|
|
Dim ctl As GroupBox = obj
|
|
If read_only Then ctl.Enabled = False
|
|
If invisible = True Then
|
|
ctl.Visible = False
|
|
ctl.Enabled = False
|
|
|
|
End If
|
|
Try
|
|
If bezeichnung <> "" Then ctl.Text = bezeichnung
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
Case "toolstripmenuitem"
|
|
Dim ctl As ToolStripMenuItem = obj
|
|
If read_only Then ctl.Enabled = False
|
|
If invisible Then
|
|
ctl.Visible = False
|
|
ctl.Enabled = False
|
|
End If
|
|
Try
|
|
If bezeichnung <> "" Then ctl.Text = bezeichnung
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
Case "textbox", "label", "combobox", "checkbox", "toolstripbutton", "panel", "datetimepicker", "maskedtextbox", "comboboxtree"
|
|
If read_only Then obj.Enabled = False
|
|
If invisible Then obj.Visible = False
|
|
Case "label"
|
|
Try
|
|
If bezeichnung <> "" Then obj.Text = bezeichnung
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
Case "richtextbox"
|
|
If read_only Then obj.Enabled = False
|
|
Try
|
|
obj.readonly = True
|
|
obj.enabled = True
|
|
Catch ex As Exception
|
|
End Try
|
|
If invisible Then obj.Visible = False
|
|
|
|
|
|
Case "tabpage"
|
|
If invisible Then
|
|
Dim tbp As TabPage = obj
|
|
For Each x As MyFormControls In Me.ctlcol
|
|
If x.MySecurityObject = tbp.Parent.Name Then
|
|
Dim tb As TabControl = x.MyControl
|
|
tb.TabPages.Remove(tbp)
|
|
Exit Sub
|
|
End If
|
|
Next
|
|
End If
|
|
'20100406 - TabPageHandling
|
|
If read_only Then
|
|
'obj.enabled = False
|
|
For Each CTLX As Control In obj.CONTROLS
|
|
Me.Objectanalysis_readonly(CTLX)
|
|
Next
|
|
End If
|
|
Case "c1truedbgrid"
|
|
Dim ctl As C1TrueDBGrid = obj
|
|
If SecurityObjectItem = "" Then
|
|
If read_only Then ctl.Enabled = False
|
|
If invisible Then obj.Visible = False
|
|
Else
|
|
If read_only Then ctl.Splits(0).DisplayColumns(SecurityObjectItem).Locked = True
|
|
If invisible Then ctl.Splits(0).DisplayColumns(SecurityObjectItem).Visible = False
|
|
End If
|
|
|
|
End Select
|
|
End Sub
|
|
|
|
|
|
#Region "Read Objects from Form and save to Database"
|
|
Dim tmpmenuname As String
|
|
|
|
|
|
|
|
|
|
|
|
''' <summary>
|
|
''' Sämtliche Controls vom Formular auslesen
|
|
''' </summary>
|
|
''' <param name="ctl"></param>
|
|
''' <returns></returns>
|
|
''' <remarks></remarks>
|
|
Private Function Objectanalysis(ByRef ctl As Object) As String
|
|
Dim typ As System.Type = ctl.GetType
|
|
Select Case LCase(typ.Name)
|
|
Case "menustrip"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
tmpmenuname = ctl.name
|
|
ReadMenu(ctl)
|
|
Case "contextmenustrip"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
tmpmenuname = ctl.name
|
|
ReadContextMenu(ctl)
|
|
Case "toolstrip"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptoolstrop As ToolStrip = ctl
|
|
Try
|
|
Dim ic As Integer
|
|
For ic = 0 To tmptoolstrop.Items.Count - 1
|
|
Try
|
|
Dim subobj As ToolStripButton
|
|
subobj = tmptoolstrop.Items(ic)
|
|
ctlcol.Add(New MyFormControls(subobj, formname, typ.Name, ctl.Name, subobj.Name, 1))
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
Next
|
|
'For Each subobj As ToolStripButton In tmptoolstrop.Items
|
|
'ctlcol.Add(New MyFormControls(subobj, formname, typ.Name, ctl.Name, subobj.Name, 1))
|
|
'Next
|
|
Catch
|
|
End Try
|
|
Case "splitcontainer"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmpsplit As SplitContainer = ctl
|
|
For Each ctrl As Object In tmpsplit.Panel1.Controls
|
|
Objectanalysis(ctrl)
|
|
Next
|
|
For Each ctrl As Object In tmpsplit.Panel2.Controls
|
|
Objectanalysis(ctrl)
|
|
Next
|
|
Case "tabcontrol", "clsmytabcontrol"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabcontrol As TabControl = ctl
|
|
For Each ctl In tmptabcontrol.TabPages
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "tabpage"
|
|
Dim tmptabpage As TabPage = ctl
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, tmptabpage.Parent.Name, 1))
|
|
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "groupbox"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As GroupBox = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "panel"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmppanel As Panel = ctl
|
|
For Each ctl In tmppanel.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "c1truedbgrid"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim ctrl As C1TrueDBGrid = ctl
|
|
Dim i As Integer
|
|
For i = 0 To ctrl.Columns.Count - 1
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ctrl.Columns(i).Caption, 0, ctrl.Columns(i).Caption))
|
|
Next
|
|
Try
|
|
If ctrl.ContextMenuStrip.Name <> "" Then
|
|
Dim x As ContextMenuStrip = ctrl.ContextMenuStrip
|
|
Objectanalysis(x)
|
|
End If
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
For Each xctl As Object In ctrl.Controls
|
|
Objectanalysis(xctl)
|
|
Next
|
|
Case "treeview"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim ctrl As TreeView = ctl
|
|
Try
|
|
|
|
If ctrl.ContextMenuStrip.Name <> "" Then
|
|
Dim x As ContextMenuStrip = ctrl.ContextMenuStrip
|
|
Objectanalysis(x)
|
|
End If
|
|
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
Case "supertabcontrol"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DevComponents.DotNetBar.SuperTabControl = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "supertabcontrolpanel"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DevComponents.DotNetBar.SuperTabControlPanel = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "patient"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.Patient = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
|
|
Case "patientdetials"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.PatientDetails = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "behandlung"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.Behandlung = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "benhandlungdetail"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.Benhandungdetail = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "finanzen"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.Finanzen = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "krankengeschichte"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.Krankengeschichte = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "leistungen"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.Leistungen = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
Case "patientabrechnung"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.PatientAbrechnung = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
|
|
Case "recall"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.Recall = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
|
|
Case "clsdokumente"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim tmptabpage As DPM2016.clsDokumente = ctl
|
|
For Each ctl In tmptabpage.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
|
|
Case "advtree"
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
Dim ctrl As AdvTree.AdvTree = ctl
|
|
Try
|
|
|
|
If ctrl.ContextMenuStrip.Name <> "" Then
|
|
Dim x As ContextMenuStrip = ctrl.ContextMenuStrip
|
|
Objectanalysis(x)
|
|
End If
|
|
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
|
|
Case Else
|
|
If ctl.name = "TreeStruktur" Then
|
|
End If
|
|
ctlcol.Add(New MyFormControls(ctl, formname, typ.Name, ctl.Name, ""))
|
|
End Select
|
|
End Function
|
|
|
|
''' <summary>
|
|
''' Auslesen von MenuItems
|
|
''' </summary>
|
|
''' <param name="x"></param>
|
|
''' <returns></returns>
|
|
''' <remarks></remarks>
|
|
'''
|
|
Dim level As Integer = 0
|
|
Private Function ReadMenu(ByRef x As Object)
|
|
Dim tmpmnu As MenuStrip = x
|
|
level = 0
|
|
For Each xx As Object In tmpmnu.Items
|
|
Dim objtype As System.Type = xx.GetType
|
|
If LCase(objtype.Name) = "toolstripmenuitem" Then
|
|
ctlcol.Add(New MyFormControls(xx, formname, "menustrip", tmpmenuname, xx.Name, level))
|
|
get_all_menus(xx)
|
|
End If
|
|
Next
|
|
End Function
|
|
''' <summary>
|
|
''' Auslesen von ContextMenuItems
|
|
''' </summary>
|
|
''' <param name="x"></param>
|
|
''' <returns></returns>
|
|
''' <remarks></remarks>
|
|
'''
|
|
|
|
Private Function ReadContextMenu(ByRef x As Object)
|
|
Try
|
|
Dim tmpmnu As ContextMenuStrip = x
|
|
level = 0
|
|
Try
|
|
For Each xx As Object In tmpmnu.Items
|
|
Dim objtype As System.Type = xx.GetType
|
|
If LCase(objtype.Name) = "toolstripmenuitem" Then
|
|
ctlcol.Add(New MyFormControls(xx, formname, "menustrip", tmpmenuname, xx.Name, level))
|
|
get_all_menus(xx)
|
|
End If
|
|
' ctlcol.Add(New MyFormControls(xx, formname, "contextmenustrip", tmpmenuname, xx.Name, level))
|
|
' get_all_menus(xx)
|
|
Next
|
|
Catch ex As Exception
|
|
End Try
|
|
Catch
|
|
End Try
|
|
End Function
|
|
''' <summary>
|
|
''' Auslesen von Menu-Subitems
|
|
''' </summary>
|
|
''' <param name="xx"></param>
|
|
''' <returns></returns>
|
|
''' <remarks></remarks>
|
|
Private Function get_all_menus(ByRef xx As ToolStripMenuItem)
|
|
level = level + 1
|
|
For Each subobj As Object In xx.DropDownItems
|
|
If LCase(subobj.GetType.Name) = "toolstripmenuitem" Then
|
|
ctlcol.Add(New MyFormControls(subobj, formname, "menustrip", tmpmenuname, subobj.Name, level))
|
|
get_all_menus(subobj)
|
|
End If
|
|
Next
|
|
level = level - 1
|
|
End Function
|
|
|
|
|
|
|
|
|
|
#End Region
|
|
|
|
#Region "ScreenDoku"
|
|
|
|
|
|
|
|
|
|
|
|
#Region "check_obsolet"
|
|
Public Function Check_Obsoloet(ByVal f As Object, Optional Classname As String = "", Optional Formularname As String = "")
|
|
Dim s As String = ""
|
|
'Bestehende Daten lesen
|
|
If Classname <> "" Then
|
|
load_form_data(Classname)
|
|
If Formularname = "" Then Formularname = Classname
|
|
Else
|
|
load_form_data(f.Name)
|
|
If Formularname = "" Then Formularname = f.name
|
|
End If
|
|
|
|
'Formular_analyiseren()
|
|
Me.ctlcol.Clear()
|
|
If Classname <> "" Then
|
|
formname = Classname
|
|
Else
|
|
formname = f.Name
|
|
End If
|
|
|
|
For Each ctl As Control In f.Controls
|
|
Objectanalysis(ctl)
|
|
Next
|
|
|
|
s = ""
|
|
Dim i As Integer
|
|
Dim found As Boolean
|
|
For Each r As DataRow In SecurityData.Tables(0).Rows
|
|
found = False
|
|
|
|
For i = 1 To ctlcol.Count
|
|
Dim secobj As MyFormControls = ctlcol(i)
|
|
If secobj.MyFormname = r("securityform") And
|
|
secobj.MySecurityObject = r("SecurityObject") And
|
|
secobj.MySecurityObjectItem = r("Securityobjectitem") And
|
|
secobj.MySecurityObjecttype = r("SecurityObjectType") Then
|
|
found = True
|
|
Exit For
|
|
End If
|
|
Next
|
|
If Not found Then
|
|
If s <> "" Then s = s + vbCrLf
|
|
s = s + "- " + r("securityObject") + "/" + r("Securityobjectitem")
|
|
End If
|
|
Next
|
|
If s <> "" Then s = Formularname + ": Folgende Elemente sind nicht mehr vorhanden:" + vbCrLf + vbCrLf + s Else s = Formularname + ": Alle Objekte werden verwendet."
|
|
MsgBox(s, MsgBoxStyle.Information, Formularname)
|
|
End Function
|
|
|
|
|
|
|
|
Public Sub load_form_data(ByVal formname As String)
|
|
|
|
End Sub
|
|
|
|
|
|
#End Region
|
|
|
|
|
|
#End Region
|
|
|
|
|
|
|
|
''' <summary>
|
|
''' Klasse für ein Control-Objekt
|
|
''' </summary>
|
|
''' <remarks></remarks>
|
|
Public Class MyFormControls
|
|
|
|
Public MyControl As Object
|
|
Public MyFormname As String
|
|
Public MySecurityObjecttype As String
|
|
Public MySecurityObject As String
|
|
Public MySecurityObjectItem As String
|
|
Public MyDescription As String
|
|
Public MyLevel As Integer
|
|
|
|
''' <summary>
|
|
''' Neue Instanz erstellen
|
|
''' </summary>
|
|
''' <param name="ctl">Control-Objekt</param>
|
|
''' <param name="Formname">Betroffenes Formular</param>
|
|
''' <param name="securityobjecttype">Objekttyp</param>
|
|
''' <param name="Securityobject">Objektname</param>
|
|
''' <param name="SecurityObjectItem">Unterobjekt (z.B. bei Menus, Spalten von C1TrueDBGrids)</param>
|
|
''' <remarks></remarks>
|
|
Sub New(ByVal ctl As Object, ByVal Formname As String, ByVal securityobjecttype As String, ByVal Securityobject As String, ByVal SecurityObjectItem As String, Optional ByVal level As Integer = 0, Optional ByVal desc As String = "")
|
|
MyControl = ctl
|
|
MySecurityObjecttype = securityobjecttype
|
|
MyFormname = Formname
|
|
MySecurityObject = Securityobject
|
|
MySecurityObjectItem = SecurityObjectItem
|
|
If desc = "" Then
|
|
MyDescription = Get_Description(ctl)
|
|
Else
|
|
MyDescription = desc
|
|
End If
|
|
Try
|
|
MyDescription = MyDescription.Replace("&", "")
|
|
Catch ex As Exception
|
|
End Try
|
|
MyLevel = level
|
|
End Sub
|
|
|
|
Private Function Get_Description(ByRef ctl As Object) As String
|
|
Dim typ As System.Type = ctl.GetType
|
|
Select Case LCase(typ.Name)
|
|
Case "menustrip", "toolstripmenuitem", "toolstrip", "toolstripbutton", "contextmenustrip", "tabpage", "c1truedbgrid", "label"
|
|
Return ctl.Text
|
|
Case Else
|
|
Return ctl.Name
|
|
End Select
|
|
|
|
End Function
|
|
|
|
Public Function write_to_text() As String
|
|
Dim s As String
|
|
Dim db As New clsDB
|
|
db.Get_Tabledata("Berechtigungen", "", "Select * from berechtigungen where eintragnr=-1")
|
|
'formular='" + MyFormname + "' and objekt='" + MySecurityObject + "'")
|
|
If db.dsDaten.Tables(0).Rows.Count = 0 Then
|
|
Dim r As DataRow = db.dsDaten.Tables(0).NewRow
|
|
r(1) = 1
|
|
r(2) = MySecurityObjecttype
|
|
r(3) = MyFormname
|
|
r(4) = MySecurityObject
|
|
r(5) = MySecurityObjectItem
|
|
r(6) = MyDescription
|
|
r(7) = MyLevel
|
|
r(8) = False
|
|
r(9) = False
|
|
r(10) = ""
|
|
r(11) = Now
|
|
r(12) = Now
|
|
r(13) = 1
|
|
r(14) = 1
|
|
db.dsDaten.Tables(0).Rows.Add(r)
|
|
db.Update_Data()
|
|
db = Nothing
|
|
End If
|
|
|
|
's = MyFormname + ";" + Me.MySecurityObjecttype + ";" + Me.MySecurityObject + ";" + Me.MySecurityObjectItem
|
|
Return s
|
|
End Function
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
End Class
|
|
|
|
Public Class ControlsCollection
|
|
Private Shared m_controls As Collection
|
|
Dim m_strings As String
|
|
Property ObjStrings As String
|
|
Get
|
|
Return m_strings
|
|
End Get
|
|
Set(value As String)
|
|
m_strings = value
|
|
End Set
|
|
End Property
|
|
|
|
Public Sub New(ByVal myForm As Form, ByRef ctlcol As Collection)
|
|
m_controls = New Collection
|
|
'create a control walker to get
|
|
'all controls on the form
|
|
Dim aControlWalker As New ControlWalker(myForm)
|
|
Dim s As String
|
|
For i = 1 To m_controls.Count
|
|
Dim xtyp As System.Type = m_controls(i).GetType
|
|
Dim name As String = m_controls(i).name
|
|
Dim parent As String = ""
|
|
Try
|
|
parent = m_controls(i).parent.name
|
|
Catch ex As Exception
|
|
parent = ""
|
|
End Try
|
|
|
|
ctlcol.Add(New MyFormControls(m_controls(i), myForm.Name, xtyp.ToString, name, parent))
|
|
|
|
Next
|
|
Me.ObjStrings = s
|
|
End Sub
|
|
|
|
|
|
'This property returns the collection of all controls
|
|
'on the form
|
|
ReadOnly Property Controls() As Collection
|
|
Get
|
|
Return m_controls
|
|
End Get
|
|
End Property
|
|
|
|
Public Function FindControl(ByVal ctlname As String) As Boolean
|
|
Dim i As Integer
|
|
For i = 1 To Me.m_controls.Count
|
|
Dim ctl As Control = m_controls(i)
|
|
If UCase(ctl.Name) = UCase(ctlname) Then MsgBox("found")
|
|
Next
|
|
End Function
|
|
Private Class ControlWalker
|
|
' This class recursively walks through all controls
|
|
' in a container, and all containers contained in
|
|
' this container, visiting all controls throughout
|
|
' the hierarchy
|
|
Private mContainer As Object
|
|
Public Sub New(ByVal Container As Object)
|
|
|
|
Dim cControl As Control
|
|
If Container.haschildren Then
|
|
For Each cControl In Container.controls
|
|
'add this control to the controls collection
|
|
m_controls.Add(cControl)
|
|
If cControl.HasChildren Then
|
|
'This control has children, create another
|
|
'ControlWalk go visit each of them
|
|
Dim cWalker As New ControlWalker(cControl)
|
|
End If
|
|
Next cControl
|
|
End If
|
|
End Sub
|
|
|
|
|
|
End Class
|
|
End Class
|
|
|
|
End Class
|