Imports System.IO Imports System.Runtime.InteropServices Public Class frmRecordView Private recordView As ClassRecordView Private ENTITY_ID, FORMVIEW_ID, PARENT_ENTITY_ID As Integer Private RESULT_DOC_PATH As String 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 frmRecordView_Load(sender As Object, e As EventArgs) Handles MyBase.Load If USER_LANGUAGE <> "de-DE" Then Me.Text = "Detailview Record" Else Me.Text = "Detailansicht Record" End If recordView = New ClassRecordView(pnlDetails) recordView.LoadRecord(JUMP_RECORD_ID) 'Titel updaten Me.Text &= " " + recordView.RecordId.ToString() RUN_WDSEARCH_GRID() Load_Tasks() End Sub Private Sub RUN_WDSEARCH_GRID() Me.Cursor = Cursors.WaitCursor Dim gridGUID = 2 Dim sql_ResultList = "select * from TBPMO_WINDREAM_RESULTLIST_CONFIG" Dim DT_WINDREAM_RESULTLIST_DEF As DataTable = ClassDatabase.Return_Datatable(sql_ResultList, "GETRESULTLIST KONFIG") Dim DT_WINDREAM_RESULTLIST As DataTable If USER_LANGUAGE <> "de-DE" Then gridGUID = 3 End If For Each row As DataRow In DT_WINDREAM_RESULTLIST_DEF.Rows If row.Item(0) <> gridGUID Then row.Delete() End If Next DT_WINDREAM_RESULTLIST_DEF.AcceptChanges() If DT_WINDREAM_RESULTLIST_DEF.Rows.Count = 1 Then DT_WINDREAM_RESULTLIST = DT_WINDREAM_RESULTLIST_DEF End If Try Dim sw As New Stopwatch sw.Start() Dim elapsed As Double Dim SQL_DOC_SEARCH = String.Format("SELECT * FROM VWPMO_WD_DOC_SEARCH WHERE [RECORD_ID] = {0}", JUMP_RECORD_ID) Dim DT_FILE_RESULT As DataTable = ClassDatabase.Return_Datatable_Connection(SQL_DOC_SEARCH, 1) If IsNothing(DT_FILE_RESULT) Then Dim msg = "wrong DocSearch-Configuration - Check logfile and contact Digital Data" tslblWindreamView.Text = msg Me.Cursor = Cursors.Default Exit Sub End If If DT_FILE_RESULT.Rows.Count > 0 Then 'Es gibt Suchergebnisse Dim msg = "Windream-Dokumente für Record: " & JUMP_RECORD_ID If USER_LANGUAGE <> "de-DE" Then msg = "windream-files for record: " & JUMP_RECORD_ID End If tslblWindreamView.Text = msg Dim DTGrid As New DataTable Dim ColArray As New List(Of String) Try 'Die Icon Colum erstellen und konfigurieren Dim colIcon As New System.Data.DataColumn() colIcon.DataType = GetType(Image) colIcon.ColumnName = "ICON" colIcon.Caption = "" DTGrid.Columns.Add(colIcon) ' Dim colPath As New System.Data.DataColumn() colPath.DataType = GetType(String) colPath.ColumnName = "FULLPATH" colPath.Caption = "Fullpath" DTGrid.Columns.Add(colPath) If Not DT_WINDREAM_RESULTLIST Is Nothing And DT_WINDREAM_RESULTLIST.Rows.Count = 1 Then Dim ColCount As Integer = 1 For Each Column As DataColumn In DT_WINDREAM_RESULTLIST.Columns If Column.ColumnName.StartsWith("COLUMN") And Column.ColumnName.EndsWith("WIDTH") = False Then Dim ColumnName = DT_WINDREAM_RESULTLIST.Rows(0).Item(Column.ColumnName) If Not IsDBNull(ColumnName) Then If Not IsDBNull(ColumnName) Or IsNothing(ColumnName) Or ColumnName <> "" Or ColumnName <> "{}" Then 'Jetzt die Spalten aus Array hinzufügen und Breite konfigurieren Dim Width = DT_WINDREAM_RESULTLIST.Rows(0).Item(String.Format("COLUMN{0}_WIDTH", ColCount)) If IsNothing(Width) Or IsDBNull(Width) Then Width = 200 End If 'Die Spalte definieren DTGrid.Columns.Add(ColumnName) ColCount += 1 End If End If End If Next 'Jetzt das Array zusammenbauen um die Spaltenwerte zu erhalten ColCount = 1 For Each Column As DataColumn In DT_WINDREAM_RESULTLIST.Columns If Column.ColumnName = String.Format("COLUMN{0}", ColCount) Then Dim ColumnName = DT_WINDREAM_RESULTLIST.Rows(0).Item(Column.ColumnName) If Not IsDBNull(ColumnName) Then If Not IsDBNull(ColumnName) Or IsNothing(ColumnName) Or ColumnName <> "" Or ColumnName <> "{}" Then 'Jetzt die Spalten aus Array hinzufügen und Breite konfigurieren ColArray.Add(Column.ColumnName) End If End If ColCount += 1 End If Next End If Catch ex As Exception MsgBox("Unexpected Error in Construct Datatable for GridResult: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try 'COL_ARRAY_RESULTLIST = ColArray For Each row As DataRow In DT_FILE_RESULT.Rows Dim fullpath = row.Item("FULL_FILENAME") 'Dim Folderpath = Path.GetDirectoryName(fullpath) Dim filename = Path.GetFileName(fullpath) Dim extension = Path.GetExtension(fullpath) ' Try Dim NewRow As DataRow NewRow = DTGrid.NewRow() 'Icon zuweisen Select Case extension Case ".csv" NewRow.Item(0) = My.Resources.doc_excel_csv Case ".txt" NewRow.Item(0) = My.Resources.text Case ".pdf" NewRow.Item(0) = My.Resources.pdf Case ".doc" NewRow.Item(0) = My.Resources.doc Case ".docx" NewRow.Item(0) = My.Resources.doc Case ".xls" NewRow.Item(0) = My.Resources.xls Case ".xlsx" NewRow.Item(0) = My.Resources.xls Case ".ppt" NewRow.Item(0) = My.Resources.ppt Case ".pptx" NewRow.Item(0) = My.Resources.ppt Case ".dwg" NewRow.Item(0) = My.Resources.dwg Case Else NewRow.Item(0) = My.Resources._blank End Select 'Den Filepath mitgeben NewRow.Item(1) = fullpath Dim i = 2 'Fängt bei 2 an, um die ICON Column zu überspringen For Each Column As String In ColArray Dim Colname = DT_WINDREAM_RESULTLIST.Rows(0).Item(Column) Dim rowvalue Try If Colname = "Dateiname" Or Colname = "filename" Then rowvalue = filename ElseIf Colname = "Dokumentart" Or Colname = "doctype" Then rowvalue = row.Item("Doctype") ElseIf Colname = "Erstellt" Or Colname = "created" Then rowvalue = row.Item("Creation_DateTime") Else rowvalue = row.Item(Colname) End If If LogErrorsOnly = False Then ClassLogger.Add(" >> rowvalue : '" & rowvalue.ToString & "'", False) Catch ex As Exception ClassLogger.Add("Unexpected Error in GetVariableValue for Column '" & Colname & "- Error: " & ex.Message) If Colname.ToString.StartsWith("doct") Or Colname.ToString.StartsWith("Dokum") Then rowvalue = "" Else rowvalue = "Error getting rowvalue" End If End Try NewRow.Item(i) = rowvalue.ToString i += 1 Next DTGrid.Rows.Add(NewRow) ' Catch ex As Exception ' ClassLogger.Add("Unexpected Error in CreateRow for doc '" & filename & "- Error: " & ex.Message) ' End Try Next If DTGrid.Rows.Count > 0 Then GridControlDocSearch.DataSource = DTGrid ' Größe der Icon Column anpassen GridViewDoc_Search.Columns.Item("ICON").MaxWidth = 24 GridViewDoc_Search.Columns.Item("ICON").MinWidth = 24 GridViewDoc_Search.Columns.Item("FULLPATH").Visible = False For Each col As DataColumn In DT_WINDREAM_RESULTLIST.Columns If col.ColumnName.EndsWith("WIDTH") Or col.ColumnName.StartsWith("ADDED") Or col.ColumnName.StartsWith("CHANGED") Then Continue For End If Dim rowvalue = DT_WINDREAM_RESULTLIST.Rows(0).Item(col.ColumnName) If IsDBNull(rowvalue) Or IsNumeric(rowvalue) Then Continue For End If Dim Width = DT_WINDREAM_RESULTLIST.Rows(0).Item(String.Format("{0}_WIDTH", col.ColumnName)) If Not IsNothing(Width) And Not IsDBNull(Width) Then Dim column = DirectCast(GridViewDoc_Search.Columns.Item(rowvalue), DevExpress.XtraGrid.Columns.GridColumn) column.Width = Width Console.WriteLine("ColumnWidth {0} set to {1}", column.FieldName, Width) Console.WriteLine("ColumnWidth {0} really set to {1}", column.FieldName, column.VisibleWidth) End If Next End If Else Dim msg = "Keine Windream-Dokumente für Record: " & JUMP_RECORD_ID & " gefunden" If USER_LANGUAGE <> "de-DE" Then msg = "No windream-files found for record: " & JUMP_RECORD_ID End If tslblWindreamView.Text = msg GridControlDocSearch.DataSource = Nothing 'Clear_Windream_ResultList() End If elapsed = sw.Elapsed.TotalSeconds sw.Stop() sw.Reset() If LogErrorsOnly = False Then ClassLogger.Add(" >> Run RUN_WDSEARCH_GRID took " & Format(elapsed, "0.000000000") & " seconds", False) Catch ex As Exception MsgBox("Unexpected Error in Run WD-Search Database: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Cursor = Cursors.Default End Sub Private Sub Load_Tasks() Try Me.TBPMO_WORKFLOW_TASK_STATETableAdapter.Connection.ConnectionString = MyConnectionString Me.VWPMO_WF_ACTIVETableAdapter.Connection.ConnectionString = MyConnectionString Me.VWPMO_WF_ACTIVETableAdapter.FillByRecord(Me.DD_DMSDataSet.VWPMO_WF_ACTIVE, USER_LANGUAGE, Environment.UserName, JUMP_RECORD_ID) Dim sql = "SELECT FORM_ID FROM TBPMO_RECORD WHERE GUID = " & JUMP_RECORD_ID ENTITY_ID = ClassDatabase.Execute_Scalar(sql) sql = "SELECT GUID FROM TBPMO_FORM_VIEW WHERE SCREEN_ID = 1 AND FORM_ID = " & ENTITY_ID FORMVIEW_ID = ClassDatabase.Execute_Scalar(sql) sql = "SELECT PARENT_ID FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID PARENT_ENTITY_ID = ClassDatabase.Execute_Scalar(sql) Catch ex As Exception MsgBox("Error in Load_Tasks:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub TabControl1_SelectedPageChanged(sender As Object, e As DevExpress.XtraTab.TabPageChangedEventArgs) Handles TabControl1.SelectedPageChanged If TabControl1.SelectedTabPageIndex = 1 Then If DD_DMSDataSet.VWPMO_WF_ACTIVE.Rows.Count = 0 Then COMMENTTextBox.Enabled = False DUE_DATEDateTimePicker.Enabled = False DateTimePickerTASK_DATE.Enabled = False STATE_IDComboBox.Enabled = False lblnoTasks.Visible = True btnSaveWorkflow.Enabled = False Else Try If WF_IDTextBox.Text <> "" Then Me.TBPMO_WORKFLOW_TASK_STATETableAdapter.FillBy(Me.DD_DMSDataSet.TBPMO_WORKFLOW_TASK_STATE, USER_LANGUAGE, WF_IDTextBox.Text, ENTITY_ID) End If Catch ex As Exception MsgBox("Error in load States:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try COMMENTTextBox.Enabled = True DUE_DATEDateTimePicker.Enabled = True DateTimePickerTASK_DATE.Enabled = True STATE_IDComboBox.Enabled = True lblnoTasks.Visible = False btnSaveWorkflow.Enabled = True End If End If End Sub Private Sub btnSaveWorkflow_Click(sender As Object, e As EventArgs) Handles btnSaveWorkflow.Click Try Dim upd = String.Format("UPDATE TBPMO_WORKFLOW_TASK SET COMMENT = '{0}', DUE_DATE = '{1}', STATE_ID = {2}, ACTIVE = {3}, CHANGED_WHO = '{4}', TASK_DATE = '{5}' " & _ "WHERE GUID = {6}", COMMENTTextBox.Text, DUE_DATEDateTimePicker.Value, STATE_IDComboBox.SelectedValue, 1, Environment.UserName, DateTimePickerTASK_DATE.Value, WF_TASK_IDTextBox.Text) If ClassDatabase.Execute_non_Query(upd, True) Then Load_Tasks() Else MsgBox("Update not successfull. Please check logfile.", MsgBoxStyle.Exclamation) End If ' Me.TBPMO_WORKFLOW_TASKTableAdapter.cmdUpdate(COMMENTTextBox.Text, DUE_DATEDateTimePicker.Value, STATE_IDComboBox.SelectedValue, 1, Environment.UserName, DateTimePicker1.Value, Me.GUIDTextBox.Text) Catch ex As Exception MsgBox("Error in save Workflow:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub frmRecordView_Shown(sender As Object, e As EventArgs) Handles Me.Shown End Sub Private Sub GridViewDoc_Search_FocusedRowChanged(sender As Object, e As DevExpress.XtraGrid.Views.Base.FocusedRowChangedEventArgs) Handles GridViewDoc_Search.FocusedRowChanged Try RESULT_DOC_PATH = GridViewDoc_Search.GetFocusedRowCellValue(GridViewDoc_Search.Columns("FULLPATH")) Catch ex As Exception RESULT_DOC_PATH = Nothing End Try End Sub Private Sub GridControlDocSearch_DoubleClick(sender As Object, e As EventArgs) Handles GridControlDocSearch.DoubleClick Try RESULT_DOC_PATH = GridViewDoc_Search.GetFocusedRowCellValue(GridViewDoc_Search.Columns("FULLPATH")) Catch ex As Exception RESULT_DOC_PATH = Nothing End Try ClassHelper.File_open(RESULT_DOC_PATH) End Sub Private Sub DateiÖffnenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DateiÖffnenToolStripMenuItem.Click ClassHelper.File_open(RESULT_DOC_PATH) End Sub Private Sub CopyToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CopyToolStripMenuItem.Click If RESULT_DOC_PATH <> Nothing Then Try Dim selectedfile(0) As String selectedfile(0) = RESULT_DOC_PATH Dim dataobj As New DataObject dataobj.SetData(DataFormats.FileDrop, True, selectedfile) Clipboard.Clear() Clipboard.SetDataObject(dataobj, True) Catch ex As Exception MsgBox("Unexpected Error in Copy file:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Cursor = Cursors.Default End If End Sub Private Sub DeleteToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DeleteToolStripMenuItem.Click If RESULT_DOC_PATH <> Nothing Then Dim msg = "Sind Sie sicher, dass Sie diese Datei löschen wollen?" If USER_LANGUAGE <> "de-DE" Then msg = "Are You sure You want to delete this file?" End If Dim result As MsgBoxResult result = MessageBox.Show(msg, "Confirmation:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Try Dim FileToDelete As String FileToDelete = RESULT_DOC_PATH If System.IO.File.Exists(FileToDelete) = True Then System.IO.File.Delete(FileToDelete) RUN_WDSEARCH_GRID() End If Catch ex As Exception MsgBox("Unexpected Error in Delete file:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End If End If End Sub Private Sub PropertiesToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles PropertiesToolStripMenuItem.Click If RESULT_DOC_PATH <> Nothing Then Cursor = Cursors.WaitCursor Dim sei As New SHELLEXECUTEINFO sei.cbSize = Marshal.SizeOf(sei) sei.lpVerb = "properties" sei.lpFile = RESULT_DOC_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("Unexpected Error in Open file propertys:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End If End If Cursor = Cursors.Default End Sub Private Sub pnlDetails_DragDrop(sender As Object, e As DragEventArgs) Handles pnlDetails.DragDrop Drag_Drop(e) End Sub Private Sub GridControlDocSearch_DragDrop(sender As Object, e As DragEventArgs) Handles GridControlDocSearch.DragDrop Drag_Drop(e) End Sub Private Sub pnlDetails_DragEnter(sender As Object, e As DragEventArgs) Handles pnlDetails.DragEnter Drag_Enter(e) End Sub Private Sub GridControlDocSearch_DragEnter(sender As Object, e As DragEventArgs) Handles GridControlDocSearch.DragEnter Drag_Enter(e) End Sub Sub Drag_Enter(e As DragEventArgs) If FORMVIEW_ID <> 0 Then ClassDragDrop.Drag_enter(e) End If End Sub Sub Drag_Drop(e As DragEventArgs) If FORMVIEW_ID <> 0 Then Dim sql = "select count(*) from VWPMO_DOKUMENTTYPES where FORMVIEW_ID = " & FORMVIEW_ID If ClassDatabase.Execute_Scalar(sql, True) = 0 Then MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation) Exit Sub End If CURRENT_FORMVIEW_ID = FORMVIEW_ID CURRENT_CONTROL_DOCTYPE_MATCH = 0 If e.Data.GetDataPresent(DataFormats.StringFormat) Then Dim Wert As String = CType(e.Data.GetData(DataFormats.StringFormat), Object) Console.WriteLine("DragDrop-Wert: " & Wert) If Wert.Contains("SCAN") Then Exit Sub 'Dim split() = Wert.Split(";") 'If IsNumeric(split(1)) Then ' CURRENT_FILEID = split(1) ' CURRENT_PARENT_ENTITY_ID = ClassDatabase.Execute_Scalar("SELECT PARENT_ID FROM TBPMO_FORM WHERE GUID = " & ENTITY_ID) ' CURRENT_RECORD_ID = JUMP_RECORD_ID ' CURRENT_FORMVIEW_ID = FORMVIEW_ID ' frmWD_Index_Dokart.ShowDialog() ' RUN_WDSEARCH_GRID() 'End If ElseIf (e.Data.GetDataPresent("FileGroupDescriptor")) AndAlso (e.Data.GetDataPresent("FileContents")) Then CURRENT_RECORD_ID = JUMP_RECORD_ID If ClassDragDrop.Drop_File(e) = True Then Check_Dropped_Files() End If ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then CURRENT_RECORD_ID = JUMP_RECORD_ID If ClassDragDrop.Drop_File(e) = True Then Check_Dropped_Files() End If End If Else CURRENT_RECORD_ID = JUMP_RECORD_ID If ClassDragDrop.Drop_File(e) = True Then Check_Dropped_Files() End If End If End If End Sub Sub Check_Dropped_Files() Try For Each Str As Object In ClassDragDrop.files_dropped If Not IsNothing(Str) Then Dim DropType = Str.Substring(0, Str.LastIndexOf("@") + 1) If DropType.ToString.Contains("SCAN") = False Then ClassLogger.Add(">> Check_Dropped_Files:" & Str.ToString, False) Dim CURRENT_WORKFILE = Str.Substring(Str.LastIndexOf("@") + 1) Dim insert = String.Format("INSERT INTO TBPMO_FILES_USER(FILENAME2WORK, USER_WORK, HANDLE_TYPE) VALUES('{0}','{1}','{2}')", CURRENT_WORKFILE, Environment.UserName, DropType) If ClassDatabase.Execute_non_Query(insert) = False Then Exit Sub End If End If End If Next Dim sql = "select count(*) from VWPMO_DOKUMENTTYPES where FORMVIEW_ID = " & FORMVIEW_ID If ClassDatabase.Execute_Scalar(sql, True) >= 1 Then Dim sql1 = String.Format("SELECT GUID, FILENAME2WORK, USER_WORK, HANDLE_TYPE, WORKED, ADDED_WHEN FROM TBPMO_FILES_USER WHERE (UPPER(USER_WORK) = UPPER('{0}')) AND WORKED = 0", Environment.UserName) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql1) If Not IsNothing(DT) Then If DT.Rows.Count > 0 Then For Each Filerow As DataRow In DT.Rows 'Dim datei = Str.ToString.Replace("@DROPFROMFSYSTEM@", "") CURRENT_FILEID = Filerow.Item(0) CURRENT_PARENT_ENTITY_ID = PARENT_ENTITY_ID CURRENT_RECORD_ID = JUMP_RECORD_ID CURRENT_FORM_ID = ENTITY_ID CURRENT_FORMVIEW_ID = FORMVIEW_ID If ClassDatabase.Execute_Scalar("SELECT COUNT(*) FROM TBPMO_FILES_USER WHERE GUID = " & CURRENT_FILEID & " AND WORKED = 0") = 1 Then frmWD_Index_Dokart.ShowDialog() Else If LogErrorsOnly = False Then ClassLogger.Add(" >> File was deleted or worked meanwhile!") End If Next RUN_WDSEARCH_GRID() End If End If Else MsgBox("No documenttypes for this entity configured! Indexing is not possible!" & vbNewLine & "Please check the configuration!", MsgBoxStyle.Exclamation) Exit Sub End If Catch ex As Exception MsgBox("Check_Dropped_Files: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub End Class