Imports System.IO Imports System.Text Public Class ClassHotkey_Windream Private Declare Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As IntPtr Private Declare Auto Function GetWindowText Lib "user32" (ByVal hWnd As System.IntPtr, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer Private Declare Function ShowWindow Lib "user32" (ByVal handle As IntPtr, ByVal nCmdShow As Integer) As Integer Private Declare Function SetForeGroundWindow Lib "user32" (ByVal Hwnd As IntPtr) As Integer Private makel As String Public Shared Function GetCaption() As String Dim Caption As New System.Text.StringBuilder(256) Dim hWnd As IntPtr = GetForegroundWindow() GetWindowText(hWnd, Caption, Caption.Capacity) Return Caption.ToString() End Function 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 LogErrorsOnly = False Then ClassLogger.Add(" ... top-window Name: " & top.MainWindowTitle, False) 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 'Fenster position ermitteln/auslesen Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Int32 Private Structure RECT Dim Left As Integer Dim Top As Integer Dim Right As Integer Dim Bottom As Integer End Structure Private Shared Sub GetWindowClientSize(ByVal hWnd As Long) Dim rc As RECT GetWindowRect(hWnd, rc) 'Left = rc.Right - rc.Left 'Height = rc.Bottom - rc.Top End Sub 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 type As String 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) If USER_LANGUAGE = "de-DE" Then MsgBox("Die Windream-Suche existiert nicht oder ist nicht zugreifbar!", MsgBoxStyle.Critical) Else MsgBox("Windream-Search does not exist or is not accessible", MsgBoxStyle.Critical) End If Return Nothing End If windowname = ClassDatabase.Execute_Scalar("SELECT WINDOW_NAME FROM TBHOTKEY_PROFILE WHERE GUID = " & HKPROFILE_ID, MyConnectionString, True) type = ClassDatabase.Execute_Scalar("SELECT OBJECTTYPE 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 type = "COPYPASTE" Then _sql = "select window_control from TBHOTKEY_PATTERNS where HKPROFILE_ID = " & HKPROFILE_ID Dim copytype = ClassDatabase.Execute_Scalar(_sql, MyConnectionString, True) Dim clipbrd Dim theHandle As IntPtr = FindWindow(Nothing, CURRENT_FOCUSES_WINDOWNAME) If theHandle <> IntPtr.Zero Then Dim theForegroundWindow As Boolean = SetForeGroundWindow(theHandle) If theForegroundWindow = True Then Select Case copytype Case "strgC" ' SetForeGroundWindow(HWND) SendKeys.Send("^{c}") 'for Ctrl-C Case "strA and strgC" SendKeys.Send("^{A}") 'AppActivate(CURRENT_FOCUSES_WINDOWNAME) SendKeys.Send("^{c}") 'for Ctrl-C End Select End If End If clipbrd = Clipboard.GetText Console.WriteLine(clipbrd.ToString) If Not clipbrd Is Nothing Then If clipbrd <> "" Then _sql = "select PATTERN_WDSEARCH from TBHOTKEY_PATTERNS where HKPROFILE_ID = " & HKPROFILE_ID Dim _pattern = ClassDatabase.Execute_Scalar(_sql, MyConnectionString, True) fileContents = fileContents.Replace(_pattern, clipbrd.ToString) End If End If Else 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 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, "Unexpected Error in Write XmlSearch:") End Try CURRENT_WD_TEMPSEARCH = windream_temp_search TEMP_FILES.Add(CURRENT_WD_TEMPSEARCH) Try Dim myhWnd As IntPtr Dim p As New Process() p.StartInfo.FileName = windream_temp_search If My.Settings.WDSearch_maximized = True Then p.StartInfo.WindowStyle = ProcessWindowStyle.Maximized Else p.StartInfo.WindowStyle = ProcessWindowStyle.Normal End If p.Start() myhWnd = p.MainWindowHandle Threading.Thread.Sleep(1000) Dim rctMain As RECT GetWindowRect(p.MainWindowHandle, rctMain) If LogErrorsOnly = False Then ClassLogger.Add(" ...Top-Position: " & rctMain.Top.ToString, False) ClassLogger.Add(" ...Left-Position: " & rctMain.Left.ToString, False) ClassLogger.Add(" ...Right-Position: " & rctMain.Right.ToString, False) ClassLogger.Add(" ...Bottom-Position: " & rctMain.Bottom.ToString, False) End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error while executing windream-Search:") ClassLogger.Add("Unexpected error while executing search: " & ex.Message, True) Return "Unexpected error while executing search" End Try Dim psList() As Process Try psList = Process.GetProcesses() For Each p As Process In psList Console.WriteLine(p.Id.ToString() + " " + p.ProcessName) If p.ProcessName.Contains("indream.Find") Then AppActivate(p.Id) If My.Settings.WDSearch_maximized = False Then Dim rctMain As RECT GetWindowRect(p.MainWindowHandle, rctMain) If rctMain.Left = 0 Or rctMain.Right = 0 Then ShowWindow(p.MainWindowHandle, 3) ' SW_MAXIMIZE End If End If ' SetForeGroundWindow( p.MainWindowHandle) End If Next p Catch ex As Exception ClassLogger.Add("Unexpected error while Setting foreground: " & ex.Message, True) 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 Unexpected error in RUN_WD_SEARCH" End Try End Function End Class