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>
271 lines
9.7 KiB
ObjectPascal
271 lines
9.7 KiB
ObjectPascal
{ Block.pas }
|
|
program Block;
|
|
|
|
{$IfDef VER80}
|
|
uses SnipTool, SnipData, SysUtils, WinTypes, WinProcs,
|
|
DbiProcs, DbiTypes, DbiErrs;
|
|
{$Else}
|
|
uses WinTypes, WinCrt, Strings, DbiProcs, DbiTypes, DbiErrs,
|
|
SnipTool, SnipData;
|
|
{$EndIf}
|
|
|
|
const
|
|
szTblName = 'customer'; { Name of table to be created. }
|
|
szCopyTblName = 'custcopy';
|
|
szTblType = szPARADOX; { Table type to use. }
|
|
|
|
|
|
|
|
{=====================================================================
|
|
Code: TableCreateTempCopy();
|
|
|
|
Input: hDb - Handle to the Database
|
|
hCur - Handle to the Source table
|
|
szDestTblName - Name of the Destination table
|
|
szTblType - Type of the table
|
|
phCurTemp - Cursor returned on the temporary table
|
|
|
|
Return: DBIResult - Success of the opperation, or what went
|
|
- wrong.
|
|
|
|
Description:
|
|
This function is used to return a handle to a temporary
|
|
table which is a copy of the passed in table.
|
|
|
|
===================================================================== }
|
|
function TableCreateTempCopy (hDb: hDBIDb; hCur: hDBICur;
|
|
szDestTblName: pCHAR; szTblType: pCHAR;
|
|
var phCurTemp: hDBICur): DBIResult;
|
|
|
|
var
|
|
rslt: DBIResult; { Return value from IDAPI functions }
|
|
crTblDes: CRTblDesc; { Table descriptor }
|
|
pfldDes: pFLDDesc; { Field descriptor }
|
|
curProp: CURProps; { Cursor properties }
|
|
|
|
begin
|
|
ChkRslt(DbiGetCursorProps(hCur, curProp), DBIERR_NONE,
|
|
' Error - GetCursorProps.');
|
|
|
|
{ Allocate memory for the field descriptor }
|
|
GetMem(pfldDes, curProp.iFields * sizeof(FLDDesc));
|
|
|
|
{ Get information on the fields of the table }
|
|
ChkRslt(DbiGetFieldDescs(hCur, pfldDes), DBIERR_NONE,
|
|
' Error - GetFieldDescs.');
|
|
|
|
{ Initialize create table descriptor }
|
|
FillChar(crTblDes, sizeof(crTblDesc), #0);
|
|
StrCopy(crTblDes.szTblName, szDestTblName);
|
|
StrCopy(crTblDes.szTblType, szTblType);
|
|
crTblDes.iFldCount := curProp.iFields;
|
|
crTblDes.pfldDesc := pfldDes;
|
|
|
|
{ Create and open the table }
|
|
rslt := ChkRslt(DbiCreateTable(hDb, TRUE, crTblDes),
|
|
DBIERR_NONE, ' CreateTempTable.');
|
|
if (rslt <> DBIERR_NONE) then
|
|
begin
|
|
FreeMem(pfldDes, curProp.iFields * sizeof(FLDDesc));
|
|
TableCreateTempCopy := rslt;
|
|
exit;
|
|
end;
|
|
|
|
rslt := ChkRslt(DbiOpenTable(hDb, crTblDes.szTblName,
|
|
crTblDes.szTblType, nil,
|
|
nil, 0, dbiREADWRITE,
|
|
dbiOPENSHARED, xltFIELD, FALSE,
|
|
nil, phCurTemp),
|
|
DBIERR_NONE, ' Error - OpenTable.');
|
|
if (rslt <> DBIERR_NONE) then
|
|
begin
|
|
FreeMem(pfldDes, curProp.iFields * sizeof(FLDDesc));
|
|
TableCreateTempCopy := rslt;
|
|
exit;
|
|
end;
|
|
|
|
FreeMem(pfldDes, curProp.iFields * sizeof(FLDDesc));
|
|
TableCreateTempCopy := rslt;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: Block();
|
|
|
|
Input: None.
|
|
|
|
Return: None.
|
|
|
|
Description:
|
|
This example shows how to read and write records to a table
|
|
in blocks (more than one record at a time). Moveing records
|
|
in blocks is the prefered method of reading and writting
|
|
records to a table because it enhances the performance of
|
|
the application.
|
|
===================================================================== }
|
|
|
|
var
|
|
rslt: DBIResult; { Return value from IDAPI functions }
|
|
hDb: hDBIDb; { Handle to the Database }
|
|
hCur: hDBICur; { Handle to the table }
|
|
hCurCopy: hDBICur; { Handle to a temporary table }
|
|
CurProp: CURProps; { Properties of the Cursor }
|
|
pRecBuf: pointer; { Pointer to the record buffer }
|
|
uRecNum: UINT16; { Loop counter - current record num }
|
|
uRecOffset: UINT16; { Offset into the block of records }
|
|
DestBuf: array[0..34] of CHAR; { New field value to write to the
|
|
table }
|
|
TempBuf: array[0..34] of CHAR; { Field value read in from the table }
|
|
bBlank: BOOL; { Used to determine if a field is blank }
|
|
const
|
|
uNumBuf: UINT32 = 10; { Number of records to buffer }
|
|
uNumRecs: UINT32 = 10; { Number of records to display, 0=all }
|
|
|
|
begin
|
|
Screen('*** Block maniplulation example ***');
|
|
Screen('');
|
|
|
|
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 Database directory...');
|
|
ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
|
|
' Error - SetDirectory.');
|
|
|
|
Screen(' Open the '+szTblName+' table (source)...');
|
|
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(' Clean up IDAPI...');
|
|
CloseDbAndexit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
{ Create a temporary table with the same field structure as the
|
|
source table }
|
|
if (TableCreateTempCopy(hDb, hCur, pCHAR(szCopyTblName),
|
|
pCHAR(szTblType), hCurCopy) <> DBIERR_NONE) then
|
|
begin
|
|
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
Screen(' Clean up IDAPI...');
|
|
CloseDbAndexit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
{ Get the size of the record buffer }
|
|
ChkRslt(DbiGetCursorProps(hCur, CurProp), DBIERR_NONE,
|
|
' Error - GetCursorProps.');
|
|
|
|
{ Allocate space for the Record Buffer }
|
|
GetMem(pRecBuf, CurProp.iRecBufSize * sizeof(BYTE) * uNumBuf);
|
|
if not Assigned(pRecBuf) then
|
|
begin
|
|
Screen(' Error - Out of memory.');
|
|
CloseDbAndexit(hDb);
|
|
exit;
|
|
end;
|
|
|
|
Screen('');
|
|
Screen(' Go to the beginning of the '+szTblName+' table...');
|
|
ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Display the '+szTblName+' table...');
|
|
ChkRslt(DisplayTable(hCur, uNumRecs), DBIERR_NONE,
|
|
' Error - DisplayTable.');
|
|
|
|
Screen('');
|
|
Screen(' Go to the beginning of the '+szTblName+' table...');
|
|
ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Read '+IntToStr(uNumBuf)+' records from the '+
|
|
szTblName+' table...');
|
|
|
|
rslt := DbiReadBlock(hCur, uNumBuf, pRecBuf);
|
|
{ Getting an EOF error is ok - just means that an attempt was
|
|
made to read more records than are currently in the table. }
|
|
if ((rslt <> DBIERR_EOF) and (rslt <> DBIERR_NONE)) then
|
|
begin
|
|
ChkRslt(rslt, DBIERR_NONE, ' Error - ReadBlock');
|
|
end;
|
|
|
|
for uRecNum := 1 to uNumBuf do
|
|
begin
|
|
{ Calculate the record offset. }
|
|
uRecOffset := (uRecNum-1)*CurProp.iRecBufSize;
|
|
|
|
{ Get the value in the second field for each record }
|
|
ChkRslt(DbiGetField(hCur, 2,
|
|
PChar(pRecBuf)+uRecOffset,
|
|
@TempBuf, bBlank),
|
|
DBIERR_NONE, ' Error - GetField.');
|
|
|
|
Screen(' Modify the record: add "'+IntToStr(uRecNum)+'" to '+
|
|
' '+StrPas(TempBuf)+' ');
|
|
|
|
{ Put the record number at the start of the field }
|
|
StrPCopy(DestBuf, IntToStr(Integer(uRecNum)));
|
|
StrCat(DestBuf, ' ');
|
|
|
|
{ Add the record number to the head of the field }
|
|
StrLCat(DestBuf, TempBuf, (30 - strlen(DestBuf)));
|
|
|
|
{ Update the buffer value }
|
|
ChkRslt(DbiPutField(hCur, 2,
|
|
PChar(pRecBuf)+uRecOffset,
|
|
@DestBuf),
|
|
DBIERR_NONE, ' Error - GetField.');
|
|
end;
|
|
|
|
{ Write uNumBuf records to the table }
|
|
Screen('');
|
|
Screen(' Write '+IntToStr(uNumBuf)+' records to the '+
|
|
szCopyTblName+' table...');
|
|
ChkRslt(DbiWriteBlock(hCurCopy, uNumBuf, pRecBuf), DBIERR_NONE,
|
|
' Error := WriteBlock.');
|
|
|
|
{ Go to the beginning of the table }
|
|
Screen('');
|
|
Screen(' Go to the beginning of the '+szCopyTblName+' table...');
|
|
ChkRslt(DbiSetToBegin(hCurCopy), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Display the '+szCopyTblName+' table...');
|
|
ChkRslt(DisplayTable(hCurCopy, uNumRecs), DBIERR_NONE,
|
|
' Error - DisplayTable.');
|
|
|
|
{ Release allocated memory }
|
|
FreeMem(pRecBuf, CurProp.iRecBufSize * sizeof(BYTE) * uNumBuf);
|
|
|
|
Screen('');
|
|
Screen(' Close the tables...');
|
|
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
ChkRslt(DbiCloseCursor(hCurCopy), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
|
|
Screen(' Deleting the "'+szCopyTblName+'" table...');
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szCopyTblName), pCHAR(szTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
|
|
Screen(' Close the Database and exit IDAPI...');
|
|
CloseDbAndexit(hDb);
|
|
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
|
|
end.
|