diff --git a/.vs/ProjectSettings.json b/.vs/ProjectSettings.json
new file mode 100644
index 0000000..f8b4888
--- /dev/null
+++ b/.vs/ProjectSettings.json
@@ -0,0 +1,3 @@
+{
+ "CurrentProjectSetting": null
+}
\ No newline at end of file
diff --git a/.vs/VSWorkspaceState.json b/.vs/VSWorkspaceState.json
new file mode 100644
index 0000000..6b61141
--- /dev/null
+++ b/.vs/VSWorkspaceState.json
@@ -0,0 +1,6 @@
+{
+ "ExpandedNodes": [
+ ""
+ ],
+ "PreviewInSolutionExplorer": false
+}
\ No newline at end of file
diff --git a/.vs/slnx.sqlite b/.vs/slnx.sqlite
index 5800bc2..306167f 100644
Binary files a/.vs/slnx.sqlite and b/.vs/slnx.sqlite differ
diff --git a/app/ZSG_Import/CURRENT.vb b/app/ZSG_Import/CURRENT.vb
index 5902eff..6d10704 100644
--- a/app/ZSG_Import/CURRENT.vb
+++ b/app/ZSG_Import/CURRENT.vb
@@ -1,4 +1,7 @@
Module CURRENT
Public LOG_ERRORS_ONLY As Boolean = True
Public CURRENT_FILEIN_WD As String
+ Public CURRENT_IMPORT_ID As Integer
+ Public CURRENT_DOC_ID As Integer
+ Public AD_DOMAIN, AD_USER, AD_SERVER, AD_USER_PW As String
End Module
diff --git a/app/ZSG_Import/ClassEncryption.vb b/app/ZSG_Import/ClassEncryption.vb
new file mode 100644
index 0000000..b0bfa39
--- /dev/null
+++ b/app/ZSG_Import/ClassEncryption.vb
@@ -0,0 +1,68 @@
+Imports System.Security.Cryptography
+Public Class ClassEncryption
+ Private TripleDes As New TripleDESCryptoServiceProvider
+ Sub New(ByVal key As String)
+ ' Initialize the crypto provider.
+ TripleDes.Key = TruncateHash(key, TripleDes.KeySize \ 8)
+ TripleDes.IV = TruncateHash("", TripleDes.BlockSize \ 8)
+ End Sub
+
+ Private Function TruncateHash(
+ ByVal key As String,
+ ByVal length As Integer) As Byte()
+
+ Dim sha1 As New SHA1CryptoServiceProvider
+
+ ' Hash the key.
+ Dim keyBytes() As Byte =
+ System.Text.Encoding.Unicode.GetBytes(key)
+ Dim hash() As Byte = sha1.ComputeHash(keyBytes)
+
+ ' Truncate or pad the hash.
+ ReDim Preserve hash(length - 1)
+ Return hash
+ End Function
+ Public Function EncryptData(
+ ByVal plaintext As String) As String
+
+ ' Convert the plaintext string to a byte array.
+ Dim plaintextBytes() As Byte =
+ System.Text.Encoding.Unicode.GetBytes("!Didalog35452Heuchelheim=" & plaintext)
+
+ ' Create the stream.
+ Dim ms As New System.IO.MemoryStream
+ ' Create the encoder to write to the stream.
+ Dim encStream As New CryptoStream(ms,
+ TripleDes.CreateEncryptor(),
+ System.Security.Cryptography.CryptoStreamMode.Write)
+
+ ' Use the crypto stream to write the byte array to the stream.
+ encStream.Write(plaintextBytes, 0, plaintextBytes.Length)
+ encStream.FlushFinalBlock()
+
+ ' Convert the encrypted stream to a printable string.
+ Return Convert.ToBase64String(ms.ToArray)
+ End Function
+ 'Entschlüsselt die Zeichenfolge
+ Public Function DecryptData(
+ ByVal encryptedtext As String) As String
+
+ ' Convert the encrypted text string to a byte array.
+ Dim encryptedBytes() As Byte = Convert.FromBase64String(encryptedtext)
+
+ ' Create the stream.
+ Dim ms As New System.IO.MemoryStream
+ ' Create the decoder to write to the stream.
+ Dim decStream As New CryptoStream(ms,
+ TripleDes.CreateDecryptor(),
+ System.Security.Cryptography.CryptoStreamMode.Write)
+
+ ' Use the crypto stream to write the byte array to the stream.
+ decStream.Write(encryptedBytes, 0, encryptedBytes.Length)
+ decStream.FlushFinalBlock()
+ Dim result = System.Text.Encoding.Unicode.GetString(ms.ToArray)
+ result = result.Replace("!Didalog35452Heuchelheim=", "")
+ ' Convert the plaintext stream to a string.
+ Return result
+ End Function
+End Class
diff --git a/app/ZSG_Import/ClassWDRights.vb b/app/ZSG_Import/ClassWDRights.vb
new file mode 100644
index 0000000..e300760
--- /dev/null
+++ b/app/ZSG_Import/ClassWDRights.vb
@@ -0,0 +1,252 @@
+Imports WINDREAMLib
+Imports DD_LIB_Standards
+Public Class ClassWDRights
+#Region "+++++ Konstanten +++++"
+ Const REL_Document_AccessRight = "AccessRight"
+ Const COL_AccessRight_AccessRightID = "dwAccessRightID"
+ Const COL_AccessRight_AccessRight = "dwAccessRight"
+ Const REL_AccessRight_UserOrGroup = "AccessRightUserOrGroup"
+
+
+ Const WMAccessRightUndefined = 0
+ Const WMAccessRightRead = 1
+ Const WMAccessRightWrite = 2
+ Const WMAccessRightReadWrite = 3
+ Const WMAccessRightAdmin = 4
+ Const WMAccessRightAllRights = 7 ' doc+folder: read, write and admin access
+
+ Const WMUserTypeMain = 1
+ Const WMUserTypeNormal = 4
+ Const WMUserTypeInactive = 8
+
+ Const WMGroupTypeAdmin = 2
+
+ Const WMEntityGroups = 13
+ Const WMEntityUser = 18
+ Const WMGroupTypeAll = 127
+
+#End Region
+#Region "+++++ Variables +++++"
+ Public Shared AD_DOMAIN As String
+ Public Shared AD_USER As String
+ Public Shared AD_USER_PW As String
+ Public Shared AD_SERVER As String
+ Public Shared WD_RIGHT_ADMIN As Integer
+ Public Shared MSG_RESULT = ""
+#End Region
+ Public Shared Function Init()
+ Try
+ MSG_RESULT = ""
+ 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")
+ WD_RIGHT_ADMIN = DT_KONFIG.Rows(0).Item("WD_RIGHT")
+ 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
+
+ Return True
+ Catch ex As Exception
+ clsLogger.Add("Unexpected Error in ClassRights Init: " & vbNewLine & ex.Message, True)
+
+ Return False
+ End Try
+ End Function
+ '''Renews all rights of the passed doc-file
+ '''
+ ''' Returns Boolean True when successfull
+ '''
+ Public Shared Function Doc_Renew_Rights() As Boolean
+ Try
+
+ Dim DT_USER_RIGHT As DataTable
+
+ Dim UserGroupRelation
+ Dim UserOrGroup
+ Dim oUSer
+
+
+ Dim sql = String.Format("SELECT * FROM [dbo].[FNPMO_GET_RIGHTS_FOR_DOC] ({0})", CURRENT_DOC_ID)
+ DT_USER_RIGHT = clsDatabase.Return_Datatable(sql)
+ If IsNothing(DT_USER_RIGHT) Then
+ Dim msg = "Error while receiving rights for DocID"
+ clsLogger.Add(msg, True)
+
+ Return False
+ End If
+
+ Dim lret
+ Try
+ ' Objekt muss zur Rechteänderung gelockt werden
+ lret = clsWindream.aktWMObject.LockRights()
+ Catch ex As Exception
+ Dim msg = "Error while locking file" & ex.Message
+ clsLogger.Add(msg, True)
+
+ Return False
+ End Try
+
+ If CBool(lret) = False Then
+ Dim msg = "Error in setting lock .LockRights - Err.Number: " & Err.Number & vbCrLf & Err.Description
+ clsLogger.Add(msg, True)
+
+ Return False
+ End If
+
+ ' Rechteträger-Liste holen
+ Dim AccessRights
+ AccessRights = clsWindream.aktWMObject.GetWMObjectRelationByName(REL_Document_AccessRight)
+ 'Bei Fehler in Rechteauswertung
+ If Err.Number <> 0 Then
+ Dim msg = "Error in setting REL_Document_AccessRight - Err.Number: " & Err.Number & vbCrLf & Err.Description
+ clsLogger.Add(msg, True)
+
+ Return False
+ End If
+ '############################# Rechte löschen ################################################################################
+ '#############################################################################################################################
+
+ 'Erst einmal alle anderen Rechte löschen
+ Dim i As Integer = 1
+ ' und nun jeden Rechteträger verarbeiten
+ For Each aRightRelation In AccessRights
+
+ ' Auflistung der Rechteträger-Informationen holen
+ UserGroupRelation = aRightRelation.GetWMObjectRelationByName(REL_AccessRight_UserOrGroup)
+ If Err.Number <> 0 Then
+ Dim msg = "Error in setting REL_AccessRight_UserOrGroup - Err.Number: " & Err.Number & vbCrLf & Err.Description
+ clsLogger.Add(msg, True)
+
+ Return False
+ End If
+
+ ' Zugriff auf das Benutzer/Gruppen-Objekt
+ UserOrGroup = UserGroupRelation.item(0)
+ Dim _msg As String
+
+ If (UserOrGroup.aWMEntity = WMEntityGroups) Then
+ _msg = "Right for Group '" & UserOrGroup.aName & "'"""
+ Else
+ _msg = "Right for User: '" & UserOrGroup.aName & "'"""
+ End If
+
+ If Err.Number <> 0 Then
+ Dim msg = "Error in setting UserGroupRelation - Err.Number: " & Err.Number & vbCrLf & Err.Description
+ clsLogger.Add(msg, True)
+
+ Return False
+ End If
+
+ 'einem Rechteträger ALLE Rechte zu entziehen
+ 'entfernt ihn gleichzeitig aus der Auflistung der Rechteträger
+ Try
+ AccessRights.Delete2(UserOrGroup, WMAccessRightAllRights)
+ Catch ex As Exception
+ Dim msg = "Error in AccessRights.Delete2: " & ex.Message
+ clsLogger.Add(msg, True)
+ Continue For
+ End Try
+ i += 1
+ _msg = _msg.Replace("'", "")
+
+ Next
+
+
+ Err.Clear()
+ ' Wenn ALLE Rechteträger entfernt werden (FOR EACH),
+ ' dann muss mindestens EIN Rechteträger mit dem Recht zur Rechteänderung
+ ' wieder zugefügt werden!!!!! Dies ist der ADDI-Right User!
+ 'Für jeden User das Recht einzeln hinzufügen
+ For Each User_Row As DataRow In DT_USER_RIGHT.Rows
+ Dim fileright 'Recht als Integer
+ Dim StringUserRight
+ Try
+ StringUserRight = AD_DOMAIN & "\" & User_Row.Item("USR_NAME")
+ fileright = User_Row.Item("USR_RIGHT")
+
+ Try
+ ' User holen
+ oUSer = clsWindream.oSession.GetWMObjectByName(WMEntityUser, StringUserRight)
+
+ Catch ex As Exception
+ Dim msg = String.Format(">> Could not create windream-Usersession for user '{0}' - check whether user is part of windream-group!", StringUserRight)
+ clsLogger.Add(msg, False)
+
+ MSG_RESULT &= msg & vbNewLine
+ Continue For
+ End Try
+ If Not IsNothing(oUSer) Then
+ Try
+ AccessRights.Insert2(oUSer, fileright) 'WMAccessRightAllRights)
+
+ Catch ex As Exception
+ Dim msg = String.Format(">> Could not set right for user {0} - AccessRights.Insert2: {1}", StringUserRight, ex.Message)
+ clsLogger.Add(msg, True)
+
+ Continue For
+ End Try
+ End If
+
+ Catch ex As Exception
+ Dim _right
+ Select Case fileright
+ Case WMAccessRightRead
+ _right = "READ"
+ Case WMAccessRightWrite
+ _right = "WRITE"
+ Case WMAccessRightAdmin
+ _right = "ADMIN"
+ Case WMAccessRightAllRights
+ _right = "ALL RIGHTS"
+ Case WMAccessRightReadWrite
+ _right = "READ WRITE"
+ End Select
+ MSG_RESULT &= String.Format("Error while working on RightChange:" & vbNewLine & "Fileright: {0}" & vbNewLine & "User: {1} " & vbNewLine & "File: {2}", _right, StringUserRight, CURRENT_FILEIN_WD) & vbNewLine
+ clsLogger.Add(ex.Message, True)
+
+ End Try
+ Next
+ Try
+ 'Speichern nicht vergessen
+ clsWindream.aktWMObject.Save()
+ Catch ex As Exception
+ Dim msg = String.Format("Error at Object2Change.Save - DocID ({0}): {1}", CURRENT_DOC_ID, ex.Message)
+ clsLogger.Add(msg, True)
+ If clsWindream.aktWMObject.aLocked = True Then
+ clsWindream.aktWMObject.unlock()
+ End If
+ Return False
+ End Try
+
+ 'und der Vollständigkeit halber auch ein Unlock
+ If clsWindream.aktWMObject.aLocked = True Then
+ Try
+ clsWindream.aktWMObject.unlock()
+ Catch ex As Exception
+ Dim msg = "Fehler bei Unlock - Error: " & ex.Message
+ clsLogger.Add(msg, True)
+ Return False
+ End Try
+ End If
+ 'jetzt True zurückgeben
+ Return True
+
+ Catch ex As Exception
+ clsLogger.Add(String.Format("Unexpected Error while Doc_Renew_Rightss DocID: {0}", CURRENT_DOC_ID), True)
+ Dim msg = "ErrorMessage: " & vbNewLine & ex.Message
+ clsLogger.Add(msg, False)
+ Return False
+ End Try
+ End Function
+
+End Class
diff --git a/app/ZSG_Import/MyService.vb b/app/ZSG_Import/MyService.vb
index 4fb956a..949f53a 100644
--- a/app/ZSG_Import/MyService.vb
+++ b/app/ZSG_Import/MyService.vb
@@ -1,9 +1,24 @@
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.
@@ -20,7 +35,9 @@ Public Class MyService
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
@@ -39,80 +56,284 @@ Public Class MyService
End Try
End Sub
Public Shared Sub RUN_THREAD(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs)
+ Dim step_ As String
Try
- 'erst einmal die Technischen Plätze bestimmen die noch nciht importiert wurden
- Dim DT_TP As DataTable = clsDatabase.Return_Datatable("SELECT DISTINCT [UNIQUE_STR] FROM [EXPORT_COMOS] where dokumentart is not null and imported = 0 and [UNIQUE_STR] LIKE '472%' order by [UNIQUE_STR]")
+ 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
- If Not IsNothing(DT_TP) Then
- If DT_TP.Rows.Count > 0 Then
- clsLogger.Add(String.Format(">> {0} TPs need to be worked - {1}", DT_TP.Rows.Count.ToString, Now), False)
- 'Jeden Technischen Platz einzeln durchlaufen weil für diesen ein Record existiert
- For Each TP As DataRow In DT_TP.Rows
- Dim _TP As String = TP.Item(0)
- clsLogger.AddDetailLog(String.Format(">> Working on technical place: '{0}'", _TP))
- Dim selrecid = String.Format("SELECT [Record-ID] FROM VWTEMP_PMO_FORM3 where UPPER(TPLNR) = UPPER('{0}')", _TP)
- Dim _RECORD_ID = clsDatabase.Execute_Scalar(selrecid)
- If Not IsNothing(_RECORD_ID) Then
- 'Jede Datei einzeln durchlaufen
- Dim sel = String.Format("SELECT * FROM [EXPORT_COMOS] WHERE IMPORTED = 0 AND [UNIQUE_STR] = '{0}'", TP.Item("UNIQUE_STR"))
- Dim DT_TP_DOCS As DataTable = clsDatabase.Return_Datatable(sel)
- If Not IsNothing(DT_TP_DOCS) Then
- If DT_TP_DOCS.Rows.Count > 0 Then
- For Each _docRow As DataRow In DT_TP_DOCS.Rows
- Dim GUID = _docRow.Item("GUID")
- Dim filename = _docRow.Item("Link")
- If File.Exists(filename) Then
+ 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))
- Else
- clsLogger.Add(String.Format(">> File not found: {0}", filename), False)
- Update_COMMENT_GUID(GUID, "FILE NOT FOUND")
+ 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
- Next
- 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(">> No Record found for TP: {0}", _TP), False)
- Update_COMMENT(_TP, "NO RECORD-ID FOUND")
+ clsLogger.Add(String.Format(">>WDOBJEKTTYPE IS NOTHING"), False)
End If
+ Else
+ clsLogger.Add("COULD NOT CREATE A SESSION", True)
- Next
-
-
- 'DD_Rights.clsLogger.Init(My.Application.Info.DirectoryPath & "\Log", "")
- 'If DD_Rights.ClassRights.Init_Service(LOG_ERRORS_ONLY, DT_RIGHTS_2b_WORKED.Rows.Count) Then
- ' If DD_Rights.ClassRights.WORK_RIGHT2B_CHANGED(DT_RIGHTS_2b_WORKED) = True Then
- ' clsLogger.Add(">> All rights were worked - " & Now, False)
- ' End If
- 'End If
+ End If
End If
End If
-
Catch ex As Exception
- clsLogger.AddError("Uncexpected Error in working rights: " & ex.Message, "DT_RIGHTS_2b_WORKED")
+ 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
- Private Shared Sub Update_COMMENT(UNIQUE_STR As String, comment As String)
+ Public Shared Function SET_WD_RIGHTS()
Try
- Dim upd = String.Format("UPDATE EXPORT_COMOS_472 SET COMMENT = '{0}' where UPPER(UNIQUE_STR) = UPPER('{1}') AND IMPORTED = 0")
- clsDatabase.Execute_non_Query(upd)
+ 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 Update_COMMENT: " & ex.Message)
+ clsLogger.AddError("Uncexpected Error in SET_WD_RIGHTS: " & ex.Message)
+ clsLogger.WriteLog()
+ Return False
End Try
- End Sub
- Private Shared Sub Update_COMMENT_GUID(GUID As Integer, comment As String)
+ 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 EXPORT_COMOS_472 SET COMMENT = '{0}' where GUID = {1}")
+ 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.
diff --git a/app/ZSG_Import/ZSG_Import.vbproj b/app/ZSG_Import/ZSG_Import.vbproj
index 416aaaf..d7ae245 100644
--- a/app/ZSG_Import/ZSG_Import.vbproj
+++ b/app/ZSG_Import/ZSG_Import.vbproj
@@ -80,6 +80,8 @@
+
+
@@ -126,6 +128,17 @@
+
+
+ {50A7E9B0-70EF-11D1-B75A-00A0C90564FE}
+ 1
+ 0
+ 0
+ tlbimp
+ False
+ True
+
+