{ sniptool.pas }
unit SnipTool;
{$N+}
interface

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

const
  MAXLEN = 50;
  szFileName = 'SNIPIT.OUT';

type
   pPChar = ^PChar;


function IntToStr(i: integer): String;
function RightPad(szDest, szSource: PChar; iTotalSize: Integer): PChar;
function ChkRslt (rslt, exp: DBIResult; pMsg: PChar ): DBIResult;
function InitAndConnect (var phDb: hDBIDb): DBIResult;
function CloseDbAndExit (var phDb: hDBIDb): DBIResult;
function FillTable (hDb: hDBIDb; szTblName, szTblType: PChar; NumRecs: Integer): DBIResult;
function CreateAndFillTable (hDb: hDBIDb; pTblDesc: pCRTblDesc; NumRecs: Integer;
                    var phCur: hDBICur): DBIResult;
function DisplayInMemoryTable (hCur: hDBICur; uDisplayNRecs: longint): DBIResult;
function DisplayTable (hCur: hDBICur; uDisplayNRecs: LongInt): DBIResult;
function PutFieldSample (hCur: hDBICur; pRecBuf: pBYTE; FldNum: Word;
               pfldDesc: pFLDDesc): DBIResult;
function MakeFullPath (szDirectory: PChar): DBIResult;
function MakeFullTblPath (pszDirectory :PChar;
                          pszRelativeDirectory: PChar) :DBIResult;
function DisplayNextRecord(hCur: hDBICur): DBIResult;
function DisplayCurrentRecord (hCur: hDBICur): DBIResult;
procedure Screen (Format: String);
procedure InitOutput;
procedure CloseOutput;

implementation

{==============================================================
   Function:
           IntToStr(i);
   Input:  i       - Integer

   Return: Converted Pascal String

   Description:
           This converts an Integer to a Pascal String
 =============================================================== }
function IntToStr(i: integer): String;
var
  s: String;
begin
  Str(i,s);
  IntToStr := s;
end;

{==============================================================
   function:
            RightPad(szDest, szSource, iTotalSize);

   Input:  szDest     -  PChar: Destination String
           szSource   -  PChar: Source String
           iTotalSize -  Integer: The TotalSize the Destination
                                  String should be.
   Return: szDest     -  PChar: Destination String

   Description:
           This converts a string's length to the requested length
           by filling balnk spaces to the right.
 =============================================================== }
function RightPad(szDest, szSource: PChar; iTotalSize: Integer): PChar;
var
  Count: Integer;
begin
  if not Assigned(szSource) then
      StrCopy(szDest,' ')
  else
  begin
     StrCopy(szDest, szSource);
     for Count := 1 to (iTotalSize-StrLen(szSource)) do
         StrCat(szDest,' ');
  end;
  RightPad := szDest;
end;

{===============================================================
   Procedure:
           Screen(Format, argptr);

   Input:  Format  - A string that represents the format that
                     the function vsprintf() uses.
           argptr  - A varied number of input parameters (based
                     on the needs of the format string).

   Return: None.

   Description:
           This will build, and echo, a message.
 =============================================================== }
procedure Screen (Format: String);
var
    i: integer;

begin
    WriteLn(Format);
end;


{===============================================================
   Procedure: InitOutput;
   Input:  None.
   Return: None.
   Description:
           Assigns the Output to a text file. This routine also
           initializes szTblDirectory and szPrivDirectory.
 =============================================================== }
procedure InitOutput;
begin

    GetMem (szTblDirectory, DBIMAXPATHLEN);
    GetMem (szPrivDirectory, DBIMAXPATHLEN);

    { Get the directory which contains the tables. }
    GetPrivateProfileString('PASCAL', 'TblDir',
                            '..\TABLES',
                            szDefTblDirectory,
                            sizeof(szDefTblDirectory),
                            'bde.ini');

    { Create a fully qualified path for the table directory. }
    MakeFullTblPath (szTblDirectory, szDefTblDirectory);

    { Get the Private directory. }
    GetPrivateProfileString('PASCAL', 'PrivateDir',
                            '.',
                            szDefTblDirectory,
                            sizeof(szDefTblDirectory),
                            'bde.ini');

    { Create a fully qualified path for the private directory. }
    MakeFullTblPath (szPrivDirectory, szDefTblDirectory);

    Screen('*** Redirecting output to '+szFileName+'...');
    Assign(Output, szFileName);
    Rewrite(Output);
end;


{===============================================================
   Procedure: CloseOutput;
   Input:  None.
   Return: None.
   Description:
           Assigns the Output back to Crt.
 =============================================================== }
procedure CloseOutput;
begin
    Close(Output);
    AssignCrt(Output);
    Rewrite(Output);
end;


{==============================================================
   Function:
           ChkRslt(rslt, pMsg);
   Input:  rslt    - Return code from IDAPI
           pMsg    - Null terminated message.

   Return: IDAPI return code passed in

   Description:
           This will echo an error message if the expected
           result does not equal the actual result. The output will be
           echoed to the screen.
 =============================================================== }
function ChkRslt (rslt, exp: DBIResult; pMsg: PChar ): DBIResult;
var
    dbi_status:  DBIMSG;

