ZsgImport/app/ZSG_Import/MyService.vb
Digital Data - Marlon Schreiber e09488a06b MS
2017-11-08 15:02:30 +01:00

361 lines
23 KiB
VB.net

Imports System.ComponentModel
Imports System.IO
Public Class MyService
'Variablen
Public Shared threadRunner As BackgroundWorker
Public Shared Function GetLnkTarget(lnkPath As String) As String
Try
Dim shl = New Shell32.Shell()
' Move this to class scope
lnkPath = System.IO.Path.GetFullPath(lnkPath)
Dim dir = shl.[NameSpace](System.IO.Path.GetDirectoryName(lnkPath))
Dim itm = dir.Items().Item(System.IO.Path.GetFileName(lnkPath))
Dim lnk = DirectCast(itm.GetLink, Shell32.ShellLinkObject)
Return lnk.Target.Path
Catch ex As Exception
clsLogger.AddError(ex.Message, "GetLnkTarget")
clsLogger.WriteLog()
Return Nothing
End Try
End Function
Protected Overrides Sub OnStart(ByVal args() As String)
' Code zum Starten des Dienstes hier einfügen. Diese Methode sollte Vorgänge
' ausführen, damit der Dienst gestartet werden kann.
' Code zum Starten des Dienstes hier einfügen. Diese Methode sollte Vorgänge
' ausführen, damit der Dienst gestartet werden kann.
Try
clsLogger.Init(My.Application.Info.DirectoryPath & "\Log", "")
clsLogger.Add("## ZSGImport Service started - " & Now & " ## ", False)
If My.Settings.MyConnectionString = String.Empty Then
clsLogger.Add("NO CONNECTIONSTRING CONFIGURED.", True)
Else
If clsDatabase.Init = False Then
clsLogger.Add("ATTENTION: No Connection was established '" & My.Settings.MyConnectionString & "'!", True)
Else
LOG_ERRORS_ONLY = My.Settings.LOG_ERRORS_ONLY
If LOG_ERRORS_ONLY = False Then
clsLogger.Add("DETAIL-LOG IS ACTIVE", False)
End If
'### Thread für das nachträgliche Setzen von Rechten generieren
MyService.threadRunner = New BackgroundWorker()
MyService.threadRunner.WorkerReportsProgress = True
MyService.threadRunner.WorkerSupportsCancellation = True
AddHandler threadRunner.DoWork, AddressOf RUN_THREAD
AddHandler threadRunner.RunWorkerCompleted, AddressOf Thread1_Completed
' Und den Durchlauf das erste Mal starten
threadRunner.RunWorkerAsync()
End If
End If
clsLogger.WriteLog()
Catch ex As Exception
clsLogger.AddError(ex.Message, "OnStart")
clsLogger.WriteLog()
End Try
End Sub
Public Shared Sub RUN_THREAD(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim step_ As String
Try
Dim DT_KONFIG As DataTable = clsDatabase.Return_Datatable("SELECT * FROM TBPMO_SERVICE_RIGHT_CONFIG WHERE GUID = 1")
AD_DOMAIN = DT_KONFIG.Rows(0).Item("AD_DOMAIN")
AD_USER = DT_KONFIG.Rows(0).Item("AD_USER")
AD_SERVER = DT_KONFIG.Rows(0).Item("AD_SERVER")
Dim PWplainText As String
Dim wrapper As New ClassEncryption("!35452didalog=")
' DecryptData throws if the wrong password is used.
Try
PWplainText = wrapper.DecryptData(DT_KONFIG.Rows(0).Item("AD_USER_PW"))
Catch ex As Exception
clsLogger.Add("The Userpassword could not be decrypted", False)
PWplainText = ""
End Try
AD_USER_PW = PWplainText
Dim logcount As Integer = 0
'erst einmal die Technischen Plätze bestimmen die noch nciht importiert wurden
Dim DTIMPORT_COMOS As DataTable = clsDatabase.Return_Datatable("SELECT * FROM VWPMO_TEMP_IMPORT_COMOS_FILES")
'SELECT DISTINCT [UNIQUE_STR] FROM [EXPORT_COMOS] where dokumentart is not null and imported = 0 and [UNIQUE_STR] LIKE '472%' order by [UNIQUE_STR]
Try
Dim selrecid
If Not IsNothing(DTIMPORT_COMOS) Then
If DTIMPORT_COMOS.Rows.Count > 0 Then
clsLogger.Add(String.Format("{0} FILES need to be worked", DTIMPORT_COMOS.Rows.Count.ToString), False)
Dim DTTBPMO_WD_OBJECTTYPE As DataTable
Dim Sql = "Select Top 1 * from TBPMO_WD_OBJECTTYPE where Upper(object_type) = Upper('ZSG - Geschäftsprozess')"
clsWindream._WDObjekttyp = "ZSG - Geschäftsprozess"
DTTBPMO_WD_OBJECTTYPE = clsDatabase.Return_Datatable(Sql)
Dim WD_Session = clsWindream.GetWMSessionAsUser(AD_DOMAIN, AD_SERVER, AD_USER, AD_USER_PW)
If Not IsNothing(WD_Session) Then
If DTTBPMO_WD_OBJECTTYPE.Rows.Count = 1 Then
If ClassWDRights.Init = True Then
Dim filecount = 1
'Jeden Technischen Platz einzeln durchlaufen weil für diesen ein Record existiert
For Each FILE_ROW As DataRow In DTIMPORT_COMOS.Rows
clsLogger.Add(String.Format("Working on File {0}/{1} - ID: {2}", filecount, DTIMPORT_COMOS.Rows.Count, FILE_ROW.Item("GUID")), False)
filecount += 1
Dim MYOBJECT As String = FILE_ROW.Item("OBJEKT")
clsLogger.AddDetailLog(String.Format("Working on OBJEKT: '{0}'", MYOBJECT))
CURRENT_IMPORT_ID = 0
step_ = ""
logcount += 1
Dim filename = FILE_ROW.Item("Link")
filename = filename.ToString.Replace("U:", "E:")
filename = filename.ToString.Replace("\\", "\")
selrecid = String.Format("SELECT GUID FROM TBPMO_RECORD where GUID = {0}", FILE_ROW.Item("RECORD_ID"))
Dim _RECORD_ID = clsDatabase.Execute_Scalar(selrecid)
If Not IsNothing(_RECORD_ID) Then
'Jede Datei einzeln durchlaufen
step_ = ""
Dim _DISPLAYNAME = FILE_ROW.Item("DISPLAYNAME")
Dim docsql As String
CURRENT_IMPORT_ID = FILE_ROW.Item("GUID")
UpdateWORKED_GUID()
If filename.ToString.EndsWith(".lnk") Then
clsLogger.Add("FILE IS A LINK", False)
If filename = GetLnkTarget(filename) = Nothing Then
Continue For
End If
End If
If File.Exists(filename) Then
Dim sql2 = String.Format("SELECT * FROM [dbo].[FN_GET_PATH_AND_CO] ('{0}')", filename)
clsLogger.AddDetailLog("sqlFN_GET_PATH_AND_CO: " & sql2)
Dim DT_PATH_RESULTS As DataTable = clsDatabase.Return_Datatable(sql2)
If DT_PATH_RESULTS.Rows.Count = 1 Then
step_ = "DT_PATH_RESULTS.Rows.Count = 1"
Dim WD_PATH = DT_PATH_RESULTS.Rows(0).Item(0)
clsLogger.AddDetailLog("WD_PATH: " & WD_PATH)
Dim Department = DT_PATH_RESULTS.Rows(0).Item(1)
Dim DoctypeSIDtring = DT_PATH_RESULTS.Rows(0).Item(2)
docsql = String.Format("select GUID from TBDD_DOKUMENTART where substring(BEZEICHNUNG,1,2) = substring('{0}',1,2)", DoctypeSIDtring)
Dim DOCTYPE_ID = clsDatabase.Execute_Scalar(docsql)
clsLogger.AddDetailLog("DOCTYPE_ID: " & DOCTYPE_ID)
Dim DOCTYPE_STRING = clsDatabase.Execute_Scalar(String.Format("SELECT [dbo].[FNPMO_GETOBJECTCAPTION] ('de-DE','DOCTYPE_TITLE' + CONVERT(VARCHAR(4),{0}),1)", DOCTYPE_ID))
If IsNothing(DOCTYPE_STRING) Then
DOCTYPE_STRING = "NO DOCTYPE"
Update_COMMENT_GUID("NO DOCTYPE: " & DoctypeSIDtring)
End If
clsLogger.AddDetailLog("DOCTYPE_STRING: " & DOCTYPE_STRING)
'Prüfen ob Datei schon referenziert wurde
docsql = String.Format("SELECT DocID, FULL_FILENAME FROM VWPMO_DOC_SYNC where UPPER(FULL_FILENAME) = UPPER('{0}')", WD_PATH)
Dim DT_FILE_EXISTS As DataTable = clsDatabase.Return_Datatable(docsql)
Dim DOC_ID
If DT_FILE_EXISTS.Rows.Count = 0 Then
Dim streamresult = clsWindream.Stream_File(filename, WD_PATH, WD_Session)
If streamresult = True Then
step_ = "streamresult = True"
If DTTBPMO_WD_OBJECTTYPE.Rows.Count = 1 Then
If clsWindream.WMFILE_existed = False Then
Dim indexname
Dim indexierung_erfolgreich = False
indexname = DTTBPMO_WD_OBJECTTYPE.Rows(0).Item("IDXNAME_DOCTYPE").ToString
'Indexierung des Dokumententyps
indexierung_erfolgreich = clsWindream.IndexaktFile(indexname, DOCTYPE_STRING)
If indexierung_erfolgreich = False Then
clsLogger.WriteLog()
Continue For
End If
indexname = DTTBPMO_WD_OBJECTTYPE.Rows(0).Item("IDXNAME_RELATION").ToString
indexierung_erfolgreich = clsWindream.IndexaktFile(indexname, "ADDI-RELATION")
If indexierung_erfolgreich = False Then
clsLogger.AddDetailLog("EXIT ON indexierung_erfolgreich ADDI-RELATION=False...")
clsLogger.WriteLog()
Continue For
End If
Else
clsLogger.WriteLog()
End If
End If
Else
step_ = " streamresult = False "
clsLogger.WriteLog()
Continue For
End If
Else
clsLogger.AddDetailLog("FILE ALREADY EXISTING IN WINDREAM...")
'Datei existiert bereits in windream
If clsWindream.Create_aktWDObjekt(WD_PATH) = False Then
clsLogger.Add(String.Format("Could not create aktWDObjekt"), False)
clsLogger.WriteLog()
Continue For
End If
End If
DOC_ID = clsWindream.aktWMObject.GetVariableValue("Dokument-ID")
CURRENT_DOC_ID = 0
If IsNumeric(DOC_ID) And DOC_ID <> 0 Then
docsql = String.Format("SELECT COUNT(DocID) FROM VWPMO_DOC_SYNC WHERE DocID = {0}", DOC_ID)
If clsDatabase.Execute_Scalar(docsql) = 1 Then
CURRENT_DOC_ID = DOC_ID
UpdateIMPORTED_GUID()
Dim execute = String.Format("EXEC [dbo].[PRPMO_DOC_CREATE_NEW_DOC] {0},{1},'{2}'", DOC_ID, _RECORD_ID, "windream")
If clsDatabase.Execute_non_Query(execute) = True Then
If Not IsDBNull(_DISPLAYNAME) Then
Dim upd1 = String.Format("UPDATE TBPMO_DOCRESULT_LIST SET DISPLAY_NAME = '{0}' WHERE DocID = {1}", _DISPLAYNAME, CURRENT_DOC_ID)
clsDatabase.Execute_Scalar(upd1)
End If
SET_WD_RIGHTS()
Else
clsLogger.Add(String.Format("DOC-Links could not be created!"), False)
End If
Else
clsLogger.Add(String.Format("DOC-ID not in VWPMO_DOC_SYNC"), False)
End If
Else
clsLogger.Add(String.Format("COULD NOT GET A DOC-ID"), False)
End If
Else
clsLogger.Add(String.Format("DT_PATH_RESULTS is nothing"), False)
End If
Else
clsLogger.Add(String.Format("File not found: {0}", filename), False)
Update_COMMENT_GUID("FILE NOT FOUND")
End If
Else
clsLogger.Add(String.Format("No Record found for OBJECT: {0} " & selrecid, MYOBJECT), False)
Update_COMMENT_GUID("No Record found (IMPORT)")
End If
If logcount = 10 Then
clsLogger.WriteLog()
logcount = 0
End If
Next
clsLogger.Add("CREATE COMOSLinks FINISHED", False)
clsLogger.WriteLog()
Else
clsLogger.AddError("Could not initialize right-module...")
End If
Else
clsLogger.Add(String.Format(">>WDOBJEKTTYPE IS NOTHING"), False)
End If
Else
clsLogger.Add("COULD NOT CREATE A SESSION", True)
End If
End If
End If
Catch ex As Exception
clsLogger.AddError("Uncexpected Error in working Objekts: " & ex.Message & " LAST STEP: " & step_)
clsLogger.WriteLog()
End Try
'Try
' Dim DT_DELETE As DataTable = clsDatabase.Return_Datatable("SELECT DISTINCT UPPER(LINK) FROM IMPORT_2017_Links WHERE IMPORTED = 1 AND FILE_DELETED = 0 AND DOC_ID > 0")
' If Not IsNothing(DT_DELETE) Then
' step_ = "FOR EACH DELETE ROW"
' For Each row_link As DataRow In DT_DELETE.Rows
' Dim _filename = row_link.Item(0)
' _filename = _filename.ToString.Replace("U:", "E:")
' Dim sqlex = String.Format("SELECT COUNT(*) FROM IMPORT_2017_Links WHERE UPPER(LINK) = UPPER('{0}') AND (IMPORTED = 0 OR WORKED = 0)", _filename)
' Dim DT_REST As DataTable = clsDatabase.Return_Datatable(sqlex)
' If DT_REST.Rows.Count = 0 Then
' If File.Exists(_filename) Then
' Try
' File.Delete(_filename)
' _filename = _filename.ToString.Replace("E:", "U:")
' Dim upd = String.Format("UPDATE IMPORT_2017_Links SET FILE_DELETED = 1 WHERE UPPER(LINK) = UPPER('{0}')", _filename)
' clsDatabase.Execute_non_Query(upd)
' Catch ex As Exception
' clsLogger.Add(String.Format("COULD NOT DELETE FILE: {0} - ERRO: " & ex.Message, _filename), False)
' End Try
' 'Else
' ' _filename = _filename.ToString.Replace("E:", "U:")
' ' Dim upd = String.Format("UPDATE IMPORT_2017_Links SET FILE_DELETED = 1 WHERE UPPER(LINK) = UPPER('{0}')", _filename)
' ' clsDatabase.Execute_non_Query(upd)
' End If
' End If
' Next
' End If
'Catch ex As Exception
' clsLogger.AddError("Uncexpected Error in Delete Docs: " & ex.Message & " LAST STEP: " & step_)
' clsLogger.WriteLog()
'End Try
clsLogger.WriteLog()
Catch ex As Exception
clsLogger.AddError("Uncexpected Error: " & ex.Message, "RUN_THREAD")
clsLogger.WriteLog()
End Try
End Sub
Public Shared Function SET_WD_RIGHTS()
Try
If ClassWDRights.Doc_Renew_Rights() Then
If ClassWDRights.MSG_RESULT <> "" Then
clsLogger.Add("Attention: some rights could Not be set: " & ClassWDRights.MSG_RESULT.MSG_RESULT, True)
Return True
End If
Else
clsLogger.Add("Error in Doc_Renew_Rights.. ", True)
Return False
End If
Catch ex As Exception
clsLogger.AddError("Uncexpected Error in SET_WD_RIGHTS: " & ex.Message)
clsLogger.WriteLog()
Return False
End Try
End Function
'Private Shared Sub Update_COMMENT(UNIQUE_STR As String, comment As String)
' Try
' Dim upd = String.Format("UPDATE [IMPORT_2017_Links] SET COMMENT_IMPORT = '{0}' where UPPER(OBJEKT) = UPPER('{1}') AND IMPORTED = 0", comment, UNIQUE_STR)
' clsDatabase.Execute_non_Query(upd)
' Catch ex As Exception
' clsLogger.AddError("Uncexpected Error in Update_COMMENT: " & ex.Message)
' End Try
'End Sub
Private Shared Sub Update_COMMENT_GUID(comment As String)
Try
Dim upd = String.Format("UPDATE IMPORT_2017_Links SET COMMENT_IMPORT = '{0}' where GUID = {1}", comment, CURRENT_IMPORT_ID)
clsDatabase.Execute_non_Query(upd)
Catch ex As Exception
clsLogger.AddError("Uncexpected Error in Update_COMMENT_GUID: " & ex.Message)
End Try
End Sub
Private Shared Sub UpdateIMPORTED_GUID()
Try
Dim upd = String.Format("UPDATE IMPORT_2017_Links SET IMPORTED = 1, DOC_ID = {1} where GUID = {0}", CURRENT_IMPORT_ID, CURRENT_DOC_ID)
clsDatabase.Execute_non_Query(upd)
Catch ex As Exception
clsLogger.AddError("Uncexpected Error in UpdateIMPORTED_GUID: " & ex.Message)
End Try
End Sub
Private Shared Sub UpdateWORKED_GUID()
Try
Dim upd = String.Format("UPDATE IMPORT_2017_Links SET WORKED = 1 where GUID = {0}", CURRENT_IMPORT_ID)
clsDatabase.Execute_non_Query(upd)
Catch ex As Exception
clsLogger.AddError("Uncexpected Error in UpdateIMPORTED_GUID: " & ex.Message)
End Try
End Sub
Protected Overrides Sub OnStop()
' Hier Code zum Ausführen erforderlicher Löschvorgänge zum Beenden des Dienstes einfügen.
clsLogger.Add("## ZSGImport Service was stopped manually - " & Now & " ## ", False)
clsLogger.WriteLog()
End Sub
Private Shared Sub Thread1_Completed(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) 'Handles threadDateiimport.RunWorkerCompleted
' This event fires when the DoWork event completes
Try
Dim result As String = ""
If e.Cancelled Then
clsLogger.Add("## The thread was cancelled", False)
clsLogger.WriteLog()
ElseIf e.Error IsNot Nothing Then
clsLogger.Add("Fehler bei Durchlauf. Der Vorgang wird abgebrochen.", True, "Thread_Completed")
clsLogger.Add(e.Error.Message, True, "Thread_Completed")
clsLogger.WriteLog()
End If
Catch ex As Exception
clsLogger.AddError(ex.Message, "Thread_Completed")
End Try
End Sub
End Class