Imports System.Data Imports System.IO Imports System.Data.SqlTypes Imports System.Data.SqlClient Imports EDOKALib.Common Public Class clsCompareFileInfo Implements IComparer Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare Dim File1 As FileInfo Dim File2 As FileInfo File1 = DirectCast(x, FileInfo) File2 = DirectCast(y, FileInfo) Compare = DateTime.Compare(File2.CreationTime, File1.CreationTime) End Function End Class Public Class frmAvaloqSpoolerTemp Private Sub frmAvaloqSpoolerTemp_Load(sender As Object, e As EventArgs) Handles MyBase.Load refreshList() End Sub Public Sub refreshList() 'Rel 4.03 Deklaration aus dem Try entfernt, damit diese im Catch wieder verwendet werden kann Dim file As IO.FileInfo Try Dim arr_Folders As String() Dim i As Integer DokList.Rows.Clear() Dim dir As New IO.DirectoryInfo(Globals.SpoolerTempDir) If dir.Exists Then Dim iCounter As Integer iCounter = 0 'Dim files As IO.FileInfo() = dir.GetFiles("*.*", SearchOption.AllDirectories) Dim dirinfo As DirectoryInfo = New DirectoryInfo(Globals.SpoolerTempDir) Dim allFiles() As FileInfo = dirinfo.GetFiles("*.edk", SearchOption.TopDirectoryOnly) Array.Sort(allFiles, New clsCompareFileInfo) 'For Each fl As FileInfo In allFiles ' MsgBox(fl.FullName.ToString()) 'Next ' Dim file As IO.FileInfo Dim tmpAction As Action tmpAction = New Action For Each file In allFiles If DateDiff(DateInterval.Day, file.CreationTime, Now) < 1 Then Try tmpAction.Load(file) addItem(tmpAction.ActionType, tmpAction.GetParameterByName("PartnerNr").Value, tmpAction.GetParameterByName("fanummer3").Value, tmpAction.GetParameterByName("DokumentTypNr").Value, DokList, file.DirectoryName & "\" & file.Name, iCounter, tmpAction.GetParameterByName("Dokumentpaket").Value) iCounter = iCounter + 1 If iCounter > 50 Then Exit For Catch End Try End If Next If iCounter = 0 Then Else End If Else dir.Create() refreshList() End If Catch ex As Exception End Try End Sub Public Sub addItem(ByVal action As String, ByVal parnr As String, ByVal ordernr As String, ByVal doctype As String, ByRef obj As DataGridView, ByVal xmlFile As String, ByVal intSort As Integer, ByVal dokPaket As String) Dim i As Integer Dim row0 As String() Dim strDocType As String = "" Dim strPartner As String = "" Dim arrActions(0 To 5) As String '20090927 - Ergänung uvm und ZV arrActions = New String() {"Anzeige Partnerdossier", "Dokument anzeige", "Dokument Erstellung", "Dokument Bearbeitung", "Statusmutation", "Host Dokument Anzeige", "UVM-Dokumentanzeige", "ZV-Dokumentanzeige"} If dokPaket = "" Then dokPaket = 0 End If Try ' Get Dokumenttyp kurzbeschreibung If doctype <> "" Then Try doctype = doctype - 900000000 Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim s As String Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) scmCmdToExecute.CommandText = "dbo.sp_GetDokumenttyp" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@DokumenttypNr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, CInt(doctype))) scmCmdToExecute.Parameters.Add(New SqlParameter("@DP", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokPaket)) sdaAdapter.Fill(dtToReturn) strDocType = dtToReturn.Rows(0).Item("bezeichnung") Catch ex As Exception '20090729 - shu uvm und zv-dokumentanzeige If action = 7 Then strDocType = doctype If action = 8 Then strDocType = doctype If action < 7 Then TKBLib.Errorhandling.TraceHelper.Msg("Edoka.Spooler Add Item Error DocType", ex.Message & ex.StackTrace, TraceLevel.Error) End If End Try End If If dokPaket = "1" Then strDocType = "Dokumentpaket" End If ' Get Partner kurzbeschreibung If parnr <> "" Then Try Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim s As String Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) scmCmdToExecute.CommandText = "dbo.sp_getPartnerInformation" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@parnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, parnr)) sdaAdapter.Fill(dtToReturn) strPartner = dtToReturn.Rows(0).Item("BKPAR00") Catch ex As Exception TKBLib.Errorhandling.TraceHelper.Msg("Edoka.Spooler Add Item Error parnr", ex.Message & ex.StackTrace, TraceLevel.Error) End Try End If row0 = New String() {arrActions(CInt(action) - 1), strDocType, parnr, strPartner, ordernr, xmlFile, intSort} obj.Rows.Insert(intSort, row0) Catch ex As Exception 'TKBLib.Errorhandling.TraceHelper.Msg("Edoka.Spooler Add Item Error", ex.Message & ex.StackTrace, TraceLevel.Error) End Try End Sub Private Sub btnStart_Click(sender As Object, e As EventArgs) Handles btnStart.Click Try Dim xmlFile As String Dim i As Integer i = DokList.CurrentRow.Index xmlFile = DokList.Item("xml", i).Value.ToString Dim filename As String = Path.GetFileName(xmlFile) filename = Globals.SpoolerDir + "\" + filename File.Copy(xmlFile, filename) Globals.TempParent = Me.ParentForm EDOKAMain.HandleCommand(New String() {filename}) Globals.TempParent = Nothing Me.Close() Catch End Try End Sub End Class