begin
    { Echo only if actual result doesn't equal expected result }
    if (rslt <> exp) then
    begin
        DbiGetErrorString(rslt, dbi_status);
        Screen('    '+StrPas(pMsg)+' category: ['+IntToStr(ErrCat(rslt))+'] code: ['+
               IntToStr(ErrCode(rslt))+'] message: '+StrPas(dbi_status));
    end;
    ChkRslt := rslt;
end;

{===============================================================
   Function:
           InitAndConnect(phDb);

   Input:  phDb - Pointer to the database handle

   Return: IDAPI return code after DbiInit() and DbiOpenDatabase().

   Description:
           Initialize IDAPI & connect to a Standard
           database (non-SQL).
 ================================================================ }
function InitAndConnect (var phDb: hDBIDb): DBIResult;
var
    rslt:  DBIResult;

begin

    { Initialize IDAPI with a NULL environment structure }
    rslt := ChkRslt(DbiInit(nil), DBIERR_NONE,'    Error - Init');
    if (rslt = DBIERR_NONE) then
    begin

        ChkRslt(DbiDebugLayerOptions(DEBUGON or OUTPUTTOFILE,
                                    'SNIPIT.DBG'), DBIERR_NONE,
                '    Error - DebugLayerOptions.');
        { IDAPI initialized. Now open a Standard database (used to access
          Paradox and dBASE tables), by using a NULL database type. }
        rslt := ChkRslt(DbiOpenDatabase(nil, nil, dbiREADWRITE,
                                       dbiOPENSHARED, nil, 0, nil, nil,
                                       phDb),
                       DBIERR_NONE, '    Error - OpenDatabase.');

        { Exit IDAPI if connect did not work }
        if (rslt <> DBIERR_NONE) then
            ChkRslt(DbiExit, DBIERR_NONE, '    Error - Exit.');

        { Assign the Output to a text file and initialize 
          szTblDirectory, szPrivDirectory directories. }
        InitOutput;

        rslt := ChkRslt( DbiSetPrivateDir(szPrivDirectory),
                       DBIERR_NONE, '    SetPrivateDir.');
        if (rslt <> DBIERR_NONE) then
        begin
            CloseOutput;
            ChkRslt(DbiExit, DBIERR_NONE, '    Error - Exit.');
        end;

    end;
    InitAndConnect := rslt;
end;

{=====================================================================
   Function:
           FormatDate (DATE Date, PChar szDate)

   Input:  DATE     - Date which needs to be formatted
           szDate   - String to contain the formatted date

   Return: Result returned from DbiDateDecode().

   Description:
           This function is used to format date fields according to the
           settings in the IDAPI.CFG file.
 ===================================================================== }
function FormatDate (dDate: DbiTypes.DATE; szDate: PChar): DBIResult;
var
    rslt: DBIResult;       { Return Value from IDAPI }
    dfmtDate: FMTDate;     { Date Format }
    uDay: Word;            { Day portion of date }
    uMonth: Word;          { Month portion of date }
    iYear: Integer;        { Year portion of date }
    sDay, sMonth, sYear: String;
begin
    { Get the formatting of the Date }
    ChkRslt(DbiGetDateFormat(dfmtDate),
            DBIERR_NONE, '    GetDateFormat.');

    { Decode the date }
    rslt := ChkRslt(DbiDateDecode(dDate, uMonth, uDay, iYear),DBIERR_NONE,
                   '        Error - DateDecode.');

    { Determine if date should be displayed year based }
    if ((not (dfmtDate.bFourDigitYear)) and
        (dfmtDate.bYearBiased) ) then
        iYear := iYear+1900;

    if (not (dfmtDate.bFourDigitYear )) then
    begin
        iYear := iYear - 1900;
        Str(iYear:2, sYear);
    end
    else
        Str(iYear:4, sYear);

    { Make certain the seperator is not the
      escape character. }
    if (StrComp(dfmtDate.szDateSeparator, '\') <> 0) then
        StrCopy(dfmtDate.szDateSeparator, '/');

    Str(uDay:2, sDay);
    Str(uMonth:2, sMonth);
    { Format the date }
    case  BYTE(dfmtDate.iDateMode) of
        { MM/DD/YY - Month, Day, Year }
         0:
             StrPCopy(szDate,
                      sMonth+StrPas(dfmtDate.szDateSeparator)+
                      sDay+StrPas(dfmtDate.szDateSeparator)+
                      sYear);
        { DD/MM/YY - Day, Month, Year }
         1:
             StrPCopy(szDate,
                      sDay+StrPas(dfmtDate.szDateSeparator)+
                      sMonth+StrPas(dfmtDate.szDateSeparator)+
                      sYear);
        { YY/MM/DD - Year, Month, Day }
         2:
             StrPCopy(szDate,
                      sYear+StrPas(dfmtDate.szDateSeparator)+
                      sMonth+StrPas(dfmtDate.szDateSeparator)+
                      sDay);
    end;
    FormatDate := rslt;
end;

{=====================================================================
   Function:
           FormatTime (TIME Time, PChar szTime)

   Input:  TIME     - Time which needs to be formatted
           szTime   - String to contain the formatted time

   Return: Result returned from DbiTimeDecode().

   Description:
           This function is used to format time fields according to
           the settings in the IDAPI.CFG file.
 ===================================================================== }
function FormatTime (tTime: DbiTypes.TIME; szTime: PChar): DBIResult;
var
    rslt: DBIResult;              { Return value from IDAPI functions }
    timeFmt: FMTTime;             { Time format }
    uHour: Word;                  { Hour portion of the time }
    uMinute: Word;                { Minute portion of the time }
    uMilSec: Word;                { Second portion (in ms) of the time }
    uIsAm: Word;                  { Is Time AM? }
    szTemp: array[0..10] of CHAR; { Temp buffer, used for AM, PM string }
    sHour, sMinute, sSec, sMilSec: String;

begin
    { Get the formatting of the Time }
    ChkRslt(DbiGetTimeFormat(timeFmt),
            DBIERR_NONE, '    GetTimeFormat.');

    { Decode the time  }
    rslt := ChkRslt(DbiTimeDecode(tTime, uHour, uMinute, uMilSec),
                   DBIERR_NONE, '        Error - TimeDecode.');

    { Make certain the seperator is not the
      escape character. }
    if (timeFmt.cTimeSeparator = '\') then
        timeFmt.cTimeSeparator  := '/';

    { Check if time should be displayed in 12 or 24 hour format }
    if (timeFmt.bTwelveHour) then
    begin
        { Temporary variable used to determine if the time is AM or PM }
        uIsAm := uHour;
        uHour := uHour mod 12;
        if (uHour = 0) then
            uHour := 12;
        { If AM, set uIsAm to TRUE, else set uIsAm to 0 }
        if (uIsAm = uHour) then
            uIsAm := 1
        else
            uIsAm := 0;
    end;
    Str(uHour:2,sHour);
    Str(uMinute:2, sMinute);
    Str((round (uMilsec/1000)):2, sSec);
    Str((round (uMilSec mod 1000)):2, sMilsec);
    { Format the hour and minute of the time }

    StrPCopy(szTime, sHour+timeFmt.cTimeSeparator+sMinute);

    { Determine if seconds are to be displayed }
    if (timeFmt.bSeconds) then
    begin
        StrPCopy(szTemp, timeFmt.cTimeSeparator+sSec);
        StrCat(szTime, szTemp);
        { Determine if milliseconds are to be displayed }
        if (timeFmt.bMilSeconds) then
        begin
            StrPCopy(szTemp, timeFmt.cTimeSeparator+sMilsec);
            StrCat(szTime, szTemp);
        end;
    end;

    { Add a string to the time if the time is 12-hour }
    if (timeFmt.bTwelveHour) then
    begin
        { Add a space to the format }
        StrCat(szTime, ' ');
        { If AM }
        if (uIsAm = 1) then
             { Copy the AM string }
            StrCat(szTime, timeFmt.szAmString)
        else { otherwise it's PM }
             { Copy the PM string }
            StrCat(szTime, timeFmt.szPmString);
    end;

    FormatTime := rslt;
end;

{=====================================================================
   Function:
           FormatTimeStamp (TIMESTAMP tStamp, PChar szTime)

   Input:  TIME     - Time which needs to be formatted
           szTime   - String to contain the formatted time

   Return: Result returned from DbiTimeStampDecode().

   Description:
           This function is used to format TimeStamp fields according
           to the settings in the IDAPI.CFG file. It calls the
           FormatDate and FormatTime functions which are defined
           above.
 ===================================================================== }
function FormatTimeStamp (tStamp: TIMESTAMP; szTimeStamp: PChar): DBIResult;
var
    rslt: DBIResult;       { Return value from IDAPI functions }
    tTime: DbiTypes.TIME;           { Time portion of the TimeStamp }
    dDate: DbiTypes.DATE;           { Date portion of the TimeStamp }
    szDate: PChar;         { Date string }
    szTime: pChar;         { Time String }
begin
    { Get the date and time components }
    rslt := ChkRslt(DbiTimeStampDecode(tStamp, dDate, tTime),
                   DBIERR_NONE, '    Error - TimeStampDecode');
    GetMem(szDate, 16 * sizeof(CHAR));
    GetMem(szTime, 21 * sizeof(CHAR));
    { Get the Date format }
    FormatDate(dDate, szDate);
    { Get the Time format }
    FormatTime(tTime, szTime);
    { Format the TimeStamp }
    szTime := StrCat(szTime,', ');
    StrCopy(szTimeStamp, Strcat(szTime,szDate));
    FormatTimeStamp := rslt;
end;

{=====================================================================
   Function:
           GetFields(hCur, pFldDescs, pRecBuf, pszField, uDefLength)

   Input:  hCur        - Handle to the Cursor
           pFldDescs   - Field Descriptor
           pRecBuf     - Record buffer - contains the record from
                         which the field values are to be retrieved.
           pszField    - Fields in the table
           uDefLength  - Default length of a field

   Return: Success of the opperation.

   Description:
           This function is used to extract all field values from
           a record and place them into an array of Strings.
 ===================================================================== }

function GetFields (hCur: hDBICur; pFldDescs: pFLDDesc; pRecBuf: Pointer;
                    pszField: pPCHAR; uDefLength: Word): DBIResult;
var
    rslt: DBIResult;          { Return value from IDAPI functions }
    TblProps: CURProps;       { Properties of the table }
    uFldNum: Word;            { Loop Counter - used to determine the
                                               current field. }
    Work: String;
    szTemp: array[0..MAXLEN] of CHAR; { Temporary variable for reading data }
    szTempAsFloat: Double absolute szTemp; { Reading the Temporary
                                             variable as Float}
    szTempAsLongInt: LongInt absolute szTemp; { Reading the Temporary
                                             variable as LongInt}
    szTempAsInt: Integer absolute szTemp; { Reading the Temporary
                                             variable as Integer}
    szTempAsShortInt: ShortInt absolute szTemp; { Reading the Temporary
                                             variable as ShortInt}
    fmBCD: fmtBCD;          { Variable to read BCD value }
    ulBlobSize: LongInt;    { Variable to read Longint Values }
    lfFloat: Double;        { Variable to read Double Values }
    Code: Integer;          { Used in Val Function }
    bIsBlank: BOOL;         { Check if the field is blank }

begin
    rslt := ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
                        '    Error - GetCursorProps.');
    if (rslt <> DBIERR_NONE) then
    begin
        GetFields := rslt;
        exit;
    end;

    { Get the field values from the record. Gets each field from
      the table, placing the results in the pszField variable }
    for  uFldNum := 1 to TblProps.iFields do
    begin
        case (pFldDescs^.iFldType) of
            fldBYTES,
            fldZSTRING:
                ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                    pszField^, bIsBlank), DBIERR_NONE,
                        '        Error - GetField.');
            fldFLOAT:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                     (@szTemp), bIsBlank),
                        DBIERR_NONE, '        Error - GetField.');
                  if (not bIsBlank) then
                    if (pFldDescs^.iSubType = fldstMONEY) then
                    begin
                      Str(szTempAsFloat:0:2, Work);
                      StrPCopy(pszField^,'$'+Work);
                    end
                    else
                    begin
                      Str(szTempAsFloat:0:1, Work);
                      StrPCopy(pszField^, Work);
                    end;
                end;
            fldBCD:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                      (@fmBCD),
                                      bIsBlank), DBIERR_NONE,
                          '        Error - GetField.');
                  if (not bIsBlank) then
                  begin
                      ChkRslt(DbiBcdToFloat(fmBCD,lfFloat),
                              DBIERR_NONE, '    BcdToFloat.');
                      Str(lfFloat:0:1, Work);
                      StrPCopy(pszField^, Work);
                  end;
                end;
            fldDATE:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                           (@ulBlobSize),
                           bIsBlank), DBIERR_NONE,
                        '        Error - GetField.');
                  if (not bIsBlank) then
                       FormatDate(ulBlobSize, pszField^);
                end;
            fldTIME:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                      (@ulBlobSize),
                                      bIsBlank), DBIERR_NONE,
                          '        Error - GetField.');
                  if (not bIsBlank) then
                       FormatTime(ulBlobSize, pszField^);
                end;
            fldTIMESTAMP:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                      (@lfFloat),
                                      bIsBlank), DBIERR_NONE,
                          '        Error - GetField.');
                  if (not bIsBlank) then
                       FormatTimeStamp(lfFloat, pszField^);
                end;
            fldINT16:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                      (@szTemp),
                                      bIsBlank), DBIERR_NONE,
                          '        Error - GetField.');
                  if (not bIsBlank) then
                  begin
                      Str(szTempAsInt, Work);
                      StrPCopy(pszField^, Work);
                  end;
                end;
            fldUINT16:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                      (@szTemp),
                                      bIsBlank), DBIERR_NONE,
                          '        Error - GetField.');
                  if (not bIsBlank) then
                  begin
                      Str(szTempAsInt, Work);
                      StrPCopy(pszField^, Work);
                  end;
                end;
            fldINT32:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                      (@szTemp),
                                       bIsBlank), DBIERR_NONE,
                          '        Error - GetField.');
                  if (not bIsBlank) then
                  begin
                      Str(szTempAsLongInt, Work);
                      StrPCopy(pszField^, Work);
                  end;
                end;
            fldUINT32:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                      (@szTemp),
                                       bIsBlank), DBIERR_NONE,
                          '        Error - GetField.');
                  if (not bIsBlank) then
                  begin
                      Str(szTempAsLongInt, Work);
                      StrPCopy(pszField^, Work);
                  end;
                end;
            fldBOOL:
                begin
                  ChkRslt(DbiGetField(hCur, uFldNum, pRecBuf,
                                      (@szTemp),
                                      bIsBlank), DBIERR_NONE,
                          '        Error - GetField.');
                  if (not bIsBlank) then
                     if (szTempAsShortInt = 0) then
                        StrCopy(pszField^, 'No')
                     else
                        StrCopy(pszField^, 'Yes');
                end;
            fldBLOB:
                { Display the first uDefLength characters of
                  Memo BLOB fields. }
                if (pFldDescs^.iSubType = fldstMEMO) then
                begin
                    ChkRslt(DbiOpenBlob(hCur, pRecBuf,
                                        uFldNum, dbiREADONLY),
                            DBIERR_NONE, '    Error - OpenBlob.');

                    {Determine the size of the BLOB }
                    ChkRslt(DbiGetBlobSize(hCur, pRecBuf,
                                           uFldNum, ulBlobSize),
                            DBIERR_NONE, '    Error - GetBlobSize.');

                    if (ulBlobSize > (uDefLength-2)) then
                        ulBlobSize := uDefLength - 2;

                    { Get the BLOB from the table }
                    ChkRslt(DbiGetBlob(hCur, pRecBuf,
                                       uFldNum, 0,
                                       ulBlobSize,
                                       pszField^,
                                       ulBlobSize),
                            DBIERR_NONE, '    Error - GetBlob.');

                    { Add the nil terminator to the string. }
                    pszField^[Integer(ulBlobSize)] := #0;

                    { Free the blob from memory }
                    ChkRslt(DbiFreeBlob(hCur, pRecBuf,
                                        uFldNum),
                            DBIERR_NONE, '    Error - FreeBlob.');
                end
                else
                    StrCopy(pszField^, 'Can''t Display');
         else
             StrCopy(pszField^, 'Can''t Display');
        end; {end of case}
        { Initialize the string in case the field was blank }
        if (bIsBlank) then
        begin
            StrCopy(pszField^, '');
            bIsBlank := FALSE;
        end;
        Inc(pFldDescs);
        Inc(pszField);
    end;
    Dec(pFldDescs, TblProps.iFields);
    Dec(pszField, TblProps.iFields);
    GetFields := DBIERR_NONE;
