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 DT_TBWMRH_KONFIGURATION = clsDatatabase.Return_Datatable("SELECT * FROM TBWMRH_KONFIGURATION WHERE GUID = 1") DT_TBDD_EMAIL = clsDatatabase.Return_Datatable("SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE ACTIVE = 1") ARR_Exported_Files = Nothing 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 _JOBROW As DataRow In DT_PROFIL_JOB.Rows clsLogger.AddDetailLog("JOB_TYP: " & _JOBROW.Item("JOB_TYP").ToString.ToUpper & " GUID: " & _JOBROW.Item("GUID").ToString) Next Dim FileJobSuccessful As Boolean = False Dim CountExportedDoc As Integer = 0 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 ReDim Preserve ARR_Exported_Files(CountExportedDoc) ARR_Exported_Files(CountExportedDoc) = EXPORTED_FILENAME CountExportedDoc += 1 FileJobSuccessful = True 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")) Case "".ToUpper End Select 'Abschluss Bearbeitung Job clsLogger.WriteLog() Next '################################## 'JETZT DER DURCHLAUF DER DATEI-JOBS '################################## If DT_PROFIL_FILE_JOB.Rows.Count > 0 Then '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 Command.......") 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 Next clsLogger.WriteLog() Else clsLogger.Add(">> KEINE File-JOBS für Profil '" & _Profilname & "' angelegt!", False, "clsProfil.Profil_Durchlauf") clsLogger.WriteLog() End If Next clsLogger.WriteLog() 'Jetzt nochmal ein Durchlauf für Profiljobs wo alle Dateien abgearbeitet wurden. For Each DR_PR_JB As DataRow In DT_PROFIL_JOB.Rows clsLogger.AddDetailLog("Now again working on profile-type: " & DR_PR_JB.Item("JOB_TYP") & " - ID: " & DR_PR_JB.Item("GUID")) Select Case DR_PR_JB.Item("JOB_TYP").ToString.ToUpper Case "Concat Files to one pdf".ToUpper clsLogger.AddDetailLog("Case Concat Files to one pdf....") Dim pdftk = DT_TBWMRH_KONFIGURATION.Rows(0).Item("PDF_TK_LOCATION") clsLogger.AddDetailLog("pdftk location: " & pdftk) CONCATTED_FILE = DR_PR_JB.Item("STRING1") clsLogger.AddDetailLog("CONCATTED_FILE location: " & CONCATTED_FILE) Dim deleteJaNein = DR_PR_JB.Item("STRING2").ToString.ToUpper clsLogger.AddDetailLog("deleteJaNein: " & deleteJaNein.ToString) If File.Exists(pdftk) Then If File.Exists(CONCATTED_FILE) Then Try File.Delete(CONCATTED_FILE) Catch ex As Exception End Try End If Try Dim myProcess As New Process Dim ProcID myProcess.StartInfo.FileName = pdftk myProcess.StartInfo.CreateNoWindow = False Dim _argument As String Dim i As Integer For Each str As String In ARR_Exported_Files If i = 0 Then _argument = """" & str & """" Else _argument = _argument & " " & """" & str & """" End If i += 1 Next myProcess.StartInfo.Arguments = _argument & " cat output " & CONCATTED_FILE clsLogger.AddDetailLog("Arguments: " & _argument & " cat output " & CONCATTED_FILE) myProcess.Start() ProcID = myProcess.Id Dim p As Process p = Process.GetProcessById(ProcID) Dim sw As Stopwatch = New Stopwatch() sw.Start() Do While p.HasExited = False If sw.Elapsed.TotalSeconds = 30 Then clsLogger.AddDetailLog("Still waiting (30 sec) for ending of process-id: " & ProcID.ToString) ElseIf sw.Elapsed.TotalMinutes = 1 Then clsLogger.AddDetailLog("Still waiting (60 sec) for ending of process-id: " & ProcID.ToString & " - Exit now") Exit Do End If Loop clsLogger.AddDetailLog("...process has exited: ") sw.Stop() clsLogger.AddDetailLog("Waiting for file: " & CONCATTED_FILE) Do While File.Exists(CONCATTED_FILE) = False Console.WriteLine("...not existing!") Loop If deleteJaNein = "JA" Then For Each str As String In ARR_Exported_Files Try File.Delete(str) Catch ex As Exception clsLogger.AddError("Unexpected error in deleting ARR_Exported_Files files: " & ex.Message, "clsProfil.Profil_Durchlauf(Concat Files to one pdf)") End Try Next End If clsLogger.WriteLog() Catch ex As Exception clsLogger.AddError("Unexpected error: " & ex.Message, "clsProfil.Profil_Durchlauf(Concat Files to one pdf)") End Try Else clsLogger.AddError("pdftk is not existing", "clsProfil.Profil_Durchlauf(Concat Files to one pdf)") End If Case "Send concatted file via mail".ToUpper clsLogger.AddDetailLog("CASE Send concatted file via mail.... ") If File.Exists(CONCATTED_FILE) = True Then Dim Email_Empfänger = DR_PR_JB.Item("STRING1") clsLogger.AddDetailLog("Email_Empfänger: " & Email_Empfänger) Dim Email_Betreff = DR_PR_JB.Item("STRING2") clsLogger.AddDetailLog("Email_Betreff: " & Email_Betreff) Dim Email_Body = DR_PR_JB.Item("STRING3") clsLogger.AddDetailLog("Email_Body: " & Email_Body) Dim EMAIL_PROFIL = DR_PR_JB.Item("STRING4") clsLogger.AddDetailLog("EMAIL_PROFIL: " & EMAIL_PROFIL) If Not IsNothing(DT_TBDD_EMAIL) And DT_TBDD_EMAIL.Rows.Count >= 1 Then Dim MAILFROM As String = "" Dim MAILSMTP As String = "" Dim MAIL_USER As String = "" Dim MAIL_USER_PW As String = "" For Each emailrow As DataRow In DT_TBDD_EMAIL.Rows If emailrow.Item("GUID") = CInt(EMAIL_PROFIL) Then MAILFROM = emailrow.Item("EMAIL_FROM") MAILSMTP = emailrow.Item("EMAIL_SMTP") MAIL_USER = emailrow.Item("EMAIL_USER") MAIL_USER_PW = emailrow.Item("EMAIL_PW") End If Next Dim wrapper As New clsEncryption("!35452didalog=") Dim PWPlain = wrapper.DecryptData(MAIL_USER_PW) If Not IsNothing(PWPlain) Then If PWPlain <> "" Then MAIL_USER_PW = PWPlain Else clsLogger.AddError("PWPlain is string.empty - Could not decrypt passwort", "clsProfil.Profil_Durchlauf(wrapper.DecryptData(MAIL_USER_PW))") clsLogger.WriteLog() Return False End If Else clsLogger.AddError("PWPlain is nothing - Could not decrypt passwort", "clsProfil.Profil_Durchlauf(wrapper.DecryptData(MAIL_USER_PW))") clsLogger.WriteLog() Return False End If clsEmail.Send_EMail(Email_Betreff, Email_Body, Email_Empfänger, MAILFROM, MAILSMTP, MAIL_USER, MAIL_USER_PW, CONCATTED_FILE) Else clsLogger.AddError("DT_TBDD_EMAIL is nothing or contains no rows", "clsProfil.Profil_Durchlauf(end concatted file via mail)") clsLogger.WriteLog() Return False End If Else clsLogger.AddError("File not existing: " & CONCATTED_FILE, "clsProfil.Profil_Durchlauf(Send concatted file via mail)") End If End Select 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