{ tbllock.pas }
program TblLock;

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

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

{=====================================================================
   Function:
           TblLock();

   Description:
           This example shows how to lock a table.  The
           example will simulate Multi-user access by adding sessions.
           The example will show both working and failing locks.
 ===================================================================== }

var
    rslt: DBIResult;      { Value returned from IDAPI functions }
    TblProps: CURProps;   { Properties of the table. Used to determine
                                the size of the record. }
    hDb1: hDBIDb;         { Handle to the first database }
    hCur1: hDBICur;       { Handle to the first table }
    hSession1: hDBISes;   { Handle to the first session }
    pRecBuf1: pBYTE;      { Pointer to the record buffer }
    hDb2: hDBIDb;         { Handle to the second database }
    hCur2: hDBICur;       { Handle to the second table }
    hSession2: hDBISes;   { Handle to the second session }
    pRecBuf2: pBYTE;      { Pointer to the record buffer }

begin
    Screen('*** Table Locking Example ***');

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

    { Acquire a session handle. Initializing IDAPI opens a session. }
    Screen('    Acquiring the current sessions handle...');
    ChkRslt(DbiGetCurrSession(hSession1),  DBIERR_NONE,
           '    Error - GetCurrSession.');

    Screen('    Setting the Database directory in session #1...');
    ChkRslt(DbiSetDirectory(hDb1, pCHAR(szTblDirectory)), DBIERR_NONE,
            '    Error - SetDirectory.');

    Screen('    Opening the '+szTblName+' Table in session #1...');
    if (ChkRslt(DbiOpenTable(hDb1, pCHAR(szTblName), pCHAR(szTblType),
                             nil, nil, 0, dbiREADWRITE,
                             dbiOPENSHARED, xltFIELD, FALSE, nil, hCur1),
                DBIERR_NONE, '    Error - OpenTable.') <> DBIERR_NONE) then
    begin
        Screen('');
        Screen('    Close the first database handle...');
        CloseDbAndexit(hDb1);

        Screen('');
        Screen('*** End of example ***');
        exit;
    end;

    Screen('    Place a write lock on the table in session #1...');
    ChkRslt(DbiAcqTableLock(hCur1, dbiWRITELOCK), DBIERR_NONE,
            '    Error - AcqTableLock.');

    { Aquire a new session.  This is to simulate multi-user table access. }
    Screen('');
    Screen('    Opening session #2...');
    ChkRslt(DbiStartSession('', hSession2, nil), DBIERR_NONE,
            '    Error - StartSession.');

    Screen('');
    Screen('    Opening Standard Database in session #2...');
    if (ChkRslt(DbiOpenDatabase('', nil, dbiREADWRITE, dbiOPENSHARED,
                                nil, 0, nil, nil, hDb2),
                DBIERR_NONE, '    Error - OpenDatabase.')
        <> DBIERR_NONE) then
    begin
        Screen('');
        Screen('    Close the first cursor to the table...');
        ChkRslt(DbiCloseCursor(hCur1), DBIERR_NONE,
                '    Error - CloseCursor.');
        Screen('    Close the first database handle...');
        CloseDbAndExit(hDb1);
        exit;
    end;

    Screen('    Setting the Database directory in session #2...');
    ChkRslt(DbiSetDirectory(hDb2, pCHAR(szTblDirectory)), DBIERR_NONE,
            '    Error - SetDirectory.');

    Screen('    Opening the '+szTblName+' Table in session #2...');
    if (ChkRslt(DbiOpenTable(hDb2, pCHAR(szTblName), pCHAR(szTblType),
                             nil, nil, 0, dbiREADWRITE,
                             dbiOPENSHARED, xltFIELD, FALSE, nil, hCur2),
                DBIERR_NONE, '    Error - OpenTable.') <> DBIERR_NONE) then
    begin
        Screen('');
        Screen('    Close the first cursor to the table...');
        ChkRslt(DbiCloseCursor(hCur1), DBIERR_NONE,
                '    Error - CloseCursor.');
        Screen('    Close the first database handle...');
        ChkRslt(DbiCloseDatabase(hDb1), DBIERR_NONE,
                '        Error - CloseDatabase.');
        Screen('    Close the second database handle...');
        ChkRslt(DbiCloseDatabase(hDb2), DBIERR_NONE,
                '        Error - CloseDatabase.');
        Screen('    Exit IDAPI...');
        ChkRslt(DbiExit, DBIERR_NONE, '    Error - Exit.');
        exit;
    end;

    ChkRslt(DbiGetCursorProps(hCur2, TblProps), DBIERR_NONE,
            '    Error - GetCursorProps.');

    { create the record buffer. }
    GetMem(pRecBuf1, TblProps.iRecBufSize * sizeof(BYTE));
    GetMem(pRecBuf2, TblProps.iRecBufSize * sizeof(BYTE));

    { Initialize the record buffer }
    ChkRslt(DbiInitRecord(hCur2, pRecBuf2), DBIERR_NONE,
            '    Error - InitRecord.');

    { Go to the top of the Table }
    ChkRslt(DbiSetToBegin(hCur2), DBIERR_NONE, '    Error - SetToBegin.');

    Screen('    Session #2 is getting and locking the first record...');
    Screen('        Error expected - table is locked...');
    ChkRslt(DbiGetNextRecord(hCur2, dbiWRITELOCK, pRecBuf2, nil),
            DBIERR_NONE, '    Error - GetRecord.');

    Screen('    Session #2 is getting the first record without locking...');
    ChkRslt(DbiGetNextRecord(hCur2, dbiNOLOCK, pRecBuf2, nil),
            DBIERR_NONE, '    Error - GetRecord.');

    Screen('');
    Screen('    Session #2 is attempting to modify the record...');
    Screen('        Error Expected - table is locked...');
    ChkRslt(DbiModifyRecord(hCur2, pRecBuf2, TRUE),
            DBIERR_NONE, '    Error - ModifyRecord.');

    { Clean Up }
    FreeMem(pRecBuf1, TblProps.iRecBufSize * sizeof(BYTE));
    FreeMem(pRecBuf2, TblProps.iRecBufSize * sizeof(BYTE));

    ChkRslt(DbiSetCurrSession(hSession2), DBIERR_NONE,
            '    Error - SetCurrSession.');

    Screen('');
    Screen('    Close the cursor to the table in session #2...');
    ChkRslt(DbiCloseCursor(hCur2), DBIERR_NONE,
            '    Error - CloseCursor.');

    Screen('    Close the database handle in session #2...');
    ChkRslt(DbiCloseDatabase(hDb2), DBIERR_NONE,
            '    Error - CloseDatabase.');

    Screen('    Closing session #2...');
    ChkRslt(DbiCloseSession(hSession2), DBIERR_NONE,
            '        Error - CloseSession.');

    ChkRslt(DbiSetCurrSession(hSession1), DBIERR_NONE,
            '    Error - SetCurrSession.');

    ChkRslt(DbiRelTableLock(hCur1, TRUE, dbiWRITELOCK), DBIERR_NONE,
            '    Error - RelTableLock.');

    { Close the cursor in session #1 }
    Screen('');
    ChkRslt(DbiCloseCursor(hCur1), DBIERR_NONE,
            '    Error - CloseCursor.');

    Screen('    Close the Database and exit IDAPI...');
    CloseDbAndexit(hDb1);

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

end.