Imports System.IO Imports System.Security.Principal Public Class frmMain1 Private Plugins() As PluginServices.AvailablePlugin Private objHost As EDOKA_PluginLib.IHost Dim users As New DataSet Dim userrechte As Integer Dim onload As Boolean = True Private Sub PopulatePluginList() Dim objPlugin As EDOKA_PluginLib.IPlugin Dim intIndex As Integer lstPlugins.Items.Add("Funktion wählen:") 'Loop through available plugins, creating instances and adding them to listbox For intIndex = 0 To Plugins.Length - 1 objPlugin = DirectCast(PluginServices.CreateInstance(Plugins(intIndex)), EDOKA_PluginLib.IPlugin) lstPlugins.Items.Add(objPlugin.Name) Next lstPlugins.SelectedIndex = 0 End Sub Private Sub BeendenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BeendenToolStripMenuItem.Click Me.Close() End Sub Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load If check_user() = False Then End If userrechte = 1 Then BeendenToolStripMenuItem.Visible = True Else BenutzerverwaltungToolStripMenuItem.Visible = False Plugins = PluginServices.FindPlugins(Path.GetDirectoryName(Application.ExecutablePath), "EDOKA_PluginLib.IPlugin") If Plugins Is Nothing Then MessageBox.Show("No plugins found!", Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Stop) Exit Sub End If PopulatePluginList() onload = False End Sub Private Sub lstPlugins_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lstPlugins.SelectedIndexChanged Cursor = Cursors.WaitCursor Dim objPlugin As EDOKA_PluginLib.IPlugin Dim dblResult As Double Try 'Create and initialize plugin objPlugin = DirectCast(PluginServices.CreateInstance(Plugins(lstPlugins.SelectedIndex - 1)), EDOKA_PluginLib.IPlugin) objPlugin.Initialize(objHost) Catch ex As Exception Cursor = Cursors.Default Exit Sub End Try 'Run calculation and return result Try objPlugin.Show(Globals.Mitarbeiternr, "", Me) Catch ex As Exception Cursor = Cursors.Default MessageBox.Show("Error " + ex.Message, Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Exit Sub End Try Cursor = Cursors.Default End Sub Dim ouser As New WindowsPrincipal(WindowsIdentity.GetCurrent) ''' ''' Windows-User auslesen ''' ''' ''' Private Function Get_Username() As String With ouser.Identity.Name Return (.Substring(.IndexOf("\") + 1)) End With End Function #Region "Tools" 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 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 <> "edokatools" 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 #End Region Private Sub BenutzerverwaltungToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BenutzerverwaltungToolStripMenuItem.Click Dim f As New frmBenutzer f.MdiParent = Me f.Show() End Sub End Class