{ reclock.pas }
program RecLock;

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

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

{=====================================================================
   Function:
           RecLock();

   Description:
           This example shows how to so record locking.  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('*** Record 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.');

    { Set the directory for the database handle }
    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
        CloseDbAndExit(hDb1);
        Screen('*** End of Example ***');
        exit;
    end;

    { 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
        ChkRslt(DbiCloseCursor(hCur1), DBIERR_NONE,
                '    Error - CloseCursor.');
        CloseDbAndExit(hDb1);
        Screen('*** End of Example ***');
        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
        ChkRslt(DbiCloseCursor(hCur1), DBIERR_NONE,
                '    Error - CloseCursor.');
        ChkRslt(DbiCloseDatabase(hDb2), DBIERR_NONE,
                '        Error - CloseDatabase.');
        CloseDbAndExit(hDb1);
        Screen('*** End of Example ***');
        exit;
    end;

    { create the record buffer. }
    ChkRslt(DbiGetCursorProps(hCur2, TblProps), DBIERR_NONE,
            '    Error - GetCursorProps.');

    GetMem(pRecBuf2, TblProps.iRecBufSize * sizeof(BYTE));
    GetMem(pRecBuf1, TblProps.iRecBufSize * sizeof(BYTE));

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

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

    { Set the current session to session #1 }
    ChkRslt(DbiSetCurrSession(hSession1), DBIERR_NONE,
            '    Error - SetCurrSession.');


    Screen('');
    Screen('    Session #1 is getting the first record without'+
           ' locking it...');
    ChkRslt(DbiSetToBegin(hCur1), DBIERR_NONE, '    Error - SetToBegin.');
    ChkRslt(DbiGetNextRecord(hCur1, dbiNOLOCK, pRecBuf1, nil),
            DBIERR_NONE, '    Error - GetRecord.');

    { Attempt to modify the record in session #1 - get an error as
        session #2 has the record locked. }
    Screen('    Session #1 is modifying the record...');
    Screen('        Error Expected - record is locked...');
    ChkRslt(DbiModifyRecord(hCur1, pRecBuf1, TRUE),
            DBIERR_NONE, '    Error - GetRecord.');

    { Set the current session to session #2 }
    ChkRslt(DbiSetCurrSession(hSession2), DBIERR_NONE,
            '    Error - SetCurrSession.');

    { Modify the record in session #2. Session #2 locked the record,
      so it will succeed this time. Note that the lock is released
      after the record is modified. }
    Screen('');
    Screen('    Session #2 is modifying the record...');
    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 '+szTblName+' 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.');

    Screen('');
    Screen('    Close the '+szTblName+' the table in session #1...');
    ChkRslt(DbiCloseCursor(hCur1), DBIERR_NONE,
            '    Error - CloseCursor.');

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

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

end.