|
Programma di esempio DBFCREAT.PRT |
; DBFCREAT
;
; Programma per Proteus
;
; (C) 2003 Simone Zanella Productions
;
; Crea un archivio DBF a partire da un file di testo.
; L'archivio contiene due campi di tipo carattere, "CODICE" (8 caratteri) e "DESC" (30 caratteri);
; il file di testo conterrā il codice nei primi 8 caratteri di ogni riga e la descrizione nei successivi
; 30 caratteri. Prima di trasferire i dati nel database, li ordina sul codice attraverso un AVL.
#!proteus -z
CONST DBF_HEAD_LEN = 32
CONST DBF_REC_LEN = 32
IF LT(ARGC, 6)
CONSOLELN "Sintassi: " ARGV(1) " " ARGV(2) " file.txt file.DBF"
ABORT 0
FI
; Apre il file articoli ed importa in un AVL gli articoli (ordinati sul codice)
TxtFile = ARGV(5)
Articoli = AVLNEW()
H2 = FOPEN(TxtFile, 1)
IF EQ(H2, -1)
CONSOLELN "File \"" TxtFile "\" non trovato oppure bloccato."
ABORT 0
FI
WHILE NOT(FEOF(H2))
L = FREADLN(H2)
Cod = LEFT(L, 8)
Desc = SUBSTR(L, 9, 30)
AVLSET(Articoli, Cod, Desc)
LOOP
FCLOSE(H2)
; Apre il file DBF, scrive l'intestazione e trascrive l'AVL.
DbfFile = ARGV(6)
H = FOPEN(DbfFile, 28)
IF EQ(H, -1)
CONSOLELN "Errore nella creazione di \"" DbfFile "\"."
ABORT 0
FI
; Crea il vettore con tipo e dimensione dei vari campi
V = VECCREATE(VECCREATE("CODICE", "C", 8, 0), VECCREATE("DESC", "C", 30, 0))
ArtDbf = CreaCampi(V)
N = 0
N2 = 0
FOR X = 1 TO VECLEN(V)
ADD(@N, 32)
ADD(@N2, VECGET(VECGET(V, X), 3))
VECFREE(VECGET(V, X))
NEXT
VECFREE(V)
; Struttura intestazione:
; nome lunghezza descrizione
; 1 dbf_id 1 id del database
; 2 last_update 3 ultimo aggiornamento (ANNO MESE GIORNO)
; 5 last_rec 4 ultimo record
; 9 data_offset 2 offset all'inizio dei record
; 11 rec_size 2 lunghezza di un record
; 13 filler 20 riservati
Data = DATE()
S = CHR(0x03) CHR(SUB(YEAR(Data), 1900)) CHR(MONTH(Data)) \
CHR(DAY(Data)) \
LongWord2String(AVLLENGTH(Articoli)) \
Word2String(ADD(33, N)) \
Word2String(INC(N2)) REPLICATE(CHR(0), 20) ArtDbf CHR(13)
FWRITE(H, S)
AVLTRAVERSE(Articoli, Trascrivi)
FWRITE(H, CHR(0x1A))
FCLOSE(H)
AVLFREE(Articoli)
ABORT 0
FUNCTION Trascrivi(label, contents)
; Trascrive il contenuto del record (il byte iniziale indica se
; il record č marcato per la cancellazione)
FWRITE(_H, " " label contents)
RETURN 0
FUNCTION String2Word(s)
; Converte da binario a word
RETURN NOR( ASC(LEFT(s, 1)), SHIFTLT(ASC(SUBSTR(s, 2, 1)), 8) )
FUNCTION Word2String(n)
; Converte da word a binario
RETURN CHR(NAND(n, 0xFF)) CHR(NAND(SHIFTRT(n, 8), 0xFF))
FUNCTION String2LongWord(s)
; Converte da binario a long word
RETURN NOR(ASC(LEFT(s, 1)), \
SHIFTLT(ASC(SUBSTR(s, 2, 1)), 8), \
SHIFTLT(ASC(SUBSTR(s, 3, 1)), 16), \
SHIFTLT(ASC(SUBSTR(s, 4, 1)), 24))
FUNCTION LongWord2String(n)
; Converte da long word a binario
RETURN CHR(NAND(n, 0xFF)) CHR(NAND(SHIFTRT(n, 8), 0xFF)) CHR(NAND(SHIFTRT(n, 16), 0xFF)) \
CHR(NAND(SHIFTRT(n, 24), 0xFF))
FUNCTION CreaCampi(v)
; Crea una stringa che contiene la descrizione dei campi nel vettore v;
; ogni elemento del vettore č a sua volta un vettore i cui elementi sono:
; 1 = nome del campo
; 2 = tipo del campo (C = carattere, N = numero, L = logico, D = data)
; 3 = dimensione del campo (8 fisso se data, 1 fisso se logico, numero di cifre intere se numero)
; 4 = numero di cifre decimali (significative solo se il tipo del campo č numerico)
st = ""
FOR x = 1 TO VECLEN(v)
t = VECGET(v, x)
; Formato della stringa binaria calcolata:
; 1 field_name 11 nome del campo
; 12 field_type 1 tipo campo (N, C, L, D)
; 13 dummy 4 riservati
; 17 char_len 1 lung. stringa (byte basso)/numero
; 18 dec 1 lung. stringa (byte alto)/numero di decimali (per i numeri)
; 19 filler 14 riservati
s = PADR(VECGET(t, 1), 11, CHR(0)) VECGET(t, 2) REPLICATE(CHR(0), 4)
IF STREQ(VECGET(t, 2), "C")
s = s Word2String(VECGET(t, 3))
ELSE
s = s CHR(VECGET(t, 3)) CHR(VECGET(t, 4))
FI
s = s REPLICATE(CHR(0), 14)
st = st s
NEXT
RETURN st