\ DBF Struct \ Copyright (C) 2000 Alex Malyshev (alexript@mail.ru) \ This is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License \ as published by the Free Software Foundation; either version 2 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, \ but WITHOUT ANY WARRANTY; without even the implied warranty of \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License \ along with this program; if not, write to the Free Software \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. uses StartUp uses Ext.struct uses Files.fileio uses Date.timedate uses TTY.yesno uses Ext.comment struct char% field Version char% field lmYear char% field lmMonth char% field lmDay cell% field NumberOfRecords short% field 1stRecord short% field RecordLen 1 chars 16 chars field Reserved1 char% field fIndex 1 chars 3 chars field Reserved2 end-struct DBF3Header struct 1 chars 11 chars field FieldName char% field DataType cell% field FieldOff char% field FieldLen 1 chars 15 chars field Reserved3 end-struct DBFSubRecord struct cell% field hFile DBF3Header field DBF3FileHeader cell% field SubRecords end-struct DBF3File : DBFFileA ( | aname -- ) CREATE DBF3File %size ALLOT ; : DBFGetVersion ( aname -- n ) DBF3FileHeader Version c@ ; : DBFGetDate ( aname -- day month year ) DBF3FileHeader DUP lmDay C@ over lmMonth C@ rot lmYear c@ 1900 + ; : DBFSetDate { aname d m yy -- } aname DBF3FileHeader DUP lmDay d swap c! DUP lmMonth m swap c! lmYear yy 1900 - swap c! ; : DBFGetNomberOfRecords ( aname -- n ) DBF3FileHeader NumberOfRecords @ ; : DBFGet1stRecordOff ( aname -- n ) DBF3FileHeader 1stRecord @ 65535 AND ; : DBFGetNumberOfFields ( aname -- n ) DBFGet1stRecordOff DBF3Header %size - DBFSubRecord %size / ; : DBFGetRecordLen ( aname -- n ) DBF3FileHeader RecordLen @ 65535 AND ; : DBFIndex? ( aname -- f ) DBF3FileHeader fIndex c@ ; : DBFFreeSubRecords ( aname -- f ) SubRecords @ FREE 0= ; : DBFReadSubRecords { aname -- f } DBFSubRecord %size aname DBFGetNumberOfFields * ALLOCATE 0= IF DUP aname SubRecords ! DBFSubRecord %size aname DBFGetNumberOfFields * aname hFile @ read-file IF DROP aname DBFFreeSubRecords DROP FALSE ELSE \ Reading Ok DBFSubRecord %size aname DBFGetNumberOfFields * = THEN ELSE FALSE THEN ; : DBFReadHeader { aname -- f } aname DBF3FileHeader DBF3Header %size aname hFile @ read-file 0= IF DBF3Header %size = if aname DBFReadSubRecords then ELSE DROP FALSE THEN ; : DBFOpenFile { aname addr u mode -- f } addr u isFileReaded if mode open-file 0= if aname hFile ! aname DBFReadHeader else false then else 2drop false then ; : DBFCloseFile ( aname -- f ) DUP hFile @ close-file 0= SWAP DBFFreeSubRecords AND ; : .DBFVersion ( n -- ) CASE 3 OF ." FoxBASE+/dBASE III+/IV" ENDOF 131 OF ." FoxPro/dBASE III+ with memo" ENDOF 245 OF ." FoxPro with memo" ENDOF 139 OF ." dBASE IV with memo" ENDOF ENDCASE ; \ --------------------------------------------------- : DBFPrintHeader ( aname -- ) CR DUP DBFGetVersion ." Version: " .DBFVersion CR DUP DBFGetDate ." Date: " .date CR DUP DBFGetNomberOfRecords ." Records: " . CR DUP DBFGetNumberOfFields ." Fields: " DUP . ." ( 0 -- " 1- . ." )" CR DUP DBFGet1stRecordOff ." 1st Rec: " . CR DUP DBFGetRecordLen ." Len.of Rec: " . CR DBFIndex? ." Index: " .Yes/No CR ; \ ---------------------------------------------------
Make your own free website on Tripod.com