Imports System.Xml Imports System.Security.Principal Public Class FrmMain Implements mMain.SingleInstance.ISingleInstanceForm Public ReadOnly Property hWnd() As System.IntPtr Implements DokMD.mMain.SingleInstance.ISingleInstanceForm.Handle Get Return Handle End Get End Property Dim users As New DataSet Dim userrechte As Integer Public Event WndProc2(ByVal m As System.Windows.Forms.Message, ByRef Cancel As Boolean) Implements mMain.SingleInstance.ISingleInstanceForm.WndProc Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message) Dim bCancel As Boolean = False RaiseEvent WndProc2(m, bCancel) If Not bCancel Then MyBase.WndProc(m) End Sub Public Sub HandleCommand(ByVal strCmd As String) Implements DokMD.mMain.SingleInstance.ISingleInstanceForm.HandleCommand Dim arrCmd() As String Me.BringToFront() Try 'arrCmd = SerialHelper.DeserializeFromBase64String(strCmd) 'TKBLib.Errorhandling.TraceHelper.Msg("Schnittstelle", "Agrument übergeben: " + arrCmd(0), TraceLevel.Info) 'HandleCommand(arrCmd) Catch ex As Exception ' HandleCommand(New String() {strCmd}) Finally Erase arrCmd End Try End Sub Private Sub FrmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim c As New EDOKA.DB_Connection Globals.conn.scoDBConnection.ConnectionString = Globals.sConnectionString Globals.fMehrfachdruck = New frmMehrfachdruck() Globals.fMehrfachdruck.MdiParent = Me Globals.fMehrfachdruck.Visible = False Globals.fMehrfachdruck.Hide() Globals.fMehrfachdruck.InitForm() If check_user() = False Then Me.Close() Exit Sub End If If userrechte = 1 Then Me.BenutzerverwaltungToolStripMenuItem.Visible = True Else Me.BenutzerverwaltungToolStripMenuItem.Visible = False Get_Params() Dim f As New frmMD f.MdiParent = Me f.Show() End Sub Function check_user() As Boolean Dim user As String = Get_Username() If Not System.IO.File.Exists(Application.StartupPath + "\users.xml") Then MsgBox("User-Datenbank ist nicht vorhanden und wird neu erstellt", MsgBoxStyle.Critical) Dim s As String = InputBox("Geben Sie das Passwort ein:") If s <> "selbstanzeigen" Then Return False End If create_usertable(user) Return False End If Globals.Userdata.ReadXml(Application.StartupPath + "\users.xml") For Each dr As DataRow In Globals.Userdata.Tables(0).Rows dr.Item(0) = Crypto.DecryptText(dr.Item(0).ToString, "Selbstanzeigen") Next userrechte = -1 For Each dr As DataRow In Globals.Userdata.Tables(0).Rows If UCase(user) = UCase(dr.Item(0)) Then If dr.Item(1) = 1 Then userrechte = 1 Else userrechte = 0 Globals.Mitarbeiternr = dr.Item(2) Globals.tgnummer = user Exit For End If Next If userrechte = -1 Then MsgBox("Sie sind nicht berechtig, die Applikation zu verwenden.", MsgBoxStyle.Exclamation) Return False End If Return True End Function Dim ouser As New WindowsPrincipal(WindowsIdentity.GetCurrent) Private Function Get_Username() As String With ouser.Identity.Name Return (.Substring(.IndexOf("\") + 1)) End With End Function Private Sub BeendenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BeendenToolStripMenuItem.Click Me.Close() End Sub Sub Get_Params() Dim xmldoc As New XmlDocument xmldoc.Load(Application.StartupPath + "\Parameters.XML") Globals.Packagegroesse = xmldoc.SelectSingleNode("/Configuration/Packagegroesse").InnerText Globals.DelayTime = xmldoc.SelectSingleNode("/Configuration/DelayTime").InnerText End Sub Sub create_usertable(ByVal username As String) Dim ds As New DataSet ds.Tables.Add("Users") ds.Tables(0).Columns.Add("TGNummer") ds.Tables(0).Columns.Add("Rolle") ds.Tables(0).Columns.Add("EDOKA_MA_Nr") Dim dr As DataRow = ds.Tables(0).NewRow dr.Item(0) = Crypto.EncryptText(username, "Selbstanzeigen") dr.Item(1) = 1 dr.Item(2) = 0 ds.Tables(0).Rows.Add(dr) ds.WriteXml(Application.StartupPath + "\users.xml") End Sub Private Sub BenutzerverwaltungToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BenutzerverwaltungToolStripMenuItem.Click Dim f As New frmBenutzer f.MdiParent = Me f.Show() End Sub Private Sub NeuesDetailfensterToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NeuesDetailfensterToolStripMenuItem.Click Dim f As New frmMD f.MdiParent = Me f.Show() End Sub Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click Me.Close() End Sub End Class