Imports System.IO Imports Microsoft.Office.Interop Imports Independentsoft Imports DLLLicenseManager Imports System.Text Imports System.Globalization Imports System.Threading Imports System.Runtime.InteropServices Public Class frmStart Public _lizenzManager As ClassLicenseManager Dim loaded As Boolean = False Dim WithEvents HotKey As New clsHotkey(Me) 'Public Sub SetLanguage() ' Dim de = System.Globalization.CultureInfo.CurrentUICulture ' 'Neue Sprache festlegen und entfernen aller Controls ' Thread.CurrentThread.CurrentUICulture = New CultureInfo(USER_LANGUAGE) ' Me.Controls.Clear() ' 'Me.Events.Dispose() ' InitializeComponent() ' tslblCultureInfo.Text = "Culture/Language: " & USER_LANGUAGE ' Try ' Dim Ic As Icon = New Icon(Application.StartupPath & "\DD_Icons_ICO_GLOBIX_128.ico") ' If Not IsNothing(Ic) Then ' Me.Icon = Ic ' End If ' Catch ex As Exception ' ClassLogger.Add(">> Icon file could not be read: " & ex.Message, False) ' End Try ' 'Me.i() ' 'Wiederherstellen der Fensterposition ' 'Me.Size = sz ' 'Me.Location = pt 'End Sub Private Const mSnapOffset As Integer = 35 Private Const WM_WINDOWPOSCHANGING As Integer = &H46 _ Public Structure WINDOWPOS Public hwnd As IntPtr Public hwndInsertAfter As IntPtr Public x As Integer Public y As Integer Public cx As Integer Public cy As Integer Public flags As Integer End Structure Protected Overrides Sub WndProc(ByRef m As Message) ' Listen for operating system messages Select Case m.Msg Case WM_WINDOWPOSCHANGING SnapToDesktopBorder(Me, m.LParam, 0) End Select MyBase.WndProc(m) End Sub Public Shared Sub SnapToDesktopBorder(ByVal clientForm _ As Form, ByVal LParam As IntPtr, ByVal widthAdjustment As Integer) If clientForm Is Nothing Then ' Satisfies rule: Validate parameters Throw New ArgumentNullException("clientForm") End If ' Snap client to the top, left, bottom or right desktop border ' as the form is moved near that border. Try ' Marshal the LPARAM value which is a WINDOWPOS struct Dim NewPosition As New WINDOWPOS NewPosition = CType(Runtime.InteropServices.Marshal.PtrToStructure( _ LParam, GetType(WINDOWPOS)), WINDOWPOS) If NewPosition.y = 0 OrElse NewPosition.x = 0 Then Return ' Nothing to do! End If ' Adjust the client size for borders and caption bar Dim ClientRect As Rectangle = _ clientForm.RectangleToScreen(clientForm.ClientRectangle) ClientRect.Width += _ SystemInformation.FrameBorderSize.Width - widthAdjustment ClientRect.Height += (SystemInformation.FrameBorderSize.Height + _ SystemInformation.CaptionHeight) ' Now get the screen working area (without taskbar) Dim WorkingRect As Rectangle = _ Screen.GetWorkingArea(clientForm.ClientRectangle) ' Left border If NewPosition.x >= WorkingRect.X - mSnapOffset AndAlso _ NewPosition.x <= WorkingRect.X + mSnapOffset Then NewPosition.x = WorkingRect.X End If ' Get screen bounds and taskbar height ' (when taskbar is horizontal) Dim ScreenRect As Rectangle = _ Screen.GetBounds(Screen.PrimaryScreen.Bounds) Dim TaskbarHeight As Integer = _ ScreenRect.Height - WorkingRect.Height ' Top border (check if taskbar is on top ' or bottom via WorkingRect.Y) If NewPosition.y >= -mSnapOffset AndAlso _ (WorkingRect.Y > 0 AndAlso NewPosition.y <= _ (TaskbarHeight + mSnapOffset)) OrElse _ (WorkingRect.Y <= 0 AndAlso NewPosition.y <= _ (mSnapOffset)) Then If TaskbarHeight > 0 Then NewPosition.y = WorkingRect.Y ' Horizontal Taskbar Else NewPosition.y = 0 ' Vertical Taskbar End If End If ' Right border If NewPosition.x + ClientRect.Width <= _ WorkingRect.Right + mSnapOffset AndAlso _ NewPosition.x + ClientRect.Width >= _ WorkingRect.Right - mSnapOffset Then NewPosition.x = WorkingRect.Right - (ClientRect.Width + _ SystemInformation.FrameBorderSize.Width) End If ' Bottom border If NewPosition.y + ClientRect.Height <= _ WorkingRect.Bottom + mSnapOffset AndAlso _ NewPosition.y + ClientRect.Height >= _ WorkingRect.Bottom - mSnapOffset Then NewPosition.y = WorkingRect.Bottom - (ClientRect.Height + _ SystemInformation.FrameBorderSize.Height) End If ' Marshal it back Runtime.InteropServices.Marshal.StructureToPtr(NewPosition, _ LParam, True) Catch ex As ArgumentException End Try End Sub Private Sub frmMain_DragDrop(sender As Object, e As DragEventArgs) Handles MyBase.DragDrop DragDropForm(e) End Sub Sub DragDropForm(e As DragEventArgs) Dim frmCollection = System.Windows.Forms.Application.OpenForms If frmCollection.OfType(Of frmIndexFileList).Any Then MsgBox("Please index the active file/mail first!", MsgBoxStyle.Exclamation, "Drag 'n Drop not allowed!") ' TimerCheckDroppedFiles.Start() Exit Sub End If 'Erstmal alles löschen ClassDatabase.Execute_non_Query("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") If ClassDragDrop.Drop_File(e) = True Then TimerCheckDroppedFiles.Start() End If End Sub Private Sub ReceiveHotKey(ByVal HotKeyID As String) Handles HotKey.HotKeyPressed Dim CapTxt As String = ClassHotkey_Windream.GetCaption() CURRENT_FOCUSES_WINDOWNAME = CapTxt If CURRENT_FOCUSES_WINDOWNAME.ToUpper.StartsWith("GLOB") Then Exit Sub If LogErrorsOnly = False Then ClassLogger.Add(" ...Focused window result: '" & CURRENT_FOCUSES_WINDOWNAME & "'", False) Me.Cursor = Cursors.WaitCursor Me.NotifyIcon1.Visible = True NotifyIcon1.ShowBalloonTip(1000, "Hotkey", "Hotkey wird ausgeführt!", ToolTipIcon.Info) Try Dim _focusedWindowfound As Boolean = False Dim HK1 As String Dim HK2 As String 'Die Hotkeys definieren Dim SQL As String = "SELECT * FROM TBHOTKEYTEMP_USER_HOTKEYS WHERE HOTKEY_ID = " & HotKeyID Dim DTHOTKEYSTEMP As DataTable = ClassDatabase.Return_Datatable(SQL, True) If Not IsNothing(DTHOTKEYSTEMP) Then HK1 = DTHOTKEYSTEMP.Rows(0).Item("HOTKEY1") HK2 = DTHOTKEYSTEMP.Rows(0).Item("HOTKEY2") 'Alle Profile raussuchen die die Tastaturkombination enthalten SQL = "select * from TBHOTKEY_USER_PROFILE where UPPER(HOTKEY1) = UPPER('" & HK1 & "') AND UPPER(HOTKEY2) = UPPER('" & HK2 & "') AND USER_ID = " & USER_ID Dim DTHOTKEY_PROFILES As DataTable = ClassDatabase.Return_Datatable(SQL, True) Dim Result As String = "" If Not IsNothing(DTHOTKEY_PROFILES) Then 'Jedes Hotkeyprofil des Users durchlaufen um zu überprüfen ob das CURRENT_FOCUSES_WINDOWNAME = dem konfiguriertem ist For Each row As DataRow In DTHOTKEY_PROFILES.Rows SQL = "select WINDOW_NAME from TBHOTKEY_PROFILE where GUID = " & row.Item("HKPROFILE_ID") 'Konfigurierte windows-String speichern Dim windowconfigured = ClassDatabase.Execute_Scalar(SQL, MyConnectionString, True) 'Focuses window enthalten?? If CURRENT_FOCUSES_WINDOWNAME.ToUpper.Contains(windowconfigured.ToString.ToUpper) Or CURRENT_FOCUSES_WINDOWNAME.ToUpper = windowconfigured.ToString.ToUpper Then 'Ja - also die windream-Suche ausführen _focusedWindowfound = True Result = ClassHotkey_Windream.RUN_WD_SEARCH(row.Item("GUID")) End If Next If _focusedWindowfound = False Then Result = "Focused Window not configured in hotkey" End If End If If Result = "" Then Me.NotifyIcon1.Visible = False Else NotifyIcon1.ShowBalloonTip(5000, "Hotkey-Fehler:", Result.ToString, ToolTipIcon.Warning) End If End If Catch ex As Exception MsgBox("Error in ReceiveHotKey: " & ex.Message, MsgBoxStyle.Critical) End Try Me.Cursor = Cursors.Default End Sub Private Sub frmMain_DragEnter(sender As Object, e As DragEventArgs) Handles Me.DragEnter Drag_Enter(sender, e) End Sub Sub Drag_Enter(sender As Object, e As DragEventArgs) If e.Data.GetDataPresent(DataFormats.FileDrop) Then e.Effect = DragDropEffects.All ' Console.WriteLine("DragEnter ...DragDrop") ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then 'handle a message dragged from Outlook e.Effect = DragDropEffects.Copy ' Console.WriteLine("DragEnter ...OutlookMessage") ElseIf e.Data.GetDataPresent("aryFileGroupDescriptor") AndAlso (e.Data.GetDataPresent("FileContents")) Then e.Effect = DragDropEffects.Copy ' Console.WriteLine("DragEnter ...Attachment from Outlook") Else 'otherwise, do not handle e.Effect = DragDropEffects.None End If End Sub Sub Check_Dropped_Files() Try Me.TopMost = False ClassDatabase.Execute_non_Query("DELETE FROM TBGI_FILES_USER WHERE WORKED = 1 AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") Dim i As Integer For Each Str As Object In ClassDragDrop.files_dropped If Not Str Is Nothing Then If LogErrorsOnly = False Then ClassLogger.Add(">> Check Drop-File: " & Str.ToString, False) Dim handleType As String = Str.Substring(0, Str.LastIndexOf("|") + 1) Dim filename As String = Str.Substring(Str.LastIndexOf("|") + 1) If ClassIndexFunctions.FileExistsinDropTable(filename) = False Then ClassFilehandle.Decide_FileHandle(filename, handleType) i += 1 Else ' Console.WriteLine("File gibt es bereits") End If End If Next Dim sql As String = "SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')" DTACTUAL_FILES = Nothing DTACTUAL_FILES = ClassDatabase.Return_Datatable(sql, True) ABORT_INDEXING = False If DTACTUAL_FILES.Rows.Count > 1 Then frmIndexFileList.ShowDialog() DTACTUAL_FILES = Nothing DTACTUAL_FILES = ClassDatabase.Return_Datatable(sql, True) End If For Each Filerow As DataRow In DTACTUAL_FILES.Rows Dim filestring As String = Filerow.Item("FILENAME2WORK") CURRENT_FILENAME = Filerow.Item("FILENAME2WORK") CURRENT_WORKFILE_GUID = Filerow.Item(0) CURRENT_WORKFILE = Filerow.Item("FILENAME2WORK") If LogErrorsOnly = False Then ClassLogger.Add(">> CURRENT_WORKFILE: " & CURRENT_WORKFILE, False) If File.Exists(CURRENT_WORKFILE) = True Then Open_IndexDialog() End If Next Catch ex As Exception If Not ex.Message.StartsWith("Die Auflistung wurde geändert") Then MsgBox("Unexpected Error in Check_Dropped_Files:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End If End Try Me.TopMost = True End Sub Sub Open_IndexDialog() Me.Hide() frmIndex.ShowDialog() Me.Visible = True Me.TopMost = True Me.BringToFront() End Sub Private Sub frmStart_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing If My.Settings.AppTerminate = False Then Try ClassLogger.Add("", False) If START_INCOMPLETE = False Then Dim Sql = "DELETE FROM TBDD_USER_MODULE_LOG_IN WHERE USER_ID = " & USER_ID & " AND UPPER(MODULE) = UPPER('Global-Indexer')" ClassDatabase.Execute_non_Query(Sql, True) End If ClassWindowLocation.SaveFormLocationSize(Me) Catch ex As Exception MsgBox("Unexpected Error in Closing Application: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try If USER_ID > 0 Then Unregister_Hotkeys() End If 'TempDateien löschen Try For Each _file In TEMP_FILES System.IO.File.Delete(_file) Next Catch ex As Exception End Try End If End Sub Public Sub New() Dim splash As New frmSplash() splash.ShowDialog() Thread.CurrentThread.CurrentUICulture = New CultureInfo(USER_LANGUAGE) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Private Sub frmStart_Load(sender As Object, e As EventArgs) Handles Me.Load If My.Settings.AppTerminate = True Then Exit Sub End If 'Me.TransparencyKey = Color.Transparent ' Me.BackColor = Color.Transparent Cursor = Cursors.WaitCursor ' My.Application.ChangeUICulture("en") 'My.Application.ChangeCulture("en") Dim i = My.Application.UICulture.ToString() Try 'Dim sql = sql_UserID 'Dim splash As New frmSplash() 'splash.ShowDialog() 'Lizenz abgellaufen, überprüfen ob User Admin ist If LICENSE_COUNT < UserLoggedin Then If USER_IS_ADMIN = True Then ClassLogger.Add(">> User is Admin - Timer will be started", False) If USER_LANGUAGE = "de-DE" Then MsgBox("Sie haben nun 3 Minuten Zeit eine neue Lizenz zu vergeben!", MsgBoxStyle.Information) Else MsgBox("You now got 3 minutes to update the license!", MsgBoxStyle.Information) End If 'Timer starten If TimerClose3Minutes.Enabled = False Then TimerClose3Minutes.Start() End If End If End If If DOCTYPE_COUNT_ACTUAL > LICENSE_DOCTYPE_COUNT Then If USER_IS_ADMIN = True Then ClassLogger.Add(">> User is Admin - Timer will be started", False) If USER_LANGUAGE = "de-DE" Then MsgBox("Sie haben nun 3 Minuten Zeit eine neue Lizenz zu vergeben!", MsgBoxStyle.Information) Else MsgBox("You now got 3 minutes to update the license!", MsgBoxStyle.Information) End If 'Timer starten If TimerClose3Minutes.Enabled = False Then TimerClose3Minutes.Start() End If End If End If ' SetLanguage() If USER_IS_ADMIN = True Then ToolStripSeparator1.Visible = True AdministrationToolStripMenuItem.Visible = True Else ToolStripSeparator1.Visible = False AdministrationToolStripMenuItem.Visible = False End If ClassDatabase.Execute_non_Query("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')", True) Unregister_Hotkeys() Load_Hotkeys() Me.Opacity = 30 Catch ex As Exception MsgBox("Unexpected Error in Load-Form" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Cursor = Cursors.Default End Sub Sub Start_Folderwatch() If CURRENT_FOLDERWATCH = String.Empty Then FW_started = False End If If CURRENT_SCAN_FOLDERWATCH = String.Empty Then FWSCAN_started = False End If If CURRENT_FOLDERWATCH <> "" Or CURRENT_SCAN_FOLDERWATCH <> "" Then If FW_ISSTARTED = True Then tslblFW.Visible = True Else tslblFW.Visible = False End If Try If FWSCAN_started = True Then If LogErrorsOnly = False Then ClassLogger.Add(">> FWSCAN started - Checking file:" & CURRENT_SCAN_FOLDERWATCH, False) Dim fileEntries As String() = Directory.GetFiles(CURRENT_SCAN_FOLDERWATCH) ' Process the list of files found in the directory. Dim fileName As String For Each fileName In fileEntries If LogErrorsOnly = False Then ClassLogger.Add(">> Scanfolder after startup: Checking file:" & fileName, False) For Each row As DataRow In DTEXCLUDE_FILES.Rows Dim content As String = row.Item(0).ToString.ToLower If fileName.ToLower.Contains(content) Then Exit Sub End If Next Dim handleType As String If fileName.ToLower.EndsWith(".msg") Then handleType = "|FW_OUTLOOK_MESSAGE|" Else handleType = "|FW_SIMPLEINDEXER|" End If 'Die Datei übergeben If LogErrorsOnly = False Then ClassLogger.Add(">> Adding file from Scanfolder after startup:" & fileName, False) If ClassIndexFunctions.FileExistsinDropTable(fileName) = False Then ClassFilehandle.Decide_FileHandle(fileName, handleType) Else ClassLogger.Add(">> Scanfolder Startup: File already exists:" & fileName, False) End If Next fileName Else If LogErrorsOnly = False Then ClassLogger.Add(">> FWSCAN not started", False) End If Catch ex As Exception ClassLogger.Add(">> Error while starting folderwatch scan: " & ex.Message, False) End Try Try If FW_started = True Then If LogErrorsOnly = False Then ClassLogger.Add(">> FW_started started - Checking file:" & CURRENT_FOLDERWATCH, False) Dim fileEntries As String() = Directory.GetFiles(CURRENT_FOLDERWATCH) ' Process the list of files found in the directory. Dim fileName As String For Each fileName In fileEntries If LogErrorsOnly = False Then ClassLogger.Add(">> Folderwach after startup: Checking file:" & fileName, False) For Each row As DataRow In DTEXCLUDE_FILES.Rows Dim content As String = row.Item(0).ToString.ToLower If fileName.ToLower.Contains(content) Then Exit Sub End If Next Dim handleType As String If fileName.ToLower.EndsWith(".msg") Then handleType = "|FW_OUTLOOK_MESSAGE|" Else handleType = "|FW_SIMPLEINDEXER|" End If 'Die Datei übergeben If LogErrorsOnly = False Then ClassLogger.Add(">> Adding file from Folderwatch after startup:" & fileName, False) If ClassIndexFunctions.FileExistsinDropTable(fileName) = False Then ClassFilehandle.Decide_FileHandle(fileName, handleType) Else ClassLogger.Add(">> Folderwatch Startup: File already exists:" & fileName, False) End If Next fileName Else If LogErrorsOnly = False Then ClassLogger.Add(">> FW_started not started", False) End If Catch ex As Exception ClassLogger.Add(">> Error while starting folderwatch: " & ex.Message, False) End Try If TimerFolderWatch.Enabled = False Then TimerFolderWatch.Start() End If End If End Sub Sub Unregister_Hotkeys() Try Dim sql As String = "Select * from TBHOTKEYTEMP_USER_HOTKEYS where [USER_ID] = " & USER_ID Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, True) If Not IsNothing(DT) Then For Each row As DataRow In DT.Rows HotKey.RemoveHotKey(row.Item("HOTKEY_ID")) Next sql = "delete from TBHOTKEYTEMP_USER_HOTKEYS where [USER_ID] = " & USER_ID ClassDatabase.Execute_non_Query(sql, True) End If Catch ex As Exception MsgBox("Error in Unregister_Hotkeys:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Load_Hotkeys() Try Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT HOTKEY1, HOTKEY2, ABS(CONVERT(INT, CONVERT(binary(4), NEWID()))) AS HOTKEY_ID FROM TBHOTKEY_USER_PROFILE WHERE USER_ID = " & USER_ID & " GROUP BY HOTKEY1, HOTKEY2", True) If DT.Rows.Count > 0 Then If LogErrorsOnly = False Then ClassLogger.Add(" >> " & DT.Rows.Count & " Hotkey-Profile", False) Dim i As Integer = 0 For Each row As DataRow In DT.Rows i += 1 Dim sql As String = "INSERT INTO TBHOTKEYTEMP_USER_HOTKEYS (HOTKEY_ID,HOTKEY1,HOTKEY2,[USER_ID]) VALUES (" & row.Item("HOTKEY_ID") & ", '" & row.Item("HOTKEY1") & "', '" & row.Item("HOTKEY2") & "', " & USER_ID & ")" ClassDatabase.Execute_non_Query(sql, True) Dim keyCode As Keys Try Dim kc As New KeysConverter Dim obj As Object = kc.ConvertFromString(row.Item("HOTKEY2").ToString.ToUpper) keyCode = CType(obj, Keys) Catch ex As Exception MsgBox("Error in Convert Key:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Exit Sub End Try Select Case row.Item("HOTKEY1") Case "Strg" If LogErrorsOnly = False Then ClassLogger.Add(" >>" & i.ToString + "|Strg " & row.Item("HOTKEY2").ToString.ToUpper, False) HotKey.AddHotKey(keyCode, clsHotkey.MODKEY.MOD_CONTROL, row.Item("HOTKEY_ID")) Case "Shift" If LogErrorsOnly = False Then ClassLogger.Add(" >>" & i.ToString + "|Shift " & row.Item("HOTKEY2").ToString.ToUpper, False) HotKey.AddHotKey(keyCode, clsHotkey.MODKEY.MOD_SHIFT, row.Item("HOTKEY_ID")) Case "Alt" If LogErrorsOnly = False Then ClassLogger.Add(" >>" & i.ToString + "|Alt " & row.Item("HOTKEY2").ToString.ToUpper, False) HotKey.AddHotKey(keyCode, clsHotkey.MODKEY.MOD_ALT, row.Item("HOTKEY_ID")) Case "win" If LogErrorsOnly = False Then ClassLogger.Add(" >>" & i.ToString + "|Win " & row.Item("HOTKEY2").ToString.ToUpper, False) HotKey.AddHotKey(keyCode, clsHotkey.MODKEY.MOD_WIN, row.Item("HOTKEY_ID")) End Select Next Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Keine Hotkeys!", False) End If Catch ex As Exception MsgBox("Error in Load_Hotkeys:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub HotkeyEisntellungenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles HotkeyEisntellungenToolStripMenuItem.Click If ClassLicence.license_is_Valid = True Then Me.Hide() Unregister_Hotkeys() frmHotKey_Add.ShowDialog() Load_Hotkeys() Me.Visible = True End If End Sub Private Sub GlobalIndexerEinstellungenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles GlobalIndexerEinstellungenToolStripMenuItem.Click Me.Hide() frmAdministration.ShowDialog() Me.Visible = True End Sub Private Sub GrundeinstellungenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles GrundeinstellungenToolStripMenuItem.Click Me.TopMost = False frmConfig_Basic.ShowDialog() 'Wurde die Sprache in der Konfiguration geändert If LANGUAGE_CHANGED = True Then If USER_LANGUAGE = "de-DE" Then MsgBox("Zur letzendlichen Neukonfiguration der Sprache ist ein Neustart notwendig!", MsgBoxStyle.Information) Else MsgBox("For the final changing of language, a restart is required!", MsgBoxStyle.Information) End If Application.Restart() ''Sprache anpassen 'SetLanguage() 'LANGUAGE_CHANGED = False 'If USER_IS_ADMIN = True Then ' ToolStripSeparator1.Visible = True ' AdministrationToolStripMenuItem.Visible = True 'Else ' ToolStripSeparator1.Visible = False ' AdministrationToolStripMenuItem.Visible = False 'End If End If Start_Folderwatch() Me.TopMost = True End Sub Private Sub FrmHotkeyAddToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles FrmHotkeyAddToolStripMenuItem.Click If ClassLicence.license_is_Valid = True Then Me.Hide() Unregister_Hotkeys() frmHotkey_User.ShowDialog() Load_Hotkeys() Me.Visible = True End If End Sub Private Sub TimerFolderWatch_Tick(sender As Object, e As EventArgs) Handles TimerFolderWatch.Tick If ClassDatabase.DatabaseConnectionTimeout = True Then TimerFolderWatch.Enabled = False Dim title = "Critical Error" Dim message = $"Database could not be reached. Global Indexer will NOT work without a database!{vbCrLf}{vbCrLf}Please check your connection.{vbCrLf}The Application will exit now." If USER_LANGUAGE = "de-DE" Then title = "Kritischer Fehler" message = $"Die Datenbank konnte nicht erreicht werden. Global Indexer funktioniert NICHT ohne Datenbankverbindung{vbCrLf}{vbCrLf}Bitte überprüfen Sie Ihre Netzwerkverbindung oder benachrichtigen Sie Ihren Administrator.{vbCrLf}Die Anwendung wird nun geschlossen." End If Dim result = MsgBox(message, MsgBoxStyle.Critical, title) If result = MsgBoxResult.Ok Then Application.ExitThread() End If Else Try If FW_started = True Or FWSCAN_started = True Then 'Prüfen ob alle Files abgearbeitet wurden Dim sql = "SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND HANDLE_TYPE like '%|FW%' AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')" DTACTUAL_FILES = ClassDatabase.Return_Datatable(sql, True) If DTACTUAL_FILES.Rows.Count > 0 Then ABORT_INDEXING = False ' Dim fil As String Me.TimerFolderWatch.Stop() For Each row As DataRow In DTACTUAL_FILES.Rows Dim FILEGUID = row.Item("GUID") If ABORT_INDEXING = True Then Exit For End If Dim FileForWork As String = row.Item(1) If LogErrorsOnly = False Then ClassLogger.Add(">> In Timer Folderwatch - File: " & FileForWork, False) Dim fileInUse As Boolean = ClassFilehandle.IsFileInUse(FileForWork) Dim fileexists As Boolean = System.IO.File.Exists(FileForWork) If fileInUse = False Then If fileexists = True Then CURRENT_WORKFILE = FileForWork CURRENT_FILENAME = FileForWork CURRENT_WORKFILE_GUID = row.Item("GUID") Open_IndexDialog() Else ClassLogger.Add(">> File not existing - Row will be deleted!", False) Dim del = String.Format("DELETE FROM TBGI_FILES_USER WHERE GUID = {0}", FILEGUID) ClassDatabase.Execute_non_Query(del) End If Else ClassLogger.Add(">> file '" & row.Item(1) & "' could not be opened exclusively - fileInUse!", False) End If Next Me.TimerFolderWatch.Start() End If tslblFW.Visible = True Else tslblFW.Visible = False End If Catch ex As Exception MsgBox("Error in Work FolderWatch-File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End If End Sub Private Sub TimerClose3Minutes_Tick(sender As Object, e As EventArgs) Handles TimerClose3Minutes.Tick If LICENSE_EXPIRED = True Or LICENSE_COUNT < UserLoggedin Then If USER_LANGUAGE = "de-DE" Then MsgBox("Global Indexer wird nun geschlossen, weil keine neue Lizenzdaten eingegeben wurden!", MsgBoxStyle.Information) Else MsgBox("Global Indexer will now be closed, cause no new license was updated!", MsgBoxStyle.Information) End If Me.Close() Else TimerClose3Minutes.Stop() End If End Sub Private Sub frmStart_Shown(sender As Object, e As EventArgs) Handles Me.Shown If My.Settings.AppTerminate = True Then Me.Close() End If ' SetLanguage() If START_INCOMPLETE = True Then If LICENSE_COUNT = 0 And LICENSE_EXPIRED = True Then Else Me.Close() End If Else TimerFolderWatch.Start() End If If UniversalViewer_Path = String.Empty And My.Settings.DoNot_Show_Documents = False Then ERROR_STATE = "NO UV" Me.TopMost = False frmConfig_Basic.ShowDialog() Me.TopMost = True End If loaded = True Opacity = 0.65 ClassHelper.Refresh_RegexTable() Start_Folderwatch() ClassWindowLocation.LoadFormLocationSize(Me) End Sub Private Sub HistoryIndexierteDateienToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles HistoryIndexierteDateienToolStripMenuItem.Click frmHistory.ShowDialog() End Sub Private Sub InfoToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles InfoToolStripMenuItem.Click Me.TopMost = False AboutBox1.ShowDialog() Me.TopMost = True End Sub Private Sub frmStart_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged End Sub Private Sub TimerCheckDroppedFiles_Tick(sender As Object, e As EventArgs) Handles TimerCheckDroppedFiles.Tick TimerCheckDroppedFiles.Stop() Check_Dropped_Files() End Sub Private Sub LabelControl1_DragDrop(sender As Object, e As DragEventArgs) Handles LabelControl1.DragDrop, btnChoosefiles.DragDrop DragDropForm(e) End Sub Private Sub LabelControl1_DragEnter(sender As Object, e As DragEventArgs) Handles LabelControl1.DragEnter, btnChoosefiles.DragEnter Drag_Enter(sender, e) End Sub Private Sub btnChoosefiles_Click(sender As Object, e As EventArgs) Handles btnChoosefiles.Click Try Dim openFileDialog1 As New OpenFileDialog Dim fName As String 'openFileDialog1.InitialDirectory = "c:\" 'openFileDialog1.Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*" 'openFileDialog1.FilterIndex = 2 openFileDialog1.RestoreDirectory = True openFileDialog1.Multiselect = True If openFileDialog1.ShowDialog() = DialogResult.OK Then Dim i As Integer = 0 ClassDragDrop.files_dropped = Nothing For Each fName In openFileDialog1.FileNames ReDim Preserve ClassDragDrop.files_dropped(i) ClassLogger.Add(">> Chosen File: " & fName, False) ClassDragDrop.files_dropped(i) = "|DROPFROMFSYSTEM|" & fName i += 1 Next TimerCheckDroppedFiles.Start() End If Catch ex As Exception MsgBox("Unexpected Error in Choose Files for Indexing:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub End Class