Imports System Imports System.IO Imports Microsoft.VisualBasic Imports System.Security.Permissions Public Class frmRoutineManager Dim HISTORY = False Dim threads As New List(Of Object) Dim StartParam = "ALL" Dim allowClose = False Sub New() ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Sub New(StartParam, allowClose, Optional HISTORY = False) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() Me.StartParam = StartParam Me.allowClose = allowClose Me.HISTORY = HISTORY ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Public Shared Path As String = "\\192.168.0.91\f\FMZoll\Datensicherung\atlas\atlas\fssouzb" '"G:\atlas\atlas\fssouzb" ' Dim ico As New NotifyIcon ' Private Sub frmMain_FormClosing(sender As Object, e As EventArgs) Handles Me.FormClosing ' icoAufschub.Visible = False ' icoAufschub.Dispose() ' End Sub ' Private Sub frmMain_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed ' Try ' Me.icoAufschub.Visible = False ' Me.icoAufschub.Dispose() ' Catch ex As Exception ' End Try 'End Sub Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles Me.Load Me.Show() ' Me.Hide() ' ico = icoAufschub ' ico.Visible = True End Sub _ Private Shared Sub Run() ' Create a new FileSystemWatcher and set its properties. Dim watcher As New FileSystemWatcher() watcher.Path = Path ' Watch for changes in LastAccess and LastWrite times, and ' the renaming of files or directories. watcher.NotifyFilter = (NotifyFilters.LastAccess Or NotifyFilters.LastWrite Or NotifyFilters.FileName Or NotifyFilters.DirectoryName) watcher.Filter = "*.*" AddHandler watcher.Created, Sub() If Not timeToSleep() Then Dim thread As _ New System.Threading.Thread(Sub() frmRoutineManager.doWork() End Sub) thread.IsBackground = True thread.Start() frmRoutineManager.threads.Add(thread) End If End Sub watcher.EnableRaisingEvents = True End Sub Public Sub doWork() Dim startTime As DateTime = Now If False Then setLabel(lblStatusATLAS, "läuft ...", "green") setLabel(lblStatusEZOLL, "wartet ...", "green") Try AtlasAufschubDatenEinlesen.initAllFiles(Path, HISTORY) setLabel(lblStatusATLAS, "OK", "green") 'frmAtlasAufschub.lblStatusATLAS.ForeColor = Color.Green Catch ex As Exception setLabel(lblStatusATLAS, "ERROR", "red") ' frmAtlasAufschub.lblStatusATLAS.ForeColor = Color.Red writeLog("ERROR", "Fehler AtalsAufschub: " & ex.Message) Finally 'lblStatusATLAS End Try End If setLabel(lblStatusEZOLL, "läuft ...", "green") Try Dim EZollAufschubEinlesen As New EZollAufschubEinlesen EZollAufschubEinlesen.initEZOLL(HISTORY) ' HISTORY, da die Abfrage sonst lange dauert und enorm Performance am Buchhaltungs-Server fordert setLabel(lblStatusEZOLL, "OK", "green") ' frmAtlasAufschub.lblStatusEZOLL.ForeColor = Color.Green Catch ex As Exception writeLog("ERROR", "Fehler EZollAufschub: " & ex.Message) setLabel(lblStatusEZOLL, "ERROR", "red") ' frmAtlasAufschub.lblStatusEZOLL.ForeColor = Color.Red Finally ' lblStatusEZOLL.Dispose() End Try setLabel(lblLastAkt, Now.ToString("dd.MM.yyyy HH:mm:ss") & " (Dauer: " & CStr(DateDiff(DateInterval.Second, startTime, DateTime.Now)) & "s)") startTime = Nothing End Sub Public Shared Function timeToSleep() As Boolean If Now.Hour >= 22 Or Now.Hour < 6 Then Return True End If Return False End Function Private Sub timer_Tick(sender As System.Object, e As System.EventArgs) Handles timer.Tick If Not timeToSleep() Then startInitATLAS() End If 'Dispose() 'GC.Collect() End Sub Private Sub Oncreated(source As Object, e As FileSystemEventArgs) If Not timeToSleep() Then startInitATLAS() End If End Sub Private Sub timerBRG_SUBEN_Tick(sender As System.Object, e As System.EventArgs) Handles timerBRG.Tick Panel1.Dispose() Dim startTime As DateTime = Now If Not timeToSleep() Then startBRG_ATLAS_SUB() startBRG_ATLAS_SBG() startBRG_EZOLL() setLabel(lblLastAktBRG_ATLAS_SUB, Now.ToString("dd.MM.yyyy HH:mm:ss") & " (Dauer: " & CStr(DateDiff(DateInterval.Second, startTime, DateTime.Now)) & "s)") End If 'Dispose() 'GC.Collect() End Sub Sub doWork_Brg_ATLAS_SUB() Dim cBuergschaften As New cBuergschaften setLabel(lbBrgAtlasSuben, "läuft ...", "green") 'lbBrgAtlasSuben.ForeColor = Color.Green Try If cBuergschaften.doStuff_ATLAS("SUB", HISTORY) Then setLabel(lbBrgAtlasSuben, "OK", "green") Else ' lbBrgAtlasSuben.ForeColor = Color.Red setLabel(lbBrgAtlasSuben, "ERROR - DB", "red") End If Catch ex As Exception setLabel(lbBrgAtlasSuben, "ERROR", "red") ' lbBrgAtlasSuben.ForeColor = Color.Red ' writeLog("ERROR", "Fehler AtalsAufschub: " & ex.Message) Finally cBuergschaften = Nothing 'lbBrgAtlasSuben.Dispose() End Try End Sub Sub doWork_Brg_ATLAS_SBG() Dim cBuergschaften As New cBuergschaften setLabel(lbBrgAtlasSalzburg, "läuft ...", "green") ' lbBrgAtlasSalzburg.ForeColor = Color.Green Try If cBuergschaften.doStuff_ATLAS("SBG", HISTORY) Then setLabel(lbBrgAtlasSalzburg, "OK", "green") Else ' lbBrgAtlasSalzburg.ForeColor = Color.Red setLabel(lbBrgAtlasSalzburg, "ERROR - DB", "red") End If Catch ex As Exception setLabel(lbBrgAtlasSalzburg, "ERROR", "red") ' lbBrgAtlasSalzburg.ForeColor = Color.Red ' writeLog("ERROR", "Fehler AtalsAufschub: " & ex.Message) Finally cBuergschaften = Nothing ' lbBrgAtlasSalzburg.Dispose() End Try End Sub Sub doWork_EZOLL() Dim cBuergschaften As New cBuergschaften setLabel(lbBrgEZoll, "läuft ...", "green") ' lbBrgAtlasSalzburg.ForeColor = Color.Green Try If cBuergschaften.doStuff_EZOLL(HISTORY) Then setLabel(lbBrgEZoll, "OK", "green") Else ' lbBrgAtlasSalzburg.ForeColor = Color.Red setLabel(lbBrgEZoll, "ERROR - DB", "red") End If Catch ex As Exception setLabel(lbBrgEZoll, "ERROR", "red") ' lbBrgAtlasSalzburg.ForeColor = Color.Red ' writeLog("ERROR", "Fehler AtalsAufschub: " & ex.Message) Finally cBuergschaften = Nothing 'lbBrgEZoll.Dispose() End Try End Sub Private Sub BeendenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BeendenToolStripMenuItem.Click Me.Close() End Sub ' Private Sub icoAufschub_MouseClick(sender As Object, e As MouseEventArgs) Handles icoAufschub.Click ' If (e.Button = Windows.Forms.MouseButtons.Right) Then ' icoAufschub.ContextMenuStrip = mneNotifyIcon ' End If ' End Sub Private Sub frmAtlasAufschub_Shown(sender As Object, e As EventArgs) Handles Me.Shown ' If False Then If StartParam = "ALL" Or StartParam = "AUFSCHUB" Then startInitATLAS() timer.Start() End If If StartParam = "ALL" Or StartParam = "BRG" Then startBRG_ATLAS_SUB() startBRG_ATLAS_SBG() startBRG_EZOLL() timerBRG.Start() End If ' StartParam = "ALL" --> AutoStart If allowClose Then TimerClose.Start() ' Prüft alle 60 sec. ob die Threads geschlossen sind, beeandet as Programm anschließend. 'GC.Collect() ' End If ' Ohne Timer, Programm schließt anschließend: ' doWork() ' doWork_Brg_ATLAS_SUB() ' doWork_Brg_ATLAS_SBG() ' doWork_EZOLL() ' Me.Close() End Sub Sub startInitATLAS() If alreadyRunning("threadATLAS") Then Exit Sub Dim threadATLAS As _ New System.Threading.Thread(Sub() ' timer.Start() Run() If Not timeToSleep() Then doWork() End If removeThreadFromList("threadATLAS") ' Stop ' disp.Dispose() 'GC.Collect() End Sub) threadATLAS.IsBackground = True threadATLAS.Start() threadATLAS.Name = "threadATLAS" threads.Add(threadATLAS) End Sub Sub startBRG_ATLAS_SUB() If alreadyRunning("thread_BRG_ATLAS_SUB") Then Exit Sub Dim thread_BRG_ATLAS_SUB As _ New System.Threading.Thread(Sub() 'timerBRG_SUBEN.Start() Run() If Not timeToSleep() Then Dim startTime As DateTime = Now doWork_Brg_ATLAS_SUB() setLabel(lblLastAktBRG_ATLAS_SUB, Now.ToString("dd.MM.yyyy HH:mm:ss") & " (Dauer: " & CStr(DateDiff(DateInterval.Second, startTime, DateTime.Now)) & "s)") startTime = Nothing End If removeThreadFromList("thread_BRG_ATLAS_SUB") 'Dispose() 'GC.Collect() End Sub) thread_BRG_ATLAS_SUB.IsBackground = True thread_BRG_ATLAS_SUB.Start() thread_BRG_ATLAS_SUB.Name = "thread_BRG_ATLAS_SUB" threads.Add(thread_BRG_ATLAS_SUB) End Sub Sub startBRG_ATLAS_SBG() If alreadyRunning("thread_BRG_ATLAS_SBG") Then Exit Sub Dim thread_BRG_ATLAS_SBG As _ New System.Threading.Thread(Sub() Run() If Not timeToSleep() Then Dim startTime As DateTime = Now doWork_Brg_ATLAS_SBG() setLabel(lblLastAktBRG_ATLAS_SBG, Now.ToString("dd.MM.yyyy HH:mm:ss") & " (Dauer: " & CStr(DateDiff(DateInterval.Second, startTime, DateTime.Now)) & "s)") startTime = Nothing End If removeThreadFromList("thread_BRG_ATLAS_SBG") 'Dispose() 'GC.Collect() End Sub) thread_BRG_ATLAS_SBG.IsBackground = True thread_BRG_ATLAS_SBG.Start() thread_BRG_ATLAS_SBG.Name = "thread_BRG_ATLAS_SBG" threads.Add(thread_BRG_ATLAS_SBG) End Sub Sub startBRG_EZOLL() If alreadyRunning("thread_EZOLL") Then Exit Sub Dim thread_EZOLL As _ New System.Threading.Thread(Sub() Run() If Not timeToSleep() Then Dim startTime As DateTime = Now doWork_EZOLL() setLabel(lblLastAktBRG_ATLAS_EZOLL, Now.ToString("dd.MM.yyyy HH:mm:ss") & " (Dauer: " & CStr(DateDiff(DateInterval.Second, startTime, DateTime.Now)) & "s)") startTime = Nothing End If removeThreadFromList("thread_EZOLL") 'Dispose() End Sub) thread_EZOLL.IsBackground = True thread_EZOLL.Start() thread_EZOLL.Name = "thread_EZOLL" threads.Add(thread_EZOLL) End Sub 'threadsicherer Aufruf Delegate Sub setLabelCallback(l As Label, t As String, c As String) Public Sub setLabel(l As Label, t As String, Optional ByVal c As String = "black") If Me.InvokeRequired Then Dim d As New setLabelCallback(AddressOf setLabel) Me.Invoke(d, New Object() {l, t, c}) Else l.Text = t Select Case c Case "green" : l.ForeColor = Color.Green Case "red" : l.ForeColor = Color.Red Case "black" : l.ForeColor = Color.Black End Select l = Nothing : t = Nothing : c = Nothing End If End Sub Function alreadyRunning(n) As Boolean Try For Each t As System.Threading.Thread In threads If t.Name = n Then Return True Next Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodBase.GetCurrentMethod.Name) End Try Return False End Function Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Me.Close() End Sub Function closeThreads() As Boolean Try For Each t As System.Threading.Thread In threads If t.IsAlive Then t.Interrupt() t.Abort() Return False End If t = Nothing threads.Remove(t) Next Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodBase.GetCurrentMethod.Name) End Try Return True End Function Function removeThreadFromList(n) As Boolean Try For Each t As System.Threading.Thread In threads If t IsNot Nothing Then If t.Name = n Then threads.Remove(t) Return False End If End If Next Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodBase.GetCurrentMethod.Name) End Try Return True End Function Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click closeThreads() End Sub Private Sub PictureBox4_Click(sender As Object, e As EventArgs) Handles PictureBox4.Click startInitATLAS() End Sub Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles PictureBox1.Click startBRG_ATLAS_SUB() End Sub Private Sub PictureBox2_Click(sender As Object, e As EventArgs) Handles PictureBox2.Click startBRG_ATLAS_SBG() End Sub Private Sub PictureBox3_Click(sender As Object, e As EventArgs) Handles PictureBox3.Click startBRG_EZOLL() End Sub Private Sub PictureBox5_Click(sender As Object, e As EventArgs) Handles PictureBox5.Click startBRG_EZOLL() startBRG_ATLAS_SBG() startBRG_ATLAS_SUB() End Sub Private Sub Button3_Click(sender As Object, e As EventArgs) ' Dispose() 'GC.Collect() For Each t As System.Threading.Thread In threads If t.Name = "thread_BRG_ATLAS_SBG" Then t = Nothing End If Next ' Dispose() 'GC.Collect() End Sub Private Sub btnAlive_Click(sender As Object, e As EventArgs) MsgBox(allThreadsClosed) End Sub Function allThreadsClosed() As Boolean For Each t As System.Threading.Thread In threads If t IsNot Nothing AndAlso t.IsAlive Then Return False End If Next Return True End Function Private Sub TimerClose_Tick(sender As Object, e As EventArgs) Handles TimerClose.Tick If allThreadsClosed() Then Me.Close() End If End Sub End Class