'Algumas declara‡äes iniciais

DEFINT A-Z

tambloco = 1000
DIM c5(1 TO tambloco) AS STRING * 8
DIM N5(1 TO tambloco) AS STRING * 17
DIM n2 AS STRING
DIM XS!
DIM bb AS LONG
DIM NUMREG AS DOUBLE
DIM R AS LONG
DIM REG AS DOUBLE
DIM c$(40)
DIM N$(40)

DIM np AS STRING
DIM no(1.677722E+07) AS STRING
DIM nn5(1.677722E+07) AS STRING
DIM bc AS STRING
tamReg = 25

CLS

'Moldura...
COLOR 11
LOCATE 1, 1: PRINT STRING$(80, CHR$(196))
LOCATE 3, 1: PRINT STRING$(80, CHR$(196))
LOCATE 23, 1: PRINT STRING$(80, CHR$(196))

FOR R = 1 TO 23
    LOCATE R, 1: PRINT CHR$(179)
    LOCATE R, 80: PRINT CHR$(179)
NEXT R
         
FOR t = 3 TO 23
    LOCATE t, 36: PRINT CHR$(179)
NEXT t

LOCATE 3, 1: PRINT CHR$(195)
LOCATE 3, 80: PRINT CHR$(180)
LOCATE 1, 80: PRINT CHR$(191)
LOCATE 23, 80: PRINT CHR$(217)
LOCATE 23, 1: PRINT CHR$(192)
LOCATE 1, 1: PRINT CHR$(218)
LOCATE 23, 36: PRINT CHR$(193)
LOCATE 3, 36: PRINT CHR$(194)
'LOCATE 9, 1: PRINT CHR$(195)
'LOCATE 9, 36: PRINT CHR$(180)

'Mostra Data
d$ = MID$(DATE$, 1, 3)
c$ = MID$(DATE$, 4, 3)
e$ = MID$(DATE$, 7, 4)
f$ = c$ + d$ + e$

COLOR 11: LOCATE 2, 25: PRINT "* * * Gera Combinacoes * * *":
LOCATE 2, 65: PRINT f$
COLOR 7
LOCATE 20, 8: PRINT "Esc para Sair"

hb = 6
cvc = 6
DO
    'hb = 6
    OPEN "Gera.dat" FOR BINARY AS #1
    NUMREG = LOF(1) \ tamReg 'calcula o n£mero de registros
    CLOSE #1

    XS! = NUMREG

    CONST false = 0, TRUE = NOT false

    'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´


    'Agora sim come‡a o programa em si
    REG = XS! '£ltimo reg + 1

    in$ = INKEY$

    LOCATE 4, 2
    PRINT " Con. Cadast:";: COLOR 15: PRINT NUMREG: COLOR 7

    n2$ = ""
    DR$ = "00000000"

    DO

        s$ = "0"
        bc$ = ""
        FOR ea = 1 TO 6
            DO
                done = 1
                RANDOMIZE TIMER
                fa = INT(RND * 60) + 1
                FOR er = 1 TO 6 'Impede que um n£mero seja repetido
                    IF nn$(er) = LTRIM$(STR$(fa)) THEN done = 0: EXIT FOR
                NEXT er
            LOOP WHILE done = 0
            nn$(ea) = LTRIM$(STR$(fa))
        NEXT ea

        DO
            done = 0
            FOR ei = 1 TO 6 - 1
                IF VAL(nn$(ei)) > VAL(nn$(ei + 1)) THEN
                    SWAP nn$(ei), nn$(ei + 1)
                    done = 1
                END IF
            NEXT ei
        LOOP WHILE done = 1

        FOR rr = 1 TO 6
            IF VAL(nn$(rr)) < 10 THEN
                bc$ = bc$ + s$ + nn$(rr) + " "
            ELSE
                bc$ = bc$ + nn$(rr) + " "
            END IF
        NEXT rr

        n2$ = LEFT$(bc$, 17)

        'Impede que uma combinacao seja repetida

        'done = 1

        FOR bb = 1 TO NUMREG
            IF (n2$) = (nn5$(bb)) THEN
                done = 0
                EXIT FOR
            ELSE
                done = 1
            END IF
        NEXT bb

        CLOSE #1

        IF maxj = 0 THEN
            done = 1
        END IF

    LOOP WHILE done = 0

    XS! = XS! + 1

    n1$ = n2$
    REG = REG + 1
    H1$ = LTRIM$(STR$(XS!))
    c1$ = RIGHT$(DR$, (LEN(DR$) - LEN(H1$))) + H1$

    OPEN "Gera.dat" FOR RANDOM ACCESS READ WRITE AS #1 LEN = 25
    FIELD #1, 8 AS a$, 17 AS f$

    'atualiza os dados no arquivo
    IF n1$ <> "" THEN
        LSET a$ = c1$
        LSET f$ = n1$
        PUT #1, REG
        LOCATE 9, 3: PRINT "                              "
        LOCATE 4, 40: PRINT "Conc. "; c1$; " => "; n1$
        b = b + 1
    END IF

    CLOSE #1

    'Tamanho do bloco (em n£mero de registros). Basta alterar esse valor que
    'todo o programa ser  adaptado ao novo valor.

    'Tamanho de cada registro (em bytes). Basta alterar aqui tamb‚m.

    'Conta quantos blocos tem o arquivo atual
    'Qual o tamanho do arquivo?
    OPEN "Gera.dat" FOR BINARY AS #1
    tamArq = LOF(1)
    CLOSE #1

    'Calcula o n£mero de blocos do arquivo
    numBlocos = tamArq \ (tambloco * tamReg)
    'Se a divisÆo de blocos no arquivo nÆo for exata...
    a = (tamArq MOD (tambloco * tamReg)) \ tamReg
    IF a > 0 THEN
        numBlocos = numBlocos + 1 'temos um bloco incompleto no fim do arq.
        NumRegUltBlc = a 'N£mero de Registros do éltimo Bloco
        'Mas se for exata...
    ELSE
        NumRegUltBlc = tambloco 'O £ltimo registro ‚ um bloco completo
    END IF

    no$ = UCASE$(no$)

    'Agora o programa vai ler e exibir na tela todos os registros, lendo
    'um bloco de cada vez
    OPEN "Gera.dat" FOR RANDOM AS #1 LEN = 25
    FIELD #1, 8 AS a$, 17 AS f$

    FOR kk = 1 TO numBlocos
        IF kk < numBlocos THEN maxj = tambloco ELSE maxj = NumRegUltBlc
        FOR j = 1 TO maxj 'lˆ o bloco
            GET #1, tambloco * (kk - 1) + j
            c5$(j) = a$
            N5$(j) = f$
            nn5$(j) = f$
        NEXT j

        FOR y = 1 TO maxj
            no$ = nn5$(y)
        NEXT y
    NEXT kk

    CLOSE #1

LOOP UNTIL in$ = CHR$(27)
 
SYSTEM