Initial commit

This commit is contained in:
2020-10-21 10:44:38 +02:00
commit 039adbbadf
1125 changed files with 854026 additions and 0 deletions

View File

@@ -0,0 +1,37 @@
Public Class FilterClass
Dim m_columname As String
Dim m_filtervalue As String
Property Columname() As String
Get
Return m_columname
End Get
Set(ByVal value As String)
m_columname = value
End Set
End Property
Property FilterValue() As String
Get
Return m_filtervalue
End Get
Set(ByVal value As String)
m_filtervalue = value
End Set
End Property
Sub New(ByVal columname As String, ByVal filtervalue As String)
MyBase.New()
Me.Columname = columname
Me.FilterValue = filtervalue
End Sub
Sub New()
MyBase.New()
End Sub
Public Sub add(ByVal columname As String, ByVal filtervalue As String)
Me.Columname = columname
Me.FilterValue = filtervalue
End Sub
End Class

View File

@@ -0,0 +1,427 @@
Imports C1.Win.C1TrueDBGrid
Imports System
Imports System.IO
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports System.Diagnostics
''' <summary>
''' Namesace TKB.VV.Utils fasst die Utility-Klassen für die Vertragsverwaltung
''' zusammen.
''' </summary>
''' <includesource>yes</includesource>
''' <seealso cref="T:Vertragsverwaltung.TKB.VV.Utils.clsMyTabControl"></seealso>
''' <seealso cref="T:Vertragsverwaltung.TKB.VV.Utils.clsProfile"></seealso>
''' <seealso cref="T:Vertragsverwaltung.TKB.VV.Utils.MyDocMgmt"></seealso>
''' <seealso cref="T:Vertragsverwaltung.TKB.VV.Utils.MyFormControls"></seealso>
''' <seealso cref="T:Vertragsverwaltung.TKB.VV.Utils.MyMessage"></seealso>
''' <seealso cref="T:Vertragsverwaltung.TKB.VV.Utils.MySecurity"></seealso>
''' <seealso cref="T:Vertragsverwaltung.TKB.VV.Utils.MySpaltenTitel"></seealso>
''' <seealso cref="T:Vertragsverwaltung.TKB.VV.Utils.Tabellenspalte"></seealso>
Namespace TKB.VV.Utils
''' <summary>
''' Klasse für das Speichern bzw. Auslesen von Image-Dateien in der Datenbank
''' </summary>
''' <remarks>
''' Es werden folgende Datebanktabellen berücksichtigt:
''' <list type="bullet">
''' <item>
''' <description>Dokument Attribut DocImage</description></item>
''' <item>
''' <description>Profile Attribut V_Uebersicht (Profillayout des C1TrueDBGrids der
''' Vertragsübersicht|Vertragselemente</description></item></list>
''' </remarks>
''' <includesource>yes</includesource>
Public Class MyDocMgmt
''' <summary>
''' Grid-Layoutfile speichern
''' </summary>
''' <param name="c1data">C1Truedbgrind, von welchem das Layout gespeichert werden soll</param>
''' <param name="GriddNo">Nummer des Grids: 1=Vertragsübersicht...</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Save_LayoutFile(ByRef c1data As C1TrueDBGrid, ByVal GridNo As Integer, ByVal Profilnr As Integer) As Boolean
Dim filename As String = Globals.clsapplication.sTmp_filepath + Trim(Str(Profilnr)) + Trim(Str(GridNo)) + ".lyt"
c1data.SaveLayout(filename)
Dim Connection As New SqlConnection()
Dim DA As New SqlDataAdapter("select * from profil where profilnr = " & Str(Profilnr), Connection)
'mitarbeiternr=" + Str(Globals.clsmitarbeiter.iMitarbeiternr.Value)
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
Dim ds As New DataSet()
Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read)
Dim mydata(fs.Length) As Byte
fs.Read(mydata, 0, fs.Length)
fs.Close()
Try
Connection.ConnectionString = Globals.sConnectionString
Connection.Open()
DA.Fill(ds, "profil")
Dim myRow As DataRow
If ds.Tables(0).Rows.Count = 0 Then
' Neues Profil sepeichern
myRow = ds.Tables(0).NewRow
myRow.Item(1) = Globals.clsmitarbeiter.iMitarbeiternr.Value
myRow.Item(2) = ""
Select Case GridNo
Case 1
myRow.Item(3) = mydata
End Select
ds.Tables(0).Rows.Add(myRow)
DA.Update(ds, "profil")
Else
myRow = ds.Tables(0).Rows(0)
Select Case GridNo
Case 1
myRow.Item(3) = mydata
End Select
DA.Update(ds, "profil")
End If
Catch ex As Exception
MsgBox(ex.Message)
Return False
End Try
fs = Nothing
cb = Nothing
ds = Nothing
DA = Nothing
Connection.Close()
Connection = Nothing
Return True
End Function
Private Function Get_Layoutfile_from_db(ByVal filename As String, ByVal GridNo As Integer, ByVal Profilnr As Integer) As Boolean
'Exit Function
Dim connection As New SqlConnection()
Dim da As New SqlDataAdapter("Select * From profil where profilnr=" & Str(Profilnr), connection)
'mitarbeiternr=" + Str(Globals.clsmitarbeiter.iMitarbeiternr.Value)
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
Dim ds As New DataSet()
Try
connection.ConnectionString = Globals.sConnectionString
connection.Open()
da.Fill(ds, "docs")
Dim myRow As DataRow
myRow = ds.Tables(0).Rows(0)
Dim MyData() As Byte
Select Case GridNo
Case 1
MyData = myRow.Item(3)
End Select
Dim K As Long
K = UBound(MyData)
Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Write)
fs.Write(MyData, 0, K)
fs.Close()
fs = Nothing
Return True
Catch ex As Exception
Return False
End Try
CB = Nothing
ds = Nothing
da = Nothing
connection.Close()
connection = Nothing
Return True
End Function
Public Function Get_Layout(ByRef c1data As C1TrueDBGrid, ByVal GridNo As Integer, ByVal Profilnr As Integer) As Boolean
Dim filename As String = Globals.clsapplication.sTmp_filepath + Trim(Str(Profilnr)) + Trim(Str(GridNo)) + ".lyt"
If File.Exists(filename) Then
c1data.LoadLayout(filename)
Return True
End If
If Get_Layoutfile_from_db(filename, GridNo, Profilnr) Then
c1data.LoadLayout(filename)
Return True
End If
Return False
End Function
''' <summary>
''' Dokument in der Tabelle Dokument speichern
''' </summary>
''' <param name="Dokumentnr">Nummer des Dokument-Datensatzes</param>
''' <param name="Filename">Zu speichender Dateiname</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Save_Document(ByVal Dokumentnr As Integer, ByVal Filename As String) As Boolean
Dim Connection As New SqlConnection()
Dim DA As New SqlDataAdapter("select * from dokument where dokumentnr =" + Str(dokumentnr), Connection)
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
Dim ds As New DataSet()
Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read)
Dim mydata(fs.Length) As Byte
fs.Read(mydata, 0, fs.Length)
fs.Close()
Try
Connection.ConnectionString = Globals.sConnectionString
Connection.Open()
DA.Fill(ds, "Dokument")
Dim myRow As DataRow
If ds.Tables(0).Rows.Count = 0 Then
Return False
Else
myRow = ds.Tables(0).Rows(0)
myRow.Item(16) = mydata
DA.Update(ds, "Dokument")
End If
Catch ex As Exception
MsgBox(ex.Message)
Return False
End Try
fs = Nothing
cb = Nothing
ds = Nothing
DA = Nothing
Connection.Close()
Connection = Nothing
Return True
End Function
''' <summary>
''' Liest das Dokument aus der DB und speichert dieses unter einem temporären Filenamen ab
''' </summary>
''' <param name="DokumentNr"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Get_Dokument(ByVal DokumentNr As Integer) As String
Dim Filename As String = Globals.clsapplication.sTmp_filepath
If Right(Filename, 1) <> "\" Then Filename = Filename + "\"
Dim connection As New SqlConnection()
Dim da As New SqlDataAdapter("Select * From Dokument where DokumentNr=" + Str(DokumentNr), connection)
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
Dim ds As New DataSet()
Try
connection.ConnectionString = Globals.sConnectionString
connection.Open()
da.Fill(ds, "Dokument")
Dim myRow As DataRow
myRow = ds.Tables(0).Rows(0)
Dim MyData() As Byte
MyData = myRow.Item(16)
Dim K As Long
K = UBound(MyData)
Filename = Filename + myRow.Item(6)
Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write)
fs.Write(MyData, 0, K)
fs.Close()
fs = Nothing
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical)
Return ""
Finally
connection.Close()
connection = Nothing
End Try
CB = Nothing
ds = Nothing
da = Nothing
Return Filename
End Function
Public Function Show_Document(ByVal Dokumentnr As Integer) As Boolean
Dim tmpfilename As String = Me.Get_Dokument(Dokumentnr)
If tmpfilename <> "" Then
OpenSystemFile(tmpfilename)
Return True
End If
Return False
End Function
Public Function OpenSystemFile(ByVal sFileName As String) As Boolean
If Len(sFileName) > 0 Then
System.Diagnostics.Process.Start(sFileName)
'
' ShellExecute(GetDesktopWindow(), vbNullString, sFileName, vbNullString, vbNullString, vbNormalFocus)
Return True
End If
End Function
Public Function Save_RptDatei(ByVal Auswertungnr As Integer, ByVal AuswertungName As String) As String
Dim filename As String = AuswertungName
Dim Connection As New SqlConnection()
Dim DA As New SqlDataAdapter("select * from AuswertungRptDatei where AuswertungDateiNr = " & Str(Auswertungnr), Connection)
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
Dim ds As New DataSet()
Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read)
Dim mydata(fs.Length) As Byte
fs.Read(mydata, 0, fs.Length)
fs.Close()
Try
Connection.ConnectionString = Globals.sConnectionString
Connection.Open()
DA.Fill(ds, "RptFile")
Dim myRow As DataRow
If ds.Tables(0).Rows.Count = 0 Then
' Neues Datei speichern
myRow = ds.Tables(0).NewRow
myRow.Item(0) = Auswertungnr
myRow.Item(1) = AuswertungName
myRow.Item(2) = RptName(AuswertungName)
myRow.Item(3) = mydata
myRow.Item(4) = Now
myRow.Item(5) = Now
myRow.Item(6) = Globals.clsmitarbeiter.iMitarbeiternr.Value
ds.Tables(0).Rows.Add(myRow)
DA.Update(ds, "RptFile")
Else
myRow = ds.Tables(0).Rows(0)
myRow.Item(1) = AuswertungName
myRow.Item(2) = RptName(AuswertungName)
myRow.Item(3) = mydata
myRow.Item(5) = Now
myRow.Item(6) = Globals.clsmitarbeiter.iMitarbeiternr.Value
DA.Update(ds, "RptFile")
End If
Catch ex As Exception
MsgBox(ex.Message)
Return False
End Try
fs = Nothing
cb = Nothing
ds = Nothing
DA = Nothing
Connection.Close()
Connection = Nothing
Return RptName(AuswertungName)
End Function
Public Function RptName(ByVal path As String) As String
Dim i As Integer
Dim file As String = path
i = InStrRev(file.Trim, "\")
If i = 0 Then
Return file.Trim
Else
Return Right(file.Trim, Len(file.Trim) - i)
End If
End Function
Public Function Get_RptDatei(ByVal Auswertungnr As String, Optional ByVal fname As String = "") As String
Dim connection As New SqlConnection()
Dim DA As New SqlDataAdapter("select * from AuswertungRptDatei where AuswertungDateiNr = " & Str(Auswertungnr), connection)
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(DA)
Dim ds As New DataSet()
Dim Filename As String = ""
Try
connection.ConnectionString = Globals.sConnectionString
connection.Open()
DA.Fill(ds, "RptFile")
Dim myRow As DataRow
myRow = ds.Tables(0).Rows(0)
Dim MyData() As Byte
Filename = Globals.clsapplication.sTmp_filepath + "\" + myRow.Item(2).ToString
If fname <> "" Then
Filename = fname
End If
MyData = myRow.Item(3)
Dim K As Long
K = UBound(MyData)
Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write)
fs.Write(MyData, 0, K)
fs.Close()
fs = Nothing
Catch ex As Exception
Return ""
End Try
CB = Nothing
ds = Nothing
DA = Nothing
connection.Close()
connection = Nothing
Return filename
End Function
Public Function Save_Architekturfile(ByVal Applikationnr As Integer, ByVal iFilename As String)
Dim filename As String = iFilename
Dim Connection As New SqlConnection()
Dim DA As New SqlDataAdapter("select * from ApplikationArchitektur where applikationnr = " & Str(Applikationnr), Connection)
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
Dim ds As New DataSet()
Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read)
Dim mydata(fs.Length) As Byte
fs.Read(mydata, 0, fs.Length)
fs.Close()
Try
Connection.ConnectionString = Globals.sConnectionString
Connection.Open()
DA.Fill(ds, "RptFile")
Dim myRow As DataRow
If ds.Tables(0).Rows.Count = 0 Then
' Neues Datei speichern
myRow = ds.Tables(0).NewRow
myRow.Item(0) = Applikationnr
myRow.Item(1) = mydata
' myRow.Item(4) = Now
' myRow.Item(5) = Now
' myRow.Item(6) = Globals.clsmitarbeiter.iMitarbeiternr.Value
ds.Tables(0).Rows.Add(myRow)
DA.Update(ds, "RptFile")
Else
myRow = ds.Tables(0).Rows(0)
myRow.Item(1) = mydata
' myRow.Item(2) = RptName(AuswertungName)
' myRow.Item(3) = mydata
' myRow.Item(5) = Now
' myRow.Item(6) = Globals.clsmitarbeiter.iMitarbeiternr.Value
DA.Update(ds, "RptFile")
End If
Catch ex As Exception
MsgBox(ex.Message)
Return False
End Try
fs = Nothing
cb = Nothing
ds = Nothing
DA = Nothing
Connection.Close()
Connection = Nothing
End Function
Public Function Get_Architekturfile(ByVal Applikationnr As String, Optional ByVal fname As String = "") As String
Dim connection As New SqlConnection()
Dim DA As New SqlDataAdapter("select * from ApplikationArchitektur where applikationnr = " & Str(Applikationnr), connection)
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(DA)
Dim ds As New DataSet()
Dim Filename As String = ""
Try
connection.ConnectionString = Globals.sConnectionString
connection.Open()
DA.Fill(ds, "RptFile")
Dim myRow As DataRow
myRow = ds.Tables(0).Rows(0)
Dim MyData() As Byte
Filename = Globals.clsapplication.sTmp_filepath + "\architekturfile.xml"
If fname <> "" Then
Filename = fname
End If
MyData = myRow.Item(1)
Dim K As Long
K = UBound(MyData)
Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write)
fs.Write(MyData, 0, K)
fs.Close()
fs = Nothing
Catch ex As Exception
Return ""
End Try
CB = Nothing
ds = Nothing
DA = Nothing
connection.Close()
connection = Nothing
Return Filename
End Function
End Class
End Namespace

