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>
311 lines
11 KiB
ObjectPascal
311 lines
11 KiB
ObjectPascal
{ Blobio.pas }
|
|
program BlobIO;
|
|
|
|
{$IfDef VER80}
|
|
uses SnipTool, SnipData, SysUtils, WinTypes, WinProcs,
|
|
DbiProcs, DbiTypes, DbiErrs;
|
|
{$Else}
|
|
uses WinTypes, WinCrt, Strings, DbiProcs, DbiTypes, DbiErrs,
|
|
SnipTool, SnipData;
|
|
{$EndIf}
|
|
|
|
const
|
|
szTblName = 'blob_io'; { Name of table to be created. }
|
|
szTblType = szDBASE; { Table type to use. }
|
|
|
|
|
|
fldDes: array[0..1] of FLDDesc = (
|
|
(
|
|
iFldNum: 1; { Field Number }
|
|
szName: 'Item_ID'; { Field Name }
|
|
iFldType: fldINT16; { Field Type }
|
|
iSubType: 0; { Field Subype }
|
|
iUnits1: 1; { 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 }
|
|
),
|
|
(
|
|
iFldNum: 2; szName: 'BigText';
|
|
iFldType: fldBLOB; iSubType: fldstMEMO;
|
|
iUnits1: 0; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
)
|
|
); { Array of field descriptors }
|
|
|
|
|
|
{====================================================================
|
|
Function: FillString();
|
|
|
|
Input: pString - String that will hold the random letters.
|
|
|
|
Return: Result of filling the string.
|
|
|
|
Desc: This function will fill the string with a pre-defined
|
|
string.
|
|
===================================================================== }
|
|
function FillString(pString: pBYTE): BOOL;
|
|
|
|
var
|
|
i: UINT16;
|
|
const
|
|
Filler = 'This is a test';
|
|
uNum: UINT16 = 1900;
|
|
|
|
begin
|
|
{ First copy the filler into the buffer. }
|
|
StrCopy(pCHAR(pString), Filler);
|
|
|
|
{ Now fill the rest of the string using StrCat. }
|
|
for i := 1 to uNum do
|
|
StrCat(pCHAR(pString), Filler);
|
|
|
|
FillString := TRUE;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: FillBlobInfo();
|
|
|
|
Input: hCur - Cursor to the table
|
|
pRecBuf - Record buffe
|
|
Return: Result of filling the BLOB field.
|
|
|
|
Desc: This function will fill the BLOB field of the given
|
|
record buffer with a predefined string.
|
|
===================================================================== }
|
|
function FillBlobInfo (hCur: hDBICur; pRecBuf: pBYTE): DBIResult;
|
|
|
|
const
|
|
Temp1: pBYTE = nil;
|
|
Temp2: pBYTE = nil;
|
|
Temp3: pBYTE = nil;
|
|
Temp4: pBYTE = nil;
|
|
Len: UINT16 = 30000;
|
|
lWritePos: longint = 0;
|
|
|
|
begin
|
|
{ Allocate memory for the four temporary buffers that will in
|
|
all amount to more than 64K of memory. }
|
|
|
|
GetMem(Temp1, (sizeof(BYTE) * Len) + 1);
|
|
if not Assigned(Temp1) then
|
|
FillBlobInfo := DBIERR_NOMEMORY;
|
|
|
|
GetMem(Temp2, (sizeof(BYTE) * Len) + 1);
|
|
if not Assigned(Temp2) then
|
|
FillBlobInfo := DBIERR_NOMEMORY;
|
|
|
|
GetMem(Temp3, (sizeof(BYTE) * Len) + 1);
|
|
if not Assigned(Temp3) then
|
|
FillBlobInfo := DBIERR_NOMEMORY;
|
|
|
|
GetMem(Temp4, (sizeof(BYTE) * Len) + 1);
|
|
if not Assigned(Temp4) then
|
|
FillBlobInfo := DBIERR_NOMEMORY;
|
|
|
|
{ Now fill each buffer with random letters.}
|
|
Screen(' Filling the temporary strings with the pre-defined data....');
|
|
FillString(Temp1);
|
|
FillString(Temp2);
|
|
FillString(Temp3);
|
|
FillString(Temp4);
|
|
|
|
Screen(' Open the BLOB for writting...');
|
|
ChkRslt(DbiOpenBlob(hCur, pRecBuf, 2, dbiREADWRITE),
|
|
DBIERR_NONE, ' Error - OpenBlob');
|
|
|
|
Screen(' Put the first part of the BLOB into the BLOB field...');
|
|
ChkRslt(DbiPutBlob(hCur, pRecBuf, 2, 0, strlen(pCHAR(Temp1)),
|
|
Temp1), DBIERR_NONE, ' Error - PutBlob');
|
|
|
|
{ Set lWritePos to point to the position inside the BLOB. }
|
|
lWritePos := longint(strlen(pCHAR(Temp1)));
|
|
|
|
Screen(' Put the second part of the BLOB into the BLOB field...');
|
|
ChkRslt(DbiPutBlob(hCur, pRecBuf, 2, lWritePos, strlen(pCHAR(Temp2)),
|
|
Temp2), DBIERR_NONE, ' Error - PutBlob');
|
|
|
|
{ Once again increment lWritePos to point to the position inside the BLOB.}
|
|
lWritePos := lWritePos + longint(strlen(pCHAR(Temp2)));
|
|
|
|
Screen(' Put the third part of the BLOB into the BLOB field...');
|
|
ChkRslt(DbiPutBlob(hCur, pRecBuf, 2, lWritePos, strlen(pCHAR(Temp3)),
|
|
Temp3), DBIERR_NONE, ' Error - PutBlob');
|
|
|
|
{ Increment lWritePos to point to the position inside the BLOB. }
|
|
lWritePos := lWritePos + longint(strlen(pCHAR(Temp3)));
|
|
|
|
Screen(' Put the final part of the BLOB into the BLOB field...');
|
|
ChkRslt(DbiPutBlob(hCur, pRecBuf, 2, lWritePos, strlen(pCHAR(Temp4)),
|
|
Temp4), DBIERR_NONE, ' Error - PutBlob');
|
|
|
|
{ Free all the buffers. }
|
|
FreeMem(Temp1, (sizeof(BYTE) * Len) + 1);
|
|
FreeMem(Temp2, (sizeof(BYTE) * Len) + 1);
|
|
FreeMem(Temp3, (sizeof(BYTE) * Len) + 1);
|
|
FreeMem(Temp4, (sizeof(BYTE) * Len) + 1);
|
|
|
|
FillBlobInfo := DBIERR_NONE;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: InsertRec();
|
|
|
|
Input: hCur - Cursor to the table
|
|
uID - ID for the field
|
|
|
|
Return: Result of adding the record to the table
|
|
|
|
Desc: This function will add a record to the given table.
|
|
===================================================================== }
|
|
function InsertRec (hCur: hDBICur; uID: UINT16): DBIResult;
|
|
|
|
var
|
|
rslt: DBIResult; { Value returned from IDAPI functions }
|
|
TblProps: CURProps; { Table Properties }
|
|
pRecBuf: pBYTE; { Record Buffer }
|
|
|
|
begin
|
|
Screen(' Acquire the tables properties...');
|
|
ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
|
|
' Error - GetCursorProps.');
|
|
|
|
{ Allocate memory for the record buffer. }
|
|
GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
|
|
if (pRecBuf = nil) then
|
|
begin
|
|
Screen(' Error - Out of memory.');
|
|
InsertRec := DBIERR_NOMEMORY;
|
|
exit;
|
|
end;
|
|
|
|
Screen(' Initialize record buffer...');
|
|
ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
|
|
' Error - InitRec.');
|
|
|
|
Screen(' Put the ID number into the record buffer...');
|
|
ChkRslt(DbiPutField(hCur, 1, pRecBuf, @(uID)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
|
|
{ Fill the BLOB information pointer with 64K or more of text. }
|
|
ChkRslt(FillBlobInfo(hCur, pRecBuf),
|
|
DBIERR_NONE, ' Error - FillBlob.');
|
|
|
|
Screen(' Insert the record into the table...');
|
|
rslt := ChkRslt(DbiInsertRecord(hCur, dbiNOLOCK, pRecBuf),
|
|
DBIERR_NONE, ' Error - InsertRecord.');
|
|
|
|
Screen(' Free the BLOB...');
|
|
ChkRslt(DbiFreeBlob(hCur, pRecBuf, 2), DBIERR_NONE,
|
|
' Error - Free BLOB');
|
|
|
|
{ free the record buffer. }
|
|
FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
|
|
|
|
InsertRec := rslt;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: Blob_IO();
|
|
|
|
Input: None.
|
|
|
|
Return: None.
|
|
|
|
Description:
|
|
This example will show how to modify and insert a BLOB field
|
|
that is greater than 64K.
|
|
===================================================================== }
|
|
|
|
var
|
|
hDb: hDBIDb; { Database handle }
|
|
hCur: hDBICur; { Cursor handle }
|
|
crTblDes: CRTblDesc; { Table Descriptor }
|
|
uNumFields: UINT16;
|
|
const
|
|
bOverWrite: BOOL = TRUE; { Overwrite, yes/no flag }
|
|
|
|
begin
|
|
Screen('*** Using BLOB''s ***');
|
|
Screen('');
|
|
|
|
Screen(' Initializing IDAPI...');
|
|
if (InitAndConnect(hDb) <> DBIERR_NONE) then { Terminate example if }
|
|
begin { Initialization fails }
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
uNumFields := trunc(sizeof(fldDes) / sizeof(fldDes[0]));
|
|
|
|
Screen(' Setting the Database directory...');
|
|
ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
|
|
' Error - SetDirectory.');
|
|
|
|
{ Initialize the table create descriptor }
|
|
FillChar(crTblDes, sizeof(CRTblDesc), #0); { Clear the buffer. }
|
|
StrCopy(crTblDes.szTblName, szTblName); { name of the table }
|
|
StrCopy(crTblDes.szTblType, szTblType); { Type of table }
|
|
crTblDes.iFldCount := uNumFields; { number of fields }
|
|
crTblDes.pfldDesc := @fldDes; { Field descriptor }
|
|
|
|
Screen(' Creating the '+szTblName+' '+szTblType+' table...');
|
|
if (ChkRslt(DbiCreateTable(hDb, bOverWrite, crTblDes),
|
|
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...');
|
|
CloseDbAndexit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
Screen('');
|
|
Screen(' Inserting the first record ...');
|
|
InsertRec(hCur, 1);
|
|
|
|
Screen('');
|
|
Screen(' Inserting the second record...');
|
|
InsertRec(hCur, 5);
|
|
|
|
Screen('');
|
|
Screen(' Close the '+szTblName+' table...');
|
|
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
|
|
{ Delete the table and its related file from disk }
|
|
Screen(' Delete the '+szTblName+' table...');
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szTblName), pCHAR(szTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
|
|
Screen('');
|
|
Screen(' Close the Database and exit IDAPI...');
|
|
{ Close the Database and exit IDAPI }
|
|
CloseDbAndexit(hDb);
|
|
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
|
|
end.
|
|
|
|
|