end;

{=====================================================================
   Function:
           SetupFields(TblProps, pFldDescs, pszField, uDefLength)

   Input:  TblProps    - Properties of the Table
           pFldDescs   - Field Descriptor
           pszField    - Fields in the table
           uDefLength  - Default length of a field

   Return: DBIERR_NONE (success)

   Description:
           This function sets up the formatting of the fields.
 ===================================================================== }
function SetupFields (TblProps: CURProps; pFldDescs: pFLDDesc; 
                      pszField: pPChar; uDefLength: Word): DBIResult;
var
    uFldNum: Word;            { Loop variable }

begin
    for uFldNum := 1 to TblProps.iFields do
    begin
        { Allocate enough space to contain the data in each field }
        case (pFldDescs^.iFldType) of
            fldBYTES,
            fldZSTRING:
              begin
                GetMem(pszField^, pFldDescs^.iLen * sizeof(CHAR));
                if (MAXLEN - 4 < pFldDescs^.iLen) then
                begin
                    pFldDescs^.iUnits1 := MAXLEN-4;
                    pFldDescs^.iLen    := MAXLEN-3;
                end;
                { Adjust if the field is smaller than it's description }
                if (pFldDescs^.iLen < StrLen(pFldDescs^.szName)) then
                begin
                    pFldDescs^.iUnits1 := StrLen(pFldDescs^.szName);
                    pFldDescs^.iLen := pFldDescs^.iUnits1 - 1;
                end;
              end;
            fldFLOAT,
            fldDATE,
            fldINT16,
            fldUINT16,
            fldINT32,
            fldUINT32,
            fldBOOL,
            fldBLOB,
            fldBCD:
              begin
                GetMem(pszField^, uDefLength * sizeof(CHAR));
                { Set the Width of the field as it will be displayed }
                pFldDescs^.iUnits1 := uDefLength-1;
                pFldDescs^.iLen    := uDefLength;
                { Adjust if the field is smaller than it's description }
                if (pFldDescs^.iLen < StrLen(pFldDescs^.szName)) then
                begin
                    pFldDescs^.iUnits1 := StrLen(pFldDescs^.szName);
                    pFldDescs^.iLen := pFldDescs^.iUnits1 - 1;
                end;
               end;
            fldTIMESTAMP:
              begin
                GetMem(pszField^, 36 * sizeof(CHAR));
                { Set the Width of the field as it will be displayed }
                pFldDescs^.iUnits1 := 36;
                pFldDescs^.iLen    := 35;
                { Adjust if the field is smaller than it's description }
                if (pFldDescs^.iLen < StrLen(pFldDescs^.szName)) then
                begin
                    pFldDescs^.iUnits1 := StrLen(pFldDescs^.szName);
                    pFldDescs^.iLen := pFldDescs^.iUnits1 - 1;
                end;
              end;
            fldTIME:
              begin
                GetMem(pszField^, 20 * sizeof(CHAR));
                { Set the Width of the field as it will be displayed }
                pFldDescs^.iUnits1 := 20;
                pFldDescs^.iLen    := 19;
                  { Adjust if the field is smaller than it's description }
                if (pFldDescs^.iLen < StrLen(pFldDescs^.szName)) then
                begin
                    pFldDescs^.iUnits1 := StrLen(pFldDescs^.szName);
                    pFldDescs^.iLen := pFldDescs^.iUnits1 - 1;
                end;
              end;
            else
              begin
                { This field size will hold the 'Not Supported'
                  message }
                GetMem(pszField^, uDefLength * sizeof(CHAR));
                { Set the width of the field as it will be displayed }
                pFldDescs^.iUnits1 := uDefLength;
              end;
        end;{end of case}
        Inc(pFldDescs);
        Inc(pszField);
    end;
    Dec(pFldDescs, TblProps.iFields);
    Dec(pszField, TblProps.iFields);
    SetUpFields := DBIERR_NONE;
end;

{===============================================================
   Function:
           CloseDbAndExit(phDb);

   Input:  phDb - Pointer to the database handle

   Return: IDAPI return code after DbiCloseDatabase() and DbiExit().

   Description:
           Close the supplied database & exit IDAPI.
================================================================ }
function CloseDbAndExit (var phDb: hDBIDb): DBIResult;
var
    rslt: DBIResult;

begin
    Close(Output);
    AssignCrt(Output);
    Rewrite(Output);

    { Close the supplied database }
    rslt := ChkRslt(DbiCloseDatabase(phDb), DBIERR_NONE,
                   '    Error - CloseDatabase');
    if (rslt = DBIERR_NONE) then
    begin
        { Uninitialize IDAPI }
        rslt := DbiDebugLayerOptions(0, nil);
        rslt := ChkRslt(DbiExit, DBIERR_NONE, '    Error - Exit.');
    end;
    CloseDbAndExit := rslt;
end;


{=====================================================================
   Function:
           FillTable(hDb, szTblName, szTblType, NumRecs);

   Input:  hDb         - The database handle
           szTblName   - Name of the table to fill
           szTblTyps   - Type of the table to fill
           NumRecs     - The number of records to insert

   Return: DBIResult - success?

   Description:
           This function add the specified number of records to
           the table containing random data.
 ===================================================================== }
function FillTable (hDb: hDBIDb; szTblName, szTblType: PChar; 
                    NumRecs: Integer): DBIResult;
var
    rslt:           DBIResult;   { Return value from IDAPI functions }
    fRecCount:      Integer;     { Loop variable = count of records }
    FldCntr:        Word;        { Field counter }
    fldDes:         FLDDesc;     { Field Descriptor }
    TblProps:       CURProps;    { Table descriptor }
    hCur:           hDBICur;     { Handle to the table }
    hFldList:       hDBICur;     { Handle to the field list table }
const
    pRecBuf:        pBYTE = nil; {Pointer to the record buffer }

begin
    Randomize;
    {  Echo the message that the records are being inserted }
    Screen('    Inserting '+IntToStr(NumRecs)+' records into the table...');

    {  Open the table }
    rslt := ChkRslt(DbiOpenTable(hDb, szTblName, szTblType, nil,
                                 nil, 0, dbiREADWRITE,
                                 dbiOPENSHARED, xltFIELD, FALSE,
                                 nil, hCur), DBIERR_NONE, '    Error - OpenTable.');
    if (rslt <> DBIERR_NONE) then
    begin
        FillTable := rslt;
        exit;
    end;

    {  Create an in-memory table that contains a list of fields. Note
       that logical (i.e. IDAPI types), are being requested instead of
       driver types. }
    rslt := ChkRslt(DbiOpenFieldList(hDb, szTblName, szTblType,
                                         FALSE, hFldList),
                        DBIERR_NONE, '    Error - OpenFieldList.');
    if (rslt <> DBIERR_NONE) then
    begin
        ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
                '    Error - CloseCursor.');
        FillTable := rslt;
        exit;
    end;

    {  Append the records if the list & table are available }
    if ((hCur <> nil) and (hFldList <> nil)) then
    begin
        {  Allocate a record buffer }
        ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
                '  Error - GetCursorProps.');

        GetMem(pRecBuf,TblProps.iRecBufSize);
        if not Assigned(pRecBuf) then
        begin
            Screen('    Error - Out of Memory.');
            ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
                    '    Error - CloseCursor.');
            ChkRslt(DbiCloseCursor(hFldList), DBIERR_NONE,
                    '    Error - CloseCursor.');
            FillTable := DBIERR_NOMEMORY;
            exit;
        end;

        { Loop until the specified number of records have been written
            to the table. }
        for fRecCount := 1 to NumRecs do
        begin
            {  Make sure we're starting with a clean record buffer }
            ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
                    '    Error - InitRecord.');

            { Start at the beginning of the field list. Setting the
              cursor to the start of the table (i.e. BOF), does not leave
              you on a record. You are effectively left on a crack.
              Because of this, you will need to go to the next record in
              the table to reach the first record of the table. }
            FldCntr := 1;
            ChkRslt(DbiSetToBegin(hFldList), DBIERR_NONE,
                    '    Error - SetToBegin.');

            { This loop will use the previously opened field list to
              drive what type of data is inserted into the table. }
            while (DbiGetNextRecord(hFldList, dbiNOLOCK, @(fldDes),
                                    nil) = DBIERR_NONE) do
            begin
                { Put field data into the record buffer }
                PutFieldSample(hCur, pRecBuf, FldCntr, @fldDes);
                Inc(FldCntr);
            end;

            { All fields have been inserted into the record buffer. Now
              we need to append the record to the table... }
            ChkRslt(DbiAppendRecord(hCur, pRecBuf),
                    DBIERR_NONE, '    Error - InsertRecord.');

            { Make sure to close all blobs (opened when data was put into
              the record buffer). }
            FldCntr := 1;
            ChkRslt(DbiSetToBegin(hFldList), DBIERR_NONE,
                    '    Error - SetToBegin.');
            while (DbiGetNextRecord(hFldList, dbiNOLOCK, @(fldDes),
                                    nil) = DBIERR_NONE) do
            begin
                if (fldDes.iFldType = fldBLOB) then
                begin
                    ChkRslt(DbiFreeBlob(hCur, pRecBuf, FldCntr),
                            DBIERR_NONE, '    Error - FreeBlob.');
                end;
                Inc(FldCntr);
            end;
        end;

        { Free allocated record buffer }
        FreeMem(pRecBuf,TblProps.iRecBufSize);
    end;

    { Clean up and return }
    ChkRslt(DbiCloseCursor(hFldList), DBIERR_NONE,
            '    Error - CloseCursor.');

    ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
            '    Error - CloseCursor.');

    FillTable := DBIERR_NONE;
