484 lines
18 KiB
VB.net
484 lines
18 KiB
VB.net
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 PathATLAS As String = VERAG_PROG_ALLGEMEIN.cAllgemein.FMZOLL_ATLAS_Datensicherung_OLD '"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
|
|
|
|
<PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _
|
|
Private Shared Sub Run()
|
|
If False Then ' altes ATLAS
|
|
|
|
' Create a new FileSystemWatcher and set its properties.
|
|
Dim watcher As New FileSystemWatcher()
|
|
watcher.Path = PathATLAS
|
|
' 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 If
|
|
|
|
End Sub
|
|
Public Sub doWork()
|
|
Dim startTime As DateTime = Now
|
|
|
|
If False Then
|
|
|
|
setLabel(lblStatusEZOLL, "wartet ...", "green")
|
|
setLabel(lblStatusATLAS, "läuft ...", "green")
|
|
Try
|
|
AtlasAufschubDatenEinlesen.initAllFiles(PathATLAS, 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 & ex.StackTrace)
|
|
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
|
|
|
|
Private Sub Button3_Click_1(sender As Object, e As EventArgs) Handles Button3.Click
|
|
Dim cBuergschaften As New cBuergschaften
|
|
cBuergschaften.doStuff_EZOLL(HISTORY)
|
|
End Sub
|
|
End Class
|