Legend - NUOVA MISSIONE

LuigiB · 18 Dicembre 2015

Ok Legend , hai scritto le funzioni che ti avevo chiesto e alla fine i valori li ottieni certe volte complichi le cose ...
Comunque qui i lavori sono cambiati in corso d'opera per fortuna che noi quand'è cosi non facciamo lievitare i costi ..

Dato che vogliamo accettare solo gli archivi che abbiano il ritardo massimo per estratto compatibile
con quello riscontrato sull'archivio reale purtroppo non possiamo piu usare la routine InitChiavi.
Perche quella routine creava X chiavi e di conseguenza X archivi .. però ora dobbiamo gestire il fatto
ch el'archivio prodotto non vada bene in quanto presenti il ritardo max estratto che si discosta troppo dal valore di riferimento.
Quindi mentre prima disponevamo di X chiavi fisse ora invece dobbiamo continuare a produrre una nuova chiave finche l'archivio risultante non rispetta i requisiti.
Quindi si elimina la sub InitChiavi e si modifica quella che crea l'archivio virtuale.
Proprio di questa sub parliamo ora , ineffetti l'ho scritta io e a te questa volta il compito di capire
cosa faccia.
Posto sotto lo script completo ovviamente come l'ho organizzato io prendilo a riferimento anche se le cose le hai scritte in modo diverso l'importante è che tu capisca la logica.

lo script si puo gia lanciare cosi per creare una serie di nuovi archivi virtuali
purtroppo mi sono reso conto che le funzioni turbo hanno un problema quando si usa la ApriFileBaseDati per cambiare archivio , il problema l'ho corretto ma devo ancora mettere la nuova versione , quindi in questo script per consentire di testarlo invece di statisticaformazioneTurbo ho usato statisticaformazione standard .

p.s.
nelllo script ho voluto inserire anche una routine mischianumeri per disordinare i numeri della colonna casuale non tanto perche serva quanto perche mi avevi detto di aver perso una mattinata a farne una simile.

.

Codice:

Option Explicit



Sub Main
    Dim aKey ' array delle chiavi per creare gli archivi virtuali
    Dim nQArchivi ' quantita degli archivi da creare
    Dim nEstrIni ' estrazione dalla quale iniziare a creare le corrispondenti virtuali
    Dim nClasseChiave ' classe per la chiave degli archivi
    Dim sFileChiavi ' file che memorizza le chiavi per gli n archivi virtuali
    Dim aEstAR ' matrice estrazioni archivio reale (Tot,Ruota,Pos)
    Dim sDirArcVirt ' directory dove vengono creati gli archivi virtuali
    Dim nRitMaxMin,nRitMaxMax ' rang emin e max per accettare il ritmax per estratto sul nuovo archivio prodotto
    Dim percVarRitMax ' percentuale di variazione +/- per calcolare il range rispetto al ritmax calcolato su archivio reale
    
    
    percVarRitMax = 10
    nQArchivi = GetQuantitaArchivi
    nClasseChiave = ScegliClasse
    nEstrIni = ScegliInizio
    sDirArcVirt = GetDirectoryAppData & "ArcVirtEnigma\"
    
    If VerificaCoerenza(nQArchivi,nClasseChiave,nEstrIni) Then
        ' creo la directry dove salvo gli archivi
        If CreaDirectory(sDirArcVirt) Then
            ' legge le estrazioni dell'archivio reale e le mette in memoria
            If AlimentaMatriceEst(aEstAR) Then
                Call GetRangeMinMaxRitardoMax(percVarRitMax,nEstrIni,nRitMaxMin,nRitMaxMax)
            
                Call CreaArchiviVirtuali(nQArchivi,nClasseChiave,nEstrIni,aEstAR,EstrazioniArchivio,sDirArcVirt,nRitMaxMin,nRitMaxMax)
                Call ScriviRitMaxPerArchivio(nClasseChiave,nQArchivi,sDirArcVirt,nEstrIni)
                'Call GestioneConvergenze(aKey,nQArchivi,nClasseChiave,sDirArcVirt,nEstrIni,nQDaProc,aEstAR)
            End If
        End If
    End If
End Sub
Function VerificaCoerenza(nQArchivi,nClasseChiave,nEstrIni)
    Dim sMsg
    If nQArchivi <= 0 Then sMsg = "Specificare la quantita di archivi da creare"
    If nClasseChiave <= 4 Then sMsg = "Specificare la classe per le chiavi di generazione"
    If nEstrIni <= 0 Then sMsg = "Specificare l'estrazione di partenza per la generazione degli archivi"
    
    If sMsg <> "" Then
        MsgBox sMsg,vbCritical
    Else
        VerificaCoerenza = True
    End If
End Function
Function ScegliInizio()
    ReDim aV(EstrazioniArchivio)
    Dim k
    For k = 1 To UBound(aV)
        aV(k) = GetInfoEstrazione(k)
    Next
    ScegliInizio = ScegliOpzioneMenu(aV,1,"Inizio archivio virtuale")
End Function
Function ScegliClasse
    ReDim aV(16)
    Dim k
    For k = 5 To 20
        aV(k - 4) = k
    Next
    ScegliClasse =(ScegliOpzioneMenu(aV,1,"Classe chiavi di generazione")) + 4
End Function
Function GetQuantitaArchivi
    GetQuantitaArchivi = Int(InputBox("Quanti archivi virtuali creare ?","Quantita archivi virtuali","25"))
End Function
Function AlimentaMatriceEst(aEst)
    ' alimenta la matrice con tutte le estrazioni dell'archivio reale
    Dim k,r,e,nTot
    nTot = EstrazioniArchivio
    ReDim aEst(nTot,11,5)
    For k = 1 To nTot
        ReDim aNumEst(0)
        Call GetEstrazioneCompleta(k,aNumEst)
        aEst(k,0,0) = DataEstrazione(k,,,"/") & "-" & IndiceAnnuale(k)
        For r = 1 To 11
            For e = 1 To 5
                aEst(k,r,e) = aNumEst(r,e)
            Next
        Next
    Next
    AlimentaMatriceEst = nTot > 0