View File

@@ -0,0 +1,39 @@
Public Class MyGenericEventHandler
Public Event Set_ToolTip(ByVal formname As String, ByVal ctlname As String)
Public Event Pruefplandetail_Saved(ByVal handler As Integer, ByVal key As Integer)
Public Event Pruefplandetail_Closed(ByVal handler As Integer, ByVal key As Integer)
Public Event Pruefschrittresultat_saved(ByVal handler As Integer, ByVal key As Integer)
Public Event pruefschrittresultat_closed(ByVal handler As Integer, ByVal key As Integer)
Public Event MassnahmeplanDetail_Saveed(ByVal handler As Integer, ByVal key As Integer)
Public Event MassnahmeplanDetail_Closed(ByVal handler As Integer, ByVal key As Integer)
Public Function Pruefplandetails_save(ByVal handler As Integer, key As Integer)
RaiseEvent Pruefplandetail_Saved(handler, key)
End Function
Public Function Pruefplandetail_close(ByVal handler As Integer, key As Integer)
RaiseEvent Pruefplandetail_closed(handler, key)
End Function
Public Function Edit_Tooltip(ByVal formname As String, ByVal ctlname As String)
RaiseEvent Set_ToolTip(formname, ctlname)
End Function
Public Function PruefplanResultat_Save(ByVal handler As Integer, ByVal key As Integer)
RaiseEvent Pruefschrittresultat_saved(handler, key)
End Function
Public Function pruefschrittResultat_Close(ByVal handler As Integer, ByVal key As Integer)
RaiseEvent pruefschrittresultat_closed(handler, key)
End Function
Public Function massnahmeplandetail_save(ByVal handler As Integer, ByVal key As Integer)
RaiseEvent MassnahmeplanDetail_Saveed(handler, key)
End Function
Public Function massnahmeplandetail_close(ByVal handler As Integer, ByVal key As Integer)
RaiseEvent MassnahmeplanDetail_Closed(handler, key)
End Function
End Class

