TeslaRel410/BORLAND/BDE/EXAMPLES/PASCAL/CR8DBTBL.PAS

{ cr8dbtbl.pas }
program Cr8DbTbl;

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

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

{ Field Descriptor used in creating a table }
fldDes: array[0..8] of FLDDesc = (
              ( { Field 1 - FLOAT }
        iFldNum:     1;            { Field Number }
        szName:      'FLOAT';      { Field Name }
        iFldType:    fldFLOAT;     { Field Type }
        iSubType:    fldUNKNOWN;   { Field Subtype }
        iUnits1:     8;            { 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 }
              ),
              ( { Field 2 - CHARACTER }
        iFldNum:     2; szName:      'CHARACTER'; 
        iFldType:    fldZSTRING; iSubType:    fldUNKNOWN;
        iUnits1:     12; iUnits2:     0;
        iOffset:     0; iLen:        0; 
        iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
        efldrRights: fldrREADWRITE
              ),
              ( { Field 3 - NUMERIC }
        iFldNum:     3; szName:      'NUMERIC';
        iFldType:    fldFLOAT; iSubType:    fldUNKNOWN;
        iUnits1:     6; iUnits2:     0; 
        iOffset:     0; iLen:        0; 
        iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
        efldrRights: fldrREADWRITE
              ),
              ( { Field 4 - DATE }
        iFldNum:     4; szName:      'DATE';
        iFldType:    fldDATE; iSubType:    fldUNKNOWN;
        iUnits1:     0; iUnits2:     0; 
        iOffset:     0; iLen:        0;
        iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
        efldrRights: fldrREADWRITE
              ),
              ( { Field 5 - LOGICAL }
        iFldNum:     5; szName:      'LOGICAL';
        iFldType:    fldBOOL; iSubType:    fldUNKNOWN;
        iUnits1:     0; iUnits2:     0; 
        iOffset:     0; iLen:        0;
        iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
        efldrRights: fldrREADWRITE
              ),
              ( { Field 6 - MEMO }
        iFldNum:     6; szName:      'MEMO';
        iFldType:    fldBLOB; iSubType:    fldstMEMO;
        iUnits1:     10; iUnits2:     0;
        iOffset:     0; iLen:        0;
        iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
        efldrRights: fldrREADWRITE
              ),
              ( { Field 7 - OLE }
        iFldNum:     7; szName:      'OLE'; 
        iFldType:    fldBLOB; iSubType:    fldstDBSOLEOBJ;
        iUnits1:     10; iUnits2:     0;
        iOffset:     0; iLen:        0;
        iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
        efldrRights: fldrREADWRITE
              ),
              ( { Field 8 - BINARY }
        iFldNum:     8; szName:      'BINARY'; 
        iFldType:    fldBLOB; iSubType:    fldstTYPEDBINARY;
        iUnits1:     10; iUnits2:     0;
        iOffset:     0; iLen:        0;
        iNullOffset: 0; efldvVchk:   fldvNOCHECKS; 
        efldrRights: fldrREADWRITE
              ),
              ( { Field 9 - DBASELOCK }
        iFldNum:     9; szName:      'DBASELOCK'; 
        iFldType:    fldLOCKINFO; iSubType:    fldUNKNOWN;
        iUnits1:     8; iUnits2:     0; 
        iOffset:     0; iLen:        0;
        iNullOffset: 0; efldvVchk:   fldvNOCHECKS;
        efldrRights: fldrREADWRITE
              )
        );  { Array of field descriptors }

{=====================================================================
   Procedure:   CreateAndFillSampleDB();

   Input:  None.

   Return: None.

   Description:
           This sample code will create a dBASE table, insert
           10 records into the table, then delete the table.

    Note:   This example uses the new dBASE 5 table format.
 ===================================================================== }

var
    hDb: hDBIDb;                  { Handle to the database }
    hCur: hDBICur;                { Handle to the table }
    TblDesc: CRTblDesc;           { Create table descriptor }
    uNumFields: INT16;
const
    uDispNumRecs: UINT16 = 10;    { Number of records to add and
                                    display. }

begin

    Screen('*** Create/Open/Fill Table Example ***');

    Screen('    Initializing IDAPI...');
    if (InitAndConnect(hDb) <> DBIERR_NONE) then
    begin
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    { The number of fields in the table - note that fldDesc is defined
      globally }
    uNumFields := trunc(sizeof(fldDes) / sizeof (fldDes[0]));

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

    { Initialize the table descriptor with the minimum values }
    Screen('    Initializing the table descriptor...');
    FillChar(TblDesc, sizeof(CRTblDesc), #0);
    lstrcpy(TblDesc.szTblName, szTblName);
    lstrcpy(TblDesc.szTblType, szTblType);
    TblDesc.iFldCount := uNumFields;
    TblDesc.pfldDesc := @fldDes;

    Screen('    Creating the '+szTblName+' dBASE table...');
    if (ChkRslt(DbiCreateTable(hDb, TRUE, TblDesc), DBIERR_NONE,
                   '    Error - CreateTable.') <> DBIERR_NONE) then
    begin
        Screen('        Make certain that the dBASE table level is set'
               +' to 5 in IDAPI.CFG.');
        Screen('    Close the Database and exit IDAPI...');
        CloseDbAndexit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    Screen('    Fill the table with Random Data...');
    FillTable(hDb, pCHAR(szTblName), pCHAR(szTblType), uDispNumRecs);

    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...');
        DbiDeleteTable(hDb, pCHAR(szTblName), pCHAR(szTblType));
        CloseDbAndexit(hDb);
        Screen('');
        Screen('*** End of Example ***');
        exit;
    end;

    Screen('    Display the '+szTblName+' table which we just created...');
    DisplayTable(hCur, uDispNumRecs);

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

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

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

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

end.