End Function
Function GetFileCfgArchivio(sDirArc,nIdEstrIni,nClasse,nQArc)
    GetFileCfgArchivio = sDirArc & "CFG_" & nIdEstrIni & "_" & nClasse & "_" & nQArc & ".dat"
End Function
Function GetFileArchivioVirt(sDirArc,nIdEstrIni,nClasse,nQArc,nIdArc)
    GetFileArchivioVirt = sDirArc & "BDV" & FormattaStringa(nIdArc,"00000") & "_" & nClasse & "_" & nIdEstrIni & "_" & nQArc & ".dat"
End Function

Function GetRitardoMaxEstrattoArchivio(nRetNum,nRetRuota,nEstrInizio)
    
    Dim n,r,nRitMax,nMax
    ReDim aN(1)
    ReDim aR(1)
    
    nRetNum = 0
    nRetRuota = 0
    

    For r = 1 To 10
        aR(1) = r
        If r <> 11 Then
            For n = 1 To 90
                aN(1) = n
                ' usare la funzione turbo solo dalla versione 1.5.73
                'Call StatisticaFormazioneTurbo(aN,aR,1,0,nRitMax,0,0,nEstrInizio,EstrazioniArchivio)
                Call StatisticaFormazione(aN,aR,1,0,nRitMax,0,0,nEstrInizio,EstrazioniArchivio)
                

                If nRitMax > nMax Then
                    nMax = nRitMax
                    nRetNum = n
                    nRetRuota = r
                End If
            Next
        End If
        
    Next
    
    GetRitardoMaxEstrattoArchivio = nMax
    
End Function
Sub GetRangeMinMaxRitardoMax(PercVariazione,nEstrIni,nRetMin,nRetMax)
    Dim nRitMax
    Dim nValue , nRetNum ,nRetRuota
    
    
    nRitMax = GetRitardoMaxEstrattoArchivio( nRetNum,nRetRuota,nEstrIni)
    nValue = ProporzioneX(PercVariazione,100,nRitMax)
    
    nRetMin = Int (nRitMax - nValue)
    nRetMax = Int (nRitMax + nValue)
    
    Call Scrivi ("Ritardo massimo su archivio reale estrazione inizio " & nEstrIni )
    Call Scrivi ("Sono accettati gli archivi che si discostano del " & PercVariazione & "% rispetto al ritardo sull'archivio reale")
    Call Scrivi ("Ritardo massimo Min " & nRetMin )
    Call Scrivi ("Ritardo massimo Max " & nRetMax )
    
    Call Scrivi
    
    
    ReDim av(3)
    av(1) = "Numero"
    av(2) = "Ruota"
    av(3) = "Ritardo max"
    
    Call InitTabella(av,vbYellow)
    
    av(1) = nRetNum
    av(2) = NomeRuota(nRetRuota)
    av(3) = nRitMax
            
    Call AddRigaTabella(av)
    Call CreaTabella
    

End Sub
Sub LeggiChiaviDaFile(sFileChiavi,aKey)
    Dim k
    ' legge le chiavi per la creazione degli archivi virtuali
    ' potrebbe pure non leggere le chiavi se il file non esiste
    
    For k = 1 To UBound(aKey)
    
        aKey(k) = ""
    Next
    If FileEsistente(sFileChiavi) Then
        ReDim aRighe(0)
        Call LeggiRigheFileDiTesto(sFileChiavi,aRighe)
        For k = 0 To UBound(aRighe)
            aKey(k + 1) = aRighe(k)
        Next
    End If
    
End Sub
Sub MischiaColonna(aCol)
    Dim nUpper
    Dim nFatti
    Dim nPos,nPosOrig
    
    
    nUpper = UBound(aCol)
    ReDim aB(nUpper)
    ReDim aNewCol(nUpper)
    
    Do While nFatti < nUpper
        
        nPos = NumeroCasuale(1,nUpper)
        Do While aB(nPos)
            nPos = NumeroCasuale(1,nUpper)
            
        Loop    
        aB(nPos) = True
        nPosOrig = nPosOrig + 1
        aNewCol(nPosOrig) = aCol(nPos)
        nFatti = nFatti + 1
    Loop
    
    For nPos = 1 To nUpper
        aCol(nPos) = aNewCol(nPos)
    Next
    
End Sub