View File

@@ -0,0 +1,228 @@
Imports System.IO
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Namespace Utils
''' <summary>
''' Standard-Messages in div. Formatenm
''' </summary>
''' <remarks></remarks>
Public Class MyMessage
#Region "Deklarationen"
''' <summary>
''' Dataview Meldungstexte um Textelemente für die Ausgabe zu suchen
''' </summary>
''' <remarks></remarks>
Private meldungstexte As New DataView()
#End Region
#Region "Dispose"
Sub dispose()
meldungstexte.Dispose()
End Sub
#End Region
#Region "DBZugriffe"
''' <summary>
''' Meldungen aus der Datenbanklesen, sofern diese noch nicht ausgelesen worden sind. Nach dem ersten Lesen werden
''' die Daten aus der Tabelle Meldungstexte ohne erneutem DB-Zugriff verwendet
''' </summary>
''' <param name="i"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Get_Meldungstext(ByVal i As Integer) As String
Dim meldungen As New DB.clsMeldungstexte
Dim res As Integer
meldungen.cpMainConnectionProvider = conn
If Me.meldungstexte.Count = 0 Then
Me.meldungstexte.Table = meldungen.SelectAll
End If
meldungstexte.Sort = "meldungstextnr"
res = meldungstexte.Find(i)
Try
Get_Meldungstext = Me.meldungstexte(res).Item(2)
Catch
Get_Meldungstext = ""
End Try
meldungen.Dispose()
End Function
#End Region
#Region "Meldungen"
''' <summary>
''' Standardmessage
''' </summary>
''' <param name="i">Messagenr</param>
''' <param name="typ">Messagetyp</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function show_standardmessage(ByVal i As Integer, ByVal typ As MsgBoxStyle) As Integer
Me.ShowMyDialog(Get_Meldungstext(i), typ, MsgBoxStyle.OkOnly)
'MsgBox(Get_Meldungstext(i), typ)
End Function
''' <summary>
''' Yes-No-Meldung
''' </summary>
''' <param name="i">Meldungsnr</param>
''' <returns>MsgboxResult</returns>
''' <remarks></remarks>
Public Function Show_MessageYesNo(ByVal i As Integer) As MsgBoxResult
Return Me.ShowMyDialog(Get_Meldungstext(i), MsgBoxStyle.Question, MsgBoxStyle.YesNo)
'Show_MessageYesNo = MsgBox(Get_Meldungstext(i), MsgBoxStyle.YesNo + MsgBoxStyle.Question)
End Function
''' <summary>
''' Standard-Meldung, welcher 2 Strings als Parameter übergeben werden, damit diese im Meldungstext ersetzt werden können.
''' Parameter im Meldungstext #1 oder #2
''' </summary>
''' <param name="i"></param>
''' <param name="typ"></param>
''' <param name="Text1"></param>
''' <param name="Text2"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function show_standardmessage_ReplaceText(ByVal i As Integer, ByVal typ As MsgBoxStyle, ByVal Text1 As String, ByVal Text2 As String) As Integer
Dim s As String
s = Get_Meldungstext(i)
s = s.Replace("#1", Text1)
s = s.Replace("#2", Text2)
Return Me.ShowMyDialog(s, typ, MsgBoxStyle.OkOnly)
' MsgBox(s, typ)
End Function
''' <summary>
''' Yes-No-Meldung, welcher 2 Strings als Parameter übergeben werden, damit diese im Meldungstext ersetzt werden können.
''' Parameter im Meldungstext #1 oder #2
''' </summary>
''' <param name="i">MeldungsNr</param>
''' <param name="Text1">erster Text zum ersetzen</param>
''' <param name="Text2">zweiter Text zum ersetzen</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function show_MessageYesNo_ReplaceText(ByVal i As Integer, ByVal Text1 As String, ByVal Text2 As String) As MsgBoxResult
Dim s As String
s = Get_Meldungstext(i)
s = s.Replace("#1", Text1)
s = s.Replace("#2", Text2)
Return Me.ShowMyDialog(s, MsgBoxStyle.Question, MsgBoxStyle.YesNo)
'show_MessageYesNo_ReplaceText = MsgBox(s, MsgBoxStyle.YesNo + MsgBoxStyle.Question)
End Function
''' <summary>
''' Ausgabe der Meldung, welche übergeben wird. Als Option können 2 Texte zum Ersetzen übergeben werden.
''' Parameter im Meldungstext #1 oder #2
''' </summary>
''' <param name="OrgText">Meldungstext</param>
''' <param name="Text1">erster Text zum ersetzen</param>
''' <param name="Text2">zweiter Text zum ersetzen</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function ReplaceTextinMSG(ByVal OrgText As String, ByVal Text1 As String, ByVal Text2 As String) As String
OrgText = OrgText.Replace("#1", Text1)
OrgText = OrgText.Replace("#2", Text2)
ReplaceTextinMSG = OrgText
End Function
''' <summary>
''' Meldung Yes-No-Cancel
''' </summary>
''' <param name="i"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Show_MessageYesNoCancel(ByVal i As Integer) As MsgBoxResult
Return Me.ShowMyDialog(Get_Meldungstext(i), MsgBoxStyle.Question, MsgBoxStyle.YesNoCancel)
'Show_MessageYesNoCancel = MsgBox(Get_Meldungstext(i), MsgBoxStyle.YesNoCancel + MsgBoxStyle.Question)
End Function
'Private Function ShowMessage(ByVal profilnr As Integer, ByVal messagenr As Integer, ByVal fnkt As Integer, ByVal style As Integer) As Boolean
' Dim scmCmdToExecute As SqlCommand = New SqlCommand()
' Dim i As Integer
' Dim dtToReturn As DataTable = New DataTable()
' Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
' scmCmdToExecute.CommandText = "dbo.sp_show_hinweismeldung"
' scmCmdToExecute.CommandType = CommandType.StoredProcedure
' scmCmdToExecute.Connection = conn.scoDBConnection
' Try
' scmCmdToExecute.Parameters.Add(New SqlParameter("@profilnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, profilnr))
' scmCmdToExecute.Parameters.Add(New SqlParameter("@hinweisnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, messagenr))
' scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, fnkt))
' scmCmdToExecute.Parameters.Add(New SqlParameter("@showit", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
' sdaAdapter.Fill(dtToReturn)
' i = scmCmdToExecute.Parameters.Item("@showit").Value
' If i <> 0 Then
' ShowMessage = True
' Else
' ShowMessage = False
' End If
' Catch ex As Exception
' ' // some error occured. Bubble it to caller and encapsulate Exception object
' Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
' Finally
' scmCmdToExecute.Dispose()
' sdaAdapter.Dispose()
' End Try
'End Function
''' <summary>
''' Zeig den eigenen Messagebox-Dialog
''' </summary>
''' <param name="msgtext"></param>
''' <param name="cancelvisible"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function ShowMyDialog(ByVal msgtext As String, ByVal ImageStyle As MsgBoxStyle, ByVal Buttons As MsgBoxStyle) As MsgBoxResult
Dim f As New frmMsgBox
f.btnno.Visible = False
f.btnAbbruch.Visible = False
f.btnYes.Visible = False
f.btnOK.Visible = False
Select Case Buttons
Case MsgBoxStyle.OkCancel
f.btnYes.Visible = True
f.btnAbbruch.Visible = True
Case MsgBoxStyle.YesNo
f.btnYes.Visible = True
f.btnno.Visible = True
Case MsgBoxStyle.YesNoCancel
f.btnYes.Visible = True
f.btnno.Visible = True
f.btnAbbruch.Visible = True
Case MsgBoxStyle.OkOnly
f.btnOK.Visible = True
End Select
f.imgCritical.Visible = False
f.imgExclamation.Visible = False
f.imgInformation.Visible = False
f.imgQuestion.Visible = False
Select Case ImageStyle
Case MsgBoxStyle.Critical
f.imgCritical.Visible = True
Case MsgBoxStyle.Exclamation
f.imgExclamation.Visible = True
Case MsgBoxStyle.Information
f.imgInformation.Visible = True
Case MsgBoxStyle.Question
f.imgQuestion.Visible = True
End Select
f.txtmsg.Text = msgtext
'f.btnYes.Visible = True
'f.btnno.Visible = True
f.ShowDialog()
Select Case f.DialogResult
Case DialogResult.Abort, DialogResult.Cancel
Return MsgBoxResult.Cancel
Case DialogResult.No
Return MsgBoxResult.No
Case DialogResult.Yes
Return MsgBoxResult.Yes
Case Else
End Select
End Function
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,818 @@
Imports C1.Win.C1TrueDBGrid
Imports System
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Namespace 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 Form
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_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 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
Finally
connection.Close()
da.Dispose()
sqlcmd.Dispose()
End Try
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()
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 "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"
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_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ü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("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 DB.clsSecurityObject
Dim dbkey As New 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ü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

View File

@@ -0,0 +1,432 @@
Imports System
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
'*
' Object MyspaltenTitel
'
' Dieses Objekt liest die Daten aus der Tabelle Spalten und speichert diese in spaltendaten
' Die Daten werden für die Spaltenbezeichnung der C1Datagrids verwendet
'
' Autor: Stefan Hutter
' Datum: 2.12.2002
'*
Imports C1.Win.C1TrueDBGrid
Namespace Utils
Public Class Tabellenspalte
Private m_table As String
Private m_field As String
Private m_spaltenname As String
Private m_locked As Boolean
Private m_Width As Integer
Private m_Order As Integer
Private m_alsHacken As Boolean
Private m_tiptext As String
Private m_numberformat As String
Property ColWith() As Integer
Get
Return m_Width
End Get
Set(ByVal Value As Integer)
m_Width = Value
End Set
End Property
Property Order() As Integer
Get
Return m_Order
End Get
Set(ByVal Value As Integer)
m_Order = Value
End Set
End Property
Property Tabelle() As String
Get
Return m_table
End Get
Set(ByVal Value As String)
m_table = Value
End Set
End Property
Property Feld() As String
Get
Return m_field
End Get
Set(ByVal Value As String)
m_field = Value
End Set
End Property
Property spaltenname() As String
Get
Return m_spaltenname
End Get
Set(ByVal Value As String)
m_spaltenname = Value
End Set
End Property
Property locked() As Boolean
Get
Return m_locked
End Get
Set(ByVal Value As Boolean)
m_locked = Value
End Set
End Property
Property AlsHacken() As Boolean
Get
Return m_alsHacken
End Get
Set(ByVal Value As Boolean)
m_alsHacken = Value
End Set
End Property
Property TipText() As String
Get
Return m_tiptext
End Get
Set(ByVal Value As String)
m_tiptext = Value
End Set
End Property
Property Numberformat() As String
Get
Return m_numberformat
End Get
Set(ByVal value As String)
m_numberformat = value
End Set
End Property
Public Sub New()
End Sub
Public Sub New(ByRef daten As Object, ByRef tablename As String, ByRef ds As DataSet)
Spaltentitel_aktualisieren(daten, tablename, ds)
End Sub
Public Function getspalte()
Try
Dim myspalten As New MySpaltenTitel()
myspalten.getspalte(Me.Tabelle, Me.Feld, Me.spaltenname, Me.locked, Me.ColWith, Me.Order, Me.AlsHacken, Me.TipText, Me.Numberformat)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Function
Public Function Spaltentitel_aktualisieren(ByRef daten As Object, ByRef tablename As String, ByRef ds As DataSet)
Dim anzcols As Integer
Dim i As Integer
Dim s As String
anzcols = daten.Splits(0).DisplayColumns.Count
Me.Tabelle = tablename
For i = 0 To daten.Columns.Count - 1
s = daten.Columns(i).DataField
Me.Feld = s
Me.getspalte()
daten.Columns(i).Caption = Me.spaltenname
If Me.ColWith = 0 Then
daten.Splits(0).DisplayColumns(i).Width = 0
daten.Splits(0).DisplayColumns(i).Visible = False
Else
daten.Splits(0).DisplayColumns(i).Width = Me.ColWith
End If
If Me.locked Then
daten.Splits(0).DisplayColumns(i).Locked = True
End If
If Me.AlsHacken Then
daten.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox
End If
'Präsentation von aktiv
If LCase(daten.Columns(i).DataField) = "aktiv" Then
daten.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox
daten.Columns(i).ValueItems.DefaultItem = True
daten.Columns(i).DefaultValue = True
daten.Columns(i).FilterText = True
'Dim items As C1.Win.C1TrueDBGrid.ValueItems = daten.Columns("aktiv").ValueItems
'items.Values.Clear()
'items.Values.Add(New C1.Win.C1TrueDBGrid.ValueItem("False", False)) ' unchecked
'items.Values.Add(New C1.Win.C1TrueDBGrid.ValueItem("True", True)) ' checked
'items.Values.Add(New C1.Win.C1TrueDBGrid.ValueItem("", "INDETERMINATE")) ' indeterminate state
End If
Select Case LCase(daten.Columns(i).DataField)
Case "erstellt_am", "erstelltam"
daten.Columns(i).DefaultValue = Now
End Select
If daten.Columns(i).DataType.Name = "DateTime" Then
daten.Columns(i).NumberFormat = "dd.MM.yyyy HH:mm:ss"
End If
If Me.Numberformat <> "" Then
daten.columns(i).numberformat = Me.Numberformat
End If
Next
ColumnOrder(tablename, daten)
daten.HeadingStyle.WrapText = False
End Function
Public Function Spaltentitel_aktualisieren(ByRef daten As Object, ByRef tablename As String, ByRef dt As DataTable, Optional ByVal Aktiv_Spalte_True_Setzen As Boolean = True)
Dim anzcols As Integer
Dim i As Integer
Dim t As New DataTable()
Dim s As String
anzcols = daten.Splits(0).DisplayColumns.Count
t = dt
Me.Tabelle = tablename
For i = 0 To daten.Columns.Count - 1
s = daten.Columns(i).DataField
'If s = "ApplikationNr" Then
' MsgBox("Hallo")
'End If
Me.Feld = s
Me.getspalte()
daten.Columns(i).Caption = Me.spaltenname
If Me.ColWith = 0 Then
daten.Splits(0).DisplayColumns(i).Width = 0
daten.Splits(0).DisplayColumns(i).Visible = False
Else
daten.Splits(0).DisplayColumns(i).Width = Me.ColWith
End If
If Me.locked Then
daten.Splits(0).DisplayColumns(i).Locked = True
End If
If Me.AlsHacken Then
daten.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox
End If
'Präsentation von aktiv
If LCase(daten.Columns(i).DataField) = "aktiv" And Aktiv_Spalte_True_Setzen = True Then
daten.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox
daten.Columns(i).ValueItems.DefaultItem = True
daten.Columns(i).DefaultValue = True
daten.Columns(i).FilterText = True
End If
Select Case LCase(daten.Columns(i).DataField)
Case "erstellt_am", "erstelltam"
daten.Columns(i).DefaultValue = Now
End Select
If daten.Columns(i).DataType.Name = "DateTime" Then
daten.Columns(i).NumberFormat = "dd.MM.yyyy HH:mm:ss"
End If
If Me.Numberformat <> "" Then
daten.columns(i).numberformat = Me.Numberformat
End If
Next
ColumnOrder(tablename, daten)
daten.HeadingStyle.WrapText = False
End Function
Public Function Spaltentitel_aktualisieren_Optionaler_Aktiv_Filer(ByRef daten As Object, ByRef tablename As String, ByRef dt As DataTable, Optional ByVal Aktiv_Filter As String = "")
Dim anzcols As Integer
Dim i As Integer
Dim t As New DataTable()
Dim s As String
anzcols = daten.Splits(0).DisplayColumns.Count
t = dt
Me.Tabelle = tablename
For i = 0 To daten.Columns.Count - 1
s = daten.Columns(i).DataField
Me.Feld = s
Me.getspalte()
If Me.spaltenname = "" Then
daten.Splits(0).DisplayColumns(i).Width = 0
Else
daten.Columns(i).Caption = Me.spaltenname
If Me.ColWith = 0 Then
daten.Splits(0).DisplayColumns(i).Width = 0
daten.Splits(0).DisplayColumns(i).Visible = False
Else
daten.Splits(0).DisplayColumns(i).Width = Me.ColWith
End If
If Me.locked Then
daten.Splits(0).DisplayColumns(i).Locked = True
End If
If Me.AlsHacken Then
daten.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox
End If
'Präsentation von aktiv
If LCase(daten.Columns(i).DataField) = "aktiv" And Aktiv_Filter <> "" Then
daten.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox
daten.Columns(i).ValueItems.DefaultItem = True
daten.Columns(i).DefaultValue = True
daten.Columns(i).FilterText = Aktiv_Filter
End If
Select Case LCase(daten.Columns(i).DataField)
Case "erstellt_am", "erstelltam"
daten.Columns(i).DefaultValue = Now
End Select
If daten.Columns(i).DataType.Name = "DateTime" Then
daten.Columns(i).NumberFormat = "dd.MM.yyyy HH:mm:ss"
End If
If Me.Numberformat <> "" Then
daten.columns(i).numberformat = Me.Numberformat
End If
End If
Next
ColumnOrder(tablename, daten)
daten.HeadingStyle.WrapText = False
End Function
''' <summary>
''' Sortierung der in der DB-Tabelle Spalaten festgelegten Reihenfolge
''' </summary>
''' <param name="Tablename"></param>
''' <param name="Data"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function ColumnOrder(ByVal Tablename As String, ByRef Data As C1TrueDBGrid)
Dim spaltendata As DataTable = Globals.Spaltendaten
Dim dv() As DataRow
Dim dr As DataRow
Dim dc As New Collection
dv = spaltendata.Select("Tabelle='" & Tablename & "'", "Reihenfolge desc, Eintragnr")
For Each c As C1DisplayColumn In Data.Splits(0).DisplayColumns
dc.Add(c)
Next
While Data.Splits(0).DisplayColumns.Count > 0
Data.Splits(0).DisplayColumns.RemoveAt(0)
End While
For Each dr In dv
For Each e As C1DisplayColumn In dc
If e.Name = dr.Item(3) Then
Data.Splits(0).DisplayColumns.Insert(0, e)
End If
Next
Next
End Function
End Class
Public Class MySpaltenTitel
Private spaltendata As DataTable = Globals.Spaltendaten
Sub New()
load_data()
End Sub
Sub dispose()
spaltendata.Dispose()
Me.dispose()
End Sub
Public Function getspalte(ByVal tabelle As String, ByVal feld As String, ByRef spaltenname As String, ByRef locked As Boolean, _
ByRef colwidth As Integer, ByRef order As Integer, ByRef alshacken As Boolean, ByRef tiptext As String, ByRef numberformat As String)
If spaltendata.Rows.Count = 0 Then load_data()
Dim dv() As DataRow
Dim dr As DataRow
dv = spaltendata.Select("Tabelle='" & tabelle & "' and tabellenspalte='" & feld & "'", "Reihenfolge, Eintragnr")
If dv.Length = 0 Then
spaltenname = ""
locked = True
colwidth = 0
order = 0
alshacken = False
tiptext = ""
numberformat = ""
End If
For Each dr In dv
spaltenname = dr.Item(3)
locked = dr.Item(4)
colwidth = dr.Item(6)
order = dr.Item(7)
alshacken = dr.Item(5)
tiptext = dr.Item(8)
numberformat = dr.Item(14).ToString
Next
'Dim i As Integer
'For i = 0 To spaltendata.Rows.Count - 1
' If UCase(spaltendata.Rows(i).Item(1)) = UCase(tabelle) And UCase(spaltendata.Rows(i).Item(2)) = UCase(feld) Then
' spaltenname = spaltendata.Rows(i).Item(3)
' locked = spaltendata.Rows(i).Item(4)
' colwidth = spaltendata.Rows(i).Item(6)
' order = spaltendata.Rows(i).Item(7)
' alshacken = spaltendata.Rows(i).Item(5)
' tiptext = spaltendata.Rows(i).Item(8)
' Exit Function
' End If
'Next
End Function
Public Sub load_data()
If Me.spaltendata.Rows.Count > 0 Then Exit Sub
Dim spalten As New Utils.clsSpalten()
spaltendata.Rows.Clear()
spalten.cpMainConnectionProvider = conn
spaltendata = spalten.Select_All_Aktiv
Globals.Spaltendaten = spaltendata
End Sub
End Class
Public Class clsSpalten
Inherits DB.clsSpalten
''' <summary>
''' Purpose: SelectAll method. This method will Select all rows from the table.
''' </summary>
''' <returns>DataTable object if succeeded, otherwise an Exception is thrown. </returns>
''' <remarks>
''' Properties set after a succesful call of this method:
''' <UL>
''' <LI>iErrorCode</LI>
'''</UL>
''' </remarks>
Public Function Select_All_Aktiv() As DataTable
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.[pr_spalten_SelectAll_Aktiv]"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
Dim dtToReturn As DataTable = New DataTable("spalten")
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
' // Use base class' connection object
scmCmdToExecute.Connection = m_scoMainConnection
Try
scmCmdToExecute.Parameters.Add(New SqlParameter("@iErrorCode", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, m_iErrorCode))
If m_bMainConnectionIsCreatedLocal Then
' // Open connection.
m_scoMainConnection.Open()
Else
If m_cpMainConnectionProvider.bIsTransactionPending Then
scmCmdToExecute.Transaction = m_cpMainConnectionProvider.stCurrentTransaction
End If
End If
' // Execute query.
sdaAdapter.Fill(dtToReturn)
m_iErrorCode = New SqlInt32(CType(scmCmdToExecute.Parameters.Item("@iErrorCode").Value, SqlInt32))
If Not m_iErrorCode.Equals(New SqlInt32(0)) Then
' // Throw error.
Throw New Exception("Stored Procedure 'pr_spalten_SelectAll' reported the ErrorCode: " & m_iErrorCode.ToString())
End If
Return dtToReturn
Catch ex As Exception
' // some error occured. Bubble it to caller and encapsulate Exception object
Throw New Exception("clsSpalten::SelectAll::Error occured.", ex)
Finally
If m_bMainConnectionIsCreatedLocal Then
' // Close connection.
m_scoMainConnection.Close()
End If
scmCmdToExecute.Dispose()
sdaAdapter.Dispose()
End Try
End Function
End Class
End Namespace

