L
LuigiB
Guest
Ciao a tutti , come avevo detto per rendere piu agevoli le statistiche sui sistemi virtuali si sono rese necessarie delle aggiunte al linguaggio dello script m dovete munirvi della nuova versione del programma
Ho preparato il seguente script che serve per generare gli archivi virtuali , la prima volta che si generano non è proprio velocissimo ma poi gli aggiornamenti successivi riguardano solo le estrazioni rimanenti quindi il problema velocità viene superato.
Una volta che sono disponibili i file delle estrazioni virtuali è possibile usarli per le normali statistiche che si possono fare con gli script ,a tale scopo c'è anche un secondo script di esempio.
Silop fai le tue verifiche per vedere se gli archivi virtuali prodotti col primo script sono giusti
Primo script per generare gli archivi
secondo script esempio di coem fare le statistiche usando i file degli archivi virtuali,
Il fulcro è la funzione ApriFileBaseDati con la quale diciamo quale file usare , il resto segue la normalissima logica gia conosciuta.
Ho preparato il seguente script che serve per generare gli archivi virtuali , la prima volta che si generano non è proprio velocissimo ma poi gli aggiornamenti successivi riguardano solo le estrazioni rimanenti quindi il problema velocità viene superato.
Una volta che sono disponibili i file delle estrazioni virtuali è possibile usarli per le normali statistiche che si possono fare con gli script ,a tale scopo c'è anche un secondo script di esempio.
Silop fai le tue verifiche per vedere se gli archivi virtuali prodotti col primo script sono giusti
Primo script per generare gli archivi
Codice:
Option Explicit
Sub Main
Dim sDir,Inizio,Fine,bPrimaFissa,bRigenera
'=========================================================================================
' questi valori servono per l'aggiornamento dell'archivio una volta fissati non cambiarli
'
Inizio = DataEstrToIdEstr(4,1,1986) ' estrazione iniziale in base ai propri metodi per esempio 3950
Fine = EstrazioniArchivio ' sempre fino all'ultima estrazione disponibile
'=======================================================================================
If MsgBox("Usare il criterio con la prima estrazione fissa ?",vbQuestion + vbYesNo) = vbYes Then
bPrimaFissa = True
Else
bPrimaFissa = False
End If
If MsgBox("Ricreare daccapo gli archivi virtuali ?",vbQuestion + vbYesNo) = vbYes Then
bRigenera = True
Else
bRigenera = False
End If
ReDim aNumPrimi(0)
Call AlimentaPrimi(aNumPrimi)
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
If CreaDirectory(sDir) Then
Call GeneraArchiviVirtuali(sDir,Inizio,Fine,bPrimaFissa,bRigenera ,aNumPrimi)
If MsgBox("Visualizzare i file degli archivi virtuali prodotti ? (E' necessario excel)",vbQuestion + vbYesNo) = vbYes Then
Call GeneraFileCsv(sDir,aNumPrimi,bPrimaFissa)
End If
Else
MsgBox "Errore creazione directory sistemi virtuali"
End If
End Sub
Sub GeneraArchiviVirtuali(sDirArchivi,idPrimaEstr,idUltimaEstr,bPrimaEstrFissa,bRigenera,aNumPrimi)
Dim sFile,nBase,idEstr,e,r,nMoltiplicatore,sData,i
Dim sDataUltimaEstrArcVirt,nEstrTotArcVir
Dim idPrimaEstrToAddArchVirt
For i = 1 To UBound(aNumPrimi)
nBase = aNumPrimi(i)
sFile = GetNomeFileArchVirt(sDirArchivi,nBase,bPrimaEstrFissa)
If bRigenera Then
Call EliminaFile(sFile)
nEstrTotArcVir = 0
sDataUltimaEstrArcVirt = ""
idPrimaEstrToAddArchVirt = idPrimaEstr
Else
nEstrTotArcVir = QuantitaEstrazioniInFile(sFile)
sDataUltimaEstrArcVirt = GetDataEstrArchivioVirt(sFile,nEstrTotArcVir)
If sDataUltimaEstrArcVirt <> "" Then
idPrimaEstrToAddArchVirt = DataEstrToIdEstr(Day(sDataUltimaEstrArcVirt),Month(sDataUltimaEstrArcVirt),Year(sDataUltimaEstrArcVirt))
If idPrimaEstrToAddArchVirt > 0 Then idPrimaEstrToAddArchVirt = idPrimaEstrToAddArchVirt + 1
Else
idPrimaEstrToAddArchVirt = idPrimaEstr
End If
End If
If idPrimaEstrToAddArchVirt > 0 Then
If nEstrTotArcVir > 0 Then
If bPrimaEstrFissa Then
nMoltiplicatore =(nEstrTotArcVir - 1) Mod 90
Else
nMoltiplicatore = nEstrTotArcVir Mod 90
End If
Else
nMoltiplicatore = 0
End If
For idEstr = idPrimaEstrToAddArchVirt To idUltimaEstr
ReDim aNumA(11,5)
If idEstr = idPrimaEstr Then
If bPrimaEstrFissa = False Then
nMoltiplicatore = 1
End If
Else
nMoltiplicatore = nMoltiplicatore + 1
End If
If nMoltiplicatore = 90 Then
For r = 1 To 11
For e = 1 To 5
aNumA(r,e) = Estratto(idEstr,Iif(r = 11,12,r),e)
Next
Next
nMoltiplicatore = 0
Else
For r = 1 To 11
For e = 1 To 5
If i <= 12 Then
aNumA(r,e) = DiffCiclometrica(Estratto(idEstr,Iif(r = 11,12,r),e),Fuori90(nBase * nMoltiplicatore))
ElseIf i > 12 And i <= 24 Then
aNumA(r,e) = Fuori90(Estratto(idEstr,r,e) + Fuori90(nBase * nMoltiplicatore))
Else
aNumA(r,e) = Estratto(idEstr,Iif(r = 11,12,r),e)
End If
Next
Next
End If
sData = DataEstrazione(idEstr,,,"/")
Call SalvaEstrazione(aNumA,sData,IndiceAnnuale(idEstr),sFile)
Messaggio "Archivio virtuale " & nBase & " estr . " & idEstr
If ScriptInterrotto Then Exit For
Next
If ScriptInterrotto Then Exit For
Else
MsgBox "Errore non previsto , rigenerare gli archivi daccapo per risolvere il problema"
End If
Call AvanzamentoElab(1,UBound(aNumPrimi),i)
Next
End Sub
Sub AlimentaPrimi(ANumPrimi)
ReDim ANumPrimi(24)
ANumPrimi(1) = 1
ANumPrimi(2) = 7
ANumPrimi(3) = 11
ANumPrimi(4) = 13
ANumPrimi(5) = 17
ANumPrimi(6) = 19
ANumPrimi(7) = 23
ANumPrimi(8) = 29
ANumPrimi(9) = 31
ANumPrimi(10) = 37
ANumPrimi(11) = 41
ANumPrimi(12) = 43
ANumPrimi(13) = 90 - 1
ANumPrimi(14) = 90 - 7
ANumPrimi(15) = 90 - 11
ANumPrimi(16) = 90 - 13
ANumPrimi(17) = 90 - 17
ANumPrimi(18) = 90 - 19
ANumPrimi(19) = 90 - 23
ANumPrimi(20) = 90 - 29
ANumPrimi(21) = 90 - 31
ANumPrimi(22) = 90 - 37
ANumPrimi(23) = 90 - 41
ANumPrimi(24) = 90 - 43
End Sub
Function GetNomeFileArchVirt(sDirArchivi,nBase,bPrimaEstrFissa)
If bPrimaEstrFissa Then
GetNomeFileArchVirt = sDirArchivi & "Virt_ConFissi_" & nBase & ".dat"
Else
GetNomeFileArchVirt = sDirArchivi & "Virt_NoFissi_" & nBase & ".dat"
End If
End Function
Function GetDataEstrArchivioVirt(sFile,idEstr)
Dim sData
Call LeggiEstrazioneDaFile(sFile,idEstr,sData,0,"")
GetDataEstrArchivioVirt = sData
End Function
Sub GeneraFileCsv(sDir,aNumPrimi,bPrimaFissa)
Dim sFileCsv,sFileArcVirt,nBase,k,idEstr,sEstr,sData,nIndice,r,e,sChrSep
Dim nEstrProdotte
sChrSep = ";"
nEstrProdotte = 0
For k = 1 To UBound(aNumPrimi)
nBase = aNumPrimi(k)
sFileArcVirt = GetNomeFileArchVirt(sDir,nBase,bPrimaFissa)
sFileCsv = sFileArcVirt & ".csv"
Call EliminaFile(sFileCsv)
sEstr = "Indice" & sChrSep & "Data" & sChrSep
For r = 1 To 11
For e = 1 To 5
sEstr = sEstr & SiglaRuota(Iif(r = 11,12,r)) & sChrSep
Next
Next
sEstr = RimuoviLastChr(sEstr,sChrSep)
Call ScriviFile(sFileCsv,sEstr,True,True)
Call Messaggio("Creazione file csv archivio base : " & nBase)
For idEstr = 1 To QuantitaEstrazioniInFile(sFileArcVirt)
ReDim aNum(12,5)
Call LeggiEstrazioneDaFile(sFileArcVirt,idEstr,sData,nIndice,aNum)
sEstr = nIndice & sChrSep & sData & sChrSep
For r = 1 To 12
If r <> 11 Then
For e = 1 To 5
sEstr = sEstr & Format2(aNum(r,e)) & sChrSep
Next
End If
Next
sEstr = RimuoviLastChr(sEstr,sChrSep)
Call ScriviFile(sFileCsv,sEstr,False,True)
nEstrProdotte = nEstrProdotte + 1
If ScriptInterrotto Then Exit For
Next
Call CloseAllFileHandle
Call AvanzamentoElab(1,UBound(aNumPrimi),k)
If ScriptInterrotto Then Exit For
Next
If nEstrProdotte > 0 Then
MsgBox "I file csv sono presenti nella directory " & vbCrLf & sDir
Call ApriDirectory(sDir)
End If
End Subsecondo script esempio di coem fare le statistiche usando i file degli archivi virtuali,
Il fulcro è la funzione ApriFileBaseDati con la quale diciamo quale file usare , il resto segue la normalissima logica gia conosciuta.
Codice:
Option Explicit
Sub Main
Dim sDir,Inizio,Fine,sFile,sFileCompleto
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
sFile = ScegliFileArchivioVirt(sDir)
If sFile <> "" Then
sFileCompleto = sDir & sFile & ".dat"
Inizio = 1
Fine = QuantitaEstrazioniInFile(sFileCompleto)
Call InitEseguiStatistica(sFileCompleto,sFile,Inizio,Fine)
End If
End Sub
Function ScegliFileArchivioVirt(sDir)
Dim i
ReDim aFile(0)
Call ElencoFileInDirectory(sDir,aFile,".dat")
If UBound(aFile) > 0 Then
i = ScegliOpzioneMenu(aFile,1,"Scegli archivio virtuale")
If i > 0 Then
ScegliFileArchivioVirt = aFile(i)
Else
ScegliFileArchivioVirt = ""
End If
Else
MsgBox "Non sono stati trovati i sistemi virtuali nella directory " & vbCrLf & sDir
End If
End Function
Sub InitEseguiStatistica(sFile,sNomeFile,Inizio,Fine)
Dim n,r,k
ReDim aRuote(1)
Dim nRit,nRitMax,nIncrRitMax,nFre
ReDim aRit(12,90)
ReDim aRitMax(12,90)
ReDim aFrq(12,90)
ReDim aIncrRitMx(12,90)
ReDim aRitPos(12,90)
If ApriFileBaseDati(sFile) Then
For r = 1 To 12
aRuote(1) = r
If r <> 11 Then
Call Messaggio("Statistica su archivio virtuale " & sNomeFile & " Ruota " & NomeRuota(r))
For n = 1 To 90
ReDim aN(1)
aN(1) = n
Call StatisticaFormazioneTurbo(aN,aRuote,1,nRit,nRitMax,nIncrRitMax,nFre,Inizio,Fine)
aRit(r,n) = nRit
aRitMax(r,n) = nRitMax
aFrq(r,n) = nFre
aIncrRitMx(r,n) = nIncrRitMax
aRitPos(r,n) = RitPosTurbo(n,r,Fine)
Next
End If
Call AvanzamentoElab(1,12,r)
If ScriptInterrotto Then Exit For
Next
Else
MsgBox "Errore apertura archivio virtuale " & vbCrLf & sFile
End If
Call GeneraTabella(aRit,aRitMax,aIncrRitMx,aFrq,aRitPos,sNomeFile)
End Sub
Sub GeneraTabella(aRit,aRitMax,aIncrRitMx,aFre,aRitPos,sNomeFile)
ReDim aTitoli(57)
Dim aSubTit
ReDim aValori(57)
Dim k,r,y,n,e
aTitoli(1) = "Sistema"
aTitoli(2) = "Numero"
k = 3
For r = 1 To 12
If r <> 11 Then
For y = 1 To 5
aTitoli(k +(y - 1)) = NomeRuota(r)
Next
k = k + 5
End If
Next
ReDim aColSpan(57)
aColSpan(1) = 1
aColSpan(2) = 1
For k = 3 To 57 Step 5
For y = 1 To 5
If y = 1 Then
aColSpan(k +(y - 1)) = 5
Else
aColSpan(k +(y - 1)) = 0
End If
Next
Next
Call Messaggio("Generazione tabella sistemi virtuali")
' se si usa la tabella html usare la seguente linea e remmare quella sotto
'Call InitTabella(aTitoli,vbBlue,,,vbWhite,,aColSpan)
'se si usa la tabella ActiveX usare la seguente linea e remmare quella sopra
Call InitTabella(aTitoli,vbBlue,,,vbWhite)
aSubTit = Array("","Rit","RitMx","Fre","IncRMx","RitPos")
For k = 3 To 57 Step 5
For y = 1 To 5
aTitoli(k +(y - 1)) = aSubTit(y)
Next
Next
Call AddRigaTabella(aTitoli,vbYellow)
aValori(1) = sNomeFile
For n = 1 To 90
aValori(2) = n
y = 2
For r = 1 To 12
If r <> 11 Then
y = y + 1
aValori(y) = aRit(r,n)
y = y + 1
aValori(y) = aRitMax(r,n)
y = y + 1
aValori(y) = aFre(r,n)
y = y + 1
aValori(y) = aIncrRitMx(r,n)
y = y + 1
aValori(y) = aRitPos(r,n)
End If
Next
Call AddRigaTabella(aValori)
Call AvanzamentoElab(1,90,n)
If ScriptInterrotto Then Exit For
Next
Call CreaTabellaOrdinabile
End Sub
/ 6 Grande