Sub CreaArchiviVirtuali(nQArchivi,nClasseKey,nEstrIni,aEstrArcReale,nQEstrAR,sDirArchivi,nRitMaxMin,nRitMaxMax)
    Dim sFileArc
    Dim k,r,e
    Dim nQEstrInArcV
    Dim idEstrAR,idEstrAV
    Dim nPosKey
    
    Dim nn
    Dim nSalv
    Dim nArcCreati
    Dim bCalcRitMax
    Dim nTmpNumArc
    Dim nRitMax
    Dim sTmpCol
    Dim coll
    Dim sFileChiavi


    Set coll = GetNewCollection
    
    sFileChiavi = GetFileCfgArchivio(sDirArchivi,nEstrIni,nClasseKey,nQArchivi)
    
    ReDim aKey(nQArchivi)
    Call LeggiChiaviDaFile(sFileChiavi,aKey)
    

    
    ' aggiorna o crea se non esistono gli archivi virtuali
    nArcCreati = 0
    Do While nArcCreati < nQArchivi
        nSalv = 0
        nTmpNumArc = nArcCreati + 1
        If aKey(nTmpNumArc) = "" Then
            
            ReDim aCol(0)
            Call GetColonnaCasuale(nClasseKey,aCol)
            Call MischiaColonna(aCol)
            sTmpCol = StringaNumeri(aCol)
            Do While AddItemColl(coll,sTmpCol,"k" & sTmpCol) = False
                Call GetColonnaCasuale(nClasseKey,aCol)
                Call MischiaColonna(aCol)

                sTmpCol = StringaNumeri(aCol)
            Loop
            
            aKey(nTmpNumArc) = sTmpCol
            bCalcRitMax = True
        Else
            bCalcRitMax = False
        End If
        
        ReDim aNumKey(0)
        Call SplitByChar("." & aKey(nTmpNumArc),".",aNumKey)
        
        sFileArc = GetFileArchivioVirt(sDirArchivi,nEstrIni,nClasseKey,nQArchivi,nTmpNumArc)
        Call Messaggio("Archivio numero " & nTmpNumArc)
        
        If FileEsistente(sFileArc) Then
            If ApriFileBaseDati(sFileArc) Then
                nQEstrInArcV = QuantitaEstrazioniInFile(sFileArc)
            Else
                nQEstrInArcV = 0
            End If
        Else
            nQEstrInArcV = 0
        End If
        idEstrAV = nQEstrInArcV
        ' cicla dalla prima estrazione da aggiungere fino a quelle disponibili nell'archivio reale
        For idEstrAR =((nEstrIni - 1) + nQEstrInArcV) + 1 To nQEstrAR
            idEstrAV = idEstrAV + 1
            nPosKey =(idEstrAV Mod nClasseKey) + 1
            nn = Int(aNumKey(nPosKey))
            ReDim aEstrV(11,5)
            For r = 1 To 11
                For e = 1 To 5
                    aEstrV(r,e) = Fuori90(Int(aEstrArcReale(idEstrAR,r,e)) + nn)
                Next
            Next
            ReDim aTmp(0)
            Call SplitByChar(aEstrArcReale(idEstrAR,0,0),"-",aTmp)
            If SalvaEstrazione(aEstrV,aTmp(0),aTmp(1),sFileArc) Then
                nSalv = nSalv + 1
                Call Messaggio(nSalv)
            End If
        Next
        
        Call AvanzamentoElab(1,nQArchivi,nTmpNumArc)
        If ScriptInterrotto Then Exit Do
        
        If bCalcRitMax Then
            If ApriFileBaseDati(sFileArc) Then
                Call Messaggio("Calcolo ritardo massimi per estratto au aexhivio numero " & nTmpNumArc)

                nRitMax = GetRitardoMaxEstrattoArchivio(0,0,1)
                If nRitMax >= nRitMaxMin And nRitMax <= nRitMaxMax Then
                    nArcCreati = nArcCreati + 1
                Else
                    Call EliminaFile(sFileArc)
                    aKey(nTmpNumArc) = ""
                End If
            End If
        Else
            nArcCreati = nArcCreati + 1
        End If
        
        
        
        
    Loop
    
    
    Set coll = Nothing
    If ScriptInterrotto = False Then
        Call EliminaFile(sFileChiavi)
        For k = 1 To UBound(aKey)
            Call ScriviFile(sFileChiavi,aKey(k),False)
        Next
        Call CloseAllFileHandle
    End If
    
End Sub
Sub ScriviRitMaxPerArchivio(nClasseChiave,nQArchivi,sDirArcVirt,nEstrIni)
    
    Dim k
    Dim Inizio,Fine
    Dim sFileArc
    Dim nRetRitMax,nRetNum,nRetRuota
    
    ReDim av(4)
    av(1) = "Numero"
    av(2) = "Ruota"
    av(3) = "Ritardo max"
    av(4) = "Archivio num"

    Call InitTabella(av,vbYellow)
    
    
    
        
    
    For k = 1 To nQArchivi
        
        sFileArc = GetFileArchivioVirt(sDirArcVirt,nEstrIni,nClasseChiave,nQArchivi,k)
        Call Messaggio("Calcolo ritardi massimi per estratto su archivi ")
        If ApriFileBaseDati(sFileArc) Then
            nRetRitMax = GetRitardoMaxEstrattoArchivio(nRetNum,nRetRuota,1)
            av(1) = nRetNum
            av(2) = NomeRuota(nRetRuota)
            av(3) = nRetRitMax
            av(4) = "Arc_" & FormattaStringa ( k , "0000")
            Call AddRigaTabella(av)
        End If
        
        Call AvanzamentoElab(1,nQArchivi,k)
        If ScriptInterrotto Then Exit For
    Next
    Call CreaTabella(3)
    

End Sub

i legend · 18 Dicembre 2015

ciao Luigi ti prometto che studiero tutto questo con molta attenzione.

mi ci faccio un libro

E' vero avolte complico le cose , ma perche per fare le cose semplici bisogna essere bravi, per bene e semplici bisogna essere geniali

il mio Arch preferito diceva Less is More.
è per farlo bisogna essere portati, e un dono.
Ciao e buona notte

LuigiB · 18 Dicembre 2015

ciao che io sia orso è poco ma sicuro però se devo essere sincero mi piaccio cosi .-) chi mi conosce bene sa che do tutto tranne che zampate ...
volendo si potrebbe anche usare come valore di riferimento il ritardo relativo solo che io sono convinto che il passo di cui parli tu non lo trovi semplicemente perche non esiste quindi pur avendo accettato il consiglio e implementato il filtro sul ritardo non credo che altri accorgimenti possano cambiare gli esiti ,,comunque inserirre il ritardo relativo oltre a rallentare un po non è difficile , ripeto però che in questo script non calcoleremeo nessun rp1 2 3 4 .. tuttavia gli archivi creati potrebbero essere utilizzati per farlo con altri script.

LuigiB · 19 Dicembre 2015

