Imports System.IO Imports System.Globalization Imports EgtUILib Module ToolsUpdate ' Classe CLD (correttore, lunghezza, diametro) di un utensile Class CldTool ' Membri Friend nCorr As Integer Friend dLen As Double Friend dDiam As Double ' Costruttori Sub New() nCorr = 0 dLen = 0 dDiam = 0 End Sub Sub New(nC As Integer, dL As Double, dD As Double) nCorr = nC dLen = dL dDiam = dD End Sub End Class ' Classe di confronto tra utensili basata sul numero di correttore Class CldToolComparer Implements IComparer(Of CldTool) ' Funzione di confronto Friend Function Compare(x As CldTool, y As CldTool) As Integer Implements IComparer(Of CldTool).Compare If x.nCorr > y.nCorr Then Return 1 If x.nCorr < y.nCorr Then Return -1 Return 0 End Function End Class Friend Function UpdateTools(sFile As String, sMachine As String, bTest As Boolean) As Boolean EgtOutLog("-- Start UpdateTools --") ' Inizializzo stato senza errori Dim nErr As Integer = 0 Dim sErrFile As String = Path.ChangeExtension(sFile, ".txt") Try My.Computer.FileSystem.DeleteFile(sErrFile) Catch ex As Exception End Try ' Vettore di Cld degli utensili Dim vCldTool As New List(Of CldTool)(256) ' Lettura file utensili If Not LoadTools(sFile, vCldTool) Then WriteErrorFile(sErrFile, 1, Nothing) Return False End If ' Imposto la macchina corrente If Not EgtSetCurrMachine(sMachine) Then WriteErrorFile(sErrFile, 2, Nothing) Return False End If ' Eseguo aggiornamento Dim sInfo As String = String.Empty If Not ExecUpdate(vCldTool, bTest, sInfo) Then WriteErrorFile(sErrFile, 3, sInfo) Return False End If ' Salvo informazioni WriteErrorFile(sErrFile, 0, sInfo) Return True End Function Private Function LoadTools(sFile As String, ByRef vCldTool As List(Of CldTool)) As Boolean ' Classe di confronto Dim ToolComp As New CldToolComparer ' Leggo i dati degli utensili dal file Try Dim sr As StreamReader = New StreamReader(sFile) Do While sr.Peek() > -1 ' Leggo la linea Dim sLine As String = sr.ReadLine() ' La divido usando come separatore ';' Dim sItems() As String = sLine.Split(";"c) ' Ci devono essere almeno tre parti If sItems.Count() < 3 Then Continue Do ' Leggo i valori Dim OneCldT As New CldTool If Not Integer.TryParse(sItems(0), OneCldT.nCorr) OrElse OneCldT.nCorr = 0 Then Continue Do If Not Double.TryParse(sItems(1), NumberStyles.Float, CultureInfo.InvariantCulture, OneCldT.dLen) Then Continue Do If Not Double.TryParse(sItems(2), NumberStyles.Float, CultureInfo.InvariantCulture, OneCldT.dDiam) Then Continue Do ' Se non c'è già un record con lo stesso correttore, lo inserisco Dim nI As Integer = vCldTool.BinarySearch(OneCldT, ToolComp) If nI < 0 Then Dim nNextI = Not nI vCldTool.Insert(nNextI, OneCldT) End If Loop sr.Close() Return True Catch ex As Exception Return False End Try End Function Private Function ExecUpdate(ByRef vCldTool As List(Of CldTool), bTest As Boolean, ByRef sInfo As String) As Boolean ' Classe di confronto Dim ToolComp As New CldToolComparer ' Ciclo su tutti gli utensili nel DB Const ALL_TOOLS As Integer = MCH_TF.DRILLBIT + MCH_TF.SAWBLADE + MCH_TF.MILL + MCH_TF.MORTISE + MCH_TF.CHISEL + MCH_TF.WATERJET + MCH_TF.COMPO Dim sName As String = String.Empty Dim nType As Integer = 0 Dim bNext As Boolean = EgtTdbGetFirstTool(ALL_TOOLS, sName, nType) While bNext EgtTdbSetCurrTool(sName) Dim nCorr As Integer = 0 EgtTdbGetCurrToolParam(MCH_TP.CORR, nCorr) If nCorr > 0 Then Dim nI As Integer = vCldTool.BinarySearch(New CldTool(nCorr, 0, 0), ToolComp) If nI >= 0 Then ' Recupero i dati dell'utensile nel DB Dim dLen As Double = 0 EgtTdbGetCurrToolParam(MCH_TP.LEN, dLen) Dim dTotLen As Double = 0 EgtTdbGetCurrToolParam(MCH_TP.TOTLEN, dTotLen) Dim dDiam As Double = 0 EgtTdbGetCurrToolParam(MCH_TP.DIAM, dDiam) Dim dTotDiam As Double = 0 EgtTdbGetCurrToolParam(MCH_TP.TOTDIAM, dTotDiam) Dim dMaxMat As Double = 0 EgtTdbGetCurrToolParam(MCH_TP.MAXMAT, dMaxMat) ' Modifiche della lunghezza Dim dDeltaL As Double = 0 If vCldTool(nI).dLen > EPS_SMALL Then dDeltaL = vCldTool(nI).dLen - dLen EgtTdbSetCurrToolParam(MCH_TP.LEN, vCldTool(nI).dLen) EgtTdbSetCurrToolParam(MCH_TP.TOTLEN, dTotLen + dDeltaL) End If ' Modifiche del diametro Dim dDeltaD As Double = 0 If vCldTool(nI).dDiam > EPS_SMALL And (nType = MCH_TY.SAW_STD Or nType = MCH_TY.SAW_FLAT Or nType = MCH_TY.MILL_STD Or nType = MCH_TY.MILL_NOTIP Or nType = MCH_TY.CHISEL_STD) Then dDeltaD = vCldTool(nI).dDiam - dDiam EgtTdbSetCurrToolParam(MCH_TP.DIAM, vCldTool(nI).dDiam) EgtTdbSetCurrToolParam(MCH_TP.TOTDIAM, dTotDiam + dDeltaD) End If ' Aggiornamento del massimo materiale lavorabile If nType = MCH_TY.SAW_STD Or nType = MCH_TY.SAW_FLAT Then EgtTdbSetCurrToolParam(MCH_TP.MAXMAT, dMaxMat + dDeltaD / 2) Else EgtTdbSetCurrToolParam(MCH_TP.MAXMAT, dMaxMat + dDeltaL) End If ' Se non è test salvo modifiche utensile If Not bTest Then EgtTdbSaveCurrTool() ' informazioni Dim sOut As String = sName & " (" & ToolTypeToString(nType) & ")" & " C=" & nCorr.ToString() & " L=" & dLen.ToString("F3", CultureInfo.InvariantCulture) & " D=" & dDiam.ToString("F3", CultureInfo.InvariantCulture) & " NewL=" & vCldTool(nI).dLen.ToString("F3", CultureInfo.InvariantCulture) & " NewD=" & vCldTool(nI).dDiam.ToString("F3", CultureInfo.InvariantCulture) sInfo &= sOut & vbCrLf EgtOutLog(sOut) Else Dim sOut As String = sName & " (" & ToolTypeToString(nType) & ")" & " C=" & nCorr.ToString() & " not found" sInfo &= sOut & vbCrLf EgtOutLog(sOut) End If Else Dim sOut As String = sName & " (" & ToolTypeToString(nType) & ")" & " without corrector" sInfo &= sOut & vbCrLf EgtOutLog(sOut) End If bNext = EgtTdbGetNextTool(ALL_TOOLS, sName, nType) End While ' Se non è test, salvo il DB utensili modificato If Not bTest Then EgtTdbSave() Return True End Function Private Function ToolTypeToString(nType As Integer) As String Select Case nType Case MCH_TY.DRILL_STD Return "Drill" Case MCH_TY.DRILL_LONG Return "LongDrill" Case MCH_TY.SAW_STD Return "Saw" Case MCH_TY.SAW_FLAT Return "FlatSaw" Case MCH_TY.MILL_STD Return "Mill" Case MCH_TY.MILL_NOTIP Return "NoTipMill" Case MCH_TY.CHISEL_STD Return "Chisel" Case MCH_TY.COMPO Return "Compo" Case Else Return "Unknown" End Select End Function Private Function WriteErrorFile(sErrFile As String, nErr As Integer, sInfo As String) As Boolean Try Dim sw As StreamWriter = New StreamWriter(sErrFile) sw.WriteLine("Err=" & nErr.ToString()) If Not IsNothing(sInfo) Then sw.WriteLine(sInfo) sw.Close() Return True Catch ex As Exception Return False End Try End Function End Module