Imports System.IO Imports System.Security.AccessControl Imports System.Security.Principal Public Class frmWD_Index_Dokart Dim droptype As String Dim aktFiledropped As String Dim MULTIFILES As Integer = 0 Private Sub FillToolStripButton_Click(sender As Object, e As EventArgs) Try Me.VWPMO_DOKUMENTTYPESTableAdapter.Fill(Me.DD_DMSDataSet.VWPMO_DOKUMENTTYPES, CURRENT_FORMVIEW_ID) Catch ex As System.Exception System.Windows.Forms.MessageBox.Show(ex.Message) End Try End Sub Function WORK_FILE(Filepath As String, Targetpath As String, vDokart_ID As Integer, vDokart As String, multiindex As Boolean) Try CURRENT_DOKARTSTRING = vDokart Dim err As Boolean = False If ClassImport_Windream.Name_Generieren(DOCTYPE_IDTextBox.Text) = False Then Return False End If Dim streamresult = ClassWindream.Stream_File(Filepath, Targetpath) 'Dim type = streamresult.GetType If streamresult = True Then Dim sql = "SELECT * FROM TBDD_INDEX_AUTOM WHERE ACTIVE = 1 AND UPPER(INDEXNAME) NOT LIKE UPPER('%ONLY %') AND DOCTYPE_ID = " & vDokart_ID Dim dt As DataTable = ClassDatabase.Return_Datatable(sql) Dim indexierung_erfolgreich As Boolean = False If dt Is Nothing = False Then If dt.Rows.Count > 0 Then Dim Count As Integer = 0 For Each row As DataRow In dt.Rows Dim indexname = row.Item("INDEXNAME").ToString Dim idxvalue = row.Item("VALUE") If idxvalue.ToString.StartsWith("@") Then Select Case idxvalue.ToString.ToUpper Case "@RECORD-ID" idxvalue = idxvalue.ToString.Replace("@Record-ID", CURRENT_RECORD_ID) Case "@DOKART" idxvalue = idxvalue.ToString.Replace("@Dokart", vDokart) End Select End If If LogErrorsOnly = False Then ClassLogger.Add(" - Indexvalue: " & idxvalue.ToString, False) Count += 1 indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_FILEIN_WD, indexname, idxvalue) If indexierung_erfolgreich = False Then MsgBox("Unexpected Error in indexing file - See log", MsgBoxStyle.Critical) err = True Exit For End If 'ByVal WD_File As String, ByVal _Indexname As String, ByVal _Value As String Next If err = True Then Return False End If 'den Entity-Key auslesen sql = "Select Top 1 * from TBPMO_WD_OBJECTTYPE where Upper(object_type) = Upper('" & ClassWindream._WDObjekttyp & "')" dt = ClassDatabase.Return_Datatable(sql) If Not dt Is Nothing Then If dt.Rows.Count = 1 Then Dim indexname = dt.Rows(0).Item("IDXNAME_ENTITYID").ToString Dim idxvalue = CURRENT_FORM_ID If LogErrorsOnly = False Then ClassLogger.Add(" - Entity-ID: " & idxvalue.ToString, False) indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_FILEIN_WD, indexname, idxvalue) If indexierung_erfolgreich = False Then err = True MsgBox("Unexpected Error in indexing file Entity - See log", MsgBoxStyle.Critical) Return False End If indexname = dt.Rows(0).Item("IDXNAME_PARENTID").ToString idxvalue = CURRENT_PARENTID If LogErrorsOnly = False Then ClassLogger.Add(" - Parent-ID: " & idxvalue.ToString, False) indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_FILEIN_WD, indexname, idxvalue) If indexierung_erfolgreich = False Then err = True MsgBox("Unexpected Error in indexing file Parent-ID - See log", MsgBoxStyle.Critical) Return False End If End If End If If indexierung_erfolgreich = True Then If multiindex = False Then MsgBox("Datei erfolgreich nach windream übertragen", MsgBoxStyle.Information, "Erfolgsmeldung") ClassDatabase.Execute_Scalar("UPDATE TBPMO_FILES_USER SET WORKED = 1 WHERE GUID = " & CURRENT_FILEID) frmForm_Constructor.tsstatus_Detail_show(True, "Datei erfolgreich nach windream übertragen") 'Die Originaldatei löschen If droptype = "dragdrop file" And indexierung_erfolgreich = True Then If chkdelete_origin.Checked = True Then 'Die temporäre Datei löschen File.Delete(aktFiledropped) End If ElseIf droptype = "@ATTMNTEXTRACTED@" And indexierung_erfolgreich = True Then 'Die temporäre Datei löschen File.Delete(aktFiledropped) ElseIf droptype = "dragdrop message" And indexierung_erfolgreich = True Then 'Die temporäre Datei löschen File.Delete(aktFiledropped) End If Return True Else MsgBox("Es gab ein Problem bei der Indexierung der Datei. Bitte prüfen sie das Log!", MsgBoxStyle.Exclamation, "Achtung:") Return False End If End If End If End If Catch ex As Exception MsgBox("Unexpected error in Work-File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function 'Function FillIndexe_Autom(dokart_id As Integer) ' Try ' Me.VWDDINDEX_AUTOMTableAdapter.Fill(Me.DD_DMSDataSet.VWDDINDEX_AUTOM, dokart_id) ' If DD_DMSDataSet.VWDDINDEX_AUTOM.Rows.Count > 0 Then ' ' MsgBox(DT.Rows.Count.ToString) ' For Each DR_AUTOINDEX As DataRow In DD_DMSDataSet.VWDDINDEX_AUTOM.Rows ' Dim indexname As String = DR_AUTOINDEX.Item("INDEXNAME") ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Build Automatischer Index '" & indexname & "'", False) ' If DR_AUTOINDEX.Item("SQL_RESULT").ToString <> String.Empty And CBool(DR_AUTOINDEX.Item("SQL_ACTIVE")) = True Then ' ' Regulären Ausdruck zum Auslesen der windream-Indexe definieren ' Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' ' SQL-String für aktuellen INdex laden ' Dim SqlString As String = DR_AUTOINDEX.Item("SQL_RESULT") ' ' einen Regulären Ausdruck laden ' Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) ' ' die Vorkommen im SQL-String auslesen ' Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(SqlString) ' ' alle Vorkommen der Indexe im SQL-String durchlaufen ' For Each element As System.Text.RegularExpressions.Match In elemente ' ' MsgBox(element.Value.ToUpper) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Element: '" & element.Value & "'", False) ' '' wenn es sich nicht um dedizeirte Werte handelt (es sollen ja nur die Indexe ausgelesen werden) ' 'If Not element.Value.ToUpper = "[%SPALTE]" And Not element.Value.ToUpper = "[%VIEW]" Then ' 'die Zeichen [% und ] entfernen (liefert den wirklichen windream-Index) ' Dim elementOhneSonderzeichen As String = element.Value.Substring(2, element.Value.Length - 3) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> elementOhneSonderzeichen: '" & elementOhneSonderzeichen & "'", False) ' 'den Platzhalter im SQL-String durch den Wert ersetzen ' Dim manIndexwert As String = GetManIndex_Value(elementOhneSonderzeichen, "IDX_AUTO") ' If manIndexwert <> "" Then ' SqlString = SqlString.Replace(element.Value, manIndexwert) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> zusammengesetzter SQL-String: " & SqlString, False) ' Else ' ClassLogger.Add(" - ACHTUNG: manIndexwert = String.Empty - Funktion: FillIndexe_Autom", False) ' Return False ' End If ' Next ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ausführen SQL....", False) ' Dim automatischerValue As String = "" ' automatischerValue = Get_AutomatischerIndex_SQL(SqlString, DR_AUTOINDEX.Item("CONNECTION_ID"), DR_AUTOINDEX.Item("SQL_PROVIDER")) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ergebnis SQL: '" & automatischerValue & "'", False) ' If automatischerValue <> String.Empty Then ' DR_AUTOINDEX.Item("Indexiert") = True ' DR_AUTOINDEX.Item("Indexwert") = automatischerValue ' Else ' ClassLogger.Add(" - ACHTUNG: automatischerValue = String.Empty - Funktion: FillIndexe_Autom", False) ' ClassLogger.Add(" - SqlString: " & SqlString, False) ' Return False ' End If ' Else ' If Not IsDBNull(DR_AUTOINDEX.Item("VALUE")) Then ' If DR_AUTOINDEX.Item("VALUE") <> "" Then ' Dim DEFAULTVALUE As String = DR_AUTOINDEX.Item("VALUE") ' 'Indexierung mit WindowsVariable ' If DEFAULTVALUE.StartsWith("$") Then ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung mit einer Windowsvariable: '" & DEFAULTVALUE & "'", False) ' Select Case DEFAULTVALUE.ToUpper ' Case "$filename_ext".ToUpper ' DEFAULTVALUE = Path.GetFileName(CURRENT_WORKFILE) ' Case "$filename".ToUpper ' DEFAULTVALUE = Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) ' Case "$FileCreateDate".ToUpper ' Dim FI As New FileInfo(CURRENT_WORKFILE) ' Dim CreationDate As Date = FI.CreationTime ' DEFAULTVALUE = CreationDate.ToShortDateString ' Case "$FileCreatedWho".ToUpper ' Dim fs As FileSecurity = File.GetAccessControl(CURRENT_WORKFILE) ' Dim sid As IdentityReference = fs.GetOwner(GetType(SecurityIdentifier)) ' Dim ntaccount As IdentityReference = sid.Translate(GetType(NTAccount)) ' Dim owner As String = ntaccount.ToString() ' DEFAULTVALUE = owner ' Case "$DateDDMMYYY".ToUpper ' DEFAULTVALUE = System.DateTime.Now.ToShortDateString ' End Select ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ergebnis der Windowsvariable: '" & DEFAULTVALUE & "'", False) ' Else ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung mit einem Festen Wert: '" & DEFAULTVALUE & "'", False) ' End If ' 'Den Wert in der Zwischentabelle speichern ' DR_AUTOINDEX.Item("Indexiert") = True ' DR_AUTOINDEX.Item("Indexwert") = DEFAULTVALUE ' End If ' End If ' End If ' Next ' 'MsgBox("Noch kein automatischer Index-SQL-String hinterlegt, dennoch wird das Dokument abgelegt!") ' Return True ' Else ' Return True ' End If ' Catch ex As System.Exception ' ClassLogger.Add(" - Fehler bei FillIndexe_Autom - Fehler: " & vbNewLine & ex.Message) ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei FillIndexe_Autom") ' Return False ' End Try 'End Function Private Sub btnindex_Click(sender As Object, e As EventArgs) Handles btnindex.Click If CURRENT_RECORD_ID = 0 Then MsgBox("Kein Datensatz ausgewählt oder die Dokumentart wurde noch nicht gewählt!", MsgBoxStyle.Information) Exit Sub End If If lvwIndices.Items.Count = 0 Then MsgBox("Bitte eine Dokumentart wählen!", MsgBoxStyle.Information) Exit Sub End If Indexing_File() End Sub Sub Indexing_File() Try Me.Cursor = Cursors.WaitCursor SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs) If cmbDokumentart.SelectedIndex <> -1 Then My.Settings.WD_INDEXDOKART_SAVE = cmbDokumentart.Text My.Settings.Save() ClassWindream._WDObjekttyp = Me.OBJECT_TYPETextBox.Text If chkMultiIndexer.Visible = True And chkMultiIndexer.Checked = True Then 'Die erste Datei indexieren If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, cmbDokumentart.SelectedValue, cmbDokumentart.Text, True) = True Then 'Und nun die folgenden Dim DTFiles2Work As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBPMO_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_FILEID & " AND UPPER(USER_WORK) = UPPER('" & Environment.UserName & "')") If Not DTFiles2Work Is Nothing Then Dim err = False For Each filerow As DataRow In DTFiles2Work.Rows CURRENT_FILEID = filerow.Item("GUID") CURRENT_FILENAME = filerow.Item("FILENAME2WORK") Dim HandleType As String = filerow.Item("HANDLE_TYPE") aktFiledropped = CURRENT_FILENAME If HandleType = "@DROPFROMFSYSTEM@" Then droptype = "dragdrop file" ElseIf HandleType = "@OUTLOOK_ATTMNT@" Then droptype = "dragdrop attachment" ElseIf HandleType = "@OUTLOOKMESSAGE@" Then droptype = "dragdrop message" End If If WORK_FILE(CURRENT_FILENAME, Me.PATHTextBox.Text, cmbDokumentart.SelectedValue, cmbDokumentart.Text, True) = False Then err = True Exit For End If Next Me.Cursor = Cursors.Default If err = False Then MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich nach windream übertragen!", MsgBoxStyle.Information, "Erfolgsmeldung:") Me.Close() End If End If End If Else If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, cmbDokumentart.SelectedValue, cmbDokumentart.Text, False) = True Then Me.Close() End If Me.Cursor = Cursors.Default End If Catch ex As Exception MsgBox("Error in Indexing_File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub cmbDokumentart_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbDokumentart.SelectedIndexChanged Try CURRENT_DOKARTID = 0 If cmbDokumentart.SelectedIndex <> -1 Then CURRENT_DOKARTID = cmbDokumentart.SelectedValue CURRENT_DOKARTSTRING = cmbDokumentart.Text Refresh_indices() End If Catch ex As Exception MsgBox("Error in cmbDokumentart SelectedIndex:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Refresh_indices() Try If CURRENT_DOKARTID > 0 Then Dim sql = "SELECT OBJEKTTYP FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKARTID OBJECT_TYPETextBox.Text = ClassDatabase.Execute_Scalar(sql, True) DOCTYPE_IDTextBox.Text = CURRENT_DOKARTID sql = "SELECT * FROM TBDD_INDEX_AUTOM WHERE DOCTYPE_ID = " & CURRENT_DOKARTID Dim dt As DataTable = ClassDatabase.Return_Datatable(sql) Dim Count As Integer = 0 If dt.Rows.Count > 0 Then lvwIndices.Items.Clear() For Each row As DataRow In dt.Rows lvwIndices.Items.Add(row.Item("INDEXNAME").ToString) Dim Value As String Dim _case = row.Item("VALUE").ToString.ToUpper Select Case row.Item("VALUE").ToString.ToUpper Case "@DOKART" Value = CURRENT_DOKARTSTRING Case "@RECORD-ID" Value = CURRENT_RECORD_ID End Select lvwIndices.Items(Count).SubItems.Add(Value) Count += 1 Next End If 'den Entity-Key auslesen sql = "Select Top 1 * from TBPMO_WD_OBJECTTYPE where Upper(object_type) = Upper('" & OBJECT_TYPETextBox.Text & "')" dt = ClassDatabase.Return_Datatable(sql) If Not dt Is Nothing Then If dt.Rows.Count = 1 Then lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_ENTITYID").ToString) lvwIndices.Items(Count).SubItems.Add(CURRENT_FORM_ID) lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_PARENTID").ToString) Dim ParentID = ClassDatabase.Execute_Scalar("SELECT TOP 1 PARENT_ID FROM TBPMO_FORM WHERE GUID = " & CURRENT_FORM_ID, True) Try If IsNumeric(ParentID) And ParentID > 0 Then lvwIndices.Items(Count + 1).SubItems.Add(ParentID) End If Catch ex As Exception MsgBox("Unexpected Error in Setting Parent-ID" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End If End If End If Catch ex As Exception MsgBox("Error in Refresh Indices for Indexing:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub frmWD_Index_Dokart_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing My.Settings.Save() End Sub Private Sub frmWD_Index_Dokart_Load(sender As Object, e As EventArgs) Handles Me.Load Try Me.VWDDINDEX_AUTOMTableAdapter.Connection.ConnectionString = MyConnectionString chkMultiIndexer.Checked = False ClassLogger.Add(">> frmWD_Index_Dokart_Load", False) chkdelete_origin.Checked = False chkdelete_origin.Visible = False CURRENT_FILENAME = ClassDatabase.Execute_Scalar("SELECT FILENAME2WORK FROM TBPMO_FILES_USER WHERE GUID = " & CURRENT_FILEID) Dim HandleType As String = ClassDatabase.Execute_Scalar("SELECT HANDLE_TYPE FROM TBPMO_FILES_USER WHERE GUID = " & CURRENT_FILEID) MULTIFILES = ClassDatabase.Execute_Scalar("SELECT COUNT(*) FROM TBPMO_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_FILEID & " AND UPPER(USER_WORK) = UPPER('" & Environment.UserName & "')") If MULTIFILES > 0 Then chkMultiIndexer.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren" chkMultiIndexer.Visible = True Else chkMultiIndexer.Visible = False End If aktFiledropped = CURRENT_FILENAME txtFilepath.Text = aktFiledropped If HandleType = "@DROPFROMFSYSTEM@" Then droptype = "dragdrop file" chkdelete_origin.Visible = True chkdelete_origin.Checked = WD_IndexDeleteDocs ElseIf HandleType = "@OUTLOOK_ATTMNT@" Then droptype = "dragdrop attachment" chkdelete_origin.Visible = True chkdelete_origin.Checked = WD_IndexDeleteDocs ElseIf HandleType = "@OUTLOOKMESSAGE@" Then droptype = "dragdrop message" chkdelete_origin.Visible = True chkdelete_origin.Checked = WD_IndexDeleteDocs End If TBPMO_FILES_USERTableAdapter.Connection.ConnectionString = MyConnectionString VWPMO_DOKUMENTTYPESTableAdapter.Connection.ConnectionString = MyConnectionString Me.VWPMO_DOKUMENTTYPESTableAdapter.Fill(Me.DD_DMSDataSet.VWPMO_DOKUMENTTYPES, CURRENT_FORMVIEW_ID) Catch ex As Exception MsgBox("Error in frmWD_Index_Dokart_Load:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub chkdelete_origin_CheckedChanged(sender As Object, e As EventArgs) Handles chkdelete_origin.CheckedChanged WD_IndexDeleteDocs = chkdelete_origin.Checked SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs) End Sub Private Sub frmWD_Index_Dokart_Shown(sender As Object, e As EventArgs) Handles Me.Shown If My.Settings.WD_INDEXDOKART_SAVE <> String.Empty Then cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(My.Settings.WD_INDEXDOKART_SAVE) Else If DD_DMSDataSet.VWPMO_DOKUMENTTYPES.Rows.Count = 1 Then cmbDokumentart.SelectedIndex = 0 CURRENT_DOKARTID = cmbDokumentart.SelectedValue CURRENT_DOKARTSTRING = cmbDokumentart.Text Refresh_indices() End If End If End Sub End Class