Si che lo avevo capito non ti preoccupare .e infatti dato che so che è vero quando me lo dicono lo prendo sempre come una cosa gradita .. in ufficio mi ci prendono anche in giro che sono orso .. ahah .per ora creiamo questi archivi e finiamo lo script che abbiamo detto. poi vedro se il plugin che ho gia fatto potra gestirli per calcolare gli stessi valori che gia calcola ...

mirapep · 19 Dicembre 2015

Ma si vedono le immagini? Io le vedo solo con l'accesso come utente

Rosanna · 19 Dicembre 2015

Mirapep, io vedo perfettamente le tue immagini.

x Luigi e i legend
non sono intervenuta perchè non ho alcun contributo scriptico degno di nota e peraltro siete ad un livello troppo alto per quello che ricordo, che so, che ho tempo di sperimentare. Dovrei riprendere, rispolverare, ripassare, colmare...per tentare di avvicinarmi un po'... ma onestamente la vedo ardua anche per altri motivi personali. Però vi seguo... ho trovato molto interessante (molto intrigante!!) la proposta degli archivi virtuali costruiti prendendo spunto dalla crittologia e quel che ne segue in termini di "base dati ulteriore e molto estesa".... davvero affascinante per concretizzare risposte alle curiosità anche se già sappiamo com'è la teoria(!!). E' un notevole esercizio scriptico, ed è piacevole vedere che Luigi ha trovato un allievo capace, stimolante e foriero di soddisfazioni...bravi bravi.
Questo thread è come un romanzo scriptico in diretta... Torno in silenzio, ma vi seguo (e salvo... poi chissà da cosa nasce cosa... boh...)

i legend · 19 Dicembre 2015

Ciao

Ciao Rosanna personalmente non conosco i tuoi lavori ma vedendo quello che fai nell altro tred.
Insieme a joe rispetto a me voi siete di un altro pianeta. Luigi si è offerto spontaneamente ( dopo che gli ho rotto tanto le scatole

) di darmi un passaggio sullo space shuttle .
È un maestro eccezionale, io provo a seguirlo

Però grazie per i complimenti fanno piacere

Pensa l anno scorso non sapevo neanche scrivere un metodo semplice semplice.
Ciao

X luigi

Luigi ho studiato la funzione del rimescolamento

Io avevo costruito una funzione sul idea di GetColonnaCasuale senza ordinaria tu invece hai fatto qualcosa di grande hai rimescolare ke posizioni
Bello bello bello.
Invece per quanto riguarda la funzione del più ritardatario se non metti tutto in un arRayse ci sono più ruote come le può segnare?
Ma a noi serviva sapere il limite massimo semplicemente. (Mi complice la vita? Sempre.)

Invece le altre funzioni le sto ancora studiando. Sono un codice bellissimo. ( se si può usare questo termine)
Grazie e buon week end

Buon week end a tutti

P.s
Lo script è le lezioni non sono solo per me
Ripeto io sono quello che rompe le scatole.
A luigi sicuramente fa piacere se la conoscenza della "classe" viene ampliata.

Questa forse la capirò solo io

i legend · 19 Dicembre 2015

Ciao mira .
Come ho detto sopra sto studiando il codice.
Visto che luigi ha abbandonato l idea del sistema crittografia credo ma devo ancora studiarlo abbia optato per la costruzione in verticale classica
. Sarebbe stato bello però avere un archivio trasformato in orizzontale.
Ma a me interessa solo il codice in qualità di scrittura.
ai fini ludici non mi interessa trovare la pietra filosofale che non esiste.
Ce gente che ha rovinato famiglie seguendo illusioni o chi le vendeva .
Non se hai notato ma qui la maggior parte degli scripter attivi non gioca

Ciao

Gli archivi creati non sono leggibili solo le chiavi.
Ciao

mirapep · 19 Dicembre 2015

Spaziometria grazie a Luigi è free e non credo che tanti altri software in vendita possano competere e/o aggiungere qualcosa di nuovo. In quanto al gioco sono punti di vista; se si segue con disciplina un metodo, se si fissa un punto di uscita, se si è consapevoli che non bisogna avventurarsi in imprese che mettono a rischio la propria e altrui serenità, se non sacrifichi nulla per il puro desiderio del gioco allora perchè no...........Se non puoi permetterti una pizza non vai al ristorante! Ma ci sono tanti altri modi per rovinarsi..........E' ovvio che occorre essere ponderati. Detto questo, mi viene un dubbio da quello che hai scritto, premesso che non ho nulla da vendere; ho istigato qualcuno al gioco? Ho postato un esempio del passato proprio per non dare opportunità di gioco a qualche avventato lettore. Sia chiaro sono animato dalla vostra stessa passione solo che devo comprendere come agite per tradurlo in VB6, in questo momento mi è più semplice non avendo padronanza delle funzioni di spazio

i legend · 19 Dicembre 2015

Ciao mira ,
Non capisco il tuo dubbio. Non ho detto che vuoi vendere niente , non ho detto che spingi le persone al gioco. Anche perché non lo hai fatto.
Sono molto diretto, e se una persona non mi piace la ignoro ,non perdo tempo a discuterci.
Ho semplicemente spiegato, la passione che mi muove.
Chi mi conosce sa come la penso.
Per me è importante la ricerca.
Per chi non sa nulla di statistica è facile partire per la tangente ed essere abbagliato dai risultati positivi.
Poi capita il caso negativo e possono essere dolori se i rischi non sono calcolati.
Spero di essermi spiegato, e che non ci siano incomprensioni.

Personalmente mi fa piacere leggere i tuoi interventi come quelli di qualsiasi altro utente ma
Se non ti sono simpatico , non è necessario interagire.
Ciao e buon week end

i legend · 19 Dicembre 2015

