[tdbf-cvs] tdbf dbf.pas,NONE,1.1 dbf_avl.pas,NONE,1.1 dbf_common.inc,NONE,1.1 dbf_common.pas,NONE,1.

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/tdbf/tdbf
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29302

Modified Files:
	history.txt 
Added Files:
	dbf.pas dbf_avl.pas dbf_common.inc dbf_common.pas 
	dbf_cursor.pas dbf_dbffile.pas dbf_fields.pas dbf_idxcur.pas 
	dbf_idxfile.pas dbf_lang.pas dbf_memo.pas dbf_parser.pas 
	dbf_pgcfile.pas dbf_pgfile.pas dbf_prscore.pas dbf_prsdef.pas 
	dbf_prssupp.pas dbf_reg.pas dbf_str.inc dbf_str.pas 
	dbf_str_es.pas dbf_str_fr.pas dbf_str_ita.pas dbf_str_nl.pas 
	dbf_str_pl.pas dbf_str_pt.pas dbf_str_ru.pas dbf_struct.inc 
	dbf_wtil.pas 
Removed Files:
	Dbf.pas Dbf_Avl.pas Dbf_Common.inc Dbf_Common.pas 
	Dbf_Cursor.pas Dbf_DbfFile.pas Dbf_Fields.pas Dbf_IdxCur.pas 
	Dbf_IdxFile.pas Dbf_Lang.pas Dbf_Memo.pas Dbf_Parser.pas 
	Dbf_PgFile.pas Dbf_PgcFile.pas Dbf_PrsCore.pas Dbf_PrsDef.pas 
	Dbf_PrsSupp.pas Dbf_Str.pas Dbf_Str_ES.pas Dbf_Str_FR.pas 
	Dbf_Str_ITA.pas Dbf_Str_NL.pas Dbf_Str_PL.pas Dbf_Str_PT.pas 
	Dbf_Str_RU.pas Dbf_Struct.inc Dbf_Wtil.pas 
Log Message:
chngd: made all filenames lowercase to ease usage on *nix

--- NEW FILE: dbf_str.inc ---
var
  STRING_FILE_NOT_FOUND: string;
  STRING_VERSION: string;

  STRING_RECORD_LOCKED: string;
  STRING_WRITE_ERROR: string;
  STRING_WRITE_INDEX_ERROR: string;
  STRING_KEY_VIOLATION: string;

  STRING_INVALID_DBF_FILE: string;
  STRING_FIELD_TOO_LONG: string;
  STRING_INVALID_FIELD_COUNT: string;
  STRING_INVALID_FIELD_TYPE: string;
  STRING_INVALID_VCL_FIELD_TYPE: string;

  STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string;
  STRING_INDEX_BASED_ON_INVALID_FIELD: string;
  STRING_INDEX_EXPRESSION_TOO_LONG: string;
  STRING_INVALID_INDEX_TYPE: string;
  STRING_CANNOT_OPEN_INDEX: string;
  STRING_TOO_MANY_INDEXES: string;
  STRING_INDEX_NOT_EXIST: string;
  STRING_NEED_EXCLUSIVE_ACCESS: string;

--- Dbf_DbfFile.pas DELETED ---

--- Dbf_Str_PL.pas DELETED ---

--- NEW FILE: dbf_str_ru.pas ---
unit Dbf_Str_RU;

{fix CR/LF}

// file is encoded in Windows-1251 encoding
// for using with Linux/Kylix must be re-coded to KOI8-R
// for use with DOS & OS/2 (if it will be possible with FreePascal or VirtualPascal)
//    file should be recoded to cp866

interface

{$I Dbf_Common.inc}
{$I Dbf_Str.inc}

implementation

initialization

  STRING_FILE_NOT_FOUND               := 'Ôàéë "%s" íå ñóùåñòâóåò. Îòêðûòü íåâîçìîæíî.';
  STRING_VERSION                      := 'TDbf V%d.%d';

  STRING_RECORD_LOCKED                := 'Çàïèñü (ñòðîêà òàáëèöû) çàáëîêèðîâàíà.';
  STRING_WRITE_ERROR                  := 'Îøèáêà çàïèñè íà äèñê (Äèñê çàïîëíåí?)';
  STRING_KEY_VIOLATION                := 'Êëþ÷åâîå çíà÷åíèå íå äîëæíî ïîâòîðÿòüñÿ!.'+#13+#10+
                                         'Èíäåêñ: %s'+#13+#10+'Çàïèñü (ñòðîêà)=%d  Êëþ÷="%s".';

  STRING_INVALID_DBF_FILE             := 'Ôàéë DBF ïîâðåæäåí èëè åãî ñòðóêòóðà íå DBF.';
  STRING_FIELD_TOO_LONG               := 'Äëèíà çíà÷åíèÿ - %d ñèìâîëîâ, ýòî áîëüøå ìàêñèìóìà - %d.';
  STRING_INVALID_FIELD_COUNT          := 'Êîëè÷åñòâî ïîëåé â òàáëèöå (%d) íåâîçìîæíî. Äîïóñòèìî îò 1 äî 4095.';
  STRING_INVALID_FIELD_TYPE           := 'Òèï çíà÷åíèÿ "%s", çàòðåáîâàííûé ïîëåì "%s" íåâîçìîæåí.';
  STRING_INVALID_VCL_FIELD_TYPE       := 'Íåâîçìîæíî ñîçäàòü ïîëå "%s", Òèï äàííûõ VCL[%x] íå ìîæåò áûòü çàïèñàí â DBF.';

  STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Èíäåêñ ññûëàåòñÿ íà íåñóùåñòâóþùåå ïîëå "%s".';
  STRING_INDEX_BASED_ON_INVALID_FIELD := 'Ïîëå "%s" íå ìîæåò áûòü èíäåêñèðîâàííî. Èíäåêñû íå ïîääåðæèâàþò òàêîé òèï ïîëÿ.';
  STRING_INDEX_EXPRESSION_TOO_LONG    := '%s: Ñëèøêîì äëèííîå çíà÷åíèå äëÿ èíäåêñà (%d). Äîëæíî áûòü íå áîëüøå 100 ñèìâîëîâ.';
  STRING_INVALID_INDEX_TYPE           := 'Íåâîçìîæíûé òèï èíäåêñà: èíäåêñàöèÿ âîçìîæíî òîëüêî ïî ÷èñëó èëè ñòðîêå';
  STRING_CANNOT_OPEN_INDEX            := 'Íåâîçìîæíî îòêðûòü èíäåêñ "%s".';
  STRING_TOO_MANY_INDEXES             := 'Íåâîçìîæíî ñîçäàòü åùå îäèí èíäåêñ. Ôàéë ïîëîí.';
  STRING_INDEX_NOT_EXIST              := 'Èíäåêñ "%s" íå ñóùåñòâóåò.';
  STRING_NEED_EXCLUSIVE_ACCESS        := 'Íåâîçìîæíî âûïîëíèòü - ñíà÷àëà íóæíî ïîëó÷èòü ìîíîïîëüíûé äîñòóï.';
end.

--- Dbf_Avl.pas DELETED ---

--- Dbf_PrsDef.pas DELETED ---

--- NEW FILE: dbf_wtil.pas ---
unit Dbf_Wtil;

{$i Dbf_Common.inc}

interface

{$ifndef WIN32}
uses
{$ifdef FPC}
  BaseUnix,
{$else}
  Libc, 
{$endif}
  Types, SysUtils, Classes;

const
  LCID_INSTALLED = $00000001;  { installed locale ids }
  LCID_SUPPORTED = $00000002;  { supported locale ids }
  CP_INSTALLED   = $00000001;  { installed code page ids }
  CP_SUPPORTED   = $00000002;  { supported code page ids }
