Imports WINDREAMLib Imports System.IO Imports System.Text Imports Newtonsoft.Json Imports DigitalData.Modules.Logging Public Class clsProfil Inherits clsCURRENT Dim Logger As Logger #Region "***** Variablen *****" Private Shared CriticalError As Boolean = False Private windream As clsWindream_allgemein Private windream_index As clsWindream_Index Private _database As clsDatabase Private _dateiverarbeitung As clsDateiverarbeitung Private _JobWork As clsJob_Work Private _email As clsEmail Private Shared WD_aktivesDokument As WMObject #End Region Sub New(MyLogger As LogConfig, PROFIL_ID As Integer) Logger = MyLogger.GetLogger() windream = New clsWindream_allgemein(MyLogger) windream_index = New clsWindream_Index(MyLogger) _database = New clsDatabase(MyLogger) _dateiverarbeitung = New clsDateiverarbeitung(MyLogger) _email = New clsEmail(MyLogger) _JobWork = New clsJob_Work(MyLogger, _email) End Sub Public Function Init(PROFIL_ID As Integer) Try Logger.Debug("Start Initialisierung Profil für GUID: " & PROFIL_ID.ToString) Dim DT As DataTable = _database.Return_Datatable("Select * from TBWMRH_PROFIL where GUID = " & PROFIL_ID) If DT.Rows.Count > 0 Then For Each DR As DataRow In DT.Rows _profGUID = PROFIL_ID _Profilname = CStr(DR.Item("Profilname")) Logger.Debug("Check Profilname '" & _Profilname & "', GUID: " & _profGUID & " geladen") ' Überprüfen ob Profil aktiv oder inaktiv If CBool(DR.Item("Aktiv")) = False Then Logger.Info("## Profil '" & _Profilname & "' ist inaktiv geschaltet") 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") Logger.Debug("Raw-Daten für Profil '" & _Profilname & "', GUID: " & _profGUID & " geladen") Return True End If Next Else Logger.Warn("Achtung - keine Profile für diesen Durchlaufthread verfügbar") Return False End If Catch ex As Exception Logger.Error(ex) Return False End Try End Function 'Durchlauf des Profils wird aus dem Service gestartet wenn Init = True war Public Function Profil_Durchlauf(manually As Boolean) As Boolean Dim _error As Boolean = False Try Dim Run_Profile As Boolean = False 'Soll die Verarbeitung heute durchgeführt werden?? Dim Dayofweek As Integer = My.Computer.Clock.LocalTime.DayOfWeek Dim SUBS As Integer = 0 Dim RUNTODAY As Integer = 0 If Dayofweek = 0 Then SUBS = 6 Else End If RUNTODAY = _profDay.Substring(Dayofweek - 1, 1) If _profDay.Substring(Dayofweek - 1, 1) = 1 Then 'Verarbeitung soll heute durchgeführt werden Logger.Debug("Verarbeitung soll heute durchgeführt werden!") Logger.Debug("_RunType: " & _profRunType) Dim arr As String() arr = _profRunType.Split(";") Logger.Debug("arr(1): " & arr(1).ToString) Select Case arr(0) Case "TIME" ' Dim intervall As Integer = clsSQLITE.konf_intervall / 60 Dim Time_next As DateTime = _proflastRun.AddMinutes(1) Dim _RunTime As Date = CDate(arr(1)) Logger.Debug("ProfilTime: " & _RunTime) Logger.Debug("_RunTime.ToShortTimeString: " & _RunTime.ToShortTimeString & " # " & "Now.ToShortTimeString: " & Now.ToShortTimeString) If Time_next.ToString.StartsWith("11.11.1911") Then Logger.Info("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 Else Logger.Debug("No run as " & _RunTime.ToShortTimeString & "<>" & Now.ToShortTimeString) End If End If Case "INTV" 'Die Differenz berechnen Dim DiffMin As Integer = DateDiff(DateInterval.Minute, _proflastRun, Date.Now) 'Logger.Info("DiffMin: " & DiffMin) 'Logger.Info("Intervall: " & arr(1)) If DiffMin >= CInt(arr(1)) Then 'Den Durchlauf erlauben Run_Profile = True Else Logger.Debug("No run as DiffMin (" & DiffMin & ") <= Intervall(" & arr(1) & ")") End If Case Else Logger.Warn("_profRunType konnte nicht ausgewertet werden - " & arr(0)) End Select If Run_Profile = False And manually = True Then Logger.Info("This is a manual run of profile!") Run_Profile = True End If If Run_Profile = True Then Logger.Info($"Working on profile '{_Profilname}'") clsCURRENT.DT_TBDD_EMAIL = _database.Return_Datatable("SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE ACTIVE = 1") clsCURRENT.PROFILE_HandledFiles = Nothing Logger.Debug("Start RUN of profile '" & _Profilname & "'") 'den Durchlaufszeitpunkt speichern If File.Exists(_profwdSuche) = False Then Logger.Warn("Die Windream-Suche '" & _profwdSuche & "' existiert nicht!", True, "clsProfil.Profil_Durchlauf") 'wenn die gesuchte File eine Suche ist: per MAil informierne und Indexierung abbrechen Return False Else ' windream-Suche für Profil starten Logger.Debug("GetSearchDocuments für Suche '" & _profwdSuche & "' starten: ") Dim windreamSucheErgebnisse As WMObjects = windream.GetSearchDocuments(_profwdSuche) If windreamSucheErgebnisse Is Nothing Then Logger.Warn("windreamSucheErgebnisse is nothing!", True, "clsProfil.Profil_Durchlauf") Return False End If If windreamSucheErgebnisse.Count > 0 Then Logger.Info(windreamSucheErgebnisse.Count & " files shall be worked!") Logger.Debug("SELECT * FROM TBWMRH_PROFIL_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE") Dim DT_PROFIL_JOB As DataTable = _database.Return_Datatable("SELECT * FROM TBWMRH_PROFIL_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE") Dim DT_PROFIL_FILE_JOB As DataTable = _database.Return_Datatable("SELECT * FROM TBWMRH_PROFIL_FILE_JOB WHERE AKTIV = 1 AND PROFIL_ID = " & _profGUID & " ORDER BY REIHENFOLGE") Logger.Debug($"DT_PROFIL_JOB ({DT_PROFIL_JOB.Rows.Count})and DT_PROFIL_FILE_JOB ({DT_PROFIL_FILE_JOB.Rows.Count}) generiert ") If DT_PROFIL_JOB.Rows.Count > 0 Then If _dateiverarbeitung.InitProfilData = True Then _database.Execute_non_Query("UPDATE TBWMRH_PROFIL SET Running = 1, LETZTER_DURCHLAUF = GETDATE() WHERE GUID = " & _profGUID) Logger.Debug("_dateiverarbeitung.InitProfilData = True") For Each _JOBROW As DataRow In DT_PROFIL_JOB.Rows Logger.Debug("JOB_TYP: " & _JOBROW.Item("JOB_TYP").ToString.ToUpper & " GUID: " & _JOBROW.Item("GUID").ToString) Next Dim FileJobSuccessful As Boolean = False Dim CountExportedDoc As Integer = 0 clsCURRENT.PROFILE_HandledFiles = Nothing 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 Logger.Info("JobType: Create Mail Attachment") 'XX Dim Email_Empfänger = DR_PR_JB.Item("STRING1") Logger.Debug("Email_Empfänger: " & Email_Empfänger) Dim Email_Betreff = DR_PR_JB.Item("STRING2") Logger.Debug("Email_Betreff: " & Email_Betreff) Dim Email_Body = DR_PR_JB.Item("STRING3") Logger.Debug("Email_Body: " & Email_Body) Dim EMAIL_PROFIL = DR_PR_JB.Item("STRING4") Logger.Debug("EMAIL_PROFIL: " & EMAIL_PROFIL) If Not IsNothing(clsCURRENT.DT_TBDD_EMAIL) And clsCURRENT.DT_TBDD_EMAIL.Rows.Count >= 1 Then Dim oAttachment = clsCURRENT.WDLAUFWERK & ":" & WMdok.aPath Dim MAILFROM As String = "" Dim MAILSMTP As String = "" Dim MAIL_USER As String = "" Dim MAIL_USER_PW As String = "" Dim MAIL_AUTH_TYPE As String = "SSL" Dim MAIL_PORT As String = "25" For Each emailrow As DataRow In clsCURRENT.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") MAIL_AUTH_TYPE = emailrow.Item("AUTH_TYPE") MAIL_PORT = emailrow.Item("PORT") 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 Logger.Warn("PWPlain is string.empty - Could not decrypt passwort181") Return False End If Else Logger.Warn("PWPlain is string.empty - Could not decrypt passwort188") Return False End If If Email_Empfänger.ToString.Contains("[%") Then Email_Empfänger = _dateiverarbeitung.REGEX_REPLACE(WMdok, Email_Empfänger) Logger.Debug("Email_Empfänger: " & Email_Empfänger) End If Email_Betreff = _dateiverarbeitung.REGEX_REPLACE(WMdok, Email_Betreff) Email_Body = _dateiverarbeitung.REGEX_REPLACE(WMdok, Email_Body) If _email.Email_Send_Independentsoft(Email_Betreff, Email_Body, Email_Empfänger, MAILFROM, MAILSMTP, MAIL_PORT, MAIL_USER, MAIL_USER_PW, MAIL_AUTH_TYPE, oAttachment) = True Then FileJobSuccessful = True Else Logger.Warn("Email_Send_Independentsoft was not successfull!") End If Else Logger.Warn("DT_TBDD_EMAIL is nothing or contains no rows") Return False End If Case "Export HDD".ToUpper Logger.Info("JobType: Case Export HDD") 'Für jedes Dokument in der Windream-Ergebnisliste 'For Each dok As WMObject In windreamSucheErgebnisse ' aktuelles Dokument zum Export bereitstellen clsCURRENT.EXPORTED_FILENAME = "" If _dateiverarbeitung.Export_File(WMdok, DR_PR_JB.Item("STRING1")) = True Then ReDim Preserve clsCURRENT.PROFILE_HandledFiles(CountExportedDoc) clsCURRENT.PROFILE_HandledFiles(CountExportedDoc) = clsCURRENT.EXPORTED_FILENAME CountExportedDoc += 1 FileJobSuccessful = True End If 'Next Case "BNS json Download".ToUpper Logger.Info("JobType: BNS json Download") FileJobSuccessful = _dateiverarbeitung.BNSjsonDownload(WMdok, DR_PR_JB.Item("STRING1"), DR_PR_JB.Item("STRING2")) 'Case "Send to printer".ToUpper ' Logger.Info("JobType: Send to printer") ' Dim pdfxchange = clsCURRENT.DT_TBWMRH_KONFIGURATION.Rows(0).Item("PDF_XCHANGE_LOCATION") ' Dim printername = DR_PR_JB.Item("STRING1") ' Dim filename = clsCURRENT.WDLAUFWERK & ":" & WMdok.aPath ' Try ' If File.Exists(pdfxchange) = False Then ' Logger.Warn("PDFXChange existiert nicht am Ort...") ' Continue For ' End If ' Dim myProcess As New Process ' myProcess.StartInfo.FileName = pdfxchange ' myProcess.StartInfo.UseShellExecute = True ' myProcess.StartInfo.CreateNoWindow = False ' 'PDFXCView.exe / Print(): showui = yes c:\mydocument.pdf ' Dim _argument As String = "/printto: """ & printername & """ """ & filename & """" ' myProcess.StartInfo.Arguments = _argument ' Logger.Debug("Arguments: " & _argument) ' Try ' myProcess.Start() ' Dim p As Process ' p = Process.GetProcessById(myProcess.Id) ' Dim sw As Stopwatch = New Stopwatch() ' sw.Start() ' Do While p.HasExited = False ' If sw.Elapsed.TotalSeconds = 30 Then ' Logger.Info("Still waiting (30 sec) for ending of process-id: " & myProcess.Id.ToString) ' ElseIf sw.Elapsed.TotalMinutes = 1 Then ' Logger.Info("Still waiting (60 sec) for ending of process-id: " & myProcess.Id.ToString & " - Exit now") ' Exit Do ' End If ' Loop ' Logger.Debug("...process has exited: ") ' FileJobSuccessful = True ' sw.Stop() ' Catch ex As Exception ' Logger.Warn("Could not print (pdfxcv) file: " & filename) ' Logger.Error(ex) ' End Try ' Catch ex As Exception ' Logger.Error(ex) ' End Try End Select 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 Logger.Info("AUSSTIEG FOR SCHLEIFE cause FileJobSuccessful = False...") 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 idxvalue = _dateiverarbeitung.REGEX_REPLACE(WMdok, idxvalue) Logger.Debug($"Index '{idxName}' shall be set with value '{idxvalue}'") Dim arrIndex() As String ReDim Preserve arrIndex(0) arrIndex(0) = idxName Logger.Debug("...nach arrIndex") Dim arrValue() As String Dim aktvalue As Object aktvalue = WMdok.GetVariableValue(idxName) Logger.Debug("...nach aktValue zuweisen..") Dim wmtype = clsWindream_allgemein.GetTypeOfIndexAsIntByName(idxName) Dim is_vektor As Boolean = False Select Case wmtype Case 4097 is_vektor = True Case 4098 is_vektor = True Case 4099 is_vektor = True Case 4101 is_vektor = True Case 4103 is_vektor = True Case 4107 is_vektor = True Case 36865 is_vektor = True End Select If is_vektor = False Then ReDim Preserve arrValue(0) arrValue(0) = idxvalue Else 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 ' MsgBox("now indexing with: " & idxvalue) windream_index.RunIndexing(WMdok, arrIndex, arrValue, _profObjekttyp) Else Logger.Warn("arrValue is nothing - keine Indexierung") End If Catch ex As Exception Logger.Error(ex) 'clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(SetIndex)") End Try Case "Rename File with windream Index".ToLower Logger.Debug("Exportierte Datei soll nach Indexvorgaben umbenannt werden...") _dateiverarbeitung.Rename_File(WMdok, DR_PR_FILE_JOB.Item("STRING1").ToString) Case "Rename File with WMVector (only one)".ToLower Logger.Debug("Exportierte Datei soll nach VektorIndexvorgaben umbenannt werden...") _dateiverarbeitung.Rename_File_Vektor(WMdok, DR_PR_FILE_JOB.Item("STRING1").ToString) Case "Execute Oracle Command".ToLower Try Logger.Debug("Execute Oracle Command.......") Dim oracleconnectionstring = DR_PR_FILE_JOB.Item("STRING1").ToString Dim oracleCommandRAW = DR_PR_FILE_JOB.Item("STRING2").ToString FileJobSuccessful = _dateiverarbeitung.RUN_ORACLE_COMMAND(WMdok, oracleconnectionstring, oracleCommandRAW) Catch ex As Exception Logger.Error(ex) '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 Logger.Debug("Execute MSSQL Command.......") FileJobSuccessful = _dateiverarbeitung.RUN_MSSQL_COMMAND(WMdok, MSSQLconnectionstring, MSSQLCommandRAW) Catch ex As Exception Logger.Error(ex) 'clsLogger.AddError("Unvorhergesehener Fehler: " & ex.Message, "clsProfil.Profil_Durchlauf(ExecuteMSSQLCommand)") End Try End Select 'Abschluss Bearbeitung File Job Next Else Logger.Warn("KEINE File-JOBS für Profil '" & _Profilname & "' angelegt!") End If Next 'Jetzt nochmal ein Durchlauf für Profiljobs wo alle Dateien abgearbeitet wurden. For Each DR_PR_JB As DataRow In DT_PROFIL_JOB.Rows Logger.Info("New run for " & DR_PR_JB.Item("JOB_TYP").ToString.ToUpper) Select Case DR_PR_JB.Item("JOB_TYP").ToString.ToUpper Case "Concat Files to one pdf".ToUpper Logger.Info("Again working on Case Concat Files to one pdf....") Dim pdftk = clsCURRENT.DT_TBWMRH_KONFIGURATION.Rows(0).Item("PDF_TK_LOCATION") Logger.Debug("pdftk location: " & pdftk) clsCURRENT.CONCATTED_FILE = DR_PR_JB.Item("STRING1") Logger.Debug("CONCATTED_FILE location: " & clsCURRENT.CONCATTED_FILE) Dim deleteJaNein = DR_PR_JB.Item("STRING2").ToString.ToUpper Logger.Debug("deleteJaNein: " & deleteJaNein.ToString) If File.Exists(pdftk) Then If File.Exists(clsCURRENT.CONCATTED_FILE) Then Try File.Delete(clsCURRENT.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 clsCURRENT.PROFILE_HandledFiles If i = 0 Then _argument = """" & str & """" Else _argument = _argument & " " & """" & str & """" End If i += 1 Next If File.Exists(clsCURRENT.CONCATTED_FILE) Then Try File.Delete(clsCURRENT.CONCATTED_FILE) Catch ex As Exception End Try End If myProcess.StartInfo.Arguments = _argument & " cat output " & clsCURRENT.CONCATTED_FILE Logger.Debug("Arguments: " & _argument & " cat output " & clsCURRENT.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 Logger.Info("Still waiting (30 sec) for ending of process-id: " & ProcID.ToString) ElseIf sw.Elapsed.TotalMinutes = 1 Then Logger.Info("Still waiting (60 sec) for ending of process-id: " & ProcID.ToString & " - Exit now") Exit Do End If Loop Logger.Debug("...process has exited: ") sw.Stop() Logger.Debug("Waiting for file: " & clsCURRENT.CONCATTED_FILE) sw.Start() Do While File.Exists(clsCURRENT.CONCATTED_FILE) = False If sw.Elapsed.TotalSeconds = 30 Then Logger.Info("ATTENTION: Still waiting (30 sec) for file: " & clsCURRENT.CONCATTED_FILE) ElseIf sw.Elapsed.TotalMinutes = 1 Then Logger.Info("ATTENTION: Still waiting (60 sec) for file: " & clsCURRENT.CONCATTED_FILE) FileJobSuccessful = False Exit Do End If Loop sw.Stop() If deleteJaNein = "JA" Then For Each str As String In clsCURRENT.PROFILE_HandledFiles Try File.Delete(str) Catch ex As Exception Logger.Error(ex) End Try Next End If Catch ex As Exception Logger.Error(ex) '("Unexpected error: " & ex.Message, "clsProfil.Profil_Durchlauf(Concat Files to one pdf)") End Try Else Logger.Warn("pdftk is not existing") End If Case "Send concatted file via mail".ToUpper Logger.Info("Working on CASE Send concatted file via mail.... ") If File.Exists(clsCURRENT.CONCATTED_FILE) = True Then Dim Email_Empfänger = DR_PR_JB.Item("STRING1") Logger.Debug("Email_Empfänger: " & Email_Empfänger) Dim Email_Betreff = DR_PR_JB.Item("STRING2") Logger.Debug("Email_Betreff: " & Email_Betreff) Dim Email_Body = DR_PR_JB.Item("STRING3") Logger.Debug("Email_Body: " & Email_Body) Dim EMAIL_PROFIL = DR_PR_JB.Item("STRING4") Logger.Debug("EMAIL_PROFIL: " & EMAIL_PROFIL) If Not IsNothing(clsCURRENT.DT_TBDD_EMAIL) And clsCURRENT.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 = "" Dim MAIL_AUTH_TYPE As String = "SSL" Dim MAIL_PORT As Integer For Each emailrow As DataRow In clsCURRENT.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") MAIL_AUTH_TYPE = emailrow.Item("AUTH_TYPE") MAIL_PORT = emailrow.Item("PORT") End If Next Logger.Debug($"MailCredentials: {MAILFROM}-{MAIL_USER}-{MAIL_USER_PW}") 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 Logger.Info("PWPlain is string.empty!!") End If Else Logger.Warn("PWPlain is string.empty - Could not decrypt passwort1") Return False End If If _email.Email_Send_Independentsoft(Email_Betreff, Email_Body, Email_Empfänger, MAILFROM, MAILSMTP, MAIL_PORT, MAIL_USER, MAIL_USER_PW, MAIL_AUTH_TYPE, clsCURRENT.CONCATTED_FILE) = True Then FileJobSuccessful = True Else Logger.Warn("Email_Send_Independentsoft was not successfull!") End If Else Logger.Warn("DT_TBDD_EMAIL is nothing or contains no rows") Return False End If Else Logger.Warn("File not existing: " & clsCURRENT.CONCATTED_FILE) End If Case "Send to printer".ToUpper Logger.Info("Working on CASE Send to printer.... ") Dim printername = DR_PR_JB.Item("STRING1") For Each str As String In clsCURRENT.PROFILE_HandledFiles Try Dim myproc As Process = New Process() myproc.StartInfo.FileName = """" & str & """" myproc.StartInfo.Verb = "printto" myproc.StartInfo.Arguments = printername myproc.StartInfo.UseShellExecute = True myproc.Start() Dim p As Process p = Process.GetProcessById(myproc.Id) Dim sw As Stopwatch = New Stopwatch() sw.Start() Do While p.HasExited = False If sw.Elapsed.TotalSeconds = 30 Then Logger.Info("Still waiting (30 sec) for ending of process-id: " & myproc.Id.ToString) ElseIf sw.Elapsed.TotalMinutes = 1 Then Logger.Info("Still waiting (60 sec) for ending of process-id: " & myproc.Id.ToString & " - Exit now") Exit Do End If Loop Logger.Debug("...process has exited: ") FileJobSuccessful = True sw.Stop() ' myproc.Kill() File.Delete(str) Catch ex As Exception Logger.Warn("Could not print (printto) file: " & str) Logger.Error(ex) End Try Next Case "Send InfoMail with WM-Search".ToUpper Logger.Info("Working on CASE Send InfoMail with WM-Search.... ") Dim oWMResults As WMObjects = windream.GetSearchDocuments(DR_PR_JB.Item("STRING5")) If oWMResults Is Nothing Then Logger.Warn("windreamSucheErgebnisse is nothing ( Send InfoMail with WM-Search)!", True, "clsProfil.Profil_Durchlauf") Return False End If If oWMResults.Count > 0 Then If _JobWork.New_Mail_with_attachment(DR_PR_JB.Item("STRING1"), DR_PR_JB.Item("STRING2"), DR_PR_JB.Item("STRING3"), DR_PR_JB.Item("STRING4"), clsCURRENT.DT_TBDD_EMAIL, DR_PR_JB.Item("STRING5")) = True Then FileJobSuccessful = True If DT_PROFIL_FILE_JOB.Rows.Count > 0 Then For Each DR_PR_FILE_JOB As DataRow In DT_PROFIL_FILE_JOB.Rows For Each oWMDoc As WMObject In oWMResults _dateiverarbeitung.Check_File_job(oWMDoc, DR_PR_FILE_JOB.Item("TYP").ToString.ToLower, DR_PR_FILE_JOB.Item("STRING1").ToString, DR_PR_FILE_JOB.Item("STRING2").ToString, _profObjekttyp, windream_index) Next Next End If End If Else Logger.Info("Send InfoMail with WM-Search - oWMResults.Count = 0") End If End Select If FileJobSuccessful = True Then End If Next Else Logger.Warn("Initialisierung Profil nicht erfolgreich") End If Else Logger.Warn("KEINE JOBS für Profil '" & _Profilname & "' angelegt!") End If Else ' keine Dateien zum Importieren Logger.Debug("Keine windream-Dokumente für Profil '" & _Profilname & "' vorhanden/gefunden.") End If End If End If Else Logger.Info("Verarbeitung für heute NICHT konfiguriert") End If 'Abschluss des Profiles _database.Execute_non_Query("UPDATE TBWMRH_PROFIL SET Running = 0 WHERE GUID = " & _profGUID) Return True Catch ex As Exception Logger.Error(ex) _database.Execute_non_Query("Update TBWMRH_PROFIL SET Running = 0 WHERE GUID = " & _profGUID) CriticalError = True Return False End Try End Function Private 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 Logger.Debug("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 Logger.Debug("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 Logger.Debug("New Value (" & Anzahl & ") " & NewValue.ToString) 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = NewValue.ToString Anzahl += 1 Else Logger.Debug("Value '" & NewValue.ToString & "' bereits in Vektorfeld enthalten") End If End If Next End If End If Else Logger.Debug("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 Logger.Debug("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 Logger.Debug("Return ValueArray: length " & ValueArray.Length) Return ValueArray Catch ex As Exception Logger.Error(ex) Return Nothing End Try End Function End Class