In risposta al post 52 invece
Leggendo il codice della crittografia di luigi dovrebbe leggere i 55 estratti come lettere singole e visto che ad ogni estrazione la stringa è diversa si applicherà bbe la stessa chiave,producendo risultati differenti.
Però li siamo ad un livello superiore per me.
Cmq se luigi ha scartato l idea probabilmente ha riscontrato le tue stesse criticità.
Ciao

i legend · 19 Dicembre 2015

Ciao mira

Per le incomprensioni basta parlarsi.
Per me è tutto ok.

Buon week end
Aspettiamo il prof

Ciao a tutti

mirapep · 19 Dicembre 2015

tutto ok, grazie
ciao

LuigiB · 19 Dicembre 2015

ciao a tutti , ciao a Rosanna che ci segue da dietro le quinte .. anche se non puoi immergerti nell'intero script ma hai lo stesso qualche domanda chiedi pure .. siamo qua ..
Per legend perce dici che ho abbandonato la strada crittografica.
Ha capito bene Mirapep il funzionamento della routine.

noi dobbiamo creare una certa quantita di archivi virtali scelta dall'utente
quindi iniziamo un ciclo che termina quando li abbiamo creati tutti.
Ogni volta che creiamo un sistema inventiamo una nuova chave (la famosa lunghetta cioè l'analoga della password nell'altro algoritmo)
attraverso la lunghetta andiamo a generare nuovi numeri , ad ogni numero della stessa estrazione aggiungiamo il numero nella tale posizione della lunghetta , incrementando l'estrazione si incrementa anche la posizione , questa segue un percorso circolare arrivata al massimo riparte dal minimo.
E' come se l'intera estrazione fosse una delle lettere in chiaro da criptare , percio ad ogni numero della stessa estrazione sommiamo lo stesso numero preso dall a lunghetta.
ora dopo aver creato il sistema dobiamo validarlo sia in funzione del rit max per estratto sia in funzione del rit rel max valori questi presi dall'archivio reale.
Nello scrip è preimpostato un valore percentuale (io ho messo 20) di scostamento +/- dai valori riscontrati sull'archivio reale.Se l'archivio prodotto non li supera verrà eliminato e non si passerà alla produzioen del prossimo archivio finche non viene validato quello corrente.

per far girare questo nuovo script pero dovete scaricare la versioen 1.5.73 perche ho dovutro creare una nuova e piu potente funzione per il ritardo relativo

http://www.mediafire.com/download/rc...ria_1_5_73.rar

appena lo script è chiaro procediamo con il discorso iniziale

Codice:

Option Explicit


Sub Main
    Dim aKey ' array delle chiavi per creare gli archivi virtuali
    Dim nQArchivi ' quantita degli archivi da creare
    Dim nEstrIni ' estrazione dalla quale iniziare a creare le corrispondenti virtuali
    Dim nClasseChiave ' classe per la chiave degli archivi
    Dim sFileChiavi ' file che memorizza le chiavi per gli n archivi virtuali
    Dim aEstAR ' matrice estrazioni archivio reale (Tot,Ruota,Pos)
    Dim sDirArcVirt ' directory dove vengono creati gli archivi virtuali
    
    Dim nRitMaxMin,nRitMaxMax ' rang emin e max per accettare il ritmax per estratto sul nuovo archivio prodotto
    Dim nRitRelMaxMin,nRitRelMaxMax ' rang emin e max per accettare il ritmax per estratto sul nuovo archivio prodotto
    Dim percVarRitMax ' percentuale di variazione +/- per calcolare il range rispetto al ritmax calcolato su archivio reale
    Dim nQEstrArcReale ' quantita estrazioni in archivio reale
    
    
    percVarRitMax = 20
    nQArchivi = GetQuantitaArchivi
    nClasseChiave = ScegliClasse
    nEstrIni = ScegliInizio
    sDirArcVirt = GetDirectoryAppData & "ArcVirtEnigma\"
    nQEstrArcReale = EstrazioniArchivio
    
    If VerificaCoerenza(nQArchivi,nClasseChiave,nEstrIni) Then
        ' creo la directry dove salvo gli archivi
        If CreaDirectory(sDirArcVirt) Then
            ' legge le estrazioni dell'archivio reale e le mette in memoria
            If AlimentaMatriceEst(aEstAR) Then
                Call GetRangeMinMaxRitardoMax(percVarRitMax,nEstrIni,nRitMaxMin,nRitMaxMax)
                Call GetRangeMinMaxRitardoRelMax(percVarRitMax,nEstrIni,nRitRelMaxMin,nRitRelMaxMax)
            

                Call CreaArchiviVirtuali(nQArchivi,nClasseChiave,nEstrIni,aEstAR,nQEstrArcReale,sDirArcVirt,nRitMaxMin,nRitMaxMax,nRitRelMaxMin,nRitRelMaxMax)
                Call ScriviRitMaxPerArchivio(nClasseChiave,nQArchivi,sDirArcVirt,nEstrIni)
                
            End If
        End If
    End If
End Sub
Function VerificaCoerenza(nQArchivi,nClasseChiave,nEstrIni)
    Dim sMsg
    If nQArchivi <= 0 Then sMsg = "Specificare la quantita di archivi da creare"
    If nClasseChiave <= 4 Then sMsg = "Specificare la classe per le chiavi di generazione"
    If nEstrIni <= 0 Then sMsg = "Specificare l'estrazione di partenza per la generazione degli archivi"
    
    If sMsg <> "" Then
        MsgBox sMsg,vbCritical
    Else
        VerificaCoerenza = True
    End If
End Function
Function ScegliInizio()
    ReDim aV(EstrazioniArchivio)
    Dim k
    For k = 1 To UBound(aV)
        aV(k) = GetInfoEstrazione(k)
    Next
    ScegliInizio = ScegliOpzioneMenu(aV,1,"Inizio archivio virtuale")
