Imports WINDREAMLib Imports System.Threading Imports System.Runtime.InteropServices Imports System.Management Imports System.Globalization Imports Oracle.ManagedDataAccess.Client Imports Independentsoft Imports System.IO Imports DevExpress.Pdf.pdfdo Imports DevExpress.Pdf Public Class frmValidator Dim viewerID Dim strFileList() Dim PROFIL_sortbynewest As Boolean Dim PROFIL_VEKTORINDEX Dim PROFIL_LOGINDEX Dim Right_Delete As Boolean Dim DTPROFIL As DataTable Dim Delimiter As String Dim WD_Search As String Dim finalProfile As Boolean Dim Move2Folder As String Private _windreamPM As New ClassPMWindream Private _windream As New ClassWindream_allgemein Private allgFunk As New ClassAllgemeineFunktionen Dim aktivesDokument As WMObject 'speichert die DocumentDaten Private navStep As String = Nothing Public Shared Document_Path As String Dim OLD_Document_Path As String = "" Dim ValueDTP As Date Dim AnzDoks As Integer Dim docCounter As Integer = 1 'Anzahl der Validierungsdokumente Dim Anzahl_ValDoks As Integer 'Anzahl der validierten Dokumente Dim Anzahl_validierte_Dok As Integer = 0 Dim me_closing As Boolean = False Dim errmessage As String = "Please validate red marked fields" Dim first_control As Control Dim last_control As Control Dim _Indexe_Loaded As Boolean = False Public Shared idxerr_message As String = "" Dim DocView Dim viewer_string As String Dim pdfxchange As Boolean = False Dim sumatra As Boolean = False Public Shared Function SetForegroundWindow(ByVal hwnd As IntPtr) As Boolean End Function Function set_foreground() Try Dim hwnd As IntPtr Dim prc() As Process = Process.GetProcessesByName("DD_PM_WINDREAM") If Not prc Is Nothing AndAlso Not prc.Length = 0 Then hwnd = prc(0).MainWindowHandle SetForegroundWindow(hwnd) Else prc = Process.GetProcessesByName("DD_PM_WINDREAM.vshost") If Not prc Is Nothing AndAlso Not prc.Length = 0 Then hwnd = prc(0).MainWindowHandle SetForegroundWindow(hwnd) End If End If Catch ex As Exception MsgBox("Fehler in set_foreground: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler:") End Try End Function Private Sub frmValidation_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing Try me_closing = True Try ' Position und Größe speichern My.Settings.frmValidatorSize = Me.Size My.Settings.frmValidatorPosition = Me.Location My.Settings.Save() Catch ex As Exception ClassLogger.Add("Error in Load FormLayout: " & ex.Message) End Try Select Case Path.GetExtension(Document_Path).ToLower Case ".pdf" Select Case vpdfviewer Case "internal" My.Settings.frmValidation_Size_PDFViewer = Me.Size Case "pdfxchange" My.Settings.frmValidatorSize = Me.Size Case "sumatra" My.Settings.frmValidatorSize = Me.Size Case "system" My.Settings.frmValidatorSize = Me.Size End Select Case ".msg" My.Settings.frmValidation_Size_Email = Me.Size Case Else My.Settings.frmValidatorSize = Me.Size End Select My.Settings.Save() Catch ex As Exception End Try Try TBPM_FILES_USER_NOT_INDEXEDTableAdapter.CmdDelete(Environment.UserName) Catch ex As Exception MsgBox("Fehler bei Übersprungene Files löschen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try If CURRENT_DOC_GUID <> 0 Then Try TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(False, "", CURRENT_DOC_GUID) Catch ex As Exception allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Fehler bei Freigabe der Dok-ID: " & CURRENT_DOC_GUID & " - ERROR: " & ex.Message, Environment.UserName) End Try End If If Viewer = "docview" Then CloseWDDocview() End If If vpdfviewer = "system" Then Kill_PDFAcrobat() Else If pdfxchange = True Or sumatra = True Then Close_PDF_Viewer(Document_Path) End If KillU_Viewer() End If End Sub Sub KillU_Viewer() Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo("taskkill.exe", "/im Viewer.exe") psi.UseShellExecute = True Proc.StartInfo = psi psi.WindowStyle = ProcessWindowStyle.Minimized Proc.Start() pdfxchange = False Dim p As Process Dim processes As Process() processes = Process.GetProcesses() For Each p In processes If p.ProcessName.ToLower = "viewer" Then p.Kill() End If Next Catch ex As Exception End Try End Sub Sub Kill_PDFAcrobat() Try Dim p As Process Dim processes As Process() processes = Process.GetProcesses() For Each p In processes If viewerID Is Nothing = False Then If p.Id = viewerID Then p.Kill() If p.ProcessName = "Acrobat.exe" Then p.Kill() Else If p.ProcessName = "Acrobat.exe" Then p.Kill() If p.ProcessName = "AcroRd32.exe" Then p.Kill() If p.ProcessName.ToLower = "acrord32" Then p.Kill() If p.ProcessName.Contains("croRd") Then p.Kill() End If Next Catch ex As Exception End Try End Sub Private Function process_User_exists(processname As String, Status As String) Try Dim selectQuery As SelectQuery = New SelectQuery("Win32_Process") Dim searcher As ManagementObjectSearcher = New ManagementObjectSearcher(selectQuery) For Each proc As ManagementObject In searcher.Get If proc("Name").ToString.ToLower = processname.ToLower Then Dim s(1) As String proc.InvokeMethod("GetOwner", CType(s, Object())) If CStr(s(0)).ToLower.Contains(Environment.UserName.ToLower) Then Return True End If End If Next Return False Catch ex As Exception If Status = "CLOSE" Then Return False Else 'ClassLogger.Add(">> Fehler in process_User_exists " & Status & ": " & ex.Message, True) Return True End If End Try End Function Private Function process_terminate(processname As String) Try Dim selectQuery As SelectQuery = New SelectQuery("Win32_Process") Dim searcher As ManagementObjectSearcher = New ManagementObjectSearcher(selectQuery) For Each proc As ManagementObject In searcher.Get If proc("Name").ToString = processname Then Dim s(1) As String proc.InvokeMethod("GetOwner", CType(s, Object())) If CStr(s(0)).ToLower.Contains(Environment.UserName.ToLower) Then proc.InvokeMethod("Terminate", Nothing) End If End If Next Return False Catch ex As Exception ClassLogger.Add(">> Fehler in process_terminate: " & ex.Message, True) End Try End Function Sub Close_PDF_Viewer(vorherigefile As String) Try If vpdfviewer = "pdfxchange" Then Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(PDFXChangeViewer, "/Close:save """ & vorherigefile & """") psi.WindowStyle = ProcessWindowStyle.Minimized psi.UseShellExecute = True Proc.StartInfo = psi Proc.Start() pdfxchange = True sumatra = False 'Dim count As Integer = 0 'sss() 'Do While process_User_exists("PDFXCview.exe", "CLOSE") = True ' 'Warten bis PDF geschlossen ist ' count += 1 ' If count = 500 Then ' If process_terminate("PDFXCview.exe") Then ' process_terminate("PDFXCview.exe") ' End If ' End If 'Loop End If If vpdfviewer = "sumatra" Then Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo("taskkill.exe", "/im SumatraPDF.exe") psi.WindowStyle = ProcessWindowStyle.Minimized psi.UseShellExecute = True Proc.StartInfo = psi Proc.Start() pdfxchange = False sumatra = True Catch ex As Exception End Try End If If vpdfviewer = "system" Then Kill_PDFAcrobat() pdfxchange = False sumatra = False End If Catch ex As Exception ClassLogger.Add("Fehler in Close_PDFXCHANGE") ClassLogger.Add(ex.Message) End Try End Sub Private Function Init_windream() Try _windream = New ClassWindream_allgemein _windream.Init() If LogErrorsOnly = False Then ClassLogger.Add(" >> Windream initiiert", False) Return True Catch ex As Exception MsgBox("Error Init_windream:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error Init _windream: " & ex.Message, Environment.UserName) ClassLogger.Add(">> Fehler in Init_windream: " & ex.Message, True) Return False End Try End Function Private Sub frmValidation_Load(sender As Object, e As System.EventArgs) Handles Me.Load SplitContainer1.Panel2Collapsed = True docCounter = 1 OLD_Document_Path = "" first_control = Nothing me_closing = False pdfxchange = False sumatra = False If My.Settings.frmValidatorPosition.IsEmpty = False Then If My.Settings.frmValidatorPosition.X > 0 And My.Settings.frmValidatorPosition.Y > 0 Then Location = My.Settings.frmValidatorPosition End If End If If My.Settings.frmValidatorSize.IsEmpty = False Then Size = My.Settings.frmValidatorSize End If Try DTPROFIL = ClassDatabase.Return_Datatable("SELECT * FROM TBPM_PROFILE WHERE GUID = " & CURRENT_ProfilGUID) TBPM_FILES_USER_NOT_INDEXEDTableAdapter.Connection.ConnectionString = MyConnectionString TBPM_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = MyConnectionString TBPM_CONNECTIONTableAdapter.Connection.ConnectionString = MyConnectionString TBPM_PROFILE_FILESTableAdapter.Connection.ConnectionString = MyConnectionString TBPM_PROFILE_FINAL_INDEXINGTableAdapter.Connection.ConnectionString = MyConnectionString TBPM_PROFILETableAdapter.Connection.ConnectionString = MyConnectionString TBPM_KONFIGURATIONTableAdapter.Connection.ConnectionString = MyConnectionString VWPM_CONTROL_INDEXTableAdapter.Connection.ConnectionString = MyConnectionString VWPM_PROFILE_USERTableAdapter.Connection.ConnectionString = MyConnectionString TBPM_CONTROL_TABLETableAdapter.Connection.ConnectionString = MyConnectionString VWPM_PROFILE_USERTableAdapter.FillByName(DD_DMSLiteDataSet.VWPM_PROFILE_USER, CURRENT_ProfilName, Environment.UserName) VWPM_CONTROL_INDEXTableAdapter.Fill(DD_DMSLiteDataSet.VWPM_CONTROL_INDEX, CURRENT_ProfilName) TBPM_CONNECTIONTableAdapter.Fill(DD_DMSLiteDataSet.TBPM_CONNECTION) If LogErrorsOnly = False Then ClassLogger.Add(" >> Profile Data geladen", False) Catch ex As Exception MsgBox("Error LOADING profile-data:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error LOADING profile-data: " & ex.Message, Environment.UserName) ClassLogger.Add(">> Fehler in LOADING profile-data: " & ex.Message, True) Me.Close() End Try Try Delimiter = TBPM_KONFIGURATIONTableAdapter.cmdGetDelimiter Dim dt As DataTable = Me.DD_DMSLiteDataSet.VWPM_PROFILE_USER Dim dr As DataRow If dt.Rows.Count = 0 Then ClassLogger.Add(">> Profildaten konnten nicht geladen werden - Übergebenes Profil: : " & CURRENT_ProfilName, True) MsgBox("Achtung: Profildaten konnten nicht übergeben oder geladen werden.", MsgBoxStyle.Critical, "Achtung:") Me.Close() End If If dt.Rows.Count > 1 Then MsgBox("Es wurden mehr als 1 Profil zurückgegeben!!", MsgBoxStyle.Critical, "Achtung:") Else If dt.Rows.Count <> 0 Then For Each dr In dt.Rows PROFIL_VEKTORINDEX = dr.Item("PM_VEKTOR_INDEX") PROFIL_LOGINDEX = dr.Item("LOG_INDEX") Me.Text = "Process Manager - " & dr.Item("TITLE") If PROFIL_VEKTORINDEX.GetType.ToString.ToLower = "system.dbnull" Then PROFIL_VEKTORINDEX = "" End If If PROFIL_LOGINDEX.GetType.ToString.ToLower = "system.dbnull" Then PROFIL_LOGINDEX = "" End If WD_Search = dr.Item("WD_SEARCH") finalProfile = dr.Item("FINAL_PROFILE") Move2Folder = dr.Item("MOVE2Folder") Right_Delete = dr.Item("RIGHT_FILE_DELETE") If CURRENT_JUMP_DOC_GUID <> 0 Then Anzahl_ValDoks = 1 Else Anzahl_ValDoks = TBPM_PROFILE_FILESTableAdapter.cmdGet_Anzahl(CURRENT_ProfilGUID) End If Next If LogErrorsOnly = False Then ClassLogger.Add(" >> Profildaten gespeichert", False) ClassLogger.Add(" >> WD_Search: " & WD_Search, False) ClassLogger.Add(" >> finalProfile: " & finalProfile, False) ClassLogger.Add(" >> Move2Folder: " & Move2Folder, False) ClassLogger.Add(" >> Right_Delete: " & Right_Delete, False) End If PROFIL_sortbynewest = DTPROFIL.Rows(0).Item("SORT_BY_LATEST") If LogErrorsOnly = False Then ClassLogger.Add(" >> PROFIL_sortbynewest: " & PROFIL_sortbynewest.ToString, False) 'Delete Button anzeigen ja/nein If Right_Delete = True Then ToolStripButtonDeleteFile.Enabled = True Else ToolStripButtonDeleteFile.Enabled = False End If If LogErrorsOnly = False Then ClassLogger.Add(" >> Right_Delete: " & Right_Delete.ToString, False) Load_Controls() End If End If Catch ex As System.Exception MsgBox("Error SAVING Profile-Data:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error SAVING Profile-Data: " & ex.Message, Environment.UserName) ClassLogger.Add(">> Fehler in SAVING Profile-Data: " & ex.Message, True) End Try 'Me.lblerror.Visible = False Try If finalProfile = True Then Dim text As String = DTPROFIL.Rows(0).Item("FINAL_TEXT") If text <> "" Then btnSave.Text = text & " (F1)" Else btnSave.Text = "Validierung speichern - Nächstes Dokument" & " (F1)" End If Else btnSave.Text = "Validierung speichern - Nächstes Dokument" & " (F1)" End If If LogErrorsOnly = False Then ClassLogger.Add(" >> Final profile Text geladen", False) Catch ex As Exception MsgBox("Error loading final profile text:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error loading final profile text: " & ex.Message, Environment.UserName) allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error loading final profile text " & ex.Message, Environment.UserName) ClassLogger.Add(">> Fehler in loading final profile text: " & ex.Message, True) End Try End Sub Sub ComboBoxData(profileId As Integer, controlName As String) ' Informationen über Profil und Control holen Dim ControlId As Integer = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(profileId, controlName) Dim ConnectionId As Integer Dim SQLCommand As String If ControlId = 0 Then Exit Sub End If ConnectionId = TBPM_PROFILE_CONTROLSTableAdapter.cmdgetConnectionID(ControlId) If ConnectionId = 0 Then Exit Sub End If SQLCommand = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlId) If SQLCommand = String.Empty Then Exit Sub End If TBPM_CONNECTIONTableAdapter.FillByID(DD_DMSLiteDataSet.TBPM_CONNECTION, ConnectionId) Dim connectionString As String For Each row As DataRow In DD_DMSLiteDataSet.TBPM_CONNECTION.Rows Select Case row.Item("SQL_PROVIDER").ToString().ToLower() Case "ms-sql" If row.Item("USERNAME") = "WINAUTH" Then connectionString = $"Data Source={row.Item("SERVER")};Initial Catalog=${row.Item("DATENBANK")};Trusted_Connection=True;" Else connectionString = $"Data Source={row.Item("SERVER")};Initial Catalog=${row.Item("DATENBANK")};User Id={row.Item("USERNAME")};Password={row.Item("PASSWORD")}" End If Case "oracle" Dim csBuilder As New OracleConnectionStringBuilder() If row.Item("SERVER") <> String.Empty And Not IsDBNull(row.Item("SERVER")) Then connectionString = $""" Data Source=( DESCRIPTION= ADDRESS_LIST= (ADDRESS= (PROTOCOL=TCP) (HOST={row.Item("SERVER")}) (PORT=1521) ) ) (CONNECT_DATA= (SERVER=DEDICATED) (SERVICE_NAME={row.Item("DATENBANK")}) ) );User Id={row.Item("USERNAME")};Password={row.Item("PASSWORD")} """ Else csBuilder.DataSource = row.Item("SERVER") csBuilder.UserID = row.Item("USERNAME") csBuilder.Password = row.Item("PASSWORD") csBuilder.PersistSecurityInfo = True csBuilder.ConnectionTimeout = 120 connectionString = csBuilder.ConnectionString End If Case Else Exit Sub End Select Next Dim items As New List(Of String) Using adapter As New SqlClient.SqlDataAdapter() Using conn As New SqlClient.SqlConnection(connectionString) conn.Open() Using cmd As New SqlClient.SqlCommand(SQLCommand, conn) Dim dataSet As New DataSet() adapter.SelectCommand = cmd adapter.Fill(dataSet) Dim table = dataSet.Tables(0) For Each row As DataRow In table.Rows items.Add(row.Item(0)) Next End Using End Using End Using End Sub Sub Load_Controls() Try pnldesigner.Controls.Clear() 'Dim dt As DataTable = DD_DMSLiteDataSet.VWPM_CONTROL_INDEX TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, CURRENT_ProfilGUID) Dim dt As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS For Each dr As DataRow In dt.Rows Dim ctrl As Control Select Case dr.Item("CTRL_TYPE").ToString.ToUpper Case "TXT" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch TXT zu laden", False) Dim txt As TextBox = ClassControlCreator.CreateExistingTextbox(dr, False) AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp ctrl = txt 'add_textbox(dr.Item("GUID"), dr.Item("CTRL_NAME"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), CInt(dr.Item("WIDTH")), CInt(dr.Item("HEIGHT")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) 'dr.Item("INDEX_NAME"), Case "LBL" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch LBL zu laden", False) ctrl = ClassControlCreator.CreateExistingLabel(dr, False) 'add_label(dr.Item("GUID"), dr.Item("CTRL_NAME"), dr.Item("CTRL_TEXT"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC"))) Case "CMB" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch CMB zu laden", False) Dim cmb = ClassControlCreator.CreateExistingCombobox(dr, False) AddHandler cmb.SelectedValueChanged, AddressOf OnCmbselectedIndex #Region "CONTROL LIST" Dim ControlID = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, cmb.Name) If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_ComboBox - GUID: " & ControlID, False) If ControlID > 0 Then If LogErrorsOnly = False Then ClassLogger.Add(" >>ControlID > 0", False) Dim ConID = Me.TBPM_PROFILE_CONTROLSTableAdapter.cmdgetConnectionID(ControlID) If ConID Is Nothing = False Then Dim commandsql = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) If LogErrorsOnly = False Then ClassLogger.Add(" >> ConID Is Nothing = False", False) If ConID > 0 And commandsql <> "" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> CConID > 0 And TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID)", False) Dim connectionString As String TBPM_CONNECTIONTableAdapter.FillByID(DD_DMSLiteDataSet.TBPM_CONNECTION, ConID) Dim DTConnection As DataTable = DD_DMSLiteDataSet.TBPM_CONNECTION Dim drConnection As DataRow For Each drConnection In DTConnection.Rows Select Case drConnection.Item("SQL_PROVIDER").ToString.ToLower Case "ms-sql" If drConnection.Item("USERNAME") = "WINAUTH" Then connectionString = "Data Source=" & drConnection.Item("SERVER") & ";Initial Catalog=" & drConnection.Item("DATENBANK") & ";Trusted_Connection=True;" Else connectionString = "Data Source=" & drConnection.Item("SERVER") & ";Initial Catalog= " & drConnection.Item("DATENBANK") & ";User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";" End If If LogErrorsOnly = False Then ClassLogger.Add(" >> ConnString Sql-Server: " & connectionString) Case "oracle" Dim conn As New OracleConnectionStringBuilder Dim connstr As String If drConnection.Item("SERVER") <> "" And drConnection.Item("DATENBANK").GetType.ToString <> "system.dbnull" Then connstr = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & drConnection.Item("SERVER") & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" & drConnection.Item("DATENBANK") & ")));User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";" Else conn.DataSource = drConnection.Item("SERVER") conn.UserID = drConnection.Item("USERNAME") conn.Password = drConnection.Item("PASSWORD") conn.PersistSecurityInfo = True conn.ConnectionTimeout = 120 connstr = conn.ConnectionString End If connectionString = connstr Case Else ClassLogger.Add(" - ConnectionType nicht integriert", False) MsgBox("ConnectionType nicht integriert", MsgBoxStyle.Critical, "Bitte Konfiguration Connection überprüfen!") End Select Next If connectionString Is Nothing = False Then Try Dim sqlCnn As SqlClient.SqlConnection Dim sqlCmd As SqlClient.SqlCommand Dim adapter As New SqlClient.SqlDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim sql As String sql = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) sqlCnn = New SqlClient.SqlConnection(connectionString) ' Try sqlCnn.Open() sqlCmd = New SqlClient.SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) Dim msg As String For i = 0 To NewDataset.Tables(0).Rows.Count - 1 cmb.Items.Add(NewDataset.Tables(0).Rows(i).Item(0)) Next adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Fehler bei GetValues SQL - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei GetValues SQL:") End Try End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Else Row 571", False) End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> AListe Handling", False) Dim AListe As String = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetChoiceListName(ControlID) If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_ComboBox - AListe: " & AListe, False) If AListe Is Nothing = False Then Dim liste = _windream.GetValuesfromAuswahlliste(AListe) If liste IsNot Nothing Then cmb.Items.Add("") For Each index As String In liste cmb.Items.Add(index) Next cmb.SelectedIndex = -1 Else MsgBox("Resultliste windream is nothing!", MsgBoxStyle.Exclamation, AListe) End If Else MsgBox("AListe from database is nothing!", MsgBoxStyle.Exclamation, AListe) End If End If End If #End Region Dim maxWith As Integer = cmb.Width Using g As Graphics = Me.CreateGraphics For Each oItem As Object In cmb.Items 'Für alle Einträge... Dim g1 As Graphics = cmb.CreateGraphics If g1.MeasureString(Text, cmb.Font).Width + 30 > maxWith Then maxWith = g1.MeasureString(Text, cmb.Font).Width + 30 End If g1.Dispose() Next oItem End Using cmb.DropDownWidth = maxWith ctrl = cmb 'add_ComboBox(dr.Item("GUID"), dr.Item("CTRL_NAME"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), CInt(dr.Item("WIDTH")), CInt(dr.Item("HEIGHT")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) 'dr.Item("INDEX_NAME"), Case "DTP" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch DTP zu laden", False) ctrl = ClassControlCreator.CreateExistingDatepicker(dr, False) 'add_DTP(dr.Item("GUID"), dr.Item("NAME"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), CInt(dr.Item("WIDTH")), CInt(dr.Item("HEIGHT")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) 'dr.Item("INDEX_NAME"), Case "DGV" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch DGV zu laden", False) Dim dgv = ClassControlCreator.CreateExistingDataGridView(dr, False) AddHandler dgv.RowValidating, AddressOf onDGVRowValidating ctrl = dgv 'add_DGV(dr.Item("GUID"), dr.Item("CTRL_NAME"), dr.Item("HEIGHT"), dr.Item("WIDTH"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) 'dr.Item("INDEX_NAME"), Case "CHK" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch Checkbox zu laden", False) ctrl = ClassControlCreator.CreateExisingCheckbox(dr, False) 'add_Checkbox(dr.Item("GUID"), dr.Item("CTRL_NAME"), dr.Item("CTRL_TEXT"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) Case "TABLE" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch Tabelle zu laden", False) Dim columns As List(Of DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow) = (From r As DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow In DD_DMSLiteDataSet.TBPM_CONTROL_TABLE Where r.CONTROL_ID = dr.Item("GUID") Select r).ToList() ctrl = ClassControlCreator.CreateExistingTable(dr, columns, False) 'add_TABLE(dr.Item("GUID"), dr.Item("CTRL_NAME"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), dr.Item("WIDTH"), CInt(dr.Item("HEIGHT")), dr.Item("READ_ONLY")) Case "LINE" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch Linie zu laden", False) ctrl = ClassControlCreator.CreateExistingLine(dr, False) End Select If first_control Is Nothing Then first_control = ctrl End If last_control = ctrl pnldesigner.Controls.Add(ctrl) Next If LogErrorsOnly = False Then ClassLogger.Add(" >> Controls geladen", False) ClassLogger.Add("", False) Catch ex As Exception If LogErrorsOnly = False Then MsgBox("Error Load_Controls: " & ex.Message, MsgBoxStyle.Critical, "Attention error:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error Load_Controls: " & ex.Message, Environment.UserName) ClassLogger.Add("Unvorhergesehener Fehler bei Load_Controls:" & ex.Message) ClassLogger.Add("", False) End Try End Sub 'Function add_label(CONTROL_ID As Integer, lblname As String, text As String, x As Integer, y As Integer) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_label - lblname: " & lblname & " x/y: " & x.ToString & "/" & y.ToString, False) ' Dim lbl As New Label ' lbl.Name = lblname ' lbl.Text = text ' lbl.AutoSize = True ' lbl.Tag = CONTROL_ID ' 'lbl.Size = New Size(CInt(lbl.Text.Length * 10), 16) ' lbl.Location = New Point(x, y) ' pnldesigner.Controls.Add(lbl) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> LBL: " & lblname & " hinzugefügt", False) 'End Function Function add_textbox(CONTROL_ID As Integer, ByVal txtname As String, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal read_only As Boolean, loadindex As Boolean) 'idxName As String, If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_textbox - txtname: " & txtname & " x/y: " & x.ToString & "/" & y.ToString, False) Dim txt As New TextBox txt.Name = txtname txt.Tag = CONTROL_ID If height > 27 Then txt.Multiline = True txt.AcceptsReturn = True Else txt.Multiline = False txt.AcceptsReturn = False End If If read_only = True Then txt.ReadOnly = True txt.TabStop = False 'txt.Enabled = False End If txt.Size = New Size(width, height) txt.Location = New Point(x, y) pnldesigner.Controls.Add(txt) AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp If first_control Is Nothing And read_only = False Then first_control = txt End If last_control = txt If LogErrorsOnly = False Then ClassLogger.Add(" >> TXT: " & txtname & " hinzugefügt", False) End Function Function add_ComboBox(CONTROL_ID As Integer, cmbname As String, x As Integer, y As Integer, width As Integer, height As Integer, read_only As Boolean, loadindex As Boolean) 'idxName As String, If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_ComboBox - cmbname: " & cmbname & " x/y: " & x.ToString & "/" & y.ToString, False) Dim cmb As New ComboBox cmb.Name = cmbname cmb.Size = New Size(width, height) cmb.Location = New Point(x, y) cmb.Tag = CONTROL_ID If read_only = True Then cmb.Enabled = False cmb.TabStop = False End If cmb.AutoCompleteMode = AutoCompleteMode.SuggestAppend cmb.AutoCompleteSource = AutoCompleteSource.ListItems If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_ComboBox - Get GUID ", False) 'Überprüfen ob es eine Auswahllsite gibt Dim ControlID = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, cmbname) If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_ComboBox - GUID: " & ControlID, False) If ControlID > 0 Then If LogErrorsOnly = False Then ClassLogger.Add(" >>ControlID > 0", False) Dim ConID = Me.TBPM_PROFILE_CONTROLSTableAdapter.cmdgetConnectionID(ControlID) If ConID Is Nothing = False Then Dim commandsql = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) If LogErrorsOnly = False Then ClassLogger.Add(" >> ConID Is Nothing = False", False) If ConID > 0 And commandsql <> "" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> CConID > 0 And TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID)", False) Dim connectionString As String TBPM_CONNECTIONTableAdapter.FillByID(DD_DMSLiteDataSet.TBPM_CONNECTION, ConID) Dim DT As DataTable = DD_DMSLiteDataSet.TBPM_CONNECTION Dim drConnection As DataRow For Each drConnection In DT.Rows Select Case drConnection.Item("SQL_PROVIDER").ToString.ToLower Case "ms-sql" If drConnection.Item("USERNAME") = "WINAUTH" Then connectionString = "Data Source=" & drConnection.Item("SERVER") & ";Initial Catalog=" & drConnection.Item("DATENBANK") & ";Trusted_Connection=True;" Else connectionString = "Data Source=" & drConnection.Item("SERVER") & ";Initial Catalog= " & drConnection.Item("DATENBANK") & ";User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";" End If If LogErrorsOnly = False Then ClassLogger.Add(" >> ConnString Sql-Server: " & connectionString) Case "oracle" Dim conn As New OracleConnectionStringBuilder Dim connstr As String If drConnection.Item("SERVER") <> "" And drConnection.Item("DATENBANK").GetType.ToString <> "system.dbnull" Then connstr = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & drConnection.Item("SERVER") & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" & drConnection.Item("DATENBANK") & ")));User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";" Else conn.DataSource = drConnection.Item("SERVER") conn.UserID = drConnection.Item("USERNAME") conn.Password = drConnection.Item("PASSWORD") conn.PersistSecurityInfo = True conn.ConnectionTimeout = 120 connstr = conn.ConnectionString End If connectionString = connstr Case Else ClassLogger.Add(" - ConnectionType nicht integriert", False) MsgBox("ConnectionType nicht integriert", MsgBoxStyle.Critical, "Bitte Konfiguration Connection überprüfen!") End Select Next If connectionString Is Nothing = False Then Try Dim sqlCnn As SqlClient.SqlConnection Dim sqlCmd As SqlClient.SqlCommand Dim adapter As New SqlClient.SqlDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim sql As String sql = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) sqlCnn = New SqlClient.SqlConnection(connectionString) ' Try sqlCnn.Open() sqlCmd = New SqlClient.SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) Dim msg As String For i = 0 To NewDataset.Tables(0).Rows.Count - 1 cmb.Items.Add(NewDataset.Tables(0).Rows(i).Item(0)) Next adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Fehler bei GetValues SQL - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei GetValues SQL:") End Try End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Else Row 571", False) End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> AListe Handling", False) Dim AListe As String = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetChoiceListName(ControlID) If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_ComboBox - AListe: " & AListe, False) If AListe Is Nothing = False Then Dim liste = _windream.GetValuesfromAuswahlliste(AListe) If liste IsNot Nothing Then cmb.Items.Add("") For Each index As String In liste cmb.Items.Add(index) Next cmb.SelectedIndex = -1 Else MsgBox("Resultliste windream is nothing!", MsgBoxStyle.Exclamation, AListe) End If Else MsgBox("AListe from database is nothing!", MsgBoxStyle.Exclamation, AListe) End If End If End If 'Die BReite der DropDown-Lsit anpassen Dim iWidestWidth As Integer = 300 Using g As Graphics = Me.CreateGraphics For Each oItem As Object In cmb.Items 'Für alle Einträge... Dim g1 As Graphics = cmb.CreateGraphics If g1.MeasureString(Text, cmb.Font).Width + 30 > iWidestWidth Then iWidestWidth = g1.MeasureString(Text, cmb.Font).Width + 30 End If g1.Dispose() Next oItem End Using 'If Me.Items.Count > Me.MaxDropDownItems Then 'Wenn die Scrollleiste angezeigt wird... ' iWidestWidth += 15 'End If cmb.DropDownWidth = Math.Max(iWidestWidth, cmb.Width) pnldesigner.Controls.Add(cmb) If LogErrorsOnly = False Then ClassLogger.Add(" >> CMB: " & cmbname & " hinzugefügt", False) AddHandler cmb.SelectedIndexChanged, AddressOf OnCmbselectedIndex If first_control Is Nothing And read_only = False Then first_control = cmb End If last_control = cmb End Function Function add_DTP(CONTROL_ID As Integer, dtpname As String, x As Integer, y As Integer, width As Integer, height As Integer, read_only As Boolean, loadindex As Boolean) 'idxName As String, If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_DTP - dtpname: " & dtpname & " x/y: " & x.ToString & "/" & y.ToString, False) Dim dtp As New DateTimePicker dtp.Name = dtpname dtp.Tag = CONTROL_ID dtp.Size = New Size(width, height) dtp.Location = New Point(x, y) dtp.Format = DateTimePickerFormat.Short If read_only = True Then dtp.Enabled = True dtp.TabStop = False End If If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_DTP - Get GUID ", False) 'Überprüfen ob es eine Auswahllsite gibt Dim guid = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, dtpname) If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_DTP - GUID: " & guid.ToString, False) pnldesigner.Controls.Add(dtp) If LogErrorsOnly = False Then ClassLogger.Add(" >> CMB: " & dtpname & " hinzugefügt", False) AddHandler dtp.ValueChanged, AddressOf OnDTPValueChanged If first_control Is Nothing And read_only = False Then first_control = dtp End If last_control = dtp End Function Function add_DGV(CONTROL_ID As Integer, dgvname As String, height As Integer, width As Integer, x As Integer, y As Integer, read_only As Boolean, loadindex As Boolean) 'idxName As String, If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_DGV - dgvname: " & dgvname & " x/y: " & x.ToString & "/" & y.ToString, False) Dim dgv As New DataGridView dgv.AllowUserToOrderColumns = False dgv.Name = dgvname dgv.Tag = CONTROL_ID dgv.Size = New Size(width, height) dgv.Location = New Point(x, y) dgv.AlternatingRowsDefaultCellStyle.BackColor = Color.Aqua Dim col As New DataGridViewTextBoxColumn col.HeaderText = "" col.Name = "column1" col.Width = dgv.Width - 30 dgv.Columns.Add(col) If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_DGV - Get GUID ", False) 'Überprüfen ob es eine Auswahllsite gibt Dim guid = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, dgvname) If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_DGV - GUID: " & guid.ToString, False) 'jkjjjk If guid > 0 Then End If pnldesigner.Controls.Add(dgv) AddHandler dgv.RowValidating, AddressOf onDGVRowValidating If LogErrorsOnly = False Then ClassLogger.Add(" >> dgv: " & dgvname & " hinzugefügt", False) If first_control Is Nothing And read_only = False Then first_control = dgv End If last_control = dgv End Function Function add_TABLE(CONTROL_ID As Integer, tableName As String, x As Integer, y As Integer, vwidth As Integer, vheight As Integer, read_only As Boolean) Dim table As New DataGridView table.Name = tableName table.Size = New Size(vwidth, vheight) table.Cursor = Cursors.Hand table.Tag = CONTROL_ID table.Location = New Point(x, y) table.AllowUserToAddRows = True table.AllowUserToDeleteRows = False table.AllowUserToResizeColumns = False table.AllowUserToResizeRows = False table.AlternatingRowsDefaultCellStyle.BackColor = Color.Aqua 'Columns laden Dim guid = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, tableName) If guid > 0 Then TBPM_CONTROL_TABLETableAdapter.Fill(Me.DD_DMSLiteDataSet.TBPM_CONTROL_TABLE, guid) Dim DT As DataTable = Me.DD_DMSLiteDataSet.TBPM_CONTROL_TABLE If DT.Rows.Count > 0 Then For Each Row As DataRow In DT.Rows Dim col As New DataGridViewTextBoxColumn col.HeaderText = Row.Item("SPALTEN_HEADER") col.Name = Row.Item("SPALTENNAME") col.Width = Row.Item("SPALTENBREITE") table.Columns.Add(col) Next End If End If ' table.AutoResizeColumns() pnldesigner.Controls.Add(table) If LogErrorsOnly = False Then ClassLogger.Add(" >> Tabelle: " & tableName & " hinzugefügt", False) If first_control Is Nothing And read_only = False Then first_control = table End If last_control = table End Function Function add_Checkbox(CONTROL_ID As Integer, chkname As String, text As String, x As Integer, y As Integer, read_only As Boolean, loadindex As Boolean) If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_label - lblname: " & chkname & " x/y: " & x.ToString & "/" & y.ToString, False) Dim chk As New CheckBox chk.Name = chkname chk.Text = text chk.Tag = CONTROL_ID chk.AutoSize = True 'chk.Size = New Size(CInt(chk.Text.Length * 15), 20) chk.Location = New Point(x, y) pnldesigner.Controls.Add(chk) If LogErrorsOnly = False Then ClassLogger.Add(" >> CHK: " & chkname & " hinzugefügt", False) End Function Sub Clear_all_Input() For Each inctrl As Control In Me.pnldesigner.Controls Dim Type As String = inctrl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" inctrl.Text = "" Case "System.Windows.Forms.ComboBox" Dim cmb As ComboBox = inctrl cmb.SelectedIndex = -1 Case "System.Windows.Forms.DataGridView" Dim dgv As DataGridView = inctrl If dgv.Rows.Count > 0 Then dgv.Rows.Clear() End If Case "System.Windows.Forms.CheckBox" End Select Next set_foreground() If first_control Is Nothing = False Then first_control.Focus() End If End Sub Public Sub OnTextBoxFocus(sender As Object, e As EventArgs) Dim box As TextBox = sender box.BackColor = Color.Lime box.SelectAll() End Sub Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender box.BackColor = Color.White 'If box.Text <> String.Empty And me_closing = False And _Indexe_Loaded = True Then ' If CheckValueExists(box) = False Then ' box.Text = "" ' box.Focus() ' frmError.ShowDialog() ' End If 'End If 'If navStep Is Nothing = False Then ' Select Case navStep ' Case "first" ' MovePosition(0) ' Case "previous" ' MovePosition(aktIndex - 1) ' Case "next" ' MovePosition(aktIndex + 1) ' Case "last" ' MovePosition(Anzahl_ValDoks - 1) ' End Select ' first_control.Focus() 'End If End Sub Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs) Dim box As TextBox = sender If box.Text <> String.Empty And me_closing = False And _Indexe_Loaded = True Then If (e.KeyCode = Keys.Return) Or (e.KeyCode = Keys.Tab) Then Try Dim CONTROL_ID = VWPM_CONTROL_INDEXTableAdapter.cmdGetControlID(CURRENT_ProfilGUID, box.Name) Dim sql = String.Format("select NAME,CONNECTION_ID,SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {0} AND SQL_UEBERPRUEFUNG LIKE '%{1}%'", CURRENT_ProfilGUID, box.Name) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql) If Not IsNothing(DT) And DT.Rows.Count > 0 Then For Each ROW As DataRow In DT.Rows Try Dim displayboxname = ROW.Item(0).ToString If Not IsDBNull(ROW.Item(1)) And Not IsDBNull(ROW.Item(2)) Then Dim sql_Statement = ROW.Item(2) ' 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 Text.RegularExpressions.Regex = New Text.RegularExpressions.Regex(preg) ' die Vorkommen im SQL-String auslesen Dim elemente As Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(sql_Statement) '#### ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen For Each element As Text.RegularExpressions.Match In elemente Try If LogErrorsOnly = False Then ClassLogger.Add(" >> element in RegeX: " & element.Value, False) Dim MyPattern = element.Value.Substring(2, element.Value.Length - 3) Dim input_value If MyPattern.Contains("txt") Then Dim txt As TextBox = CType(pnldesigner.Controls(MyPattern), TextBox) input_value = txt.Text ElseIf MyPattern.Contains("cmb") Then Dim cmb As ComboBox = CType(pnldesigner.Controls(MyPattern), ComboBox) input_value = cmb.Text End If sql_Statement = sql_Statement.ToString.Replace(element.Value, input_value) Catch ex As Exception ClassLogger.Add("Unexpected Error in Checking control values for Variable SQL Result - ERROR: " & ex.Message) End Try Next Dim resultDT As DataTable = ClassDatabase.Return_Datatable_CS(sql_Statement, ROW.Item(1)) If resultDT.Rows.Count >= 1 Then 'Nur dediziert einen Wert zurückerhalten For Each row1 As DataRow In resultDT.Rows Dim result = row1.Item(0) If Not IsNothing(result) Then pnldesigner.Controls(displayboxname).Text = result.ToString Exit For Else pnldesigner.Controls(displayboxname).Text = "RESULT = NOTHING" Exit For End If Next Else pnldesigner.Controls(displayboxname).Text = "NO RESULT" End If End If Catch ex As Exception ClassLogger.Add("Unexpected Error in Display SQL result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Catch ex As Exception ClassLogger.Add("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message) End Try If box.Name = last_control.Name Then ' Abschluss() Else SendKeys.Send("{TAB}") End If End If End If 'If navStep Is Nothing = False Then ' Select Case navStep ' Case "first" ' MovePosition(0) ' Case "previous" ' MovePosition(aktIndex - 1) ' Case "next" ' MovePosition(aktIndex + 1) ' Case "last" ' MovePosition(Anzahl_ValDoks - 1) ' End Select ' first_control.Focus() 'End If End Sub Public Sub onDGVRowValidating(ByVal sender As Object, ByVal e As DataGridViewCellCancelEventArgs) Dim dgv As DataGridView = sender Try Dim CONTROL_ID = VWPM_CONTROL_INDEXTableAdapter.cmdGetControlID(CURRENT_ProfilGUID, dgv.Name) Dim sql = String.Format("select NAME,CONNECTION_ID,SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {0} AND SQL_UEBERPRUEFUNG LIKE '%{1}%'", CURRENT_ProfilGUID, dgv.Name) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql) If Not IsNothing(DT) And DT.Rows.Count > 0 Then For Each ROW As DataRow In DT.Rows Try Dim displayboxname = ROW.Item(0).ToString If Not IsDBNull(ROW.Item(1)) And Not IsDBNull(ROW.Item(2)) Then Dim sql_Statement = ROW.Item(2) Dim cellvalue = dgv.Rows(dgv.Rows.Count - 2).Cells(0).Value.ToString() sql_Statement = sql_Statement.ToString.Replace(dgv.Name, cellvalue) Dim resultDT As DataTable = ClassDatabase.Return_Datatable_CS(sql_Statement, ROW.Item(1)) If resultDT.Rows.Count >= 1 Then 'Nur dediziert einen Wert zurückerhalten For Each row1 As DataRow In resultDT.Rows Dim result = row1.Item(0) If Not IsNothing(result) Then pnldesigner.Controls(displayboxname).Text = result.ToString Exit For Else pnldesigner.Controls(displayboxname).Text = "RESULT = NOTHING" Exit For End If Next Else pnldesigner.Controls(displayboxname).Text = "NO RESULT" End If End If Catch ex As Exception ClassLogger.Add("Unexpected Error in Display SQL result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Catch ex As Exception ClassLogger.Add("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message) End Try End Sub Public Sub OnCmbselectedIndex(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender If cmb.SelectedIndex <> -1 And _Indexe_Loaded = True Then If cmb.Name = last_control.Name Then 'Abschluss() Else SendKeys.Send("{TAB}") End If End If End Sub Public Sub OnDTPValueChanged(sender As System.Object, e As System.EventArgs) Dim dtp As DateTimePicker = sender If _Indexe_Loaded = True Then ValueDTP = dtp.Value If dtp.Name = last_control.Name Then ' Abschluss() Else SendKeys.Send("{TAB}") End If End If End Sub Private Function CheckValueExists(ByVal control As Control) Try Dim dt As DataTable = DD_DMSLiteDataSet.VWPM_CONTROL_INDEX For Each dr As DataRow In dt.Rows If dr.Item("PROFIL_ID") = CURRENT_ProfilGUID And dr.Item("CTRL_NAME") = control.Name Then Dim check = dr.Item("SQL_UEBERPRUEFUNG") If IsDBNull(check) Then If LogErrorsOnly = False Then ClassLogger.Add(" >> SQL Check is not configured!", False) Return True End If If check.ToString.Length > 0 And dr.Item("INDEX_NAME") <> "DD PM-ONLY FOR DISPLAY" Then Dim cs As String = GetConnectionString(dr.Item("CONNECTION_ID")) If allgFunk.checkValue_Exists(dr.Item("SQL_UEBERPRUEFUNG"), "@Eingabe", control.Text, dr.Item("TYP"), cs, CURRENT_ProfilGUID) = True Then Return True Else errormessage = "Der eingegebene Wert '" & control.Text & "' existiert nicht in der Datenbank!" My.Settings.Save() Return False End If Else Return True End If End If Next Catch ex As Exception ClassLogger.Add("Unvorhergesehener Fehler bei CheckValueExists:" & ex.Message) Return False End Try End Function Sub ShowFile_UniversalViewer(AktuelleIndexfile As String) Try KillU_Viewer() Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(UniversalViewer, """" & AktuelleIndexfile & """") psi.WindowStyle = ProcessWindowStyle.Minimized Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() Catch ex As Exception MsgBox("Fehler in ShowFile_UniversalViewer:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Public Function IsProcessRunning(name As String) As Boolean 'here we're going to get a list of all running processes on 'the computer For Each Process As Process In Process.GetProcesses() If Process.ProcessName.StartsWith(name) Then 'process found so it's running so return true Return True End If Next 'process not found, return false Return False End Function Sub Open_PDFXCHANGE(AktuelleIndexfile As String) Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(PDFXChangeViewer, """" & AktuelleIndexfile & """") psi.WindowStyle = ProcessWindowStyle.Minimized Proc.EnableRaisingEvents = True psi.UseShellExecute = False Proc.StartInfo = psi Proc.Start() Do While process_User_exists("PDFXCview.exe", "START") = False 'Warten bis PDF geladen ist System.Threading.Thread.Sleep(500) Loop Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in Open_PDFXCHANGE:") ClassLogger.Add("Fehler in Open_PDFXCHANGE") ClassLogger.Add(ex.Message) End Try End Sub Sub Open_Sumatra(AktuelleIndexfile As String) Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(SumatraViewer, """" & AktuelleIndexfile & """") psi.WindowStyle = ProcessWindowStyle.Minimized Proc.EnableRaisingEvents = True psi.UseShellExecute = False Proc.StartInfo = psi Proc.Start() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in Open_Sumatra:") ClassLogger.Add("Fehler in Open_Sumatra") ClassLogger.Add(ex.Message) End Try End Sub Sub Open_PDF_withStandard() If Document_Path.ToLower.EndsWith(".pdf") = True Then Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(Document_Path) psi.WindowStyle = ProcessWindowStyle.Minimized Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() viewerID = Proc.Id End If End Sub Function Get_Next_GUID() As Integer Try Dim newGUID As Integer If LogErrorsOnly = False Then ClassLogger.Add(" >> Old Document_Path: " & OLD_Document_Path, False) If PROFIL_sortbynewest = True Then newGUID = TBPM_PROFILE_FILESTableAdapter.cmdgetNextFile_GUID_Newest(CURRENT_ProfilGUID, OLD_Document_Path, Environment.UserName) Else newGUID = TBPM_PROFILE_FILESTableAdapter.cmdGetNextFile_GUID(CURRENT_ProfilGUID, OLD_Document_Path, Environment.UserName) End If Document_Path = "" CURRENT_DOC_PATH = "" If newGUID > 0 Then If LogErrorsOnly = False Then ClassLogger.Add(" >> newGUID: " & newGUID.ToString, False) Document_Path = TBPM_PROFILE_FILESTableAdapter.CmdGetFilePath_2_GUID(newGUID) CURRENT_DOC_PATH = Document_Path If LogErrorsOnly = False Then ClassLogger.Add(" >> Document_Path: " & Document_Path, False) If LogErrorsOnly = False Then ClassLogger.Add(" >> Überprüfen ob File existiert?", False) Dim i As Integer = 0 Do While allgFunk.file_exists(Document_Path, False) = False And newGUID <> 0 i = i + 1 If i > 800 Then allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Get_Next_GUID - Datei nicht vorhanden!", Environment.UserName) ClassLogger.Add(" >> ACHTUNG: Ausnahme in GetNextGUID - Datei nicht vorhanden", False) Dim Del = "DELETE FROM TBPM_PROFILE_FILES where GUID = " & newGUID ClassDatabase.Execute_non_Query(Del, True) errmessage = "Die windream-Datei existiert nicht!" Document_Path = "" CURRENT_DOC_PATH = "" Return 0 End If Loop OLD_Document_Path = Document_Path 'If PROFIL_sortbynewest Then ' newGUID = TBPM_PROFILE_FILESTableAdapter.cmdgetNextFile_GUID_Newest(PROFIL_ID, Document_Path, Environment.UserName) ' Document_Path = TBPM_PROFILE_FILESTableAdapter.CmdGetFilePath_2_GUID(newGUID) 'Else ' newGUID = TBPM_PROFILE_FILESTableAdapter.cmdGetNextFile_GUID(PROFIL_ID, Document_Path, Environment.UserName) ' Document_Path = TBPM_PROFILE_FILESTableAdapter.CmdGetFilePath_2_GUID(newGUID) 'End If Else ClassLogger.Add(" >> ACHTUNG: Ausnahme in GetNextGUID - Es konnte keine GUID abgerufen werden!", False) newGUID = 0 End If Return newGUID Catch ex As Exception errmessage = "Unvorhergesehener Fehler in Get_Next_GUID: " & ex.Message ClassLogger.Add(">> Unvorhergesehener Fehler in Get_Next_GUID:: " & ex.Message, True) Return 0 End Try End Function 'lädt die windream-Files für das Profil Sub Refresh_FileList() 'windream-Suche für Profil starten '_windreamPM = New ClassPMWindream() If PROFIL_sortbynewest = True Then TBPM_PROFILE_FILESTableAdapter.FillBy_Newest(DD_DMSLiteDataSet.TBPM_PROFILE_FILES, CURRENT_ProfilGUID) Else TBPM_PROFILE_FILESTableAdapter.Fill(DD_DMSLiteDataSet.TBPM_PROFILE_FILES, CURRENT_ProfilGUID) End If If CURRENT_DOC_GUID = 0 Then Dim DT As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_FILES CURRENT_DOC_GUID = DT.Rows(0).Item("GUID") AnzDoks = DT.Rows.Count Else AnzDoks = 1 Document_Path = CURRENT_DOC_PATH End If tsslblDocID.Text = "Document-ID: " & CURRENT_DOC_ID & " - GUID: " & CURRENT_DOC_GUID End Sub Sub Close_document_viewer() 'Vorherige Datei Schliessen If CURRENT_HTML_DOC <> "" Then If File.Exists(CURRENT_HTML_DOC) Then File.Delete(CURRENT_HTML_DOC) End If End If If pdfxchange = True Or sumatra = True Or vpdfviewer = "system" Then Close_PDF_Viewer(Document_Path) End If If aktivesDokument Is Nothing = False Then If aktivesDokument.aLocked Then aktivesDokument.Save() ' unlock the windream object aktivesDokument.unlock() End If End If End Sub Sub PdfControls_visible(visible As Boolean) If visible = False Then pnlpdf.Dock = DockStyle.None Else pnlpdf.Dock = DockStyle.Fill End If pnlpdf.Visible = visible End Sub Sub Load_Next_Document(first As Boolean) aktivesDokument = Nothing If LogErrorsOnly = False Then ClassLogger.Add(" >> aktivesDokument nothing gesetzt", False) activate_controls(False) errmessage = "" Document_Path = "" CURRENT_HTML_DOC = "" 'Me.lblerror.Visible = False _Indexe_Loaded = False If LogErrorsOnly = False Then ClassLogger.Add(" >> In Load_Next_Document", False) Try If first = True Then If LogErrorsOnly = False Then ClassLogger.Add(" >> First Document", False) aktivesDokument = Nothing Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Following Document ", False) docCounter += 1 End If Clear_all_Input() 'Select Case navtype ' Case "next" ' Case "previous" ' Case "first" ' Case "last" 'End Select If CURRENT_JUMP_DOC_GUID = 0 Then CURRENT_DOC_GUID = Get_Next_GUID() Else Document_Path = CURRENT_DOC_PATH End If If LogErrorsOnly = False Then ClassLogger.Add(" >> Dokument-GUID: '" & CURRENT_DOC_GUID.ToString & "'", False) If CURRENT_DOC_GUID > 0 Then 'Beschriftung des Navigators 'lblNavigator_anzDok.Text = position & " of " & Anzahl_ValDoks & " files" If Document_Path <> String.Empty Then ' >> >> >> >> >> >>##### Das Dokument in Bearbeitung nehmen ########################### TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(True, Environment.UserName, CURRENT_DOC_GUID) ' ############ Infos eintragen ################# tsslblDocID.Text = "Document-ID: " & CURRENT_DOC_ID & " - DocGUID: " & CURRENT_DOC_GUID txtDateipfad.Text = Document_Path tstrlbl_Info.Text = "Datei " & docCounter.ToString & " von " & Anzahl_ValDoks.ToString ClassLogger.Add(">> Validierung für Dokument '" & Document_Path & "' gestartet", False) Try aktivesDokument = _windream.oSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, Document_Path.Substring(2)) Catch ex As Exception allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Fehler bei Erzeugen windream-Objekt - DocGUID: " & CURRENT_DOC_GUID & " - ERROR: " & ex.Message, Environment.UserName) ClassLogger.Add("Fehler bei Erzeugen windream-Objekt in (LoadNextDokument): " & ex.Message) ClassLogger.Add("Error Number: " & Err.Number.ToString) Dim _err1 As Boolean = False 'Nochmaliger Versuch windream zu initialiseren If Init_windream() = True Then Try aktivesDokument = _windream.oSession.GetWMObjectByPath(WINDREAMLib.WMEntity.WMEntityDocument, Document_Path.Substring(2)) Catch ex1 As Exception ClassLogger.Add("Fehler bei 2. Versuch windream-Objekt: " & ex1.Message) _err1 = True End Try Else errmessage = "Es besteht ein Problem beim Anmelden an windream - Bitte wenden Sie sich an Digital Data!" _err1 = True End If If _err1 = True Then frmError.ShowDialog() Exit Sub End If End Try If LogErrorsOnly = False Then ClassLogger.Add(" >> Windream-Dokument geladen und gelockt", False) errmessage = Windream_get_Doc_info() If LogErrorsOnly = False Then ClassLogger.Add(" >> Windream-Dok Info geholt", False) If errmessage = "" Then Me.grpbxMailBody.Visible = False Me.grpBetreff.Visible = False load_viewer() If Document_Path.ToLower.EndsWith(".pdf") Then ToolStripButtonAnnotation.Visible = True Else ToolStripButtonAnnotation.Visible = False End If If LogErrorsOnly = False Then ClassLogger.Add(" >> Viewer geladen", False) FillIndexValues() If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexmaske geladen", False) If LogErrorsOnly = False Then ClassLogger.Add("", False) 'Nun im Vektoprindex loggen das das Profil geladen wurde 'If PROFIL_VEKTORINDEX <> "" Then ' Dim Profilstring = "DD-PM" & Delimiter & "Profil: '" & PROFIL_NAME & "'" & Delimiter & Environment.UserName & Delimiter & Now.ToString ' If Indexiere_VektorfeldPM(Profilstring, PROFIL_VEKTORINDEX) = False Then ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Profilname erfolgreich in Vektorfeld PM geschrieben", False) ' 'Else ' ' errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message ' ' My.Settings.Save() ' ' frmError.ShowDialog() ' ' _error = True ' End If 'End If 'Nun loggen das das Profil geladen wurde If PROFIL_LOGINDEX <> "" Then Dim Profilstring = "DD-PMlog" & Delimiter & "In Profil: '" & CURRENT_ProfilName & "' geladen" & Delimiter & Environment.UserName & Delimiter & Now.ToString If Indexiere_VektorfeldPM(Profilstring, PROFIL_LOGINDEX) = False Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Profilname erfolgreich in Vektorfeld LOG geschrieben", False) 'Else ' errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message ' My.Settings.Save() ' frmError.ShowDialog() ' _error = True End If End If activate_controls(True) Else errormessage = errmessage frmError.ShowDialog() End If Else errormessage = errmessage frmError.ShowDialog() End If Else If errmessage <> "" Then errormessage = errmessage frmError.ShowDialog() Else ClassLogger.Add(" >> Ende des Profils - Kein weiteres Dokument!", False) ClassLogger.Add("", False) MsgBox("Kein weiteres Dokument gefunden - Ende des Profils!" & vbNewLine & "Das Formular wird nun geschlossen.", MsgBoxStyle.Information, "Hinweis:") activate_controls(True) Me.Close() End If End If Catch ex As Exception allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Unvorhergesehener Fehler bei Load_Next_Document - DocGUID: " & CURRENT_DOC_GUID & " - ERROR: " & ex.Message, Environment.UserName) errormessage = "Unvorhergesehener Fehler bei Load_Next_Document:" & ex.Message My.Settings.Save() ClassLogger.Add("Unvorhergesehener Fehler in Load_Next_Document: " & ex.Message) frmError.ShowDialog() End Try End Sub Sub load_viewer() If Viewer = "uviewer" Then pdfxchange = False sumatra = False If Document_Path.ToLower.EndsWith(".msg") Then Show_Email() Else ShowFile_UniversalViewer(Document_Path) End If ElseIf Viewer = "docview" Then PdfControls_visible(False) If Document_Path.ToLower.EndsWith(".pdf") And vpdfviewer <> "none" Then Select Case vpdfviewer Case "internal" SplitContainer1.Panel2Collapsed = False PdfViewer1.LoadDocument(Document_Path) If LogErrorsOnly = False Then ClassLogger.Add(" >> Internal Viewer Path: " & Document_Path, False) PdfControls_visible(True) Me.Size = My.Settings.frmValidation_Size_PDFViewer PdfViewer1.ZoomFactor = PDFViewer_ZoomMode pdfxchange = False sumatra = False Case "pdfxchange" SplitContainer1.Panel2Collapsed = True Open_PDFXCHANGE(Document_Path) pdfxchange = True sumatra = False System.Threading.Thread.Sleep(1000) Me.Size = My.Settings.frmValidatorSize Case "sumatra" SplitContainer1.Panel2Collapsed = True Open_Sumatra(Document_Path) sumatra = True pdfxchange = False System.Threading.Thread.Sleep(1000) Me.Size = My.Settings.frmValidatorSize Case "system" SplitContainer1.Panel2Collapsed = True sumatra = False pdfxchange = False Open_PDF_withStandard() System.Threading.Thread.Sleep(1000) Me.Size = My.Settings.frmValidatorSize End Select ElseIf Document_Path.ToLower.EndsWith(".msg") Then Show_Email() Else SplitContainer1.Panel2Collapsed = True Me.Size = My.Settings.frmValidatorSize pdfxchange = False sumatra = False DocView = Nothing DocView = CreateObject("WMPViewXNG.Viewer") ' open the viewer viewer_string = aktivesDokument.aPath.ToString DocView.ViewFile(viewer_string) End If Else SplitContainer1.Panel2Collapsed = True PdfControls_visible(False) Me.Size = My.Settings.frmValidatorSize pdfxchange = False sumatra = False DocView = Nothing DocView = CreateObject("WMPViewXNG.Viewer") ' open the viewer viewer_string = aktivesDokument.aPath.ToString DocView.ViewFile(viewer_string) End If End Sub Sub Show_Email() Try Me.grpBetreff.Dock = DockStyle.Top Me.grpbxMailBody.Dock = DockStyle.Fill Dim msg_email As New Msg.Message(Document_Path) 'Eine tempfile generieren Dim tempFilename = My.Computer.FileSystem.GetTempFileName() Dim name = Path.GetFileNameWithoutExtension(tempFilename) tempFilename = Path.Combine(Path.GetDirectoryName(tempFilename), name & ".html") 'tempfile löschen If My.Computer.FileSystem.FileExists(tempFilename) Then My.Computer.FileSystem.DeleteFile(tempFilename) End If Me.txtBetreff.Text = msg_email.Subject 'Try Dim wFile As System.IO.FileStream Dim byteData() As Byte byteData = msg_email.BodyHtml ' MsgBox(msg_email.InternetCodePage) ' wFile = New FileStream(tempFilename, FileMode.Append) ' wFile.Write(byteData, 0, byteData.Length) ' wFile.Close() 'Catch ex As IOException ' MsgBox(ex.ToString) 'End Try Dim vIn() As Byte = msg_email.BodyHtml Dim vOut As String = System.Text.Encoding.UTF8.GetString(vIn) File.WriteAllText(tempFilename, vOut, System.Text.Encoding.UTF8) CURRENT_HTML_DOC = tempFilename Me.tslblWebbrowser.Text = CURRENT_HTML_DOC WebBrowser.Navigate("file:///" & CURRENT_HTML_DOC) SplitContainer1.Panel2Collapsed = False Me.Size = My.Settings.frmValidation_Size_Email Me.grpbxMailBody.Visible = True Me.grpBetreff.Visible = True Catch ex As Exception errormessage = "Unvorhergesehener Fehler bei Show_Email:" & ex.Message ClassLogger.Add("Unvorhergesehener Fehler in Show_Email: " & ex.Message) My.Settings.Save() frmError.ShowDialog() End Try End Sub Sub activate_controls(status As Boolean) Me.pnldesigner.Enabled = status Me.btnSave.Enabled = status End Sub Private Function Windream_get_Doc_info() Try Dim DMSErstellt As String 'If CultureInfo.CurrentUICulture.ThreeLetterISOLanguageName = "eng" Then ' My.Settings.vIDX_DMS_ERSTELLT = "DMS Created" ' dmsCreated = "DMS Created" ' My.Settings.vIDX_DMS_ERSTELLT_Zeit = "DMS Created Time" ' dmscreatedtime = "DMS Created Time" ' My.Settings.Save() 'Else 'End If Try DMSErstellt = aktivesDokument.GetVariableValue(IDX_DMS_ERSTELLT) Catch ex As Exception If ex.Message.Contains("Variable: " & IDX_DMS_ERSTELLT & " not found!") Then ClassLogger.Add("1. Ausnahme in Windream_get_Doc_info: Variable: " & IDX_DMS_ERSTELLT & " not found", True) ClassLogger.Add("1. Ausnahme-Fehler: " & ex.Message, False) If IDX_DMS_ERSTELLT = "DMS Created" Then SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS erstellt") IDX_DMS_ERSTELLT = "DMS erstellt" IDX_DMS_ERSTELLT_ZEIT = "DMS erstellt (Zeit)" SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt (Zeit)") Else IDX_DMS_ERSTELLT = "DMS Created" SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS Created") IDX_DMS_ERSTELLT_ZEIT = "DMS Created Time" SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt Time") End If DMSErstellt = aktivesDokument.GetVariableValue(IDX_DMS_ERSTELLT) Else ClassLogger.Add("Fehler in Windream_get_Doc_info 1: " & ex.Message) Return "Fehler in Windream_get_Doc_info 1: " & ex.Message End If End Try If LogErrorsOnly = False Then ClassLogger.Add(" >> DMS-Erstellt aus WD: " & DMSErstellt, False) Dim DMSErstelltZeit As String Try DMSErstelltZeit = aktivesDokument.GetVariableValue(IDX_DMS_ERSTELLT_ZEIT) Catch ex As Exception If ex.Message.Contains("Variable: " & IDX_DMS_ERSTELLT_ZEIT & " not found!") Then ClassLogger.Add("1. Ausnahme in Windream_get_Doc_info: Variable: " & IDX_DMS_ERSTELLT_ZEIT & " not found", True) If IDX_DMS_ERSTELLT = "DMS Created" Then IDX_DMS_ERSTELLT_ZEIT = "DMS erstellt (Zeit)" SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt (Zeit)") Else IDX_DMS_ERSTELLT = "DMS Created" SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS Created") IDX_DMS_ERSTELLT_ZEIT = "DMS Created Time" SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS Created Time") End If DMSErstelltZeit = aktivesDokument.GetVariableValue(IDX_DMS_ERSTELLT_ZEIT) Else ClassLogger.Add("Fehler in Windream_get_Doc_info 3: " & ex.Message) Return "Fehler in Windream_get_Doc_info 3: " & ex.Message End If End Try If LogErrorsOnly = False Then ClassLogger.Add(" >> DMSErstelltZeit aus WD: " & DMSErstelltZeit, False) If DMSErstelltZeit.Length > 11 Then txtErstellt.Text = DMSErstellt & " " & DMSErstelltZeit.Substring(10) Else txtErstellt.Text = DMSErstellt & " " & DMSErstelltZeit End If Return "" Catch ex As Exception ClassLogger.Add("Fehler in Windream_get_Doc_info (GENERELL): " & ex.Message) Return "Fehler in Windream_get_Doc_info (GENERELL): " & ex.Message End Try End Function Private Function ReturnVektor_IndexValue(VKTBezeichner As String) Try Dim value Dim name = VKTBezeichner.Replace("[%VKT", "") Dim Sort_Arr() As String Dim i As Integer = 0 'Jetzt im Vektorfeld des Profils nachsehen ob der WErt bereits vorhanden ist Dim wertWD = aktivesDokument.GetVariableValue(PROFIL_VEKTORINDEX) If wertWD Is Nothing = False Then 'Es wird gegen ein Vektorfeld nachindexiert If wertWD.GetType.ToString.Contains("System.Object") Then 'es handelt sich um ein Vektorfeld - Zuweisen der Indexwerte des Vektorfeldes zu Array For Each obj As Object In wertWD If obj Is Nothing = False Then ReDim Preserve Sort_Arr(i) Sort_Arr(i) = obj.ToString() i += 1 End If Next 'Das Ergebnis-Array nun Rückwärts sortieren, um die letzte Änderung zu finden For Each _string As Object In Sort_Arr.Reverse() Dim DDPM_String As String = _string.ToString() ' Dim VektorArray() = Split(DDPM_String, Delimiter) If VektorArray(1).ToString.ToLower = name.ToLower Then value = VektorArray(2) Exit For End If Next End If End If If value Is Nothing Then value = "" Return value Catch ex As Exception MsgBox("Fehler in ReturnVektor_IndexValue: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add("Fehler in ReturnVektor_IndexValue: " & ex.Message) Return "" End Try End Function Sub FillIndexValues() Dim controltype As String Dim indexname As String Dim resultvalue Try If DD_DMSLiteDataSet.VWPM_CONTROL_INDEX.Rows.Count > 0 Then For Each inctrl As Control In Me.pnldesigner.Controls Dim CONTROL_ID = inctrl.Tag Dim controlRow = (From form In DD_DMSLiteDataSet.VWPM_CONTROL_INDEX.AsEnumerable() Select form Where form.Item("GUID") = CONTROL_ID).Single() Dim Type As String = inctrl.GetType.ToString Dim Typ As String = controlRow.Item("CTRL_TYPE") Dim idxname As String = controlRow.Item("INDEX_NAME") indexname = idxname Dim LoadIDX As Boolean = controlRow.Item("LOAD_IDX_VALUE") If LogErrorsOnly = False Then ClassLogger.Add(" >> INDEX: " & idxname & " - CONTROLNAME: " & inctrl.Name & " - LOAD IDXVALUES: " & LoadIDX.ToString, False) Select Case Type Case "System.Windows.Forms.TextBox" Try controltype = "Textbox" If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then If LoadIDX = False Or idxname = "DD PM-ONLY FOR DISPLAY" Then inctrl.Text = "" If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If Dim wertWD If idxname.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then wertWD = ReturnVektor_IndexValue(idxname) Else wertWD = aktivesDokument.GetVariableValue(idxname) If wertWD Is Nothing Then wertWD = "" Else If wertWD.ToString = "System.Object[]" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> TextBox with VektorField: " & idxname, False) If wertWD.length = 1 Then wertWD = wertWD(0) Else ' ClassLogger.Add(" >> Vectorfield " & idxname & "' contains more then one value - First value will be used", False) wertWD = wertWD(0) End If End If End If End If If wertWD Is Nothing = False Then inctrl.Text = wertWD.ToString Else inctrl.Text = "" End If End If Catch ex As Exception errormessage = "Unvorhergesehener Fehler bei FillIndexValues TextBox:" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() ClassLogger.Add(">> Unvorhergesehener Fehler bei FillIndexValuesTextBox: " & ex.Message, True) ClassLogger.Add(">> Controltype: " & controltype, False) ClassLogger.Add(">> Indexname windream: " & indexname, False) Exit Sub End Try Case "System.Windows.Forms.ComboBox" controltype = "ComboBox" Dim cmb As ComboBox = inctrl If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then If LoadIDX = False Then cmb.SelectedIndex = -1 If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If Dim wertWD If idxname.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then wertWD = ReturnVektor_IndexValue(idxname) Else wertWD = aktivesDokument.GetVariableValue(idxname) End If If wertWD Is Nothing Then cmb.SelectedIndex = -1 Else cmb.SelectedIndex = cmb.FindStringExact(wertWD) End If End If Case "System.Windows.Forms.DataGridView" controltype = "DataGridView" Dim dgv As DataGridView = inctrl If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then If LoadIDX = False Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If Dim wertWD = aktivesDokument.GetVariableValue(idxname) If wertWD Is Nothing = False Then 'Es wird gegen ein Vektorfeld nachindexiert If wertWD.GetType.ToString.Contains("System.Object") Then Select Case Typ 'Tabellendarstellung Case "TABLE" Dim dt As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBPM_CONTROL_TABLE WHERE CONTROL_ID = " & CONTROL_ID) Dim SpaltenWerte As String() If dt.Rows.Count > 1 Then For Each Zeile As Object In wertWD SpaltenWerte = Split(Zeile, Delimiter) Select Case dt.Rows.Count Case 2 If SpaltenWerte.Length = 2 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1)}) Else dgv.Rows.Add(New String() {SpaltenWerte(0), ""}) End If Case 3 If SpaltenWerte.Length = 3 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2)}) ElseIf SpaltenWerte.Length = 2 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), ""}) Else dgv.Rows.Add(New String() {SpaltenWerte(0), "", ""}) End If Case 4 If SpaltenWerte.Length = 4 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), SpaltenWerte(3)}) ElseIf SpaltenWerte.Length = 3 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), ""}) ElseIf SpaltenWerte.Length = 2 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), "", ""}) Else dgv.Rows.Add(New String() {SpaltenWerte(0), "", "", ""}) End If End Select Next End If Case Else 'es handelt sich um ein einfaches Vektorfeld mit einem Wert For Each obj As Object In wertWD If obj Is Nothing = False Then dgv.Rows.Add(New String() {obj.ToString}) End If Next End Select End If End If End If Case "System.Windows.Forms.CheckBox" controltype = "CheckBox" If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then If LoadIDX = False Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If Dim chk As CheckBox = inctrl Dim wertWD If idxname.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then wertWD = ReturnVektor_IndexValue(idxname) Else wertWD = aktivesDokument.GetVariableValue(idxname) End If If wertWD Is Nothing Then ClassLogger.Add(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & indexname & "' ist nothing. Check defaultvalue", False) chk.Checked = False Else If wertWD.ToString = "" Then chk.Checked = False Else Dim _value If wertWD.ToString = "System.Object[]" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> CheckBoxValue with VektorField: " & idxname, False) If wertWD.length = 1 Then _value = wertWD(0) Else ' ClassLogger.Add(" >> Vectorfield " & idxname & "' contains more then one value - First value will be used", False) _value = wertWD(0) End If Else _value = wertWD End If Try Select Case CBool(_value) Case True chk.Checked = True Case False chk.Checked = False Case Else chk.Checked = False End Select Catch ex As Exception ClassLogger.Add(">> Unvorhergesehener Fehler bei CBool(wertWD) - CheckBox: " & ex.Message & vbNewLine & "Wert WD: " & wertWD.ToString, True) chk.Checked = False End Try End If End If End If Case "System.Windows.Forms.DateTimePicker" controltype = "DateTimePicker" Dim DTP As DateTimePicker = inctrl If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then Dim wertWD Try If idxname.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> DATE über PM-Vektor holen", False) wertWD = ReturnVektor_IndexValue(idxname) ClassLogger.Add(">> DTP is """, False) Else wertWD = aktivesDokument.GetVariableValue(idxname) End If If wertWD Is Nothing Then wertWD = "" Dim tempdate As Date = CDate("01.01.0001 00:00:00") If wertWD.ToString.Length > 0 Then Try tempdate = CDate(wertWD) If LogErrorsOnly = False Then ClassLogger.Add(" >> DATE konnte umgewandelt werden", False) Catch ex As Exception ValueDTP = tempdate If LogErrorsOnly = False Then ClassLogger.Add(" >> DATE wurde auf heute gesetzt", False) End Try DTP.Text = tempdate Else If LogErrorsOnly = False Then ClassLogger.Add(" >> DATE ist leer", False) ValueDTP = tempdate DTP.Text = tempdate End If Catch ex As Exception errormessage = "Unvorhergesehener Fehler bei DTP: " & vbNewLine & ex.Message ClassLogger.Add(">> Unvorhergesehener Fehler bei FillIndex DTP: " & ex.Message & vbNewLine & "Wert WD: " & wertWD.ToString & vbNewLine & "Indexname: " & idxname, True) frmError.ShowDialog() ClassLogger.Add(">> Unvorhergesehener Fehler bei FillIndex DTP: " & ex.Message, True) End Try End If 'Case Else ' MsgBox(Type) End Select Next set_foreground() If first_control Is Nothing = False Then first_control.Focus() 'Flag setzen das Indexe geladen sind _Indexe_Loaded = True Else MsgBox("Für dieses Profil wurde noch keine Eingabemaske definiert!" & vbNewLine & "Informieren Sie Ihren PM-Administrator!" & vbNewLine & "Das Fenster wird geschlossen!", MsgBoxStyle.Exclamation, "Achtung:") Me.Close() End If Catch ex As Exception errormessage = "Unvorhergesehener Fehler bei FillIndexValues:" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() ClassLogger.Add(">> Unvorhergesehener Fehler bei FillIndexValues: " & ex.Message, True) ClassLogger.Add(">> Controltype: " & controltype, False) ClassLogger.Add(">> Indexname windream: " & indexname, False) End Try End Sub Private Sub frmValidation_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown Refresh_FileList() Load_Next_Document(True) End Sub Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click btnSave.Enabled = False Abschluss() btnSave.Enabled = True End Sub Sub CloseWDDocview() Try If Viewer = "docview" Then If aktivesDokument.aPath.EndsWith("pdf") = False Or vpdfviewer = "none" Then If DocView Is Nothing = False Then DocView.CloseView(aktivesDokument.aPath, 0) End If Else If DocView Is Nothing = False Then DocView.CloseView(aktivesDokument.aPath, 0) End If End If End If Catch ex As Exception ClassLogger.Add(" ### FEHLER in CloseDocView") ClassLogger.Add("### " & ex.Message & " ###") End Try End Sub Sub Abschluss() btnSave.Enabled = False If LogErrorsOnly = False Then ClassLogger.Add(" >> Abschluss für Dok: " & aktivesDokument.aName & " gestartet", False) 'Eingaben auf Form überprüfen If Check_UpdateIndexe() = False Then 'lblerror.Visible = False 'Try Dim _error As Boolean = False Me.TBPM_PROFILE_FINAL_INDEXINGTableAdapter.Fill(Me.DD_DMSLiteDataSet.TBPM_PROFILE_FINAL_INDEXING, CURRENT_ProfilName) Dim dtfinal As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_FINAL_INDEXING If dtfinal.Rows.Count > 0 Then 'Jetzt finale Indexe setzen If LogErrorsOnly = False Then ClassLogger.Add(" >> Finale(r) Index(e) für Dok: " & aktivesDokument.aName & " soll gesetzt werden", False) For Each dr As DataRow In dtfinal.Rows Dim value As String = dr.Item("VALUE").ToString If value.ToUpper = "SQL-Command".ToUpper Then '###### Indexierung mit variablen SQL ### If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung mit dynamischem SQL!", False) Dim SQL_COMMAND = dr.Item("SQL_COMMAND") ' 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(SQL_COMMAND) '#### ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen For Each element As System.Text.RegularExpressions.Match In elemente Try If LogErrorsOnly = False Then ClassLogger.Add(" >> element in RegeX: " & element.Value, False) Dim WDINDEXNAME = element.Value.Substring(2, element.Value.Length - 3) Dim wertWD = aktivesDokument.GetVariableValue(WDINDEXNAME) If Not IsNothing(wertWD) Then SQL_COMMAND = SQL_COMMAND.ToString.Replace(element.Value, wertWD) Else ClassLogger.Add(">> Achtung Indexwert ist nothing!", False) End If Catch ex As Exception ClassLogger.Add("Unexpected Error in Checking control values for Variable SQL Result - ERROR: " & ex.Message) End Try Next Dim dynamic_value = ClassDatabase.Execute_Scalar(SQL_COMMAND, MyConnectionString, True) If Not IsNothing(dynamic_value) Then value = dynamic_value End If Else If value.StartsWith("v") Then Select Case dr.Item("VALUE").ToString Case "vDate" value = Now.ToShortDateString Case "vUserName" value = Environment.UserName Case Else value = dr.Item("VALUE") End Select End If End If Dim result() As String ReDim Preserve result(0) result(0) = value If dr.Item("INDEXNAME").ToString.StartsWith("[%VKT") Then Dim PM_String = Return_PM_VEKTOR(value, dr.Item("INDEXNAME")) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(PM_String, PROFIL_VEKTORINDEX) = False Then If LogErrorsOnly = False Then ClassLogger.Add(" >> FINALER INDEX '" & dr.Item("INDEXNAME").ToString.Replace("[%VKT", "") & "' WURDE ERFOLGREICH GESETZT", False) Else errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() _error = True End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Jetzt das indexieren", False) If Indexiere_File(aktivesDokument, dr.Item("INDEXNAME"), result) = True Then If LogErrorsOnly = False Then ClassLogger.Add(" >> FINALER INDEX '" & dr.Item("INDEXNAME") & "' WURDE ERFOLGREICH GESETZT", False) If LogErrorsOnly = False Then ClassLogger.Add("") 'Nun das Logging If PROFIL_LOGINDEX <> "" Then Dim logstr = Return_LOGString(value, "DDFINALINDEX", dr.Item("INDEXNAME")) Indexiere_VektorfeldPM(logstr, PROFIL_LOGINDEX) End If Else errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() _error = True End If End If If _error = True Then Exit For End If Next End If 'Wenn kein Fehler nach der finalen Indexierung gesetzt wurde If _error = False Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Tabelle updaten und co", False) 'Das Dokument freigeben und als editiert markieren Dim sql = String.Format("UPDATE TBPM_PROFILE_FILES SET IN_WORK = 0, WORK_USER = '{0}', EDIT = 1 WHERE GUID = {1}", Environment.UserName, CURRENT_DOC_GUID) ClassDatabase.Execute_non_Query(sql) 'TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(False, "", Document_ID) ''Das Dokument 'TBPM_PROFILE_FILESTableAdapter.CmdSetEdit(Document_ID) Dim WORK_HISTORY_ENTRY = Nothing Try WORK_HISTORY_ENTRY = DTPROFIL.Rows(0).Item("WORK_HISTORY_ENTRY") If IsDBNull(WORK_HISTORY_ENTRY) Then WORK_HISTORY_ENTRY = Nothing End If Catch ex As Exception WORK_HISTORY_ENTRY = Nothing End Try If Not IsNothing(WORK_HISTORY_ENTRY) Then If WORK_HISTORY_ENTRY <> String.Empty Then 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(WORK_HISTORY_ENTRY) '#### ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen For Each element As System.Text.RegularExpressions.Match In elemente Try If LogErrorsOnly = False Then ClassLogger.Add(" >> element in RegeX WORK_HISTORY_ENTRY: " & element.Value, False) Dim CTRL_ID = element.Value.Substring(2, element.Value.Length - 3) CTRL_ID = CTRL_ID.Replace("CTRLID", "") Dim value_from_control For Each inctrl As Control In Me.pnldesigner.Controls If IsNothing(inctrl.Tag) Then Continue For End If If inctrl.Tag = CTRL_ID Then '###### Dim Type As String = inctrl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" Try value_from_control = inctrl.Text Catch ex As Exception value_from_control = String.Empty End Try Case "System.Windows.Forms.ComboBox" Dim cmb As ComboBox = inctrl Try value_from_control = cmb.Text Catch ex As Exception value_from_control = String.Empty End Try Case "System.Windows.Forms.DateTimePicker" Dim dtp As DateTimePicker = inctrl Try value_from_control = dtp.Value.ToString Catch ex As Exception value_from_control = String.Empty End Try Case "System.Windows.Forms.CheckBox" Dim chk As CheckBox = inctrl Try value_from_control = chk.Checked Catch ex As Exception value_from_control = String.Empty End Try End Select End If Next If Not IsNothing(value_from_control) And value_from_control <> String.Empty Then WORK_HISTORY_ENTRY = WORK_HISTORY_ENTRY.ToString.Replace(element.Value, value_from_control) End If Catch ex As Exception ClassLogger.Add("Unexpected Error in Checking control values for WORK_HISTORY_ENTRY - ERROR: " & ex.Message) End Try Next If WORK_HISTORY_ENTRY.ToString.Contains("@DATE") Then WORK_HISTORY_ENTRY.ToString.Replace("@DATE", Now.ToShortDateString) End If If WORK_HISTORY_ENTRY.ToString.Contains("@USERNAME") Then WORK_HISTORY_ENTRY.ToString.Replace("@USERNAME", Environment.UserName) End If Else WORK_HISTORY_ENTRY = "" End If End If Dim ins = String.Format("INSERT INTO TBPM_FILES_WORK_HISTORY (PROFIL_ID, DOC_ID,WORKED_BY,WORKED_WHERE,STATUS_COMMENT) VALUES ({0},{1},'{2}','{3}','{4}')", CURRENT_ProfilGUID, CURRENT_DOC_ID, Environment.UserName, Environment.MachineName, WORK_HISTORY_ENTRY) ClassDatabase.Execute_non_Query(ins) Close_document_viewer() If Document_Path.ToLower.EndsWith(".pdf") Then If Not IsNothing(WORK_HISTORY_ENTRY) Then If CBool(DTPROFIL.Rows(0).Item("ANNOTATE_WORK_HISTORY_ENTRY")) = True Then sql = String.Format("SELECT * FROM TBPM_FILES_WORK_HISTORY WHERE GUID = (SELECT MAX(GUID) FROM TBPM_FILES_WORK_HISTORY WHERE PROFIL_ID = {0} AND DOC_ID = {1})", CURRENT_ProfilGUID, CURRENT_DOC_ID) Dim DT_ENTRY As DataTable = ClassDatabase.Return_Datatable(sql, True) If Not IsNothing(DT_ENTRY) Then If DT_ENTRY.Rows.Count = 1 Then Dim AnnotationString = DT_ENTRY.Rows(0).Item("WORKED_WHEN") & " " & DT_ENTRY.Rows(0).Item("WORKED_BY") & ": " & DT_ENTRY.Rows(0).Item("STATUS_COMMENT") ClassAnnotation.Annotate_PDF("Workflow-State:", AnnotationString, 0) End If End If End If Dim value = DTPROFIL.Rows(0).Item("ANNOTATE_ALL_WORK_HISTORY_ENTRIES") If CBool(value) = True Then sql = String.Format("SELECT * FROM TBPM_FILES_WORK_HISTORY WHERE DOC_ID = {1} ORDER BY GUID", CURRENT_ProfilGUID, CURRENT_DOC_ID) Dim DT_ENTRIES As DataTable = ClassDatabase.Return_Datatable(sql, True) If Not IsNothing(DT_ENTRIES) Then If DT_ENTRIES.Rows.Count > 0 Then Dim AnnotationString As String = "" For Each rw As DataRow In DT_ENTRIES.Rows AnnotationString = AnnotationString & rw.Item("WORKED_WHEN") & " " & rw.Item("WORKED_BY") & ": " & rw.Item("STATUS_COMMENT") & vbNewLine Next ClassAnnotation.Annotate_PDF("Workflow History:", AnnotationString, 0, 10, 40) End If End If End If End If End If 'wenn Move2Folder aktiviert wurde If Move2Folder <> "" Then idxerr_message = allgFunk.Move2Folder(Document_Path, Move2Folder, CURRENT_ProfilGUID) If idxerr_message <> "" Then errormessage = "Fehler bei Move2Folder:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() _error = True End If End If 'Validierungsfile löschen wenn vorhanden allgFunk.Delete_xffres(Document_Path) If LogErrorsOnly = False Then ClassLogger.Add(" >> Delete_xffres ausgeführt", False) If LogErrorsOnly = False Then ClassLogger.Add(" >> All Input clear", False) Anzahl_validierte_Dok += 1 'tstrlbl_Info.Text = "Anzahl Dateien: " & TBPM_PROFILE_FILESTableAdapter.cmdGet_Anzahl(PROFIL_ID) If LogErrorsOnly = False Then ClassLogger.Add(" >> Anzahl hochgesetzt", False) If LogErrorsOnly = False Then ClassLogger.Add(" >> Validierung erfolgreich abgeschlossen", False) ClassLogger.Add("", False) If CURRENT_JUMP_DOC_GUID <> 0 Then Me.Close() Else 'Das nächste Dokument laden Load_Next_Document(False) set_foreground() If first_control Is Nothing = False Then first_control.Focus() End If End If 'Catch ex As Exception ' errormessage = "Unvorhergesehener Fehler bei Abschluss:" & ex.Message ' My.Settings.Save() ' frmError.ShowDialog() ' ClassLogger.Add(">> Unvorhergesehener Fehler bei Abschluss: " & ex.Message, True) 'End Try Else 'lblerror.Visible = True 'lblerror.Text = errmessage errormessage = errmessage frmError.ShowDialog() End If btnSave.Enabled = True End Sub Function Check_Missing(control As Control, typ As String) Select Case typ Case "txt" If control.Text = String.Empty Then Return True End If Return False End Select End Function Function Return_PM_VEKTOR(input As String, VKTBezeichner As String) Dim PM_String As String Try Dim Bezeichner As String = VKTBezeichner.Replace("[%VKT", "") PM_String = "DD-PM" & Delimiter & Bezeichner & Delimiter & input & Delimiter & Environment.UserName & Delimiter & Now.ToString Catch ex As Exception ClassLogger.Add(">> Fehler in Return_PM_VEKTOR: " & ex.Message, True) PM_String = "DD-PM ERROR: " & ex.Message End Try Return PM_String End Function Function Return_LOGString(input As String, old As String, indexname As String) Dim PM_String As String Try If old = "DDFINALINDEX" Then PM_String = "DD-PMlog-FINAL" & Delimiter & indexname & Delimiter & input & Delimiter & Environment.UserName & Delimiter & Now.ToString Else PM_String = "DD-PMlog-CHG" & Delimiter & indexname & Delimiter & "NEW: '" & input & "' - OLD: '" & old & "'" & Delimiter & Environment.UserName & Delimiter & Now.ToString End If Catch ex As Exception ClassLogger.Add(">> Fehler in Return_LOGString: " & ex.Message, True) PM_String = "DD-PM ERROR: " & ex.Message End Try Return PM_String End Function Private Function Indexiere_VektorfeldPM(input As String, NameVKTIndex As String) Dim missing As Boolean = False Dim Anzahl As Integer = 0 Dim myInputArr As String() 'Jeden Wert des Vektorfeldes durchlaufen Dim wertWD = aktivesDokument.GetVariableValue(NameVKTIndex) If wertWD Is Nothing = False Then 'Es wird gegen ein Vektorfeld nachindexiert If wertWD.GetType.ToString.Contains("System.Object") Then 'es handelt sich um ein Vektorfeld - Zuweisen der Indexwerte des Vektorfeldes zu Array For Each obj As Object In wertWD If obj Is Nothing = False Then 'Das Array anpassen ReDim Preserve myInputArr(Anzahl) 'Den Wert im Array speichern myInputArr(Anzahl) = obj.ToString Anzahl += 1 End If Next End If 'Das Array anpassen ReDim Preserve myInputArr(Anzahl) 'und den letzten Wert übergeben myInputArr(Anzahl) = input Else 'Das Array anpassen ReDim Preserve myInputArr(Anzahl) 'und den letzten Wert übergeben myInputArr(Anzahl) = input End If If myInputArr.Length > 0 Then 'Jetzt die Datei indexieren If Indexiere_File(aktivesDokument, NameVKTIndex, myInputArr) = False Then missing = True errmessage = "Fehler beim Indexieren Vektorfeld '" & NameVKTIndex & "' - ERROR: " & idxerr_message End If End If Return missing End Function Function Check_UpdateIndexe() Try Dim dt As DataTable = DD_DMSLiteDataSet.VWPM_CONTROL_INDEX Dim missing As Boolean = False 'Jedes Control auf panel durchlaufen For Each inctrl As Control In Me.pnldesigner.Controls 'Der input der Box,Cmb muss jedes mal geleert werden Dim input As String = "" 'Jedes Control in Konfig Tab durchlaufn For Each dr As DataRow In dt.Rows If dr.Item("CTRL_TYPE") = "LBL" Then Continue For End If 'Den Indexnamen auslesen Dim _IDXName As String = dr.Item("INDEX_NAME") Dim _MUSSEINGABE As Boolean = CBool(dr.Item("VALIDATION")) Dim _READ_ONLY As Boolean = CBool(dr.Item("READ_ONLY")) Dim Typ As String = dr.Item("CTRL_TYPE") Dim CONTROL_ID As String = dr.Item("GUID") Dim ctrl = dr.Item("CTRL_NAME") 'Nur wenn der Name der Zeile entspricht und der Index READ_ONLY FALSE ist If dr.Item("CTRL_NAME") = inctrl.Name And (_READ_ONLY = False Or dr.Item("SQL_UEBERPRUEFUNG") <> "") And _IDXName <> "DD PM-ONLY FOR DISPLAY" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung für Control (" & CONTROL_ID & ") '" & ctrl & "' gestartet. Indexname '" & _IDXName & "'", False) If _IDXName = "" Then ClassLogger.Add(" >> Indexname is unexpected empty.", False) Continue For End If Dim Type As String = inctrl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" Try 'Als erstes überprüfen ob überhaupt etwas eingetragen worden ist If Check_Missing(inctrl, "txt") = True And _MUSSEINGABE = True Then 'NICHTS EINGETRAGEN missing = True errmessage = "Missing input in textbox '" & inctrl.Name & "'" inctrl.BackColor = Color.Red Exit For Else input = inctrl.Text 'den aktuellen Wert in windream auslesen Dim wertWD If _IDXName.StartsWith("[%VKT") Then wertWD = ReturnVektor_IndexValue(_IDXName) Else wertWD = aktivesDokument.GetVariableValue(_IDXName) If Not IsNothing(wertWD) Then If wertWD.ToString = "System.Object[]" Then If wertWD.Length = 1 Then wertWD = wertWD(0) Else ' ClassLogger.Add(" >> Vectorfield " & _IDXName & "' contains more then one value - First value will be used", False) wertWD = wertWD(0) End If End If Else wertWD = "" End If End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If IsNothing(wertWD) Or wertWD <> input Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If _IDXName.StartsWith("[%VKT") Then input = Return_PM_VEKTOR(input, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren Textbox als VEKTOR - ERROR: " & idxerr_message Exit For End If Else Dim result() As String ReDim Preserve result(0) result(0) = input If Indexiere_File(aktivesDokument, _IDXName, result) = False Then missing = True errmessage = "Fehler beim Indexieren Textbox - ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, wertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) End If End If End If End If End If Catch ex As Exception Dim st As New StackTrace(True) st = New StackTrace(ex, True) MsgBox("Unvorhergesehener Fehler in Check_UpdateIndexe TextBox: " & vbNewLine & ex.Message & vbNewLine & "Line: " & st.GetFrame(0).GetFileLineNumber().ToString, MsgBoxStyle.Critical, "Error:") ClassLogger.Add("Unvorhergesehener Fehler in Check_UpdateIndexe:" & ex.Message & " - Line: " & st.GetFrame(0).GetFileLineNumber().ToString, True) Return True End Try Case "System.Windows.Forms.ComboBox" Dim cmb As ComboBox = inctrl 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If cmb.SelectedIndex = -1 And _MUSSEINGABE = True Then missing = True errmessage = "Please Choose an entry out of ComboBox '" & cmb.Name & "'" Exit For ElseIf cmb.SelectedIndex <> -1 Then input = cmb.Text Dim wertWD As String 'den aktuellen Wert in windream auslesen If _IDXName.StartsWith("[%VKT") Then wertWD = ReturnVektor_IndexValue(_IDXName) Else wertWD = aktivesDokument.GetVariableValue(_IDXName) End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If wertWD <> input Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If _IDXName.StartsWith("[%VKT") Then input = Return_PM_VEKTOR(input, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren Combobox als VEKTOR - ERROR: " & idxerr_message Exit For End If Else Dim result() As String ReDim Preserve result(0) result(0) = input If Indexiere_File(aktivesDokument, _IDXName, result) = False Then cmb.DroppedDown = True missing = True errmessage = "Fehler beim Indexieren Combobox - ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, wertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) End If End If End If End If End If Case "System.Windows.Forms.DateTimePicker" Dim dtp As DateTimePicker = inctrl 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If _MUSSEINGABE = True And dtp.Value.ToString = String.Empty Then missing = True errmessage = "Please Choose DateValue for field'" & dtp.Name & "'" Exit For ElseIf dtp.Value.ToString <> "01.01.0001 00:00:00" Then input = CDate(dtp.Value) 'den aktuellen Wert in windream auslesen ' Dim wertWD As String = aktivesDokument.GetVariableValue(_IDXName) Dim wertWD As String If _IDXName.StartsWith("[%VKT") Then wertWD = ReturnVektor_IndexValue(_IDXName) Else wertWD = aktivesDokument.GetVariableValue(_IDXName) End If If IsNothing(wertWD) Then wertWD = CDate("01.01.1900") End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If wertWD <> input Then 'Wenn der WErt in ein Vektorfeld geschrieben wird If _IDXName.StartsWith("[%VKT") Then 'Input = die String komponente als String input = Return_PM_VEKTOR(input, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren DatePicker als VEKTOR - ERROR: " & idxerr_message Exit For End If Else Dim result() ReDim Preserve result(0) result(0) = CDate(input) 'MsgBox(_IDXName) If Indexiere_File(aktivesDokument, _IDXName, result) = False Then missing = True errmessage = "Fehler beim Indexieren DatePicker- ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, wertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) End If End If End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Value WD ('" & wertWD.ToString & "') = Input-value ('" & input.ToString & "')", False) End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> DateValue is 01.01.0001 00:00:00", False) End If Case "System.Windows.Forms.CheckBox" Dim chk As CheckBox = inctrl input = chk.Checked.ToString 'den aktuellen Wert in windream auslesen Dim WertWD As String Dim Bool_WD As Boolean If _IDXName.StartsWith("[%VKT") Then WertWD = ReturnVektor_IndexValue(_IDXName) If WertWD = "" Then Bool_WD = False Else Bool_WD = CBool(WertWD) End If Else Dim _Value Dim ValueWD = aktivesDokument.GetVariableValue(_IDXName) If IsNothing(ValueWD) Then Bool_WD = False Else If ValueWD.ToString = "System.Object[]" Then If ValueWD.Length = 1 Then _Value = ValueWD(0) Else ' ClassLogger.Add(" >> Vectorfield " & _IDXName & "' contains more then one value - First value will be used", False) _Value = ValueWD(0) End If Else _Value = ValueWD End If Bool_WD = CBool(_Value) End If End If ' Dim Bool_WD = CBool(aktivesDokument.GetVariableValue(_IDXName)) 'wenn Wert in Windream <> der Eingabe darf indexiert werden If Bool_WD <> chk.Checked Then Dim result() As String ReDim Preserve result(0) If chk.Checked Then result(0) = 1 Else result(0) = 0 End If If _IDXName.StartsWith("[%VKT") Then 'Input = die String komponente mit Boolean als String input = Return_PM_VEKTOR(chk.Checked.ToString, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren Checkbox als VEKTOR - ERROR: " & idxerr_message Exit For End If Else If Indexiere_File(aktivesDokument, _IDXName, result) = False Then missing = True errmessage = "Fehler beim Indexieren Checkbox - ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(CBool(result(0)).ToString, WertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) End If End If End If End If Case "System.Windows.Forms.DataGridView" Dim dgv As DataGridView = inctrl Dim Zeilen As Integer = 0 For Each row As DataGridViewRow In dgv.Rows Dim exists = False ' MsgBox(row.Cells(0).Value.GetType.ToString) If row.Cells(0).Value Is Nothing = False Then Zeilen += 1 End If Next 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If _MUSSEINGABE = True And Zeilen = 0 Then missing = True errmessage = "Missing input in vectorfield'" & dgv.Name & "'" Exit For ElseIf Zeilen > 0 Then Dim ZeilenGrid As Integer = 0 Dim myVektorArr As String() 'Jeden Werte des Datagridviews durchlaufen For Each row As DataGridViewRow In dgv.Rows Dim exists = False Select Case Typ Case "TABLE" ' MsgBox(row.Cells(0).Value.GetType.ToString) Dim str As String If row.Cells(0).Value Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) For i = 0 To row.Cells.Count - 1 Select Case i Case 0 str = row.Cells(i).Value Case Else str = str & Delimiter & row.Cells(i).Value End Select Next 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = str ZeilenGrid += 1 End If Case Else ' MsgBox(row.Cells(0).Value.GetType.ToString) If row.Cells(0).Value Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = row.Cells(0).Value.ToString ZeilenGrid += 1 End If End Select Next 'Jetzt die Datei indexieren If Indexiere_File(aktivesDokument, _IDXName, myVektorArr) = False Then missing = True errmessage = "Fehler beim Indexieren Vektorfeld - ERROR: " & idxerr_message Exit For End If End If End Select End If 'End If für Control und ReadOnly = False Next Next Return missing Catch ex As Exception Dim st As New StackTrace(True) st = New StackTrace(ex, True) MsgBox("Unvorhergesehener Fehler in Check_UpdateIndexe: " & vbNewLine & ex.Message & vbNewLine & "Line: " & st.GetFrame(0).GetFileLineNumber().ToString, MsgBoxStyle.Critical, "Error:") ClassLogger.Add("Unvorhergesehener Fehler in Check_UpdateIndexe:" & ex.Message & " - Line: " & st.GetFrame(0).GetFileLineNumber().ToString, True) Return True End Try End Function Private Function Indexiere_File(_dok As WINDREAMLib.WMObject, idxxname As String, idxvalue As Object) Dim File_indexiert As Boolean = False idxerr_message = "" Try 'Die Arrays vorbereiten Dim arrIndex() As String = Nothing Dim arrValue() As String = Nothing arrIndex = Nothing arrValue = Nothing 'Den Indexnamen übergeben ReDim Preserve arrIndex(0) arrIndex(0) = idxxname 'Das Array der Idnexwerte überprüfen If idxvalue Is Nothing = False Then If idxvalue.Length() > 1 Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexing Index '" & idxxname & "' with Arrayvalue", False) Dim anzahl As Integer = 0 For Each indexvalue As String In idxvalue ReDim Preserve arrValue(anzahl) arrValue(anzahl) = indexvalue anzahl += 1 Next Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexing Index '" & idxxname & "' with value '" & idxvalue(0) & "'", False) ReDim Preserve arrValue(0) arrValue(0) = idxvalue(0).ToString End If 'Jetzt das eigentliche Indexieren der Datei File_indexiert = Me._windreamPM.RunIndexing(_dok, arrIndex, arrValue) If File_indexiert = False Then allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Fehler beim Indexieren der Datei: " & _dok.aName & " - ERROR: " & idxerr_message, Environment.UserName) End If Return File_indexiert End If Catch ex As Exception allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Unvorhergesehener Fehler beim Indexieren der Datei: " & _dok.aName & " - ERROR: " & ex.Message, Environment.UserName) idxerr_message = "unvorhergesehener Fehler in Indexiere_File: " & ex.Message.ToString ClassLogger.Add(">> Unvorhergesehener Fehler bei Indexiere_File: " & ex.Message.ToString, True) Return Err() End Try End Function Private Sub btnfinal_Click(sender As System.Object, e As System.EventArgs) Abschluss() End Sub Function GetConnectionString(id As Integer) Try Dim connectionString As String Dim DTConnection As DataTable DTConnection = DD_DMSLiteDataSet.TBPM_CONNECTION Dim drConnection As DataRow For Each drConnection In DTConnection.Rows If drConnection.Item("GUID") = id Then Select Case drConnection.Item("SQL_PROVIDER") Case "SqlClient.SqlConnection" connectionString = "%MSData Source=" & drConnection.Item("SERVER") & ";Initial Catalog= " & drConnection.Item("DATENBANK") & ";User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";" Case "Oracle" connectionString = "%ORProvider=OraOLEDB.Oracle;Data Source=" & drConnection.Item("SERVER") & ";User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";OLEDB.NET=True;" ' connectionString = "%ORData Source=" & drConnection.Item("SERVER") & ";Persist Security Info=True;User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";Unicode=True" Case Else ClassLogger.Add(" - ConnectionType '" & drConnection.Item("SQL_PROVIDER") & "' nicht integriert", False) MsgBox("ConnectionType '" & drConnection.Item("SQL_PROVIDER") & "' nicht integriert", MsgBoxStyle.Critical, "Bitte Konfiguration Connection überprüfen!") End Select End If Next Return connectionString Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Fehler bei GetConnectionString - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei GetConnectionString:") Return "" End Try End Function Private Sub btnNavigatorfirst_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "first" End If End Sub Private Sub btnNavigatorprevious_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "previous" End If End Sub Private Sub btnNavigatornext_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "next" End If End Sub Private Sub btnNavigatorlast_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "last" End If End Sub Private Sub frmValidation_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown If e.Button = Windows.Forms.MouseButtons.Left Then navStep = Nothing End If End Sub Private Sub DateiÖffnenToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles DateiÖffnenToolStripMenuItem.Click Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(Document_Path) Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() ClassLogger.Add(" - Datei wurde geöffnet!", False) Catch ex As Exception MsgBox("Fehler bei Datei öffnen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add("Fehler bei Datei öffnen: " & ex.Message, True) End Try End Sub Sub Datei_ueberspringen() Try If LogErrorsOnly = False Then ClassLogger.Add(" >> Dokument überspringen", False) Close_document_viewer() If LogErrorsOnly = False Then ClassLogger.Add(" >> Doc Viewer geschlossen", False) 'Das Dokument freigeben TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(False, "", CURRENT_DOC_GUID) TBPM_FILES_USER_NOT_INDEXEDTableAdapter.cmdInsert(Environment.UserName, CURRENT_ProfilGUID, Document_Path) If LogErrorsOnly = False Then ClassLogger.Add(" >> Dokument freigegeben", False) ClassLogger.Add("", False) Load_Next_Document(False) Catch ex As Exception MsgBox("Fehler bei Überspringen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub delete_active_File() Try Dim result As MsgBoxResult result = MessageBox.Show("Sind Sie sicher dass Sie dieses Dokument unwiderruflich löschen wollen?" & vbNewLine & "Danach wird die nächste Datei angezeigt!", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Close_document_viewer() 'Aus der Tabelle löschen TBPM_PROFILE_FILESTableAdapter.CmdDelete(CURRENT_DOC_GUID) Dim resul = allgFunk.Delete_xffres(Document_Path) If resul = Nothing Or resul = True Then If Delete_File() = True Then 'MsgBox("Die Datei wurde erfolgreich aus windream gelöscht!" & vbNewLine & "Es wird nun die nächste Datei angezeigt!", MsgBoxStyle.Information, "Erfolgsmeldung:") Load_Next_Document(False) End If End If End If Catch ex As Exception MsgBox("Fehler bei Löschen windream-Datei:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Function Delete_File() Try If aktivesDokument Is Nothing = False Then Close_document_viewer() Me.PdfViewer1.DocumentFilePath = "" Try If aktivesDokument.aLocked Then ' unlock the windream object aktivesDokument.unlock() End If aktivesDokument.Delete() ClassLogger.Add(">> Manuelles Löschen: Datei " & aktivesDokument.aName & " erfolgreich gelöscht", False) Return True Catch ex As Exception MsgBox("Das windream-Objekt konnte nicht gelöscht werden!" & vbNewLine & vbNewLine & "Fehlermeldung:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add(" windream-Objekt konnte nicht gelöscht werden - Fehlermeldung: " & ex.Message, True) Return False End Try End If Catch ex As Exception ClassLogger.Add(" Fehler bei Delete_File", True) ClassLogger.Add(">> Fehlermeldung: " & ex.Message, False) Return False End Try End Function Private Const SEE_MASK_INVOKEIDLIST = &HC Private Const SEE_MASK_NOCLOSEPROCESS = &H40 Private Const SEE_MASK_FLAG_NO_UI = &H400 Public Const SW_SHOW As Short = 5 Public Shared Function ShellExecuteEx(ByRef lpExecInfo As SHELLEXECUTEINFO) As Boolean End Function Public Structure SHELLEXECUTEINFO Public cbSize As Integer Public fMask As Integer Public hwnd As IntPtr Public lpVerb As String Public lpFile As String Public lpParameters As String Public lpDirectory As String Dim nShow As Integer Dim hInstApp As IntPtr Dim lpIDList As IntPtr Public lpClass As String Public hkeyClass As IntPtr Public dwHotKey As Integer Public hIcon As IntPtr Public hProcess As IntPtr End Structure Private Sub DateieigenschaftenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DateieigenschaftenToolStripMenuItem.Click If Document_Path <> "" Then Cursor = Cursors.WaitCursor Dim sei As New SHELLEXECUTEINFO sei.cbSize = Marshal.SizeOf(sei) sei.lpVerb = "properties" sei.lpFile = Document_Path sei.nShow = SW_SHOW sei.fMask = SEE_MASK_INVOKEIDLIST If Not ShellExecuteEx(sei) Then Dim ex As New System.ComponentModel.Win32Exception(System.Runtime.InteropServices.Marshal.GetLastWin32Error()) MsgBox("Fehler in Datei-Eigenschaften öffnen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End If End If Cursor = Cursors.Default End Sub Private Sub frmValidation_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd If Document_Path Is Nothing = False Then Select Case Path.GetExtension(Document_Path).ToLower Case ".pdf" Select Case vpdfviewer Case "internal" My.Settings.frmValidation_Size_PDFViewer = Me.Size Case "pdfxchange" My.Settings.frmValidatorSize = Me.Size Case "sumatra" My.Settings.frmValidatorSize = Me.Size Case "system" My.Settings.frmValidatorSize = Me.Size End Select Case ".msg" My.Settings.frmValidation_Size_Email = Me.Size Case Else My.Settings.frmValidatorSize = Me.Size End Select My.Settings.Save() End If End Sub Private Sub Splitter1_LocationChanged(sender As Object, e As EventArgs) My.Settings.Save() End Sub Private Sub PdfViewer1_DocumentChanged(sender As Object, e As DevExpress.XtraPdfViewer.PdfDocumentChangedEventArgs) Handles PdfViewer1.DocumentChanged PDF_Pagenumber() End Sub Private Sub PdfViewer1_CurrentPageChanged(sender As Object, e As DevExpress.XtraPdfViewer.PdfCurrentPageChangedEventArgs) Handles PdfViewer1.CurrentPageChanged PDF_Pagenumber() End Sub Sub PDF_Pagenumber() Try pdfstatuslblPageNumber.Text = "Page " & PdfViewer1.CurrentPageNumber & "/" & PdfViewer1.PageCount Catch ex As Exception End Try End Sub Private Sub MinimumToolStripMenuItem_Click(sender As Object, e As EventArgs) PdfViewer1.ZoomFactor = 20 End Sub Private Sub PdfViewer1_ZoomChanged_1(sender As Object, e As DevExpress.XtraPdfViewer.PdfZoomChangedEventArgs) Handles PdfViewer1.ZoomChanged If Not PdfViewer1.ZoomMode = DevExpress.XtraPdfViewer.PdfZoomMode.Custom Then End If Dim sdds = PdfViewer1.ZoomFactor SaveMySettingsValue("PDFViewer_ZoomMode", PdfViewer1.ZoomFactor) PDFViewer_ZoomMode = PdfViewer1.ZoomFactor End Sub Private Sub ToolStripDropDownButton1_Click(sender As Object, e As EventArgs) Handles ToolStripDropDownButton1.Click PdfViewer1.ZoomFactor = 20 End Sub Private Sub frmValidator_KeyUp(sender As Object, e As KeyEventArgs) Handles MyBase.KeyUp If e.KeyCode = Keys.F1 Then btnSave.Enabled = False Abschluss() btnSave.Enabled = True ElseIf e.KeyCode = Keys.F4 Then Datei_ueberspringen() End If End Sub Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButtonJumpFile.Click Datei_ueberspringen() End Sub Private Sub ToolStripButtonDeleteFile_Click(sender As Object, e As EventArgs) Handles ToolStripButtonDeleteFile.Click delete_active_File() End Sub Private Sub ToolStripButtonAnnotation_Click(sender As Object, e As EventArgs) Handles ToolStripButtonAnnotation.Click PdfViewer1.CloseDocument() Close_PDF_Viewer(Document_Path) Application.DoEvents() frmAnnotations.ShowDialog() load_viewer() End Sub End Class