end;

{===============================================================
   Function:
           CreateAndFillTable(hDb, pTblDesc, NumRecs, phCur);

   Input:  hDb         - Database handle
           pTblDesc    - Pointer to a descriptor for the table to
                         create
           phCur       - Pointer to table cursor (nil means do not
                         open the table after creating

   Return: IDAPI return code.

   Description:
           Create a table based on the table descriptor
           supplied. If 'phCur <> nil' then the table will be opened,
           and the table cursor will be passed back thru this parameter.
 ================================================================ }
function CreateAndFillTable (hDb: hDBIDb; pTblDesc: pCRTblDesc; 
                             NumRecs: Integer; var phCur: hDBICur): DBIResult;
var
    rslt:      DBIResult;

begin
    Screen('  Creating '+pTblDesc^.szTblName+' table ...');

    rslt := ChkRslt(DbiCreateTable(hDb, TRUE, pTblDesc^), DBIERR_NONE,
                   '    Error - CreateTable.');
    if (rslt = DBIERR_NONE) then
    begin
        { Call the routine that will fill the table }
        rslt := FillTable(hDb, pTblDesc^.szTblName, pTblDesc^.szTblType,
                         NumRecs);

        { Open the table if the create & fill worked }
        if ((rslt = DBIERR_NONE) and (phCur <> nil)) then
        begin
            rslt := DbiOpenTable(hDb, pTblDesc^.szTblName,
                                pTblDesc^.szTblType, nil, nil, 0,
                                dbiREADWRITE, dbiOPENSHARED, xltFIELD,
                                FALSE, nil, phCur);
            ChkRslt(rslt, DBIERR_NONE, '    Error - OpenTable.');
        end;
    end;
    CreateAndFillTable := rslt;
end;

{=====================================================================
   Function:
           DisplayInMemoryTable();

   Input:  The cursor handle - which table to access
           DisplayNRecs      - How many records to display
           0                 - all records in the table

   Return: Result of displaying the records in the table

   Descrption:
           This function will display all records in the table referenced
           by the cursor. This function is used to display
           in-memory and scema tables which do not support
           the use of ReadBlock ( which is used in DislpayTable )

   Note:   This function will only display the columns
           correctly when using a fixed pitch font.
 ===================================================================== }
function DisplayInMemoryTable (hCur: hDBICur; 
                               uDisplayNRecs: longint): DBIResult;
var
    rslt: DBIResult;                    { IDAPI function return value }
    TblProps: CURProps;                 { Table Properties }
    pFldDescs: pFLDDesc;                { List of fields }
    pRecBuf: pBYTE;                     { Record Buffer }
    szFormat: PChar;                    { Contains an entire record (row) }
    pszField: pPChar;                   { Array to contain the fields of
                                          the table. }
    szTemp: array[0..MAXLEN] of CHAR;   { Temporary variable for
                                          reading data }
const
    uDefLength: Word = 15;              { Default size of a field }
    uFldNum: Word = 0;                  { Loop variable }
    uCurCountRec: longint = 0;           { Counter to keep track of how many
                                          records have been displayed }

begin

    uCurCountRec := 0;
    uFldNum := 0;

    GetMem (szFormat,1600 * sizeof(BYTE));
    if (szFormat = nil) then
    begin
        DisplayInMemoryTable := DBIERR_NOMEMORY;
        exit;
    end;

    rslt := ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
                       '    Error - GetCursorProps.');
    if (rslt <> DBIERR_NONE) then
    begin
        FreeMem(szFormat, 1600 * sizeof(BYTE));
        DisplayInMemoryTable := rslt;
        exit;
    end;

    { Allocate space for the Record Buffer }
    GetMem (pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
    if not Assigned(pRecBuf) then
    begin
        DisplayInMemoryTable := DBIERR_NOMEMORY;
        exit;
    end;

    { Allocate enough space to contain information (Field Descriptors)
      about all the fields in the answer table. }
    GetMem (pFldDescs, TblProps.iFields * sizeof(FLDDesc));
    if not Assigned(pFldDescs) then
    begin
        FreeMem(szFormat, 1600 * sizeof(BYTE));
        FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
        DisplayInMemoryTable := DBIERR_NOMEMORY;
        exit;
    end;

    { Get information about the fields. }
    ChkRslt(DbiGetFieldDescs(hCur, pFldDescs), DBIERR_NONE,
            '        Error - QryGetFieldDescs.');

    { Allocate enough buffers to contain data from the fields in the
      answer table. Also sets the width of non-fldZSTRING fields
      (all data will be converted to Strings for display ) }
    GetMem(pszField, TblProps.iFields * sizeof(PChar));

    { Set up formatting for the fields }
    SetupFields(TblProps, pFldDescs, pszField, uDefLength);

    { Display the names of the fields, aligned by column }
    Screen('');
    StrCopy(szFormat,'        ');
    for uFldNum := 1 to TblProps.iFields do
    begin
        StrCat(szFormat, RightPad(szTemp, pFldDescs^.szName,
                                  pFldDescs^.iUnits1+1));
        Inc(pFldDescs);
    end;
    Dec(pFldDescs, TblProps.iFields);
    { Display the header }
    WriteLn(szFormat);

    { Get records from the table until the end of the table is reached
      or the maximum number of records is reached.
      Note that not all field types are supported. All supported field
      types are displayed as Strings. }
    if (uDisplayNRecs = 0) then
        uDisplayNRecs := MaxLongInt; { Maximize value for uDisplayNRecs }

    while (uCurCountRec < uDisplayNRecs) do
    begin
        rslt := DbiGetNextRecord(hCur, dbiNOLOCK, pRecBuf, nil);
        if (rslt <> DBIERR_NONE) then
           break;
        Inc(uCurCountRec);
        { Fill the Record buffer with the field values }
        GetFields(hCur, pFldDescs, pRecBuf, pszField, uDefLength);

        { Initialize szFormat to all zero's }
        FillChar(szFormat^, sizeof(szFormat), #0);
        { Add leading blank space to the record }
        StrCopy(szFormat,'        ');
        { Add each field to be displayed, making certain that the
          columns line up. }
        for uFldNum := 1 to TblProps.iFields do
        begin
            StrCat(szFormat, RightPad(szTemp, pszField^,
                                      pFldDescs^.iUnits1+1));
            Inc(pFldDescs);
            Inc(pszField);
        end;
        Dec(pFldDescs, TblProps.iFields);
        Dec(pszField, TblProps.iFields);
        { Display the record}
        WriteLn(szFormat);
    end;
    { Expect the End-Of-File error - just means that there
      arn't any more records in the table. }
    if (rslt = DBIERR_EOF) then
    begin
        rslt := DBIERR_NONE;
    end;

    { Clean up }
    for uFldNum := 1 to TblProps.iFields do
    begin
        dispose(pszField^);
        Inc(pFldDescs);
        Inc(pszField);
    end;
    Dec(pszField, TblProps.iFields);
    Dec(pFldDescs, TblProps.iFields);
    FreeMem(pszField, TblProps.iFields * sizeof(PChar));
    FreeMem(pFldDescs, TblProps.iFields * sizeof(FLDDesc));
    FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
    FreeMem(szFormat, 1600 * sizeof(BYTE));

    DisplayInMemoryTable := rslt;
end;

{=====================================================================
   Function:
           DisplayTable();

   Input:  The cursor handle - which table to access
           DisplayNRecs      - How many records to display
           0                 - display all records in the table

   Return: Result of displaying the records in the table

   Descrption:
           This function will display all records in the table referenced
           by the cursor. Records are read from the table in blocks,
           making this function faster than the DisplayInMemoryTable()
           function.

   Note:   This function will only display the columns
           correctly when using a fixed pitch font.
 ===================================================================== }
function DisplayTable (hCur: hDBICur; uDisplayNRecs: LongInt): DBIResult;
var
    rslt: DBIResult;                  { IDAPI function return value }
    TblProps: CURProps;               { Table Properties }
    pFldDescs: pFLDDesc;              { List of fields }
    pRecBuf: pBYTE;                   { Record Buffer }
    pszField: pPChar;                 { Array to contain the fields of the table. }
    szFormat: PChar;                  { Contains an entire record (row) }
    szTemp: array[0..MAXLEN] of CHAR; { Temporary variable for reading data }
const
    uDefLength: Word = 15;            { Default size of a field }
    uFldNum: Word = 0;                { Loop variable }
    uCurCountRec: longint = 0;        { Counter to keep track of how many
                                        records have been displayed }
    uMaxNumRecs: Word = 30;           { Maximum number of record to read
                                        from the table at a time }
    uNumRecs: longint = 0;            { Number of records Read in from the
                                        table }
    uCount: LongInt = 0;              { Loop Variable }

begin
    { Allocate memory for the format string }
    GetMem (szFormat, 1400);
    if not Assigned(szFormat) then
    begin
        Screen('    Error - Out of Memory');
        DisplayTable := DBIERR_NOMEMORY;
        exit;
    end;
    { Set szFormat = ' '}
    szFormat[0] := ' ';
    uCurCountRec := 0;
    uNumRecs := 0;
    uCount := 0;
    uFldNum := 0;

    { Get the size of the record buffer }
    rslt := ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
                       '    Error - GetCursorProps.');
    if (rslt <> DBIERR_NONE) then
    begin
        FreeMem(szFormat,1400);
        DisplayTable := rslt;
        exit;
    end;
    { Allocate space for the Record Buffer }
    GetMem (pRecBuf, TblProps.iRecBufSize * sizeof(BYTE) * uMaxNumRecs);
    if not Assigned(pRecBuf) then
    begin
        FreeMem(szFormat, 1400);
        DisplayTable := DBIERR_NOMEMORY;
        exit;
    end;

    { Allocate enough space to contain information (Field Descriptors)
      about all the fields in the answer table. }
    GetMem (pFldDescs, TblProps.iFields * sizeof(FLDDesc));
    if not Assigned(pFldDescs) then
    begin
        FreeMem(szFormat, 1400);
        FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE) * uMaxNumRecs);
        DisplayTable := DBIERR_NOMEMORY;
        exit;
    end;

    { Get information about the fields. }
    ChkRslt(DbiGetFieldDescs(hCur, pFldDescs), DBIERR_NONE,
            '        Error - GetFieldDescs.');

    { Allocate enough buffers to contain data from the fields in the
      answer table. Also sets the width of non-fldZSTRING fields
      (all data will be converted to Strings for display ) }
    GetMem(pszField, TblProps.iFields * sizeof(PChar));
    if not Assigned(pszField) then
    begin
        FreeMem(szFormat, 1400);
        FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE) * uMaxNumRecs);
        FreeMem(pFldDescs, TblProps.iFields * sizeof(FLDDesc));
        DisplayTable := DBIERR_NOMEMORY;
        exit;
    end;

    SetupFields(TblProps, pFldDescs, pszField, uDefLength);

    { Format the names of the fields, aligned by column }
    StrCopy(szFormat,'        ');
    for uFldNum := 1 to TblProps.iFields do
    begin
        StrCat(szFormat, RightPad(szTemp, pFldDescs^.szName,
                                  pFldDescs^.iUnits1+1));
        Inc(pFldDescs);
    end;
    Dec(pFldDescs, TblProps.iFields);

    { Display the header information ( field names ) }
    Screen(' ');
    WriteLn(szFormat);

    { Get records from the table until the end of the table is reached
      Note that not all field types are supported. All supported field
      types are displayed as Strings.
      The DbiReadBlock function is used in case field mapping
      is taking place - the GetNextRec, GetPriorRec, and GetRelativeRec
      functions do not take field mapping into consideration. }
    uNumRecs := uMaxNumRecs; { Set the number of records to read from the
                   table as a block
                   if uCurCoutRec = 0, display all the records in the table }
    if (uDisplayNRecs = 0) then
        uDisplayNRecs := MaxLongInt; { Maximize value for uDisplayNRecs }

    { Get the records from the table and display }
    repeat
        { Limit the number of records to be read from the table -
          do not want to display more total records than is specified
          in uDisplayNRecs }
        if ((uNumRecs + uCurCountRec) > uDisplayNRecs) then
            uNumRecs := uDisplayNRecs - uCurCountRec;
        { Read a block of records - reading more than one record at a
          time is more efficient than reading records one at a time from
          the table. }
        rslt := DbiReadBlock(hCur, uNumRecs, pRecBuf);
        if ((rslt <> DBIERR_EOF) and { DBIERR_EOF is an expected return }
            (rslt <> DBIERR_NONE)) then { code- means cannot read more records }
        begin
          FreeMem(szFormat, 1400);
          for uFldNum := 1 to TblProps.iFields do
          begin
              dispose(pszField^);
              Inc(pFldDescs);
              Inc(pszField);
          end;
          Dec(pFldDescs, TblProps.iFields);
          Dec(pszField, TblProps.iFields);
          FreeMem(pszField, TblProps.iFields * sizeof(PChar));
          FreeMem(pFldDescs, TblProps.iFields * sizeof(FLDDesc));
          FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE) * uMaxNumRecs);
          FreeMem(szFormat, 1400);
          DisplayTable := rslt;
          exit;
        end;
        uCount := 0;
        while (uCount < uNumRecs) do
        begin
            Inc(uCount);
            Inc(uCurCountRec);

            { Fill the Record buffer with the field values }
            GetFields(hCur, pFldDescs,
                      PChar(pRecBuf) + ((uCount-1)*TblProps.iRecBufSize),
                      pszField, uDefLength);

            { Add leading blank space to the record }
            StrCopy(szFormat,'        ');
            { Add each field to be displayed, making certain that the
              columns line up. }
            for uFldNum := 1 to TblProps.iFields do
            begin
                StrCat(szFormat, RightPad(szTemp, pszField^,
                                          pFldDescs^.iUnits1));
                Inc(pFldDescs);
                Inc(pszField);
            end;
            Dec(pFldDescs, TblProps.iFields);
            Dec(pszField, TblProps.iFields);
            { Display the record }
            WriteLn(szFormat);
         end; { for ... uCount }

        { While ReadBlock reads as many records as are supposed to be
          batched (uMaxNumRecs) and the maximum number of records have not
          been read from the table. Not having read the number of records
          specified in uMaxNumRecs indicates that the end of the table has
          been reached. }
    until ((uNumRecs <> uMaxNumRecs) or
            (uCurCountRec >= uDisplayNRecs));

    { Expect the End-Of-File error - just means that there
      arn't any more records in the table. }
    if (rslt = DBIERR_EOF) then
        rslt := DBIERR_NONE;

    { Clean up }
    for uFldNum := 1 to TblProps.iFields do
    begin
        dispose(pszField^);
        Inc(pFldDescs);
        Inc(pszField);
    end;
    Dec(pFldDescs, TblProps.iFields);
    Dec(pszField, TblProps.iFields);

    FreeMem(pszField, TblProps.iFields * sizeof(PChar));
    FreeMem(pFldDescs, TblProps.iFields * sizeof(FLDDesc));
    FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE) * uMaxNumRecs);
    FreeMem(szFormat, 1400);

    DisplayTable := DBIERR_NONE;