End Function
Function ScegliClasse
    ReDim aV(16)
    Dim k
    For k = 5 To 20
        aV(k - 4) = k
    Next
    ScegliClasse =(ScegliOpzioneMenu(aV,1,"Classe chiavi di generazione")) + 4
End Function
Function GetQuantitaArchivi
    GetQuantitaArchivi = Int(InputBox("Quanti archivi virtuali creare ?","Quantita archivi virtuali","25"))
End Function
Function AlimentaMatriceEst(aEst)
    ' alimenta la matrice con tutte le estrazioni dell'archivio reale
    Dim k,r,e,nTot
    nTot = EstrazioniArchivio
    ReDim aEst(nTot,11,5)
    For k = 1 To nTot
        ReDim aNumEst(0)
        Call GetEstrazioneCompleta(k,aNumEst)
        aEst(k,0,0) = DataEstrazione(k,,,"/") & "-" & IndiceAnnuale(k)
        For r = 1 To 11
            For e = 1 To 5
                aEst(k,r,e) = aNumEst(r,e)
            Next
        Next
    Next
    AlimentaMatriceEst = nTot > 0
End Function
Function GetFileCfgArchivio(sDirArc,nIdEstrIni,nClasse,nQArc)
    GetFileCfgArchivio = sDirArc & "CFG_" & nIdEstrIni & "_" & nClasse & "_" & nQArc & ".dat"
End Function
Function GetFileArchivioVirt(sDirArc,nIdEstrIni,nClasse,nQArc,nIdArc)
    GetFileArchivioVirt = sDirArc & "BDV" & FormattaStringa(nIdArc,"00000") & "_" & nClasse & "_" & nIdEstrIni & "_" & nQArc & ".dat"
End Function

Function GetRitardoMaxEstrattoArchivio(nRetNum,nRetRuota,nEstrInizio)
    
    Dim n,r,nRitMax,nMax
    ReDim aN(1)
    ReDim aR(1)
    
    nRetNum = 0
    nRetRuota = 0
    

    For r = 1 To 10
        aR(1) = r
        If r <> 11 Then
            For n = 1 To 90
                aN(1) = n
                ' usare la funzione turbo solo dalla versione 1.5.73
                Call StatisticaFormazioneTurbo(aN,aR,1,0,nRitMax,0,0,nEstrInizio,EstrazioniArchivio)
                'Call StatisticaFormazione(aN,aR,1,0,nRitMax,0,0,nEstrInizio,EstrazioniArchivio)
                

                If nRitMax > nMax Then
                    nMax = nRitMax
                    nRetNum = n
                    nRetRuota = r
                End If
            Next
        End If
        
    Next
    
    GetRitardoMaxEstrattoArchivio = nMax
    
End Function
Sub GetRangeMinMaxRitardoMax(PercVariazione,nEstrIni,nRetMin,nRetMax)
    Dim nRitMax
    Dim nValue,nRetNum,nRetRuota
    
    
    nRitMax = GetRitardoMaxEstrattoArchivio(nRetNum,nRetRuota,nEstrIni)
    nValue = ProporzioneX(PercVariazione,100,nRitMax)
    
    nRetMin = nRitMax - nValue
    nRetMax = nRitMax + nValue
    
    Call Scrivi("Ritardo massimo su archivio reale estrazione inizio " & nEstrIni)
    Call Scrivi("Sono accettati gli archivi che si discostano del " & PercVariazione & "% rispetto al ritardo sull'archivio reale")
    Call Scrivi("Ritardo massimo Min " & nRetMin)
    Call Scrivi("Ritardo massimo Max " & nRetMax)
    
    Call Scrivi
    ReDim av(3)
    av(1) = "Numero"
    av(2) = "Ruota"
    av(3) = "Ritardo max"
    
    Call InitTabella(av,vbYellow)
    
    av(1) = nRetNum
    av(2) = NomeRuota(nRetRuota)
    av(3) = nRitMax
            
    Call AddRigaTabella(av)
    Call CreaTabella
    

End Sub
Sub GetRangeMinMaxRitardoRelMax(PercVariazione,nEstrIni,nRetMin,nRetMax)
    Dim nRitMax
    Dim nValue,nRetNum,nRetRuota
    
    
    nRitMax = GetRitRelMaxArchivio(nEstrIni,EstrazioniArchivio,nRetNum,nRetRuota)
    nValue = ProporzioneX(PercVariazione,100,nRitMax)
    
    nRetMin = nRitMax - nValue
    nRetMax = nRitMax + nValue
    
    Call Scrivi("Ritardo relativo massimo su archivio reale estrazione inizio " & nEstrIni)
    Call Scrivi("Sono accettati gli archivi che si discostano del " & PercVariazione & "% rispetto al ritardo sull'archivio reale")
    Call Scrivi("Ritardo Rel massimo Min " & nRetMin)
    Call Scrivi("Ritardo Rel massimo Max " & nRetMax)
    
    Call Scrivi
    ReDim av(3)
    av(1) = "Numero"
    av(2) = "Ruota"
    av(3) = "Ritardo rel max"
    
    Call InitTabella(av,vbYellow)
    
    av(1) = nRetNum
    av(2) = NomeRuota(nRetRuota)
    av(3) = nRitMax
            
    Call AddRigaTabella(av)
    Call CreaTabella
    

    
    