View File

@@ -0,0 +1,192 @@
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports DevComponents
Public Class clsHistory
Inherits DB.clsPruefSchrittHistory
Public daten As New DataTable
Public Neuer_Datensatz As Boolean = False
Public Mitarbeiterdaten As New DataTable
Dim stammdaten As New DB.clsStammdaten
Dim SpaltenTitel As New Utils.Tabellenspalte
Dim mMutierer As String
Property MutiererText() As String
Get
Return mMutierer
End Get
Set(ByVal value As String)
mMutierer = value
End Set
End Property
Public Function Get_Mutierer(ByVal nr As Integer) As String
Try
Dim ma As New DB.clsMitarbeiter
Dim dt As New DataTable
Dim Retvalue As String
ma.cpMainConnectionProvider = Globals.conn
ma.iMitarbeiternr = New SqlInt32(CType(nr, Int32))
dt = ma.SelectOne()
If dt.Rows.Count = 0 Then
Retvalue = ("{" + nr.ToString + "}")
Else
Retvalue = ma.sName.ToString + " " + ma.sVorname.ToString + ", " + ma.sTgnummer.ToString
End If
ma.Dispose()
dt.Dispose()
Return Retvalue
Catch
Return ""
End Try
End Function
Public Function Get_Data(ByVal Nr As Integer)
Me.cpMainConnectionProvider = Globals.conn
Me.iPruefschrittNr = New SqlInt32(CType(Nr, Int32))
Globals.conn.OpenConnection()
Me.daten = Me.SelectOne()
Globals.conn.CloseConnection(True)
Try
Me.MutiererText = Get_Mutierer(Me.iMutierer.Value)
Catch ex As Exception
Me.MutiererText = ""
End Try
End Function
Public Function Save_Data() As Integer
Me.cpMainConnectionProvider = Globals.conn
Me.iMutierer = New SqlInt32(CType(Globals.clsmitarbeiter.iMitarbeiternr, Int32))
Me.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
Globals.conn.OpenConnection()
Me.Update()
Globals.conn.CloseConnection(True)
Me.Neuer_Datensatz = False
End Function
''' <summary>
''' Löschen eines Datensatzes erstellen.
''' </summary>
''' <param name="Basenr">Ursprungs-Person: Ist dieser Wert nicht 0, werden die Daten mit BaseNr zuerst gelesen</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Delete_Data(Optional ByVal Basenr As Integer = 0) As Integer
If Basenr <> 0 Then
Get_Data(Basenr)
End If
If bAktiv.Value = False Then Exit Function
Me.cpMainConnectionProvider = Globals.conn
Me.bAktiv = New SqlBoolean(CType(False, Boolean))
Me.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
Me.iMutierer = New SqlInt32(CType(Globals.clsmitarbeiter.iMitarbeiternr, Int32))
Globals.conn.OpenConnection()
Me.Update()
Globals.conn.CloseConnection(True)
Me.Neuer_Datensatz = False
End Function
Public Overloads Function Delete(Optional ByVal Basenr As Integer = 0) As Integer
If Basenr <> 0 Then
Get_Data(Basenr)
End If
Me.cpMainConnectionProvider = Globals.conn
Globals.conn.OpenConnection()
MyBase.Delete()
Globals.conn.CloseConnection(True)
Me.Neuer_Datensatz = False
End Function
''' <summary>
''' Neue Person einfügen
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function Add_New() As Integer
Dim db As New DB.clsMyKey_Tabelle
db.cpMainConnectionProvider = Globals.conn
Dim newkey = db.get_dbkey("PruefschrittHistory")
db.Dispose()
Me.bAktiv = New SqlBoolean(CType(True, Boolean))
Me.daErstellt_am = New SqlDateTime(CType(Now, DateTime))
Me.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
Me.iMutierer = New SqlInt32(CType(Globals.clsmitarbeiter.iMitarbeiternr, Int32))
Me.sBeschreibung = New SqlString(CType("", String))
Me.daEintragdatum = New SqlDateTime(CType(Now, DateTime))
Me.iPruefSchrittHistoryNr = New SqlInt32(CType(newkey, Int32))
Me.cpMainConnectionProvider = Globals.conn
Try
Globals.conn.OpenConnection()
Me.Insert()
Globals.conn.CloseConnection(True)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Me.Neuer_Datensatz = True
Return Me.iPruefSchrittHistoryNr.Value
End Function
Public Function Insert_History(pruefschrittnr As Integer, type As Integer, String1 As String, String2 As String)
Dim i As Integer = Me.Add_New()
Me.iPruefschrittNr = New SqlInt32(CType(pruefschrittnr, Int32))
Select Case type
Case 0
'String1 = individuelle Beschreibung für den HistoryEintrag
Me.sBeschreibung = New SqlString(CType(String1, String))
Case 1
'String1 = Mitarbeiternr Absender
'String2 = Mitarbeiternr Empfänger
Dim ma As New clsMitarbeiter
String1 = ma.Get_Mitarbeitername(String1)
String2 = ma.Get_Mitarbeitername(String2)
ma.dispose()
Me.sBeschreibung = New SqlString(CType("Assessment zugeteilt von " + String1 + " zu " + String2, String))
Case 2
Dim ma As New clsMitarbeiter
String1 = ma.Get_Mitarbeitername(String1)
Me.sBeschreibung = New SqlString(CType("Assessment abgeschlossen von " + String1, String))
End Select
Me.Save_Data()
End Function
Public Function Get_Eintraege(ByRef c1daten As C1.Win.C1TrueDBGrid.C1TrueDBGrid, ByVal Pruefschrittnr As Integer)
Try
Dim ds As New DataSet
Dim connection As New SqlConnection()
Dim da As New SqlDataAdapter("", connection)
Dim sqlcmd As New SqlCommand
sqlcmd.CommandText = "sp_get_pruefschritthistory"
sqlcmd.Parameters.Add(New SqlParameter("@key", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Pruefschrittnr))
sqlcmd.CommandType = CommandType.StoredProcedure
sqlcmd.Connection = connection
Try
connection.ConnectionString = Globals.sConnectionString
connection.Open()
da.SelectCommand = sqlcmd
da.Fill(ds, "Datatable1")
c1daten.DataSource = Nothing
c1daten.DataSource = ds.Tables(0)
c1daten.DataMember = ds.Tables(0).TableName
SpaltenTitel.Spaltentitel_aktualisieren(c1daten, "Pruefschritthistory", ds.Tables(0))
Catch ex As Exception
MsgBox(ex.Message)
Finally
connection.Close()
da.Dispose()
sqlcmd.Dispose()
End Try
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Function
End Class

