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