End Sub
Function GetRitRelMaxArchivio(Inizio,fine,nRetNumRitRelMax,nRetRuotaRitRelMax)
    Dim r,k
    ReDim aRuote(1)
    Dim nRitRel,nRitRelMax
    nRetNumRitRelMax = 0
    nRetRuotaRitRelMax = 0
    
    Call Messaggio("Calcolo ritardo relativo massimo")
    For r = 1 To 10
        aRuote(1) = r
        Call InitCalcoloRitRel(aRuote,Inizio,fine)
        For k = 1 To 90
            
            nRitRel = GetRitRelMax(k,Inizio + 220,fine)
            If nRitRel > nRitRelMax Then
                nRitRelMax = nRitRel
                nRetNumRitRelMax = k
                nRetRuotaRitRelMax = r
            End If
            
            
        Next
        Call AvanzamentoElab(1,10,r)
        If ScriptInterrotto Then Exit For
    Next
    GetRitRelMaxArchivio = nRitRelMax
End Function
Sub LeggiChiaviDaFile(sFileChiavi,aKey)
    Dim k
    ' legge le chiavi per la creazione degli archivi virtuali
    ' potrebbe pure non leggere le chiavi se il file non esiste
    
    For k = 1 To UBound(aKey)
    
        aKey(k) = ""
    Next
    If FileEsistente(sFileChiavi) Then
        ReDim aRighe(0)
        Call LeggiRigheFileDiTesto(sFileChiavi,aRighe)
        For k = 0 To UBound(aRighe)
            aKey(k + 1) = aRighe(k)
        Next
    End If
    
End Sub
Sub MischiaColonna(aCol)
    Dim nUpper
    Dim nFatti
    Dim nPos,nPosOrig
    
    
    nUpper = UBound(aCol)
    ReDim aB(nUpper)
    ReDim aNewCol(nUpper)
    
    Do While nFatti < nUpper
        
        nPos = NumeroCasuale(1,nUpper)
        Do While aB(nPos)
            nPos = NumeroCasuale(1,nUpper)
            
        Loop    
        aB(nPos) = True
        nPosOrig = nPosOrig + 1
        aNewCol(nPosOrig) = aCol(nPos)
        nFatti = nFatti + 1
    Loop
    
    For nPos = 1 To nUpper
        aCol(nPos) = aNewCol(nPos)
    Next
    
End Sub

Sub CreaArchiviVirtuali(nQArchivi,nClasseKey,nEstrIni,aEstrArcReale,nQEstrAR,sDirArchivi,nRitMaxMin,nRitMaxMax,nRitRelMaxMin,nRitRelMaxMax)
    Dim sFileArc
    Dim k,r,e
    Dim nQEstrInArcV
    Dim idEstrAR,idEstrAV
    Dim nPosKey
    
    Dim nn
    Dim nSalv
    Dim nArcCreati
    Dim bCalcRitMax
    Dim nTmpNumArc
    Dim nRitMax,nRitRelMax
    Dim sTmpCol
    Dim coll
    Dim sFileChiavi
    Dim bEliminaFileArc


    Set coll = GetNewCollection
    
    sFileChiavi = GetFileCfgArchivio(sDirArchivi,nEstrIni,nClasseKey,nQArchivi)
    If FileEsistente(sFileChiavi) = False Then bEliminaFileArc = True
    
    ReDim aKey(nQArchivi)
    Call LeggiChiaviDaFile(sFileChiavi,aKey)
    

    
    ' aggiorna o crea se non esistono gli archivi virtuali
    nArcCreati = 0
    Do While nArcCreati < nQArchivi
        nSalv = 0
        nTmpNumArc = nArcCreati + 1
        If aKey(nTmpNumArc) = "" Then
            
            ReDim aCol(0)
            Call GetColonnaCasuale(nClasseKey,aCol)
            Call MischiaColonna(aCol)
            sTmpCol = StringaNumeri(aCol)
            Do While AddItemColl(coll,sTmpCol,"k" & sTmpCol) = False
                Call GetColonnaCasuale(nClasseKey,aCol)
                Call MischiaColonna(aCol)

                sTmpCol = StringaNumeri(aCol)
            Loop
            
            aKey(nTmpNumArc) = sTmpCol
            bCalcRitMax = True
        Else
            bCalcRitMax = False
        End If
        
        ReDim aNumKey(0)
        Call SplitByChar("." & aKey(nTmpNumArc),".",aNumKey)
        
        sFileArc = GetFileArchivioVirt(sDirArchivi,nEstrIni,nClasseKey,nQArchivi,nTmpNumArc)
        If bEliminaFileArc Then EliminaFile( sFileArc)
        Call Messaggio("Archivio numero " & nTmpNumArc)
        
        If FileEsistente(sFileArc) Then
            If ApriFileBaseDati(sFileArc) Then
                nQEstrInArcV = QuantitaEstrazioniInFile(sFileArc)
            Else
                nQEstrInArcV = 0
            End If
        Else
            nQEstrInArcV = 0
        End If
        idEstrAV = nQEstrInArcV
        ' cicla dalla prima estrazione da aggiungere fino a quelle disponibili nell'archivio reale
        Call AvanzamentoElab(1,nQArchivi,nTmpNumArc)

        For idEstrAR =((nEstrIni - 1) + nQEstrInArcV) + 1 To nQEstrAR
            idEstrAV = idEstrAV + 1
            nPosKey =(idEstrAV Mod nClasseKey) + 1
            nn = Int(aNumKey(nPosKey))
            ReDim aEstrV(11,5)
            For r = 1 To 11
                For e = 1 To 5
                    aEstrV(r,e) = Fuori90(Int(aEstrArcReale(idEstrAR,r,e)) + nn)
                Next
            Next
            ReDim aTmp(0)
            Call SplitByChar(aEstrArcReale(idEstrAR,0,0),"-",aTmp)
            If SalvaEstrazione(aEstrV,aTmp(0),aTmp(1),sFileArc) Then
                nSalv = nSalv + 1
                Call Messaggio("Archivio " & nTmpNumArc  & " di " & nQArchivi &  " colonne " & nSalv)
            End If
        Next
        
        
        If ScriptInterrotto Then Exit Do
        
        If bCalcRitMax Then
            If ApriFileBaseDati(sFileArc) Then
                Call Messaggio("Calcolo ritardo massimi per estratto su archivio numero " & nTmpNumArc)

                nRitMax = GetRitardoMaxEstrattoArchivio(0,0,1)
                nRitRelMax = GetRitRelMaxArchivio(1,EstrazioniArchivio,0,0)

                
                If(nRitMax >= nRitMaxMin And nRitMax <= nRitMaxMax) And(nRitRelMax >= nRitRelMaxMin And nRitRelMax <= nRitRelMaxMax) Then
                    nArcCreati = nArcCreati + 1
                Else
                    Call EliminaFile(sFileArc)
                    aKey(nTmpNumArc) = ""
                    Call ResetRitardoRel
                End If
            End If
        Else
            nArcCreati = nArcCreati + 1
        End If
        
        
        
        
    Loop
    
    
    Set coll = Nothing
    If ScriptInterrotto = False Then
        Call EliminaFile(sFileChiavi)
        For k = 1 To UBound(aKey)
            Call ScriviFile(sFileChiavi,aKey(k),False)
        Next
        Call CloseAllFileHandle
    End If
    
