Files

1464 lines
63 KiB
VB.net

Imports System.IO
Imports System.Net.NetworkInformation
Imports System.Reflection
Imports System.Text
Imports System.Threading
Imports WebDoorCreator.SDK
Imports EgtUILib
Public Class ProcMan
#Region "Public Constructors"
Public Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
synchronizationContext = SynchronizationContext.Current
m_bStopProcess = True
SetMaxCamInstances(1)
StartUiThread()
' preparo lista thread...
LISTThreadStatus.BeginUpdate()
LISTThreadStatus.Items.Clear()
LISTThreadStatus.Items.Add(New ListViewItem(New String() {"init", "waiting", "-"}))
LISTThreadStatus.EndUpdate()
' verifico SE avviare
If chkAutoRestart.Checked Then
startAllThreads()
End If
CheckStartAutoRestart()
End Sub
#End Region
#Region "Private Fields"
Private ReadOnly synchronizationContext As SynchronizationContext
' caricamento del NEXT STACK da redis (come oggetto) PROD http : https://iis01.egalware.com/WDC/SRV/
' DEV: https : https://localhost:7043/
Dim baseIp As String = "iis01.egalware.com"
Dim baseUrl As String = "https://iis01.egalware.com/WDC/SRV/"
Dim codPost As String = "WRK001"
Dim sEgtEnginePath As String = ""
' nome macchina calcolo
Dim currWDC As WDC
Dim idxSim As Integer = 0
Dim m_bExecutionThreadStoped As Boolean = False
Dim m_bStopProcess As Boolean = False
Dim m_ExecutionThread As Thread
Dim m_LastCrashedProcTime As DateTime
Private m_StatList As New List(Of ThreadStat)
Public Enum ProgramStatuses As Integer
START = 1
[STOP] = 2
End Enum
Dim m_ProgramStatus As ProgramStatuses = ProgramStatuses.STOP
'Private m_MaxCamInstances As Integer = 8
Private m_MaxCamInstances As Integer = 1
Dim risultatoPing As PingReply = Nothing
Dim ThreadList As Thread()
Dim ThreadDataList As ThreadData()
Dim HistoryThreadDataList As New List(Of ThreadStat)
Dim m_bCheckOrder As Boolean = True
Dim m_bPingOk As Boolean = False
Dim m_bAliveOk As Boolean = False
#End Region
Enum ThreadOperations As Integer
WaitingData = 1
FoundRequest = 2
WritingDdf = 3
ProcessingDdf = 4
ReadingSvg = 5
SendResult = 6
Closed = 10
End Enum
Private Class ThreadData
Public Enum ProcComm As Integer
Null = 0
WaitingAnswer = 1
AnswerReceived = 2
End Enum
Private m_CurrRequest As KeyValuePair(Of String, String)
Public ReadOnly Property CurrRequest As KeyValuePair(Of String, String)
Get
Return m_CurrRequest
End Get
End Property
Friend Sub SetCurrRequest(value As KeyValuePair(Of String, String))
m_CurrRequest = value
End Sub
Private m_sDdfPath As String
Public ReadOnly Property sDdfPath As String
Get
Return m_sDdfPath
End Get
End Property
Friend Sub SetDdfPath(value As String)
m_sDdfPath = value
End Sub
Private m_WaitProcAnswer As ProcComm = ProcComm.Null
Public ReadOnly Property WaitProcAnswer As ProcComm
Get
Return m_WaitProcAnswer
End Get
End Property
Friend Sub SetWaitProcAnswer(value As ProcComm)
m_WaitProcAnswer = value
End Sub
Private m_nProcResult As Integer
Public ReadOnly Property nProcResult As Integer
Get
Return m_nProcResult
End Get
End Property
Friend Sub SetProcResult(value As Integer)
m_nProcResult = value
End Sub
Private m_ThreadOperation As ThreadOperations
Public ReadOnly Property ThreadOperation As ThreadOperations
Get
Return m_ThreadOperation
End Get
End Property
Friend Sub SetThreadOperation(value As ThreadOperations)
m_ThreadOperation = value
End Sub
Private m_Process As Process
Public ReadOnly Property Process As Process
Get
Return m_Process
End Get
End Property
Friend Sub SetProcess(value As Process)
m_Process = value
End Sub
Private m_ThreadStat As ThreadStat
Public ReadOnly Property ThreadStat As ThreadStat
Get
Return m_ThreadStat
End Get
End Property
Friend Sub SetThreadStat(value As ThreadStat)
m_ThreadStat = value
End Sub
End Class
Public Class ThreadStat
Private m_nIndex As Integer
Public ReadOnly Property nIndex As Integer
Get
Return m_nIndex
End Get
End Property
Private m_StartThread As DateTime
Public ReadOnly Property StartThread As DateTime
Get
Return m_StartThread
End Get
End Property
Private m_StopThread As DateTime
Public ReadOnly Property StopThread As DateTime
Get
Return m_StopThread
End Get
End Property
Friend Sub SetStopThread(value As DateTime)
m_StopThread = value
End Sub
Private m_ProcExecutionList As New List(Of ProcStat)
Public ReadOnly Property ProcExecutionList As List(Of ProcStat)
Get
Return m_ProcExecutionList
End Get
End Property
Sub New(nIndex As Integer)
m_nIndex = nIndex
End Sub
Sub New(nIndex As Integer, StartThread As DateTime)
MyClass.New(nIndex)
m_StartThread = StartThread
End Sub
End Class
Public Class ProcStat
Private m_StartProc As DateTime
Public ReadOnly Property StartProc As DateTime
Get
Return m_StartProc
End Get
End Property
Private m_StopProc As DateTime
Public ReadOnly Property StopProc As DateTime
Get
Return m_StopProc
End Get
End Property
Friend Sub SetStopProc(value As DateTime)
m_StopProc = value
End Sub
Private m_nDoneRequests As Integer = 0
Public ReadOnly Property nDoneRequests As Integer
Get
Return m_nDoneRequests
End Get
End Property
Friend Sub IncrementDoneRequest()
m_nDoneRequests += 1
End Sub
Sub New(StartProc As DateTime)
m_StartProc = StartProc
End Sub
End Class
#Region "Private Methods"
Private Sub Form_Shown() Handles MyBase.Shown
If GetPrivateProfileInt(S_GENERAL, K_PROCESSATSTART, 1, m_IniFilePath) = 1 Then
startAllThreads()
End If
End Sub
Private Sub UpdateThreadCurrentStatus()
synchronizationContext.Post(New SendOrPostCallback(
Sub(o)
ThreadCurrentStatusList.BeginUpdate()
ThreadCurrentStatusList.Items.Clear()
If Not IsNothing(ThreadList) Then
For ThreadIndex = 0 To ThreadList.Count - 1
If Not IsNothing(ThreadList(ThreadIndex)) Then
Dim ThreadProcessState As String = "Nothing"
'If Not IsNothing(ThreadDataList(ThreadIndex)) AndAlso Not IsNothing(ThreadDataList(ThreadIndex).Process) AndAlso
'Not IsNothing(ThreadDataList(ThreadIndex).Process.HasExited) Then
' ThreadProcessState = ThreadDataList(ThreadIndex).Process.HasExited
'End If
ThreadCurrentStatusList.Items.Add(New ListViewItem(New String() {ThreadIndex,
If(Not IsNothing(ThreadList(ThreadIndex)), ThreadList(ThreadIndex).ThreadState.ToString(), ""),
ThreadProcessState,
If(Not IsNothing(ThreadDataList(ThreadIndex)), ThreadDataList(ThreadIndex).ThreadOperation.ToString(), "")}))
Else
ThreadCurrentStatusList.Items.Add(New ListViewItem(New String() {ThreadIndex,
"nothing"}))
End If
Next
End If
ThreadCurrentStatusList.EndUpdate()
lblpingTest.Text = m_bPingOk.ToString()
lblTestAlive.Text = m_bAliveOk.ToString()
End Sub), "")
End Sub
Private Sub btnQueueStatus_Click(sender As Object, e As EventArgs) Handles btnQueueStatus.Click
DisplayQueueStatus()
End Sub
Private Sub btnResetQueue_Click(sender As Object, e As EventArgs) Handles btnResetQueue.Click
currWDC.ResetQueue()
txtOut.Text = "Queue Resetted!"
End Sub
Private Sub btnTestAlive_Click(sender As Object, e As EventArgs) Handles btnTestAlive.Click
Dim answ As String = ""
If (currWDC.testAlive) Then
lblTestAlive.Text = "Server Alive!!!"
Else
lblTestAlive.Text = "Alive test failed!"
End If
End Sub
Private Sub btnTestPing_Click(sender As Object, e As EventArgs) Handles btnTestPing.Click
' chiamo test ping...
risultatoPing = currWDC.testPing
lblpingTest.Text = risultatoPing.Status.ToString()
End Sub
Private Sub DisplayQueueStatus()
If IsNothing(currWDC) Then Return
Dim queueStatus As New Dictionary(Of String, Long)
queueStatus = currWDC.queueStatus
Dim sb As StringBuilder
sb = New StringBuilder
For Each item As KeyValuePair(Of String, Long) In queueStatus
sb.AppendLine($"{item.Key}: {item.Value}")
Next
sb.AppendLine()
txtQueue.Text = sb.ToString()
txtQueue.Invalidate()
End Sub
Private Sub ExecutionProcess()
' recupero Id dei DDF
Dim sCurrDdfDir As String = ""
Dim nDdfId As Integer = 1
Dim bStopMainProcess As Boolean = False
Dim n30SecCounter As Integer = 0
Dim nStartingProc As Integer = 0
While Not bStopMainProcess
bStopMainProcess = m_bStopProcess
Dim bOk As Boolean = False
While Not bOk
If Not bStopMainProcess AndAlso Not m_bStopProcess Then
' ogni 30 secondi
If n30SecCounter = 30 OrElse n30SecCounter = 0 Then
' verifica connessione
'Dim risultatoPing As PingReply = currWDC.testPing
'bOk = risultatoPing.Status = IPStatus.Success
' test boolean diretto
bOk = currWDC.testPingOk
m_bPingOk = bOk
If bOk Then
bOk = currWDC.testAlive
m_bAliveOk = bOk
Else
m_bAliveOk = False
End If
Else
bOk = True
End If
End If
' se connessione non ok o processo fermato, fermo i thread
If Not bOk OrElse bStopMainProcess Then
If Not IsNothing(ThreadList) AndAlso ThreadList.Count > 0 AndAlso Not IsNothing(ThreadList(0)) Then
' li fermo
m_bStopProcess = True
' verifico siano terminati
Dim bOneNotEnded As Boolean = True
While bOneNotEnded
bOneNotEnded = False
For Each Thread In ThreadList
If Not IsNothing(Thread) Then
If Thread.IsAlive Then
bOneNotEnded = True
End If
End If
Next
End While
' pulisco la lista
For ThreadIndex = 0 To ThreadList.Count - 1
ThreadList(ThreadIndex) = Nothing
Next
m_bStopProcess = False
End If
If bStopMainProcess Then
m_bExecutionThreadStoped = True
Return
End If
End If
If Not bOk Then Thread.Sleep(10)
End While
If bOk AndAlso (IsNothing(ThreadList) OrElse ThreadList.Count = 0) Then
ThreadList = New Thread(m_MaxCamInstances - 1) {}
ThreadDataList = New ThreadData(m_MaxCamInstances - 1) {}
For nThreadIndex = 0 To m_MaxCamInstances - 1
Dim ThreadId As Integer = nThreadIndex
ThreadList(nThreadIndex) = New Thread(Sub()
ThreadFunction(ThreadId)
End Sub)
ThreadList(nThreadIndex).SetApartmentState(ApartmentState.STA)
' avvio thread di gestione della macchina che avvia la connessione
ThreadList(nThreadIndex).Start()
Thread.Sleep(100)
Next
End If
' se qualche processo in stop, lo faccio ripartire
For ThreadIndex = 0 To ThreadList.Count - 1
If ThreadIndex < ThreadList.Count Then
Dim Thread = ThreadList(ThreadIndex)
If Not IsNothing(Thread) Then
If Thread.ThreadState = ThreadState.Stopped OrElse Thread.ThreadState = ThreadState.Aborted OrElse
Thread.ThreadState = ThreadState.Suspended OrElse IsNothing(ThreadDataList(ThreadIndex).Process) OrElse (Not IsNothing(ThreadDataList(ThreadIndex).Process) AndAlso ThreadDataList(ThreadIndex).Process.HasExited) Then
Dim nActiveProc As Integer = 0
If ThreadIndex < ThreadDataList.Count Then
Dim CurrThreadStat As ThreadStat = ThreadDataList(ThreadIndex).ThreadStat
Dim CurrProcess As ProcStat = Nothing
If Not IsNothing(CurrThreadStat) Then
CurrProcess = CurrThreadStat.ProcExecutionList(CurrThreadStat.ProcExecutionList.Count - 1)
If Not IsNothing(CurrProcess) AndAlso CurrProcess.StopProc = DateTime.MinValue Then CurrProcess.SetStopProc(DateTime.Now)
If CurrThreadStat.StopThread = DateTime.MinValue Then CurrThreadStat.SetStopThread(DateTime.Now)
End If
' verifico se posso rilanciarlo
For nIndex As Integer = 0 To m_MaxCamInstances - 1
If nIndex < ThreadDataList.Count Then
Dim IndexThreadStat As ThreadStat = ThreadDataList(nIndex).ThreadStat
If Not IsNothing(IndexThreadStat) Then
If IndexThreadStat.ProcExecutionList.Count > 0 Then
Dim IndexProcess As ProcStat = IndexThreadStat.ProcExecutionList(IndexThreadStat.ProcExecutionList.Count - 1)
Dim random As New Random()
Dim nRandWait As Integer = random.Next(15, 30)
Dim RandTimeSpan As TimeSpan = TimeSpan.FromSeconds(nRandWait)
'EgtOutLog("nIndex: " & nIndex)
'EgtOutLog("Now: " & DateTime.Now)
'EgtOutLog("Stop process: " & IndexProcess.StopProc)
'EgtOutLog("nRandWait: " & nRandWait)
'EgtOutLog("RandTimeSpan: " & RandTimeSpan.ToString)
If Not IsNothing(IndexProcess) AndAlso Not IsNothing(CurrProcess) AndAlso (IndexProcess.StopProc = DateTime.MinValue OrElse (DateTime.Now - IndexProcess.StopProc) < TimeSpan.FromSeconds(nRandWait)) Then
nActiveProc += 1
'EgtOutLog("ActiveProc + 1")
End If
End If
End If
End If
Next
End If
'EgtOutLog("Conto processi attivi: " & nActiveProc)
If nActiveProc + nStartingProc + 1 <= Math.Max(2, m_MaxCamInstances) Then
nStartingProc += 1
'EgtOutLog("Ne lancio un altro")
' lo chiudo e rilancio
If ThreadIndex < ThreadDataList.Count Then
If Not IsNothing(ThreadDataList(ThreadIndex).Process) AndAlso Not ThreadDataList(ThreadIndex).Process.HasExited Then ThreadDataList(ThreadIndex).Process.Kill()
Thread.Sleep(500)
Thread.Abort()
Thread.Sleep(500)
While Not Thread.ThreadState = ThreadState.Aborted
Thread.Sleep(100)
End While
Thread = Nothing
Dim ThreadId As Integer = ThreadIndex
ThreadList(ThreadIndex) = New Thread(Sub()
ThreadFunction(ThreadId)
End Sub)
ThreadList(ThreadIndex).SetApartmentState(ApartmentState.STA)
' avvio thread di gestione della macchina che avvia la connessione
ThreadList(ThreadIndex).Start()
End If
nStartingProc -= 1
End If
End If
Else
Dim ThreadId As Integer = ThreadIndex
If ThreadIndex < ThreadList.Count Then
ThreadList(ThreadIndex) = New Thread(Sub()
ThreadFunction(ThreadId)
End Sub)
ThreadList(ThreadIndex).SetApartmentState(ApartmentState.STA)
' avvio thread di gestione della macchina che avvia la connessione
ThreadList(ThreadIndex).Start()
End If
End If
End If
Next
If n30SecCounter <= 30 Then
n30SecCounter += 1
Else
n30SecCounter = 1
End If
Thread.Sleep(1000)
End While
End Sub
Private Function GetFileContent(ByVal filePath As String, ByRef fileContent As String) As Boolean
Dim bOk As Boolean = File.Exists(filePath)
If bOk Then
Try
fileContent = File.ReadAllText(filePath)
Catch ex As Exception
bOk = False
fileContent = ""
End Try
End If
Return bOk
End Function
Private Sub performBarAdvance()
synchronizationContext.Post(New SendOrPostCallback(
Sub(o)
tsProgBar.PerformStep()
If tsProgBar.Value >= tsProgBar.Maximum Then
tsProgBar.Value = 0
End If
tsProgBar.Invalidate()
End Sub
), "")
End Sub
Private Sub performUpdateUI()
synchronizationContext.Post(New SendOrPostCallback(
Sub(o)
'verifico thread attivi e se calano --> riavvia..
If ThreadCount() <> m_MaxCamInstances And Not m_bStopProcess Then
'stopAllThreads()
'Thread.Sleep(100)
'startAllThreads()
End If
Dim nRunningProcess As Integer = 0
If Not IsNothing(ThreadDataList) Then
For ThreadIndex = 0 To ThreadDataList.Count - 1
Dim CurrThread As ThreadData = ThreadDataList(ThreadIndex)
If Not IsNothing(CurrThread) Then
If CurrThread.ThreadStat.StopThread = DateTime.MinValue Then
nRunningProcess += 1
End If
End If
Next
End If
lblRunning.Text = $"threads: {ThreadCount()}/{m_MaxCamInstances}/{nRunningProcess}"
lblRunning.Invalidate()
DisplayQueueStatus()
' colore btn start / stop...
If m_ProgramStatus = ProgramStatuses.STOP Then
StartProcess.BackColor = ButtonBase.DefaultBackColor
StartProcess.ForeColor = ButtonBase.DefaultForeColor
StopProcess.BackColor = Color.Green
StopProcess.ForeColor = Color.White
Else
StartProcess.BackColor = Color.Green
StartProcess.ForeColor = Color.White
StopProcess.BackColor = ButtonBase.DefaultBackColor
StopProcess.ForeColor = ButtonBase.DefaultForeColor
End If
End Sub
), "")
End Sub
Private Sub SetMaxCamInstances(value As Integer)
' Numero di core logici da utilizzare (minimo tra presenti sul PC e imposti da INI)
Dim nMaxThread As Integer = Math.Min(Environment.ProcessorCount, value)
m_MaxCamInstances = nMaxThread
End Sub
Private Sub startAllThreads()
If m_ProgramStatus = ProgramStatuses.START Then Return
m_bStopProcess = False
m_bExecutionThreadStoped = False
m_ExecutionThread = New Thread(Sub()
ExecutionProcess()
End Sub)
m_ExecutionThread.SetApartmentState(ApartmentState.STA)
' avvio thread di gestione della macchina che avvia la connessione
m_ExecutionThread.Start()
m_ProgramStatus = ProgramStatuses.START
#If False Then
'' recupero Id dei DDF
'Dim sDdfRoot As String = "c:\EgtData\WebDoor\Ddf"
'Dim sCurrDdfDir As String = ""
'Dim nDdfId As Integer = 1
'' Numero di core logici da utilizzare (minimo tra presenti sul PC e imposti da INI)
'Dim nMaxThread As Integer = Math.Min(Environment.ProcessorCount, m_MaxCamInstances)
'Dim bStopMainProcess As Boolean = False
'Dim n30SecCounter As Integer = 0
'While Not bStopMainProcess
' bStopMainProcess = m_bStopProcess
' Dim bOk As Boolean = False
' While Not bOk
' ' ogni 30 secondi
' If n30SecCounter = 30 OrElse n30SecCounter = 0 Then
' ' verifica connessione
' Dim risultatoPing As PingReply = currWDC.testPing
' bOk = risultatoPing.Status = IPStatus.Success
' If bOk Then
' bOk = currWDC.testAlive
' End If
' Else bOk = True
' End If
' ' se connessione non ok o processo fermato, fermo i thread
' If Not bOk OrElse bStopMainProcess Then
' If Not IsNothing(ThreadList) AndAlso ThreadList.Count > 0 Then
' ' li fermo
' m_bStopProcess = True
' ' verifico siano terminati
' Dim bOneNotEnded As Boolean = True
' While bOneNotEnded
' bOneNotEnded = False
' For Each Thread In ThreadList
' If Thread.IsAlive Then
' bOneNotEnded = True
' Exit For
' End If
' Next
' End While
' ' pulisco la lista
' For Each Thread In ThreadList
' Thread = Nothing
' Next
' End If
' If bStopMainProcess Then Return
' End If
' If Not bOk Then Thread.Sleep(10)
' End While
' If bOk AndAlso (IsNothing(ThreadList) OrElse ThreadList.Count = 0) Then
' ThreadList = New Thread(nMaxThread - 1) {}
' For nThreadIndex = 0 To nMaxThread - 1
' ThreadList(nThreadIndex) = New Thread(Sub()
' ThreadFunction()
' End Sub)
' ThreadList(nThreadIndex).SetApartmentState(ApartmentState.STA)
' ' avvio thread di gestione della macchina che avvia la connessione
' ThreadList(nThreadIndex).Start()
' Next
' End If
' If n30SecCounter <= 30 Then
' n30SecCounter += 1
' Else
' n30SecCounter = 1
' End If
' Thread.Sleep(1000)
'End While
'Dim DdfDirs As String() = Directory.GetDirectories(sDdfRoot)
'If DdfDirs.Count = 0 Then
' sCurrDdfDir = sDdfRoot & "\0"
' Directory.CreateDirectory(sCurrDdfDir)
' nDdfId = 0
'Else
' nDdfId = Directory.EnumerateFiles(DdfDirs(DdfDirs.Count - 1)).Max(Of Integer)(Function(x)
' Dim nDirId As Integer = 0
' If Integer.TryParse(x, nDirId) Then
' Return nDirId
' Else
' Return 0
' End If
' End Function)
' If (nDdfId + 1) Mod 100 = 0 Then
' sCurrDdfDir = sDdfRoot & "\" & nDdfId + 1
' Directory.CreateDirectory(sCurrDdfDir)
' nDdfId = 0
' End If
'End If
' ' Lancio in parallelo più processi (senza superare il numero di core logici presenti) Dim
' vProc As MyProc() = New MyProc(nMaxThread - 1) {} For j As Integer = 0 To nMaxThread - 1
' vProc(j).nBar = -1 vProc(j).bEnable = True Next
' While Not m_bStopProcess
' For j As Integer = 0 To nMaxThread - 1 If Not vProc(j).bEnable Then Continue For Dim bDone
' As Boolean = False
' If vProc(j).nBar = -1 Then
' ' se c'e' qualcosa da processare If currWDC.numTask2proc > 0 Then
' Dim LastRequest As Dictionary(Of String, String) = currWDC.queueList(1)
' If vBar(nCurrBar).bBarOk Then vProc(j).Proc = New Process()
' vProc(j).Proc.StartInfo.FileName = ExePath If bIsEdit Then
' vProc(j).Proc.StartInfo.Arguments = """" & vBar(nCurrBar).sBarPath & """" Else
' vProc(j).Proc.StartInfo.Arguments = """" & vBar(nCurrBar).sBarPath & """ " & """" &
' vBar(nCurrBar).nProjType & """ " & """" & vBar(nCurrBar).nMachineName & """ " &
' vBar(nCurrBar).nCmdType End If vProc(j).Proc.StartInfo.UseShellExecute = False
' If vProc(j).Proc.Start() Then vProc(j).nBar = nCurrBar nCurrBar += 1 nActProc += 1 End If
' Else If vBar(nCurrBar).nCmdType = CmdTypes.CHECK OrElse vBar(nCurrBar).nCmdType =
' CmdTypes.CHECKGEN Then RaiseEvent Calc_ProcessResult(Nothing, New
' CalcResultEventArgs(vBar(nCurrBar))) 'ProcessResults(vBar(nCurrBar)) ElseIf
' vBar(nCurrBar).nCmdType = CmdTypes.GENERATE Then RaiseEvent Calc_ProcessResult(Nothing,
' New CalcResultEventArgs(vBar(nCurrBar))) 'ProcessResults(vBar(nCurrBar)) 'RaiseEvent
' Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(nCurrBar)))
' 'ProcessResults(vBar(nCurrBar)) End If bDone = True nCurrBar += 1 End If End If Else
' If vProc(j).Proc.HasExited Then ' se terminato con successo If vProc(j).Proc.ExitCode = 0
' Then ' salvo il risultato If vBar(vProc(j).nBar).nCmdType = CmdTypes.CHECK OrElse
' vBar(vProc(j).nBar).nCmdType = CmdTypes.CHECKGEN Then RaiseEvent
' Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(vProc(j).nBar))) '
' ProcessResults(vBar(vProc(j).nBar)) ElseIf vBar(vProc(j).nBar).nCmdType =
' CmdTypes.GENERATE Then RaiseEvent Calc_ProcessResult(Nothing, New
' CalcResultEventArgs(vBar(vProc(j).nBar))) ' ProcessResults(vBar(vProc(j).nBar))
' 'RaiseEvent Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(vProc(j).nBar)))
' 'ProcessResults(vBar(nCurrBar)) End If bDone = True vProc(j).nBar = -1 nActProc -= 1 ' se
' superato il numero di processi eseguibili in parallelo ElseIf vProc(j).Proc.ExitCode = 1
' Then ' aggiungo il pezzo in coda If numBars + nShiftBar < numBars + nMaxThread Then
' vBar(numBars + nShiftBar) = vBar(vProc(j).nBar) nShiftBar += 1 End If ' disabilito il
' processo vProc(j).bEnable = False vProc(j).nBar = -1 nActProc -= 1 ' altrimenti (errore
' generico di esecuzione) Else ' salvo il risultato If vBar(vProc(j).nBar).nCmdType =
' CmdTypes.CHECK OrElse vBar(vProc(j).nBar).nCmdType = CmdTypes.CHECKGEN Then RaiseEvent
' Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(vProc(j).nBar))) '
' ProcessResults(vBar(vProc(j).nBar)) ElseIf vBar(vProc(j).nBar).nCmdType =
' CmdTypes.GENERATE Then RaiseEvent Calc_ProcessResult(Nothing, New
' CalcResultEventArgs(vBar(vProc(j).nBar))) ' ProcessResults(vBar(vProc(j).nBar))
' 'RaiseEvent Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(vProc(j).nBar)))
' 'ProcessResults(vBar(nCurrBar)) End If bDone = True vProc(j).nBar = -1 nActProc -= 1 End
' If Else vProc(j).Proc.Refresh() End If End If
' If bDone Then ' se sono in simulazione If bIsSimulation Then Dim sOriPath As String =
' Path.ChangeExtension(vBar(0).sBarPath, ".ori.bwe") ' se file modificato a mano If
' File.GetLastWriteTime(sOriPath) < File.GetLastWriteTime(vBar(0).sBarPath) Then ' aggiorno
' progetto If File.Exists(vBar(0).sBarPath) Then File.Copy(vBar(0).sBarPath, sOriPath, True)
' ' messaggio di lancio verifica callback(50, "Verifying modifications...", bCancel) '
' lancio verifica System.Threading.Thread.Sleep(500)
' Dim Proc As New Process()
' Proc.StartInfo.FileName = ExePath
' Proc.StartInfo.Arguments = """" & vBar(0).sBarPath & """ " &
' """" & vBar(0).nProjType & """ " &
'"""" & vBar(0).nMachineName & """ " & CmdTypes.CHECKGEN
' Proc.StartInfo.UseShellExecute = False
' If Proc.Start() Then Dim ProgressValue As Integer = 50 While Not Proc.HasExited
' Proc.Refresh() If ProgressValue < 90 Then ProgressValue += 0.001 callback(ProgressValue,
' "Verifying modifications...", bCancel) Thread.Sleep(1) End While ' se terminato con
' successo If Proc.ExitCode = 0 Then ' salvo il risultato RaiseEvent
' Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(0))) Thread.Sleep(500) End If End
' If End If ' messaggio di completamento simulazione callback(0, "Simulation closing",
' bCancel) ElseIf bIsEdit Then ' ricarico il progetto Dim Result As CalcEndEventArgs.Results
' If bAllKO Then Result = CalcEndEventArgs.Results.ERROR_ ElseIf bIsEdit Then Result =
' CalcEndEventArgs.Results.EDIT Else Result = CalcEndEventArgs.Results.OK End If RaiseEvent
' Calc_Ended(Nothing, New CalcEndEventArgs(CmdTypes.EDIT, Result)) Return Else ' Dialog con
' Progress Bar nDoneBar += 1 dProgress = 1 / numBars * nDoneBar Dim sProg As String =
' (dProgress * 100).ToString("F1", CultureInfo.InvariantCulture) callback(dProgress, "
' Progress: " & sProg & "% Count: " & nDoneBar & " / " & numBars, bCancel) End If If bCancel
' Then ' fine callback(1, "", bCancel) ' riabilito interfaccia RaiseEvent
' Calc_Ended(Nothing, New CalcEndEventArgs(CmdTypes.CHECKGEN, CalcEndEventArgs.Results.OK))
' Return End If nPgsCurrBar = 0 nPgsClock = 0 Else ' se non sono in simulazione If Not
' bIsSimulation AndAlso Not bIsEdit Then ' aggiorno conteggio If nPgsClock >= 100 AndAlso
' nPgsCurrBar < 149 Then nPgsCurrBar += 1 dProgress = 1 / numBars * nDoneBar + 1 / numBars /
' 150 * nPgsCurrBar Dim sProg As String = (dProgress * 100).ToString("F1",
' CultureInfo.InvariantCulture) callback(dProgress, " Progress: " & sProg & "% Count: " &
' nDoneBar & " / " & numBars, bCancel) nPgsClock = 0 End If End If End If nPgsClock += 1
' Thread.Sleep(1) Next
' End While
' m_bStopProcess = False
' Dim num2proc As Integer Dim queueStatus As New Dictionary(Of String, Long) Dim queueList
' As New Dictionary(Of String, String) Dim procResults As New List(Of CalcResultDTO) Dim
' respPut As String Dim fileName As String Dim fileCont As String
' queueStatus = currWDC.queueStatus Dim sb As StringBuilder sb = New StringBuilder
' sb.Append(txtOut.Text) sb.AppendLine("----------------------------") For Each item As
' KeyValuePair(Of String, Long) In queueStatus sb.AppendLine($"{item.Key} | Found
' {item.Value} items") Next sb.AppendLine("----------------------------") sb.AppendLine()
' txtOut.Text = sb.ToString()
' ' recupero numero da processare num2proc = currWDC.numTask2proc If (num2proc > 0) Then
' sb.AppendLine("----------------------------") ' mi prendo la lista dei primi 10 max e
' processo... queueList = currWDC.queueList(10) For Each item As KeyValuePair(Of String,
' String) In queueList fileCont = "" idxSim = idxSim + 1 If (idxSim > 3) Then idxSim = 0 End
' If fileName = Path.Combine("temp", $"Logo{idxSim:00}.svg") If (File.Exists(fileName)) Then
' fileCont = File.ReadAllText(fileName) End If
' ' mi limito a mostrare codice + contenuto DDF... dovrebbe processare invero...
' sb.AppendLine("--------------------------------------------------------")
' sb.AppendLine($"DoorId.Vers: {item.Key}") sb.AppendLine("DDF:") sb.AppendLine("--------")
' sb.AppendLine(item.Value)
' sb.AppendLine("--------------------------------------------------------") sb.AppendLine()
' ' scrivo ddf File.WriteAllText(sCurrDdfDir & "\" & nDdfId, item.Value)
' ' eseguo calcolo
' ' costruisco risposta finta di processing con esito true + SVG Dim currRes As New
' CalcResultDTO currRes.Validated = True currRes.DoorIdVers = item.Key currRes.SvgGen =
' fileCont procResults.Add(currRes) Next sb.AppendLine("----------------------------") sb.AppendLine()
' ' rendo la risposta... respPut = currWDC.SendProcResults(procResults) sb.AppendLine()
' sb.AppendLine("----------------------------") sb.AppendLine("Esito invio risposta al
' server:") sb.AppendLine() sb.AppendLine(respPut) sb.AppendLine("----------------------------")
' txtOut.Text = sb.ToString()
' End If
#End If
End Sub
Private Sub StartProcess_Click(sender As Object, e As EventArgs) Handles StartProcess.Click
startAllThreads()
End Sub
Private Sub StartUiThread()
' avvio timer progBar
TimerUI.Enabled = True
TimerUI.Start()
' avvio il timer di refresh
TimerProgBar.Enabled = True
TimerProgBar.Start()
TimerResetProcessing.Enabled = True
TimerResetProcessing.Start()
End Sub
Private Sub stopAllThreads()
If m_ProgramStatus = ProgramStatuses.STOP Then Return
m_bStopProcess = True
While Not m_bExecutionThreadStoped
Thread.Sleep(100)
End While
If Not IsNothing(m_ExecutionThread) Then
m_ExecutionThread.Abort()
While Not m_ExecutionThread.ThreadState = ThreadState.Aborted
Thread.Sleep(100)
End While
m_ExecutionThread = Nothing
End If
ThreadList = Nothing
m_ProgramStatus = ProgramStatuses.STOP
End Sub
Private Sub StopProcess_Click(sender As Object, e As EventArgs) Handles StopProcess.Click
stopAllThreads()
End Sub
Private Function ThreadCount() As Integer
Dim numCount = 0
If Not IsNothing(ThreadList) Then
' conto i NON nulli
For Each Thread In ThreadList
If Not IsNothing(Thread) Then
numCount += 1
End If
Next
End If
' rendo
Return numCount
End Function
Private Sub ThreadFunction(ThreadIndex As Integer)
Dim MyThreadData As New ThreadData
ThreadDataList(ThreadIndex) = MyThreadData
Dim CurrThreadStat As New ThreadStat(ThreadIndex, DateTime.Now)
HistoryThreadDataList.Add(CurrThreadStat)
MyThreadData.SetThreadStat(CurrThreadStat)
Dim sDrive As String = "c" ' If(ThreadIndex Mod 2 = 0, "A", "B")
Dim sCurrDdfDir As String = sDrive & ":\EgtData\WebDoor\Ddf"
Dim stopWatch As New Stopwatch()
Dim lExeTime As Long = 0
Dim lOtherTime As Long = 0
' avvio processo
Dim Proc As Process = New Process()
Proc.StartInfo.FileName = sEgtEnginePath
Proc.StartInfo.RedirectStandardInput = True
Proc.StartInfo.RedirectStandardOutput = True
Proc.StartInfo.Arguments = ThreadIndex.ToString() & " """ & sDrive & ":\EgtData\WebDoor\TestPipe.lua"""
Proc.StartInfo.UseShellExecute = False
Proc.StartInfo.CreateNoWindow = True
AddHandler Proc.OutputDataReceived, AddressOf Thread_OutputDataReceived
If Proc.Start() Then
Dim CurrPocStat As New ProcStat(DateTime.Now)
CurrThreadStat.ProcExecutionList.Add(CurrPocStat)
Proc.BeginOutputReadLine()
MyThreadData.SetProcess(Proc)
Dim nProc0Wait As Integer = 0
' ciclo per leggere coda ed eseguire
While Not m_bStopProcess AndAlso Not Proc.HasExited
Select Case MyThreadData.WaitProcAnswer
Case ThreadData.ProcComm.Null
MyThreadData.SetThreadOperation(ThreadOperations.WaitingData)
' se c'e' qualcosa da processare
Dim nNumTaskToProcess As Integer = 0
If ThreadIndex = 0 Then
nNumTaskToProcess = currWDC.numTask2proc
If nNumTaskToProcess > 0 Then
If Not m_bCheckOrder Then m_bCheckOrder = True
Else
If m_bCheckOrder Then m_bCheckOrder = False
Thread.Sleep(100)
End If
ElseIf m_bCheckOrder Then
nNumTaskToProcess = currWDC.numTask2proc
If nNumTaskToProcess = 0 Then
m_bCheckOrder = False
End If
End If
If m_bCheckOrder Then
Dim LastRequest As Dictionary(Of String, CalcReqtDTO) = currWDC.queueList(1)
If LastRequest.Count > 0 Then
MyThreadData.SetThreadOperation(ThreadOperations.FoundRequest)
' ToDo !!!
' gestione cablata x soli svg...
' da qui implementazione svg/3dm...
If LastRequest.First().Value.MimeType = "3dm" Then
End If
Dim ConvItem As KeyValuePair(Of String, String)
ConvItem = New KeyValuePair(Of String, String)(LastRequest.First().Key, LastRequest.First().Value.DDF)
MyThreadData.SetCurrRequest(ConvItem)
' vecchia versione
'MyThreadData.SetCurrRequest(LastRequest.First())
Dim Item As KeyValuePair(Of String, String) = MyThreadData.CurrRequest
Dim bOk As Boolean = Not IsNothing(Item)
If bOk Then
' avvio cronometro
'stopWatch.Reset()
stopWatch.Restart()
' svuoto vecchio set file della porta richiesta
Dim fileList As String() = Directory.GetFiles(sCurrDdfDir, Item.Key + ".*")
' elimino vecchi
If Not IsNothing(fileList) Then
For Each sFile In fileList
Try
File.Delete(sFile)
Catch ex As Exception
End Try
Next
End If
' scrivo ddf
MyThreadData.SetThreadOperation(ThreadOperations.WritingDdf)
MyThreadData.SetDdfPath(sCurrDdfDir & "\" & Item.Key & ".ddf")
Dim sDdfPath As String = MyThreadData.sDdfPath
Try
File.WriteAllText(sDdfPath, Item.Value)
Catch ex As Exception
bOk = False
End Try
If bOk Then
MyThreadData.SetThreadOperation(ThreadOperations.ProcessingDdf)
Proc.StandardInput.WriteLine(ThreadIndex & "," & sDdfPath)
MyThreadData.SetWaitProcAnswer(ThreadData.ProcComm.WaitingAnswer)
End If
End If
Else
Thread.Sleep(100)
End If
Else
Thread.Sleep(100)
End If
Case ThreadData.ProcComm.WaitingAnswer
Thread.Sleep(10)
Case ThreadData.ProcComm.AnswerReceived
Dim Item As KeyValuePair(Of String, String) = MyThreadData.CurrRequest
Dim sDdfPath As String = MyThreadData.sDdfPath
Dim bOk As Boolean = True
' salvo exe time...
stopWatch.Stop()
lExeTime = stopWatch.ElapsedMilliseconds
stopWatch.Restart()
Dim procResults As New List(Of CalcResultDTO)
Dim currRes As New CalcResultDTO
Dim fContent As String = ""
MyThreadData.SetThreadOperation(ThreadOperations.ReadingSvg)
' verifico esistenza file svg e lo carico
bOk = GetFileContent(Path.ChangeExtension(sDdfPath, "svg"), fContent)
' !!! ToDo: inserire TIPO di richiesta secondo quanto ricevuto....
' invio risposta
currRes.Validated = MyThreadData.nProcResult = 0 AndAlso bOk
currRes.DoorIdVers = Item.Key
' per ora cablato a svg, prendere da MimeType richiesta...
currRes.MimeType = "svg"
' se NON fosse validato --> messo il messaggio...
If (currRes.Validated) Then
currRes.RawContent = fContent
Else
bOk = GetFileContent(Path.ChangeExtension(sDdfPath, "txt"), fContent)
currRes.ErrorMsg = fContent
End If
MyThreadData.SetThreadOperation(ThreadOperations.SendResult)
procResults.Add(currRes)
Dim respPut As String = currWDC.SendProcResults(procResults)
stopWatch.Stop()
lOtherTime = stopWatch.ElapsedMilliseconds
CurrPocStat.IncrementDoneRequest()
' aggiorno thread display...
UpdateThreadList(Item.Key, lExeTime, lOtherTime)
' cambio nomi file generati in old
Dim OldSvg As String = Path.ChangeExtension(sDdfPath, "svg")
Dim NewSvg As String = Path.GetDirectoryName(sDdfPath) & "\" & Path.GetFileNameWithoutExtension(sDdfPath) & "_old.svg"
Try
File.Delete(NewSvg)
Catch ex As Exception
End Try
Try
File.Delete(Path.ChangeExtension(NewSvg, "txt"))
Catch ex As Exception
End Try
Try
File.Delete(Path.ChangeExtension(NewSvg, "log"))
Catch ex As Exception
End Try
Try
File.Delete(Path.ChangeExtension(NewSvg, "nge"))
Catch ex As Exception
End Try
Try
File.Delete(Path.ChangeExtension(NewSvg, "ddf"))
Catch ex As Exception
End Try
Try
File.Move(OldSvg, NewSvg)
Catch ex As Exception
End Try
Try
File.Move(Path.ChangeExtension(OldSvg, "txt"), Path.ChangeExtension(NewSvg, "txt"))
Catch ex As Exception
End Try
Try
File.Move(Path.ChangeExtension(OldSvg, "log"), Path.ChangeExtension(NewSvg, "log"))
Catch ex As Exception
End Try
Try
File.Move(Path.ChangeExtension(OldSvg, "nge"), Path.ChangeExtension(NewSvg, "nge"))
Catch ex As Exception
End Try
Try
File.Move(Path.ChangeExtension(OldSvg, "ddf"), Path.ChangeExtension(NewSvg, "ddf"))
Catch ex As Exception
End Try
MyThreadData.SetWaitProcAnswer(ThreadData.ProcComm.Null)
End Select
End While
CurrPocStat.SetStopProc(DateTime.Now)
If m_bStopProcess Then
Proc.StandardInput.WriteLine("quit")
End If
End If
CurrThreadStat.SetStopThread(DateTime.Now)
MyThreadData.SetProcess(Nothing)
MyThreadData.SetThreadOperation(ThreadOperations.Closed)
End Sub
Private Sub Thread_OutputDataReceived(sender As Object, e As DataReceivedEventArgs)
Dim sResult As String = e.Data
If Not String.IsNullOrWhiteSpace(sResult) AndAlso sResult.StartsWith("#42315#,") Then
Dim Results() As String = sResult.Split(","c)
If Results.Count >= 2 Then
Dim nIndex As Integer = -1
Dim nResult As Integer = -1
If Integer.TryParse(Results(1), nIndex) AndAlso nIndex >= 0 Then
If Integer.TryParse(Results(2), nResult) AndAlso nResult >= 0 Then
ThreadDataList(nIndex).SetProcResult(nResult)
End If
ThreadDataList(nIndex).SetWaitProcAnswer(ThreadData.ProcComm.AnswerReceived)
End If
End If
End If
End Sub
Private Sub TimerProgBar_Tick(sender As Object, e As EventArgs) Handles TimerProgBar.Tick
' esegue refresh prog bar
performBarAdvance()
End Sub
Private Sub TimerUI_Tick(sender As Object, e As EventArgs) Handles TimerUI.Tick
' effettuo refresh code e status thread
performUpdateUI()
UpdateThreadCurrentStatus()
End Sub
Private Sub txtNumThread_TextChanged(sender As Object, e As EventArgs) Handles txtNumThread.TextChanged
Dim numReq As Integer = 1
Integer.TryParse(txtNumThread.Text, numReq)
' controllo se cambiato il num thread
If numReq <> m_MaxCamInstances Then
If m_bStopProcess = False Then
stopAllThreads()
Thread.Sleep(200)
End If
' imposto
SetMaxCamInstances(numReq)
End If
End Sub
Private isUpdatingThreads As Boolean = False
''' <summary>
''' Esecuzione update display lista stato threads
''' </summary>
Private Sub UpdateThreadList(tId As String, tExeCam As Long, tOther As Long)
synchronizationContext.Post(New SendOrPostCallback(
Sub(o)
If Not isUpdatingThreads Then
isUpdatingThreads = True
ProcStats.RecordData(m_MaxCamInstances, tExeCam, tOther)
ProcStats.RecordList.Enqueue((tId, tExeCam, tOther))
'Begin the update
LISTThreadStatus.BeginUpdate()
LISTThreadStatus.Items.Clear()
' compilo in base al tipo di stat richiesta
If (chkStatAggr.Checked) Then
' statistiche di sintesi
Dim sorted = From pair In ProcStats.ExeCumSum
Order By pair.Key
For Each item In sorted
LISTThreadStatus.Items.Add(
New ListViewItem(New String() {item.Key,
$"{item.Value.NumRec} x {item.Value.ExeTime / item.Value.NumRec:N2} ms",
$"{item.Value.NumRec} x {item.Value.OthTime / item.Value.NumRec:N2} ms"
}))
Next
Else
' formato log
Dim maxItems As Integer = 15
While ProcStats.RecordList.Count > maxItems
Dim oldItem As (String, Long, Long) = ("", 0, 0)
ProcStats.RecordList.TryDequeue(oldItem)
End While
For Each item As (String, Long, Long) In ProcStats.RecordList.Reverse
LISTThreadStatus.Items.Add(New ListViewItem(New String() {
item.Item1,
$"{item.Item2} ms",
$"{item.Item3} ms"
}))
Next
End If
'End the update
LISTThreadStatus.EndUpdate()
isUpdatingThreads = False
End If
End Sub
), "")
End Sub
#End Region
#If False Then
'Private Sub btnFullTest_Click(sender As Object, e As EventArgs) Handles btnFullTest.Click
' Dim num2proc As Integer Dim queueStatus As New Dictionary(Of String, Long) Dim queueList As
' New Dictionary(Of String, String) Dim procResults As New List(Of CalcResultDTO) Dim respPut As
' String Dim fileName As String Dim fileCont As String
' queueStatus = currWDC.queueStatus Dim sb As StringBuilder sb = New StringBuilder
' sb.AppendLine("----------------------------") For Each item As KeyValuePair(Of String, Long)
' In queueStatus sb.AppendLine($"{item.Key} | Found {item.Value} items") Next
' sb.AppendLine("----------------------------") sb.AppendLine() txtOut.Text = sb.ToString() '
' recupero numero da processare num2proc = currWDC.numTask2proc If (num2proc > 0) Then
' sb.AppendLine("----------------------------") ' mi prendo la lista dei primi 10 max e
' processo... queueList = currWDC.queueList(10) For Each item As KeyValuePair(Of String, String)
' In queueList fileCont = "" idxSim = idxSim + 1 If (idxSim > 3) Then idxSim = 0 End If fileName
' = Path.Combine("temp", $"Logo{idxSim:00}.svg") If (File.Exists(fileName)) Then fileCont =
' File.ReadAllText(fileName) End If
' ' mi limito a mostrare codice + contenuto DDF... dovrebbe processare invero...
' sb.AppendLine("--------------------------------------------------------")
' sb.AppendLine($"DoorId.Vers: {item.Key}") sb.AppendLine("DDF:") sb.AppendLine("--------")
' sb.AppendLine(item.Value)
' sb.AppendLine("--------------------------------------------------------") sb.AppendLine()
' ' costruisco risposta finta di processing con esito true + SVG Dim currRes As New
' CalcResultDTO currRes.Validated = True currRes.DoorIdVers = $"{item.Key}.{item.Value}"
' currRes.SvgGen = fileCont procResults.Add(currRes) Next
' sb.AppendLine("----------------------------") sb.AppendLine()
' ' rendo la risposta... respPut = currWDC.SendProcResults(procResults) sb.AppendLine()
' sb.AppendLine("----------------------------") sb.AppendLine("Esito invio risposta al server:")
' sb.AppendLine() sb.AppendLine(respPut) sb.AppendLine("----------------------------")
' txtOut.Text = sb.ToString() End If
'End Sub
#End If
#Region "Private Structs"
Private Structure MyProc
#Region "Public Fields"
Public bEnable As Boolean
Public nBar As Integer
Public Proc As Process
Public Thread As Thread
#End Region
End Structure
''' <summary>
''' Esportazione statistiche attuali esecuzione
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub btnExportStats_Click(sender As Object, e As EventArgs) Handles btnExportStats.Click
' statistiche di sintesi
Dim sorted = From pair In ProcStats.ExeCumSum
Order By pair.Key
' preparo il file export...
Dim fileName As String
Dim adesso As DateTime = DateTime.Now
fileName = Path.Combine("C:\Temp\", $"WDC_Stats_{adesso:yyyyMMdd-HHmmss}.csv")
Dim sb As StringBuilder = New StringBuilder
sb.AppendLine("Threads;Samples;ExeTime;OtherTime;FullTime")
For Each item In sorted
' preparo la linea CSV...
sb.AppendLine($"{item.Key};{item.Value.NumRec};{item.Value.ExeTime / item.Value.NumRec:N2};{item.Value.OthTime / item.Value.NumRec:N2};{(item.Value.ExeTime + item.Value.OthTime) / item.Key:N2}")
Next
' scrivo!
File.WriteAllText(fileName, sb.ToString())
End Sub
Private Sub ProcMan_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
' forzo chiusura threads!
If m_ProgramStatus = ProgramStatuses.START Then stopAllThreads()
EgtExit()
' fix timer
TimerProgBar.Stop()
TimerProgBar.Enabled = False
TimerResetProcessing.Stop()
TimerResetProcessing.Enabled = False
TimerUI.Stop()
TimerUI.Enabled = False
TimerCheck.Stop()
TimerCheck.Enabled = False
End Sub
Private Sub chkAutoRestart_CheckedChanged(sender As Object, e As EventArgs) Handles chkAutoRestart.CheckedChanged
CheckStartAutoRestart()
End Sub
Private Sub CheckStartAutoRestart()
TimerCheck.Enabled = chkAutoRestart.Checked
If chkAutoRestart.Checked Then
If IsNothing(m_ExecutionThread) Then
startAllThreads()
ElseIf m_ExecutionThread.ThreadState = ThreadState.Aborted OrElse m_ExecutionThread.ThreadState = ThreadState.Stopped OrElse
m_ExecutionThread.ThreadState = ThreadState.Suspended Then
stopAllThreads()
Thread.Sleep(200)
While Not IsNothing(m_ExecutionThread)
Thread.Sleep(100)
End While
Thread.Sleep(100)
startAllThreads()
End If
TimerCheck.Start()
Else
TimerCheck.Stop()
End If
End Sub
Private Sub TimerCheck_Tick(sender As Object, e As EventArgs) Handles TimerCheck.Tick
restartAll()
End Sub
Private Sub restartAll()
If Not IsNothing(m_ExecutionThread) Then
stopAllThreads()
Thread.Sleep(200)
While Not IsNothing(m_ExecutionThread)
Thread.Sleep(100)
End While
Thread.Sleep(100)
End If
startAllThreads()
End Sub
Private Sub ProcMan_Load(sender As Object, e As EventArgs) Handles MyBase.Load
m_IniFilePath = AppDomain.CurrentDomain.BaseDirectory & INI_FILE_NAME
ManageInstance()
'' Imposto tipo di chiave
'EgtSetLockType(KEY_TYPE.HW)
'' Leggo e imposto chiave di protezione
'Dim sLicFileName As String = String.Empty
'GetPrivateProfileString(S_GENERAL, K_LICENCE, LIC_FILE_NAME, sLicFileName, m_IniFilePath)
'Dim sLicFile As String = AppDomain.CurrentDomain.BaseDirectory & sLicFileName
'Dim sKey As String = String.Empty
'EgtUILib.GetPrivateProfileString(S_LICENCE, K_KEY, "", sKey, sLicFile)
'EgtSetKey(sKey)
'Dim bNetHwKey As Boolean = (GetPrivateProfileInt(S_GENERAL, K_NETKEY, 0, m_IniFilePath) = 1)
'EgtSetNetHwKey(bNetHwKey)
'Dim sLockId As String = ""
'EgtUILib.GetPrivateProfileString(S_LICENCE, K_LOCKID, "", sLockId, sLicFile)
'If Not String.IsNullOrEmpty(sLockId) Then
' Dim x = EgtSetLockId(sLockId)
'End If
'' Recupero livello e opzioni della chiave
'Dim nKeyLevel As Integer = 0
'Dim nKeyOptions As Integer = 0
'Dim bKey As Boolean = EgtGetKeyLevel(9935, 2505, 1, nKeyLevel) And
' EgtGetKeyOptions(9935, 2505, 1, nKeyOptions)
' Inizializzazione generale di EgtInterface
m_sLogFile = AppDomain.CurrentDomain.BaseDirectory & GENLOG_FILE_NAME.Replace("#", m_nInstance.ToString())
Dim sLogMsg As String = "User " & Environment.MachineName & "\" & Environment.UserName & " (" & m_nInstance.ToString() & ")" & vbLf &
My.Application.Info.Title.ToString() & " ver. " &
My.Application.Info.Version.Major.ToString() &
"." & My.Application.Info.Version.Minor.ToString() &
(ChrW(97 - 1 + My.Application.Info.Version.Build)).ToString() &
My.Application.Info.Version.Revision.ToString()
EgtInit(0, m_sLogFile, sLogMsg)
'If Not bKey Then
' MessageBox.Show("No licences available!", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
' End
'End If
' leggo sorgente richieste rest da ini
GetPrivateProfileString(S_GENERAL, K_BASEIP, "", baseIp, m_IniFilePath)
GetPrivateProfileString(S_GENERAL, K_BASEURL, "", baseUrl, m_IniFilePath)
' inizializzo oggetto web
currWDC = New WDC(baseIp, baseUrl, codPost)
txtNumThread.Text = GetPrivateProfileInt(S_GENERAL, K_STARTINSTANCES, 1, m_IniFilePath).ToString()
' recupero path EgtEngine
GetPrivateProfileString(S_GENERAL, K_PROCESSPATH, "", sEgtEnginePath, m_IniFilePath)
MyBase.Text = baseUrl
End Sub
Dim m_objMutex As Mutex
Dim m_bFirstInstance As Boolean
Dim m_nInstance As Integer
Dim m_IniFilePath As String = ""
Dim m_sLogFile As String = ""
Private Sub ManageInstance()
Dim bCreated As Boolean
Try
Dim sMutexName As String = "Global\WebDoorCreator.CamSrv"
GetPrivateProfileString(S_GENERAL, K_MUTEXNAME, sMutexName, sMutexName, m_IniFilePath)
m_objMutex = New Mutex(False, sMutexName, bCreated)
Catch
bCreated = False
End Try
m_bFirstInstance = bCreated
If bCreated Then
' Prima istanza
m_nInstance = 1
' Aggiorno stato istanze attive
WritePrivateProfileString(S_GENERAL, K_INSTANCES, m_nInstance.ToString(), m_IniFilePath)
Else
' Leggo il massimo numero di istanze ammesse
Const MAX_INST As Integer = 32
Dim nMaxInst As Integer = GetPrivateProfileInt(S_GENERAL, K_MAXINST, 1, m_IniFilePath)
nMaxInst = Math.Max(1, Math.Min(nMaxInst, MAX_INST))
' Cerco il primo indice di istanza libero
Dim nTmp As Integer = GetPrivateProfileInt(S_GENERAL, K_INSTANCES, 0, m_IniFilePath)
m_nInstance = 1
Dim nMask As Integer = 1
While (nTmp And nMask) <> 0 And m_nInstance <= MAX_INST
m_nInstance += 1
nMask *= 2
End While
' Se l'indice supera il massimo
If m_nInstance > nMaxInst Then
' porto in primo piano la prima istanza
Dim bFound As Boolean = False
' processi del programma a 32 bit
Dim localProc As Process() = Process.GetProcessesByName("WebDoorCreator.CamSrv")
For Each p As Process In localProc
If p.Id <> Process.GetCurrentProcess().Id Then
bFound = True
ShowWindow(p.MainWindowHandle, 1)
Exit For
End If
Next
' se non trovati processi a 32 bit provo a 64 bit
If Not bFound Then
localProc = Process.GetProcessesByName("IcarusR64")
For Each p As Process In localProc
If p.Id <> Process.GetCurrentProcess().Id Then
bFound = True
ShowWindow(p.MainWindowHandle, SW.RESTORE)
Exit For
End If
Next
End If
' esco dal programma
End
End If
' Aggiorno stato istanze attive
nTmp += (1 << (m_nInstance - 1))
WritePrivateProfileString(S_GENERAL, K_INSTANCES, nTmp.ToString(), m_IniFilePath)
End If
End Sub
Friend Function GetMaxInstances() As Integer
' Leggo il massimo numero di istanze ammesse
Dim nMaxInst As Integer = GetPrivateProfileInt(S_GENERAL, K_MAXINST, 1, m_IniFilePath)
Return 1 ' Max(1, Min(nMaxInst, MAX_INST))
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' chiudo tutti i processi EgtEngine
' processi del programma a 32 bit
Dim localProc As Process() = Process.GetProcessesByName("EgtEngineR32")
For Each p As Process In localProc
p.Kill()
Next
localProc = Process.GetProcessesByName("EgtEngineR64")
For Each p As Process In localProc
p.Kill()
Next
End Sub
Private Sub TimerResetProcessing_Tick(sender As Object, e As EventArgs) Handles TimerResetProcessing.Tick
If Not IsNothing(currWDC) Then
currWDC.ResetQueueProcessing()
End If
End Sub
#End Region
End Class