------------------------------------------------------------ ------------------------------------------------------------ I've got some materials from http://www.gdsoft.com/swag/downloads.html Have a look (in Misc.swg - download the reader too) The examples below are written in Turbo Pascal (7.0 i suppose) So if you can write PHP codes using the examples... Regards, Nadim Attari ------------------------------------------------------------ ------------------------------------------------------------ HelpPC 2.0 PC Programmers Reference - Copyright (c) 1990 David Jurgens dBASE - File Header Structure (dBASE II) Offset Size Description 00 byte dBASE version number 02h=dBASE II 01 word number of data records in file 03 byte month of last update 04 byte day of last update 05 byte year of last update 06 word size of each data record 08 512bytes field descriptors (see below) 520 byte 0Dh if all 32 field descriptors used; otherwise 00h - dBASE II file header has a fixed size of 521 bytes DBASE - File header structure (DBASE III) Offset Size Description 00 byte dBASE vers num 03h=dBASE III w/o .DBT 83h=dBASE III w .DBT 01 byte year of last update 02 byte month of last update 03 byte day of last update 04 dword long int number of data records in file 08 word header structure length 10 word data record length 12 20bytes version 1.0 reserved data space 32-n 32bytes ea. field descriptors (see below) n+1 byte 0dH field terminator. - unlike dBASE II, dBASE III has a variable length header dBASE - Field Descriptors dBASE II Field Descriptors (header contains 32 FDs) Offset Size Description 00 11bytes null terminated field name string, 0Dh as first byte indicates end of FDs 11 byte data type, Char/Num/Logical (C,N,L) 12 byte field length 13 word field data address, (set in memory) 15 byte number of decimal places dBASE III Field Descriptors (FD count varies): Offset Size Description 00 11bytes null terminated field name string 11 byte data type, Char/Num/Logical/Date/Memo 12 dword long int field data address, (set in memory) 16 byte field length 17 byte number of decimal places 18 14bytes version 1.00 reserved data area ------------------------------------------------------------ ------------------------------------------------------------ {---------------------------------------------------------} { Unit : Dbase III Access Routines } { Auteur : Ir. G.W. van der Vegt } { Hondsbroek 57 } { 6121 XB Born } {---------------------------------------------------------} { Datum .tijd Revisie } { 910701.2130 Creatie. } { 910702.1000 Minor Errors Corrected } { Replace, Append & Pack Added } { 910706.2400 dbrec on the Heap (recsize max 64kB-16) } { Uppercase Conversion in Bd3_fileno } { Optional Halt on (fatal) Errors } { 910710.1500 Memo Field Support } { 910715.2330 Field2num bug fixed (leading sp. removed) } { 910960.1130 Fieldno Out of range detection } { 920116.1000 Two minor bugs fixed } { 920124.2200 Header updated when file is closed, } { Db3_Seekbof & Db3_Seekeof added } { Db3_Findfirst & Db3_Findnext implemented } { for wildcard search of records } { Db3_soudex & Db3_field2soundex for Soundex} { code (sound alike) operations } { Db3_firstsoudex & Db3_nextsoundex for } { soundex search on a field } { 920127.1300 Dbase Slack Filespace Detection & } { Correction } { 920129.2115 Trailing spaces remover in Db3_field2str } { Seek after truncate in Db3_open } { 920130.2145 Slack filespace bug removed } { Db3_sort implemented (based on shakersort)} { Bug in Db3_date2field removed } { 920716.2130 Empty file pack fixed in Db3_pack } { 920928.2200 Obscure bug in Db3_fieldname. Fieldnames } { seem to be are ASCIZ in stead of fixed } { length strings. } { 930927.2000 Freemem bug in db3_findnext corrected. } {---------------------------------------------------------} { To Do Full Documentation } { Write Memo Support } { Extend Db3_pack with MemoFile Packing } { Sort *.DBF in place } { Insert record in *.DBF file } { Date format not always yy-mm-dd } {---------------------------------------------------------} UNIT Db3_01; INTERFACE USES DOS; {---------------------------------------------------------} {----Error Handling : Returns First Error Which Occured } {---------------------------------------------------------} VAR db3_ernr : INTEGER; {----DB3 Module Error Code} db3_fatal : BOOLEAN; {----IF True THEN Halt(db3_ernr) on an error} db3_memotext : TEXT; {----Memo File} {---------------------------------------------------------} FUNCTION Db3_ermsg(nr : INTEGER) : STRING; {---------------------------------------------------------} {----Initialize/Exit : Must both be Called for every file } {---------------------------------------------------------} PROCEDURE Db3_open(fn : STRING); {----Opens fn.DBF file & Inits Internals} PROCEDURE Db3_close; {----Closes fn.DBF file} {---------------------------------------------------------} {----Header Function : Get .DBF header info } {---------------------------------------------------------} FUNCTION Db3_memo : BOOLEAN; FUNCTION Db3_update : STRING; FUNCTION Db3_norecs : LONGINT; FUNCTION Db3_nofields : INTEGER; FUNCTION Db3_reclen : INTEGER; {---------------------------------------------------------} {----File I/O : Dbase III Alike (pos etc. in records) } {---------------------------------------------------------} PROCEDURE Db3_seek(pos : LONGINT); FUNCTION Db3_filesize : LONGINT; FUNCTION Db3_filepos : LONGINT; PROCEDURE Db3_readnext; PROCEDURE Db3_read(pos : LONGINT); PROCEDURE Db3_seekeof; PROCEDURE Db3_seekbof; FUNCTION Db3_eof : BOOLEAN; FUNCTION Db3_bof : BOOLEAN; PROCEDURE Db3_replace(no : LONGINT); {----First Read record & Fill all fields} PROCEDURE Db3_append; {----First Fill all Fields} PROCEDURE Db3_delete(no : LONGINT); PROCEDURE Db3_undelete(no : LONGINT); PROCEDURE Db3_pack; {----Packs File IN-PLACE} PROCEDURE Db3_blankrec; {---------------------------------------------------------} {----Field Operations : no is .DBF field number } {---------------------------------------------------------} FUNCTION Db3_fieldname(no : INTEGER) : STRING; FUNCTION Db3_fieldlen(no : INTEGER) : INTEGER; FUNCTION Db3_fielddec(no : INTEGER) : INTEGER; FUNCTION Db3_fieldno(name : STRING) : INTEGER; {----Searches Fieldnumber for Uppercase fieldname} FUNCTION Db3_fieldtype(no : INTEGER) : CHAR; FUNCTION Db3_deleted : BOOLEAN; {---------------------------------------------------------} {----Field Conversions : date format 'dd-mm-19yy' } {---------------------------------------------------------} FUNCTION Db3_field2str(no :INTEGER) : STRING; FUNCTION Db3_field2char(no :INTEGER) : CHAR; FUNCTION Db3_field2logic(no : INTEGER) : BOOLEAN; FUNCTION Db3_field2num(no : INTEGER) : REAL; FUNCTION Db3_field2date(no :INTEGER) : STRING; PROCEDURE Db3_field2memo(no : INTEGER); FUNCTION Db3_field2soundex(no : INTEGER) : STRING; PROCEDURE Db3_str2field(no :INTEGER;s : STRING); PROCEDURE Db3_char2field(no :INTEGER;s : CHAR); PROCEDURE Db3_logic2field(no : INTEGER;l : BOOLEAN); PROCEDURE Db3_num2field(no : INTEGER;n : REAL); PROCEDURE Db3_date2field(no :INTEGER;d : STRING); {---------------------------------------------------------} {----Database Search, spaces are used as wildcards. } { Db3_blankrec can be used for creating a wildcard } { record. Then if Findfirst is true the use Findnext } { until Findnext becomes false. After each succesfull } { call the internal readbuffer will contain the } { matching record. Use casesense=true for a case } { sensitive search. } {---------------------------------------------------------} FUNCTION Db3_findfirst(cs : BOOLEAN) : BOOLEAN; FUNCTION Db3_findnext(cs : BOOLEAN) : BOOLEAN; {---------------------------------------------------------} {----Soundex Code Function (sound alike) } {---------------------------------------------------------} FUNCTION Db3_soundex(name : STRING) : STRING; FUNCTION Db3_firstsoundex(no : INTEGER; s : STRING) : BOOLEAN; FUNCTION Db3_nextsoundex(no : INTEGER; s : STRING) : BOOLEAN; {---------------------------------------------------------} {----Shaker Sort Almost Sorted *.DBF Files } {---------------------------------------------------------} PROCEDURE Db3_sort(no : INTEGER); IMPLEMENTATION {---------------------------------------------------------} {----Error Handling } {---------------------------------------------------------} PROCEDURE Seternr(e : INTEGER); BEGIN IF (db3_ernr=0) THEN db3_ernr:=e; IF db3_fatal THEN BEGIN Writeln; Writeln('Db3_01 [Error : ',db3_ernr:0,' = '+Db3_ermsg(db3_ernr)+']'); Writeln; IF (db3_ernr<>1) THEN Db3_close; Halt(e); END; END; {of Seternr} {---------------------------------------------------------} FUNCTION Db3_ermsg(nr : INTEGER) : STRING; BEGIN CASE nr OF 0 : Db3_ermsg:='No Error'; 1 : Db3_ermsg:='Error Opening File'; 2 : Db3_ermsg:='Seek Past EOF'; 3 : Db3_ermsg:='Seek Before BOF'; 4 : Db3_ermsg:='Read Past EOF'; 5 : Db3_ermsg:='Invalid Numeric Field'; 6 : Db3_ermsg:='Field Name NOT Found'; 7 : Db3_ermsg:='Invalid Header'; 8 : Db3_ermsg:='Incorrect Filesize'; 9 : Db3_ermsg:='Records to Large'; 10 : Db3_ermsg:='To many Fields'; 11 : Db3_ermsg:='Invalid Date Format'; 12 : Db3_ermsg:='Cannot Format Real'; 13 : Db3_ermsg:='Record was already deleted'; 14 : Db3_ermsg:='Record was not deleted'; 15 : Db3_ermsg:='NOT a Dbase III File'; 16 : Db3_ermsg:='Field Number NOT Found'; 17 : Db3_ermsg:='No Memofields in this file'; 18 : Db3_ermsg:='All matching records already found'; 19 : Db3_ermsg:='No *.DBF file open'; 20 : Db3_ermsg:='*.DBF already file open'; 99 : Db3_ermsg:='NOT Yet Implemented'; ELSE Db3_ermsg:='Unkown Error'; END; db3_ernr:=0; END; {of Db3_ermsg} {---------------------------------------------------------} {----Types/Vars & Constants } {---------------------------------------------------------} TYPE dbheader = RECORD dbvers : BYTE; dbupdy, dbupdm, dbupdd : BYTE; dbnorec: LONGINT; dbheadl, dbrecl : INTEGER; dbres : ARRAY[1..20] OF BYTE; END; dbfield = RECORD {----Definition of Field Header} dbname : ARRAY[1..11] OF CHAR; dbtype : CHAR; dbadr : LONGINT; dblen, dbdec : BYTE; dbres : ARRAY[1..14] OF CHAR; END; fptr = RECORD {----Definition of Readbuf Index} fppos : WORD; fplen : BYTE; END; CONST maxfield = 60; {----Max number of Fields} maxsize = 65000; {----Maximum Record Size} TYPE rectyp = ARRAY[0..maxsize] OF CHAR; {----Record Readbuffer Type} VAR f : file; {----.DBF File} header : dbheader; {----Space for Header} nofields : INTEGER; {----Number of Fields} fields : ARRAY[1..maxfield] OF dbfield; {----Field Definitions} fieldptr : ARRAY[1..maxfield] OF fptr; {----Index into Readbuffer} recstart : LONGINT; {----Start of Record Area} dbrec : ^rectyp; {----Record Buffer} reclen : WORD; {----Record Length} memo : FILE; {----Memo File} memopos : LONGINT; {----Location of Memo Record} memobuf : ARRAY[1..512] OF CHAR; {----Memo Text File buffer} dbsearch : ^rectyp; {----Search Record Buffer} {---------------------------------------------------------} {----Initialize } {---------------------------------------------------------} PROCEDURE Db3_open(fn : STRING); VAR i : INTEGER; j : WORD; ch : CHAR; BEGIN IF (dbrec<>NIL) THEN Seternr(20) ELSE BEGIN Assign(f,fn+'.DBF'); {$I-} Reset(f,1); {$I+} IF (Ioresult<>0) THEN Seternr(1) ELSE BEGIN {----Dump Header} Blockread(f,header,32); Getmem(dbrec,header.dbrecl+1); {---Scan for Fieldnames & Recordlength} reclen :=1; nofields:=0; Blockread(f,ch,1); WHILE (nofields<maxfield) AND (ch<>#13) DO BEGIN Inc(nofields); WITH fields[nofields] DO BEGIN dbname[1]:=ch; Blockread(f,dbname[2],Sizeof(dbfield)-1); Inc(reclen,dblen); Blockread(f,ch,1); END; END; IF (ch<>#13) THEN Seternr(10); {----Zapped file contains only a EOF} recstart:=Filepos(f); {----Set fieldptr} j:=1; FOR i:=1 TO nofields DO WITH fieldptr[i],fields[i] DO BEGIN fplen:=dblen; fppos:=j; Inc(j,dblen); END; {----Header Integrity Checks} IF NOT(header.dbvers IN [$03,$83]) THEN Seternr(15); IF ((header.dbheadl DIV 32)-1<>nofields) OR (header.dbrecl<>reclen) THEN Seternr(7); {----File Size Check} IF (header.dbnorec*reclen<>(Filesize(f)-recstart-1)) THEN BEGIN {----Truncate DBASE Slack Filespace} { Writeln('Truncating'); } Db3_Seek(header.dbnorec+1); {$I-} Seek(f,Filepos(f)+1); {$I+} IF (IOresult=0) THEN Truncate(f) ELSE Seternr(8); END; IF (reclen>Sizeof(rectyp)) THEN Seternr(9); IF Db3_memo THEN BEGIN Assign(memo,fn+'.DBT'); {$I-} Reset(memo,1); {$I+} IF (IOresult<>0) THEN Seternr(17); END; IF (db3_ernr<>0) THEN Freemem(dbrec,header.dbrecl+1); END; IF (db3_ernr<>0) THEN dbrec:=NIL ELSE Db3_Seekbof END; END; {of Db3_open} {---------------------------------------------------------} PROCEDURE Db3_close; VAR y,m,d,dow : WORD; BEGIN IF (dbrec<>NIL) THEN BEGIN {----Update *.DBF File Header} Getdate(y,m,d,dow); WITH header DO BEGIN dbupdy :=y MOD 100; dbupdm :=m; dbupdd :=d; dbnorec:=Db3_filesize; END; Reset(f,1); Blockwrite(f,header,32); Close(f); {----Cleanup Memory} Freemem(dbrec,header.dbrecl+1); IF dbsearch<>NIL THEN Freemem(dbsearch,header.dbrecl+1); dbrec :=NIL; dbsearch :=NIL; END ELSE Seternr(19); END; {of DB3_close} {---------------------------------------------------------} {----Header Operations } {---------------------------------------------------------} FUNCTION Db3_memo : BOOLEAN; BEGIN Db3_memo:=header.dbvers=$83; END; {of Db3_memo} {---------------------------------------------------------} FUNCTION Db3_update : STRING; VAR s : STRING; BEGIN s:='dd-mm-19yy'; s[ 1]:=Chr(Ord('0')+header.dbupdd DIV 10); s[ 2]:=Chr(Ord('0')+header.dbupdd MOD 10); s[ 4]:=Chr(Ord('0')+header.dbupdm DIV 10); s[ 5]:=Chr(Ord('0')+header.dbupdm MOD 10); s[ 9]:=Chr(Ord('0')+header.dbupdy DIV 10); s[10]:=Chr(Ord('0')+header.dbupdy MOD 10); Db3_update:=s; END; {of Db3_update} {---------------------------------------------------------} FUNCTION Db3_norecs : LONGINT; BEGIN Db3_norecs:=header.dbnorec; END; {of Db3_norecs} {---------------------------------------------------------} FUNCTION Db3_nofields : INTEGER; BEGIN Db3_nofields:=nofields; END; {of Db3_nofields} {---------------------------------------------------------} FUNCTION Db3_reclen : INTEGER; BEGIN Db3_reclen:=reclen; END; {of Db3_reclen} {---------------------------------------------------------} {----File I/O } {---------------------------------------------------------} PROCEDURE Db3_seek(pos : LONGINT); BEGIN {$I-} Seek(f,recstart+(pos-1)*reclen); {$I+} IF (Ioresult<>0) OR (pos<1) OR (pos>Db3_filesize+1) THEN BEGIN IF (pos>0) THEN Seternr(2) ELSE Seternr(3); END; END; {of Db3_seek} {---------------------------------------------------------} FUNCTION Db3_filesize : LONGINT; BEGIN Db3_filesize:=(Filesize(f)-recstart) DIV reclen; END; {of Db3_filesize} {---------------------------------------------------------} FUNCTION Db3_filepos : LONGINT; BEGIN Db3_filepos:=((Filepos(f)-recstart) DIV reclen)+1; END; {of Db3_filepos} {---------------------------------------------------------} PROCEDURE Db3_readnext; BEGIN IF EOF(f) OR Db3_Eof THEN Seternr(4) ELSE Blockread(f,dbrec^,reclen); END; {of Db3_readnext} {---------------------------------------------------------} PROCEDURE Db3_read(pos : LONGINT); BEGIN Db3_seek(pos); Db3_readnext; END; {of Db3_read} {---------------------------------------------------------} PROCEDURE Db3_seekeof; BEGIN Db3_Seek(Db3_filesize+1); END; {of Db3_seekeof} {---------------------------------------------------------} PROCEDURE Db3_seekbof; BEGIN Seek(f,recstart); END; {of Db3_seekeof} {---------------------------------------------------------} FUNCTION Db3_eof : BOOLEAN; BEGIN Db3_eof:=(Filepos(f)>=Filesize(f)-1); END; {of Db3_eof} {---------------------------------------------------------} FUNCTION Db3_bof : BOOLEAN; BEGIN Db3_bof:=Filepos(f)=recstart; END; {of Db3_bof} {---------------------------------------------------------} PROCEDURE Db3_replace(no : LONGINT); BEGIN Db3_seek(no); IF (db3_ernr=0) THEN Blockwrite(f,dbrec^[0],reclen) END; {of Db3_append} {---------------------------------------------------------} PROCEDURE Db3_append; VAR ch : CHAR; BEGIN Db3_seek(Db3_filesize+1); Blockwrite(f,dbrec^[0],reclen); ch:=^Z; Blockwrite(f,ch,1); Db3_seek(Db3_filesize+1); END; {of Db3_append} {---------------------------------------------------------} PROCEDURE Db3_delete(no : LONGINT); BEGIN Db3_read(no); IF dbrec^[0]='*' THEN Seternr(13) ELSE dbrec^[0]:='*'; Db3_replace(no) END; {of Db3_delete} {---------------------------------------------------------} PROCEDURE Db3_undelete(no : LONGINT); BEGIN Db3_read(no); IF dbrec^[0]=' ' THEN Seternr(14) ELSE dbrec^[0]:=' '; Db3_replace(no) END; {of Db3_undelete} {---------------------------------------------------------} PROCEDURE Db3_pack; VAR i,j : LONGINT; ch : CHAR; BEGIN j:=0; FOR i:=1 TO Db3_filesize DO BEGIN Db3_read(i); IF NOT(Db3_deleted) THEN BEGIN Inc(j); Db3_replace(j) END END; {----New EOF Marker} IF (j=0) THEN db3_SeekBof ELSE Db3_read(j); ch:=^Z; Blockwrite(f,ch,1); Truncate(f); Db3_seek(1); END; {of Db3_pack} {---------------------------------------------------------} PROCEDURE Db3_blankrec; VAR i : INTEGER; BEGIN FOR i:=0 TO reclen-1 DO dbrec^[i]:=#32; END; {of Db3_blankrec} {---------------------------------------------------------} {----Field Operations } {---------------------------------------------------------} FUNCTION Db3_fieldname(no : INTEGER) : STRING; VAR s : STRING; i : WORD; BEGIN s:=''; i:=1; IF no IN [1..nofields] THEN BEGIN WITH fields[no] DO WHILE (i<=Sizeof(dbname)) AND (dbname[i]<>#0) DO BEGIN s:=s+dbname[i]; Inc(i); END; END ELSE Seternr(16); Db3_fieldname:=s; END; {of Db3_fieldname} {---------------------------------------------------------} FUNCTION Db3_fieldlen(no : INTEGER) : INTEGER; BEGIN Db3_fieldlen:=0; IF no IN [1..nofields] THEN Db3_fieldlen:=fields[no].dblen ELSE Seternr(16); END; {of Db3_fieldlen} {---------------------------------------------------------} FUNCTION Db3_fielddec(no : INTEGER) : INTEGER; BEGIN Db3_fielddec:=0; IF no IN [1..nofields] THEN Db3_fielddec:=fields[no].dbdec ELSE Seternr(16) END; {of Db3_fielddec} {---------------------------------------------------------} FUNCTION Db3_fieldno(name : STRING) : INTEGER; VAR i,j : INTEGER; s : STRING; BEGIN Db3_fieldno:=0; s:=name; FOR i:=1 TO Length(s) DO s[i]:=Upcase(s[i]); i:=1; WHILE (i<=nofields) AND (s<>Db3_fieldname(i)) DO Inc(i); IF (i>nofields) THEN Seternr(6) ELSE Db3_fieldno:=i; END; {of Db3_fieldno} {---------------------------------------------------------} FUNCTION Db3_fieldtype(no : INTEGER) : CHAR; BEGIN Db3_fieldtype:=#00; IF no IN [1..nofields] THEN Db3_fieldtype:=fields[no].dbtype ELSE Seternr(16); END; {of Db3_fieldtype} {---------------------------------------------------------} FUNCTION Db3_deleted : BOOLEAN; BEGIN Db3_deleted:=dbrec^[0]<>#32; END; {of Db3_deleted} {---------------------------------------------------------} {----Field Conversions } {---------------------------------------------------------} FUNCTION Db3_field2str(no :INTEGER) : STRING; VAR s : STRING; i : WORD; BEGIN s:=''; IF (no IN [1..nofields]) THEN BEGIN s[0]:=Chr(fieldptr[no].fplen); Move(dbrec^[fieldptr[no].fppos],s[1],fieldptr[no].fplen); END ELSE Seternr(16); {----Strip Trailing Spaces} WHILE (Length(s)>0) AND (s[Length(s)]=#32) DO Dec(s[0]); Db3_field2str:=s; END; {of Db3_field2str} {---------------------------------------------------------} FUNCTION Db3_field2char(no :INTEGER) : CHAR; VAR s : STRING; BEGIN IF (Db3_fieldlen(no)=1) THEN s:=Db3_field2str(no) ELSE s:=#00; IF (Length(s)=0) THEN Db3_field2char:=#32 ELSE Db3_field2char:=s[1]; END; {of Db3_field2char} {---------------------------------------------------------} FUNCTION Db3_field2logic(no : INTEGER) : BOOLEAN; BEGIN Db3_field2logic:=(Db3_field2char(no)='T'); END; {of Db3_field2logic} {---------------------------------------------------------} FUNCTION Db3_field2num(no : INTEGER) : REAL; VAR r : REAL; s : STRING; e : INTEGER; BEGIN s:=Db3_field2str(no); WHILE (Length(s)>0) AND (s[1]=#32) DO Delete(s,1,1); Val(s,r,e); IF (e<>0) THEN Seternr(5); Db3_field2num:=r; END; {of Db3_field2num} {---------------------------------------------------------} FUNCTION Db3_field2date(no :INTEGER) : STRING; VAR s : STRING; BEGIN s:='dd-mm-yyyy'; IF (no IN [1..nofields]) THEN BEGIN Move(dbrec^[fieldptr[no].fppos+6],s[1],2); Move(dbrec^[fieldptr[no].fppos+4],s[4],2); Move(dbrec^[fieldptr[no].fppos+0],s[7],4); END ELSE Seternr(16); Db3_field2date:=s; END; {of Db3_field2date} {---------------------------------------------------------} FUNCTION Db3_field2soundex(no : INTEGER) : STRING; BEGIN Db3_field2soundex:=Db3_soundex(Db3_field2str(no)); END; {of Db3_field2soundex} {---------------------------------------------------------} PROCEDURE Db3_str2field(no :INTEGER;s : STRING); BEGIN IF (no IN [1..nofields]) THEN BEGIN Fillchar(dbrec^[fieldptr[no].fppos],fieldptr[no].fplen,#32); WITH fields[no] DO IF (Length(s)>dblen) THEN Move(s[1],dbrec^[fieldptr[no].fppos],dblen) ELSE Move(s[1],dbrec^[fieldptr[no].fppos],Length(s)); END ELSE Seternr(16) END; {of Db3_str2field} {---------------------------------------------------------} PROCEDURE Db3_char2field(no :INTEGER;s : CHAR); BEGIN Db3_str2field(no,s); END; {of Db3_char2field} {---------------------------------------------------------} PROCEDURE Db3_logic2field(no : INTEGER;l : BOOLEAN); BEGIN IF l THEN Db3_char2field(no,'T') ELSE Db3_char2field(no,'F') END; {of Db3_logic2field} {---------------------------------------------------------} PROCEDURE Db3_num2field(no : INTEGER;n: REAL); VAR s : STRING; BEGIN IF (no IN [1..nofields]) THEN BEGIN Str(n:fields[no].dblen:fields[no].dbdec,s); IF (Length(s)>fields[no].dblen) THEN Seternr(12) ELSE Db3_str2field(no,s); END ELSE Seternr(16) END; {of Db3_num2field} {---------------------------------------------------------} PROCEDURE Db3_date2field(no :INTEGER;d : STRING); VAR s : STRING; BEGIN IF (Length(d)<>10) OR (d[3]<>'-') OR (d[6]<>'-') THEN Seternr(11) ELSE BEGIN {----dd-mm-yyyy} s[1]:=d[ 7]; s[2]:=d[ 8]; s[3]:=d[ 9]; s[4]:=d[10]; s[5]:=d[ 4]; s[6]:=d[ 5]; s[7]:=d[ 1]; s[8]:=d[ 2]; Db3_str2field(no,s); END; END; {of Db3_date2field} {---------------------------------------------------------} {----Memo text field support } {---------------------------------------------------------} {$F+} FUNCTION memoignore(VAR f : textrec) : INTEGER; BEGIN memoignore:=0; END; {of memoignore} {---------------------------------------------------------} FUNCTION memoinput(VAR f : textrec) : INTEGER; VAR chread : WORD; BEGIN WITH Textrec(f) DO BEGIN Blockread(memo,memobuf[1],Sizeof(memobuf),chread); bufpos :=0; bufend :=chread; END; memoinput:=0; END; {of memoinput} {$F-} {---------------------------------------------------------} PROCEDURE Assignmemo(VAR f : TEXT); VAR chread : WORD; CONST fminput =$D7B1; BEGIN WITH Textrec(f) DO BEGIN handle :=$ffff; mode :=fminput; bufsize :=SIZEOF(memobuf); bufpos :=0; bufptr :=@memobuf; Blockread(memo,memobuf[1],Sizeof(memobuf),chread); bufpos :=0; bufend :=chread; openfunc :=@memoignore; inoutfunc:=@memoinput; flushfunc:=@memoignore; closefunc:=@memoignore; name[0] :=#00; END; END; {of Assignmemo} {---------------------------------------------------------} PROCEDURE Db3_field2memo(no : INTEGER); VAR e : INTEGER; s : STRING; BEGIN IF Db3_memo THEN BEGIN s:=Db3_field2str(no); WHILE (Length(s)>0) AND (s[1]=#32) DO Delete(s,1,1); Val(s,memopos,e); IF (e<>0) THEN Seternr(5) ELSE BEGIN Seek(memo,memopos*Sizeof(memobuf)); Assignmemo(db3_memotext); END; END ELSE Seternr(17); END; {of Db3_field2memo} {---------------------------------------------------------} FUNCTION Db3_findfirst(cs : BOOLEAN) : BOOLEAN; VAR match, found : BOOLEAN; i : INTEGER; BEGIN Getmem(dbsearch,Db3_reclen+1); Move(dbrec^,dbsearch^,Db3_reclen); Db3_Seekbof; found:=False; WHILE NOT(found OR Db3_eof OR (Db3_ernr<>0)) DO BEGIN Db3_readnext; i:=0; match:=true; WHILE (i<Db3_reclen) AND match DO BEGIN IF (dbsearch^[i]<>#32) THEN CASE cs OF TRUE : match:=( dbsearch^[i] = dbrec^[i]); FALSE : match:=(Upcase(dbsearch^[i])=Upcase(dbrec^[i])); END; INC(i); END; found:=match; END; Db3_findfirst:=found; IF (found=False) THEN BEGIN Freemem(dbsearch,Db3_reclen+1); dbsearch:=NIL; END; END; {of Db3_findfirst} {---------------------------------------------------------} FUNCTION Db3_findnext(cs : BOOLEAN) : BOOLEAN; VAR match, found : BOOLEAN; i : INTEGER; BEGIN IF (dbsearch=NIL) THEN Seternr(18); found:=False; WHILE NOT(found OR Db3_eof OR (Db3_ernr<>0)) DO BEGIN Db3_readnext; i:=0; match:=true; WHILE (i<Db3_reclen) AND match DO BEGIN IF (dbsearch^[i]<>#32) THEN CASE cs OF TRUE : match:=( dbsearch^[i] = dbrec^[i]); FALSE : match:=(Upcase(dbsearch^[i])=Upcase(dbrec^[i])); END; INC(i); END; found:=match; END; Db3_findnext:=found; If (found=False) AND (dbsearch<>NIL) Then BEGIN Freemem(dbsearch,Db3_reclen+1); dbsearch:=NIL; END; END; {of Db3_findnext} {---------------------------------------------------------} FUNCTION Db3_soundex(name : STRING) : STRING; VAR work : STRING; code : CHAR; i,j : INTEGER; {---------------------------------------------------------} FUNCTION Encode(VAR c: CHAR): CHAR; BEGIN CASE Upcase(c) OF 'B','F','P','V': encode:='1'; 'C','G','J','K','Q','S','X','Z': encode:='2'; 'D','T': encode:='3'; 'L': encode:='4'; 'M','N': encode:='5'; 'R': encode:='6'; 'A','E','I','O','U','Y': encode:='7'; 'H','W': encode:='8'; ELSE encode:=' '; END; END; {of Encode} {---------------------------------------------------------} BEGIN {----If we can't calculate, this is the answer} work:=''; {----Skip all non alpha codes in front} i:=1; WHILE (i<=Length(name)) AND (Encode(name[i])=' ') DO Inc(i); {----If any alpha characters left, start calculating the SOUNDEX code} IF (i<=Length(name)) THEN BEGIN {----The first alpha letter of string is the first letter of the code} work:=Upcase(name[i]); Inc(i); {----Be sure while loop precondition is correct} j:=1; code:=#00; {----Calculate the numeric part of the code, } { with a maximum of 3 digits, stop if a non } { alpha character is encountered } WHILE (i<=Length(name)) AND (j<=3) AND (code<>' ') DO BEGIN code:=Encode(name[i]); {----If new code group then add the goup number} IF (code IN ['1'..'6']) AND (work[j]<>code) THEN BEGIN Inc(j); work:=work+code; END; Inc(i); END; END; {----Return the resulting SOUNDEX code} Db3_soundex:=work; END; {of Db3_soundex} {---------------------------------------------------------} FUNCTION Db3_firstsoundex(no : INTEGER;s : STRING) : BOOLEAN; VAR found : BOOLEAN; sdx : STRING; BEGIN Db3_Seekbof; sdx:=Db3_soundex(s); found:=False; WHILE NOT(found OR Db3_eof OR (Db3_ernr<>0)) DO BEGIN Db3_readnext; found:=(Pos(sdx,Db3_field2soundex(no))=1); END; Db3_firstsoundex:=found; END; {of Db3_firstsoundex} {---------------------------------------------------------} FUNCTION Db3_nextsoundex(no : INTEGER; s : STRING) : BOOLEAN; VAR found : BOOLEAN; sdx : STRING; BEGIN sdx:=Db3_soundex(s); found:=False; WHILE NOT(found OR Db3_eof OR (Db3_ernr<>0)) DO BEGIN Db3_readnext; found:=(Pos(sdx,Db3_field2soundex(no))=1); END; Db3_nextsoundex:=found; END; {of Db3_nextsoundex} {---------------------------------------------------------} PROCEDURE Db3_sort(no : INTEGER); VAR dbsort : ^rectyp; swapped : BOOLEAN; i,j,l,r : LONGINT; s1,s2 : STRING; typ : CHAR; {---------------------------------------------------------} PROCEDURE Swap(r1,r2 : LONGINT); BEGIN {----Side Effects} i:=j; swapped:=True; {----the Swapping itself} Db3_replace(r1); Move(dbsort^,dbrec^,Db3_reclen); Db3_replace(r2); END; {of Swapped} {---------------------------------------------------------} FUNCTION Compare(VAR c1,c2 : STRING) : BOOLEAN; VAR i : INTEGER; s : STRING; BEGIN CASE typ OF 'M', 'N' : BEGIN {----Insert spaces for correct numeric compare} FOR i:=1 TO Db3_fieldlen(no)-Length(c1) DO Insert(#32,c1,i); FOR i:=1 TO Db3_fieldlen(no)-Length(c2) DO Insert(#32,c2,i); END; 'L', 'S', 'C' : BEGIN {----Convert to Uppercase for correct alpha compare} FOR i:=1 TO Length(c1) Do c1[i]:=Upcase(c1[i]); FOR i:=1 TO Length(c2) Do c2[i]:=Upcase(c2[i]); END; 'D' : ; END; {----Return TRUE if c2>c1} Compare:=(c2>c1); END; {of Compare} {---------------------------------------------------------} BEGIN {----Use ShakerSort on almost sorted *.DBF file} Getmem(dbsort,Db3_reclen+1); Move(dbrec^,dbsort^,Db3_reclen); l:=2; r:=Db3_filesize; i:=r-1; swapped:=TRUE; typ :=Db3_fieldtype(no); WHILE (l<=r) AND swapped DO BEGIN swapped:=False; {----Bubble Up} FOR j:=r DOWNTO l DO BEGIN {----Fetch record j-1 & save it} Db3_read(j-1); s2:=Db3_field2str(no); Move(dbrec^,dbsort^,Db3_reclen); {----Fetch record j} Db3_read(j); s1:=Db3_field2str(no); {----Bubble} IF Compare(s1,s2) THEN Swap(j-1,j); END; l:=i+1; {----Bubble Down} IF swapped THEN BEGIN FOR j:=l TO r DO BEGIN {----Fetch record j-1 & save it} Db3_read(j-1); s2:=Db3_field2str(no); Move(dbrec^,dbsort^,Db3_reclen); {----Fetch record j} Db3_read(j); s1:=Db3_field2str(no); {----Bubble} IF Compare(s1,s2) THEN Swap(j-1,j); END; r:=i-1; END; END; Freemem(dbsort,Db3_reclen+1); Db3_seekbof; END; {of Db3_sort} {---------------------------------------------------------} BEGIN db3_ernr :=0; db3_fatal:=False; dbsearch :=NIL; dbrec :=NIL; END. { DOCUMENTATION } Written by Ir. G.W. van der Vegt Hondbroek 57 6121 XB Born (L) and uploaded as public domain software because the author likes to share it with other Turbo Pascal Users. Please keep the source the way it is and write extentions as separate units. This unit provides read/write access to Dbase III (Plus) *.DBF files. The unit is uploaded as it is, the author is not responsible for any damgage by programs using this module. The unit is, of course, tested. Before using any of the Db3 routine a program shall call Db3_open to initialize the file internal buffers & info. When finishing the program should call Db3_close to close the file & cleanup the internal buffer. All routines are documented so there's not much to say about them. Access to the DBF file is only allowed through this unit, so the file record isn't exported. Records must be read by Db3_read or Db3_readnext, and written by Db3_append or Db3_replace. All record functions use LONGINTs as parameter for addressing records in the file. When a record is read, one can read the field in the record by using the record number as parameter of the Db3_field2 procedures. This record number lies between 1 and maxfield. If one 's to be independend of the location of the record the Db3_fieldno can be used to convert a field name to the field number. When writing records fill all field with Db3_2field routines and don't forget to use Db3_undelete to initialize the deleted marker. It's of course also possible to read a record, modify some field and replace it. The Db3_pack routine packs the file in-place, so no temp file is created. This unit can't create DBase III *.DBF files as it can't write the file header & fieldefinitions. It's also impossble to change the structure of a DBase III *.DBF database with it. This is done to keep the unit simple. Creating & modifing databases is much easier in Dbase III Language. This unit uses a special naming convention to be sure there's no confict with procedures from other units. All exported names have a three letter prefix Db3_. The 01 in the Unit name is a unique version number. -- PHP Database Mailing List (http://www.php.net/) To unsubscribe, visit: http://www.php.net/unsub.php