End Sub
Sub ScriviRitMaxPerArchivio(nClasseChiave,nQArchivi,sDirArcVirt,nEstrIni)
    
    Dim k
    Dim Inizio,Fine
    Dim sFileArc
    Dim nRetRitMax,nRetNum,nRetRuota
    Dim nRitRelMax
    
    ReDim av(5)
    av(1) = "Numero"
    av(2) = "Ruota"
    av(3) = "Ritardo max"
    av(4) = "Rit Rel max"
    av(5) = "Archivio num"

    Call InitTabella(av,vbYellow)
    
    
    
        
    
    For k = 1 To nQArchivi
        
        sFileArc = GetFileArchivioVirt(sDirArcVirt,nEstrIni,nClasseChiave,nQArchivi,k)
        Call Messaggio("Calcolo ritardi massimi per estratto su archivi ")
        If ApriFileBaseDati(sFileArc) Then
            nRetRitMax = GetRitardoMaxEstrattoArchivio(nRetNum,nRetRuota,1)
            
            nRitRelMax = GetRitRelMaxArchivio(1,EstrazioniArchivio,0,0)

            
            av(1) = nRetNum
            av(2) = NomeRuota(nRetRuota)
            av(3) = nRetRitMax
            av(4) = nRitRelMax
            av(5) = "Arc_" & FormattaStringa(k,"0000")
            Call AddRigaTabella(av)
        End If
        
        Call AvanzamentoElab(1,nQArchivi,k)
        If ScriptInterrotto Then Exit For
    Next
    Call CreaTabella(3)
    

End Sub

LuigiB · 19 Dicembre 2015

supera i controlli ... vabbe sono stato poco chiaro .. quindi se non li supera verra eliminato e riprodotto fin quando li supera

i legend · 19 Dicembre 2015

ciao luigi provo a scaricare domani la nuova versione

ciao a dopo

buona cena

i legend · 20 Dicembre 2015

Buona domenica a tutti.
Possiedo spazio 1.5.73
Pronto per un altro viaggio ai confini......... la proprio ........lì dove mai nessuno è giunto. Hihihihihi

Buon giorno luigi

LuigiB · 20 Dicembre 2015

ciao legend buona domenica te ... studia lo script e correggi un piccolo errore che c'è.
Ovvero sulla ruota nazionale se non ci sono numeri non deve generare i numeri virtuali ..
vedi se capisci dove va fatta la correzione ..

i legend · 20 Dicembre 2015

ciao a tutti

domanda ma in alimenta matrice non dovrebbe ritornare l estrazione completa
altrimenti si potrebbe controllare alla fonte

Codice:

Con questa variazione mi si è impallato forse questo controllo rallenta troppo
ma per i buchi nelle ruote prima del 3950?
For idEstrAR =((nEstrIni - 1) + nQEstrInArcV) + 1 To nQEstrAR
            idEstrAV = idEstrAV + 1
            nPosKey =(idEstrAV Mod nClasseKey) + 1
            nn = Int(aNumKey(nPosKey))
            ReDim aEstrV(11,5)
            For r = 1 To 11
                For e = 1 To 5
                    If Int(aEstrArcReale(idEstrAR,r,1)) > 0 Then
                        aEstrV(r,e) = Fuori90(Int(aEstrArcReale(idEstrAR,r,e)) + nn)
                    Else
                        aEstrV(r,e) = aEstrArcReale(idEstrAR,r,e)
                    End If
                Next
            Next
            ReDim aTmp(0)
            Call SplitByChar(aEstrArcReale(idEstrAR,0,0),"-",aTmp)
            If SalvaEstrazione(aEstrV,aTmp(0),aTmp(1),sFileArc) Then
                nSalv = nSalv + 1
                Call Messaggio("Archivio " & nTmpNumArc & " di " & nQArchivi & " colonne " & nSalv)
            End If
        Next

Ciao a dopo

LuigiB · 20 Dicembre 2015

ciao Legend , c è un errore

Codice:

.. 
 For e = 1 To 5                     If Int(aEstrArcReale(idEstrAR,r,1)) > 0 Then                         aEstrV(r,e) = Fuori90(Int(aEstrArcReale(idEstrAR,r,e)) + nn)                     Else                         aEstrV(r,e) = aEstrArcReale(idEstrAR,r,e)                     End If                 Next

Legend - NUOVA MISSIONE

LuigiB

Guest

Premium Member

LuigiB

Guest

LuigiB

Guest

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Premium Member

Premium Member

Advanced Member >PLATINUM PLUS<

Premium Member

Premium Member

Premium Member

Advanced Member >PLATINUM PLUS<

LuigiB

Guest

LuigiB

Guest

Premium Member

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest