source410: literal 4.10 source reconstruction + BC++ 4.52 fleet toolchain archived
- 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>
This commit is contained in:
Claude Fable 5
@@ -0,0 +1,325 @@
|
||||
{ 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.
|
||||
Reference in New Issue
Block a user