|
|
Imports C1.Win.C1TrueDBGrid
|
|
|
Imports System
|
|
|
Imports System.Data
|
|
|
Imports System.Data.SqlTypes
|
|
|
Imports System.Data.SqlClient
|
|
|
Namespace TKB.VV.Utils
|
|
|
''' <summary>
|
|
|
''' Formular-Security-Objekte auslesen und auf DB schreiben bzw. Formular-Security zur Laufzeit setzen
|
|
|
''' </summary>
|
|
|
''' <remarks></remarks>
|
|
|
|
|
|
Public Class MySecurity
|
|
|
Dim tt As New TKB.VV.Utils.clsToolTips
|
|
|
Dim SecurityData As DataSet = Globals.SecurityDaten
|
|
|
Dim connection As New SqlConnection()
|
|
|
Dim da As New SqlDataAdapter("", connection)
|
|
|
|
|
|
Dim IntForm As Object
|
|
|
Dim ctlcol As New Collection
|
|
|
Dim formname As String = ""
|
|
|
|
|
|
|
|
|
|
|
|
''' <summary>
|
|
|
''' Formularsecurity setzen
|
|
|
''' </summary>
|
|
|
''' <param name="f">Aktuelles Formular</param>
|
|
|
''' <returns></returns>
|
|
|
''' <remarks></remarks>
|
|
|
Public Function Set_Form_Security(ByRef f As Form)
|
|
|
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()
|
|
|
If Globals.Set_ToolTips = True Then
|
|
|
tt.Edit_Tooltips(f, ctlcol)
|
|
|
Else
|
|
|
tt.Set_ToolTips(f)
|
|
|
End If
|
|
|
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()
|
|
|
If Globals.Set_ToolTips = True Then
|
|
|
tt.Edit_ToolTips(f, ctlcol)
|
|
|
Else
|
|
|
'tt.Set_ToolTips(f)
|
|
|
End If
|
|
|
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
|
|
|
Case "maskedtextbox"
|
|
|
Dim x As MaskedTextBox = ctl
|
|
|
x.BackColor = Color.White
|
|
|
x.ForeColor = Color.Black
|
|
|
x.Enabled = True
|
|
|
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.readonly = 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)
|
|
|
Try
|
|
|
'xxx
|
|
|
If SecurityData.Tables.Count > 0 Then
|
|
|
SecurityData.Tables.Clear()
|
|
|
End If
|
|
|
' Exit Sub
|
|
|
Catch ex As Exception
|
|
|
End Try
|
|
|
SecurityData.Tables.Clear()
|
|
|
Dim sqlcmd As New SqlCommand
|
|
|
|
|
|
sqlcmd.CommandText = "dbo.my_security_get_data"
|
|
|
sqlcmd.Parameters.Add("@FormName", SqlDbType.VarChar, 255)
|
|
|
sqlcmd.Parameters.Add("@Mitarbeiternr", SqlDbType.Int, 4)
|
|
|
sqlcmd.Parameters(0).Value = Formname
|
|
|
sqlcmd.Parameters(1).Value = Globals.clsmitarbeiter.iMitarbeiternr.Value
|
|
|
|
|
|
sqlcmd.CommandType = CommandType.StoredProcedure
|
|
|
sqlcmd.Connection = connection
|
|
|
Try
|
|
|
connection.ConnectionString = Globals.sConnectionString
|
|
|
connection.Open()
|
|
|
da.SelectCommand = sqlcmd
|
|
|
da.Fill(SecurityData, "SecurityTable")
|
|
|
Globals.SecurityDaten.Tables.Add(SecurityData.Tables(0).Copy)
|
|
|
Catch ex As Exception
|
|
|
' MsgBox(ex.Message)
|
|
|
Finally
|
|
|
connection.Close()
|
|
|
da.Dispose()
|
|
|
sqlcmd.Dispose()
|
|
|
End Try
|
|
|
End Sub
|
|
|
''' <summary>
|
|
|
''' Pr<50>ft die DB-Eintr<74>ge mit den Formcontrols und bei <20>bereinstimmung werden die Security-Einstellungen gesetzt
|
|
|
''' </summary>
|
|
|
''' <remarks></remarks>
|
|
|
Private Sub Set_Security()
|
|
|
Dim i As Integer
|
|
|
For i = 0 To Me.SecurityData.Tables(0).Rows.Count - 1
|
|
|
Dim SecurityObject As String = Me.SecurityData.Tables(0).Rows(i).Item("SecurityObject")
|
|
|
Dim SecurityObjectitem As String = Me.SecurityData.Tables(0).Rows(i).Item("SecurityObjectItem")
|
|
|
Dim read_only As Boolean = Me.SecurityData.Tables(0).Rows(i).Item("readonly")
|
|
|
Dim invisible As Boolean = Me.SecurityData.Tables(0).Rows(i).Item("invisible")
|
|
|
Dim ii As Integer
|
|
|
For ii = 1 To ctlcol.Count
|
|
|
Dim secobj As MyFormControls = ctlcol(ii)
|
|
|
If secobj.MySecurityObject = SecurityObject And secobj.MySecurityObjectItem = SecurityObjectitem Then
|
|
|
Set_Preferences(secobj.MyControl, read_only, invisible, SecurityObjectitem)
|
|
|
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)
|
|
|
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
|
|
|
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
|
|
|
|
|
|
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
|
|
|
Case "textbox", "label", "combobox", "checkbox", "toolstripbutton", "panel", "datetimepicker", "maskedtextbox", "comboboxtree"
|
|
|
If read_only Then obj.Enabled = False
|
|
|
If invisible Then obj.Visible = False
|
|
|
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>
|
|
|
''' Alle Controls des Formulars zusammensuchen und auf der DB speichern
|
|
|
''' </summary>
|
|
|
''' <param name="f">Betroffenes Formular</param>
|
|
|
''' <returns></returns>
|
|
|
''' <remarks></remarks>
|
|
|
'''
|
|
|
Public Function List_Class_Controls(ByRef f As Object, ByVal FName As String)
|
|
|
Me.ctlcol.Clear()
|
|
|
formname = FName
|
|
|
For Each ctl As Control In f.Controls
|
|
|
Objectanalysis(ctl)
|
|
|
Next
|
|
|
Dim i As Integer
|
|
|
For i = 1 To ctlcol.Count
|
|
|
Dim secobj As MyFormControls = ctlcol(i)
|
|
|
secobj.Write_Object_to_DB()
|
|
|
' secobj.Write_Object_to_DB("Personal")
|
|
|
Next
|
|
|
End Function
|
|
|
|
|
|
Public Function List_Form_Controls(ByRef f As Form)
|
|
|
Me.ctlcol.Clear()
|
|
|
formname = f.Name
|
|
|
For Each ctl As Control In f.Controls
|
|
|
Objectanalysis(ctl)
|
|
|
Next
|
|
|
Dim i As Integer
|
|
|
For i = 1 To ctlcol.Count
|
|
|
Dim secobj As MyFormControls = ctlcol(i)
|
|
|
secobj.Write_Object_to_DB()
|
|
|
Next
|
|
|
End Function
|
|
|
|
|
|
''' <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 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)
|
|
|
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
|
|
|
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
|
|
|
|
|
|
|
|
|
|
|
|
''' <summary>
|
|
|
''' Pr<50>ft, ob das Security-Objekt bereits auf der DB vorhanden ist
|
|
|
''' </summary>
|
|
|
''' <param name="securityform">Formular</param>
|
|
|
''' <param name="securityobjecttype">Objekttyp</param>
|
|
|
''' <param name="securityobject">Objektname</param>
|
|
|
''' <param name="securityobjectitem">Objektitem</param>
|
|
|
''' <returns></returns>
|
|
|
''' <remarks></remarks>
|
|
|
Private Function Objexists(ByVal securityform As String, ByVal securityobjecttype As String, ByVal securityobject As String, ByVal securityobjectitem As String) As Boolean
|
|
|
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
|
|
scmCmdToExecute.CommandText = "dbo.[my_security_check_entry]"
|
|
|
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
|
|
scmCmdToExecute.Connection = conn.scoDBConnection
|
|
|
Try
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@form", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, securityform))
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@objecttype", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, securityobjecttype))
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@object", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, securityobject))
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@objectitem", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, securityobjectitem))
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@objexists", SqlDbType.Int, 4, ParameterDirection.Output, True, 0, 0, "", DataRowVersion.Proposed, 0))
|
|
|
scmCmdToExecute.Connection.Open()
|
|
|
scmCmdToExecute.ExecuteNonQuery()
|
|
|
If scmCmdToExecute.Parameters("@objexists").Value > 0 Then
|
|
|
Return True
|
|
|
Else
|
|
|
Return False
|
|
|
End If
|
|
|
Catch ex As Exception
|
|
|
Finally
|
|
|
scmCmdToExecute.Connection.Close()
|
|
|
End Try
|
|
|
End Function
|
|
|
|
|
|
#End Region
|
|
|
|
|
|
#Region "ScreenDoku"
|
|
|
|
|
|
Public Function Print_Screen(ByRef ctl As Control)
|
|
|
saveasbitmap(ctl, ctl.Name)
|
|
|
End Function
|
|
|
Public Function Generate_HTML()
|
|
|
saveasbitmap(Me.IntForm, "testform")
|
|
|
'Exit Function
|
|
|
'Dim x As MyFormControls
|
|
|
'For Each x In ctlcol
|
|
|
' Try
|
|
|
' saveasbitmap(x.MyControl, x.MyFormname & "_" & x.MySecurityObject & "_" & x.MySecurityObjectItem)
|
|
|
' If x.MySecurityObjecttype = "ToolStrip" And x.MySecurityObjectItem = "" Then
|
|
|
' Dim gaga As ToolStrip = x.MyControl
|
|
|
' For Each c As ToolStripButton In gaga.Items
|
|
|
' Dim xxx As Control = CType(c, Control)
|
|
|
|
|
|
' xxx = CType(c, Control)
|
|
|
' saveasbitmap(xxx, "xxx")
|
|
|
' Next
|
|
|
' End If
|
|
|
' Catch ex As Exception
|
|
|
' MsgBox(ex.Message)
|
|
|
' End Try
|
|
|
'Next
|
|
|
End Function
|
|
|
|
|
|
Public Function saveasbitmap(ByRef ctl As Control, ByVal filename As String)
|
|
|
Dim g As Graphics = ctl.CreateGraphics
|
|
|
Dim b As New Bitmap(ctl.Width, ctl.Height)
|
|
|
ctl.DrawToBitmap(b, New Rectangle(0, 0, ctl.Width, ctl.Height))
|
|
|
'b.Save(Globals.clsapplication.sTmp_filepath.ToString + "\" & filename & ".jpg", System.Drawing.Imaging.ImageFormat.Jpeg)
|
|
|
'b.Save("E:\Software-Projekte\Vertragsverwaltung\Screens\" & filename & ".jpg", System.Drawing.Imaging.ImageFormat.Jpeg)
|
|
|
End Function
|
|
|
|
|
|
|
|
|
#End Region
|
|
|
|
|
|
|
|
|
End Class
|
|
|
''' <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
|
|
|
|
|
|
''' <summary>
|
|
|
''' Schreibt einen Datnsatz in die Tabelle SecurityObjects
|
|
|
''' </summary>
|
|
|
''' <returns></returns>
|
|
|
''' <remarks></remarks>
|
|
|
Public Function Write_Object_to_DB()
|
|
|
If Objexists() Then Exit Function
|
|
|
Dim sectbl As New TKB.VV.DB.clsSecurityObject
|
|
|
Dim dbkey As New TKB.VV.DB.clsMyKey_Tabelle
|
|
|
dbkey.cpMainConnectionProvider = Globals.conn
|
|
|
Dim newkey As Integer = dbkey.get_dbkey("SecurityObject")
|
|
|
|
|
|
sectbl.cpMainConnectionProvider = Globals.conn
|
|
|
conn.OpenConnection()
|
|
|
sectbl.iSecurityObjectNr = New SqlInt32(CType(newkey, Int32))
|
|
|
sectbl.sSecurityForm = New SqlString(CType(MyFormname, String))
|
|
|
sectbl.sSecurityObjectType = New SqlString(CType(Me.MySecurityObjecttype, String))
|
|
|
sectbl.sSecurityObject = New SqlString(CType(Me.MySecurityObject, String))
|
|
|
sectbl.sSecurityObjectItem = New SqlString(CType(Me.MySecurityObjectItem, String))
|
|
|
sectbl.bAktiv = New SqlBoolean(CType(True, Boolean))
|
|
|
sectbl.daErstellt_am = New SqlDateTime(CType(Now, DateTime))
|
|
|
sectbl.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
|
|
|
sectbl.sSecurityObjectDescriotion = New SqlString(CType(Me.MyDescription, String))
|
|
|
sectbl.iLevel = New SqlInt32(CType(Me.MyLevel, Int32))
|
|
|
sectbl.iMutierer = New SqlInt32(CType(Globals.clsmitarbeiter.iMitarbeiternr.Value, Int32))
|
|
|
sectbl.iMandantnr = New SqlInt32(CType(Globals.clsmitarbeiter.iMandantnr.Value, Int32))
|
|
|
sectbl.Insert()
|
|
|
conn.CloseConnection(True)
|
|
|
sectbl.Dispose()
|
|
|
dbkey.Dispose()
|
|
|
End Function
|
|
|
|
|
|
|
|
|
''' <summary>
|
|
|
'''Pr<50>ft, ob das Security-Objekt bereits auf der DB vorhanden ist
|
|
|
''' </summary>
|
|
|
''' <returns></returns>
|
|
|
''' <remarks></remarks>
|
|
|
Private Function Objexists() As Boolean
|
|
|
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
|
|
scmCmdToExecute.CommandText = "dbo.[my_security_check_entry]"
|
|
|
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
|
|
scmCmdToExecute.Connection = conn.scoDBConnection
|
|
|
Try
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@form", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, Me.MyFormname))
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@objecttype", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, Me.MySecurityObjecttype))
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@object", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, Me.MySecurityObject))
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@objectitem", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 0, 0, "", DataRowVersion.Proposed, Me.MySecurityObjectItem))
|
|
|
scmCmdToExecute.Parameters.Add(New SqlParameter("@objexists", SqlDbType.Int, 4, ParameterDirection.Output, True, 0, 0, "", DataRowVersion.Proposed, 0))
|
|
|
scmCmdToExecute.Connection.Open()
|
|
|
scmCmdToExecute.ExecuteNonQuery()
|
|
|
If scmCmdToExecute.Parameters("@objexists").Value > 0 Then
|
|
|
Return True
|
|
|
Else
|
|
|
Return False
|
|
|
End If
|
|
|
Catch ex As Exception
|
|
|
Finally
|
|
|
scmCmdToExecute.Connection.Close()
|
|
|
End Try
|
|
|
End Function
|
|
|
|
|
|
|
|
|
End Class
|
|
|
|
|
|
Public Class ControlsCollection
|
|
|
Private Shared m_controls As Collection
|
|
|
Public Sub New(ByVal myForm As Form)
|
|
|
m_controls = New Collection
|
|
|
'create a control walker to get
|
|
|
'all controls on the form
|
|
|
Dim aControlWalker As New ControlWalker(myForm)
|
|
|
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 Namespace
|
