; DBFDUMP
;
; Programma per Proteus
;
; (C) 2003 Simone Zanella Productions
;
; Questo programma stampa la struttura di un file DBF ed il suo contenuto.

#!proteus -z

CONST DBF_HEAD_LEN = 32
CONST DBF_REC_LEN  = 32

IF LT(ARGC, 5)
  CONSOLELN "Sintassi: " ARGV(1) " " ARGV(2) " file.DBF"
  ABORT 0
FI
DbfFile = ARGV(5)
H = FOPEN(DbfFile, 1)
IF EQ(H, -1)
  CONSOLELN "File " DbfFile " non trovato oppure bloccato."
  ABORT 0
FI

; Struttura intestazione:
; nome             lunghezza      descrizione
; 1  dbf_id        1              id del database
; 2  last_update   3              ultimo aggiornamento
; 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

Head = FREAD(H, DBF_HEAD_LEN)
DataOffset = String2Word(SUBSTR(Head, 9, 2))
RecSize = String2Word(SUBSTR(Head, 11, 2))
LastRec = String2LongWord(SUBSTR(Head, 5, 4))

CONSOLELN "File: " DbfFile
CONSOLELN "Aggiornato il: " ASC(SUBSTR(Head, 2, 1)) " " \
                            ASC(SUBSTR(Head, 3, 1)) " " \
                            ASC(SUBSTR(Head, 4, 1))
CONSOLELN "Offset dati:   " DataOffset
CONSOLELN "Dim. record:   " RecSize
CONSOLELN "Numero di record: " LastRec
CONSOLELN "------------------------"
CONSOLELN "NOME        TIPO LUN DEC"

Fields = VECNEW(0)
REPEAT
  ; Struttura record:
  ; 1  field_name    11             nome del campo
  ; 12 field_type    1              tipo campo (N, A, 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 = FREAD(H, DBF_REC_LEN)
  MoreFields = EQ(STRLEN(S), DBF_REC_LEN)
  IF MoreFields
    MoreFields = STRNEQ(LEFT(S, 1), CHR(13))
    IF MoreFields
      IF STREQ(SUBSTR(S, 12, 1), "N")
        CONSOLELN PADR(TOKEN(LEFT(S, 11), 1, CHR(0)), 11, " ") "  " \
                  SUBSTR(S, 12, 1) "   " \
                  PADL(ASC(SUBSTR(S, 17, 1)), 3, " ") " " \
                  PADL(ASC(SUBSTR(S, 18, 1)), 3, " ")
      ELSE
        CONSOLELN PADR(TOKEN(LEFT(S, 11), 1, CHR(0)), 11, " ") "  " \
                  SUBSTR(S, 12, 1) "   " \
                  PADL(String2Word(SUBSTR(S, 17, 2)), 3, " ") " " \
                  PADL("0", 3, " ")
      FI
      VECAPPEND(Fields, S)
    FI
  FI
UNTIL NOT(MoreFields)
CONSOLELN "------------------------"
NumFields = VECLEN(Fields)

FSEEK(H, DataOffset, 0)

; Legge tutti i record e li stampa
FOR RecNum = 1 TO LastRec

  Record = FREAD(H, RecSize)

  ; Stampa il numero del record ed il byte di cancellazione
  ; (posto ad * se cancellato, altrimenti spazio)

  CONSOLE PADL(RecNum, 4, " ") " " LEFT(Record, 1) " "
  RecOffset = 2
  FOR Y = 1 TO NumFields
    S = VECGET(Fields, Y)
    IF STREQ(SUBSTR(S, 12, 1), "N")
      Width = ASC(SUBSTR(S, 17, 1))
    ELSE
      Width = String2Word(SUBSTR(S, 17, 2))
    FI
    CONSOLE SUBSTR(Record, RecOffset, Width) " "
    ADD(@RecOffset, Width)
  NEXT
  CONSOLELN ""

NEXT
ABORT 0


FUNCTION String2Word(s)

; Converte da binario a word
RETURN NOR( ASC(LEFT(s, 1)), SHIFTLT(ASC(SUBSTR(s, 2, 1)), 8) )


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))