{ Blobio.pas }
program BlobIO;

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

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


fldDes: array[0..1] of FLDDesc = (
                     (
                        iFldNum:     1;            { Field Number }
                        szName:      'Item_ID';    { Field Name }
                        iFldType:    fldINT16;     { Field Type }
                        iSubType:    0;            { Field Subype }
                        iUnits1:     1;            { 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 }
                      ),
                      (
                        iFldNum:     2; szName:      'BigText';
                        iFldType:    fldBLOB; iSubType:    fldstMEMO;
                        iUnits1:     0; iUnits2:     0;
                        iOffset:     0; iLen:        0;
                        iNullOffset: 0; efldvVchk:   fldvNOCHECKS;
                        efldrRights: fldrREADWRITE
                      )
                 );  { Array of field descriptors }


{====================================================================
   Function: FillString();

   Input:  pString - String that will hold the random letters.

   Return: Result of filling the string.

   Desc:   This function will fill the string with a pre-defined
           string.
 ===================================================================== }
function FillString(pString: pBYTE): BOOL;

var
    i: UINT16;
const
    Filler = 'This is a test';
    uNum: UINT16 = 1900;

begin
    { First copy the filler into the buffer. }
    StrCopy(pCHAR(pString), Filler);

    { Now fill the rest of the string using StrCat. }
    for i := 1 to uNum do
        StrCat(pCHAR(pString), Filler);

    FillString := TRUE;
end;

{=====================================================================
   Code:   FillBlobInfo();

   Input:  hCur        -   Cursor to the table
           pRecBuf     -   Record buffe
   Return: Result of filling the BLOB field.

   Desc:   This function will fill the BLOB field of the given
           record buffer with a predefined string. 
 ===================================================================== }
function FillBlobInfo (hCur: hDBICur; pRecBuf: pBYTE): DBIResult;

const
    Temp1: pBYTE = nil;
    Temp2: pBYTE = nil;
    Temp3: pBYTE = nil;
    Temp4: pBYTE = nil;
    Len: UINT16 = 30000;
    lWritePos: longint = 0;

begin
    { Allocate memory for the four temporary buffers that will in
      all amount to more than 64K of memory. }

    GetMem(Temp1, (sizeof(BYTE) * Len) + 1);
    if not Assigned(Temp1) then
        FillBlobInfo := DBIERR_NOMEMORY;

    GetMem(Temp2, (sizeof(BYTE) * Len) + 1);
    if not Assigned(Temp2) then
        FillBlobInfo := DBIERR_NOMEMORY;

    GetMem(Temp3, (sizeof(BYTE) * Len) + 1);
    if not Assigned(Temp3) then
        FillBlobInfo := DBIERR_NOMEMORY;

    GetMem(Temp4, (sizeof(BYTE) * Len) + 1);
    if not Assigned(Temp4) then
        FillBlobInfo := DBIERR_NOMEMORY;

    { Now fill each buffer with random letters.}
    Screen('    Filling the temporary strings with the pre-defined data....');
    FillString(Temp1);
    FillString(Temp2);
    FillString(Temp3);
    FillString(Temp4);

    Screen('    Open the BLOB for writting...');
    ChkRslt(DbiOpenBlob(hCur, pRecBuf, 2, dbiREADWRITE),
            DBIERR_NONE, '    Error - OpenBlob');

    Screen('    Put the first part of the BLOB into the BLOB field...');
    ChkRslt(DbiPutBlob(hCur, pRecBuf, 2, 0, strlen(pCHAR(Temp1)),
                       Temp1), DBIERR_NONE, '    Error - PutBlob');

    { Set lWritePos to point to the position inside the BLOB. }
    lWritePos := longint(strlen(pCHAR(Temp1)));

    Screen('    Put the second part of the BLOB into the BLOB field...');
    ChkRslt(DbiPutBlob(hCur, pRecBuf, 2, lWritePos, strlen(pCHAR(Temp2)),
                       Temp2), DBIERR_NONE, '    Error - PutBlob');

    { Once again increment lWritePos to point to the position inside the BLOB.}
    lWritePos := lWritePos + longint(strlen(pCHAR(Temp2)));

    Screen('    Put the third part of the BLOB into the BLOB field...');
    ChkRslt(DbiPutBlob(hCur, pRecBuf, 2, lWritePos, strlen(pCHAR(Temp3)),
                       Temp3), DBIERR_NONE, '    Error - PutBlob');

    { Increment lWritePos to point to the position inside the BLOB. }
    lWritePos := lWritePos + longint(strlen(pCHAR(Temp3)));

    Screen('    Put the final part of the BLOB into the BLOB field...');
    ChkRslt(DbiPutBlob(hCur, pRecBuf, 2, lWritePos, strlen(pCHAR(Temp4)),
                       Temp4), DBIERR_NONE, '    Error - PutBlob');

    { Free all the buffers. }
    FreeMem(Temp1, (sizeof(BYTE) * Len) + 1);
    FreeMem(Temp2, (sizeof(BYTE) * Len) + 1);
    FreeMem(Temp3, (sizeof(BYTE) * Len) + 1);
    FreeMem(Temp4, (sizeof(BYTE) * Len) + 1);

    FillBlobInfo := DBIERR_NONE;
