; DBFCREAT
;
; Program for Proteus
;
; (C) 2003-2004 Simone Zanella Productions
;
; Create a DBF file from a text file.
; The database has two character fields: "CODE" (8 characters) and "DESC" (30 characters);
; the text file holds CODE in the first 8 characters and DESC in the remaining characters.
; Data are sorted before being inserted into the database.

#!proteus -z

CONST DBF_HEAD_LEN = 32
CONST DBF_REC_LEN  = 32

IF LT(ARGC, 6)
  CONSOLELN "Syntax: " ARGV(1) " " ARGV(2) " file.txt file.DBF"
  ABORT 0
FI

; Open file and insert articles into AVL (sorted on code)
TxtFile = ARGV(5)
Articles = AVLNEW()
H2 = FOPEN(TxtFile, 1)
IF EQ(H2, -1)
  CONSOLELN "File \"" TxtFile "\" not found or locked."
  ABORT 0
FI
WHILE NOT(FEOF(H2))
  L = FREADLN(H2)
  Cod = LEFT(L, 8)
  Desc = SUBSTR(L, 9, 30)
  AVLSET(Articles, Cod, Desc)
LOOP
FCLOSE(H2)

; Open DBF file, write header and transcribe AVL.
DbfFile = ARGV(6)
H = FOPEN(DbfFile, 28)
IF EQ(H, -1)
  CONSOLELN "Error creating \"" DbfFile "\"."
  ABORT 0
FI

; Create an array holding type and size of each field
V = VECCREATE(VECCREATE("CODE", "C", 8, 0), VECCREATE("DESC", "C", 30, 0))
ArtDbf = CreateFields(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)

; 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

Date = DATE()
S = CHR(0x03) CHR(SUB(YEAR(Date), 1900)) CHR(MONTH(Date)) \
    CHR(DAY(Date)) \
    LongWord2String(AVLLENGTH(Articles)) \
    Word2String(ADD(33, N)) \
    Word2String(INC(N2)) REPLICATE(CHR(0), 20) ArtDbf CHR(13)
FWRITE(H, S)

AVLTRAVERSE(Articles, Transcribe)

FWRITE(H, CHR(0x1A))
FCLOSE(H)

AVLFREE(Articles)
ABORT 0


FUNCTION Transcribe(label, contents)

; Transcribe record contents (initial byte tells if record
; is deleted).
FWRITE(_H, " " label contents)
RETURN 0


FUNCTION String2Word(s)

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


FUNCTION Word2String(n)

; Convert from word to binary
RETURN CHR(NAND(n, 0xFF)) CHR(NAND(SHIFTRT(n, 8), 0xFF))


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


FUNCTION LongWord2String(n)

; Convert from long word to binary
RETURN CHR(NAND(n, 0xFF)) CHR(NAND(SHIFTRT(n, 8), 0xFF)) CHR(NAND(SHIFTRT(n, 16), 0xFF)) \
       CHR(NAND(SHIFTRT(n, 24), 0xFF))


FUNCTION CreateFields(v)

; Create a string holding the description of each field in array v;
; each element of the array is, in turn, an array whose elements are:
;   1 = field name
;   2 = field type (C = character, N = number, L = logical, D = date)
;   3 = field size (8 fixed if date, 1 fixed if logical, number of integer digits if number)
;   4 = number of decimal digits (meaningful only if field is a number)

st = ""
FOR x = 1 TO VECLEN(v)
  t = VECGET(v, x)

  ; 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 = 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