Imports System.IO Imports System.Text Public Class ClassHotkey_Windream Private Shared fileContents As String Private Shared Function IsRelevantWindow(windowname As String, myControlNo As Integer, Value As String) Try Dim Control_Sequence As Integer = 0 Dim enumerator1 As New ClassWindowAPI 'Jedes Formularwindow durchlaufen For Each top As ClassWindowAPI.ApiWindow In enumerator1.GetTopLevelWindows() If top.MainWindowTitle.Contains(windowname) Or top.MainWindowTitle.ToLower = windowname.ToLower Then Control_Sequence = 0 For Each vControl As ClassWindowAPI.ApiWindow In enumerator1.GetChildWindows(top.hWnd) If vControl.MainWindowTitle <> "" Then If Control_Sequence = myControlNo Then If Value.ToUpper = vControl.MainWindowTitle.ToUpper Then Return True Else If LogErrorsOnly = False Then ClassLogger.Add(" ... Control-Sequence: " & myControlNo.ToString & " entspricht nicht dem Matchvalue.", False) Return False End If End If End If Control_Sequence += 1 Next vControl Return False End If Next top Catch ex As Exception MsgBox("Error in IsRelevantWindowt:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add(">> Error in IsRelevantWindow:" & ex.Message, False) Return False End Try End Function Private Shared Function Get_windowContent(windowname As String, myControlID As Integer) Try Dim Control_Sequence As Integer = 0 Dim enumerator1 As New ClassWindowAPI 'Jedes Formularwindow durchlaufen For Each top As ClassWindowAPI.ApiWindow In enumerator1.GetTopLevelWindows() If top.MainWindowTitle.Contains(windowname) Or top.MainWindowTitle.ToLower = windowname.ToLower Then Control_Sequence = 0 For Each vControl As ClassWindowAPI.ApiWindow In enumerator1.GetChildWindows(top.hWnd) If vControl.MainWindowTitle <> "" Then If Control_Sequence = myControlID Then If LogErrorsOnly = False Then ClassLogger.Add(" ... Control-Sequence: " & myControlID.ToString & " - Gelesener Wert: " & vControl.MainWindowTitle, False) Return vControl.MainWindowTitle.ToString End If End If Control_Sequence += 1 Next vControl Return Nothing End If Next top Catch ex As Exception MsgBox("Error in Get_windowContent:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add(">> Error in Get_windowContent:" & ex.Message, False) Return Nothing End Try End Function Public Shared Function RUN_WD_SEARCH(HK_USR_PROFILE_ID As Integer) Try If LogErrorsOnly = False Then ClassLogger.Add(" ...RUN_WD_SEARCH with HK_USR_PROFILE_ID '" & HK_USR_PROFILE_ID & "'", False) Dim DTWD As DataTable Dim Objecttype As String Dim windowname As String Dim HKPROFILE_ID As Integer Dim _sql = "SELECT WD_SEARCH,HKPROFILE_ID FROM TBHOTKEY_USER_PROFILE WHERE GUID = " & HK_USR_PROFILE_ID DTWD = ClassDatabase.Return_Datatable(_sql) If DTWD.Rows.Count = 0 Then If LogErrorsOnly = False Then ClassLogger.Add(" ...KEINE USER_PROFILES hinterlegt", False) Return "Uncexpected Error in Hotkey - Check Log for Hotkey" End If If DTWD.Rows.Count > 1 Then ClassLogger.Add("Das Ergebnis von '" & _sql & "' liefert mehr als eine Zeile zurück!", True) Return "Uncexpected Error in Hotkey - Check Log for Hotkey" End If If DTWD.Rows(0).Item(0) = "" Then If LogErrorsOnly = False Then ClassLogger.Add(">> KEINE Windream-Suche hinterlegt!", False) Return "Error in Hotkey - KEINE Windream-Suche hinterlegt - Check Logkey" End If Dim BaseSearch = DTWD.Rows(0).Item(0) Dim extension = Path.GetExtension(BaseSearch) HKPROFILE_ID = DTWD.Rows(0).Item("HKPROFILE_ID") Dim windream_temp_search As String = "" If IO.File.Exists(BaseSearch) = False Then ClassLogger.Add("Die Windream-Suche existiert nicht oder ist nicht zugreifbar!", True) MsgBox("Die Windream-Suche existiert nicht oder ist nicht zugreifbar!", MsgBoxStyle.Critical) Return Nothing End If windowname = ClassDatabase.Execute_Scalar("SELECT WINDOW_NAME FROM TBHOTKEY_PROFILE WHERE GUID = " & HKPROFILE_ID, MyConnectionString, True) fileContents = "" 'Eine tempfile generieren Dim tempFilename1 = My.Computer.FileSystem.GetTempFileName() 'Nur den Filenamen ohne Erweiterung Dim tempName = Path.GetFileNameWithoutExtension(tempFilename1) 'tempfile löschen If My.Computer.FileSystem.FileExists(tempFilename1) Then My.Computer.FileSystem.DeleteFile(tempFilename1) End If Dim temppath = Path.GetTempPath Dim EncodingFormat As Encoding Dim WDUnicode = ClassDatabase.Execute_Scalar("SELECT WD_UNICODE FROM TBGI_CONFIGURATION WHERE GUID = 1", MyConnectionString, True) If WDUnicode = True Then EncodingFormat = Encoding.GetEncoding(1252) '1252 If LogErrorsOnly = False Then ClassLogger.Add(" ...Unicode is used (Encoding.GetEncoding(1252))", False) Else If LogErrorsOnly = False Then ClassLogger.Add(" ...UTF8 (Encoding.GetEncoding(65001))", False) EncodingFormat = Encoding.GetEncoding(65001) End If Dim DT_HOOKS As DataTable = ClassDatabase.Return_Datatable("select * from TBHOTKEY_WINDOW_HOOK where HKPROFILE_ID = " & HKPROFILE_ID, True) If DT_HOOKS.Rows.Count > 0 Then Dim RelevantWindow As Boolean = False For Each row As DataRow In DT_HOOKS.Rows RelevantWindow = IsRelevantWindow(windowname, row.Item("SEQUENCE_NUMBER"), row.Item("CONTROL_VALUE")) If RelevantWindow = False Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Not the relevant window", False) Return "Not the Relevant window......" End If Next End If If LogErrorsOnly = False Then ClassLogger.Add(" ...ReadAlltext: " & BaseSearch, False) fileContents = My.Computer.FileSystem.ReadAllText(BaseSearch, EncodingFormat) ', System.Text.Encoding.Unicode If LogErrorsOnly = False Then ClassLogger.Add(" ...fileContents geladen", False) fileContents = fileContents.Replace("Í", "Ö") 'Das Array für die PAtterns anpassen _sql = "select * from TBHOTKEY_PATTERNS WHERE HKPROFILE_ID = " & HKPROFILE_ID Dim DT_PATTERNS As DataTable = ClassDatabase.Return_Datatable(_sql, True) If DT_PATTERNS.Rows.Count > 0 Then Dim i As Integer = 0 For Each row As DataRow In DT_PATTERNS.Rows If LogErrorsOnly = False Then ClassLogger.Add(" ...Get Value for Control# '" & row.Item("SEQUENCE_NUMBER").ToString & "'", False) Dim foundresult = Get_windowContent(windowname, row.Item("SEQUENCE_NUMBER").ToString) If Not IsNothing(foundresult) Then 'Die Nachbearbeitungsschritte laden Dim DTNB As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBHOTKEY_PATTERNS_REWORK WHERE HKPATTERN_ID = " & row.Item("GUID") & " ORDER BY SEQUENCE") If DTNB Is Nothing = False Then If DTNB.Rows.Count > 0 Then foundresult = ClassPostprocessing.Get_Nachbearbeitung_Wert(foundresult, DTNB) End If End If End If If Not IsNothing(foundresult) Then If foundresult.ToString = "<" Or foundresult.ToString = ">" Then ClassLogger.Add(">> Hot Key received an irregular value.", False) Return "Hotkey konnte nur einen irregulären Wert auswerten." End If If LogErrorsOnly = False Then ClassLogger.Add(" ...fileContents.length: " & fileContents.Length, False) If LogErrorsOnly = False Then ClassLogger.Add(" ...Replace pattern '" & row.Item(2).ToString & "' with '" & foundresult & "'", False) fileContents = fileContents.Replace(row.Item(2).ToString, foundresult) If LogErrorsOnly = False Then ClassLogger.Add(" ...fileContents.length: " & fileContents.Length, False) Else ClassLogger.Add(">> Hot Key could not read any value.", False) Return "Hotkey konnte keinen Wert auswerten - Evtl. ist das konfigurierte Fenster nicht geöffnet?" End If Next End If Try 'Die windream File zusammensetzen windream_temp_search = temppath & tempName & extension Try 'Die File schreiben My.Computer.FileSystem.WriteAllText(windream_temp_search, fileContents, False, EncodingFormat) If LogErrorsOnly = False Then ClassLogger.Add(" ...wrote Text to windream_temp_search: " & windream_temp_search, False) ' XML-Datei öffnen und laden Dim Stream As New IO.StreamReader(CStr(windream_temp_search), EncodingFormat) Dim Reader As New System.Xml.XmlTextReader(Stream) ' XML-Datei initialisieren Dim xml As New System.Xml.XmlDocument() ' XML-Datei öffnen und laden xml.Load(Reader) Reader.Close() xml.Save(windream_temp_search) If LogErrorsOnly = False Then ClassLogger.Add(" ...Xml Generiert: " & windream_temp_search, False) Catch ex As Exception ClassLogger.Add("TempFile could not be created: " & ex.Message, True) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unerwarteter Fehler in Write XmlSearch:") End Try CURRENT_WD_TEMPSEARCH = windream_temp_search Try Dim p As New Process() p.StartInfo.FileName = windream_temp_search p.StartInfo.WindowStyle = ProcessWindowStyle.Normal p.Start() 'p.WaitForExit() 'p.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei Ausführen der windream-Suche:") ClassLogger.Add("Unexpected error while executing search: " & ex.Message, True) Return "Unexpected error while executing search" End Try Return "" Catch ex As Exception ClassLogger.Add("Unexpected error in Create Search: " & ex.Message, True) MsgBox("Error in Create Search:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return "Unexpected error in Create Search" End Try Catch ex As Exception ClassLogger.Add("Unexpected error in RUN_WD_SEARCH: " & ex.Message, True) MsgBox("Error in RUN_WD_SEARCH:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return "Unerwarteter Fehler bei RUN_WD_SEARCH" End Try End Function End Class