View File

@@ -0,0 +1,150 @@
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports DevComponents
Public Class clsMitarbeiter
Inherits DB.clsMitarbeiter
Public daten As New DataTable
Public Neuer_Datensatz As Boolean = False
Public Mitarbeiterdaten As New DataTable
Dim stammdaten As New DB.clsStammdaten
Dim SpaltenTitel As New Utils.Tabellenspalte
Public VerantwortlichISIdaten As New DataTable
Dim mMutierer As String
Property MutiererText() As String
Get
Return mMutierer
End Get
Set(ByVal value As String)
mMutierer = value
End Set
End Property
Sub New()
Mitarbeiterdaten = stammdaten.Get_Stammdaten("mitarbeiter", "bezeichnung")
VerantwortlichISIdaten = stammdaten.Get_Stammdaten("verantwortungisi", "bezeichnung")
End Sub
Sub dispose()
Mitarbeiterdaten.Dispose()
VerantwortlichISIdaten.Dispose()
End Sub
Public Function Get_Mitarbeitername(ByVal nr As Integer) As String
Return Get_Mutierer(nr)
End Function
Public Function Get_Mutierer(ByVal nr As Integer) As String
Try
Dim ma As New DB.clsMitarbeiter
Dim dt As New DataTable
Dim Retvalue As String
ma.cpMainConnectionProvider = Globals.conn
ma.iMitarbeiternr = New SqlInt32(CType(nr, Int32))
dt = ma.SelectOne()
If dt.Rows.Count = 0 Then
Retvalue = ("{" + nr.ToString + "}")
Else
Retvalue = ma.sName.ToString + " " + ma.sVorname.ToString + ", " + ma.sTgnummer.ToString
End If
ma.Dispose()
dt.Dispose()
Return Retvalue
Catch
Return ""
End Try
End Function
Public Function Get_Data(ByVal Nr As Integer)
Me.cpMainConnectionProvider = Globals.conn
Me.iMitarbeiternr = New SqlInt32(CType(Nr, Int32))
Globals.conn.OpenConnection()
Me.daten = Me.SelectOne()
Globals.conn.CloseConnection(True)
Try
Me.MutiererText = Get_Mutierer(Me.iMutierer.Value)
Catch ex As Exception
Me.MutiererText = ""
End Try
End Function
Public Function Save_Data() As Integer
Me.cpMainConnectionProvider = Globals.conn
Me.iMutierer = New SqlInt32(CType(Globals.clsmitarbeiter.iMitarbeiternr, Int32))
Me.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
Globals.conn.OpenConnection()
Me.Update()
Globals.conn.CloseConnection(True)
Me.Neuer_Datensatz = False
End Function
''' <summary>
''' Löschen eines Datensatzes erstellen.
''' </summary>
''' <param name="Basenr">Ursprungs-Person: Ist dieser Wert nicht 0, werden die Daten mit BaseNr zuerst gelesen</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function Delete_Data(Optional ByVal Basenr As Integer = 0) As Integer
If Basenr <> 0 Then
Get_Data(Basenr)
End If
If bAktiv.Value = False Then Exit Function
Me.cpMainConnectionProvider = Globals.conn
Me.bAktiv = New SqlBoolean(CType(False, Boolean))
Me.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
Me.iMutierer = New SqlInt32(CType(Globals.clsmitarbeiter.iMitarbeiternr, Int32))
Globals.conn.OpenConnection()
Me.Update()
Globals.conn.CloseConnection(True)
Me.Neuer_Datensatz = False
End Function
Public Overloads Function Delete(Optional ByVal Basenr As Integer = 0) As Integer
If Basenr <> 0 Then
Get_Data(Basenr)
End If
Me.cpMainConnectionProvider = Globals.conn
Globals.conn.OpenConnection()
MyBase.Delete()
Globals.conn.CloseConnection(True)
Me.Neuer_Datensatz = False
End Function
''' <summary>
''' Neue Person einfügen
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function Add_New() As Integer
Dim db As New DB.clsMyKey_Tabelle
db.cpMainConnectionProvider = Globals.conn
Dim newkey = db.get_dbkey("Mitarbeiter")
db.Dispose()
Me.bAktiv = New SqlBoolean(CType(True, Boolean))
Me.daErstellt_am = New SqlDateTime(CType(Now, DateTime))
Me.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
Me.iMutierer = New SqlInt32(CType(Globals.clsmitarbeiter.iMitarbeiternr, Int32))
Me.sName = New SqlString(CType("", String))
Me.sVorname = New SqlString(CType("", String))
Me.sTgnummer = New SqlString(CType("", String))
Me.sEmail = New SqlString(CType("", String))
Me.cpMainConnectionProvider = Globals.conn
Try
Globals.conn.OpenConnection()
Me.Insert()
Globals.conn.CloseConnection(True)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Me.Neuer_Datensatz = True
Return Me.iMitarbeiternr.Value
End Function
End Class

