home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / unity / d345 / ALP.ZIP / ALP.pas next >
Encoding:
Pascal/Delphi Source File  |  2001-05-23  |  102.1 KB  |  2,793 lines
  1. unit ALP;
  2. {-----------------------------------------------------------------------------
  3.  Universal unit of access to databases without BDE
  4.  Last modification : 23 May 2001
  5.  (Please write this last modification date in your e-mails.)
  6.  
  7.  Version:     1.17
  8.  Author:    Momot Alexander (Deleon)
  9.  Http:          http://www.dbwork.chat.ru
  10.  E-Mail:    dbwork@chat.ru
  11.  Status:    FreeWare
  12.  Delphi:        32-bit versions
  13.  Platform:    Windows 32-bit versions.
  14.  
  15. ~ History ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  16.  
  17. * 27 Feb 2001
  18.   - Adding a new error codes.
  19.   - Correct ALPDeleteRecord function.
  20.   - Correct ALPGetRecord function.
  21.  
  22. -----------------------------------------------------------------------------}
  23.  
  24. interface
  25.  
  26. uses
  27.   Windows, SysUtils, Alp32;
  28.  
  29. type
  30.   Char3      = array[0..02] of Char;
  31.   Char12     = array[0..11] of Char;
  32.   Char16     = array[0..15] of Char;
  33.   Char24     = array[0..23] of Char;
  34.   Char32     = array[0..31] of Char;
  35.   Char36     = array[0..35] of Char;
  36.   Char48     = array[0..47] of Char;
  37.   Char64     = array[0..63] of Char;
  38.   Char256    = array[0..255]of Char;
  39.   TByteSet   = set of Byte;
  40.   TByteIdent = record
  41.                 iOffs: Word;
  42.                 iVals: TByteSet;
  43.                end;
  44.   TTblIdent  = packed record
  45.                 iName : string[16];
  46.                 iDesc : string[24];
  47.                 iCount: 0..6;
  48.                 iIdent: array[0..6]of TByteIdent;
  49.                end;{ rec }
  50.  
  51.  
  52. {----------------------------------------------------------------------------}
  53. { SUPPORTED TABLE TYPES                                                      }
  54. {----------------------------------------------------------------------------}
  55.  
  56.   ALP_TBLTYPE  = (
  57.                    ttUNKNOWN,  { Unknown table type      }
  58.                    ttDBASE3,   { FoxBase+/dBase III Plus }
  59.                    ttDBASE4,   { dBase IV                }
  60.                    ttDBASE5,   { dBase V for WIN         }
  61.                    ttDBASE7,   { dBase VII for WIN       }
  62.                    ttFOXPRO1,  { FoxPRO                  }
  63.                    ttFOXPRO2,  { FoxPRO                  }
  64.                    ttFOXPRO3,  { FoxPRO                  }
  65.                    ttFOXPRO4,  { FoxPRO                  }
  66.                    ttPARADOX3, { Paradox 3.5             }
  67.                    ttPARADOX4, { Paradox 4               }
  68.                    ttPARADOX5, { Paradox 5 for WIN       }
  69.                    ttPARADOX7, { Paradox 7 for WIN       }
  70.                    ttCLARION1, { Clarion 1               }
  71.                    ttCLARION2, { Clarion 2               }
  72.                    ttEXCEL,    { Excel                   }
  73.                    ttEJM       { EJM                     }
  74.                   );
  75.  
  76.   ALP_TYPESET = set of ALP_TBLTYPE;
  77.  
  78.  
  79. {============================================================================}
  80. {                   Bookmark Properties                                      }
  81. {============================================================================}
  82.   pBookmark = ^IBookmark;       { Bookmark properties }
  83.   IBookmark  = Integer;
  84.  
  85. {============================================================================}
  86. {                   Record Properties                                        }
  87. {============================================================================}
  88.  
  89. type
  90.   RECStatus = (rsUnmodified, rsModified, rsInserted, rsDeleted);
  91.  
  92.   pRECProps = ^RECProps;
  93.   RECProps = packed record              { Record properties }
  94.     iRecNum         : Longint;          { When Seq# supported only }
  95.     iRecStatus      : RECStatus;        { Delayed Updates Record Status }
  96.     bDeleteFlag     : Boolean;          { When soft delete supported only }
  97.   end;
  98.  
  99.  
  100. const
  101. {----------------------------------------------------------------------------}
  102. { ALP CONSTANTS                                                             }
  103. {----------------------------------------------------------------------------}
  104.  
  105. { TABLE IDENTS }
  106.   TBLIDENT : array[ALP_TBLTYPE]of TTblIdent =
  107.              (
  108.               (iName: 'UNKNOWN';  iDesc: 'UNKNOWN';  iCount: 0; iIdent: ((iOffs: 00;iVals: [00]),             (iOffs: 00;iVals: [00]),          (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  109.               (iName: 'dBASE3';   iDesc: 'UNKNOWN';  iCount: 6; iIdent: ((iOffs: 00;iVals: [$03,$83]),        (iOffs: 14;iVals: [00,01]),       (iOffs: 15;iVals: [00,01]), (iOffs: 12;iVals: [00]), (iOffs: 13;iVals: [00]), (iOffs: 28;iVals: [00,01]), (iOffs: 00;iVals: [00]))),
  110.               (iName: 'dBASE4';   iDesc: 'UNKNOWN';  iCount: 6; iIdent: ((iOffs: 00;iVals: [$04,$8B,$8E,$7B]),(iOffs: 14;iVals: [00,01]),       (iOffs: 15;iVals: [00,01]), (iOffs: 12;iVals: [00]), (iOffs: 13;iVals: [00]), (iOffs: 28;iVals: [00,01]), (iOffs: 00;iVals: [00]))),
  111.               (iName: 'dBASE5';   iDesc: 'UNKNOWN';  iCount: 6; iIdent: ((iOffs: 00;iVals: [$05]),            (iOffs: 14;iVals: [00,01]),       (iOffs: 15;iVals: [00,01]), (iOffs: 12;iVals: [00]), (iOffs: 13;iVals: [00]), (iOffs: 28;iVals: [00,01]), (iOffs: 00;iVals: [00]))),
  112.               (iName: 'dBASE7';   iDesc: 'UNKNOWN';  iCount: 6; iIdent: ((iOffs: 00;iVals: [$9B]),            (iOffs: 14;iVals: [00,01]),       (iOffs: 15;iVals: [00,01]), (iOffs: 12;iVals: [00]), (iOffs: 13;iVals: [00]), (iOffs: 28;iVals: [00,01]), (iOffs: 00;iVals: [00]))),
  113.               (iName: 'FOXPRO1';  iDesc: 'UNKNOWN';  iCount: 0; iIdent: ((iOffs: 00;iVals: [$00]),            (iOffs: 00;iVals: [00]),          (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  114.               (iName: 'FOXPRO2';  iDesc: 'UNKNOWN';  iCount: 0; iIdent: ((iOffs: 00;iVals: [$00]),            (iOffs: 00;iVals: [00]),          (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  115.               (iName: 'FOXPRO3';  iDesc: 'UNKNOWN';  iCount: 0; iIdent: ((iOffs: 00;iVals: [$00]),            (iOffs: 00;iVals: [00]),          (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  116.               (iName: 'FOXPRO4';  iDesc: 'UNKNOWN';  iCount: 0; iIdent: ((iOffs: 00;iVals: [$00]),            (iOffs: 00;iVals: [00]),          (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  117.               (iName: 'PARADOX3'; iDesc: 'UNKNOWN';  iCount: 3; iIdent: ((iOffs: 04;iVals: [00,02]),          (iOffs: 05;iVals: [01,02,03,04]), (iOffs: 57;iVals: [04]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  118.               (iName: 'PARADOX4'; iDesc: 'UNKNOWN';  iCount: 3; iIdent: ((iOffs: 04;iVals: [00,02]),          (iOffs: 05;iVals: [01,02,03,04]), (iOffs: 57;iVals: [09]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  119.               (iName: 'PARADOX5'; iDesc: 'UNKNOWN';  iCount: 3; iIdent: ((iOffs: 04;iVals: [00,02]),          (iOffs: 05;iVals: [01,02,03,04]), (iOffs: 57;iVals: [11]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  120.               (iName: 'PARADOX7'; iDesc: 'UNKNOWN';  iCount: 3; iIdent: ((iOffs: 04;iVals: [00,02]),          (iOffs: 05;iVals: [01,02,03,04]), (iOffs: 57;iVals: [12]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  121.               (iName: 'CLARION1'; iDesc: 'CLARION1'; iCount: 0; iIdent: ((iOffs: 00;iVals: [67]),             (iOffs: 01;iVals: [51]),          (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  122.               (iName: 'CLARION2'; iDesc: 'CLARION2'; iCount: 2; iIdent: ((iOffs: 00;iVals: [67]),             (iOffs: 01;iVals: [51]),          (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  123.               (iName: 'EXCEL';    iDesc: 'EXCEL';    iCount: 0; iIdent: ((iOffs: 00;iVals: [67]),             (iOffs: 01;iVals: [51]),          (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00]))),
  124.               (iName: 'EJM';      iDesc: 'EJM';      iCount: 4; iIdent: ((iOffs: 00;iVals: [09]),             (iOffs: 01;iVals: [04]),          (iOffs: 02;iVals: [74]),    (iOffs: 03;iVals: [19]), (iOffs: 00;iVals: [00]), (iOffs: 00;iVals: [00]),    (iOffs: 00;iVals: [00])))
  125.              );
  126.  
  127.   ALP_CLARIONTYPES : ALP_TYPESET =  [ttCLARION1..ttCLARION2];
  128.   ALP_DBASETYPES   : ALP_TYPESET =  [ttDBASE3..ttDBASE7, ttFOXPRO1..ttFOXPRO4];
  129.   ALP_PDXTYPES     : ALP_TYPESET =  [ttPARADOX3..ttPARADOX7];
  130.  
  131. { ERRORS }
  132.   ERR_NONE                   = 0;
  133.   ERR_UNSUPPORTEDFILE        = 1;
  134.   ERR_CANNOTOPENFILE         = 2;
  135.   ERR_CANNOTCLOSEFILE        = 3;
  136.   ERR_INVALIDFILE            = 4;
  137.   ERR_INVALIDHANDLE          = 5;
  138.   ERR_INVALIDFILENAME        = 6;
  139.   ERR_FILENOTEXIST           = 7;
  140.   ERR_CANNOTSEEK             = 8;
  141.   ERR_CANNOTREADFILE         = 9;
  142.   ERR_CANNOTWRITEFILE        = 10;
  143.   ERR_BOF                    = 11;
  144.   ERR_EOF                    = 12;
  145.   ERR_BUFFERISEMPTY          = 13;
  146.   ERR_INVALIDFIELDDESC       = 14;
  147.   ERR_INVALIDINDEXDESC       = 15;
  148.   ERR_RECDELETED             = 16;
  149.   ERR_INVALIDCRDESC          = 17;
  150.  
  151. { PARAMETERS }
  152.   PRM_NUMRECS                = 11;
  153.   PRM_NUMDELS                = 12;
  154.   PRM_NUMFLDS                = 13;
  155.   PRM_RECSIZE                = 14;
  156.   PRM_BLOCKFIRST             = 15;
  157.   PRM_BLOCKLAST              = 16;
  158.   PRM_BLOCKFREE              = 17;
  159.   PRM_BLOCKUSED              = 18;
  160.   PRM_BLOCKTOTAL             = 19;
  161.  
  162. { MAX }
  163.   MAX_FILENAMELEN            = 255;
  164.   MAX_HEADERBUFSIZE          = 1024 * 2;
  165.   MAX_BUFFERSIZE             = 1024 * 32;   { Read buffer size }
  166.  
  167. { SEEK }
  168.   SEEK_FROMBEGIN             = 0;           { Seek from begin of file }
  169.   SEEK_FROMCURRENT           = 1;           { Seek from current position }
  170.   SEEK_FROMEND               = 2;           { Seek from end of file }
  171.  
  172. { SEEK OF FILE }
  173.   SEEK_PDXVERSION            = 57;
  174.  
  175. { SET BUFFER RESULTS }
  176.   BUFFER_NORMAL              = 0;
  177.   BUFFER_EMPTY               = 1;
  178.   BUFFER_END                 = 2;
  179.  
  180. { VERSION }
  181.   VERSION_DBASE3             = $03;
  182.   VERSION_DBASE4             = $04;
  183.   VERSION_DBASE5             = $05;
  184.   VERSION_DBASE7             = $8B;
  185.  
  186.   VERSION_PDX3               = 04;
  187.   VERSION_PDX4               = 09;
  188.   VERSION_PDX5               = 11;
  189.   VERSION_PDX7               = 12;
  190.  
  191. type
  192. {----------------------------------------------------------------------------}
  193. { ARRAYS                                                                     }
  194. {----------------------------------------------------------------------------}
  195.  
  196.   ALP_FILENAME     = packed array [0..MAX_FILENAMELEN] of Char; { holds a DOS path }
  197.  
  198.  
  199. {============================================================================}
  200. {                    Field map                                               }
  201. {============================================================================}
  202.  
  203.   ALP_FLDTYPE =   (uftUnknown,    uftString,      uftSmallint,  uftInteger,
  204.               {4}  uftWord,       uftBoolean,     uftFloat,     uftCurrency,
  205.               {8}  uftBCD,        uftDate,        uftTime,      uftDateTime,
  206.               {12} uftBytes,      uftVarBytes,    uftAutoInc,   uftBlob,
  207.               {16} uftMemo,       uftGraphic,     uftFmtMemo,   uftParadoxOle,
  208.               {20} uftDBaseOle,   uftTypedBinary, uftCursor,    uftFixedChar,
  209.               {24} uftWideString, uftLargeint,    uftADT,       uftArray,
  210.               {28} uftReference,  uftDataSet,     uftOraBlob,   uftOraClob,
  211.               {32} uftVariant,    uftInterface,   uftIDispatch, uftGuid);
  212.  
  213.   ALP_SUBTYPE = (sftUNKNOWN, sftBYTE, sftBCD);
  214.  
  215.  
  216.  
  217. const
  218.   ALP_FLDSIZES: packed array[ALP_FLDTYPE] of Byte =
  219.     (0 {ftUnknown},    0 {ftString},      2 {ftSmallint}, 4  {ftInteger},    2 {ftWord},
  220.      0 {ftBoolean},    8 {ftFloat},       8 {ftCurrency}, 0  {ftBCD},        4 {ftDate},
  221.      4 {ftTime},       8 {ftDateTime},    0 {ftBytes},    0  {ftVarBytes},   4 {ftAutoInc},
  222.      10{ftBlob},       10{ftMemo},        10{ftGraphic},  10 {ftFmtMemo},    0 {ftParadoxOle},
  223.      10{ftDBaseOle},   10{ftTypedBinary}, 10{ftCursor},   0  { ftFixedChar },
  224.      0 {ftWideString}, 0 {ftLargeInt} ,   0 {ftADT},      0  {ftArray},      0 {ftReference},
  225.      0 {ftDataSet},    10{ftOraBlob},     10{ftOraClob},  0  {ftVariant},    10{ftInterface},
  226.      0 {ftIDispatch},  0 {ftGuid});
  227.  
  228.   ALP_SIZEFLDS = [uftString, uftBytes, uftVarBytes, uftADT, uftArray, uftReference];
  229.  
  230. {----------------------------------------------------------------------------}
  231. { SUPPORTED TABLE HEADERS                                                    }
  232. {----------------------------------------------------------------------------}
  233.  
  234.  
  235. {============================================================================}
  236. {                    dBASE descriptors                                       }
  237. {============================================================================}
  238.  
  239.   FLD_DB_STRING  = 67;
  240.   FLD_DB_DATE    = 68;
  241.   FLD_DB_NUMBER  = 70;
  242.   FLD_DB_BOOLEAN = 76;
  243.   FLD_DB_MEMO    = 77;
  244.   FLD_DB_FLOAT   = 78;
  245.  
  246. type
  247.   HDR_DBASE = packed record
  248.   {000} Version     : Byte;    { dBase version                   }
  249.   {001} Year        : Byte;    { Year of last update             }
  250.   {002} Month       : Byte;    { Month of last update            }
  251.   {003} Day         : Byte;    { Day of last update              }
  252.   {004} NumRecs     : Integer; { Number of records in the file   }
  253.   {008} HdrLen      : Word;    { Length of the header            }
  254.   {010} RecLen      : Word;    { Length of individual records    }
  255.   {012} Nets        : Word;    { not used                        }
  256.   {014} Transaction : Byte;    { begin-end transaction (0,1)     }
  257.   {015} Encrypted   : Byte;    { Coded fields (0,1)              }
  258.   {016} NetWork     : array [0..11]of Byte;
  259.   {028} MdxFile     : Byte;    { Exist .mdx file indicator (0,1) }
  260.   {029} LangDrv     : Byte;    { language driver /fox/           }
  261.   {030} Labeled     : Word;
  262.   end;{ rec }
  263.  
  264.   { 001 - code page 437  }
  265.   { 002 - code page 850  }
  266.   { 100 - code page 852  }
  267.   { 102 - code page 865  }
  268.   { 101 - code page 866  }
  269.   { 104 - code page 895  }
  270.   { 200 - code page 1250 }
  271.   { 201 - code page 1251 }
  272.   { 003 - code page 1252 }
  273.  
  274.   HDR_DBASEADD = record
  275.     Dummy   : array[32..67] of byte;
  276.   end;{ rec }
  277.  
  278.   pFLDHDR_DBASE = ^FLDHDR_DBASE;
  279.   FLDHDR_DBASE = packed record
  280.     Hdr  : Byte;                 { record header type and status }
  281.   end;
  282.  
  283.   pFLD_DBASE3 = ^FLD_DBASE3;
  284.   FLD_DBASE3 = packed record
  285.   {000} FldName  : array[0..10]of Char;
  286.   {011} FldType  : Byte;
  287.   {012} Rsrv1    : array[0..3]of Byte;
  288.   {016} FldSize  : Byte;
  289.   {017} FldDec   : Byte;
  290.   {018} Rsrv2    : array[0..13]of Byte;
  291.   end;{ rec }
  292.  
  293.   pFLD_DBASE5 = ^FLD_DBASE5;
  294.   FLD_DBASE5 = packed record
  295.   {000} FldName  : array[0..10]of Char;
  296.   {011} Rsrv1    : array[0..20]of Byte;
  297.   {032} FldType  : Byte;
  298.   {033} FldSize  : Byte;
  299.   {034} FldDec   : Byte;
  300.   {035} Rsrv2    : array[0..12]of Byte;
  301.   end;{ rec }
  302.  
  303.   pDATE_DBASE = ^DATE_DBASE;
  304.   DATE_DBASE = packed record
  305.   {000} Year     : array[0..3]of Char;
  306.   {004} Month    : array[0..1]of Char;
  307.   {006} Day      : array[0..1]of Char;
  308.   end;
  309.  
  310. const
  311.   DELFLAG_DBASE       = Ord('*');
  312.   EMPCHAR_DBASE       = Ord(' ');
  313.   OFFS_DBASE_NUMRECS  = 4;
  314.  
  315. {============================================================================}
  316. {                    CLARION descriptors                                     }
  317. {============================================================================}
  318. const
  319.   SIGN_LOCKED     =   1;         { bit 0 - file is locked          }
  320.   SIGN_OWNED      =   2;         { bit 1 - file is owned           }
  321.   SIGN_ENCRYPTED  =   4;         { bit 2 - records are encrypted   }
  322.   SIGN_MEMO       =   8;         { bit 3 - memo file exists        }
  323.   SIGN_COMPRESSED =  16;         { bit 4 - file is compressed      }
  324.   SIGN_RECLAIM    =  32;         { bit 5 - reclaim deleted records }
  325.   SIGN_READONLY   =  64;         { bit 6 - file is read only       }
  326.   SIGN_CREATED    =  128;        { bit 7 - file may be created     }
  327.  
  328.   DELFLAG_CLARION =    16;
  329.   EMPCHAR_CLARION =     0;
  330.   DELTA_DAYS      = 36161;       { for fast DATE conversion }
  331.  
  332.   FLD_CL_LONG     = 1;
  333.   FLD_CL_REAL     = 2;
  334.   FLD_CL_STRING   = 3;
  335.   FLD_CL_PICTURE  = 4;
  336.   FLD_CL_BYTE     = 5;
  337.   FLD_CL_SHORT    = 6;
  338.   FLD_CL_GROUP    = 7;
  339.   FLD_CL_DECIMAL  = 8;
  340.  
  341. type
  342.   HDR_CLARION = packed record
  343.   {000} FileSIG  : Word;             { file signature            }
  344.   {002} SFAtr    : Word;             { file attribute and status }
  345.   {004} NumKeys  : Byte;             { number of keys in file      }
  346.   {005} NumRecs  : Integer;          { number of records in file   }
  347.   {009} NumDels  : Integer;          { number of deleted records   }
  348.   {013} NumFlds  : Word;             { number of fields            }
  349.   {015} NumPics  : Word;             { number of pictures          }
  350.   {017} NumArrs  : Word;             { number of array descriptors }
  351.   {019} RecLen   : Word;             { record length (including record header) }
  352.   {021} Offset   : Integer;          { start of data area          }
  353.   {025} LogEOF   : Integer;          { logical end of file         }
  354.   {029} LogBOF   : Integer;          { logical beginning of file   }
  355.   {033} FreeRec  : Integer;          { first usable deleted record }
  356.   {037} RecName  : Char12;           { record name without prefix }
  357.   {049} MemName  : Char12;           { memo name without prefix   }
  358.   {061} FilPrefx : Char3;            { file name prefix           }
  359.   {064} RecPrefx : Char3;            { record name prefix         }
  360.   {067} MemoLen  : Word;             { size of memo         }
  361.   {069} MemoWid  : Word;             { column width of memo }
  362.   {071} LockCont : Integer;          { Lock Count }
  363.   {075} ChgTime  : Integer;          { time of last change }
  364.   {079} ChgDate  : Integer;          { date of last change }
  365.   {083} CheckSum : Word;             { checksum for encrypt }
  366.   end; { rec }
  367.  
  368.   pFLDHDR_CLARION = ^FLDHDR_CLARION;
  369.   FLDHDR_CLARION = packed record
  370.     Hdr  : Byte;                 { record header type and status }
  371.     Ptr  : Integer;              { pointer for next deleted record or memo if active }
  372.   end;
  373.  
  374.   pFLD_CLARION = ^FLD_CLARION;
  375.   FLD_CLARION  = packed record
  376.     FldType : Byte;              { type of field }
  377.     FldName : Char16;            { name of field }
  378.     FOffset : Word;              { offset into record }
  379.     Length  : Word;              { length of field    }
  380.     DecSig  : Byte;              { significance for decimals }
  381.     DecDec  : Byte;              { number of decimal places  }
  382.     ArrNum  : Word;              { array number   }
  383.     PicNum  : Word;              { picture number }
  384.   end;
  385.  
  386.   pKEY_CLARION = ^KEY_CLARION;
  387.   KEY_CLARION = packed record
  388.     NumComps : Byte;             { number of components for key }
  389.     KeyNams  : Char16;           { name of this key    }
  390.     CompType : Byte;             { type of composite   }
  391.     CompLen  : Byte;             { length of composite }
  392.   end;
  393.  
  394.   pKEYITEM_CLARION = ^KEYITEM_CLARION;
  395.   KEYITEM_CLARION = packed record
  396.     FldType : Byte;              { type of field }
  397.     FldNum  : Word;              { field number  }
  398.     ElmOff  : Word;              { record offset of this element }
  399.     ElmLen  : Byte;              { length of element }
  400.   end;
  401.  
  402.   pPICT_CLARION = ^PICT_CLARION;
  403.   PICT_CLARION = packed record
  404.     PicLen : Word;
  405.     PicStr : Char256;
  406.   end;
  407.  
  408.   pARR_CLARION = ^ARR_CLARION;
  409.   ARR_CLARION = packed record
  410.     NumDim : Word;               { dims for current field         }
  411.     TotDim : Word;               { total number of dims for field }
  412.     ElmSiz : Word;               { total size of current field    }
  413.   end;
  414.  
  415.   pARRITEM_CLARION = ^ARRITEM_CLARION;
  416.   ARRITEM_CLARION = packed record
  417.     MaxDim : Word;               { number of dims for array part }
  418.     LenDim : Word;               { length of field }
  419.   end;
  420.  
  421.  
  422. {============================================================================}
  423. {                    PARADOX descriptors                                       }
  424. {============================================================================}
  425.  
  426. const
  427.   FLD_PD_ALPHA          = 1;
  428.   FLD_PD_DATE           = 2;
  429.   FLD_PD_INT16          = 3;
  430.   FLD_PD_INT32          = 4;
  431.   FLD_PD_MONEY          = 5;
  432.   FLD_PD_NUMBER         = 6;
  433.   FLD_PD_LOGICAL        = 9;
  434.   FLD_PD_MEMO           = 12;
  435.   FLD_PD_BINARY         = 13;
  436.   FLD_PD_FMEMO          = 14;
  437.   FLD_PD_OLE            = 15;
  438.   FLD_PD_GRAPHIC        = 16;
  439.   FLD_PD_TIME           = 20;
  440.   FLD_PD_TIMESTAMP      = 21;
  441.   FLD_PD_AUTOINC        = 22;
  442.   FLD_PD_BCD            = 23;
  443.   FLD_PD_BYTES          = 24;
  444.  
  445.   OFFS_FIRSTRECPDX    = 06;
  446.  
  447. type
  448.   HDR_PARADOX = packed record
  449.   {000} RecLen     : Word;        { record length (including record header) }
  450.   {002} HdrLen     : Word;        { header length               }
  451.   {004} Keyed      : Byte;        { flag keyed table or not     }
  452.   {005} BlockSize  : Byte;        { data block size code in kb  }
  453.   {006} NumRecs    : Longint;     { number of records in file   }
  454.   {010} NumBlUsed  : Word;        { number of blocks in use     }
  455.   {012} NumBlTotal : Word;        { number of blocks total      }
  456.   {014} BlFirst    : Word;        { First data block (always 1) }
  457.   {016} BlLast     : Word;        { Last data block             }
  458.   {018} Rsrv1      : array[0..14]of Byte;
  459.   {033} NumFlds    : Byte;        { number of fields            }
  460.   {034} Rsrv2      : Byte;
  461.   {035} NumKeyFlds : Word;        { number of keyed fields      }
  462.   {037} Rsrv3      : array[0..19]of Byte;
  463.   {057} Version    : Byte;        { version of file             }
  464.   {058} Rsrv4      : array[0..14]of Byte;
  465.   {073} AutoInc    : Integer;     { autoincrement value         }
  466.   {077} BlFrstFree : Word;        { first free block            }
  467.   {079} Rsrv5      : array[0..40]of Byte;
  468.   {120} OffsFlds   : Word;        { start of field description array }
  469.   end;
  470.  
  471.   pFLD_PARADOX = ^FLD_PARADOX;
  472.   FLD_PARADOX = packed record
  473.   {000} FldType   : Byte;
  474.   {001} FldSize   : Byte;
  475.   end;{ rec }
  476.  
  477.   pBLOCK_HDR = ^BLOCK_HDR;
  478.   BLOCK_HDR = packed record
  479.   {000} NumNext   : Word;         { Next block number (Zero if last block)      }
  480.   {002} NumPrev   : Word;         { Previous block number (Zero if first block) }
  481.   {004} OffsLast  : SmallInt;     { Offset of last record in block              }
  482.   end;{ rec }
  483.  
  484. {============================================================================}
  485. {                    EJM descriptors                                         }
  486. {============================================================================}
  487.  
  488. const
  489.   EJM_TBLIDENT = 323617801;
  490.  
  491. type
  492.   HDR_EJM = packed record
  493.   {000} Ident      : Longint;     { table identificator         }
  494.   {004} Version    : Byte;        { table version               }
  495.   {005} HdrLen     : Word;        { header length               }
  496.   {007} Keyed      : Byte;        { flag keyed table or not     }
  497.   {008} BlockSize  : Byte;        { data block size code in kb  }
  498.   {009} RecLen     : Longint;     { data record size            }
  499.   {013} NumFlds    : Word;        { number of fields            }
  500.   {015} NumRecs    : Longint;     { number of records           }
  501.   {019} NumDels    : Longint;     { number of deleted records   }
  502.   {023} NumKeyFlds : Word;        { number of keyed fields      }
  503.   {025} AutoInc    : Longint;     { autoincrement value         }
  504.   {029} Encrypted  : Byte;        { encripted value             }
  505.   {030} LangDrv    : array[0..15]of Byte;
  506.   {046} Password   : array[0..15]of Byte;
  507.   {062} Rsrv1      : array[0..15]of Byte;
  508.   {078} Rsrv2      : array[0..6] of Byte;
  509.   end;
  510.  
  511.   pFLD_EJM = ^FLD_EJM;
  512.   FLD_EJM = packed record
  513.   {000} FldType   : Byte;
  514.   {001} FldSize   : Byte;
  515.   {002} FldDec    : Byte;
  516.   end;{ rec }
  517.  
  518.   IFLD_EJM_STATE = (esNORMAL, esDELETED);
  519.  
  520. type
  521.   ALPRESULT = Word;
  522.  
  523. {============================================================================}
  524. {                    Record descriptor                                       }
  525. {============================================================================}
  526.  
  527.  
  528. {============================================================================}
  529. {                    Field descriptor                                        }
  530. {============================================================================}
  531.  
  532.   pFLDDESC = ^FLDDESC;
  533.   FLDDESC = packed record
  534.    iFldNum         : Word;             { Field number (1..n) }
  535.    szName          : Char36;           { Field name }
  536.    iFldType        : ALP_FLDTYPE;     { Field type }
  537.    iSubType        : ALP_SUBTYPE;     { Sub field type }
  538.    iFldSize        : Word;             { Number of Chars, digits etc }
  539.    iFldSig         : Byte;             { significance for decimals }
  540.    iFldDec         : Byte;             { number of decimal places  }
  541.    iOffset         : Word;             { Offset in the record (computed) }
  542.    iPhysLen        : Word;             { Length in bytes (computed) }
  543.    iDataLen        : Word;             { Data length in bytes }
  544.    iUnUsed         : array [0..1] of Word;
  545.   end;
  546.  
  547.   pFldArray = ^IFldArray;
  548.   IFldArray = array[0..0]of FLDDESC;
  549.  
  550. {============================================================================}
  551. {                    Index descriptor                                        }
  552. {============================================================================}
  553.  
  554.   pIdxDesc = ^IdxDesc;
  555.   IdxDesc = packed record
  556.    iIdxNum         : Word;             { Index number (1..n) }
  557.    szName          : Char36;           { Index name }
  558.    iUnUsed         : array [0..1] of Word;
  559.   end;
  560.  
  561.   pIdxArray = ^IIdxArray;
  562.   IIdxArray = array[0..0]of IdxDesc;
  563.  
  564. {============================================================================}
  565. {                    Handle descriptor                                       }
  566. {============================================================================}
  567.   IBuffer      = class;
  568.  
  569.   ALP_HANDLE   = ^_HANDLE;
  570.   _HANDLE  = packed record
  571.    iHandle       : Integer;            { Handle of data file                }
  572.    iTblType      : ALP_TBLTYPE;        { Type of file (dBase, Clarion etc.) }
  573.    iTblDesc      : Char16;             { File descriptor                    }
  574.    iVersion      : Word;               { File version                       }
  575.    iFileName     : ALP_FILENAME;       { File name                          }
  576.    iHdrSize      : Integer;            { Size of header                     }
  577.    iHdrReadBytes : Integer;            { Count of read bytes in buffer      }
  578.    iFilePos      : Integer;            { Cursor position in file            }
  579.    iRecId        : Integer;            { Record index                       }
  580.    iRecPos       : Integer;            { Record position in file            }
  581.    iOffsData     : Integer;            { Offset begin of data               }
  582.    iOffsNames    : Integer;            { Offset begin of field names        }
  583.    iAutoInc      : Integer;            { AutoInc value                      }
  584.    iNumRecs      : Integer;            { Number of records                  }
  585.    iNumDels      : Integer;            { Number of deleted records          }
  586.    iNumFlds      : Word;               { Number of physical fields          }
  587.    iNumIdxs      : Word;               { Number of indexes                  }
  588.    iNumPict      : Word;               { Number of pictures                 }
  589.    iNumArrs      : Word;               { Number of arrays                   }
  590.    iNumBlobs     : Byte;               { Number of blobs                    }
  591.    iRecSize      : Word;               { Physical record size               }
  592.    iMarkSize     : Word;               { Bookmark size                      }
  593.    iDataSize     : Word;               { Data rec size without hdr          }
  594.    iFldHdrSize   : Byte;               { Size of record header              }
  595.    //~~~~~~~~~~~~~
  596.    iBlockPos     : Integer;            { Size of block                      }
  597.    iBlockFirst   : Integer;            { Number of first block              }
  598.    iBlockLast    : Integer;            { Number of last block               }
  599.    iBlockUsed    : Integer;            { Count of used blocks               }
  600.    iBlockTotal   : Integer;            { Total count of blocks              }
  601.    iBlockCurr    : Integer;            { Size of block                      }
  602.    iBlockNext    : Integer;            { Size of block                      }
  603.    iBlockPred    : Integer;            { Size of block                      }
  604.    iBlockSize    : Integer;            { Size of block                      }
  605.    //~~~~~~~~~~~~~
  606.    iBufSize      : Integer;            { Size of buffer                     }
  607.    iReadBytes    : Integer;            { Count bytes in buffer              }
  608.    iCurrRec      : Integer;            { Current record in buffer           }
  609.    iMaxPos       : Integer;            { Max pos record to read             }
  610.    iFooterLen    : Word;               { Size of footer                     }
  611.    mBlocksInBuf  : Integer;            { Max count blocks in buffer         }
  612.    mRecsInBuf    : Integer;            { Max count records in buffer        }
  613.    mRecsInBlock  : Integer;            { Max count records in block         }
  614.    pFIELDS       : pFLDDESC;           { Pointer to fields descriptor       }
  615.    BUFFER        : IBuffer;            { Pointer to buffer                  }
  616.    pHEADER       : pBYTE;              { Pointer to header descriptor       }
  617.   end;
  618.  
  619.  
  620. {============================================================================}
  621. {                   Buffer class                                             }
  622. {============================================================================}
  623.   pRecDesc = ^IRecDesc;
  624.   IRecDesc = packed record
  625.     Ident     : Integer;
  626.     Pos       : Integer;
  627.   end;{ rec }
  628.  
  629.   IBuffer  = class
  630.   private
  631.     pHandle     : ALP_HANDLE;
  632.     //~~~~~~~~~~~~~~
  633.     pMainBuf    : Pointer;
  634.     pIntBuf     : Pointer;
  635.     pCursor     : Pointer;
  636.     //~~~~~~~~~~~~~~
  637.     BufferPos   : Integer;
  638.     BufferSize  : Integer;
  639.     RecordId    : Integer;
  640.     RecordOffs  : Integer;
  641.     RecordSize  : Integer;
  642.     ReadRecs    : Integer;
  643.     Capacity    : Integer;
  644.     function    GetRecPos: Integer;
  645.     function    IsBOF   : Boolean;
  646.     function    IsEOF   : Boolean;
  647.     function    IsEMPTY : Boolean;
  648.   public
  649.     constructor Create(Owner: ALP_HANDLE);
  650.     destructor  Destroy; override;
  651.     procedure   Clear;
  652.     procedure   Delete;
  653.     function    Next  : Boolean;
  654.     function    Prior : Boolean;
  655.     function    First : Boolean;
  656.     function    Last  : Boolean;
  657.     function    Locate(RecPos: Integer): Boolean;
  658.     function    SetToRec(RecId: Integer): Boolean;
  659.     property    BOF   : Boolean read IsBOF;
  660.     property    EOF   : Boolean read IsEOF;
  661.     property    RecPos: Integer read GetRecPos;
  662.   end;
  663.  
  664.  
  665. {============================================================================}
  666. {                      Create/Restructure descriptor                         }
  667. {============================================================================}
  668.  
  669. type
  670.   pCROpType = ^ICROpType;
  671.   ICROpType = (                         { Create/Restruct Operation type }
  672.     crNOOP,
  673.     crADD,                              { Add a new element. }
  674.     crCOPY,                             { Copy an existing element. }
  675.     crMODIFY,                           { Modify an element. }
  676.     crDROP,                             { Removes an element. }
  677.     crREDO,                             { Reconstruct an element. }
  678.     crTABLE,                            { Not used }
  679.     crGROUP,                            { Not used }
  680.     crFAMILY,                           { Not used }
  681.     crDONE,                             { Used internally }
  682.     crDROPADD                           { Used internally }
  683.   );
  684.  
  685.   pCRTblDesc = ^ICRTblDesc;
  686.   ICRTblDesc = packed record            { Create/Restruct Table descr }
  687.     szDbName        : Char256;          { DatabaseName           }
  688.     szTblName       : Char36;           { TableName incl. optional path & ext }
  689.     iTblType        : ALP_TBLTYPE;      { Driver type (optional) }
  690.     szUserName      : Char36;           { User name (if applicable) }
  691.     szPassword      : Char24;           { Password (optional) }
  692.     bProtected      : Boolean;          { Master password supplied in szPassword }
  693.     bPack           : Boolean;          { Pack table (restructure only) }
  694.     iFldCount       : Word;             { Number of field defs supplied }
  695.     pFldOp          : pCROpType;        { Array of field ops }
  696.     pFldDesc        : pFLDDesc;         { Array of field descriptors }
  697.     iIdxCount       : Word;             { Number of index defs supplied }
  698.     pIdxOp          : pCROpType;        { Array of index ops }
  699.     pIdxDesc        : PIdxDesc;         { Array of index descriptors }
  700.     (*
  701.     iSecRecCount    : Word;             { Number of security defs supplied }
  702.     pecrSecOp       : pCROpType;        { Array of security ops }
  703.     psecDesc        : pSECDesc;         { Array of security descriptors }
  704.     iValChkCount    : Word;             { Number of val checks }
  705.     pecrValChkOp    : pCROpType;        { Array of val check ops }
  706.     pvchkDesc       : pVCHKDesc;        { Array of val check descs }
  707.     iRintCount      : Word;             { Number of ref int specs }
  708.     pecrRintOp      : pCROpType;        { Array of ref int ops }
  709.     printDesc       : pRINTDesc;        { Array of ref int specs }
  710.     iOptParams      : Word;             { Number of optional parameters }
  711.     pfldOptParams   : pFLDDesc;         { Array of field descriptors }
  712.     pOptData        : Pointer;          { Optional parameters }
  713.     *)
  714.   end;
  715.  
  716. {===========================================================================}
  717. { ALP FUNCTIONS                                                             }
  718. {===========================================================================}
  719. {                      Table Open, Properties & Structure                   }
  720. {===========================================================================}
  721.  
  722. function ALPOpenTable (                { Open a table }
  723.       FileName      : string;          { Table name or file name }
  724.       bReadOnly     : boolean;         { Read or RW }
  725.       bExclusive    : boolean;         { Excl or Share }
  726. var   Handle        : ALP_HANDLE       { Returns Cursor handle }
  727.    ): ALPResult;
  728.  
  729. function ALPCloseTable (               { Closes cursor }
  730.       Handle        : ALP_HANDLE       { Pntr to Cursor handle }
  731.    ): ALPResult;
  732.  
  733. function ALPTableCreate (              { Create a table        }
  734.       pTblDesc      : pCRTblDesc;      { Table descriptor      }
  735.       bOpen         : boolean;         { Open after create     }
  736. var   Handle        : ALP_HANDLE       { Returns Cursor handle }
  737.    ): ALPResult;
  738.  
  739. function ALPGetFieldDescs (            { Get field descriptions }
  740.       Handle        : ALP_HANDLE;      { Cursor handle }
  741.       pFldDesc      : pFLDDesc         { Array of field descriptors }
  742.    ): ALPResult;
  743.  
  744. {=============================================================================}
  745. {                              Cursor Maintenance                             }
  746. {=============================================================================}
  747.  
  748.  
  749. function ALPSetToBegin (               { Reset cursor to beginning }
  750.       Handle        : ALP_HANDLE       { Cursor handle }
  751.    ): ALPResult;
  752.  
  753. function ALPSetToEnd (                 { Reset cursor to ending }
  754.       Handle        : ALP_HANDLE       { Cursor handle }
  755.    ): ALPResult;
  756.  
  757. function ALPGetBookMark (              { Get a book-mark }
  758.       Handle        : ALP_HANDLE;      { Cursor }
  759.       pBkMark       : Pointer          { Pointer to Book-Mark }
  760.    ): ALPResult;
  761.  
  762. function ALPSetToBookMark (            { Position to a Book-Mark }
  763.       Handle        : ALP_HANDLE;      { Cursor }
  764.       pBkMark       : Pointer          { Pointer to Book-Mark }
  765.    ): ALPResult;
  766.  
  767.  
  768. {============================================================================}
  769. {                      Data Access: Logical Record Level                     }
  770. {============================================================================}
  771.  
  772. function ALPGetNextRecord (            { Find/Get the next record }
  773.       Handle        : ALP_HANDLE;      { Cursor handle }
  774.       pRecBuff      : Pointer;         { Record buffer(client) }
  775.       pRecProps     : pRECProps        { Optional record properties }
  776.    ): ALPResult;
  777.  
  778. function ALPGetPriorRecord (           { Find/Get the prior record }
  779.       Handle        : ALP_HANDLE;      { Cursor handle }
  780.       pRecBuff      : Pointer;         { Record buffer(client) }
  781.       pRecProps     : pRECProps        { Optional record properties }
  782.    ): ALPResult;
  783.  
  784. function ALPGetRecord (                { Gets the current record }
  785.       Handle        : ALP_HANDLE;      { Cursor handle }
  786.       pRecBuff      : Pointer;         { Record buffer(client) }
  787.       pRecProps     : pRECProps        { Optional record properties }
  788.    ): ALPResult;
  789.  
  790. function ALPInitRecord (               { Initialize record area }
  791.       Handle        : ALP_HANDLE;      { Cursor handle }
  792.       pRecBuff      : Pointer          { Record buffer }
  793.    ): ALPResult;
  794.  
  795. function ALPInsertRecord (             { Inserts a new record }
  796.       Handle        : ALP_HANDLE;      { Cursor handle }
  797.       pRecBuff      : Pointer          { New Record (client) }
  798.    ): ALPResult;
  799.  
  800. function ALPModifyRecord (             { Updates the current record }
  801.       Handle        : ALP_HANDLE;      { Cursor handle }
  802.       pRecBuf       : Pointer;         { Modified record }
  803.       bFreeLock     : Boolean          { Free record lock }
  804.    ): ALPResult;
  805.  
  806. function ALPDeleteRecord (             { Deletes the current record }
  807.       Handle        : ALP_HANDLE;      { Cursor handle }
  808.       pRecBuf       : Pointer          { Copy of deleted record }
  809.    ): ALPResult;
  810.  
  811. function ALPReadBlock (                { Read a block of records }
  812.       Handle        : ALP_HANDLE;      { Cursor handle }
  813. var   iRecords      : Longint;         { Number of records to read }
  814.       pBuf          : Pointer          { Buffer }
  815.    ): ALPResult;
  816.  
  817. function ALPWriteBlock (               { Write a block of records }
  818.       Handle        : ALP_HANDLE;      { Cursor handle }
  819. var   iRecords      : Longint;         { Number of records to write/written }
  820.       pBuf          : Pointer          { Buffer }
  821.    ): ALPResult;
  822.  
  823. function ALPAppendRecord (             { Inserts a new record }
  824.       Handle        : ALP_HANDLE;      { Cursor handle }
  825.       pRecBuff      : Pointer          { New Record (client) }
  826.    ): ALPResult;
  827.  
  828. function ALPGetRecordCount (           { Get the current number of records }
  829.       Handle        : ALP_HANDLE;      { Cursor handle }
  830. var   iRecCount     : Longint          { Number of records }
  831.    ): ALPResult;
  832.  
  833. {============================================================================}
  834. {                            Field Level Access                              }
  835. {============================================================================}
  836.  
  837. function ALPGetField (                 { Get Field value }
  838.       Handle        : ALP_HANDLE;      { Cursor }
  839.       iField        : Word;            { Field # (1..n) }
  840.       pRecBuff      : Pointer;         { Record buffer }
  841.       pDest         : Pointer;         { Destination field buffer }
  842. var   bBlank        : Boolean          { Returned : is field blank }
  843.    ): ALPResult;
  844.  
  845. function ALPPutField (                 { Put a value in the record buffer }
  846.       Handle        : ALP_HANDLE;      { Cursor }
  847.       iField        : Word;            { Field # (1..n) }
  848.       pRecBuff      : Pointer;         { Record buffer }
  849.       pSrc          : Pointer          { Source field buffer }
  850.    ): ALPResult;
  851.  
  852.  
  853. {============================================================================}
  854. {                            Formatting data                                 }
  855. {============================================================================}
  856.  
  857. function ALPDataToIDE (                { Get a formatted value }
  858.       Handle        : ALP_HANDLE;      { Cursor }
  859.       pFld          : pFldDesc;        { Field pointer }
  860.       pBuff         : Pointer          { Value buffer }
  861.    ): ALPResult;
  862.  
  863. function ALPIDEToData (                { Set a formatted value }
  864.       Handle        : ALP_HANDLE;      { Cursor }
  865.       pFld          : pFldDesc;        { Field pointer }
  866.       pBuff         : Pointer          { Value buffer }
  867.    ): ALPResult;
  868.  
  869.  
  870.  
  871. implementation
  872.  
  873.  
  874.  
  875. {============================================================================}
  876. {                            Utilites                                        }
  877. {============================================================================}
  878.  
  879. procedure _CalcHandleProps (           { Set handle properties           }
  880.       Handle        : ALP_HANDLE       { Cursor                          }
  881.    );
  882. var
  883.  BlockCount  : Integer;
  884. begin
  885.  if( Handle^.iTblType in [ttPARADOX3..ttPARADOX7])then
  886.  begin
  887.   Handle^.mBlocksInBuf := ( Handle^.iBufSize div Handle^.iBlockSize );
  888.   Handle^.mRecsInBlock := ( Handle^.iBlockSize - SizeOf(BLOCK_HDR))div Handle^.iRecSize;
  889.   BlockCount  := ( Handle^.iBufSize div Handle^.iBlockSize );
  890.   Handle^.mRecsInBuf   := ( BlockCount * Handle^.mRecsInBlock );
  891.  end{ if }else
  892.  begin
  893.   Handle^.mBlocksInBuf := 1;
  894.   Handle^.mRecsInBlock := ( Handle^.iBlockSize div Handle^.iRecSize );
  895.   Handle^.mRecsInBuf   := Handle^.mRecsInBlock;
  896.   BlockCount := ( Handle^.iNumRecs div Handle^.mRecsInBlock );
  897.   if( Handle^.iNumRecs > BlockCount * Handle^.mRecsInBlock )then
  898.   inc( BlockCount );
  899.   Handle^.iBlockTotal  := BlockCount;
  900.   Handle^.iBlockFirst  := 1;
  901.   Handle^.iBlockLast   := BlockCount;
  902.   Handle^.iBlockUsed   := BlockCount;
  903.   Handle^.iBlockUsed   := BlockCount;
  904.  end;{ else }
  905. end;{ proc }
  906.  
  907. procedure _SetFldDataLen (                 { Get a field data length         }
  908.       pFld          : pFldDesc             { Pointer to field structure      }
  909.    );
  910. begin
  911.  pFld^.iDataLen := ALP_FLDSIZES[pFld^.iFldType];
  912.  if( pFld^.iDataLen = 0 )then
  913.  pFld^.iDataLen := pFld^.iPhysLen;
  914.  if( pFld^.iFldType = uftSmallInt )and
  915.    ( pFld^.iSubType = sftByte )then
  916.  begin
  917.   pFld^.iPhysLen := 1;
  918.   pFld^.iDataLen := 2;
  919.  end;
  920. end;{ proc }
  921.  
  922. procedure _WriteParam (                  { Write param to header }
  923.       Handle        : ALP_HANDLE;        { Cursor }
  924.       Param         : Word               { Param ident }
  925.    );
  926. var
  927.  PrmSize: Integer;
  928.  PrmOffs: Integer;
  929.  PrmBuf : Pointer;
  930. begin
  931.  PrmOffs := -1;
  932.  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  933.  if( Handle^.iTblType in ALP_PDXTYPES )then
  934.  begin
  935.   case( Param )of
  936.   PRM_NUMRECS: begin
  937.     PrmSize := SizeOf(Integer);
  938.     GetMem(PrmBuf, PrmSize);
  939.     Integer(PrmBuf^) := Handle^.iNumRecs;
  940.     PrmOffs := 6;
  941.    end;{ NumRecs }
  942.   PRM_NUMFLDS: begin
  943.     PrmSize := SizeOf(Byte);
  944.     GetMem(PrmBuf, PrmSize);
  945.     Byte(PrmBuf^) := Handle^.iNumFlds;
  946.     PrmOffs := 33;
  947.    end;{ NumRecs }
  948.   PRM_RECSIZE: begin
  949.     PrmSize := SizeOf(Word);
  950.     GetMem(PrmBuf, PrmSize);
  951.     Word(PrmBuf^) := Handle^.iRecSize;
  952.     PrmOffs := 0;
  953.    end;{ NumRecs }
  954.   end;{ case }
  955.  end else
  956.  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  957.  if( Handle^.iTblType in ALP_CLARIONTYPES )then
  958.  begin
  959.   case( Param )of
  960.   PRM_NUMRECS: begin
  961.     PrmSize := SizeOf(Integer);
  962.     GetMem(PrmBuf, PrmSize);
  963.     Integer(PrmBuf^) := Handle^.iNumRecs;
  964.     PrmOffs := 5;
  965.    end;{ NumRecs }
  966.   PRM_NUMDELS: begin
  967.     PrmSize := SizeOf(Integer);
  968.     GetMem(PrmBuf, PrmSize);
  969.     Integer(PrmBuf^) := Handle^.iNumDels;
  970.     PrmOffs := 9;
  971.    end;{ NumRecs }
  972.   PRM_NUMFLDS: begin
  973.     PrmSize := SizeOf(Word);
  974.     GetMem(PrmBuf, PrmSize);
  975.     Word(PrmBuf^) := Handle^.iNumFlds;
  976.     PrmOffs := 13;
  977.    end;{ NumRecs }
  978.   PRM_RECSIZE: begin
  979.     PrmSize := SizeOf(Word);
  980.     GetMem(PrmBuf, PrmSize);
  981.     Word(PrmBuf^) := Handle^.iRecSize;
  982.     PrmOffs := 19;
  983.    end;{ NumRecs }
  984.   end;{ case }
  985.  end else
  986.  if( Handle^.iTblType in ALP_DBASETYPES )then
  987.  begin
  988.   case( Param )of
  989.   PRM_NUMRECS: begin
  990.     PrmSize := SizeOf(Integer);
  991.     GetMem(PrmBuf, PrmSize);
  992.     Integer(PrmBuf^) := Handle^.iNumRecs;
  993.     PrmOffs := 2;
  994.    end;{ NumRecs }
  995.   PRM_RECSIZE: begin
  996.     PrmSize := SizeOf(Word);
  997.     GetMem(PrmBuf, PrmSize);
  998.     Word(PrmBuf^) := Handle^.iRecSize;
  999.     PrmOffs := 8;
  1000.    end;{ NumRecs }
  1001.   end;{ case }
  1002.  end;
  1003.  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1004.  if( PrmOffs > -1 )then
  1005.  begin
  1006.   try
  1007.    FileSeek(Handle^.iHandle, PrmOffs, SEEK_FROMBEGIN);
  1008.    FileWrite(Handle^.iHandle, PrmBuf^, PrmSize);
  1009.   finally
  1010.    FreeMem(PrmBuf, PrmSize);
  1011.   end;{ fin }
  1012.  end;{ if }
  1013. end;
  1014.  
  1015. procedure _SetRecId (                    { Set current record }
  1016.       Handle        : ALP_HANDLE         { Cursor }
  1017.    );
  1018. var
  1019.  TotalRecs   : Integer;
  1020.  RecsInBlock : Integer;
  1021.  BlockOffs   : Integer;
  1022.  BlockCount  : Integer;
  1023. begin
  1024.  if( Handle^.iTblType in [ttPARADOX3..ttPARADOX7])then
  1025.  begin
  1026.   RecsInBlock := ((Handle^.iBlockSize - SizeOf(BLOCK_HDR))div Handle^.iRecSize );
  1027.   BlockCount  := ((Handle^.iRecPos - Handle^.iOffsData )div Handle^.iBlockSize );
  1028.   TotalRecs   := ( RecsInBlock * BlockCount );
  1029.   BlockOffs   := ( Handle^.iOffsData + ( Handle^.iBlockSize * BlockCount ));
  1030.   Handle^.iRecId := ((Handle^.iRecPos - BlockOffs - SizeOf(BLOCK_HDR))div Handle^.iRecSize + TotalRecs + 1 );
  1031.  end{ if }else
  1032.  begin
  1033.   Handle^.iRecId := ( Handle^.iRecPos - Handle^.iOffsData )div Handle^.iRecSize + 1;
  1034.  end;{ else }
  1035. end;{ proc }
  1036.  
  1037. function _GetFieldType (                  { Get a field type }
  1038.       Handle        : ALP_HANDLE;         { Handle of Table  }
  1039.       FldType       : Byte;               { Original field type }
  1040.       FldSize       : Word;               { Original field size }
  1041.       FldDec        : Byte                { Original field dec }
  1042.    ): ALP_FLDTYPE;
  1043. begin
  1044.   case( Handle^.iTBLTYPE )of
  1045.   //~~ dbase types ~~~~~~~~~~~~~~~~~~~~~
  1046.   ttDBASE3..ttDBASE7,
  1047.   ttFOXPRO1..ttFOXPRO4:
  1048.     case( FldType )of
  1049.     FLD_DB_STRING  : Result := uftString;
  1050.     FLD_DB_DATE    : Result := uftDate;
  1051.     FLD_DB_BOOLEAN : Result := uftBoolean;
  1052.     FLD_DB_MEMO    : Result := uftMemo;
  1053.     FLD_DB_NUMBER, FLD_DB_FLOAT:
  1054.      case( FldSize )of
  1055.      06: if( FldDec = 0 )then
  1056.          Result := uftSmallint else
  1057.          Result := uftFloat;
  1058.      11: if( FldDec = 0 )then
  1059.          Result := uftInteger else
  1060.          Result := uftFloat;
  1061.      else
  1062.       Result := uftFloat;
  1063.      end;{ case }
  1064.     end;{ case }
  1065.   //~~ clarion types ~~~~~~~~~~~~~~~~~~~~~
  1066.   ttCLARION1..ttCLARION2:
  1067.     case( FldType )of
  1068.     FLD_CL_LONG     : Result := uftInteger;
  1069.     FLD_CL_REAL     : Result := uftFloat;
  1070.     FLD_CL_STRING   : Result := uftString;
  1071.     FLD_CL_PICTURE  : Result := uftGraphic;
  1072.     FLD_CL_BYTE     : Result := uftSmallint;
  1073.     FLD_CL_SHORT    : Result := uftSmallInt;
  1074.     FLD_CL_GROUP    : Result := uftArray;
  1075.     FLD_CL_DECIMAL  : Result := uftFloat;
  1076.     end;{ case }
  1077.   //~~ paradox types ~~~~~~~~~~~~~~~~~~~~~
  1078.   ttPARADOX3..ttPARADOX7:
  1079.     case( FldType )of
  1080.     FLD_PD_ALPHA    : Result := uftString;
  1081.     FLD_PD_DATE     : Result := uftDate;
  1082.     FLD_PD_INT16    : Result := uftSmallint;
  1083.     FLD_PD_INT32    : Result := uftInteger;
  1084.     FLD_PD_MONEY    : Result := uftCurrency;
  1085.     FLD_PD_NUMBER   : Result := uftFloat;
  1086.     FLD_PD_LOGICAL  : Result := uftBoolean;
  1087.     FLD_PD_MEMO     : Result := uftMemo;
  1088.     FLD_PD_BINARY   : Result := uftBlob;
  1089.     FLD_PD_FMEMO    : Result := uftFmtMemo;
  1090.     FLD_PD_OLE      : Result := uftParadoxOle;
  1091.     FLD_PD_GRAPHIC  : Result := uftGraphic;
  1092.     FLD_PD_TIME     : Result := uftTime;
  1093.     FLD_PD_TIMESTAMP: Result := uftDateTime;
  1094.     FLD_PD_AUTOINC  : Result := uftAutoInc;
  1095.     FLD_PD_BCD      : Result := uftBCD;
  1096.     FLD_PD_BYTES    : Result := uftBytes;
  1097.     end;{ case }
  1098.   end;{ case }
  1099. end;
  1100.  
  1101. function _IsBOF (                        { Get begin flag }
  1102.       Handle        : ALP_HANDLE         { Handle of Table  }
  1103.    ): Boolean;
  1104. begin
  1105.  Result := ( Handle^.iRecId < 1 );
  1106. end;{ func }
  1107.  
  1108. function _IsEOF (                        { Get end flag }
  1109.       Handle        : ALP_HANDLE         { Handle of Table  }
  1110.    ): Boolean;
  1111. begin
  1112.   Result := ( Handle^.iRecId > Handle^.iNumRecs );
  1113. end;{ func }
  1114.  
  1115. function _IsBlank (                      { Analize field value }
  1116.       Handle        : ALP_HANDLE;        { Cursor }
  1117.       pFld          : pFldDesc;          { Field pointer }
  1118.       pBuff         : Pointer            { Value buffer }
  1119.    ): Boolean;
  1120. var
  1121.  I       : Integer;
  1122.  pPos    : pByte;
  1123.  EmpChar : Byte;
  1124. begin
  1125.  case( Handle^.iTblType )of
  1126.  ttDBASE3..ttDBASE7,
  1127.  ttFOXPRO1..ttFOXPRO4:
  1128.   EmpChar := EMPCHAR_DBASE;
  1129.  ttCLARION1..ttCLARION2,
  1130.  ttPARADOX3..ttPARADOX7:
  1131.   EmpChar := EMPCHAR_CLARION;
  1132.  end;{ case }
  1133.  
  1134.  pPos   := pBuff;
  1135.  Result := True;
  1136.  for I := 1 to pFld^.iPhysLen do
  1137.  begin
  1138.   if( pPos^ <> EmpChar )then
  1139.   begin
  1140.    Result := False;
  1141.    Break;
  1142.   end;{ if }
  1143.   inc(pPos);
  1144.  end;{ for }
  1145. end;{ func }
  1146.  
  1147.  
  1148. procedure _SetBuffer (                  { Set buffer }
  1149.       Handle        : ALP_HANDLE        { Cursor }
  1150.    );
  1151. var
  1152.  I           : Integer;
  1153.  pPos1       : pBYTE;
  1154.  pPos2       : pBYTE;
  1155.  pBlHdr      : pBLOCK_HDR;
  1156.  RecsInBlock : Integer;
  1157. begin
  1158.  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1159.  pPos1  := Handle^.BUFFER.pIntBuf;
  1160.  pPos2  := Handle^.BUFFER.pMainBuf;
  1161.  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1162.  Handle^.BUFFER.BufferPos := Handle^.iBlockPos;
  1163.  Handle^.iBlockCurr := (Handle^.iBlockPos - Handle^.iOffsData )div Handle^.iBlockSize + 1;
  1164.  Handle^.BUFFER.ReadRecs  := 0;
  1165.  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1166.  if( Handle^.iTblType in ALP_PDXTYPES )then
  1167.  begin
  1168.   pBlHdr := Handle^.BUFFER.pINTBUF;
  1169.   inc(pPos1, SizeOf(BLOCK_HDR));
  1170.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1171.   Handle^.iBlockNext := pBlHdr^.NumNext;
  1172.   Handle^.iBlockPred := pBlHdr^.NumPrev;
  1173.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1174.   if( pBlHdr^.OffsLast < 0 )then
  1175.   RecsInBlock := 0 else
  1176.   RecsInBlock := (( pBlHdr^.OffsLast + Handle^.iRecSize) div Handle^.iRecSize );
  1177.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1178.   _Move(pPos1, pPos2, RecsInBlock * Handle^.iRecSize);
  1179.   inc( Handle^.BUFFER.ReadRecs, RecsInBlock );
  1180.  end else
  1181.  begin
  1182.   Handle^.iBlockNext := Handle^.iBlockCurr + 1;
  1183.   Handle^.iBlockPred := Handle^.iBlockCurr - 1;
  1184.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1185.   RecsInBlock := Handle^.iReadBytes div Handle^.iRecSize;
  1186.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1187.   _Move(pPos1, pPos2, RecsInBlock * Handle^.iRecSize);
  1188.   inc( Handle^.BUFFER.ReadRecs, RecsInBlock );
  1189.  end;{ else }
  1190.  Handle^.BUFFER.First;
  1191. end;{ func }
  1192.  
  1193. function _GetBlockPos (                  { Get block position       }
  1194.       Handle        : ALP_HANDLE;        { Handle of Table          }
  1195.       BlockId       : Integer            { Block number             }
  1196.    ): Integer;
  1197. begin
  1198.  if( Handle^.iTblType in ALP_PDXTYPES)then
  1199.  begin
  1200.   Result := Handle^.iOffsData + (BlockId - 1) * Handle^.iBlockSize;
  1201.  end{ if }else
  1202.  begin
  1203.   Result := Handle^.iOffsData + (BlockId - 1) * Handle^.iBlockSize;
  1204.  end;{ else }
  1205. end;{ func }
  1206.  
  1207. function _ReadBlockHdr (                 { Write block hdr          }
  1208.       Handle        : ALP_HANDLE;        { Cursor                   }
  1209.       BlockId       : Integer;           { Block ident              }
  1210.       pBlHdr        : pBLOCK_HDR         { Header descriptor        }
  1211.    ): ALPRESULT;
  1212. var
  1213.  E     : Integer;
  1214.  BlPos : Integer;
  1215. begin
  1216.  if( BlockId >= 1 )and( BlockId <= Handle^.iBlockLast )then
  1217.  begin
  1218.   BlPos := _GetBlockPos( Handle, BlockId );
  1219.   E := FileSeek(Handle^.iHandle, BlPos, SEEK_FROMBEGIN);
  1220.   if( E = -1 )then Result := ERR_CANNOTSEEK else
  1221.   begin
  1222.    E := FileRead(Handle^.iHandle, pBlHdr^, SizeOf(BLOCK_HDR));
  1223.    if( E = -1 )then Result := ERR_CANNOTREADFILE else
  1224.    Result := ERR_NONE;
  1225.   end;{ if }
  1226.  end;{ if }
  1227. end;
  1228.  
  1229. function _WriteBlockHdr (                { Write block hdr          }
  1230.       Handle        : ALP_HANDLE;        { Cursor                   }
  1231.       BlockId       : Integer;           { Block ident              }
  1232.       pBlHdr        : pBLOCK_HDR         { Header descriptor        }
  1233.    ): ALPRESULT;
  1234. var
  1235.  E     : Integer;
  1236.  BlPos : Integer;
  1237. begin
  1238.  if( BlockId >= 1 )and( BlockId <= Handle^.iBlockLast )then
  1239.  begin
  1240.   BlPos := _GetBlockPos( Handle, BlockId );
  1241.   E := FileSeek(Handle^.iHandle, BlPos, SEEK_FROMBEGIN);
  1242.   if( E = -1 )then Result := ERR_CANNOTSEEK else
  1243.   begin
  1244.    E := FileWrite(Handle^.iHandle, pBlHdr^, SizeOf(BLOCK_HDR));
  1245.    if( E = -1 )then Result := ERR_CANNOTWRITEFILE else
  1246.    Result := ERR_NONE;
  1247.   end;{ if }
  1248.  end;{ if }
  1249. end;
  1250.  
  1251.  
  1252. {===========================================================================}
  1253. { BUFFER FUNCTIONS & PROCEDURES                                             }
  1254. {===========================================================================}
  1255.  
  1256. { IBuffer }
  1257.  
  1258. constructor IBuffer.Create(Owner: ALP_HANDLE);
  1259. begin
  1260.  BufferSize  := Owner^.iBufSize;
  1261.  RecordId    := 1;
  1262.  RecordSize  := Owner^.iRecSize;
  1263.  ReadRecs    := 0;
  1264.  Capacity    := BufferSize div RecordSize;
  1265.  if( Owner^.iTblType in ALP_PDXTYPES )then
  1266.  RecordOffs  := SizeOf(BLOCK_HDR)else
  1267.  RecordOffs  := 0;
  1268.  //~~~~~~~~~~~~~~~~~~~~~~
  1269.  pMainBuf    := AllocMem(BufferSize);
  1270.  pIntBuf     := AllocMem(BufferSize);
  1271.  pCursor     := pMainBuf;
  1272.  //~~~~~~~~~~~~~~~~~~~~~~
  1273.  pHandle     := Owner;
  1274. end;
  1275.  
  1276. destructor IBuffer.Destroy;
  1277. begin
  1278.  FreeMem(pMainBuf, BufferSize);
  1279.  FreeMem(pIntBuf, BufferSize);
  1280. end;
  1281.  
  1282. function IBuffer.First: Boolean;
  1283. begin
  1284.  RecordId := 1;
  1285.  pCursor  := pMainBuf;
  1286.  Result   := True;
  1287. end;
  1288.  
  1289. function IBuffer.Last: Boolean;
  1290. begin
  1291.  RecordId := ReadRecs;
  1292.  Longint(pCursor) := Longint(pMainBuf) + (ReadRecs - 1)* RecordSize;
  1293.  Result   := True;
  1294. end;
  1295.  
  1296. function IBuffer.IsBOF: Boolean;
  1297. begin
  1298.  Result := ( RecordId <= 1 )or( ReadRecs = 0 );
  1299. end;
  1300.  
  1301. function IBuffer.IsEOF: Boolean;
  1302. begin
  1303.  Result := ( RecordId >= ReadRecs )or( ReadRecs = 0 );
  1304. end;
  1305.  
  1306. function IBuffer.Next: Boolean;
  1307. begin
  1308.  Result := not( IsEOF );
  1309.  if( Result )then
  1310.  begin
  1311.   inc( RecordId );
  1312.   Longint(pCursor) := Longint(pMainBuf) + (RecordId - 1)* RecordSize;
  1313.  end;{ if }
  1314. end;
  1315.  
  1316. function IBuffer.Prior: Boolean;
  1317. begin
  1318.  Result := not( IsBOF );
  1319.  if( Result )then
  1320.  begin
  1321.   dec( RecordId );
  1322.   Longint(pCursor) := Longint(pMainBuf) + (RecordId - 1)* RecordSize;
  1323.  end;{ if }
  1324. end;
  1325.  
  1326. procedure IBuffer.Clear;
  1327. begin
  1328.  RecordId := 0;
  1329.  ReadRecs := 0;
  1330. end;
  1331.  
  1332. procedure IBuffer.Delete;
  1333. var
  1334.  pPos1 : pBYTE;
  1335.  pPos2 : pBYTE;
  1336.  pBlock: pBLOCK_HDR;
  1337. begin
  1338.  if( ReadRecs > 0 )then
  1339.  begin
  1340.   pPos1 := pCursor;
  1341.   if( pHandle^.iTblType in ALP_PDXTYPES )then
  1342.   begin
  1343.    pBlock := pIntBuf;
  1344.    if( RecordId < ReadRecs )then
  1345.    begin
  1346.     { move main buffer }
  1347.     pPos2 := pCursor;
  1348.     inc(pPos2, pHandle^.iRecSize);
  1349.     _Move(pPos2, pPos1, (ReadRecs - RecordId)* pHandle^.iRecSize);
  1350.     { move internal buffer }
  1351.     pPos1  := pIntBuf;
  1352.     inc(pPos1, SizeOf(BLOCK_HDR)+ (RecordId - 1)*pHandle^.iRecSize);
  1353.     pPos2 := pPos1;
  1354.     inc(pPos2, pHandle^.iRecSize);
  1355.     _Move(pPos2, pPos1, (ReadRecs - RecordId)* pHandle^.iRecSize);
  1356.    end{ if }else
  1357.    RecordId := ReadRecs - 1;
  1358.    { calc block hdr }
  1359.    dec(pBlock^.OffsLast, pHandle^.iRecSize);
  1360.    dec(ReadRecs);
  1361.   end{ if }else
  1362.   begin
  1363.    if( pHandle^.iTblType in ALP_CLARIONTYPES )then
  1364.    pPos1^ := DELFLAG_CLARION else
  1365.    if( pHandle^.iTblType in ALP_DBASETYPES )then
  1366.    pPos1^ := DELFLAG_DBASE;
  1367.   end;
  1368.  end;{ if }
  1369. end;
  1370.  
  1371. function IBuffer.SetToRec(RecId: Integer): Boolean;
  1372. begin
  1373.  Result := ( RecId >= 1 )and( RecId <= ReadRecs );
  1374.  if( Result )then
  1375.  begin
  1376.   RecordId := RecId;
  1377.   Longint(pCursor) := Longint(pMainBuf) + (RecordId - 1)* RecordSize;
  1378.  end;{ if }
  1379. end;
  1380.  
  1381. function IBuffer.Locate(RecPos: Integer): Boolean;
  1382. begin
  1383.  if( PHandle^.iTblType in ALP_PDXTYPES )then
  1384.   Result := ( RecPos >= BufferPos + SizeOf(BLOCK_HDR))and
  1385.             ( RecPos <= BufferPos + SizeOf(BLOCK_HDR) + (ReadRecs - 1)* PHandle^.iRecSize )
  1386.  else
  1387.   Result := ( RecPos >= BufferPos )and( RecPos <= BufferPos + (ReadRecs - 1)* PHandle^.iRecSize );
  1388.  
  1389.  if( Result )then
  1390.  begin
  1391.   RecordId := (RecPos - BufferPos - RecordOffs)div RecordSize + 1;
  1392.   Longint(pCursor) := Longint(pMainBuf) + (RecordId - 1)* RecordSize;
  1393.  end;{ if }
  1394. end;
  1395.  
  1396. function IBuffer.GetRecPos: Integer;
  1397. begin
  1398.  Result := BufferPos + RecordOffs + (RecordId - 1) * RecordSize;
  1399. end;
  1400.  
  1401. function IBuffer.IsEMPTY: Boolean;
  1402. begin
  1403.  Result := ReadRecs = 0;
  1404. end;
  1405.  
  1406.  
  1407.  
  1408.  
  1409.  
  1410.  
  1411.  
  1412. {===========================================================================}
  1413. {                      Table Open, Properties & Structure                   }
  1414. {===========================================================================}
  1415.  
  1416. function ALPOpenTable (                { Open a table }
  1417.       FileName      : string;           { Table name or file name }
  1418.       bReadOnly     : boolean;          { Read or RW }
  1419.       bExclusive    : boolean;          { Excl or Share }
  1420. var   Handle        : ALP_HANDLE       { Returns Cursor handle }
  1421.    ): ALPResult;
  1422. const
  1423.  //(('FF','FT'),('TF','TT'));
  1424.  OpenArray: array[boolean, boolean]of Integer =
  1425.             ((fmOpenReadWrite or fmShareDenyNone,
  1426.               fmOpenReadWrite or fmShareExclusive),
  1427.              (fmOpenRead or fmShareDenyNone,
  1428.               fmOpenRead or fmShareExclusive));
  1429. label
  1430.  LB_UNSUPPORT;
  1431. var
  1432.  I, E, F   : Integer;
  1433.  X         : ALP_TBLTYPE;
  1434.  Found     : Boolean;
  1435.  OpenMode  : Integer;
  1436.  { DBASE }
  1437.  H_DBASE   : HDR_DBASE;
  1438.  pFDB3     : pFLD_DBASE3;
  1439.  pFDB5     : pFLD_DBASE5;
  1440.  { CLARION }
  1441.  H_CLR     : HDR_CLARION;
  1442.  pFCLR     : pFLD_CLARION;
  1443.  pKCLR     : pKEY_CLARION;
  1444.  pKICLR    : pKEYITEM_CLARION;
  1445.  pPCLR     : pPICT_CLARION;
  1446.  pACLR     : pARR_CLARION;
  1447.  pAICLR    : pARRITEM_CLARION;
  1448.  { PARADOX }
  1449.  H_PDX     : HDR_PARADOX;
  1450.  pFPDX     : pFLD_PARADOX;
  1451.  { EJM }
  1452.  H_EJM     : HDR_EJM;
  1453.  pFEJM     : pFLD_EJM;
  1454.  
  1455.  FldOffs   : Word;
  1456.  
  1457.  pFLD      : pFLDDesc;
  1458.  pPOS      : pBYTE;
  1459.  pSTEP     : pBYTE;
  1460. begin
  1461.  Result := ERR_NONE;
  1462.  if( Handle <> nil )then  { Check valid handle }
  1463.  Result := ERR_INVALIDHANDLE else
  1464.  begin
  1465.   OpenMode := OpenArray[bReadOnly, bExclusive];
  1466.   { Open file }
  1467.   E := FileOpen(FileName, OpenMode);
  1468.   if( E = -1 )then Result := ERR_CANNOTOPENFILE else
  1469.   begin
  1470.    Handle := AllocMem(SizeOf(_HANDLE));
  1471.    Handle^.iHANDLE := E;
  1472.    { Set to begin of file }
  1473.    E := FileSeek(Handle^.iHANDLE, 0, SEEK_FROMBEGIN);
  1474.    if( E = -1 )then
  1475.    begin
  1476.     Result := ERR_CANNOTSEEK;
  1477.     FileClose(Handle^.iHANDLE);
  1478.     FreeMem(Handle, SizeOf(_HANDLE));
  1479.     Handle := nil;
  1480.    end else begin
  1481.     { Get mem for header }
  1482.     Handle^.pHEADER   := AllocMem(MAX_HEADERBUFSIZE);
  1483.     Handle^.iMarkSize := SizeOf(IBookMark);
  1484.     Handle^.iFilePos  := E;
  1485.     E := FileRead(Handle^.iHANDLE, Handle^.pHEADER^, MAX_HEADERBUFSIZE);
  1486.     if( E = -1 )then
  1487.     begin
  1488.      Result := ERR_CANNOTREADFILE;
  1489.      FileClose(Handle^.iHANDLE);
  1490.      FreeMem(Handle^.pHEADER, MAX_HEADERBUFSIZE);
  1491.      FreeMem(Handle, SizeOf(_HANDLE));
  1492.      Handle := nil;
  1493.     end else begin
  1494.      inc(Handle^.iFilePos, E);
  1495.      Handle^.iHdrReadBytes := E;
  1496.      { GETTING FILE FORMAT }
  1497.      pPOS := Handle^.pHEADER;
  1498.      for X := Low(ALP_TBLTYPE)to High(ALP_TBLTYPE)do
  1499.      begin
  1500.       Found := False;
  1501.       for F := 0 to TBLIDENT[X].iCount - 1 do
  1502.       begin
  1503.        pPOS := Handle^.pHEADER;
  1504.        inc(pPOS, TBLIDENT[X].iIdent[F].iOffs);
  1505.        Found := (pPOS^ in TBLIDENT[X].iIdent[F].iVals);
  1506.        if( not Found )then Break;
  1507.       end;{ for }
  1508.       if( Found )then
  1509.       begin
  1510.        Handle^.iTBLTYPE := X;
  1511.        StrPCopy(Handle^.iTBLDESC, TBLIDENT[X].iName);
  1512.        Break;
  1513.       end;{ if }
  1514.      end;{ for }
  1515.  
  1516.      { UNKNOWN FILE FORMAT }
  1517.      if( Handle^.iTBLTYPE = ttUNKNOWN )then
  1518.      begin
  1519.       Result := ERR_UNSUPPORTEDFILE;
  1520.       FileClose(Handle^.iHANDLE);
  1521.       FreeMem(Handle^.pHEADER, MAX_HEADERBUFSIZE);
  1522.       FreeMem(Handle, SizeOf(_HANDLE));
  1523.       Handle := nil;
  1524.      end else
  1525.      begin
  1526.       { LOAD DESCRIPTORS }
  1527.       case( Handle^.iTBLTYPE )of
  1528.  
  1529.  
  1530.       ttDBASE3..ttDBASE7:
  1531.        begin
  1532.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1533.         _Move(Handle^.pHEADER, @H_DBASE, SizeOf(HDR_DBASE));
  1534.         Handle^.iHdrSize    := H_DBASE.HdrLen;
  1535.         Handle^.iRecSize    := H_DBASE.recLen;
  1536.         Handle^.iDataSize   := H_DBASE.recLen - SizeOf(FLDHDR_DBASE);
  1537.         Handle^.iFldHdrSize := SizeOf(FLDHDR_DBASE);
  1538.         Handle^.iNumRecs    := H_DBASE.numRecs;
  1539.         Handle^.iOffsData   := H_DBASE.HdrLen;
  1540.         Handle^.iBufSize    := ( MAX_BUFFERSIZE div Handle^.iRecSize ) * Handle^.iRecSize;
  1541.         Handle^.iBlockSize  := Handle^.iBufSize;
  1542.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1543.         pPOS := Handle^.pHEADER;
  1544.         inc(pPOS, SizeOf(HDR_DBASE));
  1545.         case( Handle^.iTBLTYPE )of
  1546.         ttDBASE3..ttDBASE4:
  1547.          begin
  1548.           pFDB3 := pFLD_DBASE3(pPOS);
  1549.          end;{ ttDBASE3 }
  1550.         ttDBASE5..ttDBASE7:
  1551.          begin
  1552.           inc(pPOS, SizeOf(HDR_DBASEADD));
  1553.           pFDB5 := pFLD_DBASE5(pPOS);
  1554.          end;{ ttDBASE4 }
  1555.         end;{ case }
  1556.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1557.         E := 0;
  1558.         while( Char(pPOS^)<> #$0D )do
  1559.         begin
  1560.          inc(Handle^.iNumFlds);
  1561.          ReallocMem(Handle^.pFIELDS, SizeOf(FLDDesc) * Handle^.iNumFlds);
  1562.          pFLD := Handle^.pFIELDS;
  1563.          inc(pFLD, Handle^.iNumFlds - 1);
  1564.          { read field properties }
  1565.          pFLD^.iFldNum := Handle^.iNumFlds;
  1566.          case( Handle^.iTBLTYPE )of
  1567.          ttDBASE3..ttDBASE4:
  1568.            begin
  1569.             StrPCopy(pFLD^.szName, pFDB3^.FldName);
  1570.             pFLD^.iFldType := _GetFieldType(Handle, pFDB3^.FldType, pFDB3^.FldSize, pFDB3^.FldDec);
  1571.             pFLD^.iFldSize := pFDB3^.FldSize;
  1572.             pFLD^.iFldDec  := pFDB3^.FldDec;
  1573.             pFLD^.iPhysLen := pFDB3^.FldSize;
  1574.             pFLD^.iOffset  := E;
  1575.             _SetFldDataLen( pFLD );
  1576.             inc(E, pFLD^.iPhysLen);
  1577.             { update pos }
  1578.             inc(pFDB3);
  1579.             pPOS := pBYTE(pFDB3);
  1580.            end;{ ttDBASE3 }
  1581.          ttDBASE5..ttDBASE7:
  1582.            begin
  1583.             StrPCopy(pFLD^.szName, pFDB5^.FldName);
  1584.             pFLD^.iFldType := _GetFieldType(Handle, pFDB5^.FldType, pFDB3^.FldSize, pFDB3^.FldDec);
  1585.             pFLD^.iFldSize := pFDB5^.FldSize;
  1586.             pFLD^.iFldDec  := pFDB5^.FldDec;
  1587.             pFLD^.iPhysLen := pFDB5^.FldSize;
  1588.             pFLD^.iOffset  := E;
  1589.             _SetFldDataLen( pFLD );
  1590.             inc(E, pFLD^.iPhysLen);
  1591.             { update pos }
  1592.             inc(pFDB5);
  1593.             pPOS := pBYTE(pFDB5);
  1594.            end;{ ttDBASE4 }
  1595.          end;{ case }
  1596.         end;{ while }
  1597.        end;{ ttDBASE3..ttDBASE7 }
  1598.  
  1599.  
  1600.       ttCLARION1..ttCLARION2:
  1601.        begin
  1602.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1603.         _Move(Handle^.pHEADER, @H_CLR, SizeOf(HDR_CLARION));
  1604.         Handle^.iNumFlds    := H_CLR.NumFlds;
  1605.         Handle^.iRecSize    := H_CLR.RecLen;
  1606.         Handle^.iFldHdrSize := SizeOf(FLDHDR_CLARION);
  1607.         Handle^.iDataSize   := H_CLR.RecLen - SizeOf(FLDHDR_CLARION);
  1608.         Handle^.iNumRecs    := H_CLR.NumRecs;
  1609.         Handle^.iNumDels    := H_CLR.NumDels;
  1610.         Handle^.iBufSize    := ( MAX_BUFFERSIZE div Handle^.iRecSize ) * Handle^.iRecSize;
  1611.         Handle^.iBlockSize  := Handle^.iBufSize;
  1612.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1613.         pPOS := Handle^.pHEADER;
  1614.         inc(pPOS, SizeOf(HDR_CLARION));
  1615.         Handle^.pFIELDS := AllocMem(SizeOf(FLDDesc) * Handle^.iNumFlds);
  1616.         pFLD  := Handle^.pFIELDS;
  1617.         E     := Length(H_CLR.FilPrefx) + 2;
  1618.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1619.         { Read fields }
  1620.         for I := 1 to H_CLR.NumFlds do
  1621.         begin
  1622.          pFCLR := pFLD_CLARION(pPOS);
  1623.          pFLD^.iFldNum  := I;
  1624.          StrPCopy(pFLD^.szName, Trim(Copy(pFCLR^.FldName, E, Length(pFCLR^.FldName) - E)));
  1625.          pFLD^.iFldType := _GetFieldType(Handle, pFCLR^.FldType, pFCLR^.DecSig, pFCLR^.DecDec);
  1626.          pFLD^.iFldSize := pFCLR^.Length;
  1627.          pFLD^.iFldSig  := pFCLR^.DecSig;
  1628.          pFLD^.iFldDec  := pFCLR^.DecDec;
  1629.          pFLD^.iPhysLen := pFCLR^.Length;
  1630.          pFLD^.iOffset  := pFCLR^.FOffset;
  1631.          if( pFld^.iFldType = uftInteger )and
  1632.            ( Pos('DATE', UpperCase(pFld^.szName)) > 0 )then
  1633.          pFld^.iFldType := uftDate;
  1634.          { set subtype }
  1635.          if( pFCLR^.FldType = FLD_CL_DECIMAL )then
  1636.          pFLD^.iSubType := sftBCD else
  1637.          if( pFCLR^.FldType = FLD_CL_BYTE )then
  1638.          pFLD^.iSubType := sftBYTE;
  1639.          _SetFldDataLen( pFLD );
  1640.          inc(pPOS, SizeOf(FLD_CLARION));
  1641.          inc(pFLD);
  1642.         end;{ for }
  1643.         //------------------
  1644.         { Read keys }
  1645.         for I := 1 to H_CLR.NumKeys do
  1646.         begin
  1647.          pKCLR := pKEY_CLARION(pPOS);
  1648.          for F := 1 to pKCLR^.NumComps do
  1649.          begin
  1650.           inc(pPOS, SizeOf(KEYITEM_CLARION));
  1651.          end;{ for }
  1652.          inc(pPOS, SizeOf(KEY_CLARION));
  1653.         end;{ for }
  1654.         //------------------
  1655.         { Read pictures }
  1656.         for I := 1 to H_CLR.NumPics do
  1657.         begin
  1658.          pPCLR := pPICT_CLARION(pPOS);
  1659.          inc(pPOS, SizeOf(PICT_CLARION));
  1660.         end;{ for }
  1661.         //------------------
  1662.         { Read arrays }
  1663.         for I := 1 to H_CLR.NumArrs do
  1664.         begin
  1665.          pACLR := pARR_CLARION(pPOS);
  1666.          for F := 1 to pACLR^.TotDim do
  1667.          begin
  1668.           inc(pPOS, SizeOf(ARRITEM_CLARION))
  1669.          end;{ for }
  1670.          inc(pPOS, SizeOf(ARR_CLARION));
  1671.         end;{ for }
  1672.         Handle^.iOffsData := Longint(pPOS) - Longint(Handle^.pHEADER);
  1673.        end;{ ttCLARION1..ttCLARION2 }
  1674.  
  1675.  
  1676.       ttPARADOX3..ttPARADOX7:
  1677.        begin
  1678.         _Move(Handle^.pHEADER, @H_PDX, SizeOf(HDR_PARADOX));
  1679.         Handle^.iHdrSize    := H_PDX.HdrLen;
  1680.         Handle^.iNumFlds    := H_PDX.NumFlds;
  1681.         Handle^.iRecSize    := H_PDX.RecLen;
  1682.         Handle^.iFldHdrSize := 0;
  1683.         Handle^.iDataSize   := H_PDX.RecLen;
  1684.         Handle^.iNumRecs    := H_PDX.NumRecs;
  1685.         Handle^.iNumDels    := 0;
  1686.         Handle^.iAutoInc    := H_PDX.AutoInc;
  1687.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1688.         Handle^.iBlockFirst := H_PDX.BlFirst;
  1689.         Handle^.iBlockLast  := H_PDX.BlLast;
  1690.         Handle^.iBlockUsed  := H_PDX.NumBlUsed;
  1691.         Handle^.iBlockTotal := H_PDX.NumBlTotal;
  1692.         Handle^.iBlockSize  := H_PDX.BlockSize * 1024;
  1693.         Handle^.iBufSize    := Handle^.iBlockSize;
  1694.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1695.         Handle^.iOffsData   := H_PDX.HdrLen;
  1696.         { Calc field descs offset }
  1697.         case( Handle^.iTblType )of
  1698.         ttPARADOX3:
  1699.           begin
  1700.            Handle^.iOffsNames := 177 + ((Handle^.iNumFlds - 1) * 6);
  1701.            FldOffs := 88;
  1702.           end;
  1703.         ttPARADOX4..ttPARADOX5:
  1704.           begin
  1705.            Handle^.iOffsNames := 209 + ((Handle^.iNumFlds - 1) * 6);
  1706.            FldOffs := 120;
  1707.           end;
  1708.         ttPARADOX7:
  1709.           begin
  1710.            Handle^.iOffsNames := 391 + ((Handle^.iNumFlds - 1) * 6);
  1711.            FldOffs := 120;
  1712.           end;
  1713.         end;{ case }
  1714.  
  1715.         Handle^.pFIELDS := AllocMem(SizeOf(FLDDesc) * Handle^.iNumFlds);
  1716.         pFLD  := Handle^.pFIELDS;
  1717.         pPos  := Handle^.pHEADER;
  1718.         inc(pPos, FldOffs);
  1719.         pFPDX := pFLD_PARADOX(pPos);
  1720.         pPos  := Handle^.pHEADER;
  1721.         inc(pPos,  Handle^.iOffsNames);
  1722.         E := 0;
  1723.         { Read fields }
  1724.         for I := 1 to H_PDX.NumFlds do
  1725.         begin
  1726.          pFLD^.iFldNum := I;
  1727.          StrCopy(pFLD^.szName, PChar(pPos));
  1728.          pFLD^.iFldType := _GetFieldType(Handle, pFPDX^.FldType, pFPDX^.FldSize, 0);
  1729.          pFLD^.iFldSize := pFPDX^.FldSize;
  1730.          pFLD^.iPhysLen := pFPDX^.FldSize;
  1731.          pFLD^.iDataLen := pFPDX^.FldSize;
  1732.          pFLD^.iOffset  := E;
  1733.          inc(pPos, StrLen(pFLD^.szName) + 1);
  1734.          inc(E, pFLD^.iDataLen);
  1735.          inc(pFPDX);
  1736.          inc(pFLD);
  1737.         end;{ for }
  1738.        end;{ Paradox }
  1739.  
  1740.  
  1741.       ttEJM:
  1742.        begin
  1743.         _Move(Handle^.pHEADER, @H_EJM, SizeOf(HDR_EJM));
  1744.         Handle^.iHdrSize    := H_EJM.HdrLen;
  1745.         Handle^.iNumFlds    := H_EJM.NumFlds;
  1746.         Handle^.iRecSize    := H_EJM.RecLen;
  1747.         Handle^.iFldHdrSize := SizeOf(IFLD_EJM_STATE);
  1748.         Handle^.iDataSize   := H_EJM.RecLen - Handle^.iFldHdrSize;
  1749.         Handle^.iNumRecs    := H_EJM.NumRecs;
  1750.         Handle^.iNumDels    := H_EJM.NumDels;
  1751.         Handle^.iAutoInc    := H_EJM.AutoInc;
  1752.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1753.         Handle^.iBufSize    := ( MAX_BUFFERSIZE div Handle^.iRecSize ) * Handle^.iRecSize;
  1754.         Handle^.iBlockSize  := Handle^.iBufSize;
  1755.         //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1756.         Handle^.iOffsNames  := SizeOf(H_EJM) + (Handle^.iNumFlds * SizeOf(FLD_EJM));
  1757.         Handle^.iOffsData   := H_EJM.HdrLen;
  1758.         FldOffs := SizeOf(H_EJM);
  1759.  
  1760.         Handle^.pFIELDS := AllocMem(SizeOf(FLDDesc) * Handle^.iNumFlds);
  1761.         pFLD  := Handle^.pFIELDS;
  1762.         pPos  := Handle^.pHEADER;
  1763.         inc(pPos, FldOffs);
  1764.         pFEJM := pFLD_EJM(pPos);
  1765.         pPos  := Handle^.pHEADER;
  1766.         inc(pPos,  Handle^.iOffsNames);
  1767.         E := 0;
  1768.         { Read fields }
  1769.         for I := 1 to H_EJM.NumFlds do
  1770.         begin
  1771.          pFLD^.iFldNum := I;
  1772.          StrCopy(pFLD^.szName, PChar(pPos));
  1773.          pFLD^.iFldType := ALP_FLDTYPE(pFEJM^.FldType);
  1774.          pFLD^.iFldSize := pFEJM^.FldSize;
  1775.          pFLD^.iFldDec  := pFEJM^.FldDec;
  1776.          pFLD^.iPhysLen := pFEJM^.FldSize;
  1777.          pFLD^.iDataLen := pFEJM^.FldSize;
  1778.          pFLD^.iOffset  := E;
  1779.          inc(pPos, StrLen(pFLD^.szName) + 1);
  1780.          inc(E, pFLD^.iDataLen);
  1781.          inc(pFEJM);
  1782.          inc(pFLD);
  1783.         end;{ for }
  1784.        end;{ EJM }
  1785.  
  1786.       end;{ case }
  1787.       { Create Buffer }
  1788.       Handle^.BUFFER   := IBuffer.Create(Handle);
  1789.       { Set record position }
  1790.       Handle^.iRecPos   := Handle^.iOffsData;
  1791.       Handle^.iBlockPos := Handle^.iOffsData;
  1792.       { Set handle properties }
  1793.       _CalcHandleProps( Handle );
  1794.      end;{ if }
  1795.     end;{ if }
  1796.    end;{ if }
  1797.   end;{ if }
  1798.  end;{ if }
  1799. end;{ func }
  1800.  
  1801. function ALPCloseTable (               { Closes cursor }
  1802.       Handle        : ALP_HANDLE       { Pntr to Cursor handle }
  1803.    ): ALPResult;
  1804. begin
  1805.  Result := ERR_NONE;
  1806.  if( Handle = nil )then
  1807.   Result := ERR_INVALIDHANDLE else
  1808.  begin
  1809.   if( Handle^.pFIELDS <> nil )then FreeMem(Handle^.pFIELDS, SizeOf(FLDDESC) * Handle^.iNumFlds);
  1810.   if( Handle^.pHEADER <> nil )then FreeMem(Handle^.pHEADER, MAX_HEADERBUFSIZE);
  1811.   Handle^.BUFFER.Free;
  1812.   FileClose( Handle^.iHandle );
  1813.   FreeMem(Handle, SizeOf(_HANDLE));
  1814.   TObject(Handle) := nil;
  1815.  end;
  1816. end;{ func }
  1817.  
  1818. function ALPTableCreate (              { Create a table        }
  1819.       pTblDesc      : pCRTblDesc;      { Table descriptor      }
  1820.       bOpen         : boolean;         { Open after create     }
  1821. var   Handle        : ALP_HANDLE       { Returns Cursor handle }
  1822.    ): ALPResult;
  1823. var
  1824.   E, I, F   : Integer;
  1825.   H         : Integer;
  1826.   Path      : string;
  1827.   FileName  : string;
  1828.   pFld      : pFldDesc;
  1829.   { EJM }
  1830.   IHDR_EJM  : HDR_EJM;
  1831.   IFLD_EJM  : FLD_EJM;
  1832.   IFLD_NAME : Char64;
  1833.   HdrLen    : Integer;
  1834.   RecLen    : Integer;
  1835.   NameLen   : Word;
  1836. begin
  1837.   Result := ERR_NONE;
  1838.   if( pTblDesc = nil )then  { Check valid descriptor }
  1839.   Result := ERR_INVALIDCRDESC else
  1840.   begin
  1841.    { create }
  1842.    case( pTblDesc^.iTblType )of
  1843.    ttEJM:
  1844.      begin
  1845.       HdrLen   := SizeOf(HDR_EJM);
  1846.       Path     := StrPas(pTblDesc^.szDbName);
  1847.       FileName := ChangeFileExt(StrPas(pTblDesc^.szTblName), '.EJM');
  1848.       { fill header }
  1849.       FillChar(IHDR_EJM, SizeOf(HDR_EJM), 0);
  1850.       IHDR_EJM.Ident   := EJM_TBLIDENT;
  1851.       IHDR_EJM.Version := 1;
  1852.       IHDR_EJM.NumFlds := pTblDesc^.iFldCount;
  1853.       { create stream }
  1854.       H := FileCreate(Path + FileName);
  1855.       if( H = -1 )then Result := ERR_INVALIDFILENAME else
  1856.       begin
  1857.        FileSeek(H, 0, SEEK_FROMBEGIN);
  1858.        E := FileWrite(H, IHDR_EJM, SizeOf(HDR_EJM));
  1859.        if( E = -1 )then Result := ERR_CANNOTWRITEFILE else
  1860.        begin
  1861.         RecLen := 0;
  1862.         { write field descs }
  1863.         pFld := pTblDesc^.pFldDesc;
  1864.         for I := 0 to pTblDesc^.iFldCount - 1 do
  1865.         begin
  1866.          IFLD_EJM.FldType := Ord(pFld^.iFldType);
  1867.          IFLD_EJM.FldSize := ALP_FLDSIZES[ALP_FLDTYPE(pFld^.iFldType)] + pFld^.iFldSize;
  1868.          IFLD_EJM.FldDec  := pFld^.iFldDec;
  1869.          E := FileWrite(H, IFLD_EJM, SizeOf(FLD_EJM));
  1870.          if( E = -1 )then
  1871.          begin
  1872.           Result := ERR_CANNOTWRITEFILE;
  1873.           Break;
  1874.          end;
  1875.          inc(pFld);
  1876.          inc(RecLen, IFLD_EJM.FldSize);
  1877.          inc(HdrLen, SizeOf(FLD_EJM));
  1878.         end;{ for }
  1879.         { write field names }
  1880.         if( Result = ERR_NONE )then
  1881.         begin
  1882.          pFld := pTblDesc^.pFldDesc;
  1883.          for I := 0 to pTblDesc^.iFldCount - 1 do
  1884.          begin
  1885.           StrCopy(IFLD_NAME, pFld^.szName);
  1886.           E := FileWrite(H, IFLD_NAME, StrLen(IFLD_NAME) + 1);
  1887.           if( E = -1 )then
  1888.           begin
  1889.            Result := ERR_CANNOTWRITEFILE;
  1890.            Break;
  1891.           end;
  1892.           inc(pFld);
  1893.           inc(HdrLen, StrLen(IFLD_NAME) + 1);
  1894.          end;{ for }
  1895.         end;
  1896.         { write header length }
  1897.         E := FileSeek(H, 5, SEEK_FROMBEGIN);
  1898.         if( E = -1 )then Result := ERR_CANNOTSEEK else
  1899.         begin
  1900.          E := FileWrite(H, HdrLen, SizeOf(Word));
  1901.          if( E = -1 )then Result := ERR_CANNOTWRITEFILE;
  1902.         end;
  1903.         { write record length }
  1904.         E := FileSeek(H, 9, SEEK_FROMBEGIN);
  1905.         if( E = -1 )then Result := ERR_CANNOTSEEK else
  1906.         begin
  1907.          E := FileWrite(H, RecLen, SizeOf(Integer));
  1908.          if( E = -1 )then Result := ERR_CANNOTWRITEFILE;
  1909.         end;
  1910.        end;
  1911.        FileClose(H);
  1912.       end;
  1913.      end;{ ttEJM }
  1914.    end;{ case }
  1915.   end;
  1916. end;
  1917.  
  1918. function ALPGetFieldDescs (            { Get field descriptions }
  1919.       Handle        : ALP_HANDLE;      { Cursor handle }
  1920.       pFldDesc      : pFLDDesc          { Array of field descriptors }
  1921.    ): ALPResult;
  1922. begin
  1923.  Result := ERR_NONE;
  1924.  if( Handle = nil )then
  1925.  Result := ERR_INVALIDHANDLE else
  1926.  begin
  1927.   _Move(Handle^.pFIELDS, pFLDDesc, SizeOf(FLDDESC)* Handle^.iNumFlds);
  1928.  end;
  1929. end;{ func }
  1930.  
  1931. {=============================================================================}
  1932. {                              Cursor Maintenance                             }
  1933. {=============================================================================}
  1934.  
  1935. function ALPSetToBegin (               { Reset cursor to beginning }
  1936.       Handle        : ALP_HANDLE       { Cursor handle }
  1937.    ): ALPResult;
  1938. var
  1939.  E      : Integer;
  1940. begin
  1941.  Result := ERR_NONE;
  1942.  if( Handle = nil )then
  1943.  Result := ERR_INVALIDHANDLE else
  1944.  begin
  1945.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1946.   Handle^.iBlockPred := 0;
  1947.   Handle^.iBlockNext := Handle^.iBlockFirst;
  1948.   Handle^.iBlockCurr := Handle^.iBlockFirst - 1;
  1949.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1950.   Handle^.BUFFER.Clear;
  1951.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1952.  end;{ if }
  1953. end;{ func }
  1954.  
  1955. function ALPSetToEnd (                 { Reset cursor to ending }
  1956.       Handle        : ALP_HANDLE       { Cursor handle }
  1957.    ): ALPResult;
  1958. var
  1959.  E     : Integer;
  1960.  Pos   : Integer;
  1961. begin
  1962.  Result := ERR_NONE;
  1963.  if( Handle = nil )then
  1964.  Result := ERR_INVALIDHANDLE else
  1965.  begin
  1966.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1967.   Handle^.iBlockNext := 0;
  1968.   Handle^.iBlockPred := Handle^.iBlockLast;
  1969.   Handle^.iBlockCurr := Handle^.iBlockLast + 1;
  1970.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1971.   Handle^.BUFFER.Clear;
  1972.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1973.  end;{ if }
  1974. end;{ func }
  1975.  
  1976. function ALPGetBookMark (              { Get a book-mark }
  1977.       Handle        : ALP_HANDLE;      { Cursor }
  1978.       pBkMark       : Pointer           { Pointer to Book-Mark }
  1979.    ): ALPResult;
  1980. begin
  1981.  Result := ERR_NONE;
  1982.  if( Handle = nil )then
  1983.  Result := ERR_INVALIDHANDLE else
  1984.  begin
  1985.   pBookmark( pBkMark )^ := Handle^.BUFFER.RecPos;
  1986.  end;{ if }
  1987. end;{ func }
  1988.  
  1989. function ALPSetToBookMark (             { Position to a Book-Mark }
  1990.       Handle        : ALP_HANDLE;       { Cursor }
  1991.       pBkMark       : Pointer           { Pointer to Book-Mark }
  1992.    ): ALPResult;
  1993. var
  1994.  E           : Integer;
  1995.  NewPos      : Integer;
  1996.  BlockId     : Integer;
  1997. begin
  1998.  Result := ERR_NONE;
  1999.  if( Handle = nil )then
  2000.  Result := ERR_INVALIDHANDLE else
  2001.  begin
  2002.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2003.   Handle^.iRecPos := pBookmark(pBkMark)^;
  2004.   if not( Handle^.BUFFER.Locate(Handle^.iRecPos))then
  2005.   begin
  2006.    BlockId := (Handle^.iRecPos - Handle^.iOffsData)div Handle^.iBlockSize + 1;
  2007.    Handle^.iBlockPos  := _GetBlockPos(Handle, BlockId);
  2008.    Handle^.iBlockCurr := BlockId;
  2009.    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2010.    E := FileSeek(Handle^.iHANDLE, Handle^.iBlockPos, SEEK_FROMBEGIN);
  2011.    if( E = -1 )then Result := ERR_CANNOTSEEK else
  2012.    begin
  2013.     E := FileRead(Handle^.iHANDLE, Handle^.BUFFER.pIntBuf^, Handle^.iBufSize);
  2014.     if( E = -1 )then Result := ERR_CANNOTREADFILE else
  2015.     begin
  2016.      Handle^.iReadBytes := E;
  2017.      _SetBuffer(Handle);
  2018.      Handle^.BUFFER.Locate(Handle^.iRecPos);
  2019.     end;{ if }
  2020.    end;{ if }
  2021.   end;{ if }
  2022.  end;{ if }
  2023. end;{ func }
  2024.  
  2025.  
  2026. {===========================================================================}
  2027. {                      Data Access: Logical Record Level                    }
  2028. {===========================================================================}
  2029.  
  2030. function ALPGetNextRecord (             { Find/Get the next record }
  2031.       Handle        : ALP_HANDLE;       { Cursor handle }
  2032.       pRecBuff      : Pointer;          { Record buffer(client) }
  2033.       pRecProps     : pRECProps         { Optional record properties }
  2034.    ): ALPResult;
  2035. label
  2036.  LABEL_REPEAT;
  2037. var
  2038.  E        : Integer;
  2039.  NewPos   : Integer;
  2040.  pData    : pByte;
  2041.  IsAccept : Boolean;
  2042. begin
  2043.  Result := ERR_NONE;
  2044.  if( Handle = nil )then
  2045.  Result := ERR_INVALIDHANDLE else
  2046.  begin
  2047.   repeat
  2048.    if( Handle^.BUFFER.IsEOF )then
  2049.    begin
  2050.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2051.     LABEL_REPEAT:
  2052.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2053.     if( Handle^.iBlockCurr > Handle^.iBlockLast )or
  2054.       ( Handle^.iBlockNext = 0 )then
  2055.     begin
  2056.      Result := ERR_EOF;
  2057.      Break;
  2058.     end;{ if }
  2059.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2060.     NewPos := _GetBlockPos( Handle, Handle^.iBlockNext );
  2061.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2062.     E := FileSeek(Handle^.iHandle, NewPos, SEEK_FROMBEGIN);
  2063.     if( E = -1 )then Result := ERR_CANNOTSEEK else
  2064.     begin
  2065.      Handle^.iBlockPos := E;
  2066.      //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2067.      E := FileRead(Handle^.iHandle, Handle^.BUFFER.pIntBuf^, Handle^.iBufSize);
  2068.      if( E = -1 )then Result := ERR_CANNOTREADFILE else
  2069.      begin
  2070.       Handle^.iReadBytes := E;
  2071.       _SetBuffer(Handle);
  2072.       //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2073.       if( Handle^.BUFFER.IsEMPTY )then
  2074.       if( Handle^.iBlockCurr >= Handle^.iBlockLast )or
  2075.         ( Handle^.iBlockNext = 0 )then
  2076.       Result := ERR_EOF else goto LABEL_REPEAT;
  2077.       //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2078.      end;{ if }
  2079.      //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2080.     end;{ if }
  2081.    end else
  2082.    Handle^.BUFFER.Next;
  2083.  
  2084.    {----------------------------------------------------------}
  2085.    { Get Record                                               }
  2086.    {----------------------------------------------------------}
  2087.    if( Result = ERR_NONE )then
  2088.    begin
  2089.     pData := Handle^.BUFFER.pCursor;
  2090.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2091.     IsAccept := False;
  2092.     if(( Handle^.iTblType in ALP_DBASETYPES)and
  2093.        ( PByte(pData)^ = DELFLAG_DBASE))then Continue else
  2094.     if(( Handle^.iTblType in ALP_CLARIONTYPES )and
  2095.        ( PByte(pData)^ = DELFLAG_CLARION))then Continue;
  2096.     IsAccept := True;
  2097.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2098.     { Move data buffer }
  2099.     if( pRecBuff <> nil )then
  2100.     begin
  2101.      inc(pData, Handle^.iFldHdrSize);
  2102.      _Move(pData, pRecBuff, Handle^.iDataSize);
  2103.     end;{ if }
  2104.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2105.     { Set record properties }
  2106.     if( pRecProps <> nil )then
  2107.     begin
  2108.      pRecProps^.iRecNum     := Handle^.iRecId;
  2109.      pRecProps^.iRecStatus  := rsUnmodified;
  2110.      pRecProps^.bDeleteFlag := False;
  2111.     end;{ if }
  2112.    end;{ if }
  2113.   until( IsAccept )xor( Result <> ERR_NONE );
  2114.  end;{ if }
  2115. end;{ func }
  2116.  
  2117. function ALPGetPriorRecord (            { Find/Get the prior record }
  2118.       Handle        : ALP_HANDLE;       { Cursor handle }
  2119.       pRecBuff      : Pointer;          { Record buffer(client) }
  2120.       pRecProps     : pRECProps         { Optional record properties }
  2121.    ): ALPResult;
  2122. label
  2123.  LABEL_REPEAT;
  2124. var
  2125.  E        : Integer;
  2126.  pData    : pByte;
  2127.  NewPos   : Integer;
  2128.  IsAccept : Boolean;
  2129. begin
  2130.  Result := ERR_NONE;
  2131.  if( Handle = nil )then
  2132.  Result := ERR_INVALIDHANDLE else
  2133.  begin
  2134.   repeat
  2135.    if( Handle^.BUFFER.IsBOF )then
  2136.    begin
  2137.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2138.     LABEL_REPEAT:
  2139.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2140.     if( Handle^.iBlockCurr < Handle^.iBlockFirst )or
  2141.       ( Handle^.iBlockPred = 0 )then
  2142.     begin
  2143.      Result := ERR_BOF;
  2144.      Break;
  2145.     end;{ if }
  2146.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2147.     NewPos := _GetBlockPos( Handle, Handle^.iBlockPred );
  2148.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2149.     begin
  2150.      E := FileSeek(Handle^.iHandle, NewPos, SEEK_FROMBEGIN);
  2151.      if( E = -1 )then Result := ERR_CANNOTSEEK else
  2152.      begin
  2153.       Handle^.iBlockPos := E;
  2154.       E := FileRead(Handle^.iHandle, Handle^.BUFFER.pINTBUF^ , Handle^.iBufSize);
  2155.       if( E = -1 )then Result := ERR_CANNOTREADFILE else
  2156.       begin
  2157.        Handle^.iReadBytes := E;
  2158.        _SetBuffer(Handle);
  2159.        Handle^.BUFFER.Last;
  2160.        //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2161.        if( Handle^.BUFFER.IsEMPTY )then
  2162.        if( Handle^.iBlockCurr <= Handle^.iBlockFirst )or
  2163.          ( Handle^.iBlockPred = 0 )then
  2164.        Result := ERR_BOF else goto LABEL_REPEAT;
  2165.       end;{ if }
  2166.      end;{ if }
  2167.     end;{ if }
  2168.    end else
  2169.    Handle^.BUFFER.Prior;
  2170.  
  2171.    {----------------------------------------------------------}
  2172.    { Get Record                                               }
  2173.    {----------------------------------------------------------}
  2174.    if( Result = ERR_NONE )then
  2175.    begin
  2176.     pData := Handle^.BUFFER.pCursor;
  2177.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2178.     IsAccept := False;
  2179.     if(( Handle^.iTblType in ALP_DBASETYPES)and
  2180.        ( PByte(pData)^ = DELFLAG_DBASE))then Continue else
  2181.     if(( Handle^.iTblType in ALP_CLARIONTYPES )and
  2182.        ( PByte(pData)^ = DELFLAG_CLARION))then Continue;
  2183.     IsAccept := True;
  2184.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2185.     { Move data buffer }
  2186.     if( pRecBuff <> nil )then
  2187.     begin
  2188.      inc(pData, Handle^.iFldHdrSize);
  2189.      _Move(pData, pRecBuff, Handle^.iDataSize);
  2190.     end;{ if }
  2191.     //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2192.     { Set record properties }
  2193.     if( pRecProps <> nil )then
  2194.     begin
  2195.      pRecProps^.iRecNum     := Handle^.iRecId;
  2196.      pRecProps^.iRecStatus  := rsUnmodified;
  2197.      pRecProps^.bDeleteFlag := False;
  2198.     end;{ if }
  2199.    end;{ if }
  2200.   until( IsAccept )xor( Result <> ERR_NONE );
  2201.  end;{ if }
  2202. end;{ func }
  2203.  
  2204. function ALPGetRecord (                 { Gets the current record }
  2205.       Handle        : ALP_HANDLE;       { Cursor handle }
  2206.       pRecBuff      : Pointer;          { Record buffer(client) }
  2207.       pRecProps     : pRECProps         { Optional record properties }
  2208.    ): ALPResult;
  2209. var
  2210.  pData: pBYTE;
  2211. begin
  2212.  Result := ERR_NONE;
  2213.  if( Handle = nil )then
  2214.  Result := ERR_INVALIDHANDLE else
  2215.  begin
  2216.   { Get Record }
  2217.   if( Handle^.BUFFER.IsEMPTY )then
  2218.    Result := ERR_BUFFERISEMPTY else
  2219.   if( Handle^.BUFFER.IsEOF )and
  2220.     ( Handle^.iBlockCurr > Handle^.iBlockLast )then
  2221.    Result := ERR_EOF else
  2222.   if( Handle^.BUFFER.IsBOF )and
  2223.     ( Handle^.iBlockCurr < Handle^.iBlockFirst )then
  2224.    Result := ERR_BOF else
  2225.   begin
  2226.    pData := Handle^.BUFFER.pCursor;
  2227.    if( Handle^.iTblType in ALP_CLARIONTYPES )and
  2228.      ( pData^ = DELFLAG_CLARION )then
  2229.    Result := ERR_RECDELETED else
  2230.    if( Handle^.iTblType in ALP_DBASETYPES )and
  2231.      ( pData^ = DELFLAG_DBASE )then
  2232.    Result := ERR_RECDELETED else
  2233.    begin
  2234.     //~~~ set buffer ~~~~~~~~
  2235.     if( pRecBuff <> nil )then
  2236.     begin
  2237.      inc(pData, Handle^.iFldHdrSize);
  2238.      _Move(pData, pRecBuff, Handle^.iDataSize);
  2239.     end;{ if }
  2240.     //~~~ set record props ~~
  2241.     if( pRecProps <> nil )then
  2242.     begin
  2243.      pRecProps^.iRecNum     := Handle^.iRecId;
  2244.      pRecProps^.iRecStatus  := rsUnmodified;
  2245.      pRecProps^.bDeleteFlag := False;
  2246.     end;{ if }
  2247.    end;{ if }
  2248.   end;{ if }
  2249.  end;{ if }
  2250. end;{ func }
  2251.  
  2252. function ALPInitRecord (               { Initialize record area }
  2253.       Handle        : ALP_HANDLE;      { Cursor handle }
  2254.       pRecBuff      : Pointer           { Record buffer }
  2255.    ): ALPResult;
  2256. begin
  2257.  case( Handle^.iTblType )of
  2258.  ttDBASE3..ttDBASE7,
  2259.  ttFOXPRO1..ttFOXPRO4   : FillChar(pRecBuff^, Handle^.iDataSize, EMPCHAR_DBASE);
  2260.  ttCLARION1..ttCLARION2,
  2261.  ttPARADOX3..ttPARADOX7 : FillChar(pRecBuff^, Handle^.iDataSize, 0);
  2262.  end;{ case }
  2263. end;{ func }
  2264.  
  2265. function ALPInsertRecord (             { Inserts a new record }
  2266.       Handle        : ALP_HANDLE;      { Cursor handle }
  2267.       pRecBuff      : Pointer           { New Record (client) }
  2268.    ): ALPResult;
  2269. begin
  2270. end;{ func }
  2271.  
  2272. function ALPModifyRecord (              { Updates the current record }
  2273.       Handle        : ALP_HANDLE;       { Cursor handle }
  2274.       pRecBuf       : Pointer;          { Modified record }
  2275.       bFreeLock     : Boolean           { Free record lock }
  2276.    ): ALPResult;
  2277. var
  2278.  E       : Integer;
  2279.  RecPos  : Integer;
  2280.  RecSize : Integer;
  2281.  pPos    : pBYTE;
  2282. begin
  2283.  Result := ERR_NONE;
  2284.  if( Handle = nil )then
  2285.  Result := ERR_INVALIDHANDLE else
  2286.  begin
  2287.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2288.   pPos := Handle^.BUFFER.pCursor;
  2289.   inc(pPos, Handle^.iFldHdrSize);
  2290.   RecSize := Handle^.iRecSize - Handle^.iFldHdrSize;
  2291.   _Move(pRecBuf, pPos, RecSize);
  2292.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2293.   RecPos := ( Handle^.BUFFER.GetRecPos + Handle^.iFldHdrSize );
  2294.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2295.   E := FileSeek(Handle^.iHandle, RecPos, SEEK_FROMBEGIN);
  2296.   if( E = -1 )then Result := ERR_CANNOTSEEK else
  2297.   begin
  2298.    E := FileWrite(Handle^.iHandle, pRecBuf^, RecSize);
  2299.    if( E = -1 )then Result := ERR_CANNOTWRITEFILE else
  2300.    begin
  2301.    end;{ if }
  2302.   end;{ if }
  2303.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2304.  end;{ if }
  2305. end;{ func }
  2306.  
  2307. function ALPDeleteRecord (              { Deletes the current record }
  2308.       Handle        : ALP_HANDLE;       { Cursor handle }
  2309.       pRecBuf       : Pointer           { Copy of deleted record }
  2310.    ): ALPResult;
  2311. var
  2312.  E       : Integer;
  2313.  BlcPos  : Integer;
  2314.  RecPos  : Integer;
  2315.  NumRecs : Longint;
  2316.  Offs    : Longint;
  2317. begin
  2318.  Result := ERR_NONE;
  2319.  if( Handle = nil )then
  2320.  Result := ERR_INVALIDHANDLE else
  2321.  begin
  2322.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2323.   Handle^.BUFFER.Delete;
  2324.   //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2325.   if(  Handle^.iTblType in ALP_PDXTYPES )then
  2326.   begin
  2327.    RecPos := ( Handle^.BUFFER.BufferPos );
  2328.    E := FileSeek(Handle^.iHandle, RecPos, SEEK_FROMBEGIN);
  2329.    if( E = -1 )then Result := ERR_CANNOTSEEK else
  2330.    begin
  2331.     E := FileWrite(Handle^.iHandle, Handle^.BUFFER.pIntBuf^, Handle^.iBlockSize);
  2332.     if( E = -1 )then Result := ERR_CANNOTWRITEFILE else
  2333.     begin
  2334.      dec(Handle^.iNumRecs);
  2335.      _WriteParam(Handle, PRM_NUMRECS);
  2336.     end;{ if }
  2337.    end;{ if }
  2338.   end else
  2339.   begin
  2340.    RecPos := ( Handle^.BUFFER.GetRecPos );
  2341.    E := FileSeek(Handle^.iHandle, RecPos, SEEK_FROMBEGIN);
  2342.    if( E = -1 )then Result := ERR_CANNOTSEEK else
  2343.    begin
  2344.     E := FileWrite(Handle^.iHandle, Handle^.BUFFER.pCursor^, Handle^.iRecSize);
  2345.     dec(Handle^.iNumRecs);
  2346.     inc(Handle^.iNumDels);
  2347.     _WriteParam(Handle, PRM_NUMDELS);
  2348.    end;{ if }
  2349.   end;{ if }
  2350.  end;{ if }
  2351. end;{ func }
  2352.  
  2353. function ALPReadBlock (                { Read a block of records }
  2354.       Handle        : ALP_HANDLE;      { Cursor handle }
  2355. var   iRecords      : Longint;          { Number of records to read }
  2356.       pBuf          : Pointer           { Buffer }
  2357.    ): ALPResult;
  2358. begin
  2359. end;{ func }
  2360.  
  2361. function ALPWriteBlock (               { Write a block of records }
  2362.       Handle        : ALP_HANDLE;      { Cursor handle }
  2363. var   iRecords      : Longint;          { Number of records to write/written }
  2364.       pBuf          : Pointer           { Buffer }
  2365.    ): ALPResult;
  2366. begin
  2367. end;{ func }
  2368.  
  2369. function ALPAppendRecord (             { Inserts a new record }
  2370.       Handle        : ALP_HANDLE;      { Cursor handle }
  2371.       pRecBuff      : Pointer           { New Record (client) }
  2372.    ): ALPResult;
  2373. var
  2374.  E      : Integer;
  2375.  pBuf   : pBYTE;
  2376.  pPos   : pBYTE;
  2377.  RecPos : Integer;
  2378. begin
  2379.  Result := ERR_NONE;
  2380.  if( Handle = nil )then
  2381.  Result := ERR_INVALIDHANDLE else
  2382.  begin
  2383.   Result := ALPSetToEnd(Handle);
  2384.   if( Result = ERR_NONE )then
  2385.   begin
  2386.    RecPos := Handle^.iRecPos + Handle^.iRecSize;
  2387.    pBuf   := AllocMem(Handle^.iRecSize + Handle^.iFooterLen);
  2388.    try
  2389.     { init record }
  2390.     ALPInitRecord(Handle, pBuf);
  2391.     inc(pPos, Handle^.iFldHdrSize);
  2392.     _Move(pRecBuff, pPos, Handle^.iDataSize);
  2393.     inc(pPos, Handle^.iDataSize);
  2394.     pPos^ := 26;{ end }
  2395.     E := FileSeek(Handle^.iHandle, RecPos, SEEK_FROMBEGIN);
  2396.     if( E = -1 )then Result := ERR_CANNOTSEEK else
  2397.     begin
  2398.      Handle^.iFilePos := E;
  2399.      E := FileWrite(Handle^.iHandle, pBuf^, Handle^.iRecSize + Handle^.iFooterLen);
  2400.      if( E = -1 )then Result := ERR_CANNOTWRITEFILE else
  2401.      begin
  2402.       Handle^.iRecPos := RecPos;
  2403.      end;{ if }
  2404.     end;{ if }
  2405.    finally
  2406.     FreeMem(pBuf, Handle^.iRecSize + Handle^.iFooterLen);
  2407.    end;{ fin }
  2408.   end;{ if }
  2409.  end;{ if }
  2410. end;{ func }
  2411.  
  2412. function ALPGetRecordCount (           { Get the current number of records }
  2413.       Handle        : ALP_HANDLE;      { Cursor handle }
  2414. var   iRecCount     : Longint          { Number of records }
  2415.    ): ALPResult;
  2416. var
  2417.  Bk   : IBookmark;
  2418. begin
  2419.  Result := ERR_NONE;
  2420.  if( Handle^.iTblType in ALP_PDXTYPES + [ttEJM] )then
  2421.   iRecCount := Handle^.iNumRecs
  2422.  else begin
  2423.   iRecCount := 0;
  2424.   try
  2425.    ALPGetBookMark(Handle, @Bk);
  2426.    ALPSetToBegin(Handle);
  2427.    while( ALPGetNextRecord(Handle, nil, nil) = ERR_NONE )do
  2428.    inc(iRecCount);
  2429.   finally
  2430.    ALPSetToBookMark(Handle, @Bk);
  2431.   end;{ fin }
  2432.  end;{ else } 
  2433. end;{ func }
  2434.  
  2435. {============================================================================}
  2436. {                            Field Level Access                              }
  2437. {============================================================================}
  2438.  
  2439. function ALPGetField (                 { Get Field value }
  2440.       Handle        : ALP_HANDLE;      { Cursor }
  2441.       iField        : Word;             { Field # (1..n) }
  2442.       pRecBuff      : Pointer;          { Record buffer }
  2443.       pDest         : Pointer;          { Destination field buffer }
  2444. var   bBlank        : Boolean           { Returned : is field blank }
  2445.    ): ALPResult;
  2446. var
  2447.  pFLD: pFLDDesc;
  2448.  pPos: pBYTE;
  2449.  pBuf: pCHAR;
  2450. begin
  2451.  Result := ERR_NONE;
  2452.  if( Handle = nil )then
  2453.  Result := ERR_INVALIDHANDLE else
  2454.  begin
  2455.   pFLD := Handle^.pFIELDS;
  2456.   inc(pFLD, iField - 1);
  2457.   pPos := precBuff;
  2458.   inc(pPos, pFLD^.iOffset);
  2459.   if( pDest <> nil )then
  2460.   begin
  2461.    bBlank := _IsBlank(Handle, pFld, pPos);
  2462.    if( not bBlank )then
  2463.    begin
  2464.     try
  2465.      FillChar(pDest^, pFLD^.iDataLen, #0);
  2466.      pBuf := AllocMem(pFld^.iPhysLen + 1);
  2467.      _Move(pPos, pBuf, pFLD^.iPhysLen);
  2468.      ALPDataToIDE(Handle, pFld, pBuf);
  2469.      if( pFld^.iFldType = uftString )then
  2470.      _Move(pBuf, pDest, pFld^.iDataLen + 1)else
  2471.      _Move(pBuf, pDest, pFld^.iDataLen);
  2472.     finally
  2473.      FreeMem(pBuf, pFld^.iPhysLen + 1);
  2474.     end;{ fin }
  2475.    end;{ fin }
  2476.   end;{ if }
  2477.  end;{ if }
  2478. end;{ func }
  2479.  
  2480. function ALPPutField (                  { Put a value in the record buffer }
  2481.       Handle        : ALP_HANDLE;       { Cursor }
  2482.       iField        : Word;             { Field # (1..n) }
  2483.       pRecBuff      : Pointer;          { Record buffer }
  2484.       pSrc          : Pointer           { Source field buffer }
  2485.    ): ALPResult;
  2486. var
  2487.  pFLD  : pFLDDesc;
  2488.  pPos1 : pBYTE;
  2489.  pPos2 : pBYTE;
  2490. begin
  2491.  Result := ERR_NONE;
  2492.  if( Handle = nil )then
  2493.  Result := ERR_INVALIDHANDLE else
  2494.  begin
  2495.   pFLD := Handle^.pFIELDS;
  2496.   inc(pFLD, iField - 1);
  2497.   pPos1 := pRecBuff;
  2498.   pPos2 := Handle^.BUFFER.pCursor;
  2499.   inc(pPos1, pFLD^.iOffset);
  2500.   inc(pPos2, Handle^.iFldHdrSize + pFld^.iOffset);
  2501.  
  2502.   if( pSrc = nil )then
  2503.    case( Handle^.iTblType )of
  2504.    ttDBASE3..ttDBASE7,
  2505.    ttFOXPRO1..ttFOXPRO4:
  2506.     begin
  2507.      FillChar(pPos1^, pFLD^.iPhysLen, EMPCHAR_DBASE);
  2508.      FillChar(pPos2^, pFLD^.iPhysLen, EMPCHAR_DBASE);
  2509.     end;{ }
  2510.    end{ case }
  2511.   else
  2512.   begin
  2513.    ALPIDEToData(Handle, pFld, pSrc);
  2514.    _Move(pSrc, pPos1, pFLD^.iPhysLen);
  2515.    _Move(pSrc, pPos2, pFLD^.iPhysLen);
  2516.   end;{ else }
  2517.  end;{ if }
  2518. end;{ func }
  2519.  
  2520.  
  2521.  
  2522. {============================================================================}
  2523. {                            Formatting data                                 }
  2524. {============================================================================}
  2525.  
  2526. function ALPDataToIDE (                { Get a formatted value }
  2527.       Handle        : ALP_HANDLE;      { Cursor }
  2528.       pFld          : pFldDesc;         { Field pointer }
  2529.       pBuff         : Pointer           { Value buffer }
  2530.    ): ALPResult;
  2531. var
  2532.  I       : Integer;
  2533.  F       : Integer;
  2534.  P       : Pointer;
  2535.  Len     : Integer;
  2536.  Value   : string;
  2537.  Int16   : SmallInt;
  2538.  Int32   : Integer;
  2539.  Card    : Integer;
  2540.  Dbl     : Double;
  2541.  pDate   : pDATE_DBASE;
  2542.  Day     : Word;
  2543.  Month   : Word;
  2544.  Year    : Word;
  2545.  pPos    : pByte;
  2546.  EDate   : TDateTime;
  2547.  Rslt    : Integer;
  2548.  Buf     : array [0..31] of Byte;
  2549. begin
  2550.   case( pFld^.iFldType )of
  2551.   uftString:   case( Handle^.iTblType )of
  2552.                ttDBASE3..ttDBASE7,
  2553.                ttFOXPRO1..ttFOXPRO4,
  2554.                ttCLARION1..ttCLARION2:
  2555.                 begin
  2556.                  Value := StrPas(PChar(pBuff));
  2557.                  Value := TrimRight(Value);
  2558.                  _StrToAnsi(Value);
  2559.                  StrPCopy(PChar(pBuff), Value);
  2560.                 end;
  2561.                ttPARADOX3..ttPARADOX7:
  2562.                 begin
  2563.                 end;{ Paradox }
  2564.                end;{ case }
  2565.   uftSmallint: case( Handle^ .iTblType )of
  2566.                ttDBASE3..ttDBASE7,
  2567.                ttFOXPRO1..ttFOXPRO4:
  2568.                 begin
  2569.                   Value := PChar(pBuff);
  2570.                   Val(Value, Int16, Rslt);
  2571.                   if( Rslt = 0 )then
  2572.                   SmallInt(pBuff^) := Int16
  2573.                   else
  2574.                   SmallInt(pBuff^) := 0;
  2575.                 end;{ dBase }
  2576.                ttPARADOX3..ttPARADOX7:
  2577.                 begin
  2578.                  _PdxToSmall(pBuff);
  2579.                 end;{ Paradox }
  2580.                end;{ case }
  2581.   uftInteger,
  2582.   uftAutoInc:  case( Handle^.iTblType )of
  2583.                ttDBASE3..ttDBASE7,
  2584.                ttFOXPRO1..ttFOXPRO4:
  2585.                 begin
  2586.                  Value := PChar(pBuff);
  2587.                  Val(Value, Int32, Rslt);
  2588.                  if( Rslt = 0 )then
  2589.                  Integer(pBuff^) := Int32
  2590.                  else
  2591.                  Integer(pBuff^) := 0;
  2592.                 end;{ dBase }
  2593.                ttPARADOX3..ttPARADOX7:
  2594.                 begin
  2595.                  _PdxToInt(pBuff);
  2596.                 end;{ Paradox }
  2597.                end;{ case }
  2598.   uftFloat:    case( Handle^.iTblType )of
  2599.                ttDBASE3..ttDBASE7:
  2600.                 begin
  2601.                  Value := PChar(pBuff);
  2602.                  Val(Value, Dbl, Rslt);
  2603.                  if( Rslt = 0 )then
  2604.                  Double(pBuff^) := Dbl
  2605.                  else
  2606.                  Double(pBuff^) := 0;
  2607.                 end;{ dBase }
  2608.                ttCLARION1..ttCLARION2:
  2609.                 begin
  2610.                  if( pFld^.iSubType = sftBCD )then
  2611.                  begin
  2612.                   _Move(pBuff, @Buf, pFld^.iFldSize);
  2613.                   Dbl := 0;
  2614.                   for I := 1 to pFld^.iFldSize - 1 do
  2615.                   begin
  2616.                    Card := 1;
  2617.                    for F := 1 to I do Card := Card * Card;
  2618.                    Dbl := Dbl + (Buf[I] div 16) * Card * 10;
  2619.                    Dbl := Dbl + (Buf[I] mod 16) * Card;
  2620.                   end;
  2621.                   { znak }
  2622.                   if( Buf[0] div 16 ) <> 0 then Dbl := Dbl * -1;
  2623.                   { decimal }
  2624.                   //for F := 1 to pFld^.iFldDec - 1 do Dbl := Dbl / 10;
  2625.                   Double(pBuff^) := Dbl;
  2626.                  end else
  2627.                  begin
  2628.                   Value := PChar(pBuff);
  2629.                   Val(Value, Dbl, Rslt);
  2630.                   if( Rslt = 0 )then
  2631.                   Double(pBuff^) := Dbl
  2632.                   else
  2633.                   Double(pBuff^) := 0;
  2634.                  end;
  2635.                 end;{ Clarion }
  2636.                ttPARADOX3..ttPARADOX7:
  2637.                 begin
  2638.                  _PdxToDouble(pBuff);
  2639.                 end;{ Paradox }
  2640.                end;{ case }
  2641.   uftCurrency: case( Handle^.iTblType )of
  2642.                ttPARADOX3..ttPARADOX7:
  2643.                 begin
  2644.                  _PdxToDouble(pBuff);
  2645.                 end;{ Paradox }
  2646.                end;{ case }
  2647.   uftDate:     case( Handle^.iTblType )of
  2648.                ttDBASE3..ttDBASE7:
  2649.                 begin
  2650.                  pDate := pBuff;
  2651.                  Year  := StrToIntDef(pDate^.Year, 0);
  2652.                  Month := StrToIntDef(pDate^.Month, 1);
  2653.                  Day   := StrToIntDef(pDate^.Day, 1);
  2654.                  if( Day = 0 )then Day := 1;
  2655.                  if( Month = 0 )then Month := 1;
  2656.                  if( Year < 1900 )or( Year > 2100 )then Year := 1900;
  2657.                  try
  2658.                   EDate := EncodeDate(Year, Month, Day);
  2659.                   Integer(pBuff^) := DateTimeToTimeStamp(EDate).Date;
  2660.                  except
  2661.                   Integer(pBuff^) := 0;
  2662.                  end;
  2663.                 end;{ dBase }
  2664.                ttCLARION1..ttCLARION2:
  2665.                 begin
  2666.                  Integer(pBuff^) := DateTimeToTimeStamp(Integer(pBuff^) - DELTA_DAYS).Date;
  2667.                 end;{ clarion }
  2668.                ttPARADOX3..ttPARADOX7:
  2669.                 begin
  2670.                  _PdxToInt(pBuff);
  2671.                 end;{ Paradox }
  2672.                end;{ case }
  2673.   uftBCD:      case( Handle^.iTblType )of
  2674.                ttCLARION1..ttCLARION2:
  2675.                 begin
  2676.                 end;{ clarion }
  2677.                end;{ case }
  2678.   uftBoolean:  case( Handle^.iTblType )of
  2679.                ttDBASE3..ttDBASE7,
  2680.                ttFOXPRO1..ttFOXPRO4:
  2681.                 begin
  2682.                  _Move(pBuff, @Buf, pFld^.iPhysLen);
  2683.                  if Char(Buf[0]) = 'T'then
  2684.                   WordBool(pBuff^) := True else
  2685.                  if Char(Buf[0]) = 'F'then
  2686.                   WordBool(pBuff^) := False;
  2687.                 end;{ dBase }
  2688.                end;{ case }
  2689.   end;{ case }
  2690. end;{ func }
  2691.  
  2692. function ALPIDEToData (                { Set a formatted value }
  2693.       Handle        : ALP_HANDLE;      { Cursor }
  2694.       pFld          : pFldDesc;         { Field pointer }
  2695.       pBuff         : Pointer           { Value buffer }
  2696.    ): ALPResult;
  2697. var
  2698.  Int16 : SmallInt;
  2699.  Int32 : Integer;
  2700.  Dbl   : Double;
  2701.  TStmp : TTimeStamp;
  2702.  Value : string;
  2703.  Bool  : Boolean;
  2704.  Buf   : array [0..31] of Byte;
  2705. begin
  2706.   case( pFld^.iFldType )of
  2707.   uftString:   case( Handle^.iTblType )of
  2708.                ttDBASE3..ttDBASE7,
  2709.                ttFOXPRO1..ttFOXPRO4,
  2710.                ttCLARION1..ttCLARION2:
  2711.                 begin
  2712.                  CharToOemBuff( PChar(pBuff), PChar(pBuff), StrLen(PChar(pBuff)));
  2713.                 end;{ clarion }
  2714.                end;{ case }
  2715.   uftSmallint: case( Handle^ .iTblType )of
  2716.                ttDBASE3..ttDBASE7,
  2717.                ttFOXPRO1..ttFOXPRO4:
  2718.                 begin
  2719.                  Int16 := SmallInt( pBuff^ );
  2720.                  Str(Int16, Value);
  2721.                  StrPCopy(PChar(pBuff), Value);
  2722.                 end;{ dBase }
  2723.                ttPARADOX3..ttPARADOX7:
  2724.                 begin
  2725.                  _SmallToPdx(pBuff);
  2726.                 end;{ Paradox }
  2727.                end;{ case }
  2728.   uftInteger:  case( Handle^.iTblType )of
  2729.                ttDBASE3..ttDBASE7,
  2730.                ttFOXPRO1..ttFOXPRO4:
  2731.                 begin
  2732.                  Int32 := Integer( pBuff^ );
  2733.                  Str(Int32, Value);
  2734.                  StrPCopy(PChar(pBuff), Value);
  2735.                 end;{ dBase }
  2736.                ttPARADOX3..ttPARADOX7:
  2737.                 begin
  2738.                  _IntToPdx(pBuff);
  2739.                 end;{ Paradox }
  2740.                end;{ case }
  2741.   uftFloat:    case( Handle^.iTblType )of
  2742.                ttDBASE3..ttDBASE7,
  2743.                ttFOXPRO1..ttFOXPRO4:
  2744.                 begin
  2745.                  Dbl := Double( pBuff^ );
  2746.                  Str(Dbl:pFld^.iPhysLen:pFld^.iFldDec, Value);
  2747.                  StrPCopy(PChar(pBuff), Value);
  2748.                 end;{ dBase }
  2749.                ttPARADOX3..ttPARADOX7:
  2750.                 begin
  2751.                  _DoubleToPdx(pBuff);
  2752.                 end;{ Paradox }
  2753.                end;{ case }
  2754.   uftCurrency: case( Handle^.iTblType )of
  2755.                ttPARADOX3..ttPARADOX7:
  2756.                 begin
  2757.                  _DoubleToPdx(pBuff);
  2758.                 end;{ Paradox }
  2759.                end;{ case }
  2760.   uftBoolean:  case( Handle^.iTblType )of
  2761.                ttDBASE3..ttDBASE7,
  2762.                ttFOXPRO1..ttFOXPRO4:
  2763.                 begin
  2764.                  Bool := Boolean( pBuff^ );
  2765.                  if Bool then
  2766.                  StrPCopy(PChar(pBuff), 'T')else
  2767.                  StrPCopy(PChar(pBuff), 'F');
  2768.                 end;{ dBase }
  2769.                end;{ case }
  2770.   uftDate:     case( Handle^.iTblType )of
  2771.                ttDBASE3..ttDBASE7, ttFOXPRO1..ttFOXPRO4:
  2772.                 begin
  2773.                  TStmp.Time := 0;
  2774.                  TStmp.Date := Integer(pBuff^);
  2775.                  Int32 := Trunc(TimeStampToDateTime(TStmp));
  2776.                  StrPCopy(PChar(pBuff), FormatDateTime('yyyymmdd', Int32));
  2777.                 end;{ dBase }
  2778.                ttCLARION1..ttCLARION2:
  2779.                 begin
  2780.                  TStmp.Time := 0;
  2781.                  TStmp.Date := Integer(pBuff^) + DELTA_DAYS;
  2782.                  Integer(pBuff^) := Trunc(TimeStampToDateTime(TStmp));
  2783.                 end;{ dBase }
  2784.                ttPARADOX3..ttPARADOX7:
  2785.                 begin
  2786.                  _IntToPdx(pBuff);
  2787.                 end;{ Paradox }
  2788.                end;{ case }
  2789.   end;{ case }
  2790. end;{ func }
  2791.  
  2792. end.
  2793.