RecordOrganizer/app/DD-Record-Organiser/frmWD_Index_Dokart.vb
2015-11-05 15:57:50 +01:00

382 lines
23 KiB
VB.net

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
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)
lvwIndices.Items(Count + 1).SubItems.Add(CURRENT_PARENTID)
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