home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 1.ddi / DBASE3.PRO < prev    next >
Encoding:
Prolog Source  |  1987-03-23  |  4.3 KB  |  125 lines
  1. /************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.     Access a dBASE III(TM) (V1.1) compatible file from Prolog
  7.  
  8. *************************************************************/
  9.  
  10. Domains
  11. /*************************************************************
  12.     Prolog representation of the data base
  13. *************************************************************/
  14.  
  15.   Dbase3RecL    = Dbase3Rec*        /* A database is a number of records */
  16.   Dbase3Rec    = Dbase3Elem*        /* A record is a number of fields */
  17.   Dbase3Elem    = char(String);        /* Characters */
  18.             real(Real);        /* 64-bit IEEE floating point */
  19.             logical(Bool);    /* Logical */
  20.             memo(String);        /* 10 digits rep. a .DBT block no */
  21.             date(String)        /* format YYYY MM DD */
  22.   
  23.   Bool        = Char            /* Y y N n T t F f or Space */
  24.   
  25.   FldDescL    = FldDesc*        /* description for each field */
  26.   FldDesc    = flddesc(Dbase3Type,Integer)
  27.   Dbase3Type    = ch;r;l;m;d
  28.   
  29.   FldNameL    = String*
  30.  
  31. PREDICATES
  32.   /* Read predicates */
  33.   Init_Dbase3(Real,FldNameL,FldDescL)
  34.   rd_dbase3_DbaseHeader(Real)
  35.   rd_dbase3_fieldDescL(FldNameL,FldDescL)
  36.   rd_dbase3File(Real,File,FldDescL,Dbase3RecL)
  37.   rd_dbase3_DataRec(File,FldDescL,dBase3Rec)
  38.   rd_dbase3_elem(File,FldDesc,dBase3Elem)
  39.  
  40.   conv_FldType(Char,dBASE3Type)
  41.  
  42.   /* Read a single record */
  43.   rd_dbase3_DataRec1(Real,Real,File,FldDescL,dBase3Rec)
  44.   rd_dbase3Rec(Real,File,FldDescL,dBase3Rec)
  45.  
  46. CLAUSES
  47.   Init_Dbase3(TotRecs,FldNameL,FldDescL):-
  48.     rd_dbase3_DbaseHeader(TotRecs),
  49.     rd_dbase3_fieldDescL(FldNameL,FldDescL).
  50.  
  51.  
  52. /*************************************************************
  53.     Read dBASE III(TM) header
  54. *************************************************************/
  55.  
  56.   rd_dbase3_DbaseHeader(TotRecs):-
  57.     ignore(4),        /* ID & Last update & record size */
  58.     read_long(TotRecs), /* 32-bit number */
  59.     ignore(24).        /* Header length, Record length & Reserved */
  60.  
  61.  
  62. /*************************************************************
  63.     Read Field descriptors
  64. *************************************************************/
  65.  
  66.   rd_dbase3_fieldDescL([FldName|FldNameL],[fldDesc(Type,Len)|FldDescL]):-
  67.     readchar(Ch), Ch<>'\013',!, /* CR means final array field */
  68.     read_strArr(10,Name), frontchar(FldName,Ch,Name),
  69.     readchar(T), conv_FldType(T,Type),
  70.     ignore(4),    /* data address */
  71.     readchar(L), char_int(L,Len),
  72.     ignore(15),    /* decimal count & Reserved */
  73.     rd_dbase3_FieldDescL(FldNameL,FldDescL).
  74.  
  75.   rd_dbase3_FieldDescL([],[]):-readchar(_).
  76.  
  77.   conv_FldType('C',ch):-!.
  78.   conv_FldType('N',r):-!.
  79.   conv_FldType('L',l):-!.
  80.   conv_FldType('M',m):-!.
  81.   conv_FldType('D',d):-!.
  82.  
  83.   
  84. /*************************************************************
  85.     Read Data Records
  86. *************************************************************/
  87.  
  88.   rd_dbase3File(0,_,_,[]):-!.
  89.   rd_dbase3File(N,MFP,FldDescL,[Rec|RecL]):-
  90.     rd_dbase3_DataRec1(N,N2,MFP,FldDescL,Rec),
  91.     rd_dbase3File(N2,MFP,FldDescL,RecL).
  92.  
  93.   rd_dbase3_datarec1(Ni,No,MFP,FldDescL,Rec):-
  94.     readchar(NotDel), NotDel=' ',!,    No=Ni-1,rd_dbase3_DataRec(MFP,FldDescL,Rec).
  95.   rd_dbase3_datarec1(Ni,No,MFP,FldDescL,Rec):-
  96.     Ni2=Ni-1, rd_dbase3_datarec(MFP,FldDescL,_),
  97.     rd_dbase3_DataRec1(Ni2,No,MFP,FldDescL,Rec).
  98.  
  99.   rd_dbase3_DataRec(_,[],[]):-!.
  100.   rd_dbase3_DataRec(MFP,[FldDesc|FldDescL],[Elem|ElemL]):-
  101.     rd_dbase3_elem(MFP,FldDesc,Elem), rd_dbase3_DataRec(MFP,FldDescL,ElemL).
  102.  
  103.   rd_dbase3_elem(_,fldDesc(ch,Len),char(Str)):-!,read_strArr(Len,Str).
  104.   rd_dbase3_elem(_,fldDesc(l,Len),logical(Char)):-!,
  105.     readchar(Char), ToSkip=Len-1, ignore(ToSkip).
  106.   rd_dbase3_elem(_,fldDesc(r,Len),real(Real)):-!,
  107.     read_strArr(Len,Str), str_real(Str,Real).
  108.   rd_dbase3_elem(MFP,fldDesc(m,Len),memo(Memo)):-!,
  109.     read_strArr(Len,BlkNo),
  110.     str_int(BlkNo,P), Pos=P*512,
  111.     readdevice(FP), readdevice(MFP),
  112.     filepos(MFP,Pos,0), read_strCtrlZ(Memo),
  113.     readdevice(FP).
  114.   rd_dbase3_elem(_,fldDesc(d,Len),date(Date)):-!,read_strArr(Len,Date).
  115.  
  116.  
  117. /*************************************************************
  118.     Read data records sequentially
  119. *************************************************************/
  120.  
  121.   rd_dbase3Rec(0,_,_,_):-!,fail.
  122.   rd_dbase3Rec(N,MFP,FldDescL,Rec):-rd_dbase3_datarec1(N,_,MFP,FldDescL,Rec).
  123.   rd_dbase3Rec(N,MFP,FldDescL,Rec):-N2=N-1, rd_dbase3Rec(N2,MFP,FldDescL,Rec).
  124.  
  125.