{ refinteg.pas }
program RefInteg;

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

const
   szTblName = 'RefInteg'; { Name of table to be created. }
   szTblType = szPARADOX;  { Table type to use. }

{ Field Descriptor used in creating a table }
fldDes: array[0..3] of FLDDesc = (
              ( { Field 1 - AUTOINC }
                iFldNum:     1;            { Field Number }
                szName:      'Status ID';  { Field Name }
                iFldType:    fldFLOAT;     { Field Type }
                iSubType:    fldUNKNOWN;   { Field Subtype }
                iUnits1:     0;            { Field Size }
                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 - ALPHA }
                iFldNum:     2; szName:      'Order No';
                iFldType:    fldFLOAT; iSubType:    fldUNKNOWN;
                iUnits1:     0; iUnits2:     0;
                iOffset:     0; iLen:        0;
                iNullOffset: 0; efldvVchk:   fldvNOCHECKS;
                efldrRights: fldrREADWRITE
              ),
              ( { Field 4 - DATE }
                iFldNum:     3; szName:      'Date Sent';
                iFldType:    fldDATE; iSubType:    fldUNKNOWN;
                iUnits1:     0; iUnits2:     0;
                iOffset:     0; iLen:        0;
                iNullOffset: 0; efldvVchk:   fldvNOCHECKS;
                efldrRights: fldrREADWRITE
              ),
              ( { Field 4 - DATE }
                iFldNum:     4; szName:      'Date Received';
                iFldType:    fldDATE; iSubType:    fldUNKNOWN;
                iUnits1:     0; iUnits2:     0;
                iOffset:     0; iLen:        0;
                iNullOffset: 0; efldvVchk:   fldvNOCHECKS;
                efldrRights: fldrREADWRITE
              )
             ); { Array of field descriptors }


