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>
326 lines
13 KiB
ObjectPascal
326 lines
13 KiB
ObjectPascal
{ refinteg.pas }
|
|
program RefInteg;
|
|
|
|
{$IfDef VER80}
|
|
uses SnipTool, SnipData, SysUtils, WinTypes, WinProcs,
|
|
DbiProcs, DbiTypes, DbiErrs;
|
|
{$Else}
|
|
uses WinTypes, WinCrt, Strings, DbiProcs, DbiTypes, DbiErrs,
|
|
SnipTool, SnipData;
|
|
{$EndIf}
|
|
|
|
const
|
|
szTblName = 'RefInteg'; { Name of table to be created. }
|
|
szTblType = szPARADOX; { Table type to use. }
|
|
|
|
{ Field Descriptor used in creating a table }
|
|
fldDes: array[0..3] of FLDDesc = (
|
|
( { Field 1 - AUTOINC }
|
|
iFldNum: 1; { Field Number }
|
|
szName: 'Status ID'; { Field Name }
|
|
iFldType: fldFLOAT; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: 0; { 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 - ALPHA }
|
|
iFldNum: 2; szName: 'Order No';
|
|
iFldType: fldFLOAT; iSubType: fldUNKNOWN;
|
|
iUnits1: 0; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
( { Field 4 - DATE }
|
|
iFldNum: 3; szName: 'Date Sent';
|
|
iFldType: fldDATE; iSubType: fldUNKNOWN;
|
|
iUnits1: 0; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
( { Field 4 - DATE }
|
|
iFldNum: 4; szName: 'Date Received';
|
|
iFldType: fldDATE; iSubType: fldUNKNOWN;
|
|
iUnits1: 0; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
)
|
|
); { Array of field descriptors }
|
|
|
|
|
|
{ Array of Referential Integrity rules }
|
|
rintDes: array[0..0] of RINTDesc = (
|
|
(
|
|
iRintNum: 1; { Ref Integrity Number }
|
|
szRintName: 'Order No'; { Name for this integrity }
|
|
eType: rintDEPENDENT; { Whether master or dependent }
|
|
szTblName: 'orders.db'; { Other table name }
|
|
eModOp: rintCASCADE; { Modify Qualifier }
|
|
eDelOp: rintRESTRICT; { Delete Modifier }
|
|
iFldCount: 1; { Fields in foreign key }
|
|
aiThisTabFld: (2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
|
{ Fields in this table }
|
|
aiOthTabFld: (1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
|
|
{ Fields in other table }
|
|
)
|
|
);
|
|
|
|
{ Define the operation on the table }
|
|
crOpTyp: CROpType = ( crADD );
|
|
|
|
{ Index Descriptor - describes the Indexes associated with the
|
|
table. This index is going to be added to the table when the
|
|
table is created. }
|
|
idxDes: array[0..1] of IDXDesc = (
|
|
( { Primary Index }
|
|
szName: ''; { 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: 2; { Fields in key }
|
|
iKeyLen: 1; { Length in bytes }
|
|
bOutofDate: FALSE; { Index out of date? }
|
|
iKeyExpType: 0; { Key Type of Expression }
|
|
aiKeyFld: (1,2,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 - Maintained,
|
|
Case insensitive }
|
|
szName: 'Order No'; 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: (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)
|
|
)
|
|
);
|
|
|
|
{=====================================================================
|
|
Function:
|
|
AddRecord (hDBICur hCur, FLOAT fStatus, FLOAT fOrder)
|
|
|
|
Input: hCur - Cursor to which the record will be added
|
|
fStatus - Value to write to the Status ID field
|
|
fOrder - Value to write to the Order ID field
|
|
|
|
Return: Success of the function.
|
|
|
|
Description:
|
|
This function is used to add a record to the table.
|
|
Generates random data for two date fields. Those fields are:
|
|
DateSent - Value to write to the Date Sent field and
|
|
DateDelivered - Value to write to the Date Received field
|
|
===================================================================== }
|
|
Function AddRecord (hCur: hDBICur; fStatus: FLOAT; fOrder: FLOAT): DBIResult;
|
|
|
|
var
|
|
rslt: DBIResult; { Return value from IDAPI functions }
|
|
pRecBuf: pBYTE; { Record Buffer }
|
|
TblProps: CURProps; { The properties of the table }
|
|
uMonth: UINT16; { Contains the month portion of the date }
|
|
uDay: UINT16; { Contains the day portion of the date }
|
|
iYear: INT16; { Contains the year portion of the date }
|
|
szTemp: pCHAR; { Temporary string used in parsing the date }
|
|
sDate: DATE; { Date structure - used in DbiPutField. }
|
|
|
|
begin
|
|
{ Allocate a record buffer }
|
|
ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
|
|
' Error - GetCursorProps.');
|
|
|
|
GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(pBYTE));
|
|
if not Assigned (pRecBuf) then
|
|
begin
|
|
Screen(' Error - Out of Memory.');
|
|
AddRecord := DBIERR_NOMEMORY;
|
|
exit;
|
|
end;
|
|
|
|
{ Make sure we're starting with a clean record buffer }
|
|
ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
|
|
' Error - InitRecord.');
|
|
|
|
{ Add the Status ID to the Record Buffer }
|
|
ChkRslt(DbiPutField(hCur, 1, pRecBuf, @(fStatus)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
|
|
{ Add the Order ID to the Record Buffer }
|
|
ChkRslt(DbiPutField(hCur, 2, pRecBuf, @(fOrder)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
|
|
{ Randomly generate & encode a date }
|
|
uMonth := random(11) + 1;
|
|
uDay := random(20) + 1;
|
|
iYear := random(98) + 1900;
|
|
ChkRslt(DbiDateEncode(uMonth, uDay, iYear, sDate),
|
|
DBIERR_NONE, ' Error - DateEncode.');
|
|
|
|
{ Put the data into the record buffer }
|
|
rslt := DbiPutField(hCur, 3, pRecBuf, @(sDate));
|
|
|
|
{ Randomly generate & encode a date }
|
|
uMonth := random(11) + 1;
|
|
uDay := random(20) + 1;
|
|
iYear := random(98) + 1900;
|
|
{ Encode the date }
|
|
ChkRslt(DbiDateEncode(uMonth, uDay, iYear, sDate),
|
|
DBIERR_NONE, ' Error - DateEncode.');
|
|
|
|
{ Put the data into the record buffer }
|
|
rslt := DbiPutField(hCur, 4, pRecBuf, @(sDate));
|
|
|
|
{ Insert the record into the table }
|
|
rslt := ChkRslt(DbiInsertRecord(hCur, dbiNOLOCK, pRecBuf),
|
|
DBIERR_NONE, ' Error - InsertRecord.');
|
|
|
|
FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(pBYTE));
|
|
|
|
AddRecord := rslt;
|
|
end;
|
|
|
|
|
|
{=====================================================================
|
|
Function:
|
|
RefInteg();
|
|
|
|
Description:
|
|
This function shows how to create and use Referential
|
|
Integrity.
|
|
===================================================================== }
|
|
|
|
var
|
|
hDb: hDBIDb; { Handle to the database }
|
|
hCur: hDBICur; { Handle to the table }
|
|
TblDesc: CRTblDesc; { Create table descriptor }
|
|
uNumFields: UINT16;
|
|
iRintCount: INT16;
|
|
uNumIndexes: UINT16;
|
|
const
|
|
uDispNumRecs: UINT16 = 10; { Number of records to add and display }
|
|
|
|
begin
|
|
Screen('*** Referential Integrity 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]));
|
|
|
|
{ Number of Referential Integrity Rules }
|
|
iRintCount := trunc(sizeof(rintDes) / sizeof(rintDes[0]));
|
|
|
|
{ Number of indexes to be created when the table is created - note
|
|
that idxDesc is defined globally. }
|
|
uNumIndexes := trunc(sizeof(idxDes) / sizeof(idxDes[0]));
|
|
|
|
Screen(' Setting the default Database directory...');
|
|
ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
|
|
' Error - SetDirectory.');
|
|
|
|
Screen(' Initializing the table descriptor...');
|
|
FillChar(TblDesc, SizeOf(CRTblDesc), #0);
|
|
StrCopy(TblDesc.szTblName, szTblName);
|
|
StrCopy(TblDesc.szTblType, szTblType);
|
|
TblDesc.iFldCount := uNumFields;
|
|
TblDesc.pfldDesc := @fldDes;
|
|
TblDesc.iIdxCount := uNumIndexes;
|
|
TblDesc.pidxDesc := @idxDes;
|
|
TblDesc.iRintCount := iRintCount;
|
|
TblDesc.pecrRintOp := @crOpTyp;
|
|
TblDesc.printDesc := @rintDes;
|
|
|
|
Screen(' Creating the '+szTblName+' table...');
|
|
if (ChkRslt(DbiCreateTable(hDb, TRUE, TblDesc), DBIERR_NONE,
|
|
' Error - CreateTable.') <> DBIERR_NONE) then
|
|
begin
|
|
Screen(' Close the Database and exit IDAPI...');
|
|
CloseDbAndExit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
Screen(' Open the '+szTblName+' table...');
|
|
if (ChkRslt(DbiOpenTable(hDb, pCHAR(szTblName), pCHAR(szTblType),
|
|
nil, nil, 0, dbiREADWRITE, dbiOPENSHARED,
|
|
xltFIELD, FALSE, nil, hCur),
|
|
DBIERR_NONE, ' Error - OpenTable.') <> DBIERR_NONE) then
|
|
begin
|
|
Screen(' Close the Database and exit IDAPI...');
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szTblName), pCHAR(szTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
CloseDbAndExit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
{ This add will fail - Order Id of 900 does not exist within the
|
|
orders table }
|
|
Screen(' Add a record to the table. ');
|
|
Screen(' Error Expected -'+
|
|
' no record in the orders table has an ID of 900...');
|
|
AddRecord(hCur, 1, 900);
|
|
|
|
{ This add will success - Order Id of 1004 exists within the orders
|
|
table. }
|
|
Screen('');
|
|
Screen(' Add a record to the table with a valid Order Id...');
|
|
AddRecord(hCur, 1, 1004);
|
|
|
|
ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Display the '+szTblName+' table...');
|
|
DisplayTable(hCur, uDispNumRecs);
|
|
|
|
Screen('');
|
|
Screen(' Close the Table...');
|
|
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
|
|
Screen(' Deleting the table...');
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szTblName), pCHAR(szTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
|
|
Screen(' Close the Database and exit IDAPI...');
|
|
CloseDbAndExit(hDb);
|
|
|
|
Screen('*** End of Example ***');
|
|
|
|
end.
|