Imports System.IO Imports System.Net.NetworkInformation Imports System.Text Imports System.Threading Imports WeebDoorCreator.SDK Public Class Form1 #Region "Public Methods" Public Sub DisplayQueueStatus() Dim queueStatus As New Dictionary(Of String, Long) 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() End Sub Public Sub SetMaxCamInstances(value As Integer) m_MaxCamInstances = value End Sub #End Region Private ReadOnly synchronizationContext As SynchronizationContext Private Sub performBarAdvance() synchronizationContext.Post(New SendOrPostCallback(Function(o) tsProgBar.PerformStep() If tsProgBar.Value >= tsProgBar.Maximum Then tsProgBar.Value = 0 End If tsProgBar.Invalidate() End Function), "") End Sub #Region "Private Fields" ' 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" ' nome macchina calcolo Dim currWDC As WDC = New WDC(baseIp, baseUrl, codPost) Dim idxSim As Integer = 0 Dim m_bExecutionThreadStoped As Boolean = False Dim m_bStopProcess As Boolean = False Dim m_ExecutionThread As Thread 'Private m_MaxCamInstances As Integer = 8 Private m_MaxCamInstances As Integer = 1 Dim risultatoPing As PingReply = Nothing Dim ThreadList As Thread() #End Region #Region "Private Methods" 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 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 ExecutionProcess() ' 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 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 Thread.IsAlive Then bOneNotEnded = True End If Next End While ' pulisco la lista For ThreadIndex = 0 To ThreadList.Count - 1 ThreadList(ThreadIndex) = Nothing Next 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 OrElse IsNothing(ThreadList(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() Thread.Sleep(10) Next End If 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 StartProcess_Click(sender As Object, e As EventArgs) Handles StartProcess.Click m_bStopProcess = False ' fix colori StartProcess.BackColor = Color.Green StartProcess.ForeColor = Color.White 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() '' 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 Sub Private Sub StopProcess_Click(sender As Object, e As EventArgs) Handles StopProcess.Click m_bStopProcess = True ' fix colori StartProcess.BackColor = ButtonBase.DefaultBackColor StartProcess.ForeColor = ButtonBase.DefaultForeColor While Not m_bExecutionThreadStoped Thread.Sleep(10) End While m_ExecutionThread = Nothing End Sub Private Sub ThreadFunction() Dim sExePath As String = "c:\EgtProg\EgtEngine\EgtEngineR32.exe" Dim sCurrDdfDir As String = "c:\EgtData\WebDoor\Ddf" While Not m_bStopProcess ' se c'e' qualcosa da processare If currWDC.numTask2proc > 0 Then Dim LastRequest As Dictionary(Of String, String) = currWDC.queueList(1) If LastRequest.Count > 0 Then Dim Item As KeyValuePair(Of String, String) = LastRequest.First() Dim bOk As Boolean = Not IsNothing(Item) If bOk Then ' 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 File.Delete(sFile) Next End If ' scrivo ddf Dim sDdfPath As String = sCurrDdfDir & "\" & Item.Key & ".ddf" Try File.WriteAllText(sDdfPath, Item.Value) Catch ex As Exception bOk = False End Try If bOk Then ' eseguo calcolo Dim Proc As New Process() Proc.StartInfo.FileName = sExePath Proc.StartInfo.Arguments = """C:\EgtData\WebDoor\Main.lua""" & " """ & sDdfPath & """" Proc.StartInfo.UseShellExecute = False If Proc.Start() Then While Not Proc.HasExited Thread.Sleep(1) End While Dim procResults As New List(Of CalcResultDTO) Dim currRes As New CalcResultDTO Dim fContent As String = "" ' verifico esistenza file svg e lo carico bOk = GetFileContent(Path.ChangeExtension(sDdfPath, "svg"), fContent) ' invio risposta currRes.Validated = Proc.ExitCode = 0 AndAlso bOk currRes.DoorIdVers = Item.Key ' se NON fosse validato --> messo il messaggio... If (currRes.Validated) Then currRes.SvgGen = fContent Else bOk = GetFileContent(Path.ChangeExtension(sDdfPath, "txt"), fContent) currRes.ErrorMsg = fContent End If procResults.Add(currRes) Dim respPut As String = currWDC.SendProcResults(procResults) End If End If End If End If End If End While End Sub #End Region #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 #End Region End Class