\ DBF Records \ 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 Files.DBF.struct uses Files.DBF.fields VARIABLE pTempRecordBuffer : DBFPrintTempRecordBuffer ( aname -- ) pTempRecordBuffer @ DBFGetRecordLen TYPE CR ; : DBFFreeTempRecordBuffer ( -- f ) pTempRecordBuffer @ FREE 0= ; : DBFReadRecordToTempBuffer { aname n -- f } aname DBFGetRecordLen DUP { len } ALLOCATE 0= IF pTempRecordBuffer ! n len * aname DBFGet1stRecordOff + aname hFile @ DUP { h } 2DUP file-size DROP D>S < IF SWAP S>D ROT reposition-file IF DBFFreeTempRecordBuffer DROP FALSE ELSE pTempRecordBuffer @ len h read-file 0= IF len = IF TRUE ELSE DBFFreeTempRecordBuffer DROP FALSE THEN ELSE DBFFreeTempRecordBuffer DROP FALSE THEN THEN ELSE DBFFreeTempRecordBuffer DROP FALSE THEN ELSE FALSE THEN ; : DBFRecordDeleted? pTempRecordBuffer @ @ [CHAR] * = ; : .* DBFRecordDeleted? IF [char] * EMIT ELSE SPACE THEN ; : DBFPrintSingleRecord { aname n -- f } aname n DBFReadRecordToTempBuffer IF aname DBFGetNumberOfFields 0 DO aname I 2DUP DBFGetFieldName TYPE ." : " DBFGetFieldOff pTempRecordBuffer @ + aname I DBFGetFieldLen TYPE CR LOOP ." Deleted: " .* CR DBFFreeTempRecordBuffer THEN ; : DBFPrintRecord { aname n -- f } aname n DBFReadRecordToTempBuffer IF ." |".* ." |" aname DBFGetNumberOfFields 0 DO aname I DBFGetFieldOff pTempRecordBuffer @ + aname I DBFGetFieldLen TYPE ." | " LOOP CR DBFFreeTempRecordBuffer THEN ; : DBFPrintBase { aname -- } aname DBFGetNomberOfRecords 0 DO aname I DBFPrintRecord 0= IF LEAVE THEN LOOP ;
Make your own free website on Tripod.com