Imports System.IO Imports System.Security.AccessControl Imports System.Security.Principal Imports System.Data.SqlClient Imports Oracle.ManagedDataAccess.Client Imports DigitalData.Modules.Windream Public Class frmWM_IndexFile Dim droptype As String Dim aktFiledropped As String Dim MULTIFILES As Integer = 0 Dim formloaded As Boolean = False Dim DTVWPMO_DOKUMENTTYPES As DataTable Public Class SW Public label As String Public stopwatch As Stopwatch Public Sub New(label As String) Me.label = label stopwatch = New Stopwatch() stopwatch.Start() End Sub Public Function Done() As Long stopwatch.Stop() Dim message = String.Format("{0, 5}ms || {1}", stopwatch.ElapsedMilliseconds, label) Console.WriteLine(message) LOGGER.Debug(message) Return stopwatch.ElapsedMilliseconds End Function End Class Function WORK_FILE(ImportFilePath As String, VerzeichnisZiel As String, vDokart_ID As Integer, vDokart As String, multiindex As Boolean) 'Dim swWORK_FILE As New SW("WORK_FILE: " & DOCTYPE_IDTextBox.Text) Try CURRENT_DOC_ID = Nothing Dim odeleteRights As Boolean = True Dim oSQL = $"SELECT GUID FROM TBPMO_FILES_USER WHERE FILENAME2WORK = '{ImportFilePath}' AND WORKED = 0 AND USER_WORK = '{Environment.UserName}'" CURRENT_FILEID = MYDB_ECM.GetScalarValue(oSQL) CURRENT_DOKARTSTRING = vDokart Dim err As Boolean = False '################################################################# 'Name und ZielPfad generieren '################################################################# Dim sw As New SW("GetUse Nameconvention ID: " & DOCTYPE_IDTextBox.Text) If ClassImport_Windream.Name_Generieren(DOCTYPE_IDTextBox.Text) = False Then 'swWORK_FILE.Done() Return False End If sw.Done() sw = New SW("CheckFileExists") Dim existsonlyasMaster = False If WMMOD.TestFileExists(CURRENT_NEWFILENAME) = True Then Dim msg = "Eine Datei mit identischem Namen existiert bereits! Wollen Sie die bestehende Datei ersetzen? (KEINE VERSIONIERUNG)" & vbNewLine & "Beachten Sie das vorhandene Versionen beim Ersetzen mit gelöscht werden!" If USER_LANGUAGE <> "de-DE" Then msg = "There is already a file with the same name! Would You like to replace the file?" & vbNewLine & "All versions will also be deleted!" End If Dim result As MsgBoxResult result = MessageBox.Show(msg, "File already exists:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then If WMMOD.RemoveFile(CURRENT_NEWFILENAME) Then 'swWORK_FILE.Done() Return False End If Else CURRENT_NEWFILENAME = ClassHelper.Versionierung_Datei(CURRENT_NEWFILENAME) End If Else If WMMOD.TestFileExists(CURRENT_NEWFILENAME) = True Then ClassHelper.InsertEssential_Log(CURRENT_RECORD_ID, "RECORD-ID", "FILE ALREADY EXISTED WITH NON-USER RIGHTS: " & CURRENT_NEWFILENAME) CURRENT_NEWFILENAME = ClassHelper.Versionierung_Datei(CURRENT_NEWFILENAME) existsonlyasMaster = True Dim msg = "Eine Datei mit identischem Namen existiert bereits!" & vbNewLine & "Sie besitzen allerdings nicht die Rechte diese Datei zu bearbeiten." & vbNewLine & "Aus diesem Grund wird Ihre Datei versioniert!" If USER_LANGUAGE <> "de-DE" Then msg = "There is already a file with the same name!" & vbNewLine & "But You do not own the rights to work it." & vbNewLine & "Therefore Your file will be versioned!" End If MsgBox(msg, MsgBoxStyle.Information) End If End If sw.Done() '################################################################# 'Stream File to windream '################################################################# sw = New SW("File Stream") Dim streamresult = WMMOD.NewFileStream(ImportFilePath, CURRENT_NEWFILENAME, OBJECT_TYPETextBox.Text, True) sw.Done() '################################################################# If streamresult = True Then sw = New SW("File Indexing") CURRENT_FILEIN_WD = CURRENT_NEWFILENAME Dim DOCID DOCID = WMMOD.GetIndexValue(CURRENT_FILEIN_WD, "Dokument-ID") If Not IsNothing(DOCID) Then CURRENT_DOC_ID = DOCID(0) Else DOCID = WMMOD.GetIndexValue(CURRENT_FILEIN_WD, "Document-ID") If Not IsNothing(DOCID) Then CURRENT_DOC_ID = DOCID(0) End If End If Dim sql = "SELECT * FROM TBDD_INDEX_AUTOM WHERE ACTIVE = 1 AND UPPER(INDEXNAME) NOT LIKE UPPER('%ONLY %') AND SQL_ACTIVE = 0 AND LEN(INDEXNAME) > 1 AND DOCTYPE_ID = " & vDokart_ID Dim DT_AUTO_INDEXE As DataTable = MYDB_ECM.GetDatatable(sql) Try sql = "SELECT * FROM VWCUST_DOCTYPE_CONFIG WHERE DOCTYPE_ID = " & vDokart_ID Dim DTVWCUST_DOCTYPE_CONFIG As DataTable = MYDB_ECM.GetDatatable(sql) If Not IsNothing(DTVWCUST_DOCTYPE_CONFIG) Then If DTVWCUST_DOCTYPE_CONFIG.Rows.Count = 1 Then odeleteRights = CBool(DTVWCUST_DOCTYPE_CONFIG.Rows(0).Item("DELETE_RIGHTS")) End If End If Catch ex As Exception LOGGER.Warn($"Unexpected error in VWCUST_DOCTYPE_CONFIG Area: {ex.Message}") End Try Dim indexierung_erfolgreich As Boolean = True LOGGER.Debug("Doctype: " & vDokart.ToString) indexierung_erfolgreich = WMMOD.SetFileIndex(CURRENT_FILEIN_WD, WMINDEX_DOCTYPE, vDokart, WMOBJECTTYPE) If indexierung_erfolgreich = False Then err = True ClassHelper.MSGBOX_Handler("ERROR", "Unexpected Error: ", "Unexpected Error in WorkFile-indexing Doctype '" & WMINDEX_DOCTYPE & "') - Check logfile!") sw.Done() 'swWORK_FILE.Done() Return False End If indexierung_erfolgreich = WMMOD.SetFileIndex(CURRENT_FILEIN_WD, WMINDEX_RELATION, "ADDI-RELATION", WMOBJECTTYPE) If indexierung_erfolgreich = False Then err = True ClassHelper.MSGBOX_Handler("ERROR", "Unexpected Error: ", "Unexpected Error in WorkFile-indexing AddiRelation '" & WMINDEX_RELATION & "') - Check logfile!") sw.Done() 'swWORK_FILE.Done() Return False End If sw.Done() If DT_AUTO_INDEXE Is Nothing = False Then 'CHECK DD If DT_AUTO_INDEXE.Rows.Count > 0 Then Dim Count As Integer = 0 For Each row As DataRow In DT_AUTO_INDEXE.Rows Dim oAutoIndexname = row.Item("INDEXNAME").ToString Dim oAutoIndexValue = row.Item("VALUE") If oAutoIndexValue.ToString.StartsWith("@") Then Select Case oAutoIndexValue.ToString.ToUpper Case "@RECORD-ID" oAutoIndexValue = oAutoIndexValue.ToString.Replace("@Record-ID", CURRENT_RECORD_ID) Case "@DOKART" oAutoIndexValue = oAutoIndexValue.ToString.Replace("@Dokart", vDokart) End Select Else 'Es wird nicht über einen @PAttern indexiert ' Regulären Ausdruck zum Auslesen der Indexe definieren Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' 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(oAutoIndexValue) '#### ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen For Each element As System.Text.RegularExpressions.Match In elemente LOGGER.Debug("element in RegeX: " & element.Value) Select Case element.Value.Substring(2, 1).ToUpper 'Nur automatische Indizes auswerten Case "A" Dim APattern = element.Value.Substring(3, element.Value.Length - 4) If APattern.Contains("#") Then LOGGER.Debug("element filled with Record-Data.......: ") Dim split() As String = APattern.Split("#") If split.Length = 2 Then Dim CONTROL_ID = split(1) LOGGER.Debug("CONTROL_ID: " & CONTROL_ID) If IsNumeric(CONTROL_ID) Then Dim CONTROLVALUE = ClassControlValues.Get_Control_Value_for_ID(CONTROL_ID, CURRENT_RECORD_ID) If IsNothing(CONTROLVALUE) Then LOGGER.Warn("Index should be filled with value of Control-ID '" & CONTROL_ID & "', but result was nothing.") LOGGER.Warn("SQL-Command: " & CURRENT_LAST_SQL) oAutoIndexValue = "" Else If IsDBNull(CONTROLVALUE) Then LOGGER.Warn("Index should be filled with value of Control-ID '" & CONTROL_ID & "', but result was DBNULL.") LOGGER.Warn("SQL-Command: " & CURRENT_LAST_SQL) oAutoIndexValue = "" Else oAutoIndexValue = CONTROLVALUE End If End If Else End If End If End If End Select Next End If LOGGER.Debug($"Autovalue used for Indexing: '" & oAutoIndexValue.ToString & "'") Count += 1 indexierung_erfolgreich = WMMOD.SetFileIndex(CURRENT_FILEIN_WD, oAutoIndexname, oAutoIndexValue, WMOBJECTTYPE) If indexierung_erfolgreich = False Then MsgBox("Unexpected Error in indexing file - See log", MsgBoxStyle.Critical) err = True Exit For End If Next If err = True Then 'swWORK_FILE.Done() Return False End If Else 'MsgBox("Attention in Work-File:" & vbNewLine & "No indices were defined (1)!", MsgBoxStyle.Critical) 'Return False End If Else 'swWORK_FILE.Done() MsgBox("Attention in Work-File:" & vbNewLine & "No indices were defined (0)!", MsgBoxStyle.Critical) Return False End If 'Nun alles aufrüumen und die neue DocID holen If indexierung_erfolgreich = True Then LOGGER.Info("File was correctly imported and indexed: " & CURRENT_FILEIN_WD) Dim oReldocpath = ClassHelper.GetRelPath(CURRENT_FILEIN_WD) LOGGER.Info("oReldocpath: " & oReldocpath) CURRENT_WM_OBJECT = WMMOD.GetFileByPath(oReldocpath) If IsNothing(CURRENT_WM_OBJECT) Then MsgBox("Attention in Work-File:" & vbNewLine & "Could not create final windream-object!", MsgBoxStyle.Critical) Return False End If LOGGER.Info("...CURRENT_WM_OBJECT created: " & oReldocpath) Dim stg As String = "Datei erfolgreich nach windream übertragen" Dim stg1 As String = "Erfolgsmeldung" If USER_LANGUAGE <> "de-DE" Then stg = "File was successfully transfered to windream" stg1 = "Success:" End If If multiindex = False Then CURRENT_NOTIFICATION_MSG = stg MYDB_ECM.GetScalarValue("UPDATE TBPMO_FILES_USER SET WORKED = 1 WHERE GUID = " & CURRENT_FILEID) For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows If row.Item("GUID") = CURRENT_FILEID Then row.Item("WORKED") = 1 If IsNothing(droptype) Then droptype = row.Item("HANDLE_TYPE") End If End If Next If IsNothing(CURRENT_DOC_ID) Then sw = New SW("GettingDocID") sql = String.Format("SELECT DocID FROM VWPMO_DOC_SYNC WHERE FULL_FILENAME = '{0}' AND CONVERT(DATE,Change_DateTime) = CONVERT(DATE,GETDATE())", CURRENT_FILEIN_WD) CURRENT_DOC_ID = MYDB_ECM.GetScalarValue(sql) sw.Done() End If If Not IsNothing(CURRENT_DOC_ID) Then ClassHelper.InsertEssential_Log(CURRENT_DOC_ID, "DOC_ID", "File was imported and indexed!") LOGGER.Info(String.Format("File-Import was finished - DocID: {0} ", CURRENT_DOC_ID)) Dim delete = False '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@" Or droptype = "SCAN") And indexierung_erfolgreich = True Then 'Die temporäre Datei löschen delete = True ElseIf droptype = "dragdrop message" And indexierung_erfolgreich = True Then 'Die temporäre Datei löschen delete = True End If If delete = True Then For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows If row.Item("GUID") = CURRENT_FILEID Then row.Item("DELETE_FILE") = True End If Next End If If WMMOD.SessionLoggedin = False Then MsgBox("Could not create a windream-session!", MsgBoxStyle.Critical) Else FAU_AD_USER = "" ClassFileResult.DocID = CURRENT_DOC_ID ClassFileResult.SET_DOCID_INDICES() If ClassDOC_SEARCH.CREATE_DOC_RELATED_LINKS(CURRENT_DOC_ID, CURRENT_RECORD_ID) = False Then stg = "Unerwarteter Fehler: Der Record-Link konnte nicht erzeugt werden! Überprüfen Sie das Log." If USER_LANGUAGE <> "de-DE" Then stg = "Unexpected Error: Could not create the recordlink! Please check the log." End If MsgBox(stg, MsgBoxStyle.Critical, stg1) Else sw = New SW("Setting_Rights") If ClassDOC_SEARCH.SET_WD_RIGHTS(CURRENT_WM_OBJECT, CURRENT_DOC_ID, CURRENT_FILEIN_WD, odeleteRights) = False Then MsgBox("The rights for the new file could not be created! Please check the logfile!" & vbNewLine & "orgFLOW will try to give You at least reading rights!", MsgBoxStyle.Exclamation) DD_Rights.ClassRights.SetRightExplicit(CURRENT_DOC_ID, CURRENT_FILEIN_WD, USER_USERNAME, 1) ClassHelper.InsertEssential_Log(CURRENT_DOC_ID, "DOC-ID", "NEW FILE INDEXING - RIGHTS COULD NOT BE SET!!") End If sw.Done() End If End If Else stg = "Unerwarteter Fehler: Es konnte keine DocID für die übertragene Datei erzeugt werden!" If USER_LANGUAGE <> "de-DE" Then stg = "Unexpected Error: Could not get a docId for transmitted file!" End If LOGGER.Warn(stg) MsgBox(stg, MsgBoxStyle.Critical, stg1) End If Else MsgBox("An unexpected error occured while indexing file. Please check the log!", MsgBoxStyle.Exclamation) ' swWORK_FILE.Done() Return False End If 'swWORK_FILE.Done() Return True Else 'swWORK_FILE.Done() Return False End If Catch ex As Exception MsgBox("Unexpected error in Work-File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) 'swWORK_FILE.Done() Return False End Try End Function Private Sub btnindex_Click(sender As Object, e As EventArgs) Handles btnindex.Click Try If CURRENT_RECORD_ID = 0 Then MsgBox("No Record chosen or the documenttype was not chosen!", MsgBoxStyle.Information) Exit Sub End If 'If lvwIndices.Items.Count = 0 Then ' MsgBox("Please choose a documenttxpe!", MsgBoxStyle.Information) ' Exit Sub 'End If If Not IsNothing(CURRENT_TBPMO_INDEX_MAN) Then If CURRENT_TBPMO_INDEX_MAN.Rows.Count > 0 Then If ClassFileResult.CheckWrite_IndexeMan(grbxControls) = False Then Exit Sub End If End If End If If cmbDokumentart.SelectedIndex <> -1 Then My.Settings.WD_INDEXDOKART_SAVE = cmbDokumentart.Text My.Settings.Save() If WMMOD.SessionLoggedin = True Then Handle_File(cmbDokumentart.SelectedValue) Else MsgBox("Could not create a windream-session! Please contact Your admin!", MsgBoxStyle.Critical) End If End If Catch ex As Exception MsgBox("Unexpected Error in Prepare indexing: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Handle_File(doctype_id As Integer) Try Me.Cursor = Cursors.WaitCursor SaveMySettingsValue("WD_IndexDeleteDocs", WD_IndexDeleteDocs, "ConfigMain") ' clsWM.MY_WDOBJECTTYPE = Me.OBJECT_TYPETextBox.Text 'Multi-Indexer ist aktiv If chkMultiIndexer.Visible = True And chkMultiIndexer.Checked = True Then 'Die erste Datei indexieren If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = True Then 'Und nun die folgenden Dim DTFiles2Work As DataTable = MYDB_ECM.GetDatatable("SELECT * FROM TBPMO_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_FILEID & " AND UPPER(USER_WORK) = UPPER('" & USER_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" Else droptype = filerow.Item("HANDLE_TYPE") End If If WORK_FILE(CURRENT_FILENAME, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, True) = False Then err = True Exit For End If Next Me.Cursor = Cursors.Default If err = False Then NEW_FILES_ADDED = True Dim stg As String = "Alle Dateien wurden mit Multiindexing erfolgreich nach windream übertragen!" Dim stg1 As String = "Erfolgsmeldung" If USER_LANGUAGE <> "de-DE" Then stg = "All files were transferred via Multiindexing to windream" stg1 = "Success:" End If MsgBox(stg, MsgBoxStyle.Information, stg1) Me.Close() End If End If End If Else 'No MULTI INDEX If WORK_FILE(Me.txtFilepath.Text, Me.PATHTextBox.Text, doctype_id, My.Settings.WD_INDEXDOKART_SAVE, False) = True Then NEW_FILES_ADDED = True Me.Close() Else MessageBox.Show("Import to windream was not successful." & vbNewLine & "Check the log for further information!", "Unexpected Error in windream-Stream:", MessageBoxButtons.OK, MessageBoxIcon.Error) End If End If Me.Cursor = Cursors.Default 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() Refresh_Indices_Manual() Check_Subfolder() End If Catch ex As Exception MsgBox("Error in cmbDokumentart SelectedIndex:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Refresh_Indices_Manual() Try ClassFileResult.GET_DATATABLE_INDICES_PMO() If CURRENT_TBPMO_INDEX_MAN.Rows.Count > 0 Then 'Der Tabelle eine Splate für den idnexwert hinzufügen Dim MAN_VALUE As DataColumn = CURRENT_TBPMO_INDEX_MAN.Columns.Add("MAN_VALUE", Type.GetType("System.String")) grbxControls.Visible = True grbxControls.Controls.Clear() Me.Size = New Size(605, 700) Dim anz As Integer = 1 Dim ylbl As Integer = 20 Dim y As Integer = 38 For Each DR As DataRow In CURRENT_TBPMO_INDEX_MAN.Rows Dim type = DR.Item("DATATYPE") If type <> "BOOLEAN" Then addLabel(DR.Item("GUID"), DR.Item("NAME"), DR.Item("COMMENT").ToString, ylbl) End If Dim DefaultValue = DR.Item("DEFAULT_VALUE") Select Case type Case "BOOLEAN" Dim VORBELGUNG As Integer = DefaultValue 'nur eine Textbox Dim chk As CheckBox = ClassControls_Manual.AddCheckBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG, DR.Item("COMMENT").ToString) If Not IsNothing(chk) Then grbxControls.Controls.Add(chk) End If Case "INTEGER" If DR.Item("SUGGESTION") = True And DR.Item("SQL_RESULT").ToString.Length > 0 Then AddVorschlag_ComboBox(DR.Item("GUID"), DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) 'AddAutoSuggest_Textbox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) Else Dim VORBELGUNG As Integer = DefaultValue 'nur eine Textbox AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG) End If Case "FOLDERSELECT" AddFOLDERSELECTBUTTON(DR.Item("GUID"), DR.Item("NAME"), y) Case "VARCHAR" If DR.Item("SUGGESTION") = True And DR.Item("SQL_RESULT").ToString.Length > 0 Then AddVorschlag_ComboBox(DR.Item("GUID"), DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) 'AddAutoSuggest_Textbox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) Else If DR.Item("NAME").ToString.ToLower = "dateiname" Then 'Übergibt den Dateinamen um diesen Vorzuschlagen AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, System.IO.Path.GetFileNameWithoutExtension(txtFilepath.Text)) Else Dim VORBELGUNG As String = DefaultValue 'nur eine Textbox AddTextBox(DR.Item("GUID"), DR.Item("NAME"), y, VORBELGUNG) End If End If Case "DATE" AddDateTimePicker(DR.Item("GUID"), DR.Item("NAME"), y) Case Else MsgBox($"Please check the datatype of manual index ({ DR.Item("NAME")} - {type} - Refresh_Indices_Manual (frmWMIndexFile)", MsgBoxStyle.Critical, "Achtung:") LOGGER.Warn(" - Datentyp nicht hinterlegt - LoadIndexe_Man") End Select anz += 1 ylbl += 60 y += 60 Next SendKeys.Send("{TAB}") Else grbxControls.Visible = False Me.Size = New Size(605, 430) End If Catch ex As Exception MsgBox("Error in Refresh_Indices_Manual:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Sub Check_Subfolder() Try Dim sel If CURRENT_REDUNDANT_FORM_ID <> 0 Then sel = "select MANUAL_SUBFOLDER FROM TBPMO_WD_FORMVIEW_DOKTYPES WHERE FORMVIEW_ID = (SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_REDUNDANT_FORM_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID & ")" Else sel = "select MANUAL_SUBFOLDER FROM TBPMO_WD_FORMVIEW_DOKTYPES WHERE FORMVIEW_ID = (SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = " & CURRENT_ENTITY_ID & " and SCREEN_ID = " & CURRENT_SCREEN_ID & ")" End If Dim chk = MYDB_ECM.GetScalarValue(sel) If Not IsNothing(chk) Then If CBool(chk) = True Then lblSubfolder.Visible = True txtSubfolder.Visible = True CURRENT_CHECK_SUBFOLDER = True CURRENT_SUBFOLDER = "" Else lblSubfolder.Visible = False txtSubfolder.Visible = False CURRENT_CHECK_SUBFOLDER = False End If End If Catch ex As Exception MsgBox("Error in Check_Subfolder:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) lblSubfolder.Visible = False txtSubfolder.Visible = False CURRENT_CHECK_SUBFOLDER = False End Try End Sub Sub addLabel(ID As Integer, indexname As String, hinweis As String, ylbl As Integer) Dim lbl As New Label lbl.Name = "lbl" & indexname lbl.Size = New Size(CInt(hinweis.Length * 15), 18) 'CInt(hinweis.Length * 9) lbl.Text = hinweis lbl.Tag = ID grbxControls.Controls.Add(lbl) lbl.Location = New Point(11, ylbl) End Sub Sub AddComboBoxValue(cmbName As ComboBox, Value As String) cmbName.Items.Add(Value) End Sub ' _ Function addCombobox(ID As Integer, indexname As String, y As Integer) Dim cmb As New ComboBox cmb.Name = "cmb" & indexname cmb.AutoSize = True cmb.Size = New Size(300, 27) cmb.Tag = ID grbxControls.Controls.Add(cmb) cmb.Location = New Point(11, y) 'cmb.AutoCompleteMode = AutoCompleteMode.SuggestAppend 'cmb.AutoCompleteSource = AutoCompleteSource.ListItems 'AddHandler cmb.KeyUp, AddressOf AutoCompleteCombo_KeyUp AddHandler cmb.SelectedIndexChanged, AddressOf OncmbSIndexChanged AddHandler cmb.GotFocus, AddressOf OncmbGotFocus AddHandler cmb.LostFocus, AddressOf OncmbLostFocus Return cmb End Function Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender cmb.BackColor = Color.Lime End Sub ' _ Public Sub OncmbLostFocus(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender cmb.BackColor = Color.White End Sub Function AddFOLDERSELECTBUTTON(ID As Integer, indexname As String, y As Integer) Dim btn As New Button btn.Name = "btn" & indexname If USER_LANGUAGE <> "de-DE" Then btn.Text = "Select the folder" Else btn.Text = "Wählen Sie einen Ordner" End If btn.Size = New Size(260, 27) btn.Tag = ID grbxControls.Controls.Add(btn) btn.Location = New Point(11, y) AddHandler btn.Click, AddressOf OnbtnClick Return btn End Function Public Sub OnbtnClick(sender As System.Object, e As System.EventArgs) Dim btn As Button = sender Dim folderBrowserDialog1 As New FolderBrowserDialog If USER_LANGUAGE <> "de-DE" Then folderBrowserDialog1.Description = "Select the directory:" Else folderBrowserDialog1.Description = "Wählen Sie einen Ordner:" End If ' Do not allow the user to create New files via the FolderBrowserDialog. folderBrowserDialog1.ShowNewFolderButton = True Try folderBrowserDialog1.RootFolder = PATHTextBox.Text Catch ex As Exception End Try Try folderBrowserDialog1.SelectedPath = PATHTextBox.Text Catch ex As Exception End Try Dim result As DialogResult = folderBrowserDialog1.ShowDialog() If (result = DialogResult.OK) Then ClassFileResult.SET_CURRENT_TBPMO_INDEX_MAN_VALUE(btn.Tag, folderBrowserDialog1.SelectedPath) PATHTextBox.Text = folderBrowserDialog1.SelectedPath txtSubfolder.Text = folderBrowserDialog1.SelectedPath End If End Sub Function AddTextBox(ID As Integer, indexname As String, y As Integer, text As String) Dim txt As New TextBox txt.Name = "txt" & indexname txt.Size = New Size(260, 27) 'txt.AutoSize = True txt.Tag = ID grbxControls.Controls.Add(txt) txt.Location = New Point(11, y) If text <> "" Then txt.Text = text txt.Size = New Size(CInt(text.Length * 15), 27) txt.SelectAll() End If AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp AddHandler txt.TextChanged, AddressOf OnTextBoxTextChanged Return txt End Function Public Sub OnTextBoxFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender box.BackColor = Color.Lime box.SelectAll() End Sub Public Sub OnTextBoxTextChanged(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender 'If box.Text.Length > 15 Then Dim g As Graphics = box.CreateGraphics box.Width = g.MeasureString(box.Text, box.Font).Width + 15 g.Dispose() ' End If End Sub Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender box.BackColor = Color.White End Sub Public Sub OnTextBoxKeyUp(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Dim box As TextBox = sender If (e.KeyCode = Keys.Return) Then SendKeys.Send("{TAB}") End If End Sub Sub AddDateTimePicker(ID As Integer, indexname As String, y As Integer) Dim dtp As New DateTimePicker dtp.Name = "dtp" & indexname dtp.Format = DateTimePickerFormat.Short dtp.Size = New Size(133, 27) dtp.Tag = ID dtp.Location = New Point(11, y) grbxControls.Controls.Add(dtp) AddHandler dtp.ValueChanged, AddressOf OndtpChanged End Sub Sub OndtpChanged() 'offen was hier zu tun ist End Sub Public Sub OncmbSIndexChanged(sender As System.Object, e As System.EventArgs) If formloaded = False Then Exit Sub End If Dim cmb As ComboBox = sender If cmb.SelectedIndex <> -1 Then If cmb.Text.Length > 15 Then Dim g As Graphics = cmb.CreateGraphics cmb.Width = g.MeasureString(cmb.Text, cmb.Font).Width + 30 g.Dispose() End If Get_NextComboBoxResults(cmb) SendKeys.Send("{TAB}") End If End Sub Sub Get_NextComboBoxResults(cmb As ComboBox) Try Dim indexname = cmb.Name.Replace("cmb", "") Dim sql = "SELECT GUID,NAME,SQL_RESULT FROM TBPMO_INDEX_MAN where ACTIVE = 1 AND SUGGESTION = 1 AND SQL_RESULT like '%@" & indexname & "%' and DOCTYPE_ID = " & CURRENT_DOKARTID & " ORDER BY SEQUENCE" Dim DT As DataTable = MYDB_ECM.GetDatatable(sql) If Not IsNothing(DT) Then If DT.Rows.Count > 0 Then Dim cmbname = "cmb" & DT.Rows(0).Item("NAME") Renew_ComboboxResults(DT.Rows(0).Item("GUID"), indexname, cmb.Text) End If End If Catch ex As Exception MsgBox("Error in Get_NextComboBoxResults:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub Renew_ComboboxResults(INDEX_GUID As Integer, SearchString As String, Resultvalue As String) Try Dim connectionString As String Dim sqlCnn As SqlConnection Dim sqlCmd As SqlCommand Dim adapter As New SqlDataAdapter Dim oracleConn As OracleConnection Dim oracleCmd As OracleCommand Dim oracleadapter As New OracleDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim conid = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "CONNECTION_ID") Dim sql_result = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "SQL_RESULT") Dim NAME = ClassMoreMetadata.Return_CURRENT_TBPMO_INDEX_MAN_VALUE(INDEX_GUID, "NAME") If Not IsNothing(conid) And Not IsNothing(sql_result) And Not IsNothing(NAME) Then For Each ctrl As Control In Me.grbxControls.Controls If ctrl.Name = "cmb" & NAME.ToString Then Dim cmb As ComboBox = ctrl Dim sql As String = sql_result.ToString.ToUpper.Replace("@" & SearchString.ToUpper, Resultvalue) connectionString = MYDB_ECM.CurrentConnectionString If connectionString Is Nothing = False Then 'SQL Befehl füllt die Auswahlliste If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then sqlCnn = New SqlConnection(connectionString) sqlCnn.Open() sqlCmd = New SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then oracleConn = New OracleConnection(connectionString) oracleConn.Open() oracleCmd = New OracleCommand(sql, oracleConn) oracleadapter.SelectCommand = oracleCmd oracleadapter.Fill(NewDataset) End If If NewDataset.Tables(0).Rows.Count > 0 Then cmb.Items.Clear() 'Die Standargrösse definieren Dim newWidth As Integer = 300 For i = 0 To NewDataset.Tables(0).Rows.Count - 1 'MsgBox(NewDataset.Tables(0).Rows(i).Item(0)) AddComboBoxValue(cmb, NewDataset.Tables(0).Rows(i).Item(0)) Try Dim text As String = NewDataset.Tables(0).Rows(i).Item(0) If text.Length > 15 Then Dim g As Graphics = cmb.CreateGraphics If g.MeasureString(text, cmb.Font).Width + 30 > newWidth Then newWidth = g.MeasureString(text, cmb.Font).Width + 30 End If g.Dispose() End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:") End Try Next cmb.Size = New Size(newWidth, 27) cmb.AutoCompleteSource = AutoCompleteSource.ListItems cmb.AutoCompleteMode = AutoCompleteMode.Suggest End If If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then Try adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception End Try Else Try oracleadapter.Dispose() oracleCmd.Dispose() oracleConn.Close() Catch ex As Exception End Try End If End If End If Next End If Catch ex As Exception LOGGER.Warn(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:") End Try End Sub Private Sub AddVorschlag_ComboBox(ID As Integer, indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Optional Vorgabe As String = "") Try Dim connectionString As String Dim sqlCnn As SqlConnection Dim sqlCmd As SqlCommand Dim adapter As New SqlDataAdapter Dim oracleConn As OracleConnection Dim oracleCmd As OracleCommand Dim oracleadapter As New OracleDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim sql As String Dim runinLZ As Boolean = False connectionString = MYDB_ECM.CurrentConnectionString ' ClassDatabase.GetConnectionString(conid) If connectionString Is Nothing = False Then 'SQL Befehl füllt die Auswahlliste sql = sql_Vorschlag If Not sql.Contains("@") Then If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then sqlCnn = New SqlConnection(connectionString) sqlCnn.Open() sqlCmd = New SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then oracleConn = New OracleConnection(connectionString) oracleConn.Open() oracleCmd = New OracleCommand(sql_Vorschlag, oracleConn) oracleadapter.SelectCommand = oracleCmd oracleadapter.Fill(NewDataset) End If Else runinLZ = True LOGGER.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!") End If Dim newCMB As ComboBox If runinLZ = True Then 'Die Standardcombobox anlegen newCMB = addCombobox(ID, indexname, y) newCMB.Size = New Size(300, 27) Else If NewDataset.Tables(0).Rows.Count > 0 Then 'Die Standardcombobox anlegen newCMB = addCombobox(ID, indexname, y) 'Die Standargrösse definieren Dim newWidth As Integer = 300 For i = 0 To NewDataset.Tables(0).Rows.Count - 1 'MsgBox(NewDataset.Tables(0).Rows(i).Item(0)) AddComboBoxValue(newCMB, NewDataset.Tables(0).Rows(i).Item(0)) Try Dim text As String = NewDataset.Tables(0).Rows(i).Item(0) If text.Length > 15 Then Dim g As Graphics = newCMB.CreateGraphics If g.MeasureString(text, newCMB.Font).Width + 30 > newWidth Then newWidth = g.MeasureString(text, newCMB.Font).Width + 30 End If g.Dispose() End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:") End Try Next newCMB.Size = New Size(newWidth, 27) newCMB.AutoCompleteSource = AutoCompleteSource.ListItems newCMB.AutoCompleteMode = AutoCompleteMode.Suggest newCMB.DropDownHeight = (newCMB.ItemHeight + 0.2) * 25 If Vorgabe <> "" Then newCMB.SelectedIndex = newCMB.FindStringExact(Vorgabe) newCMB.Text = Vorgabe Get_NextComboBoxResults(newCMB) End If Else End If If connectionString.Contains("Server=") And connectionString.Contains("Database=") Then Try adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try Else Try oracleadapter.Dispose() oracleCmd.Dispose() oracleConn.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try End If End If End If Catch ex As Exception LOGGER.Warn(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddVorschlag_ComboBox:") End Try End Sub Sub Refresh_indices() Try If CURRENT_DOKARTID > 0 Then Dim sql = "SELECT * FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKARTID Dim DTDOKART As DataTable = MYDB_ECM.GetDatatable(sql) If DTDOKART.Rows.Count = 1 Then OBJECT_TYPETextBox.Text = DTDOKART.Rows(0).Item("OBJEKTTYP") DOCTYPE_IDTextBox.Text = CURRENT_DOKARTID PATHTextBox.Text = DTDOKART.Rows(0).Item("ZIEL_PFAD") Dim dt As DataTable 'sql = "SELECT * FROM TBDD_INDEX_AUTOM WHERE DOCTYPE_ID = " & CURRENT_DOKARTID 'Dim dt As DataTable = MYDB_ECM.GetDatatable(sql) 'Dim Count As Integer = 0 'lvwIndices.Items.Clear() 'If dt.Rows.Count > 0 Then ' 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 = MYDB_ECM.GetDatatable(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_ENTITY_ID) 'Count = Count + 1 'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_PARENTID").ToString) 'If CURRENT_REDUNDANT_FORM_ID <> 0 Then ' sql = "SELECT TOP 1 PARENT_ID FROM TBPMO_FORM WHERE GUID = " & CURRENT_REDUNDANT_FORM_ID 'Else ' sql = "SELECT TOP 1 PARENT_ID FROM TBPMO_FORM WHERE GUID = " & CURRENT_ENTITY_ID 'End If 'Dim ParentID = MYDB_ECM.GetScalarValue(sql) 'Try ' If IsNumeric(ParentID) And ParentID > 0 Then ' lvwIndices.Items(Count).SubItems.Add(ParentID) ' End If 'Catch ex As Exception ' MsgBox("Unexpected Error in Setting Parent-ID" & vbNewLine & ex.Message, MsgBoxStyle.Critical) 'End Try 'Count = Count + 1 ''den Record-Key auslesen 'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_RECORDID").ToString) 'lvwIndices.Items(Count).SubItems.Add(CURRENT_RECORD_ID) 'Count = Count + 1 'lvwIndices.Items.Add(dt.Rows(0).Item("IDXNAME_DOCTYPE").ToString) 'lvwIndices.Items(Count).SubItems.Add(CURRENT_DOKARTSTRING) End If 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 CURRENT_FILENAME = "" Me.VWDDINDEX_AUTOMTableAdapter.Connection.ConnectionString = MYDB_ECM.CurrentConnectionString chkMultiIndexer.Checked = False LOGGER.Debug("frmWD_Index_Dokart_Load") chkdelete_origin.Checked = False chkdelete_origin.Visible = False Dim oReconnect = WMMOD.SessionReconnect '= New Windream(LOGCONFIG, False, WMDriveLetter, WMPATH_PREFIX, True, WM_SERVER, WM_USER, WM_USER_PW, WM_DOMAIN) Dim HandleType As String For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows If row.Item("GUID") = CURRENT_FILEID Then CURRENT_FILENAME = row.Item("FILENAME2WORK") HandleType = row.Item("HANDLE_TYPE") End If Next If CURRENT_FILENAME = "" Then MsgBox("Chekc the Temp Files Table, as it seems to be empty!", MsgBoxStyle.Exclamation) Exit Sub End If MULTIFILES = 0 For Each row As DataRow In CURRENT_TBPMO_FILES_USER.Rows If row.Item("GUID") <> CURRENT_FILEID Then MULTIFILES += 1 End If Next 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 ElseIf HandleType = "SCAM" Then droptype = "scan" End If Dim sql = String.Format("SELECT FORMVIEW_ID, FORM_ID, FORM_TITLE, DOKUMENTTYPE_ID, DOKUMENTTYPE, PATH, SHORTNAME, OBJECT_TYPE, FW_DOCTYPE_ID FROM VWPMO_DOKUMENTTYPES WHERE (FORMVIEW_ID = {0}) " & _ "ORDER BY SEQUENCE, DOKUMENTTYPE", CURRENT_FORMVIEW_ID) DTVWPMO_DOKUMENTTYPES = MYDB_ECM.GetDatatable(sql) 'VWPMO_DOKUMENTTYPESTableAdapter.Connection.ConnectionString = MYDB_ECM.CurrentConnectionString 'Me.VWPMO_DOKUMENTTYPESTableAdapter.Fill(Me.DD_DMSDataSet.VWPMO_DOKUMENTTYPES, CURRENT_FORMVIEW_ID) CURRENT_REDUNDANT_FORM_ID = 0 CURRENT_REDUNDANT_FORMVIEW_ID = 0 If DTVWPMO_DOKUMENTTYPES.Rows.Count = 0 Then ' DD_DMSDataSet.VWPMO_DOKUMENTTYPES.Rows.Count = 0 Then If CURRENT_ENTITY_REDUNDANT_ID <> 0 Then Dim FVID = MYDB_ECM.GetScalarValue(String.Format("SELECT GUID FROM TBPMO_FORM_VIEW WHERE FORM_ID = {0} and SCREEN_ID = 1", CURRENT_ENTITY_REDUNDANT_ID), True) 'Me.VWPMO_DOKUMENTTYPESTableAdapter.Fill(Me.DD_DMSDataSet.VWPMO_DOKUMENTTYPES, FVID) If DTVWPMO_DOKUMENTTYPES.Rows.Count = 0 Then 'DD_DMSDataSet.VWPMO_DOKUMENTTYPES.Rows.Count = 0 Then MsgBox("No documenttypes for the redundant entity configured either! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation) Exit Sub Else LOGGER.Debug("Redundant EntityID: " & CURRENT_ENTITY_REDUNDANT_ID) CURRENT_REDUNDANT_FORM_ID = CURRENT_ENTITY_REDUNDANT_ID CURRENT_REDUNDANT_FORMVIEW_ID = FVID CURRENT_ENTITY_ID = CURRENT_ENTITY_REDUNDANT_ID CURRENT_FORMVIEW_ID = FVID End If Else MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation) Exit Sub End If End If 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, "ConfigMain") End Sub Private Sub frmWD_Index_Dokart_Shown(sender As Object, e As EventArgs) Handles Me.Shown Try If My.Settings.WD_INDEXDOKART_SAVE <> String.Empty Then Me.cmbDokumentart.SelectedItem = Me.cmbDokumentart.Items.IndexOf(My.Settings.WD_INDEXDOKART_SAVE) ' cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(My.Settings.WD_INDEXDOKART_SAVE) End If If DTVWPMO_DOKUMENTTYPES.Rows.Count >= 1 Then cmbDokumentart.DataSource = DTVWPMO_DOKUMENTTYPES cmbDokumentart.DisplayMember = DTVWPMO_DOKUMENTTYPES.Columns(4).ColumnName cmbDokumentart.ValueMember = DTVWPMO_DOKUMENTTYPES.Columns(3).ColumnName If DTVWPMO_DOKUMENTTYPES.Rows.Count = 1 Then cmbDokumentart.SelectedIndex = 0 CURRENT_DOKARTID = cmbDokumentart.SelectedValue CURRENT_DOKARTSTRING = cmbDokumentart.Text Refresh_indices() End If End If Me.Hide() Me.Visible = True Me.Activate() Me.BringToFront() If CURRENT_CONTROL_DOCTYPE_MATCH <> "" Then 'Me.cmbDokumentart.SelectedItem = Me.cmbDokumentart.Items.IndexOf(CURRENT_CONTROL_DOCTYPE_MATCH) cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(CURRENT_CONTROL_DOCTYPE_MATCH) If cmbDokumentart.SelectedIndex = 0 And CURRENT_CONTROL_DOCTYPE_MATCH = cmbDokumentart.Text Then CURRENT_DOKARTID = cmbDokumentart.SelectedValue CURRENT_DOKARTSTRING = cmbDokumentart.Text Refresh_indices() End If End If Catch ex As Exception MsgBox("Error in Form Shown:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try formloaded = True End Sub Private Sub txtSubfolder_TextChanged(sender As Object, e As EventArgs) Handles txtSubfolder.TextChanged CURRENT_SUBFOLDER = txtSubfolder.Text End Sub End Class