FileFlow/Global_Indexer/ClassHotkey_Windream.vb
2017-08-08 17:08:28 +02:00

337 lines
18 KiB
VB.net

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