Files
webdoorcreator/DemoVB/Form1.vb
T
Emmanuele Sassi eabf5ba12e - bozza thread di esecuzione processi
- try su funzioni Db
2023-05-11 12:22:37 +02:00

536 lines
23 KiB
VB.net

Imports System.Globalization
Imports System.IO
Imports System.Net.NetworkInformation
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Threading
Imports System.Windows.Forms.VisualStyles.VisualStyleElement.ToolTip
Imports WeebDoorCreator.SDK
Public Class Form1
' 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 risultatoPing As PingReply = Nothing
Dim currWDC As WDC = New WDC(baseIp, baseUrl, codPost)
Dim m_bStopProcess As Boolean = False
Private m_MaxCamInstances As Integer = 1
Public Sub SetMaxCamInstances(value As Integer)
m_MaxCamInstances = value
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 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
Dim idxSim As Integer = 0
Private Sub StopProcess_Click(sender As Object, e As EventArgs) Handles StopProcess.Click
m_bStopProcess = True
End Sub
Private Structure MyProc
Public bEnable As Boolean
Public Proc As Process
Public Thread As Thread
Public nBar As Integer
End Structure
Dim ThreadList As Thread()
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
' 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
' verifico esistenza file svg e lo carico
Dim sSvgPath As String = Path.ChangeExtension(sDdfPath, "svg")
bOk = File.Exists(sSvgPath)
Dim sSvgContent As String = ""
If bOk Then
Try
sSvgContent = File.ReadAllText(sSvgPath)
Catch ex As Exception
bOk = False
sSvgContent = ""
End Try
End If
' invio risposta
currRes.Validated = Proc.ExitCode = 0 AndAlso bOk
currRes.DoorIdVers = Item.Key
currRes.SvgGen = sSvgContent
procResults.Add(currRes)
Dim respPut As String = currWDC.SendProcResults(procResults)
End If
End If
End If
End If
End If
End While
End Sub
Private Sub StartProcess_Click(sender As Object, e As EventArgs) Handles StartProcess.Click
' recupero Id dei DDF
Dim sDdfRoot As String = "c:\EgtData\WebDoor\Ddf"
Dim sCurrDdfDir As String = ""
Dim nDdfId As Integer = 1
'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
' 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)
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
' ' 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 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 btnResetQueue_Click(sender As Object, e As EventArgs) Handles btnResetQueue.Click
currWDC.ResetQueue()
txtOut.Text = "Queue Resetted!"
End Sub
Private Sub btnQueueStatus_Click(sender As Object, e As EventArgs) Handles btnQueueStatus.Click
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
End Class