end;

{=====================================================================
   Code:   InsertRec();

   Input:  hCur    - Cursor to the table
           uID     - ID for the field

   Return: Result of adding the record to the table

   Desc:   This function will add a record to the given table.
 ===================================================================== }
function InsertRec (hCur: hDBICur; uID: UINT16): DBIResult;

var
    rslt: DBIResult;          { Value returned from IDAPI functions }
    TblProps: CURProps;       { Table Properties }
    pRecBuf: pBYTE;           { Record Buffer }

begin
    Screen('    Acquire the tables properties...');
    ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
            '    Error - GetCursorProps.');

    { Allocate memory for the record buffer. }
    GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
    if (pRecBuf = nil) then
    begin
        Screen('    Error - Out of memory.');
        InsertRec := DBIERR_NOMEMORY;
        exit;
    end;

    Screen('    Initialize record buffer...');
    ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
            '    Error - InitRec.');

    Screen('    Put the ID number into the record buffer...');
    ChkRslt(DbiPutField(hCur, 1, pRecBuf, @(uID)),
            DBIERR_NONE, '    Error - PutField.');

    { Fill the BLOB information pointer with 64K or more of text. }
    ChkRslt(FillBlobInfo(hCur, pRecBuf),
            DBIERR_NONE, '    Error - FillBlob.');

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

    Screen('    Free the BLOB...');
    ChkRslt(DbiFreeBlob(hCur, pRecBuf, 2), DBIERR_NONE,
            '    Error - Free BLOB');

    { free the record buffer. }
    FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE)); 

    InsertRec := rslt;
end;

{=====================================================================
   Code:   Blob_IO();

   Input:  None.

   Return: None.

   Description:
           This example will show how to modify and insert a BLOB field
           that is greater than 64K.
 ===================================================================== }

var
    hDb: hDBIDb;                 { Database handle }
    hCur: hDBICur;               { Cursor handle }
    crTblDes: CRTblDesc;         { Table Descriptor }
    uNumFields: UINT16;
const
    bOverWrite: BOOL = TRUE;     { Overwrite, yes/no flag }

begin
    Screen('*** Using BLOB''s ***');
    Screen('');

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

    uNumFields := trunc(sizeof(fldDes) / sizeof(fldDes[0]));

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

    { 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 }

    Screen('    Creating the '+szTblName+' '+szTblType+' table...');
    if (ChkRslt(DbiCreateTable(hDb, bOverWrite, crTblDes),
                 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...');
        CloseDbAndexit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    Screen('');
    Screen('    Inserting the first record ...');
    InsertRec(hCur, 1);

    Screen('');
    Screen('    Inserting the second record...');
    InsertRec(hCur, 5);

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

    { Delete the table and its related file from disk }
    Screen('    Delete the '+szTblName+' table...');
    ChkRslt(DbiDeleteTable(hDb, pCHAR(szTblName), pCHAR(szTblType)),
            DBIERR_NONE, '    Error - DeleteTable.');

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

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

end.