(*
 *  Language IDs.
 *
 *  The following two combinations of primary language ID and
 *  sublanguage ID have special semantics:
 *
 *    Primary Language ID   Sublanguage ID      Result
 *    -------------------   ---------------     ------------------------
 *    LANG_NEUTRAL          SUBLANG_NEUTRAL     Language neutral
 *    LANG_NEUTRAL          SUBLANG_DEFAULT     User default language
 *    LANG_NEUTRAL          SUBLANG_SYS_DEFAULT System default language
 *)
{ Primary language IDs. }
  LANG_NEUTRAL                         = $00;
  LANG_AFRIKAANS                       = $36;
  LANG_ALBANIAN                        = $1c;
  LANG_ARABIC                          = $01;
  LANG_BASQUE                          = $2d;
  LANG_BELARUSIAN                      = $23;
  LANG_BULGARIAN                       = $02;
  LANG_CATALAN                         = $03;
  LANG_CHINESE                         = $04;
  LANG_CROATIAN                        = $1a;
  LANG_CZECH                           = $05;
  LANG_DANISH                          = $06;
  LANG_DUTCH                           = $13;
  LANG_ENGLISH                         = $09;
  LANG_ESTONIAN                        = $25;
  LANG_FAEROESE                        = $38;
  LANG_FARSI                           = $29;
  LANG_FINNISH                         = $0b;
  LANG_FRENCH                          = $0c;
  LANG_GERMAN                          = $07;
  LANG_GREEK                           = $08;
  LANG_HEBREW                          = $0d;
  LANG_HUNGARIAN                       = $0e;
  LANG_ICELANDIC                       = $0f;
  LANG_INDONESIAN                      = $21;
  LANG_ITALIAN                         = $10;
  LANG_JAPANESE                        = $11;
  LANG_KOREAN                          = $12;
  LANG_LATVIAN                         = $26;
  LANG_LITHUANIAN                      = $27;
  LANG_NORWEGIAN                       = $14;
  LANG_POLISH                          = $15;
  LANG_PORTUGUESE                      = $16;
  LANG_ROMANIAN                        = $18;
  LANG_RUSSIAN                         = $19;
  LANG_SERBIAN                         = $1a;
  LANG_SLOVAK                          = $1b;
  LANG_SLOVENIAN                       = $24;
  LANG_SPANISH                         = $0a;
  LANG_SWEDISH                         = $1d;
  LANG_THAI                            = $1e;
  LANG_TURKISH                         = $1f;
  LANG_UKRAINIAN                       = $22;
  LANG_VIETNAMESE                      = $2a;
{ Sublanguage IDs. }
  { The name immediately following SUBLANG_ dictates which primary
    language ID that sublanguage ID can be combined with to form a
    valid language ID.
  }
  SUBLANG_NEUTRAL                      = $00;    { language neutral }
  SUBLANG_DEFAULT                      = $01;    { user default }
  SUBLANG_SYS_DEFAULT                  = $02;    { system default }
  SUBLANG_ARABIC_SAUDI_ARABIA          = $01;    { Arabic (Saudi Arabia) }
  SUBLANG_ARABIC_IRAQ                  = $02;    { Arabic (Iraq) }
  SUBLANG_ARABIC_EGYPT                 = $03;    { Arabic (Egypt) }
  SUBLANG_ARABIC_LIBYA                 = $04;    { Arabic (Libya) }
  SUBLANG_ARABIC_ALGERIA               = $05;    { Arabic (Algeria) }
  SUBLANG_ARABIC_MOROCCO               = $06;    { Arabic (Morocco) }
  SUBLANG_ARABIC_TUNISIA               = $07;    { Arabic (Tunisia) }
  SUBLANG_ARABIC_OMAN                  = $08;    { Arabic (Oman) }
  SUBLANG_ARABIC_YEMEN                 = $09;    { Arabic (Yemen) }
  SUBLANG_ARABIC_SYRIA                 = $0a;    { Arabic (Syria) }
  SUBLANG_ARABIC_JORDAN                = $0b;    { Arabic (Jordan) }
  SUBLANG_ARABIC_LEBANON               = $0c;    { Arabic (Lebanon) }
  SUBLANG_ARABIC_KUWAIT                = $0d;    { Arabic (Kuwait) }
  SUBLANG_ARABIC_UAE                   = $0e;    { Arabic (U.A.E) }
  SUBLANG_ARABIC_BAHRAIN               = $0f;    { Arabic (Bahrain) }
  SUBLANG_ARABIC_QATAR                 = $10;    { Arabic (Qatar) }
  SUBLANG_CHINESE_TRADITIONAL          = $01;    { Chinese (Taiwan) }
  SUBLANG_CHINESE_SIMPLIFIED           = $02;    { Chinese (PR China) }
  SUBLANG_CHINESE_HONGKONG             = $03;    { Chinese (Hong Kong) }
  SUBLANG_CHINESE_SINGAPORE            = $04;    { Chinese (Singapore) }
  SUBLANG_DUTCH                        = $01;    { Dutch }
  SUBLANG_DUTCH_BELGIAN                = $02;    { Dutch (Belgian) }
  SUBLANG_ENGLISH_US                   = $01;    { English (USA) }
  SUBLANG_ENGLISH_UK                   = $02;    { English (UK) }
  SUBLANG_ENGLISH_AUS                  = $03;    { English (Australian) }
  SUBLANG_ENGLISH_CAN                  = $04;    { English (Canadian) }
  SUBLANG_ENGLISH_NZ                   = $05;    { English (New Zealand) }
  SUBLANG_ENGLISH_EIRE                 = $06;    { English (Irish) }
  SUBLANG_ENGLISH_SOUTH_AFRICA         = $07;    { English (South Africa) }
  SUBLANG_ENGLISH_JAMAICA              = $08;    { English (Jamaica) }
  SUBLANG_ENGLISH_CARIBBEAN            = $09;    { English (Caribbean) }
  SUBLANG_ENGLISH_BELIZE               = $0a;    { English (Belize) }
  SUBLANG_ENGLISH_TRINIDAD             = $0b;    { English (Trinidad) }
  SUBLANG_FRENCH                       = $01;    { French }
  SUBLANG_FRENCH_BELGIAN               = $02;    { French (Belgian) }
  SUBLANG_FRENCH_CANADIAN              = $03;    { French (Canadian) }
  SUBLANG_FRENCH_SWISS                 = $04;    { French (Swiss) }
  SUBLANG_FRENCH_LUXEMBOURG            = $05;    { French (Luxembourg) }
  SUBLANG_GERMAN                       = $01;    { German }
  SUBLANG_GERMAN_SWISS                 = $02;    { German (Swiss) }
  SUBLANG_GERMAN_AUSTRIAN              = $03;    { German (Austrian) }
  SUBLANG_GERMAN_LUXEMBOURG            = $04;    { German (Luxembourg) }
  SUBLANG_GERMAN_LIECHTENSTEIN         = $05;    { German (Liechtenstein) }
  SUBLANG_ITALIAN                      = $01;    { Italian }
  SUBLANG_ITALIAN_SWISS                = $02;    { Italian (Swiss) }
  SUBLANG_KOREAN                       = $01;    { Korean (Extended Wansung) }
  SUBLANG_KOREAN_JOHAB                 = $02;    { Korean (Johab) }
  SUBLANG_NORWEGIAN_BOKMAL             = $01;    { Norwegian (Bokmal) }
  SUBLANG_NORWEGIAN_NYNORSK            = $02;    { Norwegian (Nynorsk) }
  SUBLANG_PORTUGUESE                   = $02;    { Portuguese }
  SUBLANG_PORTUGUESE_BRAZILIAN         = $01;    { Portuguese (Brazilian) }
  SUBLANG_SERBIAN_LATIN                = $02;    { Serbian (Latin) }
  SUBLANG_SERBIAN_CYRILLIC             = $03;    { Serbian (Cyrillic) }
  SUBLANG_SPANISH                      = $01;    { Spanish (Castilian) }
  SUBLANG_SPANISH_MEXICAN              = $02;    { Spanish (Mexican) }
  SUBLANG_SPANISH_MODERN               = $03;    { Spanish (Modern) }
  SUBLANG_SPANISH_GUATEMALA            = $04;    { Spanish (Guatemala) }
  SUBLANG_SPANISH_COSTA_RICA           = $05;    { Spanish (Costa Rica) }
  SUBLANG_SPANISH_PANAMA               = $06;    { Spanish (Panama) }
  SUBLANG_SPANISH_DOMINICAN_REPUBLIC   = $07;  { Spanish (Dominican Republic) }
  SUBLANG_SPANISH_VENEZUELA            = $08;    { Spanish (Venezuela) }
  SUBLANG_SPANISH_COLOMBIA             = $09;    { Spanish (Colombia) }
  SUBLANG_SPANISH_PERU                 = $0a;    { Spanish (Peru) }
  SUBLANG_SPANISH_ARGENTINA            = $0b;    { Spanish (Argentina) }
  SUBLANG_SPANISH_ECUADOR              = $0c;    { Spanish (Ecuador) }
  SUBLANG_SPANISH_CHILE                = $0d;    { Spanish (Chile) }
  SUBLANG_SPANISH_URUGUAY              = $0e;    { Spanish (Uruguay) }
  SUBLANG_SPANISH_PARAGUAY             = $0f;    { Spanish (Paraguay) }
  SUBLANG_SPANISH_BOLIVIA              = $10;    { Spanish (Bolivia) }
  SUBLANG_SPANISH_EL_SALVADOR          = $11;    { Spanish (El Salvador) }
  SUBLANG_SPANISH_HONDURAS             = $12;    { Spanish (Honduras) }
  SUBLANG_SPANISH_NICARAGUA            = $13;    { Spanish (Nicaragua) }
  SUBLANG_SPANISH_PUERTO_RICO          = $14;    { Spanish (Puerto Rico) }
  SUBLANG_SWEDISH                      = $01;    { Swedish }
  SUBLANG_SWEDISH_FINLAND              = $02;    { Swedish (Finland) }
{ Sorting IDs. }
  SORT_DEFAULT                         = $0;     { sorting default }
  SORT_JAPANESE_XJIS                   = $0;     { Japanese XJIS order }
  SORT_JAPANESE_UNICODE                = $1;     { Japanese Unicode order }
  SORT_CHINESE_BIG5                    = $0;     { Chinese BIG5 order }
  SORT_CHINESE_PRCP                    = $0;     { PRC Chinese Phonetic order }
  SORT_CHINESE_UNICODE                 = $1;     { Chinese Unicode order }
  SORT_CHINESE_PRC                     = $2;     { PRC Chinese Stroke Count order }
  SORT_KOREAN_KSC                      = $0;     { Korean KSC order }
  SORT_KOREAN_UNICODE                  = $1;     { Korean Unicode order }
  SORT_GERMAN_PHONE_BOOK               = $1;     { German Phone Book order }