end;

{=====================================================================
   Function:
           PutFieldSample(hCur, pRecBuf, FldNum, pfldDesc);

   Input:  hCur     - The handle for the table to fill
           pRecBuf  - The record buffer to insert data into
           FldNum   - The field we are generating
           pfldDesc - A descriptor that describes the field to generate

   Return: Result returned from DbiPutField().

   Description:
           This routine is used to put field data into a record
           buffer. Note that all LOGICAL field types are covered. You
           will need to refer to documentation, or run the DRVCAPS.C
           example for PHYSICAL to LOGICAL field mappings.
 ===================================================================== }
function PutFieldSample (hCur: hDBICur; pRecBuf: pBYTE; FldNum: Word;
                         pfldDesc: pFLDDesc): DBIResult;
var
    pBuf: pBYTE;         { Buffer which contains the record data }
    rslt: DBIResult;     { Return value from Paradox functions }
    i: Integer;          { Loop counter }
    BlobSize: Integer;   { Size of the BLOB }
    Bool: Boolean;       { Used for fldBOOL }
    i16: Integer;        { Used for fldINT16 }
    ui16: Word;          { Used for fldUINT16 }
    i32: LongInt;        { Used for fldINT32 }
    ui32: LongInt;       { Used for fldUINT32 }
    fFloat: Double;      { Used for fldFLOAT }
    fmBcd: FMTBcd;       { Used for fldBCD }
    dDate: DbiTypes.DATE;         { Used for fldDATE }
    tTime: DbiTypes.TIME;         { Used for fldTIME }
    tStamp: DbiTypes.TIMESTAMP;   { Used for fldTIMESTAMP }
    month: Word;         { Used in generating the date }
    day: Word;           { Used in generating the date }
    year: Word;          { Used in generating the date }
    hour: Word;          { Used in generating the time }
    min: Word;           { Used in generating the time }
    sec: Word;           { Used in generating the time }
 begin
    { Allocate a generic buffer (used for string & blob fields) }
    GetMem (pBuf,4096);

    { This switch contains sample code that demonstrates how to
      insert a field of any type into a record buffer. Random data
      is used by this example. }
    case (pfldDesc^.iFldType) of
        fldBYTES,
        fldZSTRING:
          begin
            StrPCopy(PChar(pBuf), 'Field #'+IntToStr(FldNum));

            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, pBuf);
          end;
        fldDATE:
          begin
            { Randomly generate & encode a date }
            month := random(11) + 1;
            day := random(20) + 1;
            year := random(98) + 1900;
            ChkRslt(DbiDateEncode(month, day, year, dDate),
                    DBIERR_NONE, '    Error - DateEncode.');

            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @(dDate));
          end;
        fldBLOB:
          begin
            { Generate a blob from 10-4010 bytes }
            BlobSize := (random(4000))+10;

            StrCopy(PChar(pBuf), 'BLOB example ');
            { Write data to the BLOB field }
            for i := 0 to (BlobSize mod 11) do
            begin
                StrCat(PChar(pBuf), 'BLOB test ');
            end;

            { Init the blob header (contents defined by IDAPI client) }
            if ((pfldDesc^.iSubType = fldstFMTMEMO) or
                 (pfldDesc^.iSubType = fldstOLEOBJ) or
                 (pfldDesc^.iSubType = fldstGRAPHIC)) then
            begin
                 FillChar(pBuf^, 8, #0);
            end;

            { Open the blob prior to putting }
            ChkRslt(DbiOpenBlob(hCur, pRecBuf, FldNum, dbiREADWRITE),
                    DBIERR_NONE, '    Error - OpenBlob.');

            { Put the blob. Note that DbiFreeBlob() will be
              called after the record is inserted! }
            rslt := DbiPutBlob(hCur, pRecBuf, FldNum, 0, BlobSize,
                              pBuf);
          end;
        fldBOOL:
          begin
            { Boolean fields are either TRUE or FALSE }
            if (random(100) < 50) then
                Bool := True
            else
                Bool := False;
            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @(Bool));
          end;
        fldINT16:
          begin
            i16 := (random(120));
            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @(i16));
          end;
        fldBCD:
          begin
            fFloat := (random(10000) / 1.21324);
            ChkRslt(DbiBcdFromFloat(fFloat, pfldDesc^.iUnits1,
                                    pfldDesc^.iUnits2, fmBcd),
                    DBIERR_NONE, '    Error - BcdFromFloat.');
            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @fmBcd);
          end;
        fldLOCKINFO:
          begin
            rslt := 0;
          end;
        fldUINT16:
          begin
            ui16 := (random(120));
            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @(ui16));
          end;
        fldINT32:
          begin
            { Put the data into the record buffer if it is not an
              Auto Increment field. }
            if (pfldDesc^.iSubType <> fldstAUTOINC) then
            begin
                i32 := (random(10000));
                rslt := DbiPutField(hCur, FldNum, pRecBuf, @(i32));
            end
            else
                { Don't have to put a value into an Auto Increment Field,
                    but do have to make certain to not return an error. }
                rslt := 0;
          end;
        fldUINT32:
          begin
            ui32 := (random(10000));
            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @(ui32));
          end;
        fldFLOAT:
          begin
            fFloat := (random(10000) / 1.21324);
            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @fFloat);
          end;
        fldTIME:
          begin
            { Randomize, and encode, a time value }
            hour := random(23) + 1;
            min := random(59) + 1;
            sec := random(59999);
            ChkRslt(DbiTimeEncode(hour, min, sec, tTime), DBIERR_NONE,
                    '    Error - TimeEncode.');

            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @(tTime));
          end;
        fldTIMESTAMP:
          begin
            { Encode a date and a time }
            month := random(11) + 1;
            day := random(20) + 1;
            year := random(98)+1900;
            ChkRslt(DbiDateEncode(month, day, year, dDate),
                    DBIERR_NONE, '    Error - DateEncode.');
            hour := random(23) + 1;
            min :=  random(59) + 1;
            sec :=  random(59999);
            ChkRslt(DbiTimeEncode(hour, min, sec, tTime),
                    DBIERR_NONE, '    Error - TimeEncode.');

            { Now encode, and put, the time stamp }
            ChkRslt(DbiTimeStampEncode(dDate, tTime, tStamp),
                    DBIERR_NONE, '    Error - TimeStampEncode');
            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @tStamp);
          end;
        fldVARBYTES:
          begin
            { Init the size (1st two bytes) & contents }
            pBuf^ := pfldDesc^.iUnits1 - 2;
            Inc(pBuf);
            for i := 2 to pfldDesc^.iUnits1 do
            begin
                Inc(pBuf);
                pBuf^ := random(90)+32;
            end;
            { Put the data into the record buffer }
            rslt := DbiPutField(hCur, FldNum, pRecBuf, @(pBuf));
          end;
    else
          begin
            rslt := DBIERR_INVALIDFLDTYPE;
          end;
    end;
    { Determine if any of the previous DbiPutField functions failed. }
    ChkRslt(rslt, DBIERR_NONE, '    Error - PutField.');

    { Clean up and return }
    freeMem (pBuf, 4096);
    PutFieldSample := rslt;
