Imports System Imports System.Text Imports System.Runtime.InteropServices Imports System.Threading Imports System.IO Imports System.Collections Imports System.Runtime.Serialization.Formatters.Binary Imports System.Runtime.Serialization Imports System.Xml.Serialization Imports System.Xml '20201022 - New Class Public Class NewFileCheck Public FilesToWatch As New Collection Dim ts As String Dim Filename As String Public Function AddToCollection(Apptype As Integer, dokumentid As String, wlib As WordLib) As Long Dim ts As String = Now.ToString("yyyyMMddHHmmssFFF") Filename = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "\" + ts + "_" + wlib.DokumentID + ".olib" Try If Globals.UseOlibFile = True Then Save_Wordlibdata(wlib, Apptype) Catch ex As Exception PerfMon.force_insert_entry(dokumentid + ": SaveWordlibdata fehlgeschlagen: " + ex.message) End Try Dim pid As Long pid = GetHandle(dokumentid, Apptype, dokumentid) FilesToWatch.Add(New Wachfile(Apptype, dokumentid, pid, wlib, ts, Filename)) If IntTimer.Enabled = False Then IntTimer.Enabled = True IntTimer.Start() End If Return pid End Function Sub Save_Wordlibdata(wlib As WordLib, apptype As Integer) Dim ds As New DataSet Dim dt As New DataTable dt.Columns.Add("save_historystatus") dt.Columns.Add("save_historystatusbr") dt.Columns.Add("dokumentid") dt.Columns.Add("Save_DokumentFunktionen") dt.Columns.Add("CreateDoc") dt.Columns.Add("Save_Dokument") dt.Columns.Add("Dokumentidbr") dt.Columns.Add("Dokumentcoldindex_Changed") dt.Columns.Add("dokumentid_changed") dt.Columns.Add("Dokumentcoldindex_Changedbr") dt.Columns.Add("dokumentid_changedbr") dt.Columns.Add("Timestamp") dt.Columns.Add("Applicationtype") dt.Columns.Add("Dokumentfilename") dt.Columns.Add("Dokumentname") Dim dr As DataRow = dt.NewRow dr.Item(0) = wlib.save_historystatus dr.Item(1) = wlib.save_historystatusbr dr.Item(2) = wlib.DokumentID dr.Item(3) = wlib.Save_DokumentFunktionen dr.Item(4) = wlib.CreateDoc dr.Item(5) = wlib.Save_Dokument dr.Item(6) = wlib.Dokumentidbr dr.Item(7) = wlib.Dokumentcoldindex_Changed dr.Item(8) = wlib.dokumentid_changed dr.Item(9) = wlib.Dokumentcoldindex_changedbr dr.Item(10) = wlib.dokumentid_changedbr dr.Item(11) = ts dr.Item(12) = apptype dr.Item(13) = wlib.Dokumentfilename dr.Item(14) = wlib.DokumentName dt.Rows.Add(dr) Try dt.TableName = "Allgemein" ds.Tables.Add(dt.Copy) Catch End Try Try ds.Tables.Add(wlib.Save_Dokument.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokument" Catch End Try Try ds.Tables.Add(wlib.Save_Notizen.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Notizen" Catch End Try Try ds.Tables.Add(wlib.Save_ColdIndex.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Coldindex" Catch End Try Try ds.Tables.Add(wlib.Save_Dokumentwerte.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentwerte" Catch End Try Try ds.Tables.Add(wlib.Save_Dokumentzuordnungen.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentzuordnungen" Catch End Try Try ds.Tables.Add(wlib.Save_Dokumentinfomeldungen.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentinfomeldung" Catch End Try Try ds.Tables.Add(wlib.Save_DokumentFunktionen.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentfunktionen" Catch End Try Try ds.Tables.Add(wlib.save_dokumentersetzen.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentersetzen" Catch End Try Try ds.Tables.Add(wlib.save_dokumentcoldindex.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentcoldindex" Catch End Try Try ds.Tables.Add(wlib.Save_Dokumentbr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentbr" Catch End Try Try ds.Tables.Add(wlib.Save_Notizenbr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Notizenbr" Catch End Try Try ds.Tables.Add(wlib.Save_ColdIndexbr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Coldindexbr" Catch End Try Try ds.Tables.Add(wlib.Save_Dokumentwertebr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentwertebr" Catch End Try Try ds.Tables.Add(wlib.Save_Dokumentzuordnungenbr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentzuordnungenvr" Catch End Try Try ds.Tables.Add(wlib.Save_Dokumentinfomeldungenbr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentinfomeldungenbr" Catch End Try Try ds.Tables.Add(wlib.Save_DokumentFunktionenbr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentfunktionenbr" Catch End Try Try ds.Tables.Add(wlib.save_dokumentersetzenbr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentersetzenbr" Catch End Try Try ds.Tables.Add(wlib.save_dokumentcoldindexbr.Copy) ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentcoldindexbr" Catch End Try Dim files As String() = System.IO.Directory.GetFiles(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"), "*" + wlib.DokumentID + ".olib", System.IO.SearchOption.TopDirectoryOnly) If files.Length > 0 Then For Each filename As String In files System.IO.File.Delete(filename) Next End If ds.WriteXml(Filename) Dim fs As New FileStream(Filename, FileMode.Create) Dim sw As New StreamWriter(fs) sw.WriteLine("") sw.WriteLine("") For Each t As DataTable In ds.Tables For Each r As DataRow In t.Rows sw.WriteLine("<" + t.TableName + ">") For Each dc As DataColumn In t.Columns Dim s As String = "" Try If r.Item(dc.ColumnName) = System.DBNull.Value Then s = "<" + dc.ColumnName + ">System.DBNull.Value" Else s = "<" + dc.ColumnName + ">" + r.Item(dc.ColumnName).ToString + "" End If Catch s = "<" + dc.ColumnName + ">" + r.Item(dc.ColumnName).ToString + "" End Try sw.WriteLine(s) Next sw.WriteLine("") Next Next sw.WriteLine("") sw.Close() End Sub Sub New() IntTimer.Enabled = True End Sub #Region "Timer" Dim WithEvents IntTimer As New System.Timers.Timer(Globals.Check_Doc_Timer) Sub Check_Doks() Handles IntTimer.Elapsed For i As Integer = 1 To FilesToWatch.Count Dim fw As Wachfile = FilesToWatch(i) Dim pid As Long = -1 For ic As Integer = 1 To Globals.try_count_search Try Dim p As Process = Process.GetProcessById(fw.Prozessid) pid = p.Id Exit For Catch ex As Exception pid = -1 If ex.Message.IndexOf("Es wird kein Prozess mit der ID") = -1 Then PerfMon.force_insert_entry(fw.Dokumentid + ": Process-ID Check_Doks fehlgeschlagen (Counter:" + ic.ToString + "):" + ex.Message) End If End Try System.Threading.Thread.Sleep(100) Next ic If pid < 1 Then IntTimer.Stop() Dim wl As WordLib = fw.WLib Try If wl.Finishing() Then If File.Exists(fw.datafilename) Then File.Delete(fw.datafilename) End If Else PerfMon.force_insert_entry(fw.Dokumentid + ": Finishing return false " + fw.Prozessid.ToString) End If Catch ex As Exception If Globals.Force_Watch_Message Then PerfMon.force_insert_entry(fw.Dokumentid + ": Dokument Finishing Fehler: Prozess-ID: " + fw.Prozessid.ToString + ": " + ex.Message) End If End Try FilesToWatch.Remove(i) IntTimer.Start() Exit Sub End If Next End Sub #End Region #Region "Prozessbearbeitung" Public Function doc_is_active(processid As Long) As Boolean Dim Docfound As Boolean = False Try Dim p As Process = Process.GetProcessById(processid) If p.Id = processid Then Docfound = True If p.Id = 0 Then Docfound = False End If Catch ex As Exception Docfound = False End Try Return Docfound Exit Function End Function Public Function GetHandle(ByVal caption As String, Applicationtype As Integer, ByVal dokumentid As String) As String Try For i As Integer = 1 To Globals.try_count_search If Applicationtype = 1 Then For Each p As Process In Process.GetProcessesByName("winword") If p.MainWindowTitle.IndexOf(caption) > -1 Then Return p.Id.ToString Exit Function End If Next End If If Applicationtype = 2 Then For Each p As Process In Process.GetProcessesByName("excel") If p.MainWindowTitle.IndexOf(caption) > -1 Then Return p.Id.ToString Exit Function End If Next End If If Applicationtype <> 1 And Applicationtype <> 2 Then For Each p As Process In Process.GetProcesses If p.MainWindowTitle.IndexOf(caption) > -1 Then Return p.Id.ToString Exit Function End If Next End If Thread.Sleep(500) Next i Return 0 Catch ex As Exception PerfMon.force_insert_entry(dokumentid + ": Prozess-ID konnte nicht ermittelt werden: " + ex.Message) End Try End Function #End Region End Class Public Class Wachfile Dim m_applicationtype As Integer Property Applicationtype As Integer Get Return m_applicationtype End Get Set(value As Integer) m_applicationtype = value End Set End Property Dim m_dokumentid As String Property Dokumentid As String Get Return m_dokumentid End Get Set(value As String) m_dokumentid = value End Set End Property Dim m_Prozessid As Long Property Prozessid As Long Get Return m_Prozessid End Get Set(value As Long) m_Prozessid = value End Set End Property Dim m_wlib As WordLib Property WLib As WordLib Get Return m_wlib End Get Set(value As WordLib) m_wlib = value End Set End Property Dim m_ts As String Property TS As String Get Return m_ts End Get Set(value As String) m_ts = value End Set End Property Dim m_datafilename As String Property datafilename As String Get Return m_datafilename End Get Set(value As String) m_datafilename = value End Set End Property Sub New(Apptype As Integer, dokid As String, procid As Long, wlib As WordLib, ts As String, datafilename As String) Me.Applicationtype = Apptype Me.Dokumentid = dokid Me.Prozessid = procid Me.WLib = wlib Me.TS = ts Me.datafilename = datafilename End Sub End Class