(*
 *  A language ID is a 16 bit value which is the combination of a
 *  primary language ID and a secondary language ID.  The bits are
 *  allocated as follows:
 *
 *       +-----------------------+-------------------------+
 *       |     Sublanguage ID    |   Primary Language ID   |
 *       +-----------------------+-------------------------+
 *        15                   10 9                       0   bit
 *
 *
 *
 *  A locale ID is a 32 bit value which is the combination of a
 *  language ID, a sort ID, and a reserved area.  The bits are
 *  allocated as follows:
 *
 *       +-------------+---------+-------------------------+
 *       |   Reserved  | Sort ID |      Language ID        |
 *       +-------------+---------+-------------------------+
 *        31         20 19     16 15                      0   bit
 *
 *)
{ Default System and User IDs for language and locale. }
  LANG_SYSTEM_DEFAULT   = (SUBLANG_SYS_DEFAULT shl 10) or LANG_NEUTRAL;
  LANG_USER_DEFAULT     = (SUBLANG_DEFAULT shl 10) or LANG_NEUTRAL;
  LOCALE_SYSTEM_DEFAULT = (SORT_DEFAULT shl 16) or LANG_SYSTEM_DEFAULT;
  LOCALE_USER_DEFAULT   = (SORT_DEFAULT shl 16) or LANG_USER_DEFAULT;

(*
  Error const of File Locking
*)
{$ifdef FPC}
  ERROR_LOCK_VIOLATION = ESysEACCES;
{$else}  
  ERROR_LOCK_VIOLATION = EACCES;
{$endif}  

{ MBCS and Unicode Translation Flags. }
  MB_PRECOMPOSED = 1; { use precomposed chars }
  MB_COMPOSITE = 2; { use composite chars }
  MB_USEGLYPHCHARS = 4; { use glyph chars, not ctrl chars }

type
  LCID = DWORD;
  BOOL = LongBool;
  PBOOL = ^BOOL;
  WCHAR = WideChar;
  PWChar = PWideChar;
  LPSTR = PAnsiChar;
  PLPSTR = ^LPSTR;
  LPCSTR = PAnsiChar;
  LPCTSTR = PAnsiChar; { should be PWideChar if UNICODE }
  LPTSTR = PAnsiChar; { should be PWideChar if UNICODE }
  LPWSTR = PWideChar;
  PLPWSTR = ^LPWSTR;
  LPCWSTR = PWideChar;

  { System time is represented with the following structure: }
  PSystemTime = ^TSystemTime;
  TSystemTime = record
    wYear: Word;
    wMonth: Word;
    wDayOfWeek: Word;
    wDay: Word;
    wHour: Word;
    wMinute: Word;
    wSecond: Word;
    wMilliseconds: Word;
  end;

  TFarProc = Pointer;
  TFNLocaleEnumProc = TFarProc;
  TFNCodepageEnumProc = TFarProc;
  TFNDateFmtEnumProc = TFarProc;
  TFNTimeFmtEnumProc = TFarProc;
  TFNCalInfoEnumProc = TFarProc;

function LockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD): BOOL;
function UnlockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToUnlockLow, nNumberOfBytesToUnlockHigh: DWORD): BOOL;
procedure GetLocalTime(var lpSystemTime: TSystemTime);
function GetOEMCP: Cardinal;
function GetACP: Cardinal;
function OemToChar(lpszSrc: PChar; lpszDst: PChar): BOOL;
function CharToOem(lpszSrc: PChar; lpszDst: PChar): BOOL;
function OemToCharBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
function CharToOemBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
function MultiByteToWideChar(CodePage: DWORD; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;
function WideCharToMultiByte(CodePage: DWORD; dwFlags: DWORD; lpWideCharStr: LPWSTR; cchWideChar: Integer; lpMultiByteStr: LPSTR; cchMultiByte: Integer; lpDefaultChar: LPCSTR; lpUsedDefaultChar: PBOOL): Integer;
function CompareString(Locale: LCID; dwCmpFlags: DWORD; lpString1: PChar; cchCount1: Integer; lpString2: PChar; cchCount2: Integer): Integer;
function EnumSystemCodePages(lpCodePageEnumProc: TFNCodepageEnumProc; dwFlags: DWORD): BOOL;
function EnumSystemLocales(lpLocaleEnumProc: TFNLocaleEnumProc; dwFlags: DWORD): BOOL;
function GetUserDefaultLCID: LCID;

{$ifdef FPC}
function  GetLastError: Integer;
procedure SetLastError(Value: Integer);
{$endif}
{$endif}

implementation

{$ifndef WIN32}
{$ifdef FPC}
uses
  unix;
{$endif}

(*
NAME
       fcntl - manipulate file descriptor

SYNOPSIS
       #include <unistd.h>
       #include <fcntl.h>

       int fcntl(int fd, int cmd);
       int fcntl(int fd, int cmd, long arg);
       int fcntl(int fd, int cmd, struct flock * lock);

DESCRIPTION
       fcntl  performs one of various miscellaneous operations on
       fd.  The operation in question is determined by cmd:

       F_GETLK, F_SETLK and F_SETLKW are used to  manage  discreð
       tionary  file locks.  The third argument lock is a pointer
       to a struct flock (that may be overwritten by this  call).

       F_GETLK
              Return  the  flock  structure that prevents us from
              obtaining the lock, or set the l_type field of  the
              lock to F_UNLCK if there is no obstruction.

       F_SETLK
              The lock is set (when l_type is F_RDLCK or F_WRLCK)
              or cleared (when it is F_UNLCK).  If  the  lock  is
              held by someone else, this call returns -1 and sets
              errno to EACCES or EAGAIN.

       F_SETLKW
              Like F_SETLK, but instead of returning an error  we
              wait for the lock to be released.  If a signal that
              is to be caught is received while fcntl is waiting,
              it is interrupted and (after the signal handler has
              returned) returns immediately (with return value -1
              and errno set to EINTR).

       Using  these  mechanisms,  a  program  can implement fully
       asynchronous I/O without using select(2) or  poll(2)  most
       of the time.

       The  use of O_ASYNC, F_GETOWN, F_SETOWN is specific to BSD
       and Linux.   F_GETSIG  and  F_SETSIG  are  Linux-specific.
       POSIX  has asynchronous I/O and the aio_sigevent structure
       to achieve similar things; these  are  also  available  in
       Linux as part of the GNU C Library (Glibc).

RETURN VALUE
       For  a  successful  call,  the return value depends on the
       operation:

       F_GETFD  Value of flag.

       F_GETFL  Value of flags.

       F_GETOWN Value of descriptor owner.

       F_GETSIG Value of signal sent when read or  write  becomes
                possible,   or   zero   for   traditional   SIGIO
                behaviour.

       All other commands
                Zero.

       On error, -1 is returned, and errno is set  appropriately.

ERRORS
       EACCES   Operation  is  prohibited  by locks held by other
                processes.

       EAGAIN   Operation is prohibited because the file has been
                memory-mapped by another process.

       EBADF    fd is not an open file descriptor.

       EDEADLK  It  was detected that the specified F_SETLKW comð
                mand would cause a deadlock.

       EFAULT   lock is outside your accessible address space.

       EINTR    For F_SETLKW, the command was  interrupted  by  a
                signal.  For F_GETLK and F_SETLK, the command was
                interrupted by  a  signal  before  the  lock  was
                checked  or acquired.  Most likely when locking a
                remote file (e.g.  locking  over  NFS),  but  can
                sometimes happen locally.

       EINVAL   For  F_DUPFD,  arg is negative or is greater than
                the maximum allowable value.  For  F_SETSIG,  arg
                is not an allowable signal number.

       EMFILE   For  F_DUPFD, the process already has the maximum
                number of file descriptors open.

       ENOLCK   Too many segment locks open, lock table is  full,
                or a remote locking protocol failed (e.g. locking
                over NFS).

       EPERM    Attempted to clear the O_APPEND flag  on  a  file
                that has the append-only attribute set.

typedef long  __kernel_off_t;
typedef int   __kernel_pid_t;

struct flock {
        short l_type;
        short l_whence;
        off_t l_start;
        off_t l_len;
        pid_t l_pid;
};

whence:
--------
const
  SEEK_SET        = 0;      { Seek from beginning of file.  }
  SEEK_CUR        = 1;      { Seek from current position.  }
  SEEK_END        = 2;      { Seek from end of file.  }

{ Old BSD names for the same constants; just for compatibility.  }
  L_SET           = SEEK_SET;
  L_INCR          = SEEK_CUR;
  L_XTND          = SEEK_END;
*)

const

{$IFDEF FPC}
   F_RDLCK = 0;
   F_WRLCK = 1;
   F_UNLCK = 2;
   F_EXLCK = 4;
   F_SHLCK = 8;

   LOCK_SH = 1;
   LOCK_EX = 2;
   LOCK_NB = 4;
   LOCK_UN = 8;

   LOCK_MAND = 32;
   LOCK_READ = 64;
   LOCK_WRITE = 128;
   LOCK_RW = 192;

   EACCES = ESysEACCES;
   EAGAIN = ESysEAGAIN;
{$ENDIF}

function LockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD): BOOL;
var
  FLockInfo: {$ifdef FPC}BaseUnix.FLock{$else}TFLock{$endif};
  FLastError: Cardinal;