{ Array of Referential Integrity rules }
rintDes: array[0..0] of RINTDesc = (
           (
              iRintNum:        1;             { Ref Integrity Number }
              szRintName:      'Order No';    { Name for this integrity }
              eType:           rintDEPENDENT; { Whether master or dependent }
              szTblName:       'orders.db';   { Other table name }
              eModOp:          rintCASCADE;   { Modify Qualifier }
              eDelOp:          rintRESTRICT;  { Delete Modifier }
              iFldCount:       1;             { Fields in foreign key }
              aiThisTabFld:    (2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
                                              { Fields in this table }
              aiOthTabFld:     (1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
                                              { Fields in other table }
           )
                 );

{ Define the operation on the table }
crOpTyp: CROpType = ( crADD );

{ Index Descriptor - describes the Indexes associated with the
  table. This index is going to be added to the table when the
  table is created. }
idxDes: array[0..1] of IDXDesc = (
            ( { Primary Index }
               szName:           '';          { 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:       2;           { Fields in key }
               iKeyLen:          1;           { Length in bytes }
               bOutofDate:       FALSE;       { Index out of date? }
               iKeyExpType:      0;           { Key Type of Expression }
               aiKeyFld:         (1,2,0,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:           'Order No'; 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:         (2,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)
            )
        );

{=====================================================================
   Function:
           AddRecord (hDBICur hCur, FLOAT fStatus, FLOAT fOrder)

   Input:  hCur            - Cursor to which the record will be added
           fStatus         - Value to write to the Status ID field
           fOrder          - Value to write to the Order ID field

   Return: Success of the function.

   Description:
           This function is used to add a record to the table.
           Generates random data for two date fields. Those fields are:
               DateSent        - Value to write to the Date Sent field and
               DateDelivered   - Value to write to the Date Received field
 ===================================================================== }
Function AddRecord (hCur: hDBICur; fStatus: FLOAT; fOrder: FLOAT): DBIResult;

var
    rslt: DBIResult;    { Return value from IDAPI functions }
    pRecBuf: pBYTE;     { Record Buffer }
    TblProps: CURProps; { The properties of the table }
    uMonth: UINT16;     { Contains the month portion of the date }
    uDay: UINT16;       { Contains the day portion of the date }
    iYear: INT16;       { Contains the year portion of the   date }
    szTemp: pCHAR;      { Temporary string used in parsing the date }
    sDate: DATE;         { Date structure - used in DbiPutField. }

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

    GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(pBYTE));
    if not Assigned (pRecBuf) then
    begin
        Screen('    Error - Out of Memory.');
        AddRecord := DBIERR_NOMEMORY;
        exit;
    end;

    {  Make sure we're starting with a clean record buffer }
    ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
            '    Error - InitRecord.');

    { Add the Status ID to the Record Buffer }
    ChkRslt(DbiPutField(hCur, 1, pRecBuf, @(fStatus)),
            DBIERR_NONE, '    Error - PutField.');

    { Add the Order ID to the Record Buffer }
    ChkRslt(DbiPutField(hCur, 2, pRecBuf, @(fOrder)),
            DBIERR_NONE, '    Error - PutField.');

    { Randomly generate & encode a date }
    uMonth := random(11) + 1;
    uDay := random(20) + 1;
    iYear := random(98) + 1900;
    ChkRslt(DbiDateEncode(uMonth, uDay, iYear, sDate),
                    DBIERR_NONE, '    Error - DateEncode.');

    { Put the data into the record buffer }
    rslt := DbiPutField(hCur, 3, pRecBuf, @(sDate));

    { Randomly generate & encode a date }
    uMonth := random(11) + 1;
    uDay := random(20) + 1;
    iYear := random(98) + 1900;
    { Encode the date }
    ChkRslt(DbiDateEncode(uMonth, uDay, iYear, sDate),
                    DBIERR_NONE, '    Error - DateEncode.');

    { Put the data into the record buffer }
    rslt := DbiPutField(hCur, 4, pRecBuf, @(sDate));

    { Insert the record into the table }
    rslt := ChkRslt(DbiInsertRecord(hCur, dbiNOLOCK, pRecBuf),
                   DBIERR_NONE, '    Error - InsertRecord.');

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

    AddRecord := rslt;
end;


{=====================================================================
   Function:
           RefInteg();

   Description:
           This function shows how to create and use Referential
           Integrity.
 ===================================================================== }

var
    hDb: hDBIDb;                { Handle to the database }
    hCur: hDBICur;              { Handle to the table }
    TblDesc: CRTblDesc;         { Create table descriptor }
    uNumFields: UINT16;
    iRintCount: INT16;
    uNumIndexes: UINT16;
const
    uDispNumRecs: UINT16 = 10; { Number of records to add and display }

begin
    Screen('*** Referential Integrity Example ***');

    Screen('    Initializing IDAPI...');
    if (InitAndConnect(hDb) <> DBIERR_NONE) then
    begin
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

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

    { Number of Referential Integrity Rules }
    iRintCount := trunc(sizeof(rintDes) / sizeof(rintDes[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]));

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

    Screen('    Initializing the table descriptor...');
    FillChar(TblDesc, SizeOf(CRTblDesc), #0);
    StrCopy(TblDesc.szTblName, szTblName);
    StrCopy(TblDesc.szTblType, szTblType);
    TblDesc.iFldCount   := uNumFields;
    TblDesc.pfldDesc    := @fldDes;
    TblDesc.iIdxCount   := uNumIndexes;
    TblDesc.pidxDesc    := @idxDes;
    TblDesc.iRintCount  := iRintCount;
    TblDesc.pecrRintOp  := @crOpTyp;
    TblDesc.printDesc   := @rintDes;

    Screen('    Creating the '+szTblName+' table...');
    if (ChkRslt(DbiCreateTable(hDb, TRUE, TblDesc), DBIERR_NONE,
                   '    Error - CreateTable.') <> DBIERR_NONE) then
    begin
        Screen('    Close the Database and exit IDAPI...');
        CloseDbAndExit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    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
        Screen('    Close the Database and exit IDAPI...');
        ChkRslt(DbiDeleteTable(hDb, pCHAR(szTblName), pCHAR(szTblType)),
                DBIERR_NONE, '    Error - DeleteTable.');
        CloseDbAndExit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    { This add will fail - Order Id of 900 does not exist within the
      orders table }
    Screen('    Add a record to the table.        ');
    Screen('        Error Expected -'+
           ' no record in the orders table has an ID of 900...');
    AddRecord(hCur, 1, 900);

    { This add will success - Order Id of 1004 exists within the orders
      table. }
    Screen('');
    Screen('    Add a record to the table with a valid Order Id...');
    AddRecord(hCur, 1, 1004);

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

    Screen('    Display the '+szTblName+' table...');
    DisplayTable(hCur, uDispNumRecs);

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

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

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

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

end.