{ idxdbase.pas }
program IdxDbase;

{$IfDef VER80}
uses SnipTool, SnipData, SysUtils, WinTypes, WinProcs,
     DbiProcs, DbiTypes, DbiErrs;
{$Else}
uses WinTypes, WinCrt, Strings, DbiProcs, DbiTypes, DbiErrs,
     SnipTool, SnipData;
{$EndIf}

const
  NAMELEN  = 10; { Set the length of the name fields; }
  PLACELEN = 20; { Set the length of the POB field; }
  DATELEN  = 11; { Length that a date will be displayed: mm\dd\yyyy; }

  szTblName = 'people';  { Name of table to be created. }
  szTblType = szDBASE;   { Table type to use. }


{ Field Descriptor used in creating a table }
fldDes: array[0..4] of FLDDesc = (
              ( { Field 1 - First Name }
              iFldNum:     1;            { Field Number }
              szName:      'FirstName';  { Field Name }
              iFldType:    fldZSTRING;   { Field Type }
              iSubType:    fldUNKNOWN;   { Field Subtype }
              iUnits1:     NAMELEN;      { Field Size ( 1 or 0) }
              iUnits2:     0;            { Decimal places ( 0 ) }
              iOffset:     0;            { Offset in record ( 0 ) }
              iLen:        0;            { Length in Bytes  ( 0 ) }
              iNullOffset: 0;            { For Null Bits    ( 0 ) }
              efldvVchk:   fldvNOCHECKS; { Validiy checks   ( 0 ) }
              efldrRights: fldrREADWRITE { Rights }
                          ),
              ( { Field 2 - Middle Name }
              iFldNum:     2; szName:      'MidName';
              iFldType:    fldZSTRING; iSubType:    fldUNKNOWN;
              iUnits1:     NAMELEN; iUnits2:     0; 
              iOffset:     0; iLen:        0; 
              iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
              efldrRights: fldrREADWRITE
                          ),
              ( { Field 3 - Last Name }
              iFldNum:     3; szName:      'LName'; 
              iFldType:    fldZSTRING; iSubType:    fldUNKNOWN;
              iUnits1:     NAMELEN; iUnits2:     0; 
              iOffset:     0; iLen:        0; 
              iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
              efldrRights: fldrREADWRITE
                          ),
              ( { Field 4 - Date of Birth }
              iFldNum:     4; szName:      'DOB'; 
              iFldType:    fldDATE; iSubType:    fldUNKNOWN;
              iUnits1:     0; iUnits2:     0; 
              iOffset:     0; iLen:        0;
              iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
              efldrRights: fldrREADWRITE
                          ),
              ( { Field 5 - Place of Birth }
              iFldNum:     5; szName:      'POB';
              iFldType:    fldZSTRING; iSubType:    fldUNKNOWN;
              iUnits1:     PLACELEN; iUnits2:     0;
              iOffset:     0; iLen:        0; 
              iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
              efldrRights: fldrREADWRITE
              )
          );  { Array of field descriptors }

{ Index Descriptor - describes the Indexe associated with the
  table. }