begin
  FLockInfo.l_type := F_WRLCK;
  FLockInfo.l_whence := SEEK_SET;
  FLockInfo.l_start := dwFileOffsetLow;
  FLockInfo.l_len := nNumberOfBytesToLockLow;
  FLockInfo.l_pid := {$ifdef FPC}fpgetpid{$else}getpid{$endif}();
  Result := {$ifdef FPC}fpfcntl{$else}fcntl{$endif}(hFile, F_SETLK, FLockInfo) <> -1;
  if not Result then
  begin
    FLastError := GetLastError();
    if (FLastError = EACCES) or (FLastError = EAGAIN) then
      SetLastError(ERROR_LOCK_VIOLATION)
    else
      Result := True; // If errno is ENOLCK or EINVAL
  end;
end;

function UnlockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToUnlockLow, nNumberOfBytesToUnlockHigh: DWORD): BOOL;
var
  FLockInfo: {$ifdef FPC}BaseUnix.FLock{$else}TFLock{$endif};
begin
  FLockInfo.l_type := F_UNLCK;
  FLockInfo.l_whence := SEEK_SET;
  FLockInfo.l_start := dwFileOffsetLow;
  FLockInfo.l_len := nNumberOfBytesToUnLockLow;
  FLockInfo.l_pid := {$ifdef FPC}fpgetpid{$else}getpid{$endif}();
  Result := {$ifdef FPC}fpfcntl{$else}fcntl{$endif}(hFile, F_SETLK, FLockInfo) <> -1;
end;

procedure DateTimeToSystemTime(const DateTime: TDateTime; var SystemTime: TSystemTime);
begin
  with SystemTime do
  begin
    DecodeDateFully(DateTime, wYear, wMonth, wDay, wDayOfWeek);
    Dec(wDayOfWeek);
    DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);
  end;
end;

function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
begin
  with SystemTime do
  begin
    Result := EncodeDate(wYear, wMonth, wDay);
    if Result >= 0 then
      Result := Result + EncodeTime(wHour, wMinute, wSecond, wMilliSeconds)
    else
      Result := Result - EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
  end;
end;

procedure GetLocalTime(var lpSystemTime: TSystemTime);
begin
  DateTimeToSystemTime(NOW, lpSystemTime);
end;

function GetOEMCP: Cardinal;
begin
  Result := $FFFFFFFF;
end;

function GetACP: Cardinal;
begin
  Result := 1252;
end;

function OemToChar(lpszSrc: PChar; lpszDst: PChar): BOOL;
begin
  if lpszDst <> lpszSrc then
    StrCopy(lpszDst, lpszSrc);
  Result := TRUE;
end;

function CharToOem(lpszSrc: PChar; lpszDst: PChar): BOOL;
begin
  if lpszDst <> lpszSrc then
    StrCopy(lpszDst, lpszSrc);
  Result := TRUE;
end;

function OemToCharBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
begin
  if lpszDst <> lpszSrc then
    StrLCopy(lpszDst, lpszSrc, cchDstLength);
  Result := TRUE;
end;

function CharToOemBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
begin
  if lpszDst <> lpszSrc then
    StrLCopy(lpszDst, lpszSrc, cchDstLength);
  Result := TRUE;
end;

