Imports WINDREAMLib Imports System.IO Imports System.Text Imports Newtonsoft.Json Public Class clsProfil #Region "***** Variablen *****" Private Shared CriticalError As Boolean = False Private Shared WD_aktivesDokument As WMObject #End Region Public Shared Function Init(guid As Integer) Try clsLogger.AddDetailLog("Start Initialisierung Profil für GUID: " & guid.ToString) Dim DT As DataTable = clsDatatabase.Return_Datatable("Select * from TBWMRH_PROFIL where GUID = " & guid) If DT.Rows.Count > 0 Then For Each DR As DataRow In DT.Rows _profGUID = guid _Profilname = CStr(DR.Item("Profilname")) clsLogger.AddDetailLog("Check Profilname '" & _Profilname & "', GUID: " & _profGUID & " geladen") ' Überprüfen ob Profil aktiv oder inaktiv If CBool(DR.Item("Aktiv")) = False Then clsLogger.Add("## Profil '" & _Profilname & "' ist inaktiv geschaltet", False) clsLogger.Add("", False) Return False Else _profObjekttyp = CStr(DR.Item("Objekttyp")) _profwdSuche = CStr(DR.Item("WindreamSuche")) _profDay = CStr(DR.Item("Day")) _profRunType = CStr(DR.Item("Run")) _proflastRun = DR.Item("Letzter_Durchlauf") clsLogger.AddDetailLog("Raw-Daten für Profil '" & _Profilname & "', GUID: " & _profGUID & " geladen - Last Run: " & _proflastRun.ToString) Return True End If Next Else clsLogger.Add("Achtung - keine Profile für diesen Durchlaufthread verfügbar", False) Return False End If Catch ex As Exception clsLogger.AddError(ex.Message, "Profil_Init") Return False End Try End Function 'Durchlauf des Profils wird aus dem Service gestartet wenn Init = True war Public Shared Function Profil_Durchlauf() Dim _error As Boolean = False Dim Run_Profile As Boolean = False Try 'Soll die Verarbeitung heute durchgeführt werden?? Dim Dayofweek As Integer = My.Computer.Clock.LocalTime.DayOfWeek If _profDay.Substring(Dayofweek - 1, 1) = 1 Then 'Verarbeitung soll heute durchgeführt werden clsLogger.AddDetailLog("RUN CONFIGURED FOR TODAY") clsLogger.AddDetailLog("_RunType: " & _profRunType) Dim arr As String() arr = _profRunType.Split(";") clsLogger.AddDetailLog("arr(1): " & arr(1).ToString) Select Case arr(0) Case "TIME" ' Dim intervall As Integer = clsSQLITE.konf_intervall / 60 clsLogger.AddDetailLog("Intervall: 1 Minute") Dim Time_next As DateTime = _proflastRun.AddMinutes(1) Dim _RunTime As Date = CDate(arr(1)) clsLogger.AddDetailLog("ProfilTime: " & _RunTime) clsLogger.AddDetailLog("_RunTime.ToShortTimeString: " & _RunTime.ToShortTimeString & " # " & "Now.ToShortTimeString: " & Now.ToShortTimeString) If Time_next.ToString.StartsWith("11.11.1911") Then clsLogger.AddDetailLog("Manueller Durchlauf des Profils - 11.11.1911") Run_Profile = True Else 'Ist die Uhrzeit in der Range If _RunTime.ToShortTimeString = Now.ToShortTimeString Then Run_Profile = True End If End If Case "INTV" 'Die Differenz berechnen Dim DiffMin As Integer = DateDiff(DateInterval.Minute, _proflastRun, Date.Now) Dim msg As String msg = "DiffMin: " & DiffMin & vbNewLine & "Intervall: " & arr(1) clsLogger.AddDetailLog(msg) If DiffMin >= CInt(arr(1)) Then 'Den Durchlauf erlauben Run_Profile = True Else clsLogger.AddDetailLog("No run as " & DiffMin & " >= CInt(" & arr(1) & ") is false ") End If Case Else clsLogger.Add(">> _profRunType konnte nicht ausgewertet werden - " & arr(0), False) End Select If Run_Profile = True Then clsLogger.Add(">> Start des Durchlaufes für Profil '" & _Profilname & "'", False) 'den Durchlaufszeitpunkt speichern clsDatatabase.Execute_non_Query("Update TBWMRH_PROFIL SET Running = 1 WHERE GUID = " & _profGUID) clsLogger.AddDetailLog("Prüfen der windream-Suche.......") If File.Exists(_profwdSuche) = False Then clsLogger.Add("Die Windream-Suche '" & _profwdSuche & "' existiert nicht!", True, "clsProfil.Profil_Durchlauf") 'wenn die gesuchte File eine Suche ist: per MAil informierne und Indexierung abbrechen clsDatatabase.Execute_non_Query("Update TBWMRH_PROFIL SET Running = 0 WHERE GUID = " & _profGUID) clsLogger.WriteLog() Return False Else ' windream-Suche für Profil starten clsLogger.AddDetailLog("GetSearchDocuments für Suche '" & _profwdSuche & "' starten: ") Dim windreamSucheErgebnisse As WMObjects = clsWindream_allgemein.GetSearchDocuments(_profwdSuche) If windreamSucheErgebnisse Is Nothing Then clsLogger.Add("windreamSucheErgebnisse is nothing!", True, "clsProfil.Profil_Durchlauf") clsLogger.WriteLog() Return False End If If windreamSucheErgebnisse.Count > 0 Then clsLogger.Add("- Insgesamt sollen '" & windreamSucheErgebnisse.Count & "' Dateien bearbeitet werden", False) clsLogger.AddDetailLog("SELECT * FROM TBWMRH_PROFIL_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE") Dim DT_PROFIL_JOB As DataTable = clsDatatabase.Return_Datatable("SELECT * FROM TBWMRH_PROFIL_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE") Dim DT_PROFIL_FILE_JOB As DataTable = clsDatatabase.Return_Datatable("SELECT * FROM TBWMRH_PROFIL_FILE_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE") clsLogger.AddDetailLog("DT_PROFIL_JOB und DT_PROFIL_FILE_JOB generiert ") clsLogger.AddDetailLog("DT_PROFIL_JOB.Rows.Count = " & DT_PROFIL_JOB.Rows.Count) clsLogger.AddDetailLog("DT_PROFIL_FILE_JOB.Rows.Count = " & DT_PROFIL_FILE_JOB.Rows.Count) If DT_PROFIL_JOB.Rows.Count > 0 Then If clsDateiverarbeitung.InitProfilData = True Then clsLogger.AddDetailLog("clsDateiverarbeitung.InitProfilData = True") 'For Each DR_PR_JB As DataRow In DT_PROFIL_JOB.Rows ' Dim result = DR_PR_JB.Item("JOB_TYP").ToString.ToUpper ' Select Case DR_PR_JB.Item("JOB_TYP").ToString.ToUpper ' Case "BNS json Download".ToUpper ' 'ARRAY oder Äqivalent bilden ' Dim sb As New StringBuilder() ' Dim sw As New StringWriter(sb) ' Using writer As JsonWriter = New JsonTextWriter(sw) ' writer.Formatting = Formatting.Indented ' writer.WriteStartObject() ' writer.WritePropertyName("CPU") ' writer.WriteValue("Intel") ' writer.WritePropertyName("PSU") ' writer.WriteValue("500W") ' writer.WritePropertyName("Drives") ' writer.WriteStartArray() ' writer.WriteValue("DVD read/writer") ' writer.WriteComment("(broken)") ' writer.WriteValue("500 gigabyte hard drive") ' writer.WriteValue("200 gigabype hard drive") ' writer.WriteEnd() ' writer.WriteEndObject() ' End Using ' Console.WriteLine(sb.ToString()) ' End Select 'Next Dim FileJobSuccessful As Boolean = False For Each WMdok As WMObject In windreamSucheErgebnisse For Each DR_PR_JB As DataRow In DT_PROFIL_JOB.Rows Select Case DR_PR_JB.Item("JOB_TYP").ToString.ToUpper Case "Create Mail Attachment".ToUpper Case "Export HDD".ToUpper clsLogger.AddDetailLog("Case Export HDD") 'Für jedes Dokument in der Windream-Ergebnisliste 'For Each dok As WMObject In windreamSucheErgebnisse ' aktuelles Dokument zum Export bereitstellen EXPORTED_FILENAME = "" If clsDateiverarbeitung.Export_File(WMdok, DR_PR_JB.Item("STRING1")) = True Then FileJobSuccessful = True 'If DT_PROFIL_FILE_JOB.Rows.Count > 0 Then ' clsLogger.AddDetailLog("Anzahl DT_PROFIL_FILE_JOB.Rows.Count:" & DT_PROFIL_FILE_JOB.Rows.Count) ' 'Für jeden File-Job ' For Each DR_PR_FILE_JOB As DataRow In DT_PROFIL_FILE_JOB.Rows ' If FileJobSuccessful = False Then ' clsLogger.Add("AUSSTIEG FOR SCHLEIFE...", True) ' clsLogger.WriteLog() ' Exit For ' End If ' Select Case DR_PR_FILE_JOB.Item("TYP").ToString.ToLower ' Case "Set Index".ToLower ' Try ' 'Überprüfen ob Value bereits gesetzt wurde? ' Dim idxName As String = DR_PR_FILE_JOB.Item("STRING1").ToString ' Dim idxvalue As String = DR_PR_FILE_JOB.Item("STRING2").ToString ' If idxvalue.Contains("[%DATETIME]") Then ' idxvalue = idxvalue.Replace("[%DATETIME]", Now.ToString) ' End If ' clsLogger.AddDetailLog("Datei soll mit Index '" & idxName & "'indexiert werden...") ' Dim arrIndex() As String ' ReDim Preserve arrIndex(0) ' arrIndex(0) = idxName ' clsLogger.AddDetailLog("...nach arrIndex") ' Dim arrValue() As String ' Dim aktvalue As Object ' aktvalue = WMdok.GetVariableValue(idxName) ' clsLogger.AddDetailLog("...nach aktValue zuweisen..") ' If aktvalue Is Nothing Then ' clsLogger.AddDetailLog("Index '" & idxName & "' ist noch leer.") ' ReDim Preserve arrValue(0) ' arrValue(0) = idxvalue ' Else ' clsLogger.AddDetailLog("Index '" & idxName & "' ist bereits gefüllt.") ' Dim myArray() ' ReDim myArray(0) ' myArray(0) = idxvalue ' Dim VektorArray() ' VektorArray = Return_VektorArray(WMdok, idxName, myArray, True) ' If VektorArray Is Nothing = False Then ' ReDim arrValue(VektorArray.Length - 1) ' Array.Copy(VektorArray, arrValue, VektorArray.Length) ' End If ' End If ' If arrValue Is Nothing = False Then ' clsWindream_Index.RunIndexing(WMdok, arrIndex, arrValue, _profObjekttyp) ' Else ' clsLogger.Add(">> arrValue is nothing - keine Indexierung", False, "clsProfil.Profil_Durchlauf") ' End If ' Catch ex As Exception ' clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(SetIndex)") ' End Try ' Case "Rename File with windream Index".ToLower ' clsLogger.AddDetailLog("Exportierte Datei soll nach Indexvorgaben umbenannt werden...") ' clsDateiverarbeitung.Rename_File(WMdok, DR_PR_FILE_JOB.Item("STRING1").ToString) ' Case "Rename File with WMVector (only one)".ToLower ' clsLogger.AddDetailLog("Exportierte Datei soll nach VektorIndexvorgaben umbenannt werden...") ' clsDateiverarbeitung.Rename_File_Vektor(WMdok, DR_PR_FILE_JOB.Item("STRING1").ToString) ' Case "Execute Oracle Command".ToLower ' Try ' clsLogger.AddDetailLog("Execute Oracle Comman.......") ' Dim oracleconnectionstring = DR_PR_FILE_JOB.Item("STRING1").ToString ' Dim oracleCommandRAW = DR_PR_FILE_JOB.Item("STRING2").ToString ' FileJobSuccessful = clsDateiverarbeitung.RUN_ORACLE_COMMAND(WMdok, oracleconnectionstring, oracleCommandRAW) ' Catch ex As Exception ' clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(ExecuteOracleCommand)") ' End Try ' Case "Execute MSSQL Command".ToLower ' Try ' Dim MSSQLconnectionstring = DR_PR_FILE_JOB.Item("STRING1").ToString ' Dim MSSQLCommandRAW = DR_PR_FILE_JOB.Item("STRING2").ToString ' clsLogger.AddDetailLog("Execute MSSQL Command.......") ' FileJobSuccessful = clsDateiverarbeitung.RUN_MSSQL_COMMAND(WMdok, MSSQLconnectionstring, MSSQLCommandRAW) ' Catch ex As Exception ' clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(ExecuteMSSQLCommand)") ' End Try ' End Select ' 'Abschluss Bearbeitung File Job ' clsLogger.WriteLog() ' Next 'Else ' clsLogger.Add(">> KEINE File-JOBS für Profil '" & _Profilname & "' angelegt!", False, "clsProfil.Profil_Durchlauf") ' clsLogger.WriteLog() 'End If Else clsDatatabase.Execute_non_Query("UPDATE TBWMRH_PROFIL SET Running = 0, LETZTER_DURCHLAUF = Getdate() WHERE GUID = " & _profGUID) End If 'Next Case "BNS json Download".ToUpper FileJobSuccessful = clsDateiverarbeitung.BNSjsonDownload(WMdok, DR_PR_JB.Item("STRING1"), DR_PR_JB.Item("STRING2")) End Select 'Abschluss Bearbeitung Job clsLogger.WriteLog() Next '################################## 'JETZT DER DURCHLAUF DER DATEI-JOBS '################################## If DT_PROFIL_FILE_JOB.Rows.Count > 0 Then Dim filecount As Integer = 0 'Für jeden File-Job For Each DR_PR_FILE_JOB As DataRow In DT_PROFIL_FILE_JOB.Rows If FileJobSuccessful = False Then clsLogger.Add("AUSSTIEG FOR SCHLEIFE...", True) clsLogger.WriteLog() Exit For End If Select Case DR_PR_FILE_JOB.Item("TYP").ToString.ToLower Case "Set Index".ToLower Try 'Überprüfen ob Value bereits gesetzt wurde? Dim idxName As String = DR_PR_FILE_JOB.Item("STRING1").ToString Dim idxvalue As String = DR_PR_FILE_JOB.Item("STRING2").ToString If idxvalue.Contains("[%DATETIME]") Then idxvalue = idxvalue.Replace("[%DATETIME]", Now.ToString) End If clsLogger.AddDetailLog("Datei soll mit Index '" & idxName & "'indexiert werden...") Dim arrIndex() As String ReDim Preserve arrIndex(0) arrIndex(0) = idxName clsLogger.AddDetailLog("...nach arrIndex") Dim arrValue() As String Dim aktvalue As Object aktvalue = WMdok.GetVariableValue(idxName) clsLogger.AddDetailLog("...nach aktValue zuweisen..") If aktvalue Is Nothing Then clsLogger.AddDetailLog("Index '" & idxName & "' ist noch leer.") ReDim Preserve arrValue(0) arrValue(0) = idxvalue Else clsLogger.AddDetailLog("Index '" & idxName & "' ist bereits gefüllt.") Dim myArray() ReDim myArray(0) myArray(0) = idxvalue Dim VektorArray() VektorArray = Return_VektorArray(WMdok, idxName, myArray, True) If VektorArray Is Nothing = False Then ReDim arrValue(VektorArray.Length - 1) Array.Copy(VektorArray, arrValue, VektorArray.Length) End If End If If arrValue Is Nothing = False Then clsWindream_Index.RunIndexing(WMdok, arrIndex, arrValue, _profObjekttyp) Else clsLogger.Add(">> arrValue is nothing - keine Indexierung", False, "clsProfil.Profil_Durchlauf") End If Catch ex As Exception clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(SetIndex)") End Try Case "Rename File with windream Index".ToLower clsLogger.AddDetailLog("Exportierte Datei soll nach Indexvorgaben umbenannt werden...") clsDateiverarbeitung.Rename_File(WMdok, DR_PR_FILE_JOB.Item("STRING1").ToString) Case "Rename File with WMVector (only one)".ToLower clsLogger.AddDetailLog("Exportierte Datei soll nach VektorIndexvorgaben umbenannt werden...") clsDateiverarbeitung.Rename_File_Vektor(WMdok, DR_PR_FILE_JOB.Item("STRING1").ToString) Case "Execute Oracle Command".ToLower Try clsLogger.AddDetailLog("Execute Oracle Comman.......") Dim oracleconnectionstring = DR_PR_FILE_JOB.Item("STRING1").ToString Dim oracleCommandRAW = DR_PR_FILE_JOB.Item("STRING2").ToString FileJobSuccessful = clsDateiverarbeitung.RUN_ORACLE_COMMAND(WMdok, oracleconnectionstring, oracleCommandRAW) Catch ex As Exception clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(ExecuteOracleCommand)") End Try Case "Execute MSSQL Command".ToLower Try Dim MSSQLconnectionstring = DR_PR_FILE_JOB.Item("STRING1").ToString Dim MSSQLCommandRAW = DR_PR_FILE_JOB.Item("STRING2").ToString clsLogger.AddDetailLog("Execute MSSQL Command.......") FileJobSuccessful = clsDateiverarbeitung.RUN_MSSQL_COMMAND(WMdok, MSSQLconnectionstring, MSSQLCommandRAW) Catch ex As Exception clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(ExecuteMSSQLCommand)") End Try End Select If filecount >= 20 Then clsLogger.WriteLog() filecount = 0 End If 'Abschluss Bearbeitung File Job Next Else clsLogger.Add(">> KEINE File-JOBS für Profil '" & _Profilname & "' angelegt!", False, "clsProfil.Profil_Durchlauf") clsLogger.WriteLog() End If Next clsLogger.WriteLog() Else clsLogger.Add(">> Initialisierung Profil nicht erfolgreich", True) clsLogger.WriteLog() End If Else clsLogger.Add(">> KEINE JOBS für Profil '" & _Profilname & "' angelegt!", False, "clsProfil.Profil_Durchlauf") clsLogger.WriteLog() End If Else ' keine Dateien zum Importieren clsLogger.Add(">> Keine windream-Dokumente für Profil '" & _Profilname & "' vorhanden/gefunden.", False) clsLogger.Add("", False) clsLogger.WriteLog() End If End If End If Else clsLogger.AddDetailLog("Verarbeitung für heute NICHT konfiguriert") clsLogger.WriteLog() End If If Run_Profile = True Then 'Abschluss des Profiles clsDatatabase.Execute_non_Query("UPDATE TBWMRH_PROFIL SET Running = 0, LETZTER_DURCHLAUF = GETDATE() WHERE GUID = " & _profGUID) clsLogger.AddDetailLog("'UPDATE TBWMRH_PROFIL SET Running = 0' ausgeführt") End If clsLogger.AddDetailLog("") clsLogger.WriteLog() Return True Catch ex As Exception clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf") If Run_Profile = True Then clsDatatabase.Execute_non_Query("Update TBWMRH_PROFIL SET Running = 0 WHERE GUID = " & _profGUID) End If ' CriticalError = False Return False End Try End Function Private Shared Function Return_VektorArray(ByVal oDocument As WMObject, vktIndexName As String, NIIndexe As Object, CheckDuplikat As Boolean) Try Dim missing As Boolean = False Dim Anzahl As Integer = 0 Dim ValueArray() 'Jeden Wert des Vektorfeldes durchlaufen Dim wertWD = oDocument.GetVariableValue(vktIndexName) If wertWD Is Nothing = False Then 'Nochmals prüfen ob wirklich Array If wertWD.GetType.ToString.Contains("System.Object") Then 'Keine Duplikatprüfung also einfach neues Array füllen If CheckDuplikat = False Then For Each value As Object In wertWD 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = value.ToString Anzahl += 1 Next 'Und jetzt den/die Neuen Wert(e) anfügen For Each NewValue As Object In NIIndexe If NewValue Is Nothing = False Then 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = NewValue.ToString Anzahl += 1 End If Next Else clsLogger.AddDetailLog("Duplikatprüfung soll durchgeführt werden.") 'Duplikat Prüfung an, also nur anhängen wenn Wert <> For Each WDValue As Object In wertWD If WDValue Is Nothing = False Then 'Erst einmal die ALten Werte schreiben ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = WDValue.ToString clsLogger.AddDetailLog("Value (" & Anzahl & ") " & WDValue.ToString) Anzahl += 1 End If Next 'Jetzt die Neuen Werte auf Duplikate überprüfen For Each NewValue As Object In NIIndexe If NewValue Is Nothing = False Then If ValueArray.Contains(NewValue) = False Then clsLogger.AddDetailLog("New Value (" & Anzahl & ") " & NewValue.ToString) 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = NewValue.ToString Anzahl += 1 Else clsLogger.AddDetailLog("Value '" & NewValue.ToString & "' bereits in Vektorfeld enthalten") End If End If Next End If End If Else clsLogger.AddDetailLog("Vektorfeld ist noch leer....") 'Den/die Neuen Wert(e) anfügen For Each NewValue As Object In NIIndexe If NewValue Is Nothing = False Then If CheckDuplikat = True Then If ValueArray Is Nothing = False Then If ValueArray.Contains(NewValue) = False Then 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = NewValue.ToString Anzahl += 1 Else clsLogger.AddDetailLog("Value '" & NewValue.ToString & "' bereits in Array enthalten") End If Else 'Dererste Wert, also hinzufügen 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = NewValue.ToString Anzahl += 1 End If Else 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = NewValue.ToString Anzahl += 1 End If End If Next End If clsLogger.AddDetailLog("Return ValueArray: length " & ValueArray.Length) Return ValueArray Catch ex As Exception clsLogger.AddError(ex.Message, "Return_VektorArray") Return Nothing End Try End Function End Class