end;

{=====================================================================
   Function:
           MakeFullPath (PChar szDirectory)

   Input:  szDirectory - String to contain the path to the Tables
                           directory.

   Return: DBIERR_SUCCESS

   Description:
           This function is used to get the fully qualified path to
           the EXAMPLES\TABLES directory. This function will only work
           when the EXAMPLES\TABLES directory resides in ..\TABLES.
 ===================================================================== }
function MakeFullPath (szDirectory: PChar): DBIResult;
var
    iLoop: integer;      { Loop counter }
    TmpPtr: PChar;

const
    szRelDirectory = '..\TABLES';
    szTablesDirectory = '\TABLES';

begin
    { Get the current working directory }
    StrPCopy(szDirectory, ParamStr(0));
    { Remove the .EXE and one directory from the full path }
    for iLoop := 1 to 2 do
    begin
      TmpPtr := StrRScan(szDirectory, '\');
      { if the path cannot be determined, use a relative path }
      if TmpPtr = nil then
      begin
        StrCopy(szDirectory, szRelDirectory);
        Break;
      end;
      TmpPtr^ := #0;
      { Place the tables directory on the new path }
      if iLoop = 2 then
        StrCat(szDirectory, szTablesDirectory);
    end;
    MakeFullPath := dbiErr_None;
end;

{ =====================================================================
  Function:
          MakeFullTblPath (pszDirectory, pszRelativeDirectory)

  Input:  pszDirectory            - String to contain the path to the tables
                                      directory.
          pszRelativeDirectory    - String which contains the relative offset
                                      from the current directory.

  Return: int     - If the directory exists

  Description:
          This function is used to get the fully qualified path to
          the directory which will contain the tables. This function
          will only work when pszRelativeDirectory contains either "."
          an absolute path, or <..\\>TABLES.
 ===================================================================== }
function MakeFullTblPath (pszDirectory :PChar;
                          pszRelativeDirectory: PChar) :DBIResult;
var
    iExists: integer;    { Does the directory exist? }
    iLen: integer;       { Length of the path }
    iLoop: integer;      { Loop counter }
    iDepth: integer;     { How relative the directory is }
const
    cDrive: Byte = 3;
    
begin

    { Assume absolute path if second character is a ':'. }
    if (pszRelativeDirectory[1] = ':') then
    begin
        StrCopy(pszDirectory, pszRelativeDirectory);
    end
    else 
    begin
        if ( StrComp(pszRelativeDirectory, '.') = 0) then
        begin
            { Get the current working directory. }
(*            GetCurDir(pszDirectory, cDrive);      *)
        end
        else
        begin
            { Get the current working directory. }
(*            GetCurDir(pszDirectory, cDrive); *)
            iLen := strlen(pszDirectory);
            iDepth := 0;

            { Determine where in the string the last directory on 
              the path starts }
            while(StrLComp(@pszRelativeDirectory[iDepth * 3], '..\',3) = 0) do
            begin
                for iLoop := iLen downto -1 do
                    { If the current character is equal to '\', we found 
                      the start of last directory on the path }
                    if (pszDirectory[iLoop] = '\') then
                        break;

                iLen := iLoop - 1;
                iDepth := iDepth + 1;
            end;
            { Copy the 'TABLES' directory to form the full path to the tables.
                Need to move past szDirectory past the '\' and szTblDirectory
                past the '..\'. }
            StrCopy( @pszDirectory[iLoop+1],
                          @pszRelativeDirectory[iDepth * 3]);
        end;
    end;

    MakeFullTblPath := DBIERR_NONE;
end;

{=====================================================================
   Function:
           DisplayNextRecord(HDBICur hCur)

   Input:  Handle to the cursor.

   Return: DBIERR_SUCCESS

   Description:
           This function will call DisplayInMemoryTable() with a value
           of 1 for the second parameter.  This way it will display the
           next record.
 ===================================================================== }
function DisplayNextRecord(hCur: hDBICur): DBIResult;
begin
    ChkRslt(DisplayInMemoryTable(hCur, 1), DBIERR_NONE, '    Error - '+
            'DisplayNextRecord');

    DisplayNextRecord := DBIERR_NONE;
end;

{=====================================================================
   Function:
           DisplayCurrentRecord();

   Input:  The cursor handle - which table to access

   Return: Result of displaying the records in the table

   Descrption:
           This function will display the current record only.

   Note:   This function will only display the columns
           correctly when using a fixed pitch font.
 ===================================================================== }
function DisplayCurrentRecord (hCur: hDBICur): DBIResult;
var
    rslt: DBIResult;                 { IDAPI function return value }
    TblProps: CURProps;              { Table Properties }
    pFldDescs: pFLDDesc;             { List of fields }
    pRecBuf: pBYTE;                  { Record Buffer }
    pszField: pPChar;                { Array to contain the fields of the
                                       table. }
    szFormat: PChar;                 { Contains an entire record (row) }
    uFldNum: Word;                   { Loop variable }
    szTemp: array[0..MAXLEN] of CHAR;{ Temporary variable for reading data }
const
    uDefLength: Word = 15;           { Default size of a field }

begin

    GetMem(szFormat, 1600*sizeof(BYTE));
    if not Assigned(szFormat) then
        DisplayCurrentRecord := DBIERR_NOMEMORY;

    rslt := ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
                       '    Error - GetCursorProps.');
    if (rslt <> DBIERR_NONE) then
    begin
        FreeMem(szFormat, 1600*SizeOf(BYTE));
        DisplayCurrentRecord := rslt;
        exit;
    end;

    { Allocate space for the Record Buffer }
    GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
    if not Assigned(pRecBuf) then
    begin
        DisplayCurrentRecord := DBIERR_NOMEMORY;
        exit;
    end;

    { Allocate enough space to contain information (Field Descriptors)
      about all the fields in the answer table. }
    GetMem(pFldDescs, TblProps.iFields * sizeof(FLDDesc));
    if not Assigned(pFldDescs) then
    begin
        FreeMem(szFormat, 1600*SizeOf(BYTE));
        FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
        DisplayCurrentRecord := DBIERR_NOMEMORY;
        exit;
    end;

    { Get information about the fields. }
    ChkRslt(DbiGetFieldDescs(hCur, pFldDescs), DBIERR_NONE,
            '        Error - QryGetFieldDescs.');

    { Allocate enough buffers to contain data from the fields in the
      answer table. Also sets the width of non-fldZSTRING fields
      (all data will be converted to Strings for display ) }
    GetMem(pszField, TblProps.iFields * sizeof(PChar));

    { Set up formatting for the fields }
    SetupFields(TblProps, pFldDescs, pszField, uDefLength);

    { Display the names of the fields, aligned by column }
    Screen('');
    StrCopy(szFormat,'        ');
    for uFldNum := 1 to TblProps.iFields do
    begin
        StrCat(szFormat, RightPad(szTemp, pFldDescs^.szName,
                                  pFldDescs^.iUnits1+1));
        Inc(pFldDescs);
    end;
    Dec(pFldDescs, TblProps.iFields);
    { Display the header }
    WriteLn(szFormat);

    ChkRslt(DbiGetRecord(hCur, dbiNOLOCK, pRecBuf, nil), DBIERR_NONE,
            '    Error - GetRecord');

    { Fill the Record buffer with the field values }
    GetFields(hCur, pFldDescs, pRecBuf, pszField, uDefLength);

    { Initialize szFormat to all zero's }
    FillChar(szFormat^, sizeof(szFormat), #0);
    { Add leading blank space to the record }
    StrCopy(szFormat,'        ');

    { Add each field to be displayed, making certain that the
      columns line up. }
    for uFldNum := 1 to TblProps.iFields do
    begin
        StrCat(szFormat, RightPad(szTemp, pszField^,
                                  pFldDescs^.iUnits1+1));
        Inc(pFldDescs);
        Inc(pszField);
    end;
    Dec(pFldDescs, TblProps.iFields);
    Dec(pszField, TblProps.iFields);
    { Display the record }
    WriteLn(szFormat);

    { Expect the End-Of-File error - just means that there
      arn't any more records in the table. }
    if (rslt = DBIERR_EOF) then
        rslt := DBIERR_NONE;

    { Clean up }
    for uFldNum := 1 to TblProps.iFields do
    begin
        dispose(pszField^);
        Inc(pFldDescs);
        Inc(pszField);
    end;
    Dec(pFldDescs, TblProps.iFields);
    Dec(pszField, TblProps.iFields);

    FreeMem(pszField, TblProps.iFields * sizeof(PChar));
    FreeMem(pFldDescs, TblProps.iFields * sizeof(FLDDesc));
    FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
    FreeMem(szFormat, 1600*sizeof(BYTE));

    DisplayCurrentRecord := rslt;
end;

end.