idxDes: array[0..2] of IDXDesc = (
              (  { Multi-Field Production Index }
              szName:           '';           { Name }
              iIndexId:         0;         { Number }
              szTagName:        'FNAME';    { Tag Name ( for dBASE ) }
              szFormat:         '';     { Optional Format }
              bPrimary:         FALSE;        { Primary? }
              bUnique:          FALSE;        { Unique? }
              bDescending:      FALSE;        { Descending? }
              bMaintained:      TRUE;         { Maintained? }
              bSubset:          FALSE;        { SubSet? }
              bExpIdx:          TRUE;         { Expression index? }
              iCost:            0;         { for QBE only }
              iFldsInKey:       3;            { Fields in key }
              iKeyLen:          1;            { Length in bytes }
              bOutofDate:       FALSE;        { Index out of date? }
              iKeyExpType:      0;            { Key Type of Expression }
              aiKeyFld:         (1,2,3,0,0,0,0,0,0,0,0,0,0,0,0,0);
                                              { Array of field numbers }
              szKeyExp:         'FirstName + MidName + LName';{ Key expression }
              szKeyCond:        '';           { Key Condition }
              bCaseInsensitive: FALSE;        { Case insensitive }
              iBlockSize:       0;            { Block size in bytes }
              iRestrNum:        0;            { Restructure number }
              iUnUsed:          (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
              ),
              (  { Single-Field Production index }
              szName:           ''; iIndexId:         0;
              szTagName:        'LNAME'; szFormat:         '';
              bPrimary:         FALSE; bUnique:          FALSE;
              bDescending:      FALSE; bMaintained:      TRUE;
              bSubset:          FALSE; bExpIdx:          FALSE;
              iCost:            0; iFldsInKey:       1;
              iKeyLen:          1; bOutofDate:       FALSE;
              iKeyExpType:      0;
              aiKeyFld:         (3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
              szKeyExp:         ''; szKeyCond:        '';
              bCaseInsensitive: FALSE; iBlockSize:       0;
              iRestrNum:        0;
              iUnUsed:          (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
              ),
              (  { Single-Field Production index }
              szName:           ''; iIndexId:         0;
              szTagName:        'POB'; szFormat:         '';
              bPrimary:         FALSE; bUnique:          FALSE;
              bDescending:      FALSE; bMaintained:      TRUE;
              bSubset:          FALSE; bExpIdx:          FALSE;
              iCost:            0; iFldsInKey:       1;
              iKeyLen:          1; bOutofDate:       FALSE;
              iKeyExpType:      0;
              aiKeyFld:         (5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
              szKeyExp:         ''; szKeyCond:        '';
              bCaseInsensitive: FALSE; iBlockSize:       0;
              iRestrNum:        0;
              iUnUsed:          (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
              )
          );

idxDes1: IDXDesc = (
              { Multi-Field; non-maintained dBASE index }
              szName:           'FULLNAME.NDX'; iIndexId:         0;
              szTagName:        ''; szFormat:         '';
              bPrimary:         FALSE; bUnique:          FALSE;
              bDescending:      FALSE; bMaintained:      FALSE;
              bSubset:          FALSE; bExpIdx:          TRUE;
              iCost:            0; iFldsInKey:       2;
              iKeyLen:          1; bOutofDate:       FALSE;
              iKeyExpType:      0;
              aiKeyFld:         (1,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
              szKeyExp:         'FirstName + LName'; szKeyCond:        '';
              bCaseInsensitive: FALSE; iBlockSize:       0;
              iRestrNum:        0;
              iUnUsed:          (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
           );



{=====================================================================
   Code:   AddRecord();

   Input:  pointer to the cursor handle, first name (pCHAR), middle
           name (pCHAR), last name (pCHAR), Month of Birth (UINT16), Day
           of Birth (UINT16), Year of Birth (UINT16), Place of birth
           (pCHAR).

   Return: Result of adding the record to the table

   Description:
           This function will add a record to the given table.
 ===================================================================== }
Function
AddRecord (hCur: hDBICur; pszFirst: pCHAR; pszMiddle: 
           pCHAR; pszLast: pCHAR; uMonth: UINT16; uDay: UINT16; 
           uYear: UINT16; pszPOB: pCHAR): DBIResult;

var
    dDate: DATE;           { Date structure }
    rslt: DBIResult;       { Value returned from IDAPI functions }
    TblProps: CURProps;    { Table Properties }
    pRecBuf: pBYTE;        { Record Buffer }

begin
    {  Allocate a record buffer }
    ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
            '    Error - GetCursorProps.');

    GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
    if not Assigned(pRecBuf) then
    begin
        AddRecord := DBIERR_NOMEMORY;
        exit;
    end;

    ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
            '    Error - InitRecord.');

    { First Name }
    ChkRslt(DbiPutField(hCur, 1, pRecBuf, pBYTE(pszFirst)),
            DBIERR_NONE, '    Error - PutField.');

    { Middle Name }
    ChkRslt(DbiPutField(hCur, 2, pRecBuf, pBYTE(pszMiddle)),
            DBIERR_NONE, '    Error - PutField.');

    { Last Name }
    ChkRslt(DbiPutField(hCur, 3, pRecBuf, pBYTE(pszLast)),
            DBIERR_NONE, '    Error - PutField.');

    { DOB }
    ChkRslt(DbiDateEncode(uMonth, uDay, uYear, dDate),
            DBIERR_NONE, '    Error - DateEncode.');
    ChkRslt(DbiPutField(hCur, 4,  pRecBuf, @dDate),
            DBIERR_NONE, '    Error - PutField.');

    { Place fo Birth }
    ChkRslt(DbiPutField(hCur, 5,  pRecBuf, pBYTE(pszPOB)),
            DBIERR_NONE, '    Error - PutField.');

    rslt := ChkRslt(DbiInsertRecord(hCur, dbiNOLOCK, pRecBuf),
                   DBIERR_NONE, '    Error - InsertRecord.');

    FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));

    AddRecord := rslt;
end;


{=====================================================================
   Code:   GoTop()

   Input:  Handle to the table's cursor.

   Return: Nothing.

   Description:
           This function will move the cursor to the top of the table
           that it is set to.
 ===================================================================== }
procedure GoTop (hCur: hDBICur);
begin
    { This will set the cursor to the top of table(BOF).  However, the
      cursor is on the crack so one needs to move to the top. }
    ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE, '    Error - SetToBegin.');

    { Now get the next record with no lock to move on top of the first
      record. }
    ChkRslt(DbiGetNextRecord(hCur, dbiNOLOCK, nil, nil), DBIERR_NONE,
            '    Error - GetNextRecord.');
end;

{=====================================================================
   Code:   InitTable();

   Input:  pointer to the database handle.

   Return: result of the table initialization.

   Description:
           This function will create a table and fill the table
           with a number of records.  The function uses
           another function called AddRecord which adds records to
           the table.
 ===================================================================== }
function InitTable (phDb: hDBIDb): DBIResult;

var
    rslt: DBIResult;                { Value returned from IDAPI functions }
    hCur: hDBICur;                  { Cursor handle for the table that is
                                      created }
    crTblDes: CRTblDesc;            { Table Descriptor }
    MyDesc: pIDXDesc;               { Index Descriptor }
    uNumFields, uNumIndexes: INT16;

const
    bOverWrite: BOOL = TRUE;        { Overwrite, yes/no flag }

begin
    { The number of fields in the table }
     uNumFields := trunc(sizeof(fldDes) / sizeof (fldDes[0]));

    { Number of indexes to be created when the table is created }
    uNumIndexes := trunc(sizeof(idxDes) / sizeof(idxDes[0]));

    FillChar(crTblDes, sizeof(CRTblDesc), #0); { Clear the buffer. }

    { Set the name and the type of the table }
    StrCopy(crTblDes.szTblName, szTblName) ; { name of the table }
    StrCopy(crTblDes.szTblType, szTblType) ; { Type of table }

    { Set the field information for the table }
    crTblDes.iFldCount     := uNumFields ;   { number of fields }
    crTblDes.pfldDesc      := @fldDes ;      { Field descriptor }

    { Set the index information for the table }
    crTblDes.iIdxCount     := uNumIndexes ;  { Number of indexes }
    crTblDes.pidxDesc      := @idxDes ;      { Index descriptor }

    { Create the table using information supplied in the Table
      Descrpitor above }
    Screen('    Creating table and indexes...');
    rslt := ChkRslt(DbiCreateTable(phDb, bOverWrite, crTblDes),
                        DBIERR_NONE, '    Error - CreateTable.');
    if (rslt <> DBIERR_NONE) then
    begin
        InitTable := rslt;
        exit;
    end;

    ChkRslt(DbiOpenTable(phDb, pCHAR(szTblName), pCHAR(szTblType),
                           nil, nil, 0, dbiREADWRITE, dbiOPENSHARED,
                           xltFIELD, FALSE, nil, hCur),
            DBIERR_NONE, '    Error - OpenTable.');

    { Add records to the table }
    Screen('    Adding Records to the table...');
    rslt := AddRecord(hCur, 'Klaus', 'John', 'Lockwood', 7, 28, 1968,
                     'Chicago');
    rslt := AddRecord(hCur, 'Ann', 'Tracy', 'Brown', 12, 27, 1969,
                     'Hermosa Beach');
    rslt := AddRecord(hCur, 'John', 'Boy', 'Krull', 2, 7, 1954,
                     'Ohmaha');
    rslt := AddRecord(hCur, 'Goliath', 'Joel', 'Raccah', 4, 13, 1970,
                     'Tel Aviv');

    { Close the table so it can be reopened from the calling function. }
    ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
            '    Error - CloseCursor.');

    InitTable := rslt;
end;

{=====================================================================
   Code:   IndexDBase();

   Input:  None.

   Return: None.

   Description:
           This example shows how to setup a dBASE table and dBASE
           indexes.  This includes expression indexes(multiple field
           indexes) and the particular needs of the common dBASE index.
 ===================================================================== }

var
    hDb: hDBIDb;            { Database handle }
    hCur: hDBICur;          { Cursor handle }
    MyDesc: pIDXDesc;       { Index Descriptor }

begin
    Screen('*** dBASE Index Example ***');
    Screen('');

    Screen('    Initializing IDAPI...');
    if (InitAndConnect(hDb) <> DBIERR_NONE) then { Terminate example if }
    begin                                        { Initialization fails }
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    Screen('    Setting the default Database directory...');
    ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
            '    Error - SetDirectory.');

    { Create the table and insert four records }
    if (InitTable(hDb) <> DBIERR_NONE) then
    begin
        CloseDbAndExit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    Screen('    Open the table which we just created in exclusive'+
           ' mode ');
    Screen('    (required in order to add an index to a'+
           ' dBASE table)...');
    if (ChkRslt(DbiOpenTable(hDb, pCHAR(szTblName), pCHAR(szTblType),
                             nil, nil, 0, dbiREADWRITE, dbiOPENEXCL,
                             xltFIELD, FALSE, nil, hCur),
        DBIERR_NONE, '    Error - OpenTable.') <> DBIERR_NONE) then
    begin
        CloseDbAndExit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    { Now add the new index to the table.  To add an index we must have
      an exclusive lock on the table which we acquired when opening the
      table. }
    Screen('    Adding another Index to the table...');
    ChkRslt(DbiAddIndex(hDb, hCur, pCHAR(szTblName), pCHAR(szTblType),
                        idxDes1, nil), DBIERR_NONE,
            '    Error - AddIndex.');

    { Close the index. In dBASE, after closing a non-maintained
      index will not be kept up-to-date. }
    Screen('    Closing the non-maintained index we just added...');
    ChkRslt(DbiCloseIndex(hCur, 'FULLNAME.NDX', 0), DBIERR_NONE,
            '    Error - CloseIndex.');

    { Now add a record to the table to make the index out of date. }
    Screen('    Adding a record to invalidate the index...');
    ChkRslt(AddRecord(hCur, 'Charlie', 'Joel', 'Waternon', 5, 21, 1983,
                      'California'), DBIERR_NONE,
            '   Error - AddRecord.');

    { Open the added index using OpenIndex a function that is DBase
      specific. }
    Screen('    Open the new index to show that it is out of date...');
    ChkRslt(DbiOpenIndex(hCur, 'FULLNAME.NDX', 0), DBIERR_NONE,
            '    Error - OpenIndex.');

    { Opening the index does not make it the current index.  To make the
      index current we need to switch to it. For a non maintained .NDX
      index, we need to supply the index name. }

    Screen('    Switch to the newly created index that is out of date...');
    ChkRslt(DbiSwitchToIndex(hCur, 'FULLNAME.NDX', nil, 0, FALSE),
            DBIERR_NONE, '    Error - SwitchToIndex.');

    Screen('    Display the table...');
    Screen('');
    Screen('    Note that only 4 entries are displayed even'+
                ' though there are 5 ');
    Screen('    entries in the table'+
                ' because the index is out of date...');
    ChkRslt(DisplayTable(hCur, 0), DBIERR_NONE,
            '    Error - DisplayTable.');

    { Switch to default order.  We cannot regen the index if it is the
      currently active index on the cursor. }
    Screen('');
    Screen('    Switching to default order...');

    ChkRslt (DbiSwitchToIndex(hCur, nil, nil, 0, FALSE),
                          DBIERR_NONE, 'SwitchToIndex');

    Screen('');
    Screen('    Regenerating the index...');
    ChkRslt(DbiRegenIndex(hDb, hCur, pCHAR(szTblName), pCHAR(szTblType),
                          'FULLNAME.NDX', nil, 0), DBIERR_NONE,
                          '    Error - RegenIndex.');

    { Switch back to the non-maintained index. It should now be up-to-date. }
    Screen('    Switch to the newly regenerated index...');
    ChkRslt ( DbiSwitchToIndex(hCur, 'FULLNAME.NDX', nil, 0, FALSE),
                          DBIERR_NONE, 'SwitchToIndex');

    Screen('    Display the table according to the new index...');
    ChkRslt(DisplayTable(hCur, 0), DBIERR_NONE,
            '    Error - Display Table.');

    { Now case the index to no index.  This is beacuse the default
      index for dBASE is no index so passing nil for all three options
      will return a cursor that has no order other than the order in
      which the records were inserted. }
    Screen('');
    Screen('    Switching index to show record order...');
    ChkRslt(DbiSwitchToIndex(hCur, nil, nil, 0, FALSE),
                             DBIERR_NONE, '    Error - SwitchToIndex.');

    { Now re - display the table. }
    Screen('    This is the order of the table with no index...');
    ChkRslt(DisplayTable(hCur, 0), DBIERR_NONE,
            '    Error - DisplayTable.');

    { Now get memory for the index descriptor. }
    GetMem (MyDesc, sizeof(IDXDesc));
    if not Assigned(MyDesc) then
    begin
        CloseDbAndExit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    { Close the non-maintained index as we are done with this
      part of the example. }
    Screen('');
    Screen('    Closing the non-maintained index.');

    ChkRslt (DbiCloseIndex(hCur, 'FULLNAME.NDX', 0), DBIERR_NONE,
             'CloseIndex');

    { The only indexes that are open now are maintained indexes since we
      have already closed the non-maintained index. }

    { Get any index descriptor (in this case the first one). }
    ChkRslt(DbiGetIndexDesc(hCur, 1, MyDesc^), DBIERR_NONE,
            '    Error - GetIndexDesc.');

    Screen('');
    Screen('    Switching to a index in the production index... ');
    ChkRslt(DbiSwitchToIndex(hCur, MyDesc^.szName, MyDesc^.szTagName, 0,
                             FALSE), DBIERR_NONE,
                             '    Error - SwitchToIndex.');

    Screen('    This is the order of the table using a tag'+
                 ' inside the production');
    Screen('    index called '+StrPas(MyDesc^.szTagName)+' ');
    ChkRslt(DisplayTable(hCur, 0), DBIERR_NONE,
            '    Error - DisplayTable.');

    { Delete the table and its related indexes and files from disk.  To
      do this we first need to delete the NDX and then we close the
      table and delete the table.  By doing this IDAPI will delete the
      MDX file for us. }

    Screen('');
    Screen('    Must delete the FULLNAME.NDX index separately as it is not');
    Screen('    a part of the production index...');
    ChkRslt(DbiDeleteIndex(hDb, hCur, pCHAR(szTblName), pCHAR(szTblType),
            'FULLNAME.NDX', nil, 0), DBIERR_NONE,
            '    Error - DeleteIndex.');

    Screen('    Close the '+szTblName+' table...'); 
    ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
            '    Error - CloseCursor.');

    Screen('    Delete the '+szTblName+' table...'); 
    ChkRslt(DbiDeleteTable(hDb, pCHAR(szTblName), pCHAR(szTblType)),
            DBIERR_NONE, '    Error - DeleteTable.');

    FreeMem(MyDesc, sizeof(IDXDesc));

    Screen('    Close the Database and exit IDAPI...');
    CloseDbAndExit(hDb);

    Screen('');
    Screen('*** End of Example ***');

end.