View File

@@ -0,0 +1,42 @@
Imports System
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Namespace db
Public Class clsStammdaten
Public Function Get_Stammdaten(ByVal Tabelle As String, ByVal orderby As String) As DataTable
Dim selectcommand As New SqlCommand
Dim connection As New SqlConnection()
Dim da As New SqlDataAdapter("", connection)
Dim ds As New DataSet
selectcommand.CommandText = "sp_get_stammdaten"
selectcommand.Parameters.Add("@Mitarbeiternr", SqlDbType.Int, 4)
selectcommand.Parameters.Add("@Tabelle", SqlDbType.VarChar, 255)
selectcommand.Parameters.Add("@Orderby", SqlDbType.VarChar, 255)
selectcommand.Parameters(0).Value = Globals.clsmitarbeiter.iMitarbeiternr.Value
selectcommand.Parameters(1).Value = Tabelle
selectcommand.Parameters(2).Value = orderby
selectcommand.CommandType = CommandType.StoredProcedure
selectcommand.Connection = connection
Try
connection.ConnectionString = Globals.sConnectionString
connection.Open()
da.SelectCommand = selectcommand
da.Fill(ds)
Return ds.Tables(0)
Catch ex As Exception
Finally
connection.Close()
da.Dispose()
ds.Dispose()
selectcommand.Dispose()
End Try
End Function
End Class
End Namespace

