You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

181 lines
6.3 KiB

Imports System.IO
Imports System.Security.Principal
Imports PluginContracts
Imports System.Reflection
Public Class frmMain1
Dim plugins As ICollection(Of IPlugin) = New List(Of IPlugin)
Private _Plugins As Dictionary(Of String, IPlugin)
Dim users As New DataSet
Dim userrechte As Integer
Dim onload As Boolean = True
Public Function LoadPlugins(path As String) As ICollection(Of IPlugin)
Dim dllFileNames As String()
If Directory.Exists(path) Then
dllFileNames = Directory.GetFiles(path, "*.dll")
Dim assemblies As ICollection(Of Assembly) = New List(Of Assembly)(dllFileNames.Length)
For Each dllFile As String In dllFileNames
Try
Dim an As AssemblyName = AssemblyName.GetAssemblyName(dllFile)
Dim assembly As Assembly = Assembly.Load(an)
assemblies.Add(assembly)
Catch
End Try
Next
Dim pluginType As Type = GetType(IPlugin)
Dim pluginTypes As ICollection(Of Type) = New List(Of Type)
For Each assembly As Assembly In assemblies
If assembly <> Nothing Then
Dim types As Type() = assembly.GetTypes()
For Each type As Type In types
If type.IsInterface Or type.IsAbstract Then
Continue For
Else
If type.GetInterface(pluginType.FullName) <> Nothing Then
pluginTypes.Add(type)
End If
End If
Next
End If
Next
Dim plugins As ICollection(Of IPlugin) = New List(Of IPlugin)(pluginTypes.Count)
For Each type As Type In pluginTypes
Dim plugin As IPlugin = Activator.CreateInstance(type)
plugins.Add(plugin)
Next
Return plugins
End If
Return Nothing
End Function
Private Sub PopulatePluginList()
_Plugins = New Dictionary(Of String, IPlugin)
For Each item In plugins
_Plugins.Add(item.Name, item)
lstPlugins.Items.Add(item.Name)
Dim tmisub As New ToolStripMenuItem
tmisub = tmi.DropDown.Items.Add(item.Name)
AddHandler tmisub.Click, AddressOf Erweiterungen_Click
Next
lstPlugins.SelectedIndex = 0
End Sub
Public Function Erweiterungen_Click(ByVal sender As Object, ByVal e As EventArgs)
Cursor = Cursors.WaitCursor
Dim tmi As ToolStripMenuItem = sender
If _Plugins.ContainsKey(tmi.Text) Then
Dim plugin As IPlugin = _Plugins(tmi.Text)
plugin.Show(Globals.Mitarbeiternr, "", Me)
End If
Cursor = Cursors.Default
End Function
Private Sub BeendenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BeendenToolStripMenuItem.Click
Me.Close()
End Sub
Dim tmi As New ToolStripMenuItem
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
onload = True
'plugins = LoadPlugins("k:\plugins")
plugins = LoadPlugins(Application.StartupPath)
If plugins.Count > 0 Then
tmi = Me.MenuStrip1.Items.Add("Erweiterungen")
End If
PopulatePluginList()
onload = False
End Sub
Dim ouser As New WindowsPrincipal(WindowsIdentity.GetCurrent)
''' <summary>
''' Windows-User auslesen
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
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
Private Sub lstPlugins_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lstPlugins.SelectedIndexChanged
If onload Then Exit Sub
If _Plugins.ContainsKey(lstPlugins.SelectedItem) Then
Dim plugin As IPlugin = _Plugins(lstPlugins.SelectedItem)
plugin.Show(Globals.Mitarbeiternr, "", Me)
End If
End Sub
End Class