307 lines
17 KiB
VB.net
307 lines
17 KiB
VB.net
Imports System.Data.SqlClient
|
|
Imports WINDREAMLib
|
|
Imports System.Globalization
|
|
Module Modul_Main
|
|
Public vIntervall As Integer
|
|
Private _windreamPM As ClassPMWindream
|
|
Private _wdDokument As WMObject
|
|
Private email As New ClassEmail
|
|
Private email_Reminder As Boolean
|
|
Private email_from, email_user, email_pw, email_smtp, Reminder_Head, Reminder_Footer As String
|
|
|
|
Sub Main()
|
|
Try
|
|
ClassLogger.Init("", "logPM_Server", True)
|
|
ClassLogger.Add(" ######## ProcessManager - Server gestartet - " & Now, False)
|
|
Catch ex As System.Exception
|
|
'MsgBox("Fehler bei Log Create: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Achtung:")
|
|
End Try
|
|
Try
|
|
' Windream instanziieren
|
|
_windreamPM = New ClassPMWindream()
|
|
'Windream initialisieren (Connection, Session, ... aufbauen)
|
|
_windreamPM.Init()
|
|
ClassLogger.Add(" >> windream initialisiert", False)
|
|
Catch ex As Exception
|
|
ClassLogger.Add("Fehler in windream-Init: " & ex.Message, True)
|
|
If My.Settings.Email_senden = True Then
|
|
email.Send_Error_Mail("Fehler in windream-Init (Modul main): <br> >> Fehlermeldung: <br>" & ex.Message)
|
|
End If
|
|
End Try
|
|
Load_Konfig()
|
|
Check_Profiles()
|
|
Send_Reminder()
|
|
End Sub
|
|
Sub Run_Timer_Refresh_Files()
|
|
ClassLogger.Add(">> Timer Refresh_Files gestartet!", False)
|
|
Check_Profiles()
|
|
End Sub
|
|
Sub Send_Reminder()
|
|
Try
|
|
If email_Reminder = True Then
|
|
Dim list As New List(Of Integer)
|
|
list.Add(8)
|
|
list.Add(9)
|
|
list.Add(10)
|
|
list.Add(12)
|
|
list.Add(14)
|
|
list.Add(16)
|
|
list.Add(18)
|
|
Dim hour As Integer = My.Computer.Clock.LocalTime.Hour
|
|
Dim start As Boolean = False
|
|
Dim i As Integer
|
|
For i = 0 To list.Count - 1
|
|
If list.Item(i) = hour Then
|
|
start = True
|
|
End If
|
|
Next i
|
|
'Wenn diese Stunde eine Email versendet werden soll
|
|
If start = True Then
|
|
Dim DT As DataTable = ClassDatabase.Return_Datatable("Select * from VWPM_EMAIL_PROFIL where ANZ_FILES > 0")
|
|
If DT Is Nothing = False Then
|
|
If DT.Rows.Count > 0 Then
|
|
For Each Row As DataRow In DT.Rows
|
|
'If Row.Item("LAST_HOUR") = 0 Then
|
|
If Row.Item("LAST_HOUR") <> hour Then
|
|
If CBool(Row.Item("EMAIL_ONCE_DAY")) = True Then
|
|
If hour = 12 Then
|
|
Dim Body As String = "- Profilnam: '" & Row.Item("PROFIL_TITLE") & "' - Anzahl der Dokumente: " & Row.Item("ANZ_FILES")
|
|
If ClassEmail.Send_Reminder_Mail(Body, email_from, email_smtp, email_user, email_pw, Row.Item("EMAIL"), Reminder_Head, Reminder_Footer) = True Then
|
|
ClassDatabase.Execute_MSSQL("UPDATE TBPM_USER SET LAST_EMAIL_SEND = " & hour & " WHERE GUID = " & Row.Item("USER_ID"))
|
|
End If
|
|
End If
|
|
Else
|
|
Dim Body As String = "- Profilnam: '" & Row.Item("PROFIL_TITLE") & "' - Anzahl der Dokumente: " & Row.Item("ANZ_FILES")
|
|
If ClassEmail.Send_Reminder_Mail(Body, email_from, email_smtp, email_user, email_pw, Row.Item("EMAIL"), Reminder_Head, Reminder_Footer) = True Then
|
|
ClassDatabase.Execute_MSSQL("UPDATE TBPM_USER SET LAST_EMAIL_SEND = " & hour & " WHERE GUID = " & Row.Item("USER_ID"))
|
|
End If
|
|
End If
|
|
|
|
End If
|
|
'End If
|
|
Next
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
|
|
|
|
Catch ex As Exception
|
|
ClassLogger.Add("###Fehler in Send_Reminder: " & ex.Message)
|
|
If My.Settings.Email_senden = True Then
|
|
email.Send_Error_Mail("Fehler in Send_Reminder (Modul main): <br> >> Fehlermeldung: <br>" & ex.Message)
|
|
End If
|
|
End Try
|
|
End Sub
|
|
Sub Load_Konfig()
|
|
Try
|
|
Dim myConnection As SqlConnection
|
|
myConnection = New SqlConnection(My.Settings.SQLConnection)
|
|
Dim mySQLcommand As SqlCommand
|
|
mySQLcommand = New SqlCommand("SELECT * FROM TBPM_KONFIGURATION WHERE GUID = 1", myConnection)
|
|
|
|
' mySQLcommand.CommandText = "SELECT * FROM TBPM_KONFIGURATION WHERE GUID = 1"
|
|
Try
|
|
myConnection.Open()
|
|
Catch ex As Exception
|
|
ClassLogger.Add("Fehler in Load_Konfig DB aufbauen - Fehler: " & ex.Message, False)
|
|
ClassLogger.Add("Prüfen Sie die Anwendungsdatei-Angaben für die Connection", False)
|
|
myConnection.Close()
|
|
Exit Sub
|
|
End Try
|
|
Dim adapter1 As SqlDataAdapter = New SqlDataAdapter(mySQLcommand)
|
|
Dim dt As DataTable = New DataTable()
|
|
adapter1.Fill(dt)
|
|
|
|
If dt.Rows.Count = 1 Then
|
|
Dim Konfig_Row As System.Data.DataRow
|
|
'---------------------- für jedes Profil die Dateien überprüfen ------------------------
|
|
For Each Konfig_Row In dt.Rows
|
|
If CBool(Konfig_Row.Item("EMAIL_ACTIVE")) = True Then
|
|
email_Reminder = CBool(Konfig_Row.Item("EMAIL_ACTIVE"))
|
|
email_from = Konfig_Row.Item("EMAIL_FROM")
|
|
email_user = Konfig_Row.Item("EMAIL_USER")
|
|
email_pw = Konfig_Row.Item("EMAIL_PW")
|
|
email_smtp = Konfig_Row.Item("EMAIL_SMTP")
|
|
Reminder_Head = Konfig_Row.Item("EMAIL_REMINDER_HEADER")
|
|
Reminder_Footer = Konfig_Row.Item("EMAIL_REMINDER_FOOTER")
|
|
Else
|
|
email_Reminder = False
|
|
End If
|
|
Next
|
|
End If
|
|
Catch ex As Exception
|
|
ClassLogger.Add("###Fehler in Load_Konfig: " & ex.Message)
|
|
If My.Settings.Email_senden = True Then
|
|
email.Send_Error_Mail("Fehler in Load_Konfig (Modul main): <br> >> Fehlermeldung: <br>" & ex.Message)
|
|
End If
|
|
End Try
|
|
End Sub
|
|
Sub Check_Profiles()
|
|
Dim stp As String
|
|
' windream-Suche für Profil starten
|
|
_windreamPM = New ClassPMWindream()
|
|
stp = 1
|
|
Try
|
|
ClassLogger.Add(" >> Check_Profiles gestartet", False)
|
|
Dim WD_Search As String
|
|
Dim myConnection As SqlConnection
|
|
stp = 2
|
|
myConnection = New SqlConnection(My.Settings.SQLConnection)
|
|
stp = 3
|
|
Dim mySQLcommand As SqlCommand
|
|
mySQLcommand = New SqlCommand("SELECT GUID,NAME,WD_OBJECTTYPE,WD_SEARCH FROM TBPM_PROFILE WHERE ACTIVE = 1", myConnection)
|
|
stp = 4
|
|
mySQLcommand.CommandText = "SELECT GUID,NAME,WD_OBJECTTYPE,WD_SEARCH FROM TBPM_PROFILE WHERE ACTIVE = 1"
|
|
stp = 5
|
|
Try
|
|
myConnection.Open()
|
|
Catch ex As Exception
|
|
ClassLogger.Add("Fehler in Check_Profiles DB aufbauen - Fehler: " & ex.Message, False)
|
|
myConnection.Close()
|
|
Exit Sub
|
|
End Try
|
|
stp = 6
|
|
Dim adapter1 As SqlDataAdapter = New SqlDataAdapter(mySQLcommand)
|
|
stp = 7
|
|
Dim dt As DataTable = New DataTable()
|
|
stp = 8
|
|
adapter1.Fill(dt)
|
|
stp = 9
|
|
|
|
Console.WriteLine(">> Evtl alte nicht aktualisierte PROFILE-FILE Daten werden gelöscht")
|
|
'---------------------- Evtl alte nicht aktualisierte PROFILE-FILE Daten werden gelöscht ------------------------
|
|
Dim delete As String = "DELETE FROM TBPM_PROFILE_FILES WHERE ACTIVE = 0 AND IN_WORK = 0"
|
|
ClassDatabase.Execute_MSSQL(delete)
|
|
|
|
Dim sel4 = "select count(*) from TBPM_PROFILE_FILES"
|
|
Dim EMPTYTABLE = ClassDatabase.Execute_Scalar(sel4)
|
|
If EMPTYTABLE = 0 Then
|
|
ClassLogger.Add(">> Tabelle ist noch komplett leer", False)
|
|
End If
|
|
'delete = "DELETE FROM TBPM_PROFILE_FILES_TEMP"
|
|
'ClassDatabase.Execute_MSSQL(delete)
|
|
stp = 10
|
|
|
|
If dt.Rows.Count > 0 Then
|
|
Dim Profile_Row As System.Data.DataRow
|
|
'---------------------- für jedes Profil die Dateien überprüfen ------------------------
|
|
For Each Profile_Row In dt.Rows
|
|
stp = "a"
|
|
Console.WriteLine(">> Dateien für Profil '" & Profile_Row.Item("NAME") & "' eintragen")
|
|
ClassLogger.Add(">> Dateien für Profil '" & Profile_Row.Item("NAME") & "' eintragen", False)
|
|
Dim ID As Integer = Profile_Row.Item("GUID")
|
|
WD_Search = Nothing
|
|
WD_Search = Profile_Row.Item("WD_SEARCH")
|
|
stp = "b"
|
|
If WD_Search Is Nothing = False Then
|
|
'---------------------- Die Dateien auslesen ------------------------
|
|
Dim windreamSucheErgebnisse As WMObjects
|
|
stp = "c"
|
|
windreamSucheErgebnisse = _windreamPM.GetSearchDocuments(WD_Search)
|
|
stp = "d"
|
|
Dim Anzahl_Doks As Integer = 0
|
|
If windreamSucheErgebnisse Is Nothing = False Then
|
|
If windreamSucheErgebnisse.Count > 0 Then
|
|
stp = "e"
|
|
'Die aktuellen Files auf refreshed = 0 setzten
|
|
Dim upd As String = "UPDATE TBPM_PROFILE_FILES SET REFRESHED = 0 WHERE PROFIL_ID = " & ID
|
|
If ClassDatabase.Execute_MSSQL(upd) = True Then
|
|
stp = "e-1"
|
|
'Ein Array mit Dateiinformationen anlegen
|
|
Dim Profil_Docs(windreamSucheErgebnisse.Count - 1, 2) As String
|
|
For Each dok As WMObject In windreamSucheErgebnisse
|
|
Profil_Docs(Anzahl_Doks, 0) = ID
|
|
Profil_Docs(Anzahl_Doks, 1) = My.Settings.WD_LW & ":" & dok.aPath
|
|
'------DMS Erstell-Datum holen --------
|
|
Dim DMSErstellt = dok.GetVariableValue(My.Settings.vIDX_DMS_ERSTELLT)
|
|
Dim DOC_ID
|
|
Try
|
|
DOC_ID = dok.GetVariableValue("Dokument-ID")
|
|
Catch ex As Exception
|
|
DOC_ID = 0
|
|
End Try
|
|
|
|
'ClassLogger.Add(">> DMSErstellt: '" & DMSErstellt.ToString, False)
|
|
Dim date_EN As String
|
|
If My.Settings.vIDX_DMS_ERSTELLT.EndsWith("reated") Then
|
|
Dim arr() = DMSErstellt.ToString.Split(".")
|
|
If arr.Length = 3 Then
|
|
date_EN = arr(2).Replace(" 00:00:00", "") & "-" & arr(1) & "-" & arr(0)
|
|
ClassLogger.Add(">> date_EN: '" & date_EN, False)
|
|
DMSErstellt = date_EN
|
|
End If
|
|
End If
|
|
'-------------------- Überprüfen ob das Dokument bereits enthalten ist? Kann nur passieren wenn das Dok gerade in Bearbeitung ist ----------
|
|
Dim sel1 As String = "SELECT GUID FROM TBPM_PROFILE_FILES WHERE PROFIL_ID = " & ID & " AND FILE_PATH = '" & My.Settings.WD_LW & ":" & dok.aPath & "'"
|
|
Dim check = ClassDatabase.Execute_Scalar(sel1)
|
|
'---------------------- Das Dokument inserten ------------------------
|
|
Try
|
|
If check Is Nothing Or EMPTYTABLE = 0 Then
|
|
Dim insert As String = "INSERT INTO TBPM_PROFILE_FILES (PROFIL_ID, FILE_PATH, ACTIVE, DMS_ERSTELLT_DATE,DOC_ID) VALUES (" & ID & ", '" & My.Settings.WD_LW & ":" & dok.aPath & "',1, CONVERT(DATE,'" & DMSErstellt & "')," & DOC_ID & ")"
|
|
If ClassDatabase.Execute_MSSQL(insert) = False Then
|
|
ClassLogger.Add("### Unexpected Error while Inserting File-Record")
|
|
End If
|
|
' aktuelles Dokument der Klasse mitteilen
|
|
Else
|
|
If CInt(check) > 0 Then
|
|
Dim upd1 As String = "UPDATE TBPM_PROFILE_FILES SET REFRESHED = 1, EDIT = 0 WHERE GUID = " & CInt(check)
|
|
ClassDatabase.Execute_MSSQL(upd1)
|
|
End If
|
|
|
|
End If
|
|
Catch ex As Exception
|
|
ClassLogger.Add("###Fehler IN Insert or Update File-Record - ast step: " & stp)
|
|
ClassLogger.Add("###Fehler-Nachricht: " & ex.Message)
|
|
End Try
|
|
|
|
Anzahl_Doks += 1
|
|
Next
|
|
stp = "f - vor Delete Refreshed = 0"
|
|
Dim Del As String = "DELETE FROM TBPM_PROFILE_FILES WHERE PROFIL_ID = " & ID & " AND REFRESHED = 0"
|
|
ClassDatabase.Execute_MSSQL(Del)
|
|
'---------------------- Aktuelle Anzahl in Profiltabelle updaten ------------------------
|
|
Dim update As String = "UPDATE TBPM_PROFILE SET NO_OF_DOCUMENTS = " & Anzahl_Doks & " WHERE GUID = " & ID
|
|
stp = "g - " & Anzahl_Doks.ToString
|
|
ClassDatabase.Execute_MSSQL(update)
|
|
ClassLogger.Add(">> Profil '" & Profile_Row.Item("NAME") & "' aktualisiert - Anzahl Dateien: " & Anzahl_Doks.ToString, False)
|
|
Else
|
|
ClassLogger.Add(">> ACHTUNG: Refresh konnte nicht ausgeführt werden: " & upd, False)
|
|
End If
|
|
Else
|
|
stp = "g"
|
|
ClassLogger.Add(">> KEINE DATEIEN FÜR PROFIL VORHANDEN.", False)
|
|
End If
|
|
Else
|
|
ClassLogger.Add(">> ACHTUNG: WINDREAM-SUCHE ist NOTHING.", False)
|
|
End If
|
|
End If
|
|
Next
|
|
stp = "h"
|
|
''------------------------------- Bearbeitete Daten löschen ------------------------
|
|
If ClassDatabase.Execute_MSSQL("DELETE FROM TBPM_PROFILE_FILES WHERE EDIT = 1") = True Then
|
|
' stp = "i"
|
|
' Console.WriteLine(">> Alte PROFILE-FILE Daten geleert")
|
|
' '---------------------- DIE NEUEN DATEN AUF ACTIVE SETZEN ------------------------
|
|
' Dim update As String = "UPDATE TBPM_PROFILE_FILES SET ACTIVE = 1 WHERE ACTIVE = 0"
|
|
' ClassDatabase.Execute_MSSQL(update)
|
|
' stp = "j"
|
|
' Console.WriteLine(">> Neue PROFILE-FILE Daten aktiv gesetzt")
|
|
End If
|
|
ClassDatabase.Execute_MSSQL("EXEC PRPM_REMOVE_NE_FILES")
|
|
End If
|
|
myConnection.Close()
|
|
stp = "k"
|
|
Catch ex As Exception
|
|
ClassLogger.Add("###Fehler IN Check_Profiles - last step: " & stp)
|
|
ClassLogger.Add("###Fehler IN Check_Profiles: " & ex.Message)
|
|
If ex.Message.Contains("Der Objektverweis wurde nicht auf eine Objektinstanz festgelegt.") = False Then
|
|
If My.Settings.Email_senden = True Then
|
|
email.Send_Error_Mail("Fehler in Check_Profiles (Modul main): <br> >> Fehlermeldung: <br>" & ex.Message)
|
|
End If
|
|
End If
|
|
End Try
|
|
End Sub
|
|
End Module
|