AppStd/RecordOrganizer
8
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

MS

Browse Source
This commit is contained in:
SchreiberM
2016-04-14 12:27:57 +02:00
parent dab2f6ff83
commit ede8ede415
7 changed files with 243 additions and 193 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
app/DD-Record-Organiser/ClassDatabase.vb
View File

@@ -266,7 +266,8 @@ Public Class ClassDatabase
SQLconnect.Close() SQLconnect.Close()
Return result Return result
Else Else
MsgBox("No ConnectionID!", MsgBoxStyle.Exclamation) MsgBox("No Connection for ID: " & connectionId & " - ExecuteScalar: " & cmdscalar, MsgBoxStyle.Exclamation)
ClassLogger.Add("No Connection for ID: " & connectionId & " - ExecuteScalar: " & cmdscalar)
Return Nothing Return Nothing
End If End If

252
app/DD-Record-Organiser/ClassDragDrop.vb
View File

@@ -5,128 +5,131 @@ Public Class ClassDragDrop
Public Shared files_dropped As String() Public Shared files_dropped As String()
Public Shared Function Drop_File(e As DragEventArgs) Public Shared Function Drop_File(e As DragEventArgs)
Try Try
Try
If LogErrorsOnly = False Then ClassLogger.Add(" >> In Drop_File....", False)
files_dropped = Nothing
Dim sql As String = "DELETE FROM TBPMO_FILES_USER WHERE HANDLE_TYPE <> 'SCAN' AND UPPER(USER_WORK) = UPPER('" & Environment.UserName & "')" If LogErrorsOnly = False Then ClassLogger.Add(" >> In Drop_File....", False)
ClassDatabase.Execute_non_Query(sql) files_dropped = Nothing
If e.Data.GetDataPresent(DataFormats.FileDrop) Then Dim sql As String = "DELETE FROM TBPMO_FILES_USER WHERE HANDLE_TYPE <> 'SCAN' AND UPPER(USER_WORK) = UPPER('" & Environment.UserName & "')"
If LogErrorsOnly = False Then ClassLogger.Add(" >> DataFormats.FileDrop", False) ClassDatabase.Execute_non_Query(sql)
Dim MyFiles() As String
Dim i As Integer
' Assign the files to an array.
MyFiles = e.Data.GetData(DataFormats.FileDrop)
' Loop through the array and add the files to the list.
For i = 0 To MyFiles.Length - 1
ReDim Preserve files_dropped(i)
files_dropped(i) = "@DROPFROMFSYSTEM@" & MyFiles(i)
' ListBox1.Items.Add(MyFiles(i))
Next
Return files_dropped
End If
Catch ex As Exception
MsgBox("Unexpected Error in DropFile||DataFormats.FileDrop: " & ex.Message, MsgBoxStyle.Critical)
ClassLogger.Add("Unexpected Error in DataFormats.FileDrop: " & ex.Message, True)
End Try
Try If e.Data.GetDataPresent(DataFormats.FileDrop) Then
If e.Data.GetDataPresent("FileGroupDescriptor") AndAlso (e.Data.GetDataPresent("FileContents")) Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Simple File Drop", False)
Console.WriteLine(">> FileGroupDescriptor/FileContents") Dim MyFiles() As String
If LogErrorsOnly = False Then ClassLogger.Add(" >> FileGroupDescriptor/FileContents", False) Dim i As Integer
'// the first step here is to get the stbFileName ' Assign the files to an array.
'// of the attachment and MyFiles = e.Data.GetData(DataFormats.FileDrop)
'// build a full-path name so we can store it ' Loop through the array and add the files to the list.
'// in the temporary folder For i = 0 To MyFiles.Length - 1
'// ClassLogger.Add(">> Simple FileDrop - File: " & MyFiles(i), False)
'// set up to obtain the aryFileGroupDescriptor ReDim Preserve files_dropped(i)
'// and extract the file name files_dropped(i) = "@DROPFROMFSYSTEM@" & MyFiles(i)
Dim stmInput As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream) ' ListBox1.Items.Add(MyFiles(i))
Dim aryFileGroupDescriptor(512) As Byte ' = new byte[512] Next
stmInput.Read(aryFileGroupDescriptor, 0, 512) Return True
'// used to build the stbFileName from the aryFileGroupDescriptor block ElseIf (e.Data.GetDataPresent("FileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then
Dim stbFileName As System.Text.StringBuilder = New System.Text.StringBuilder("") '// the first step here is to get the stbFileName
'// this trick gets the stbFileName of the passed attached file '// of the attachment and
Dim intCnt As Integer = 76 '// build a full-path name so we can store it
Do While aryFileGroupDescriptor(intCnt) <> 0 '// in the temporary folder
stbFileName.Append(Convert.ToChar(aryFileGroupDescriptor(intCnt), System.Globalization.CultureInfo.CreateSpecificCulture("de-DE"))) '//
intCnt += 1 '// set up to obtain the aryFileGroupDescriptor
Loop '// and extract the file name
stmInput.Close() Dim stmInput As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream)
Dim aryFileGroupDescriptor(512) As Byte ' = new byte[512]
stmInput.Read(aryFileGroupDescriptor, 0, 512)
'// used to build the stbFileName from the aryFileGroupDescriptor block
Dim stbFileName As System.Text.StringBuilder = New System.Text.StringBuilder("")
'// this trick gets the stbFileName of the passed attached file
Dim intCnt As Integer = 76
Do While aryFileGroupDescriptor(intCnt) <> 0
stbFileName.Append(Convert.ToChar(aryFileGroupDescriptor(intCnt), System.Globalization.CultureInfo.CreateSpecificCulture("de-DE")))
intCnt += 1
Loop
stmInput.Close()
Dim anhaenge = e.Data.GetDataPresent("FileContents") Dim anhaenge = e.Data.GetDataPresent("FileContents")
'Dim path As String = "C:\VBProjekte\Dateien" 'Dim path As String = "C:\VBProjekte\Dateien"
'// put the zip file into the temp directory '// put the zip file into the temp directory
Dim strOutFile As String = Path.GetTempPath() & stbFileName.ToString() Dim strOutFile As String = Path.GetTempPath() & stbFileName.ToString()
'// create the full-path name '// create the full-path name
'// '//
'// Second step: we have the file name. '// Second step: we have the file name.
'// Now we need to get the actual raw '// Now we need to get the actual raw
'// data for the attached file and copy it to disk so we work on it. '// data for the attached file and copy it to disk so we work on it.
'// '//
'// get the actual raw file into memory '// get the actual raw file into memory
Dim msInput As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream) 'This returns nothing for an Email Dim msInput As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream) 'This returns nothing for an Email
If msInput Is Nothing = False Then If msInput Is Nothing = False Then
'// allocate enough bytes to hold the raw date If LogErrorsOnly = False Then ClassLogger.Add(" >> Drag of Outlook Attachment", False)
Dim aryFileBytes(CType(msInput.Length, Int32)) As Byte '// allocate enough bytes to hold the raw date
'// set starting position at first byte and read in the raw data Dim aryFileBytes(CType(msInput.Length, Int32)) As Byte
msInput.Position = 0 '// set starting position at first byte and read in the raw data
msInput.Read(aryFileBytes, 0, CType(msInput.Length, Int32)) msInput.Position = 0
'// create a file and save the raw zip file to it msInput.Read(aryFileBytes, 0, CType(msInput.Length, Int32))
Dim fsOutput As IO.FileStream = New IO.FileStream(strOutFile, IO.FileMode.Create) '; '// create a file and save the raw zip file to it
fsOutput.Write(aryFileBytes, 0, aryFileBytes.Length) Dim fsOutput As IO.FileStream = New IO.FileStream(strOutFile, IO.FileMode.Create) ';
fsOutput.Close() ' // close the file fsOutput.Write(aryFileBytes, 0, aryFileBytes.Length)
fsOutput.Close() ' // close the file
Dim finTemp As IO.FileInfo = New IO.FileInfo(strOutFile) Dim resultVersion = ClassHelper.Versionierung_Datei(strOutFile)
'// always good to make sure we actually created the file If resultVersion <> "" Then
If (finTemp.Exists = True) Then strOutFile = resultVersion
'MsgBox("Attachment File from Outlook created:" & vbNewLine & strOutFile) End If
' lblFile.Text += "Attachment File from Outlook created" + Environment.NewLine Dim finTemp As IO.FileInfo = New IO.FileInfo(strOutFile)
Console.WriteLine(">> Drop of a mailattachment - File") '// always good to make sure we actually created the file
ReDim Preserve files_dropped(0) If (finTemp.Exists = True) Then
files_dropped(0) = "@OUTLOOK_ATTMNT@" & strOutFile ReDim Preserve files_dropped(0)
TEMP_FILES.Add(strOutFile) files_dropped(0) = "@OUTLOOK_ATTACHMENT@" & strOutFile
If LogErrorsOnly = False Then ClassLogger.Add(" >> Drop an Attachment - File: " & strOutFile, False) If LogErrorsOnly = False Then ClassLogger.Add(">> Drop an Attachment - File: " & strOutFile, False)
Return files_dropped Return True
Else Else
ClassLogger.Add(">> Attachment File from Outlook could not be created", False) ClassLogger.Add(">> Attachment File from Outlook could not be created", False)
'lblFile.Text += "Attachment File from Outlook could not be created" + Environment.NewLine
End If
End If End If
End If End If
Catch ex As Exception End If
MsgBox("Unexpected Error in DropFile||Attachment: " & ex.Message, MsgBoxStyle.Critical) If e.Data.GetDataPresent("FileGroupDescriptor") Then
ClassLogger.Add("Unexpected Error in Drop Attachment: " & ex.Message, True) Dim oApp
End Try Try
oApp = New Outlook.Application()
Try Catch ex As Exception
If e.Data.GetDataPresent("FileGroupDescriptor") Then MsgBox("Unexpected error in Initialisieren von Outlook-API:" & vbNewLine & ex.Message & vbNewLine & vbNewLine & "Evtl ist Outlook nicht in der dafür vorgesehenen For")
Console.WriteLine(">> FileGroupDescriptor") Return False
If LogErrorsOnly = False Then ClassLogger.Add(" >> Drop of OutlookMessage", False) End Try
Dim oApp As New Outlook.Application If LogErrorsOnly = False Then ClassLogger.Add(" >> Drop of msg", False)
'supports a drop of a Outlook message
'supports a drop of a Outlook message Dim myobj As Object
Dim myobj As Object For i As Integer = 1 To oApp.ActiveExplorer.Selection.Count
myobj = oApp.ActiveExplorer.Selection.Item(i)
For i As Integer = 1 To oApp.ActiveExplorer.Selection.Count Dim subj As String = myobj.Subject
myobj = oApp.ActiveExplorer.Selection.Item(i) If subj = "" Then
subj = "NO_SUBJECT"
'hardcode a destination path for testing End If
Dim strFile As String = IO.Path.Combine(Path.GetTempPath, (myobj.Subject + ".msg").Replace(":", "")) If subj.Contains("\") Then
subj = subj.Replace("\", "-")
End If
If subj.Contains("/") Then
subj = subj.Replace("/", "-")
End If
'hardcode a destination path for testing
Dim strFile As String = IO.Path.Combine(Path.GetTempPath, (subj + ".msg").Replace(":", ""))
strFile = strFile.Replace("?", "")
strFile = strFile.Replace("!", "")
strFile = strFile.Replace("%", "")
strFile = strFile.Replace("$", "")
ClassLogger.Add(">> Drop of msg - File:" & strFile, False)
Try
myobj.SaveAs(strFile) myobj.SaveAs(strFile)
TEMP_FILES.Add(strFile) Catch ex As Exception
ReDim Preserve files_dropped(i) MsgBox("Error in Save Email2Tempfile" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
files_dropped(i) = "@OUTLOOKMESSAGE@" & strFile Return False
Next End Try
Return files_dropped
End If
Catch ex As Exception
MsgBox("Unexpected Error in DropFile||OutlookMessage: " & ex.Message, MsgBoxStyle.Critical)
ClassLogger.Add("Unexpected Error in Drop OutlookMessage: " & ex.Message, True)
End Try
ReDim Preserve files_dropped(i)
files_dropped(i) = "@OUTLOOK_MESSAGE@" & strFile
Next
Return True
'Drop eines Outlook Attachments
End If
Catch ex As Exception Catch ex As Exception
MsgBox("Unexpected Error in Drop_File: " & ex.Message, MsgBoxStyle.Critical) MsgBox("Unexpected Error in Drop_File: " & ex.Message, MsgBoxStyle.Critical)
@@ -137,28 +140,7 @@ Public Class ClassDragDrop
ReDim Preserve files_dropped(0) ReDim Preserve files_dropped(0)
files_dropped(0) = "@SCAN@" & Wert files_dropped(0) = "@SCAN@" & Wert
End If End If
'Else
' Dim files() As String = e.Data.GetData(DataFormats.FileDrop)
' Dim filestype() As String
' filestype = e.Data.GetData(DataFormats.CommaSeparatedValue)
' Dim sReader As New StreamReader(filestype(0))
' 'get the filename from the file without the path
' Dim file_name As String = Path.GetFileName(filestype(0))
' 'check the extension of the file
' If Path.GetExtension(filestype(0)).ToLower() = ".xml" Then
' 'Read the xml file
' For Each path In files
' 'ReadXMLFile(path)
' Next
' Else
' 'warning about the file type
' MessageBox.Show("Only XML files are supported!", "Warning!", _
'MessageBoxButtons.OK, _
' MessageBoxIcon.Warning)
' End If
'End If
End Function End Function
Public Shared Sub Drag_enter(e As DragEventArgs) Public Shared Sub Drag_enter(e As DragEventArgs)

29
app/DD-Record-Organiser/ClassHelper.vb
View File

@@ -50,4 +50,33 @@ Public Class ClassHelper
End If End If
Return inuse Return inuse
End Function End Function
Public Shared Function Versionierung_Datei(Dateiname As String)
Dim extension
Dim _NewFileString
Try
Dim version As Integer = 1
Dim Stammname As String = Path.GetDirectoryName(Dateiname) & "\" & Path.GetFileNameWithoutExtension(Dateiname)
extension = Path.GetExtension(Dateiname)
Dim _neuername As String = Stammname
'Dim MoveFilename As String = DATEINAME.Replace(element.Value, "")
'Überprüfen ob File existiert
If File.Exists(_neuername & extension) = False Then
_NewFileString = _neuername
Else
Do While File.Exists(_neuername & extension)
version = version + 1
_neuername = Stammname & "~" & version
_NewFileString = _neuername
Loop
End If
Return _NewFileString & extension
Catch ex As Exception
ClassLogger.Add(" - Error in versioning file - error: " & vbNewLine & ex.Message)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in versioning file:")
Return ""
End Try
End Function
End Class End Class

36
app/DD-Record-Organiser/ClassInit.vb
View File

@@ -50,7 +50,7 @@ Public Class ClassInit
End Sub End Sub
Public Sub InitUserLogin() Public Shared Function InitUserLogin()
Dim sql = sql_UserID Dim sql = sql_UserID
sql = sql.Replace("@user", Environment.UserName) sql = sql.Replace("@user", Environment.UserName)
ClassLogger.Add(">> Neuanmeldung am System: " & Now.ToString, False) ClassLogger.Add(">> Neuanmeldung am System: " & Now.ToString, False)
@@ -58,10 +58,16 @@ Public Class ClassInit
USER_GUID = ClassDatabase.Execute_Scalar(sql) USER_GUID = ClassDatabase.Execute_Scalar(sql)
If USER_GUID Is Nothing Then If USER_GUID Is Nothing Then
ClassLogger.Add(" - User: " & Environment.UserName & " nicht in der Userverwaltung hinterlegt!", False) ClassLogger.Add(" - User '" & Environment.UserName & "' not listed in Useradminsitration!", False)
'MsgBox("Achtung: Sie sind nicht in der Userverwaltung hinterlegt." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!", MsgBoxStyle.Critical, "Achtung:") 'MsgBox("Achtung: Sie sind nicht in der Userverwaltung hinterlegt." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!", MsgBoxStyle.Critical, "Achtung:")
'Me.Close() 'Me.Close()
Throw New Exception("Sie sind nicht in der Userverwaltung hinterlegt." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!") Dim msg = String.Format("Sie sind nicht in der Userverwaltung hinterlegt." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!")
If USER_LANGUAGE <> "de-DE" Then
msg = String.Format("You are not listed in the Useradministration." & vbNewLine & "Please contact the admin.")
End If
MsgBox(msg, MsgBoxStyle.Exclamation)
Return False
Else Else
USER_LANGUAGE = ClassDatabase.Execute_Scalar("SELECT LANGUAGE FROM TBDD_USER WHERE GUID = " & USER_GUID, False) USER_LANGUAGE = ClassDatabase.Execute_Scalar("SELECT LANGUAGE FROM TBDD_USER WHERE GUID = " & USER_GUID, False)
Dim DT_CLIENT_USER As DataTable = ClassDatabase.Return_Datatable("SELECT CLIENT_ID FROM TBDD_CLIENT_USER WHERE USER_ID = " & USER_GUID) Dim DT_CLIENT_USER As DataTable = ClassDatabase.Return_Datatable("SELECT CLIENT_ID FROM TBDD_CLIENT_USER WHERE USER_ID = " & USER_GUID)
@@ -82,7 +88,13 @@ Public Class ClassInit
If ClassDatabase.Execute_Scalar(sql) = False Then If ClassDatabase.Execute_Scalar(sql) = False Then
ClassLogger.Add(" - User: " & Environment.UserName & " nicht für Modul freigegben!", False) ClassLogger.Add(" - User: " & Environment.UserName & " nicht für Modul freigegben!", False)
'MsgBox("Achtung: Sie sind nicht für die Nutzung dieses Moduls freigeschaltet." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!", MsgBoxStyle.Critical, "Achtung:") 'MsgBox("Achtung: Sie sind nicht für die Nutzung dieses Moduls freigeschaltet." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!", MsgBoxStyle.Critical, "Achtung:")
Throw New Exception("Sie sind nicht für die Nutzung dieses Moduls freigeschaltet." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!") Dim msg = String.Format("Sie sind nicht für die Nutzung dieses Moduls freigeschaltet." & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!")
If USER_LANGUAGE <> "de-DE" Then
msg = String.Format("You are not authorized for using this module." & vbNewLine & "Please contact the admin.")
End If
MsgBox(msg, MsgBoxStyle.Exclamation)
Return False
'Me.Close() 'Me.Close()
Else Else
'Am System anmelden 'Am System anmelden
@@ -115,13 +127,20 @@ Public Class ClassInit
'#### '####
If LICENSE_COUNT < USERS_LOGGED_IN And LICENSE_EXPIRED = False Then If LICENSE_COUNT < USERS_LOGGED_IN And LICENSE_EXPIRED = False Then
MsgBox("Die Anzahl der aktuell angemeldeten User (" & USERS_LOGGED_IN.ToString & ") überschreitet die Anzahl der aktuellen Lizenzen!" & vbNewLine & "Anzahl der Lizenzen: " & LICENSE_COUNT.ToString & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!", MsgBoxStyle.Critical, "Achtung:") Dim msg = String.Format("Die Anzahl der aktuell angemeldeten User (" & USERS_LOGGED_IN.ToString & ") überschreitet die Anzahl der aktuellen Lizenzen!" & vbNewLine & "Anzahl der Lizenzen: " & LICENSE_COUNT.ToString & vbNewLine & "Bitte setzen Sie sich mit dem Systembetreuer in Verbindung!")
ClassLogger.Add(" >> Die Anzahl der aktuell angemeldeten User (" & USERS_LOGGED_IN.ToString & ") überschreitet die Anzahl der Lizenzen (" & LICENSE_COUNT & ") für Record-Organizer!", False)
If USER_LANGUAGE <> "de-DE" Then
msg = String.Format("The number of logged Users (" & USERS_LOGGED_IN.ToString & ") exceeds the number of licenses." & vbNewLine & _
"Number of licenses: " & LICENSE_COUNT.ToString & vbNewLine & "Please contact Your admin!")
End If
MsgBox(msg, MsgBoxStyle.Exclamation)
ClassLogger.Add(" >> The number of logged Users (" & USERS_LOGGED_IN.ToString & ") exceeds the number of licenses (" & LICENSE_COUNT & ") ", False)
If USER_IS_ADMIN = False Then If USER_IS_ADMIN = False Then
'Anmeldung wieder herausnehmen 'Anmeldung wieder herausnehmen
sql = "DELETE FROM TBDD_USER_MODULE_LOG_IN WHERE USER_ID = " & USER_GUID & " AND MODULE= 'RECORD_ORGANIZER'" sql = "DELETE FROM TBDD_USER_MODULE_LOG_IN WHERE USER_ID = " & USER_GUID & " AND MODULE= 'RECORD_ORGANIZER'"
ClassDatabase.Execute_non_Query(sql, True) ClassDatabase.Execute_non_Query(sql, True)
ClassLogger.Add(" - Wieder abgemeldet", False) ClassLogger.Add(" - logged out the user", False)
Return False
End If End If
Else Else
Try Try
@@ -137,6 +156,7 @@ Public Class ClassInit
End If End If
Catch ex As Exception Catch ex As Exception
ClassLogger.Add("Unexpected Error in Init_Folderwatch: " & ex.Message, True) ClassLogger.Add("Unexpected Error in Init_Folderwatch: " & ex.Message, True)
Return False
End Try End Try
End If End If
@@ -145,6 +165,6 @@ Public Class ClassInit
'LabelLoggedIn.Caption = "Anzahl Angemeldete User: " & anzahl.ToString 'LabelLoggedIn.Caption = "Anzahl Angemeldete User: " & anzahl.ToString
End If End If
End If End If
End Sub End Function
End Class End Class

6
app/DD-Record-Organiser/frmConstructor_Main.vb
View File

@@ -3186,8 +3186,10 @@ Public Class frmConstructor_Main
End If End If
Else Else
CURRENT_RECORD_ID = RECORD_ID CURRENT_RECORD_ID = RECORD_ID
ClassDragDrop.Drop_File(e) If ClassDragDrop.Drop_File(e) = True Then
Check_Dropped_Files() Check_Dropped_Files()
End If
End If End If
End If End If
End Sub End Sub

106
app/DD-Record-Organiser/frmMain.vb
View File

@@ -60,36 +60,40 @@ Public Class frmMain
End Try End Try
End Sub End Sub
Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load
Try ' Referenz zu frmMain speichern
' Referenz zu frmMain speichern MAIN_FORM = Me
MAIN_FORM = Me If ERROR_INIT <> "INVALID USER" Then
Try
' Form Titel setzen
ClassWindowLocation.LoadFormLocationSize(Me, 1, CURRENT_SCREEN_ID, "frmMain")
Dim i = My.Application.UICulture.ToString()
' Form Titel setzen 'Dim splash As New frmSplash()
ClassWindowLocation.LoadFormLocationSize(Me, 1, CURRENT_SCREEN_ID, "frmMain") 'splash.ShowDialog()
Dim i = My.Application.UICulture.ToString()
'Dim splash As New frmSplash() ' MainForm Hintergrund laden
'splash.ShowDialog() SetBackgroundImage()
' MainForm Hintergrund laden Me.Text = Application.ProductName
SetBackgroundImage() LabelVersion.Caption = String.Format("Version {0}", My.Application.Info.Version.ToString)
LabelUser.Caption = Environment.UserName
LabelMachine.Caption = My.Computer.Name
LabelLanguage.Caption = "Language: " & USER_LANGUAGE
Load_Connection_Dep_Data()
'Wenn Argumente übergeben wurden, wird Formular geladen und zu record gesprungen
ClassJumpRecord.ParseArgs()
If Task_Popup_minutes <> 0 Then
TimerTasks.Interval = Task_Popup_minutes * 60000
End If
Catch ex As Exception
MsgBox("Error in Load Form:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End If
Me.Text = Application.ProductName
LabelVersion.Caption = String.Format("Version {0}", My.Application.Info.Version.ToString)
LabelUser.Caption = Environment.UserName
LabelMachine.Caption = My.Computer.Name
LabelLanguage.Caption = "Language: " & USER_LANGUAGE
Load_Connection_Dep_Data()
'Wenn Argumente übergeben wurden, wird Formular geladen und zu record gesprungen
ClassJumpRecord.ParseArgs()
If Task_Popup_minutes <> 0 Then
TimerTasks.Interval = Task_Popup_minutes * 60000
End If
Catch ex As Exception
MsgBox("Error in Load Form:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub End Sub
Sub Load_Connection_Dep_Data() Sub Load_Connection_Dep_Data()
SetBackground() SetBackground()
@@ -105,6 +109,8 @@ Public Class frmMain
LoadQuickStartItems() LoadQuickStartItems()
ElseIf ERROR_INIT = "DATABASE" Then ElseIf ERROR_INIT = "DATABASE" Then
Load_ConfigBasic() Load_ConfigBasic()
ElseIf ERROR_INIT = "INVALID USER" Then
End If End If
Load_TasksforUser() Load_TasksforUser()
End Sub End Sub
@@ -118,6 +124,9 @@ Public Class frmMain
End Try End Try
End Sub End Sub
Private Sub frmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing Private Sub frmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
If ERROR_INIT = "INVALID USER" Then
Exit Sub
End If
Try Try
Dim sql = "UPDATE TBDD_USER SET LOGGED_IN = @LogInOut, LOGGED_WHERE = '@ANGEMELDETWO' WHERE (LOWER(USERNAME) = LOWER('@user'))" Dim sql = "UPDATE TBDD_USER SET LOGGED_IN = @LogInOut, LOGGED_WHERE = '@ANGEMELDETWO' WHERE (LOWER(USERNAME) = LOWER('@user'))"
sql = sql.Replace("@LogInOut", 0) sql = sql.Replace("@LogInOut", 0)
@@ -450,33 +459,38 @@ Public Class frmMain
End Sub End Sub
Private Sub frmMain_Shown(sender As Object, e As EventArgs) Handles Me.Shown Private Sub frmMain_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Refresh_TaskReminder() If ERROR_INIT <> "INVALID USER" Then
If Task_Popup_minutes <> 0 Then Refresh_TaskReminder()
TimerTasks.Start() If Task_Popup_minutes <> 0 Then
End If TimerTasks.Start()
End If
RUN_TIMER() RUN_TIMER()
If Sett_ConstructorStart <> 0 Then If Sett_ConstructorStart <> 0 Then
Cursor = Cursors.WaitCursor Cursor = Cursors.WaitCursor
OpenFormConstructor(Sett_ConstructorStart) OpenFormConstructor(Sett_ConstructorStart)
Cursor = Cursors.Default Cursor = Cursors.Default
End If End If
'Lizenz abgellaufen, überprüfen ob User Admin ist 'Lizenz abgellaufen, überprüfen ob User Admin ist
If LICENSE_COUNT < USERS_LOGGED_IN Then If LICENSE_COUNT < USERS_LOGGED_IN Then
If USER_IS_ADMIN = True Then If USER_IS_ADMIN = True Then
ClassLogger.Add(">> User is Admin - Timer will be started", False) ClassLogger.Add(">> User is Admin - Timer will be started", False)
'If USER_LANGUAGE = "de-DE" Then 'If USER_LANGUAGE = "de-DE" Then
MsgBox("Sie haben nun 3 Minuten Zeit eine neue Lizenz zu vergeben!", MsgBoxStyle.Information) MsgBox("You now got 3 minutes for creating a new license", MsgBoxStyle.Information)
'Else 'Else
' MsgBox("You now got 3 minutes to update the license!", MsgBoxStyle.Information) ' MsgBox("You now got 3 minutes to update the license!", MsgBoxStyle.Information)
'End If 'End If
'Timer starten 'Timer starten
If TimerClose3Minutes.Enabled = False Then If TimerClose3Minutes.Enabled = False Then
TimerClose3Minutes.Start() TimerClose3Minutes.Start()
End If
End If End If
End If End If
Else
Me.Close()
End If End If
'If DOCTYPE_COUNT_ACTUAL > LICENSE_DOCTYPE_COUNT Then 'If DOCTYPE_COUNT_ACTUAL > LICENSE_DOCTYPE_COUNT Then
' If CURRENT_USER_IS_ADMIN = True Then ' If CURRENT_USER_IS_ADMIN = True Then
' ClassLogger.Add(">> User is Admin - Timer will be started", False) ' ClassLogger.Add(">> User is Admin - Timer will be started", False)

4
app/DD-Record-Organiser/frmSplash.vb
View File

@@ -78,7 +78,9 @@ Public NotInheritable Class frmSplash
System.Threading.Thread.Sleep(300) System.Threading.Thread.Sleep(300)
bw.ReportProgress(CalcProgress(4), "Initializing User-Configuration") bw.ReportProgress(CalcProgress(4), "Initializing User-Configuration")
Init.InitUserLogin() If Init.InitUserLogin = False Then
ERROR_INIT = "INVALID USER"
End If
System.Threading.Thread.Sleep(500) System.Threading.Thread.Sleep(500)