; DBFDUMP
;
; Program for Proteus
;
; (C) 2003-2004 Simone Zanella Productions
;
; This program print out the structure of a DBF file and its contents.

#!proteus -z

CONST DBF_HEAD_LEN = 32
CONST DBF_REC_LEN  = 32

IF LT(ARGC, 5)
  CONSOLELN "Syntax: " ARGV(1) " " ARGV(2) " file.DBF"
  ABORT 0
FI
DbfFile = ARGV(5)
H = FOPEN(DbfFile, 1)
IF EQ(H, -1)
  CONSOLELN "File " DbfFile " not found or locked."
  ABORT 0
FI

; Header:
; name             length         description
; 1  dbf_id        1              database id
; 2  last_update   3              last update (YEAR MONTH DAY)
; 5  last_rec      4              last record
; 9  data_offset   2              offset to first record
; 11 rec_size      2              record length
; 13 filler        20             reserved

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 "Last update: " ASC(SUBSTR(Head, 2, 1)) " " \
                          ASC(SUBSTR(Head, 3, 1)) " " \
                          ASC(SUBSTR(Head, 4, 1))
CONSOLELN "Data Offset:   " DataOffset
CONSOLELN "Record size:   " RecSize
CONSOLELN "Number of records: " LastRec
CONSOLELN "------------------------"
CONSOLELN "NAME        TYPE LEN DEC"

Fields = VECNEW(0)
REPEAT
  ; Format of calculated binary string:
  ; 1  field_name    11             field name
  ; 12 field_type    1              field type (N, C, L, D)
  ; 13 dummy         4              reserved
  ; 17 char_len      1              string length (lower byte)/number
  ; 18 dec           1              string length (higher byte)/number of decimal digits (for numbers)
  ; 19 filler        14             reserved
  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)

; Read all records and print them
FOR RecNum = 1 TO LastRec

  Record = FREAD(H, RecSize)

  ; Print record number and deleted status
  ; (* if deleted, blank otherwise)

  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)

; Convert from binary to word
RETURN NOR( ASC(LEFT(s, 1)), SHIFTLT(ASC(SUBSTR(s, 2, 1)), 8) )


FUNCTION String2LongWord(s)

; Convert from binary to 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))