CydandClaude Fable 5
63312e07f9
- BORLAND/: Borland C++ 4.52 (chosen over 4.5 by byte-match: CODE/RP/CW32.LIB
is identical to 4.52's install lib). BCC32/TLINK32/TLIB/MAKE run natively on
Win11; CODE/BT/OPT.MAK is the shipped BTL4OPT.EXE's exact flag recipe
(extender = Borland PowerPack DPMI32, not Phar Lap TNT).
- restoration/source410/: the literal 1995-form reconstruction of the missing
BT game source (never mixed into CODE/). Round 1-3 state:
* 6 of 10 surviving original TUs COMPILE CLEAN under the period toolchain
(BTMSSN, BTCNSL, BTSCNRL, BTTEAM, BTL4MODE, BTL4ARND) - first builds
since 1996.
* BT_L4/BTL4APP.CPP pilot reconstruction: 12/12 functions, Fail() lands on
its binary-recorded line 400 exactly.
* BT/BTCNSL.HPP: console wire IDs recovered from the binary's ctors
(Killed=9, Damaged=10, ScoreUpdate=13, DeathWithoutHonor=15 [T1];
TeamScore=12 flagged [T4]).
* MUNGA/: 8 engine-header backfills back-dated from the BT412 WinTesla tree
(VDATA numbering decomp-verified; AUDREND's OpenAL-era virtual removed -
the period compiler is the drift detector).
* Tooling: backdate.py (WinTesla->1995 header transform), compile410.sh
(per-TU verification sweep under authentic OPT.MAK flags).
* README: corrected roadmap - MECH.HPP is the capstone grown with the mech
TU reconstructions; BTREG.CPP green = the header-family milestone.
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
639 lines
26 KiB
ObjectPascal
639 lines
26 KiB
ObjectPascal
{ batmove.pas }
|
|
program BatMove;
|
|
|
|
{$IfDef VER80}
|
|
uses SnipTool, SnipData, SysUtils, WinTypes, WinProcs,
|
|
DbiProcs, DbiTypes, DbiErrs;
|
|
{$Else}
|
|
uses WinTypes, WinCrt, Strings, DbiProcs, DbiTypes, DbiErrs,
|
|
SnipTool, SnipData;
|
|
{$EndIf}
|
|
|
|
const
|
|
NAMELEN = 10; { Set the length of the name fields }
|
|
PLACELEN = 20; { Set the length of the POB field }
|
|
DATELEN = 11; { Length that a date will be displayed: mm\dd\yyyy }
|
|
|
|
szDBTblName = 'DBPeople'; { Name of table to be created. }
|
|
szDBTblType = szDBASE; { Table type to use. }
|
|
|
|
{ Field Descriptor used in creating a table }
|
|
|
|
DBfldDesc: array[0..2] of FLDDesc = (
|
|
( { Field 1 - First Name }
|
|
iFldNum: 1; { Field Number }
|
|
szName: 'Name'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: NAMELEN; { Field Size }
|
|
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 - Place of Birth }
|
|
iFldNum: 2; szName: 'POB'; iFldType: fldZSTRING;
|
|
iSubType: fldUNKNOWN; iUnits1: PLACELEN;
|
|
iUnits2: 0; iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
( { Field 3 - Date of Birth }
|
|
iFldNum: 3; szName: 'DOB'; iFldType: fldZSTRING;
|
|
iSubType: fldUNKNOWN; iUnits1: DATELEN;
|
|
iUnits2: 0; iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
)
|
|
);
|
|
|
|
{ Index Descriptor - describes the Indexe associated with the
|
|
table. }
|
|
DBidxDesc: array[0..2] of idxDesc = (
|
|
( { Primary Index - Full Name }
|
|
szName: 'Name'; { Name }
|
|
iIndexId: 1; { Number }
|
|
szTagName: 'NAME'; { Tag Name ( for dBase ) }
|
|
szFormat: ''; { Optional Format}
|
|
bPrimary: TRUE; { Primary? }
|
|
bUnique: FALSE; { Unique? }
|
|
bDescending: FALSE; { Descending? }
|
|
bMaintained: TRUE; { Maintained? }
|
|
bSubset: FALSE; { SubSet? }
|
|
bExpIdx: FALSE; { Expression index? }
|
|
iCost: 0; { for QBE only }
|
|
iFldsInKey: 1; { Fields in key }
|
|
iKeyLen: 1; { Length in bytes }
|
|
bOutofDate: FALSE; { Index out of date? }
|
|
iKeyExpType: 0; { Key Type of Expression }
|
|
aiKeyFld: (1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
|
{ Array of field numbers }
|
|
szKeyExp: ''; { Key expression }
|
|
szKeyCond: ''; { Key Condition }
|
|
bCaseInsensitive: FALSE; { Case insensitive }
|
|
iBlockSize: 0; { Block size in bytes }
|
|
iRestrNum: 0; { Restructure number }
|
|
iUnUsed: (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
|
|
),
|
|
( { Secondary Index 1 - Single-Field }
|
|
szName: 'POB'; iIndexId: 2;
|
|
szTagName: 'POB1'; szFormat: '';
|
|
bPrimary: FALSE; bUnique: FALSE;
|
|
bDescending: FALSE; bMaintained: TRUE;
|
|
bSubset: FALSE; bExpIdx: FALSE;
|
|
iCost: 0; iFldsInKey: 1;
|
|
iKeyLen: 1; bOutofDate: FALSE;
|
|
iKeyExpType: 0;
|
|
aiKeyFld: (2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
|
szKeyExp: ''; szKeyCond: '';
|
|
bCaseInsensitive: FALSE; iBlockSize: 0;
|
|
iRestrNum: 0;
|
|
iUnUsed: (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
|
|
),
|
|
( { Secondary Index 2 - Single Field }
|
|
szName: 'DOB'; iIndexId: 3;
|
|
szTagName: 'DOB1'; szFormat: '';
|
|
bPrimary: FALSE; bUnique: FALSE;
|
|
bDescending: FALSE; bMaintained: TRUE;
|
|
bSubset: FALSE; bExpIdx: FALSE;
|
|
iCost: 0; iFldsInKey: 1;
|
|
iKeyLen: 1; bOutofDate: FALSE;
|
|
iKeyExpType: 0;
|
|
aiKeyFld: (3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
|
szKeyExp: ''; szKeyCond: '';
|
|
bCaseInsensitive: FALSE;
|
|
iBlockSize: 0; iRestrNum: 0;
|
|
iUnUsed: (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
|
|
)
|
|
);
|
|
|
|
szPDTblName = 'PDPeople'; { Name of table to be created. }
|
|
szPDTblType = szPARADOX; { Table type to use. }
|
|
|
|
|
|
{ Field Descriptor used in creating a table. }
|
|
PDfldDesc: array[0..4] of FLDDesc = (
|
|
( { Field 1 - First Name }
|
|
iFldNum: 1; { Field Number }
|
|
szName: 'First Name'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: NAMELEN; { Field Size }
|
|
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 - Middle Name }
|
|
iFldNum: 2; szName: 'Middle Name';
|
|
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
|
|
iUnits1: NAMELEN; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
( { Field 3 - Last Name }
|
|
iFldNum: 3; szName: 'Last Name';
|
|
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
|
|
iUnits1: NAMELEN; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
( { Field 4 - Date of Birth }
|
|
iFldNum: 4; szName: 'DOB';
|
|
iFldType: fldDATE; iSubType: fldUNKNOWN;
|
|
iUnits1: 0; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
( { Field 5 - Place of Birth }
|
|
iFldNum: 5; szName: 'POB';
|
|
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
|
|
iUnits1: PLACELEN; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
)
|
|
);
|
|
|
|
{ Index Descriptor - describes the Indexe associated with the
|
|
table. }
|
|
PDidxDesc: array[0..2] of idxDesc = (
|
|
( { Primary Index - Full Name }
|
|
szName: 'Full Name'; { Name }
|
|
iIndexId: 1; { Number }
|
|
szTagName: ''; { Tag Name ( for dBase ) }
|
|
szFormat: ''; { Optional Format}
|
|
bPrimary: TRUE; { Primary? }
|
|
bUnique: TRUE; { Unique? }
|
|
bDescending: FALSE; { Descending? }
|
|
bMaintained: TRUE; { Maintained? }
|
|
bSubset: FALSE; { SubSet? }
|
|
bExpIdx: FALSE; { Expression index? }
|
|
iCost: 0; { for QBE only }
|
|
iFldsInKey: 3; { Fields in key }
|
|
iKeyLen: 1; { Length in bytes }
|
|
bOutofDate: FALSE; { Index out of date? }
|
|
iKeyExpType: 0; { Key Type of Expression }
|
|
aiKeyFld: (1,2,3,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
|
{ Array of field numbers }
|
|
szKeyExp: ''; { Key expression }
|
|
szKeyCond: ''; { Key Condition }
|
|
bCaseInsensitive: FALSE; { Case insensitive }
|
|
iBlockSize: 0; { Block size in bytes }
|
|
iRestrNum: 0; { Restructure number }
|
|
iUnUsed: (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
|
|
),
|
|
( { Secondary Index 1 - Single-Field - Maintained,
|
|
Case insensitive }
|
|
szName: 'Last Name'; iIndexId: 2;
|
|
szTagName: ''; szFormat: '';
|
|
bPrimary: FALSE; bUnique: FALSE;
|
|
bDescending: FALSE; bMaintained: TRUE;
|
|
bSubset: FALSE; bExpIdx: FALSE;
|
|
iCost: 0; iFldsInKey: 1;
|
|
iKeyLen: 1; bOutofDate: FALSE;
|
|
iKeyExpType: 0;
|
|
aiKeyFld: (3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
|
szKeyExp: ''; szKeyCond: '';
|
|
bCaseInsensitive: TRUE; iBlockSize: 0;
|
|
iRestrNum: 0;
|
|
iUnUsed: (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
|
|
),
|
|
( { Secondary Index 2 - Single Field - Not Maintained }
|
|
szName: 'POB'; iIndexId: 3;
|
|
szTagName: ''; szFormat: '';
|
|
bPrimary: FALSE; bUnique: FALSE;
|
|
bDescending: FALSE; bMaintained: FALSE;
|
|
bSubset: FALSE; bExpIdx: FALSE;
|
|
iCost: 0; iFldsInKey: 1;
|
|
iKeyLen: 1; bOutofDate: FALSE;
|
|
iKeyExpType: 0;
|
|
aiKeyFld: (5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
|
szKeyExp: ''; szKeyCond: '';
|
|
bCaseInsensitive: FALSE; iBlockSize: 0;
|
|
iRestrNum: 0;
|
|
iUnUsed: (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
|
|
)
|
|
);
|
|
|
|
|
|
{=====================================================================
|
|
Code: AddRecordDB();
|
|
|
|
Input: pointer to the cursor handle, name(pCHAR), Date(pCHAR),
|
|
Place of birth(pCHAR).
|
|
|
|
Return: Result of adding the record to the table
|
|
|
|
Description:
|
|
This function will add a record to the given dBASE table.
|
|
===================================================================== }
|
|
function AddRecordDB (hCur: hDBICur; pszNAME, pszPOB,
|
|
pszDATE: pCHAR): DBIResult;
|
|
|
|
var
|
|
rslt: DBIResult; { Value returned from IDAPI functions }
|
|
TblProps: CURProps; { Table Properties }
|
|
pRecBuf: pBYTE; { Record Buffer }
|
|
|
|
begin
|
|
{ Allocate a record buffer }
|
|
ChkRslt(DbiGetCursorProps( hCur, TblProps), DBIERR_NONE,
|
|
' Error - GetProps.');
|
|
|
|
GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
|
|
if not Assigned(pRecBuf) then
|
|
begin
|
|
Screen(' Error - Out of memory.');
|
|
AddRecordDB := DBIERR_NOMEMORY;
|
|
end;
|
|
|
|
{ Make sure we're starting with a clean record buffer }
|
|
ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
|
|
' Error - InitRecord.');
|
|
|
|
{ Name }
|
|
ChkRslt(DbiPutField(hCur, 1, pRecBuf, pBYTE(pszNAME)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
{ Place fo Birth }
|
|
ChkRslt(DbiPutField(hCur, 2, pRecBuf, pBYTE(pszPOB)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
{ Date of birth }
|
|
ChkRslt(DbiPutField(hCur, 3, pRecBuf, pBYTE(pszDATE)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
rslt := ChkRslt(DbiInsertRecord(hCur, dbiNOLOCK, pRecBuf),
|
|
DBIERR_NONE, ' Error - InsertRec.');
|
|
|
|
FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
|
|
|
|
AddRecordDB := rslt;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: CreateDBTable();
|
|
|
|
Input: pointer to the database handle.
|
|
|
|
Return: result of the table initialization.
|
|
|
|
Description:
|
|
This function creates a table and fills the table
|
|
with a few records.
|
|
===================================================================== }
|
|
function CreateDBTable (phDb: hDBIDb): DBIResult;
|
|
|
|
var
|
|
rslt: DBIResult; { Value returned from IDAPI functions }
|
|
hCur: hDBICur; { Cursor handle for the table that is
|
|
created }
|
|
crTblDes: CRTblDesc; { Table Descriptor }
|
|
const
|
|
bOverWrite: BOOL = TRUE; { Overwrite, yes/no flag }
|
|
|
|
{ The number of fields in the table - note that fldDesc is defined
|
|
globally }
|
|
uNumFields: Integer = trunc(sizeof(DBfldDesc) / sizeof (DBfldDesc[0]));
|
|
|
|
{ Number of indexes to be created when the table is created - note
|
|
that idxDesc is defined globally. }
|
|
uNumIndexes: Integer = trunc(sizeof(DBidxDesc) / sizeof(DBidxDesc[0]));
|
|
|
|
begin
|
|
|
|
{Initialize the table create descriptor.}
|
|
FillChar(crTblDes, sizeof(CRTblDesc), #0); { Clear the buffer. }
|
|
StrCopy(crTblDes.szTblName, szDBTblName) ; { name of the table }
|
|
StrCopy(crTblDes.szTblType, szDBTblType) ; { Type of table }
|
|
crTblDes.iFldCount := uNumFields ; { number of fields }
|
|
crTblDes.pfldDesc := @DBfldDesc ; { Field descriptor }
|
|
crTblDes.iIdxCount := uNumIndexes ; { Number of indexes }
|
|
crTblDes.pidxDesc := @DBidxDesc ; { Index descriptor }
|
|
|
|
{ Create the table using information supplied in the Table
|
|
Descrpitor above }
|
|
Screen(' Creating table and indexes...');
|
|
rslt := ChkRslt(DbiCreateTable( phDb, bOverWrite, crTblDes),
|
|
DBIERR_NONE, ' Error - CreateTable.');
|
|
if ( rslt <> DBIERR_NONE) then
|
|
begin
|
|
CreateDBTable := rslt;
|
|
exit;
|
|
end;
|
|
|
|
{ Open the table }
|
|
rslt := ChkRslt(DbiOpenTable( phDb, pCHAR(szDBTblName),
|
|
pCHAR(szDBTblType), nil, nil, 0,
|
|
dbiREADWRITE, dbiOPENSHARED,
|
|
xltFIELD, FALSE, nil, hCur),
|
|
DBIERR_NONE, ' Error - OpenTable.');
|
|
if (rslt <> DBIERR_NONE) then
|
|
begin
|
|
CreateDBTable := rslt;
|
|
exit;
|
|
end;
|
|
|
|
{ Add records to the table }
|
|
rslt := AddRecordDB(hCur, 'Jeffery', 'San Jose', '1/28/1967');
|
|
rslt := AddRecordDB(hCur, 'William', 'New York', '8/12/1970');
|
|
rslt := AddRecordDB(hCur, 'Jimmy', 'San Francisco', '3/10/1924');
|
|
rslt := AddRecordDB(hCur, 'Larry', 'Germany', '12/22/1933');
|
|
|
|
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
|
|
CreateDBTable := rslt;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: AddRecord();
|
|
|
|
Input: pointer to the cursor handle, first name (pCHAR), middle
|
|
name (pCHAR), last name (pCHAR), Month of Birth (UINT16), Day
|
|
of Birth (UINT16), Year of Birth (UINT16), Place of birth
|
|
(pCHAR).
|
|
|
|
Return: Result of adding the record to the table
|
|
|
|
Description:
|
|
This function will add a record to the given table.
|
|
===================================================================== }
|
|
Function AddRecord (hCur: hDBICur; pszFirst: pCHAR;
|
|
pszMiddle: pCHAR; pszLast: pCHAR;
|
|
uMonth: UINT16; uDay: UINT16; uYear: UINT16;
|
|
pszPOB: pCHAR): DBIResult;
|
|
|
|
var
|
|
dDate: DATE; { Date structure }
|
|
rslt: DBIResult; { Value returned from IDAPI functions }
|
|
TblProps: CURProps; { Table Properties }
|
|
pRecBuf: pBYTE; { Record Buffer }
|
|
|
|
begin
|
|
{ Allocate a record buffer }
|
|
ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
|
|
' Error - GetCursorProps.');
|
|
|
|
GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
|
|
if not Assigned(pRecBuf) then
|
|
begin
|
|
AddRecord := DBIERR_NOMEMORY;
|
|
exit;
|
|
end;
|
|
|
|
{ Make sure we're starting with a clean record buffer }
|
|
ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
|
|
' Error - InitRecord.');
|
|
|
|
{ First Name }
|
|
ChkRslt(DbiPutField(hCur, 1, pRecBuf, pBYTE(pszFirst)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
{ Middle Name }
|
|
ChkRslt(DbiPutField(hCur, 2, pRecBuf, pBYTE(pszMiddle)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
{ Last Name }
|
|
ChkRslt(DbiPutField(hCur, 3, pRecBuf, pBYTE(pszLast)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
{ DOB }
|
|
ChkRslt(DbiDateEncode(uMonth, uDay, uYear, dDate),
|
|
DBIERR_NONE, ' Error - DateEncode.');
|
|
ChkRslt(DbiPutField(hCur, 4, pRecBuf, @dDate),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
{ Place fo Birth }
|
|
ChkRslt(DbiPutField(hCur, 5, pRecBuf, pBYTE(pszPOB)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
rslt := ChkRslt(DbiInsertRecord(hCur, dbiNOLOCK, pRecBuf),
|
|
DBIERR_NONE, ' Error - InsertRecord.');
|
|
|
|
FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
|
|
|
|
AddRecord := rslt;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: CreatePDTable();
|
|
|
|
Input: pointer to the database handle.
|
|
|
|
Return: result of the table initialization.
|
|
|
|
Description:
|
|
This function will create a table and fill the table
|
|
with a few records.
|
|
===================================================================== }
|
|
function CreatePDTable (phDb: hDBIDb): DBIResult;
|
|
|
|
var
|
|
rslt: DBIResult; { Value returned from IDAPI functions }
|
|
hCur: hDBICur; { Cursor handle for the table that is
|
|
created }
|
|
crTblDes: CRTblDesc; { Table Descriptor }
|
|
const
|
|
bOverWrite: BOOL = TRUE; { Overwrite, yes/no flag }
|
|
|
|
{ The number of fields in the table - note that fldDesc is defined
|
|
globally }
|
|
uNumFields: integer = trunc(sizeof(PDfldDesc) / sizeof (PDfldDesc[0]));
|
|
|
|
{ Number of indexes to be created when the table is created - note
|
|
that idxDesc is defined globally. }
|
|
uNumIndexes: integer = trunc(sizeof(PDidxDesc) / sizeof(PDidxDesc[0]));
|
|
|
|
begin
|
|
{Initialize the table create descriptor.}
|
|
FillChar(crTblDes, sizeof(CRTblDesc), #0); { Clear the buffer. }
|
|
strcopy(crTblDes.szTblName, szPDTblName) ; { name of the table }
|
|
strcopy(crTblDes.szTblType, szPDTblType) ; { Type of table }
|
|
crTblDes.iFldCount := uNumFields ; { number of fields }
|
|
crTblDes.pfldDesc := @PDfldDesc ; { Field descriptor }
|
|
crTblDes.iIdxCount := uNumIndexes ; { Number of indexes }
|
|
crTblDes.pidxDesc := @PDidxDesc ; { Index descriptor }
|
|
|
|
{ Create the table using information supplied in the Table
|
|
Descrpitor above }
|
|
rslt := ChkRslt(DbiCreateTable(phDb, bOverWrite, crTblDes),
|
|
DBIERR_NONE, ' Error - CreateTable.');
|
|
if (rslt <> DBIERR_NONE) then
|
|
begin
|
|
CreatePDTable := rslt;
|
|
exit;
|
|
end;
|
|
|
|
rslt := ChkRslt(DbiOpenTable(phDb, pCHAR(szPDTblName),
|
|
pCHAR(szPDTblType), nil, nil, 0,
|
|
dbiREADWRITE, dbiOPENSHARED,
|
|
xltFIELD, FALSE, nil, hCur),
|
|
DBIERR_NONE, ' Error - OpenTable.');
|
|
if (rslt <> DBIERR_NONE) then
|
|
begin
|
|
CreatePDTable := rslt;
|
|
exit;
|
|
end;
|
|
|
|
{ Add records to the table }
|
|
rslt := AddRecord(hCur, 'David', 'John', 'Smith', 7, 28, 1968,
|
|
'Chicago');
|
|
rslt := AddRecord(hCur, 'Tracy', 'Joanne', 'Thompson', 12, 27, 1969,
|
|
'Hermosa Beach');
|
|
rslt := AddRecord(hCur, 'John', 'Boy', 'Doe', 2, 7, 1954,
|
|
'Ohmaha');
|
|
rslt := AddRecord(hCur, 'Klaus', 'Epstein', 'Stern', 4, 13, 1970,
|
|
'Tel Aviv');
|
|
|
|
{ Close the table so it can be reopened from the calling function. }
|
|
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
|
|
CreatePDTable := rslt;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Procedure: BatchMove();
|
|
|
|
Input: None.
|
|
|
|
Return: None.
|
|
|
|
Description:
|
|
This example appends and updates data across two tables.
|
|
This example includes key violation and problems with
|
|
changed tables.
|
|
===================================================================== }
|
|
|
|
var
|
|
hDb: hDBIDb; { Handle to the database }
|
|
DBhCur: hDBICur; { dBASE Cursor handle }
|
|
PDhCur: hDBICur; { PARADOX Cursor handle }
|
|
const
|
|
ulNumRecs: UINT32 = 0; { Number of records moved in Batch move }
|
|
ulChangedRecs: UINT32 = 0; { Number of records changed in Batch move }
|
|
ulKeyViolRecs: UINT32 = 0; { Number of key violations in Batch move }
|
|
ulProbRecs: UINT32 = 0; { Number of problem recs in Batch move }
|
|
uaSrcRecs: array[0..2] of Word = (1,5,4);
|
|
{ Fields to use in the source table }
|
|
szKeyViol: DBIPATH = 'KEYVIOL';
|
|
szProblems: DBIPATH = 'PROBLEMS';
|
|
szChanged: DBIPATH = 'CHANGED'; {Names of temporary tables.}
|
|
|
|
begin
|
|
Screen('*** Table Copy Example ***');
|
|
|
|
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 default dBASE Database directory...');
|
|
ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
|
|
' Error - SetDirectory.');
|
|
|
|
Screen(' Create the '+StrPas(szDBTblName)+' dBASE table...');
|
|
if (CreateDBTable(hDb) <> DBIERR_NONE) then
|
|
begin
|
|
CloseDbAndexit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
{ Open the table which was created with the above statement. }
|
|
Screen(' Open the dBASE table which we just created....');
|
|
if (ChkRslt(DbiOpenTable(hDb, pCHAR(szDBTblName),
|
|
pCHAR(szDBTblType), nil, nil, 0,
|
|
dbiREADWRITE, dbiOPENSHARED, xltFIELD,
|
|
FALSE, nil, DBhCur),
|
|
DBIERR_NONE, ' Error - OpenTable.') <> DBIERR_NONE) then
|
|
begin
|
|
CloseDbAndexit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
ChkRslt(DbiSetToBegin(DBhCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Displaying the '+StrPas(szDBTblName)+' dBASE table...');
|
|
ChkRslt(DisplayTable(DBhCur, 0), DBIERR_NONE,
|
|
' Error - Display Table');
|
|
|
|
Screen('');
|
|
Screen(' Create the '+StrPas(szPDTblName)+' PARADOX table...');
|
|
if (CreatePDTable(hDb) <> DBIERR_NONE) then
|
|
begin
|
|
CloseDbAndexit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
Screen(' Open the PARADOX table which we just created....');
|
|
if (ChkRslt(DbiOpenTable(hDb, pCHAR(szPDTblName),
|
|
pCHAR(szPDTblType), nil, nil, 0,
|
|
dbiREADWRITE, dbiOPENSHARED, xltFIELD,
|
|
FALSE, nil, PDhCur),
|
|
DBIERR_NONE, ' Error - OpenTable.') <> DBIERR_NONE) then
|
|
begin
|
|
CloseDbAndexit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
ChkRslt(DbiSetToBegin(PDhCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Displaying the '+StrPas(szPDTblName)+' PARADOX table...');
|
|
ChkRslt(DisplayTable(PDhCur, 0), DBIERR_NONE,
|
|
' Error - Display Table');
|
|
|
|
ChkRslt(DbiSetToBegin(PDhCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen('');
|
|
Screen(' Appending the PARADOX table to the dBASE table...');
|
|
ChkRslt(DbiBatchMove(nil, PDhCur, nil, DBhCur, batchAPPEND, 3,
|
|
@uaSrcRecs, nil, nil, 0, szKeyViol, szProblems,
|
|
szChanged, @ulProbRecs, @ulKeyViolRecs,
|
|
@ulChangedRecs, FALSE, FALSE, ulNumRecs, TRUE),
|
|
DBIERR_NONE,' Error - Batch Move');
|
|
|
|
ChkRslt(DbiSetToBegin(DBhCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Displaying the new updated dBASE table...');
|
|
ChkRslt(DisplayTable(DBhCur, 0), DBIERR_NONE,
|
|
' Error - Display Table');
|
|
|
|
Screen('');
|
|
Screen(' Closing the PARADOX table ... ');
|
|
ChkRslt(DbiCloseCursor(PDhCur), DBIERR_NONE,
|
|
' Error - CloseCur.');
|
|
|
|
Screen(' Delete the PARADOX table ...');
|
|
ChkRslt(DbiDeleteTable(hDb,pCHAR(szPDTblName), pCHAR(szPDTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
|
|
Screen(' Closing the dBASE table ...');
|
|
ChkRslt(DbiCloseCursor(DBhCur),DBIERR_NONE, ' Error - CloseCur.');
|
|
|
|
Screen(' Delete the dBASE table ...');
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szDBTblName), pCHAR(szDBTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
|
|
Screen(' Close the Database and exit IDAPI...');
|
|
CloseDbAndexit(hDb);
|
|
|
|
Screen('*** End of Example ***');
|
|
|
|
end.
|