function MultiByteToWideChar(CodePage: DWORD; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;
var
  TempA: AnsiString;
  TempW: WideString;
begin
  TempA := String(lpMultiByteStr^);
  TempW := TempA;
  Result := Length(TempW);
  System.Move(TempW, lpWideCharStr^, Result);
end;

function WideCharToMultiByte(CodePage: DWORD; dwFlags: DWORD; lpWideCharStr: LPWSTR; cchWideChar: Integer; lpMultiByteStr: LPSTR; cchMultiByte: Integer; lpDefaultChar: LPCSTR; lpUsedDefaultChar: PBOOL): Integer;
var
  TempA: AnsiString;
  TempW: WideString;
begin
  TempW := WideString(lpWideCharStr^);
  TempA := TempW;
  Result := Length(TempA);
  System.Move(TempA, lpMultiByteStr^, Result);
end;

function CompareString(Locale: LCID; dwCmpFlags: DWORD; lpString1: PChar; cchCount1: Integer; lpString2: PChar; cchCount2: Integer): Integer;
begin
  Result := StrLComp(lpString1, lpString2, cchCount1) + 2;
  if Result > 2 then Result := 3;
  if Result < 2 then Result := 1;
end;

function EnumSystemCodePages(lpCodePageEnumProc: TFNCodepageEnumProc; dwFlags: DWORD): BOOL;
begin
  Result := True;
end;

function EnumSystemLocales(lpLocaleEnumProc: TFNLocaleEnumProc; dwFlags: DWORD): BOOL;
begin
  Result := True;
end;

function GetUserDefaultLCID: LCID; stdcall;
begin
  Result := LANG_ENGLISH or (SUBLANG_ENGLISH_UK shl 10);
end;

{$ifdef FPC}

function GetLastError: Integer;
begin
  Result := FpGetErrno;
end;

procedure SetLastError(Value: Integer);
begin
  FpSetErrno(Value);
end;

{$endif}
{$endif}

end.

--- Dbf_Parser.pas DELETED ---

--- Dbf_Fields.pas DELETED ---

--- NEW FILE: dbf_reg.pas ---
unit Dbf_Reg;

{tab fix}

{===============================================================================
||         TDbf Component         ||         http://tdbf.sf.net               ||
===============================================================================}
(*
  tDBF is supplied "AS IS". The author disclaims all warranties,
  expressed or implied, including, without limitation, the warranties of
  merchantability and or fitness for any purpose. The author assumes no
  liability for damages, direct or consequential, which may result from the
  use of TDBF.

  TDbf is licensed under the LGPL (lesser general public license).

  You are allowed to use this component in any project free of charge.
  You are
  - NOT allowed to claim that you have created this component.  You are
  - NOT allowed to copy this component's code into your own component and
      claim that the code is your idea.

*)

interface

{$I Dbf_Common.inc}

procedure Register;

implementation

{$ifndef FPC}
{$R Dbf.dcr}
{$endif}

uses
  SysUtils,
  Classes,
{$ifdef KYLIX}
  QGraphics,
  QControls,
  QForms,
  QDialogs,
{$else}
  Controls,
  Forms,
  Dialogs,
{$endif}
  Dbf,
  Dbf_DbfFile,
  Dbf_IdxFile,
  Dbf_Fields,
  Dbf_Common,
  Dbf_Str
{$ifndef FPC}
  ,ExptIntf
{$endif}
{$ifdef DELPHI_6}
  ,DesignIntf,DesignEditors
{$else}
{$ifndef FPC}
  ,DsgnIntf
{$else}
  ,PropEdits
  ,LazarusPackageIntf
  ,LResources
  {,ComponentEditors}
{$endif}
{$endif}
  ;

//==========================================================
//============ DESIGNONLY ==================================
//==========================================================
(*
//==========================================================
//============ TFilePathProperty
//==========================================================
type
  TFilePathProperty = class(TStringProperty)
  public
    function GetValue: string; override;
  end;

function TFilePathProperty.GetValue: string;
begin
  Result := inherited GetValue;
  if Result = EmptyStr then
  begin
    SetValue(ExtractFilePath(ToolServices.GetProjectName));
    Result := inherited GetValue;
  end;
end;
*)

//==========================================================
//============ TTableNameProperty
//==========================================================
type
  TTableNameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure TTableNameProperty.Edit; {override;}
var
  FileOpen: TOpenDialog;
  Dbf: TDbf;
begin
  FileOpen := TOpenDialog.Create(Application);
  try
    with fileopen do begin
      Dbf := GetComponent(0) as TDbf;
{$ifndef FPC}
      if Dbf.FilePath = EmptyStr then
        FileOpen.InitialDir := ExtractFilePath(ToolServices.GetProjectName)
      else
{$endif}
        FileOpen.InitialDir := Dbf.AbsolutePath;
      Filename := GetValue;
      Filter := 'Dbf table|*.dbf';
      if Execute then begin
        SetValue(Filename);
      end;
    end;
  finally
    Fileopen.free;
  end;
end;

function TTableNameProperty.GetAttributes: TPropertyAttributes; {override;}
begin
  Result := [paDialog, paRevertable];
end;

//==========================================================
//============ TIndexFileNameProperty
//==========================================================

type
  TIndexFileNameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure TIndexFileNameProperty.Edit; {override;}
var
  FileOpen: TOpenDialog;
  IndexDef: TDbfIndexDef;
  Indexes: TDbfIndexDefs;
  Dbf: TDbf;
begin
  FileOpen := TOpenDialog.Create(Application);
  try
    with fileopen do begin
      IndexDef := GetComponent(0) as TDbfIndexDef;
      Indexes := TDbfIndexDefs(IndexDef.Collection);
      Dbf := TDbf(Indexes.FOwner);
      FileOpen.InitialDir := Dbf.AbsolutePath;
      Filename := GetValue;
      Filter := 'Simple index (ndx)|*.ndx'{|Multiple index (mdx)|*.mdx'};
      if Execute then begin
        SetValue(ExtractFileName(Filename));
      end;
    end;
  finally
    Fileopen.free;
  end;
end;

function TIndexFileNameProperty.GetAttributes: TPropertyAttributes; {override;}
begin
  Result := [paDialog, paRevertable];
end;

//==========================================================
//============ TSortFieldProperty
//==========================================================

type
  TSortFieldProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TSortFieldProperty.GetAttributes: TPropertyAttributes; {override;}
begin
  Result := [paValueList, paSortList, paRevertable];
end;

procedure TSortFieldProperty.GetValues(Proc: TGetStrProc);
var
  IndexDef: TDbfIndexDef;
  Indexes: TDbfIndexDefs;
  Dbf: TDbf;
  I: integer;
begin
  IndexDef := GetComponent(0) as TDbfIndexDef;
  Indexes := TDbfIndexDefs(IndexDef.Collection);
  Dbf :=  TDbf(Indexes.FOwner);
  for I := 0 to Dbf.FieldCount-1 do
  begin
    Proc(Dbf.Fields[i].FieldName);
  end;
end;

//==========================================================
//============ TIndexNameProperty
//==========================================================

type
  TIndexNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
    function GetValue: string; override;
  end;

function TIndexNameProperty.GetAttributes: TPropertyAttributes; {override;}
begin
  Result := [paValueList, paRevertable];
end;

procedure TIndexNameProperty.GetValues(Proc: TGetStrProc);
var
  Dbf: TDbf;
  I: Integer;
begin
  Dbf := GetComponent(0) as TDbf;
  Dbf.UpdateIndexDefs;
  for I := 0 to Dbf.Indexes.Count - 1 do
    Proc(Dbf.Indexes[I].IndexFile);
end;

procedure TIndexNameProperty.SetValue(const Value: string); {override}
var
  Dbf: TDbf;
begin
  Dbf := GetComponent(0) as TDbf;
  Dbf.IndexName := Value;
end;

function TIndexNameProperty.GetValue: string; {override;}
var
  Dbf: TDbf;
begin
  Dbf := GetComponent(0) as TDbf;
  Result := Dbf.IndexName;
end;

//==========================================================
//============ TVersionProperty
//==========================================================
type
  TVersionProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure TVersionProperty.Edit; {override;}
begin
  ShowMessage(
    Format(STRING_VERSION,[TDBF_MAJOR_VERSION, TDBF_MINOR_VERSION]) +
      ' : a dBase component'+#13+
      'for Delphi and c++ builder with no BDE.'+#13+
      #13 +
      'To get the latest version, please visit'+#13+
      'the website: http://www.tdbf.net'+#13+
      'or SourceForge: http://tdbf.sf.net');
end;

function TVersionProperty.GetAttributes: TPropertyAttributes; {override;}
begin
  Result := [paDialog, paReadOnly, paRevertable];
end;

//==========================================================
//============ TNativeFieldTypeProperty
//==========================================================
type
  TNativeFieldTypeProperty = class(TCharProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

procedure TNativeFieldTypeProperty.SetValue(const Value: string);
var
  L: Longint;
begin
  if Length(Value) = 0 then L := 0 else
  if Value[1] = '#' then L := StrToInt(Copy(Value, 2, Maxint))
  else L := Ord(Value[1]);
  SetOrdValue(L);
end;

function TNativeFieldTypeProperty.GetAttributes: TPropertyAttributes; {override;}
begin
  result := [paRevertable,paValueList];
end;

procedure TNativeFieldTypeProperty.GetValues(Proc: TGetStrProc);
begin
  Proc('C Character');
  Proc('N Numeric');
  Proc('D Date');
  Proc('L Logical');
  Proc('M Memo');
  Proc('B Blob');
  Proc('F Float');
  Proc('O Double');
  Proc('I Integer');
  Proc('G Graphic');
  Proc('+ AutoIncrement');
  Proc('@ DateTime');
end;

//==========================================================
//============ initialization
//==========================================================
function IDE_DbfDefaultPath:string;
begin
{$ifndef FPC}
  if ToolServices<>nil then
    Result := ExtractFilePath(ToolServices.GetProjectName)
  else
{$endif}
    Result := GetCurrentDir
end;

{$ifdef FPC}
procedure RegisterUnitDbf;
{$else}
procedure Register;
{$endif}
begin
  Dbf.DbfBasePath := IDE_DbfDefaultPath;
  RegisterComponents('Data Access', [TDbf]);
//  RegisterPropertyEditor(TypeInfo(string), TDbf, 'FilePath', TFilePathProperty);
  RegisterPropertyEditor(TypeInfo(string), TDbf, 'TableName', TTableNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TDbf, 'Version', TVersionProperty);
  RegisterPropertyEditor(TypeInfo(string), TDbf, 'IndexName', TIndexNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TDbfIndexDef, 'IndexFile', TIndexFileNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TDbfIndexDef, 'SortField', TSortFieldProperty);
  RegisterPropertyEditor(TypeInfo(char), TDbfFieldDef, 'NativeFieldType', TNativeFieldTypeProperty);
end;

{$ifdef FPC}
procedure Register;
begin
  RegisterUnit('Dbf', @RegisterUnitDbf);
end;
{$endif}

{$ifdef FPC}
initialization
  {$i tdbf.lrs}
{$endif}

end.

--- Dbf.pas DELETED ---

--- NEW FILE: dbf_fields.pas ---
unit Dbf_Fields;

{force CR/LF fix}

interface

{$I Dbf_Common.inc}

uses
  Classes,
  SysUtils,
  Db,
  Dbf_Common,
  Dbf_Str;

type
  PDbfFieldDef = ^TDbfFieldDef;

  TDbfFieldDef = class(TCollectionItem)
  private
    FFieldName: string;
    FFieldType: TFieldType;
    FNativeFieldType: TDbfFieldType;
    FDefaultBuf: PChar;
    FMinBuf: PChar;
    FMaxBuf: PChar;
    FSize: Integer;
    FPrecision: Integer;
    FHasDefault: Boolean;
    FHasMin: Boolean;
    FHasMax: Boolean;
    FAllocSize: Integer;
    FCopyFrom: Integer;
    FOffset: Integer;
    FAutoInc: Cardinal;
    FRequired: Boolean;
    FIsLockField: Boolean;

    function  GetDbfVersion: TXBaseVersion;
    procedure SetNativeFieldType(lFieldType: TDbfFieldType);
    procedure SetFieldType(lFieldType: TFieldType);
    procedure SetSize(lSize: Integer);
    procedure SetPrecision(lPrecision: Integer);
    procedure VCLToNative;
    procedure NativeToVCL;
    procedure FreeBuffers;
  protected
    function  GetDisplayName: string; override;
    procedure AssignTo(Dest: TPersistent); override;

    property DbfVersion: TXBaseVersion read GetDbfVersion;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure AssignDb(DbSource: TFieldDef);

    procedure CheckSizePrecision;
    procedure SetDefaultSize;
    procedure AllocBuffers;
    function  IsBlob: Boolean;

    property DefaultBuf: PChar read FDefaultBuf;
    property MinBuf: PChar read FMinBuf;
    property MaxBuf: PChar read FMaxBuf;
    property HasDefault: Boolean read FHasDefault write FHasDefault;
    property HasMin: Boolean read FHasMin write FHasMin;
    property HasMax: Boolean read FHasMax write FHasMax;
    property Offset: Integer read FOffset write FOffset;
    property AutoInc: Cardinal read FAutoInc write FAutoInc;
    property IsLockField: Boolean read FIsLockField write FIsLockField;
    property CopyFrom: Integer read FCopyFrom write FCopyFrom;
  published
    property FieldName: string     read FFieldName write FFieldName;
    property FieldType: TFieldType read FFieldType write SetFieldType;
    property NativeFieldType: TDbfFieldType read FNativeFieldType write SetNativeFieldType;
    property Size: Integer         read FSize      write SetSize;
    property Precision: Integer    read FPrecision write SetPrecision;
    property Required: Boolean     read FRequired  write FRequired;
  end;

  TDbfFieldDefs = class(TCollection)
  private
    FOwner: TPersistent;
    FDbfVersion: TXBaseVersion;
    FUseFloatFields: Boolean;

    function GetItem(Idx: Integer): TDbfFieldDef;
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(Owner: TPersistent);

{$ifdef SUPPORT_DEFAULT_PARAMS}
    procedure Add(const Name: string; DataType: TFieldType; Size: Integer = 0; Required: Boolean = False);
{$else}
    procedure Add(const Name: string; DataType: TFieldType; Size: Integer; Required: Boolean);
{$endif}
    function AddFieldDef: TDbfFieldDef;

    property Items[Idx: Integer]: TDbfFieldDef read GetItem;
    property DbfVersion: TXBaseVersion read FDbfVersion write FDbfVersion;
    property UseFloatFields: Boolean read FUseFloatFields write FUseFloatFields;
  end;

implementation

uses
  Dbf_DbfFile;      // for dbf header structures

{$I Dbf_Struct.inc}

// I keep changing that fields...
// Last time has been asked by Venelin Georgiev
// Is he going to be the last ?
const
(*
The theory until now was :
    ftSmallint  16 bits = -32768 to 32767
                          123456 = 6 digit max theorically
                          DIGITS_SMALLINT = 6;
    ftInteger  32 bits = -2147483648 to 2147483647
                         12345678901 = 11 digits max
                         DIGITS_INTEGER = 11;
    ftLargeInt 64 bits = -9223372036854775808 to 9223372036854775807
                         12345678901234567890 = 20 digits max
                         DIGITS_LARGEINT = 20;

But in fact if I accept 6 digits into a ftSmallInt then tDbf will not
being able to handles fields with 999999 (6 digits).

So I now oversize the field type in order to accept anithing coming from the
database.
    ftSmallint  16 bits = -32768 to 32767
                           -999  to  9999
                           4 digits max theorically
                          DIGITS_SMALLINT = 4;
    ftInteger  32 bits = -2147483648 to 2147483647
                           -99999999 to  999999999                                        12345678901 = 11 digits max
                         DIGITS_INTEGER = 9;
    ftLargeInt 64 bits = -9223372036854775808 to 9223372036854775807
                           -99999999999999999 to  999999999999999999
                         DIGITS_LARGEINT = 18;
 *)
  DIGITS_SMALLINT = 4;
  DIGITS_INTEGER = 9;
  DIGITS_LARGEINT = 18;

//====================================================================
// DbfFieldDefs
//====================================================================
function TDbfFieldDefs.GetItem(Idx: Integer): TDbfFieldDef;
begin
  Result := TDbfFieldDef(inherited GetItem(Idx));
end;

constructor TDbfFieldDefs.Create(Owner: TPersistent);
begin
  inherited Create(TDbfFieldDef);
  FOwner := Owner;
end;

function TDbfFieldDefs.AddFieldDef: TDbfFieldDef;
begin
  Result := TDbfFieldDef(inherited Add);
end;

function TDbfFieldDefs.GetOwner: TPersistent; {override;}
begin
  Result := FOwner;
end;

procedure TDbfFieldDefs.Add(const Name: string; DataType: TFieldType; Size: Integer; Required: Boolean);
var
  FieldDef: TDbfFieldDef;
begin
  FieldDef := AddFieldDef;
  FieldDef.FieldName := Name;
  FieldDef.FieldType := DataType;
  FieldDef.Size := size;
  FieldDef.Required := Required;
end;

//====================================================================
// DbfFieldDef
//====================================================================
constructor TDbfFieldDef.Create(Collection: TCollection); {virtual}
begin
  inherited;

  FDefaultBuf := nil;
  FMinBuf := nil;
  FMaxBuf := nil;
  FAllocSize := 0;
  FCopyFrom := -1;
  FPrecision := 0;
  FHasDefault := false;
  FHasMin := false;
  FHasMax := false;
end;

destructor TDbfFieldDef.Destroy; {override}
begin
  FreeBuffers;
  inherited;
end;

procedure TDbfFieldDef.Assign(Source: TPersistent);
var
  DbfSource: TDbfFieldDef;
begin
  if Source is TDbfFieldDef then
  begin
    // copy from another TDbfFieldDef
    DbfSource := TDbfFieldDef(Source);
    FFieldName := DbfSource.FieldName;
    FFieldType := DbfSource.FieldType;
    FNativeFieldType := DbfSource.NativeFieldType;
    FSize := DbfSource.Size;
    FPrecision := DbfSource.Precision;
    FRequired := DbfSource.Required;
    FCopyFrom := DbfSource.Index;
    FIsLockField := DbfSource.IsLockField;
    // copy default,min,max
    AllocBuffers;
    if DbfSource.DefaultBuf <> nil then
      Move(DbfSource.DefaultBuf^, FDefaultBuf^, FAllocSize*3);
    FHasDefault := DbfSource.HasDefault;
    FHasMin := DbfSource.HasMin;
    FHasMax := DbfSource.HasMax;
    // do we need offsets?
    FOffset := DbfSource.Offset;
    FAutoInc := DbfSource.AutoInc;
{$ifdef SUPPORT_FIELDDEF_TPERSISTENT}
  end else if Source is TFieldDef then begin
    AssignDb(TFieldDef(Source));
{$endif}
  end else
    inherited Assign(Source);
end;

procedure TDbfFieldDef.AssignDb(DbSource: TFieldDef);
begin
  // copy from Db.TFieldDef
  FFieldName := DbSource.Name;
  FFieldType := DbSource.DataType;
  FSize := DbSource.Size;
  FPrecision := DbSource.Precision;
  FRequired := DbSource.Required;
{$ifdef SUPPORT_FIELDDEF_INDEX}
  FCopyFrom := DbSource.Index;
{$endif}
  FIsLockField := false;
  // convert VCL fieldtypes to native DBF fieldtypes
  VCLToNative;
  // for integer / float fields try fill in size/precision
  SetDefaultSize;
  // VCL does not have default value support
  AllocBuffers;
  FHasDefault := false;
  FHasMin := false;
  FHasMax := false;
  FOffset := 0;
  FAutoInc := 0;
end;

procedure TDbfFieldDef.AssignTo(Dest: TPersistent);
var
  DbDest: TFieldDef;
begin
{$ifdef SUPPORT_FIELDDEF_TPERSISTENT}
  // copy to VCL fielddef?
  if Dest is TFieldDef then
  begin
    DbDest := TFieldDef(Dest);
    // VCL TFieldDef does not know how to handle TDbfFieldDef!
    // what a shame :-)
{$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
    DbDest.Attributes := [];
    DbDest.ChildDefs.Clear;
    DbDest.DataType := FFieldType;
    DbDest.Required := FRequired;
    DbDest.Size := FSize;
    DbDest.Name := FFieldName;
{$endif}
  end else
{$endif}
    inherited AssignTo(Dest);
end;

function TDbfFieldDef.GetDbfVersion: TXBaseVersion;
begin
  Result := TDbfFieldDefs(Collection).DbfVersion;
end;

procedure TDbfFieldDef.SetFieldType(lFieldType: tFieldType);
begin
  FFieldType := lFieldType;
  VCLToNative;
  CheckSizePrecision;
end;

procedure TDbfFieldDef.SetNativeFieldType(lFieldType: tDbfFieldType);
begin
  // get uppercase field type
  if (lFieldType >= 'a') and (lFieldType <= 'z') then
    lFieldType := Chr(Ord(lFieldType)-32);
  FNativeFieldType := lFieldType;
  NativeToVCL;
  CheckSizePrecision;
end;

procedure TDbfFieldDef.SetSize(lSize: Integer);
begin
  FSize := lSize;
  CheckSizePrecision;
end;

procedure TDbfFieldDef.SetPrecision(lPrecision: Integer);
begin
  FPrecision := lPrecision;
  CheckSizePrecision;
end;

procedure TDbfFieldDef.NativeToVCL;
begin
  case FNativeFieldType of
// OH 2000-11-15 dBase7 support.
// Add the new fieldtypes
    '+' : FFieldType := ftAutoInc;
    'I' : FFieldType := ftInteger;
    'O' : FFieldType := ftFloat;
    '@', 'T':
          FFieldType := ftDateTime;
    'C',
    #$91  {Russian 'C'}
        : FFieldType := ftString;
    'L' : FFieldType := ftBoolean;
    'F', 'N':
      begin
        if (FPrecision = 0) then
        begin
          if FSize <= DIGITS_SMALLINT then
            FFieldType := ftSmallInt
          else
          if TDbfFieldDefs(Collection).UseFloatFields then
            FFieldType := ftFloat
          else
{$ifdef SUPPORT_INT64}
          if FSize <= DIGITS_INTEGER then
            FFieldType := ftInteger
          else
            FFieldType := ftLargeInt;
{$else}
            FFieldType := ftInteger;
{$endif}
        end else begin
          FFieldType := ftFloat;
        end;
      end;
    'D' : FFieldType := ftDate;
    'M' : FFieldType := ftMemo;
    'B' : FFieldType := ftBlob;
    'G' : FFieldType := ftDBaseOle;
    'Y' :
      if DbfGlobals.CurrencyAsBCD then
        FFieldType := ftBCD
      else
        FFieldType := ftCurrency;
    '0' : FFieldType := ftBytes;	{ Visual FoxPro ``_NullFlags'' }
  else
    FNativeFieldType := #0;
    FFieldType := ftUnknown;
  end; //case
end;

procedure TDbfFieldDef.VCLToNative;
begin
  FNativeFieldType := #0;
  case FFieldType of
    ftAutoInc  : FNativeFieldType  := '+';
    ftDateTime :
{$ifdef SUPPORT_INT64}
      if DbfVersion = xBaseVII then
        FNativeFieldType := '@'
      else
{$endif}
        FNativeFieldType := 'T';
{$ifdef SUPPORT_FIELDTYPES_V4}
    ftFixedChar,
    ftWideString,
{$endif}
    ftString   : FNativeFieldType  := 'C';
    ftBoolean  : FNativeFieldType  := 'L';
    ftFloat, ftSmallInt, ftWord
{$ifdef SUPPORT_INT64}
      , ftLargeInt
{$endif}
               : FNativeFieldType := 'N';
    ftDate     : FNativeFieldType := 'D';
    ftMemo     : FNativeFieldType := 'M';
    ftBlob     : FNativeFieldType := 'B';
    ftDBaseOle : FNativeFieldType := 'G';
    ftInteger  :
      if DbfVersion = xBaseVII then
        FNativeFieldType := 'I'
      else
        FNativeFieldType := 'N';
    ftBCD, ftCurrency: 
      if DbfVersion = xFoxPro then
        FNativeFieldType := 'Y';
  end;
  if FNativeFieldType = #0 then
    raise EDbfError.CreateFmt(STRING_INVALID_VCL_FIELD_TYPE, [GetDisplayName, Ord(FFieldType)]);
end;

procedure TDbfFieldDef.SetDefaultSize;
begin
  case FFieldType of
    ftFloat:
      begin
        FSize := 18;
        FPrecision := 9;
      end;
    ftCurrency, ftBCD:
      begin
        FSize := 8;
        FPrecision := 4;
      end;
    ftSmallInt, ftWord:
      begin
        FSize := DIGITS_SMALLINT;
        FPrecision := 0;
      end;
    ftInteger:
      begin
        if DbfVersion = xBaseVII then
          FSize := 4
        else
          FSize := DIGITS_INTEGER;
        FPrecision := 0;
      end;
{$ifdef SUPPORT_INT64}
    ftLargeInt:
      begin
        FSize := DIGITS_LARGEINT;
        FPrecision := 0;
      end;
{$endif}
    ftDate, ftDateTime:
      begin
        if FNativeFieldType = 'T' then
          FSize := 14
        else
          FSize := 8;
        FPrecision := 0;
      end;
  end; // case fieldtype
end;

procedure TDbfFieldDef.CheckSizePrecision;
begin
  case FNativeFieldType of
    'C':
      begin
        if FSize < 0      then FSize := 0;
        if FSize >= 65534 then FSize := 65534;
        FPrecision := 0;
      end;
    'L':
      begin
        FSize := 1;
        FPrecision := 0;
      end;
    'N','F':
      begin
        case FFieldType of
          ftSmallInt:
          begin
            FSize := DIGITS_SMALLINT;
            FPrecision := 0;
          end;
          ftInteger:
          begin
            FSize := DIGITS_INTEGER;
            FPrecision := 0;
          end;
          ftLargeInt:
          begin
            FSize := DIGITS_LARGEINT;
            FPrecision := 0;
          end;
        else
          // floating point
          if FSize < 2   then FSize := 2;
          if FSize >= 20 then FSize := 20;
          if FPrecision > FSize-2 then FPrecision := FSize-2;
          if FPrecision < 0       then FPrecision := 0;
        end;
      end;
    'D':
      begin
        FSize := 8;
        FPrecision := 0;
      end;
    'M','G','B':
      begin
        FSize := 10;
        FPrecision := 0;
      end;
    '+','I':
      begin
        FSize := 4;
        FPrecision := 0;
      end;
    '@', 'O':
      begin
        FSize := 8;
        FPrecision := 0;
      end;
    'T':
      begin
        FSize := 14;
        FPrecision := 0;
      end;
    'Y':
      begin
        FSize := 8;
        FPrecision := 4;
      end;
  else
    // Nothing
  end; // case
end;

function TDbfFieldDef.GetDisplayName: string; {override;}
begin
  Result := FieldName;
end;

function TDbfFieldDef.IsBlob: Boolean; {override;}
begin
  Result := FNativeFieldType in ['M','G','B'];
end;

procedure TDbfFieldDef.FreeBuffers;
begin
  if FDefaultBuf <> nil then
  begin
    // one buffer for all
    FreeMemAndNil(Pointer(FDefaultBuf));
    FMinBuf := nil;
    FMaxBuf := nil;
  end;
  FAllocSize := 0;
end;

procedure TDbfFieldDef.AllocBuffers;
begin
  // size changed?
  if FAllocSize <> FSize then
  begin
    // free old buffers
    FreeBuffers;
    // alloc new
    GetMem(FDefaultBuf, FSize*3);
    FMinBuf := FDefaultBuf + FSize;
    FMaxBuf := FMinBuf + FSize;
    // store allocated size
    FAllocSize := FSize;
  end;
end;

end.

--- Dbf_Str_RU.pas DELETED ---

--- Dbf_Str_ES.pas DELETED ---

--- Dbf_PrsSupp.pas DELETED ---

--- Dbf_Common.inc DELETED ---

--- NEW FILE: dbf_dbffile.pas ---
unit Dbf_DbfFile;

interface

{$I Dbf_Common.inc}

uses
  Classes, SysUtils,
{$ifdef WIN32}
  Windows,
{$else}
{$ifdef KYLIX}
  Libc, 
{$endif}  
  Types, Dbf_Wtil,
{$endif}
  Db,
  Dbf_Common,
  Dbf_Cursor,
[...2493 lines suppressed...]
  PFoxCDXNodeNonLeaf    = ^TFoxCDXNodeNonLeaf;

  TFoxCDXNodeLeaf       = Packed Record
    NodeCommon          : TFoxCDXNodeCommon;
    BlockFreeSpace      : Word;
    RecordNumberMask    : Integer;
    DuplicateCountMask  : Byte;
    TrailByteCountMask  : Byte;
    RecNoBytes          : Byte;
    DuplicateCountBytes : Byte;
    TrailByteCountBytes : Byte;
    HoldingByteCount    : Byte;
    DataBlock           : TDataBlock;
  End;
  PFoxCDXNodeLeaf       = ^TFoxCDXNodeLeaf;

*)

end.

--- Dbf_Str_FR.pas DELETED ---

--- NEW FILE: dbf_str.pas ---
unit Dbf_Str;

{fix CR/LF}

interface

{$I Dbf_Common.inc}
{$I Dbf_Str.inc}

implementation

initialization

  STRING_FILE_NOT_FOUND               := 'Open: file not found: "%s".';
  STRING_VERSION                      := 'TDbf V%d.%d';

  STRING_RECORD_LOCKED                := 'Record locked.';
  STRING_WRITE_ERROR                  := 'Error while writing occurred. (Disk full?)';
  STRING_WRITE_INDEX_ERROR            := 'Error while writing occurred; indexes probably corrupted. (Disk full?)';
  STRING_KEY_VIOLATION                := 'Key violation. (Key already present in file).'+#13+#10+
                                         'Index: %s'+#13+#10+'Record=%d Key=''%s''.';

  STRING_INVALID_DBF_FILE             := 'Invalid DBF file.';
  STRING_FIELD_TOO_LONG               := 'Value is too long: %d characters (it can''t be more than %d).';
  STRING_INVALID_FIELD_COUNT          := 'Invalid field count: %d (must be between 1 and 4095).';
  STRING_INVALID_FIELD_TYPE           := 'Invalid field type ''%s'' for field ''%s''.';
  STRING_INVALID_VCL_FIELD_TYPE       := 'Cannot create field "%s", VCL field type %x not supported by DBF.';

  STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Index based on unknown field "%s".';
  STRING_INDEX_BASED_ON_INVALID_FIELD := 'Field "%s" is an invalid field type to base index on.';
  STRING_INDEX_EXPRESSION_TOO_LONG    := 'Index result for "%s" too long, >100 characters (%d).';
  STRING_INVALID_INDEX_TYPE           := 'Invalid index type: can only be string or float.';
  STRING_CANNOT_OPEN_INDEX            := 'Cannot open index: "%s".';
  STRING_TOO_MANY_INDEXES             := 'Can not create index: too many indexes in file.';
  STRING_INDEX_NOT_EXIST              := 'Index "%s" does not exist.';
  STRING_NEED_EXCLUSIVE_ACCESS        := 'Exclusive access is required for this operation.';
end.

--- NEW FILE: dbf_common.pas ---
unit Dbf_Common;

interface

{$I Dbf_Common.inc}

uses
  SysUtils, Classes, DB
{$ifndef WIN32}
  , Types, Dbf_Wtil
{$ifdef KYLIX}
  , Libc
{$endif}  
{$endif}
  ;

const
  TDBF_MAJOR_VERSION      = 6;
  TDBF_MINOR_VERSION      = 38;
  TDBF_SUB_MINOR_VERSION  = 0;

  TDBF_TABLELEVEL_FOXPRO = 25;

type
  EDbfError = class (EDatabaseError);
  EDbfWriteError = class (EDbfError);

  TDbfFieldType = char;
  PBookMarkData = ^rBookMarkData;
  rBookmarkData = Integer;

  TXBaseVersion   = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII);
  TSearchKeyType = (stEqual, stGreaterEqual, stGreater);

  TDateTimeHandling       = (dtDateTime, dtBDETimeStamp);

//-------------------------------------

{$ifdef FPC_VERSION}
  PDateTime = ^TDateTime;
  TDateTimeAlias = type TDateTime;
  TDateTimeRec = record
    case TFieldType of
      ftDate: (Date: Longint);
      ftTime: (Time: Longint);
      ftDateTime: (DateTime: TDateTimeAlias);
  end;
{$endif}

  PSmallInt = ^SmallInt;
  PCardinal = ^Cardinal;
  PDouble = ^Double;
  PString = ^String;
  PDateTimeRec = ^TDateTimeRec;

{$ifdef SUPPORT_INT64}
  PLargeInt = ^Int64;
{$endif}

//-------------------------------------

{$ifndef SUPPORT_FREEANDNIL}
// some procedures for the less lucky who don't have newer versions yet :-)
procedure FreeAndNil(var v);
{$endif}
procedure FreeMemAndNil(var P: Pointer);

//-------------------------------------

{$ifndef SUPPORT_PATHDELIM}
const
{$ifdef WIN32}
  PathDelim = '\';
{$else}
  PathDelim = '/';
{$endif}
{$endif}

{$ifndef SUPPORT_INCLTRAILPATHDELIM}
function IncludeTrailingPathDelimiter(const Path: string): string;
{$endif}

//-------------------------------------

function GetCompletePath(const Base, Path: string): string;
function GetCompleteFileName(const Base, FileName: string): string;
function IsFullFilePath(const Path: string): Boolean; // full means not relative
{$ifndef SUPPORT_NEW_FIELDDATA}
function DateTimeToBDETimeStamp(aDT: TDateTime): double;
function BDETimeStampToDateTime(aBT: double): TDateTime;
{$endif}
function  GetStrFromInt(Val: Integer; const Dst: PChar): Integer;
procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char);
{$ifdef SUPPORT_INT64}
function  GetStrFromInt64(Val: Int64; const Dst: PChar): Integer;
procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char);
{$endif}
procedure FindNextName(BaseName: string; var OutName: string; var Modifier: Integer);
{$ifdef USE_CACHE}
function GetFreeMemory: Integer;
{$endif}