View File

@@ -0,0 +1,159 @@
Imports C1.Win.C1TrueDBGrid
Imports System
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Namespace TKB.VV.Utils
Public Class clsToolTips
Public WithEvents MyTooltip As New ToolTip
Dim ToolTipData As DataSet = Globals.ToolTipDaten
Dim connection As New SqlConnection()
Dim da As New SqlDataAdapter("", connection)
Dim l As New List(Of Control)
Dim WithEvents evh As MyGenericEventHandler = Globals.MyEventHanlder
Public Function Edit_ToolTips(ByRef frm As Form, ByRef ctlcol As Collection)
Me.Load_Data()
l.Clear()
Me.GetControl(frm, "*", l)
For Each s As Control In l
Try
MyTooltip.SetToolTip(s, frm.Name + "|" + s.Name)
MyTooltip.Tag = frm.Name
Catch ex As Exception
MsgBox(ex.Message)
End Try
Next
'For Each ctl As Control In ctlcol
' Try
' MyTooltip.SetToolTip(ctl, "SetToolTip")
' MyTooltip.Tag = frm.Name + "|" + ctl.Name
' Catch ex As Exception
' End Try
'Next
End Function
Private Sub MyTooltip_Popup(ByVal sender As Object, ByVal e As System.Windows.Forms.PopupEventArgs) Handles MyTooltip.Popup
'MsgBox(e.AssociatedControl.Name)
evh.Edit_Tooltip(MyTooltip.Tag, e.AssociatedControl.Name)
'Dim s As String = MyTooltip.Tag
'Dim sp() As String
'sp = s.Split("|")
'evh.Edit_Tooltip(sp(0), sp(1))
End Sub
Public Function Set_ToolTips(ByRef frm As Form)
Me.Load_Data()
'MyTooltip.ToolTipIcon = ToolTipIcon.Info
MyTooltip.IsBalloon = True
MyTooltip.UseFading = True
MyTooltip.UseAnimation = True
Dim dv As New DataView(ToolTipData.Tables(0), "Aktiv = 1 and (Formularname='" & frm.Name & "' or Formularname='Allgemein')", "", DataViewRowState.CurrentRows)
For Each dr As DataRowView In dv
l.Clear()
Me.GetControl(frm, dr.Item("Controlname"), l)
Try
For Each ctl As Control In l
Try
MyTooltip.SetToolTip(ctl, dr.Item("ToolTip"))
Catch
End Try
Next
Catch ex As Exception
End Try
Next
End Function
''' <summary>
''' Daten ab Datenbank laden
''' </summary>
''' <remarks></remarks>
Private Sub Load_Data()
Try
If ToolTipData.Tables.Count < 1 Then
ToolTipData.Tables.Clear()
Else
Exit Sub
End If
Catch ex As Exception
End Try
ToolTipData.Tables.Clear()
Dim sqlcmd As New SqlCommand
sqlcmd.CommandText = "dbo.my_tooltip_get_data"
'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(ToolTipData, "Tooltips")
Globals.SecurityDaten.Tables.Add(ToolTipData.Tables(0).Copy)
Catch ex As Exception
Finally
connection.Close()
da.Dispose()
sqlcmd.Dispose()
End Try
End Sub
#Region "Utils"
''' <summary>
''' Sucht in den Base-Controls sämtliche Controls mit dem Namen in "Key" (Wildcards * möglich) und listet
''' die gefundnen Controls in der Liste L zur weiteren Bearbeitung
''' </summary>
''' <param name="BaseControl">Base-Contrlo (z.B. aktuelles Formular</param>
''' <param name="Key">Schlüssel welcher gesucht werden soll</param>
''' <param name="L">Liste der gefundenen Objekte</param>
''' <returns>True wenn eines oder mehr Controls gefunden wurden, false wenn kein Control gefunden wurde.
''' </returns>
''' <remarks></remarks>
Private Function GetControl(ByVal BaseControl As Control, ByVal Key As String, ByRef L As List(Of Control), Optional ByVal ReturnAtFirstElement As Boolean = False) As Boolean
If L Is Nothing Then L = New List(Of Control)
Dim Gut As Boolean
Dim ReturnFlag As Boolean = False
If Key IsNot Nothing Then Key = Key.ToLower
If BaseControl.HasChildren = True Then
For Each ctl As Control In BaseControl.Controls
Gut = False
If Key Is Nothing Then
Gut = True
Else
If ctl.Name.Length >= Key.Length Then
Key = Key.ToLower
If Key.StartsWith("*") Then
If Key.Substring(1) = ctl.Name.ToLower.Substring(ctl.Name.Length - (Key.Length - 1), Key.Length - 1) Then Gut = True
ElseIf Key.EndsWith("*") Then
If Key.Substring(0, Key.Length - 1) = ctl.Name.ToLower.Substring(0, Key.Length - 1) Then Gut = True
Else
If Key = ctl.Name.ToLower Then Gut = True
End If
End If
End If
If Gut = True Then
L.Add(ctl)
If ReturnAtFirstElement = True Then ReturnFlag = True
End If
If ReturnFlag = False Then
Call GetControl(ctl, Key, L)
End If
Next
End If
If L.Count - 1 > -1 Then
Return True
Else
Return False
End If
End Function
#End Region
End Class
End Namespace