NEU
This commit is contained in:
470
initATLASAufschubkonten/frmRoutineManager.vb
Normal file
470
initATLASAufschubkonten/frmRoutineManager.vb
Normal file
@@ -0,0 +1,470 @@
|
||||
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
|
||||
|
||||
<PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _
|
||||
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.Name = n Then
|
||||
threads.Remove(t)
|
||||
Return False
|
||||
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
|
||||
Reference in New Issue
Block a user