{ idxpdox.pas }
program IdxPdox;

{$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 = szPARADOX;    { 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:      'First Name'; { 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:      'Middle Name';
                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:      'Last Name';
                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 Descriptors }
idxDes: array[0..2] of IDXDesc = (
            ( { Primary Index - Full Name }
                szName:           'Full Name';  { Name }
                iIndexId:         1;            { Number }
                szTagName:        '';           { Tag Name ( for dBase ) }
                szFormat:         '';           { Optional Format }
                bPrimary:         TRUE;         { Primary? }
                bUnique:          TRUE;         { Unique? }
                bDescending:      FALSE;        { Descending? }
                bMaintained:      TRUE;         { Maintained? }
                bSubset:          FALSE;        { SubSet? }
                bExpIdx:          FALSE;        { 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:         '';           { 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)
            ),
            (  { Secondary Index 1 - Single-Field - Maintained,
                 Case insensitive }
                szName:           'Last Name'; iIndexId:         2;
                szTagName:        ''; 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: TRUE; iBlockSize:       0;
                iRestrNum:        0;
                iUnUsed:          (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
            ),
            (  { Secondary Index 2 - Single Field - Not Maintained }
                szName:           'POB'; iIndexId:         3;
                szTagName:        ''; szFormat:         '';
                bPrimary:         FALSE; bUnique:          FALSE;
                bDescending:      FALSE; bMaintained:      FALSE;
                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)
            )
        );

{ Index Descriptor - Describes the indexes associated with the
  table. This index will be added to the table after the table
  has been created. } 
idxDesc1: IDXDesc = (
             { Secondary Index 3 - Multi-Field - Maintained }
                szName:           'Name'; iIndexId:         4;
                szTagName:        ''; szFormat:         '';
                bPrimary:         FALSE; bUnique:          FALSE;
                bDescending:      FALSE; bMaintained:      TRUE;
                bSubset:          FALSE; bExpIdx:          FALSE;
                iCost:            0; iFldsInKey:       2;
                iKeyLen:          1; bOutofDate:       FALSE;
                iKeyExpType:      0;
                aiKeyFld:         (3,1,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)
         );

{=====================================================================
 ===================================================================== }
function TrueOrFalse (bTemp: Bool): String;
begin
    if (bTemp) then
        TrueOrFalse := 'TRUE'
    else
        TrueOrFalse := 'FALSE';
end;

{=====================================================================
   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;

    {  Make sure we're starting with a clean record buffer }
    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:   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 }
    uNumFields, uNumIndexes: INT16;

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

begin
    { The number of fields in the table - note that fldDesc is defined
      globally }
    uNumFields := trunc(sizeof(fldDes) / sizeof (fldDes[0]));

    { Number of indexes to be created when the table is created - note
      that idxDesc is defined globally. }
    uNumIndexes := trunc(sizeof(idxDes) / sizeof(idxDes[0]));

    { Initialize the table create descriptor. }
    FillChar(crTblDes, sizeof(CRTblDesc), #0); { Clear the buffer. }
    StrCopy(crTblDes.szTblName, szTblName) ; { name of the table }
    StrCopy(crTblDes.szTblType, szTblType) ; { Type of table }
    crTblDes.iFldCount     := uNumFields ;   { number of fields }
    crTblDes.pfldDesc      := @fldDes ;      { Field descriptor }
    crTblDes.iIdxCount     := uNumIndexes ;  { Number of indexes }
    crTblDes.pidxDesc      := @idxDes ;      { Index descriptor }

    Screen('    Creating the '+szTblName+' table...');
    rslt := ChkRslt(DbiCreateTable(phDb, bOverWrite, crTblDes),
                        DBIERR_NONE, '    Error - CreateTable.');
    if (rslt <> DBIERR_NONE) then
    begin
        InitTable := rslt;
        exit;
    end;

    rslt := ChkRslt(DbiOpenTable(phDb, pCHAR(szTblName),
                                     pCHAR(szTblType), nil, nil, 0,
                                     dbiREADWRITE, dbiOPENSHARED,
                                     xltFIELD, FALSE, nil, hCur),
                        DBIERR_NONE, '    Error - OpenTable.');
    if (rslt <> DBIERR_NONE) then
    begin
        InitTable := rslt;
        exit;
    end;

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

    ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE, 
            '    Error - CloseCursor.');

    InitTable := rslt;
end;

{=====================================================================
   Code:   IndexPDox();

   Input:  None.

   Return: None.

   Description:
           This example shows how to craete and add Paradox indexes.
           This encludes creating primary indexes and maintaining
           secondary indexes (if needed).
 ===================================================================== }

var
    hDb: hDBIDb;              { Database handle }
    hCur: hDBICur;            { Cursor handle }
    TblProps: CURProps;       { Table Properties }
    MyDesc: pIDXDesc;         { Index Descriptor }
    i: UINT16;                { Loop variable }
    szTemp: PChar;

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

    Screen('    Initializing IDAPI...');
    if (InitAndConnect(hDb) <> DBIERR_NONE) then
    begin
        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 fill with data }
    if (InitTable(hDb) <> DBIERR_NONE) then
    begin
        Screen('    Clean up IDAPI...');
        CloseDbAndExit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    { Add an index to the table. Note that the index is added to the
      table before the table is opened - the table must either be closed
      or opened in exclusive mode in order to an an Index. }
    Screen('        Add an Index to the table...');
    ChkRslt(DbiAddIndex(hDb, nil, pCHAR(szTblName),
                          pCHAR(szTblType), idxDesc1, nil), DBIERR_NONE,
            '    Error - AddIndex.');

    Screen('        Open the '+szTblName+' table...');
    if (ChkRslt(DbiOpenTable(hDb, pCHAR(szTblName), pCHAR(szTblType),
                             nil, nil, 0, dbiREADWRITE, dbiOPENSHARED,
                             xltFIELD, FALSE, nil, hCur),
        DBIERR_NONE, '    Error - OpenTable.') <> DBIERR_NONE) then
    begin
        CloseDbAndExit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    Screen('    Get the number of indexes on the '+szTblName+'table...');
    ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
            '    Error - GetCursorProps.');

    Screen('    There are '+IntToStr(TblProps.iIndexes)+' indexes on the table');

    { Allocate space for the index descriptor. }
    GetMem(MyDesc, sizeof(IDXDesc) * TblProps.iIndexes);
    if not Assigned(MyDesc) then
    begin
        Screen('       Error - Out of Memory.');
        CloseDbAndExit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    Screen('    Get and display information about the indexes');
    Screen('');
    Screen('        Name           ID    Primary Maintained '+
                 'Fields Case_Insensitive');
    Screen('        =================================================='+
           '==========');
    GetMem(szTemp, 50);
    for i := 1 to TblProps.iIndexes do
    begin
        ChkRslt(DbiGetIndexDesc(hCur, i, MyDesc^),
                DBIERR_NONE, '    Error - GetIndexDesc.');

        if (StrComp(MyDesc^.szName, '') = 0) then
           { Primary index don't have names }
           StrCopy(szTemp, '*Primary Index*')
        else
           StrCopy(szTemp, RightPad(szTemp, MyDesc^.szName, 13 ));

        Screen('        '+StrPas(szTemp)+'   '+IntToStr(MyDesc^.iIndexId)+' '+
               ''+TrueOrFalse(MyDesc^.bPrimary)+'     '+
               ''+TrueOrFalse(MyDesc^.bMaintained)+'    '+
               ''+IntToStr(MyDesc^.iFldsInKey)+'     '+
               ''+TrueOrFalse(MyDesc^.bCaseInsensitive)+'  ');
        Inc(MyDesc);
    end;
    Dec(MyDesc, TblProps.iIndexes);

    ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
            '    Error - SetToBegin.');

    { Display the records in the table. The order of the records depends
      on the active index - in this case, it is the primary Index. }
    Screen('');
    Screen('    Display the records in the table in the order of the'+
           ' primary');
    Screen('    index - First, Middle, Last.');
    DisplayTable(hCur, 0);

    { Switch the index which the table is opened on - only need to
      provide one of the following: IndexName, TagName, or IndexId. }
    Screen('');
    Screen('    Change the table to be opened on the "Last Name"'+
           ' index...');
    ChkRslt(DbiSwitchToIndex(hCur, 'Last Name', nil, 0, FALSE),
            DBIERR_NONE, '    Error - SwitchToIndex.');

    ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
            '    Error - SetToBegin.');

    Screen('    Display the records in the table in the order of the '+
           '"Last Name" index...');
    DisplayTable(hCur, 0);

    Screen('');
    Screen('    Add a record to the table in order to invalidate...'+
           ' non-maintained indexes');
    AddRecord(hCur, 'Jerry', 'Joel', 'Raccah', 5, 22, 1958,
              'Lake Tahoe');

    { Switch the index which the table is opened on - only need to
      provide one of the following: IndexName, TagName, or IndexId.
      This function here is passed an ID of 5 which is the
      id of the single field that it is indexing on. }
    Screen('');
    Screen('    Change the table to be opened on the "POB"'+
           ' index (which is non-maintained)...');
    Screen('    Note that we expect an error - the "POB" index is' +
           ' not maintained');
    Screen('');
    ChkRslt(DbiSwitchToIndex(hCur, nil, nil, 5, FALSE),
            DBIERR_NONE, '        Error - SwitchToIndex.');

    Screen('');
    Screen('    Steps to regenerate the "POB" index...');
    Screen('        Close the Table - the table must be open in' +
           ' Exclusive mode to Regenerate');
    Screen('        the indexes...');

    ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
            '    Error - CloseCursor.');

    Screen('        Open the table in Exclusive mode...');
    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;

    Screen('        Regenerate the index...');
    ChkRslt(DbiRegenIndex(hDb, hCur, pCHAR(szTblName),
                          pCHAR(szTblType), 'POB', nil, 5),
            DBIERR_NONE, '        Error - RegenIndexes.');

    { Switch the index which the table is opened on - only need to
      provide one of the following: IndexName, TagName, or IndexId
      (parameter 2, 3, or 4 to DbiSwitchToIndex). }
    Screen('');
    Screen('    Change the table to be opened on the "POB"' +
           ' index (which is non-maintained)...');
    ChkRslt(DbiSwitchToIndex(hCur, 'POB', nil, 0, FALSE),
            DBIERR_NONE, '        Error - SwitchToIndex.');

    ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
            '    Error - SetToBegin.');

    Screen('    Display the records in the table in the order of the'+
           '"POB" (Place of Birth)');
    Screen('    index...');
    DisplayTable(hCur, 0);

    { Note that the table has to be opened either in Exclusive
      Mode or closed to delete an index. }
    Screen('');
    Screen('    Delete the "Last Name" index...');
    ChkRslt(DbiDeleteIndex(hDb, nil, pCHAR(szTblName),
                           pCHAR(szTblType), 'Last Name', '', 0),
            DBIERR_NONE, '  Error - DeleteIndex.');

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

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

    FreeMem(MyDesc, sizeof(IDXDesc) * TblProps.iIndexes);

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

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

end.