// OH 2000-11-15 dBase7 support. Swap Byte order for 4 and 8 Byte Integer
function SwapInt(const Value: Cardinal): Cardinal;
procedure SwapInt64(Value, Result: Pointer); register;

function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integer): Integer;

// Returns a pointer to the first occurence of Chr in Str within the first Length characters
// Does not stop at null (#0) terminator!
function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;

implementation

{$ifdef WIN32}
uses
  Windows;
{$endif}

//====================================================================

function GetCompletePath(const Base, Path: string): string;
begin
  if IsFullFilePath(Path)
  then begin
    Result := Path;
  end else begin
    if Length(Base) > 0 then
      Result := ExpandFileName(IncludeTrailingPathDelimiter(Base) + Path)
    else
      Result := ExpandFileName(Path);
  end;

  // add last backslash if not present
  if Length(Result) > 0 then
    Result := IncludeTrailingPathDelimiter(Result);
end;

function IsFullFilePath(const Path: string): Boolean; // full means not relative
begin
{$ifdef WIN32}
  Result := Length(Path) > 1;
  if Result then
    // check for 'x:' or '\\' at start of path
    Result := ((Path[2]=':') and (upcase(Path[1]) in ['A'..'Z']))
      or ((Path[1]='\') and (Path[2]='\'));
{$else}  // Linux
  Result := Length(Path) > 0;
  if Result then
    Result := Path[1]='/';
 {$endif}
end;

//====================================================================

function GetCompleteFileName(const Base, FileName: string): string;
var
  lpath: string;
  lfile: string;
begin
  lpath := GetCompletePath(Base, ExtractFilePath(FileName));
  lfile := ExtractFileName(FileName);
  lpath := lpath + lfile;
  result := lpath;
end;

// it seems there is no pascal function to convert an integer into a PChar???

procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char);
var
  Temp: array[0..10] of Char;
  I, J, K: Integer;
  NegSign: boolean;
begin
  if Width <= 0 then
    exit;

  NegSign := Val < 0;
  Val := Abs(Val);
  // we'll have to store characters backwards first
  I := 0;
  J := 0;
  repeat
    Temp[I] := Chr((Val mod 10) + Ord('0'));
    Val := Val div 10;
    Inc(I);
  until Val = 0;
  // add sign
  if NegSign then
  begin
    Dst[J] := '-';
    Inc(J);
  end;
  // add spaces
  for K := 0 to Width - I - J - 1 do
  begin
    Dst[J] := PadChar;
    Inc(J);
  end;
  // if field too long, cut off
  if J + I > Width then
    I := Width - J;
  // copy value, remember: stored backwards
  repeat
    Dst[J] := Temp[I-1];
    Inc(J);
    Dec(I);
  until I = 0;
  // done!
end;

{$ifdef SUPPORT_INT64}

procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char);
var
  Temp: array[0..19] of Char;
  I, J, K: Integer;
  NegSign: boolean;
