{ Block.pas }
program Block;

{$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. }
    szCopyTblName = 'custcopy';
    szTblType = szPARADOX;      { Table type to use. }



{=====================================================================
   Code:   TableCreateTempCopy();

   Input:  hDb             - Handle to the Database
           hCur            - Handle to the Source table
           szDestTblName   - Name of the Destination table
           szTblType       - Type of the table
           phCurTemp       - Cursor returned on the temporary table

   Return: DBIResult       - Success of the opperation, or what went
                           - wrong.

   Description:
           This function is used to return a handle to a temporary
           table which is a copy of the passed in table.

 ===================================================================== }
function TableCreateTempCopy (hDb: hDBIDb; hCur: hDBICur; 
                              szDestTblName: pCHAR; szTblType: pCHAR; 
                              var phCurTemp: hDBICur): DBIResult;

var
    rslt: DBIResult;     { Return value from IDAPI functions }
    crTblDes: CRTblDesc; { Table descriptor }
    pfldDes: pFLDDesc;   { Field descriptor }
    curProp: CURProps;   { Cursor properties }

begin
    ChkRslt(DbiGetCursorProps(hCur, curProp), DBIERR_NONE,
            '    Error - GetCursorProps.');

    { Allocate memory for the field descriptor }
    GetMem(pfldDes, curProp.iFields * sizeof(FLDDesc));

    { Get information on the fields of the table }
    ChkRslt(DbiGetFieldDescs(hCur, pfldDes), DBIERR_NONE,
            '    Error - GetFieldDescs.');

    { Initialize create table descriptor }
    FillChar(crTblDes, sizeof(crTblDesc), #0);
    StrCopy(crTblDes.szTblName, szDestTblName);
    StrCopy(crTblDes.szTblType, szTblType);
    crTblDes.iFldCount := curProp.iFields;
    crTblDes.pfldDesc  := pfldDes;

    { Create and open the table }
    rslt := ChkRslt(DbiCreateTable(hDb, TRUE, crTblDes),
                   DBIERR_NONE, '    CreateTempTable.');
    if (rslt <> DBIERR_NONE) then
    begin
        FreeMem(pfldDes, curProp.iFields * sizeof(FLDDesc));
        TableCreateTempCopy := rslt;
        exit;
    end;

    rslt := ChkRslt(DbiOpenTable(hDb, crTblDes.szTblName,
                                     crTblDes.szTblType, nil,
                                     nil, 0, dbiREADWRITE,
                                     dbiOPENSHARED, xltFIELD, FALSE,
                                     nil, phCurTemp),
                DBIERR_NONE, '    Error - OpenTable.');
    if (rslt <> DBIERR_NONE) then
    begin
        FreeMem(pfldDes, curProp.iFields * sizeof(FLDDesc));
        TableCreateTempCopy := rslt;
        exit;
    end;

    FreeMem(pfldDes, curProp.iFields * sizeof(FLDDesc));
    TableCreateTempCopy := rslt;
end;

{=====================================================================
   Code:   Block();

   Input:  None.

   Return: None.

   Description:
           This example shows how to read and write records to a table
           in blocks (more than one record at a time). Moveing records
           in blocks is the prefered method of reading and writting
           records to a table because it enhances the performance of
           the application.
 ===================================================================== }

var
    rslt: DBIResult;          { Return value from IDAPI functions }
    hDb: hDBIDb;              { Handle to the Database }
    hCur: hDBICur;            { Handle to the table }
    hCurCopy: hDBICur;        { Handle to a temporary table }
    CurProp: CURProps;        { Properties of the Cursor }
    pRecBuf: pointer;         { Pointer to the record buffer }
    uRecNum: UINT16;          { Loop counter - current record num }
    uRecOffset: UINT16;       { Offset into the block of records }
    DestBuf: array[0..34] of CHAR;   { New field value to write to the
                                       table  }
    TempBuf: array[0..34] of CHAR;   { Field value read in from the table }
    bBlank: BOOL;             { Used to determine if a field is blank }
const
    uNumBuf: UINT32 = 10;     { Number of records to buffer }
    uNumRecs: UINT32 = 10;    { Number of records to display, 0=all }

begin
    Screen('*** Block maniplulation 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 Database directory...');
    ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
            '    Error - SetDirectory.');

    Screen('    Open the '+szTblName+' table (source)...');
    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('    Clean up IDAPI...');
        CloseDbAndexit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    { Create a temporary table with the same field structure as the
      source table }
    if (TableCreateTempCopy(hDb, hCur, pCHAR(szCopyTblName),
                            pCHAR(szTblType), hCurCopy) <> DBIERR_NONE) then
    begin
        ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
                '    Error - CloseCursor.');
        Screen('    Clean up IDAPI...');
        CloseDbAndexit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    { Get the size of the record buffer }
    ChkRslt(DbiGetCursorProps(hCur, CurProp), DBIERR_NONE,
            '    Error - GetCursorProps.');

    { Allocate space for the Record Buffer }
    GetMem(pRecBuf, CurProp.iRecBufSize * sizeof(BYTE) * uNumBuf);
    if not Assigned(pRecBuf) then
    begin
        Screen('    Error - Out of memory.');
        CloseDbAndexit(hDb);
        exit;
    end;

    Screen('');
    Screen('    Go to the beginning of the '+szTblName+' table...');
    ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
            '    Error - SetToBegin.');

    Screen('    Display the '+szTblName+' table...');
    ChkRslt(DisplayTable(hCur, uNumRecs), DBIERR_NONE,
                         '    Error - DisplayTable.');

    Screen('');
    Screen('    Go to the beginning of the '+szTblName+' table...');
    ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
            '    Error - SetToBegin.');

    Screen('    Read '+IntToStr(uNumBuf)+' records from the '+
           szTblName+' table...');

    rslt := DbiReadBlock(hCur, uNumBuf, pRecBuf);
    { Getting an EOF error is ok - just means that an attempt was
      made to read more records than are currently in the table. }
    if ((rslt <> DBIERR_EOF) and (rslt <> DBIERR_NONE)) then
    begin
        ChkRslt(rslt, DBIERR_NONE, '    Error - ReadBlock');
    end;

    for uRecNum := 1 to uNumBuf do
    begin
        { Calculate the record offset. }
        uRecOffset := (uRecNum-1)*CurProp.iRecBufSize;
        
        { Get the value in the second field for each record }
        ChkRslt(DbiGetField(hCur, 2,
                          PChar(pRecBuf)+uRecOffset,
                          @TempBuf, bBlank),
                DBIERR_NONE, '    Error - GetField.');

        Screen('    Modify the record: add "'+IntToStr(uRecNum)+'" to '+
               ' '+StrPas(TempBuf)+' ');

        { Put the record number at the start of the field }
        StrPCopy(DestBuf, IntToStr(Integer(uRecNum)));
        StrCat(DestBuf, ' ');

        { Add the record number to the head of the field }
        StrLCat(DestBuf, TempBuf, (30 - strlen(DestBuf)));

        { Update the buffer value }
        ChkRslt(DbiPutField(hCur, 2,
                          PChar(pRecBuf)+uRecOffset,
                          @DestBuf),
                DBIERR_NONE, '    Error - GetField.');
    end;

    { Write uNumBuf records to the table }
    Screen('');
    Screen('    Write '+IntToStr(uNumBuf)+' records to the '+
            szCopyTblName+' table...');
    ChkRslt(DbiWriteBlock(hCurCopy, uNumBuf, pRecBuf), DBIERR_NONE,
            '    Error := WriteBlock.');

    { Go to the beginning of the table }
    Screen('');
    Screen('    Go to the beginning of the '+szCopyTblName+' table...');
    ChkRslt(DbiSetToBegin(hCurCopy), DBIERR_NONE,
            '    Error - SetToBegin.');

    Screen('    Display the '+szCopyTblName+' table...');
    ChkRslt(DisplayTable(hCurCopy, uNumRecs), DBIERR_NONE,
                         '    Error - DisplayTable.');

    { Release allocated memory }
    FreeMem(pRecBuf, CurProp.iRecBufSize * sizeof(BYTE) * uNumBuf);

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

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

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

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

end.