begin
  if Width <= 0 then
    exit;

  NegSign := Val < 0;
  Val := Abs(Val);
  // we'll have to store characters backwards first
  I := 0;
  J := 0;
  repeat
    Temp[I] := Chr((Val mod 10) + Ord('0'));
    Val := Val div 10;
    inc(I);
  until Val = 0;
  // add sign
  if NegSign then
  begin
    Dst[J] := '-';
    inc(J);
  end;
  // add spaces
  for K := 0 to Width - I - J - 1 do
  begin
    Dst[J] := PadChar;
    inc(J);
  end;
  // if field too long, cut off
  if J + I > Width then
    I := Width - J;
  // copy value, remember: stored backwards
  repeat
    Dst[J] := Temp[I-1];
    inc(J);
    dec(I);
  until I = 0;
  // done!
end;

{$endif}

// it seems there is no pascal function to convert an integer into a PChar???
// NOTE: in dbf_dbffile.pas there is also a convert routine, but is slightly different

function GetStrFromInt(Val: Integer; const Dst: PChar): Integer;
var
  Temp: array[0..10] of Char;
  I, J: Integer;
begin
  Val := Abs(Val);
  // we'll have to store characters backwards first
  I := 0;
  J := 0;
  repeat
    Temp[I] := Chr((Val mod 10) + Ord('0'));
    Val := Val div 10;
    Inc(I);
  until Val = 0;

  // remember number of digits
  Result := I;
  // copy value, remember: stored backwards
  repeat
    Dst[J] := Temp[I-1];
    Inc(J);
    Dec(I);
  until I = 0;
  // done!
end;

{$ifdef SUPPORT_INT64}

function GetStrFromInt64(Val: Int64; const Dst: PChar): Integer;
var
  Temp: array[0..19] of Char;
  I, J:...

[truncated message content]