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>
459 lines
19 KiB
ObjectPascal
459 lines
19 KiB
ObjectPascal
{ blobsmpl.pas }
|
|
program BlobSmpl;
|
|
|
|
{$IfDef VER80}
|
|
uses SnipTool, SnipData, SysUtils, WinTypes, WinProcs,
|
|
DbiProcs, DbiTypes, DbiErrs;
|
|
{$Else}
|
|
uses WinTypes, WinCrt, Strings, DbiProcs, DbiTypes, DbiErrs,
|
|
SnipTool, SnipData;
|
|
{$EndIf}
|
|
|
|
const
|
|
NAMELEN = 20; { Set name length to 20 characters }
|
|
DATELEN = 9; { Set date length to 9 characters }
|
|
|
|
szTblName = 'BLOBSMPL'; { Table to create }
|
|
szTblType = szPARADOX; { Table Type to use }
|
|
|
|
fldDes: array[0..5] of FLDDesc = (
|
|
(
|
|
iFldNum: 1; { Field Number }
|
|
szName: 'First Name'; { Field Name }
|
|
iFldType: fldZSTRING; { Field Type }
|
|
iSubType: fldUNKNOWN; { Field Subtype }
|
|
iUnits1: NAMELEN; { 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: 'Middle Name';
|
|
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
|
|
iUnits1: NAMELEN; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
(
|
|
iFldNum: 3; szName: 'Last Name';
|
|
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
|
|
iUnits1: NAMELEN; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
(
|
|
iFldNum: 4; szName: 'DOB';
|
|
iFldType: fldDATE; iSubType: fldUNKNOWN;
|
|
iUnits1: 0; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
(
|
|
iFldNum: 5; szName: 'POB';
|
|
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
|
|
iUnits1: 20; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
( { Note that Memo fields in PARADOX require a
|
|
size - this is the amount of the BLOB which
|
|
is stored within the actual table in addition
|
|
to being stored in the .MB file. }
|
|
iFldNum: 6; szName: 'General Info';
|
|
iFldType: fldBLOB; iSubType: fldstMEMO;
|
|
iUnits1: 20; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
)
|
|
); { Array of field descriptors }
|
|
|
|
idxDes: IDXDesc = (
|
|
{ Primary Index }
|
|
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;
|
|
iUnUsed: (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
|
|
);
|
|
|
|
{=====================================================================
|
|
Code: FillHalfString();
|
|
|
|
Input: pString - A String buffer that will be written into by the
|
|
function.
|
|
|
|
Return: Nothing although the input string is modified.
|
|
|
|
Desc: This example fills the input string with a preset string.
|
|
Except it fills the string with a different string
|
|
than FillString().
|
|
===================================================================== }
|
|
procedure FillHalfString (pString: pCHAR);
|
|
begin
|
|
StrCopy(pString,
|
|
+' This is line 1 of the BLOB functions.'#13
|
|
+' This is line 1 of the BLOB functions.'#13);
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: FillString();
|
|
|
|
Input: pString - A String buffer that will be written into by the
|
|
function.
|
|
|
|
Return: Nothing although the input string is modified.
|
|
|
|
Desc: This example fills the input string with a preset string.
|
|
===================================================================== }
|
|
procedure FillString (pString: pCHAR);
|
|
begin
|
|
StrCopy(pString,
|
|
+' This is a test of the BLOB functions.'#13
|
|
+' This is a test of the BLOB functions.'#13
|
|
+' This is a test of the BLOB functions.'#13
|
|
+' This is a test of the BLOB functions.'#13);
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: FillRecord();
|
|
|
|
Input: Cursor to Table, Record Buffer, and an integer which is used
|
|
to figure out which record data to insert.
|
|
|
|
Result: DbiResult
|
|
|
|
Desc: This function simply takes the cursor and fills the record
|
|
buffer with pre-assigned values (static values for this
|
|
example). It returns an error if we encounter one.
|
|
===================================================================== }
|
|
procedure FillRecord (hCur: hDBICur; pRecBuf: pBYTE; iOff: integer);
|
|
|
|
var
|
|
dDate: DATE; { Date to write to the table }
|
|
pGenInfo: pCHAR; { Buffer to contain the string which is
|
|
written to the BLOB field }
|
|
GenLen: UINT16; { Length of the string }
|
|
|
|
begin
|
|
{ Initialize the record buffer before filling it }
|
|
ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
|
|
' Error - InitRecord.');
|
|
|
|
{ Allocate a buffer that is capable of holding a large string. }
|
|
GetMem(pGenInfo, sizeof (CHAR) * 1200);
|
|
if not Assigned(pGenInfo) then
|
|
exit;
|
|
|
|
{ function will fill the pGeninfo pointer with a string }
|
|
FillString(pGenInfo);
|
|
|
|
{ Fill the fields of the buffer. The fields are filled directly,
|
|
but a variable could be used that would hold the string, date or
|
|
BLOB information. }
|
|
|
|
{ Fill the first field in the record buffer. (First Name)
|
|
If this is the first record to be inserted we set the field
|
|
to 'Franklin' if it is the second record than we set it to
|
|
'Franklin-1'. This is to keep the key field(s) unique. }
|
|
if (iOff = 1) then
|
|
ChkRslt(DbiPutField(hCur, 1, pRecBuf, pCHAR('Franklin')),
|
|
DBIERR_NONE, ' Error - PutField.')
|
|
else
|
|
ChkRslt(DbiPutField(hCur, 1, pRecBuf, pCHAR('Franklin-1')) ,
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
|
|
{ Middle Name }
|
|
ChkRslt(DbiPutField(hCur, 2, pRecBuf, pCHAR('D.')),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
|
|
{ Last Name }
|
|
ChkRslt(DbiPutField(hCur, 3, pRecBuf, pCHAR('Rosevelt')),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
|
|
{ DOB }
|
|
ChkRslt(DbiDateEncode(12, 22, 32, dDate),
|
|
DBIERR_NONE, ' Error - DateEncode.');
|
|
ChkRslt(DbiPutField(hCur, 4, pRecBuf, @(dDate)),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
|
|
{ Place of Birth }
|
|
ChkRslt(DbiPutField(hCur, 5, pRecBuf, pCHAR('Chicago')),
|
|
DBIERR_NONE, ' Error - PutField.');
|
|
|
|
{ Open the BLOB. To write or read from a BLOB you MUST open the
|
|
BLOB first. All that is needed is the cursor, the Record buffer,
|
|
the field number and the rights. If the BLOB is opened in
|
|
ReadWrite mode, the table MUST be opened in ReadWrite mode also. }
|
|
ChkRslt(DbiOpenBlob(hCur, pRecBuf, 6, dbiREADWRITE),
|
|
DBIERR_NONE, ' Error - OpenBlob.');
|
|
|
|
{ Put the whole BLOB into the field }
|
|
ChkRslt(DbiPutBlob(hCur, pRecBuf, 6, 0, strlen(pGenInfo)+1,
|
|
pBYTE(pGenInfo)) ,
|
|
DBIERR_NONE, ' Error - PutBlob.');
|
|
|
|
{ Now if iOff=2 then we need to change the BLOB information so that
|
|
we modify a portion of the BLOB. }
|
|
if (iOff = 2) then
|
|
begin
|
|
{ Get the length of the present BLOB information before changeing
|
|
it. }
|
|
GenLen := strlen(pGenInfo);
|
|
|
|
{ Clear the pGenINfo Buffer. }
|
|
FillChar(pGenInfo^, sizeof(pGenInfo), #0);
|
|
|
|
{ Fill the pGenInfo buffer with a new string. }
|
|
FillHalfString (pGenInfo);
|
|
|
|
{ Change half of the present BLOB value by
|
|
putting a new string in the second half of the BLOB.
|
|
Use the length of the originaly inserted BLOB divided
|
|
by two to find the half way point and add one to compensate
|
|
for the odd length. }
|
|
ChkRslt(DbiPutBlob(hCur, pRecBuf, 6, trunc(GenLen/2), strlen(pGenInfo),
|
|
pBYTE(pGenInfo)),
|
|
DBIERR_NONE, ' Error - PutBlob.');
|
|
end;
|
|
|
|
ChkRslt(DbiAppendRecord(hCur, pRecBuf), DBIERR_NONE,
|
|
' Error - AppendRecord.');
|
|
|
|
FreeMem(pGenInfo, sizeof(pGenInfo));
|
|
|
|
{ Free the BLOB. }
|
|
ChkRslt(DbiFreeBlob(hCur, pRecBuf, 6), DBIERR_NONE,
|
|
' Error - FreeBlob.');
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: DispBlob();
|
|
|
|
Input: hCur - Table Cursor.
|
|
pRecBuf - Record Buffer.
|
|
iOff - Which record to display.
|
|
|
|
Return: None.
|
|
|
|
Desc: This function displays the BLOB field that is pointed to by
|
|
the Cursor and which resides in the record buffer. The
|
|
function displays the whole BLOB and then half of the BLOB.
|
|
It uses DbiGetBlob with and without a range to accomplish
|
|
this functionality.
|
|
===================================================================== }
|
|
procedure DispBlob (hCur: hDBICur; pRecBuf: pBYTE; iOff: integer);
|
|
|
|
var
|
|
BlobSize: UINT32; { Size of the BLOB }
|
|
ActualSize: UINT32; { Actual size of the BLOB as read
|
|
from the table }
|
|
const
|
|
phBlob: pCHAR = nil; { Pointer to BLOB data }
|
|
phHalfBlob: pCHAR = nil; { Pointer to BLOB data }
|
|
|
|
begin
|
|
FillChar(pRecBuf^, sizeof(pRecBuf), #0); { Clear the Record buffer. }
|
|
|
|
{ Get the record from the table }
|
|
ChkRslt(DbiGetRecord(hCur, dbiWRITELOCK, pRecBuf, nil),
|
|
DBIERR_NONE, ' Error - GetRecord.');
|
|
|
|
{ Open the BLOB. The BLOB must be opened before reading or writeing
|
|
from a BLOB. If the BLOB is opened in ReadWrite mode, the table
|
|
also has to be open in ReadWrite mode.
|
|
This part locks the record in the previous function DbiGetRecord
|
|
with the WRITELOCK option. Note that a lock does not need to be
|
|
placed on the BLOB as the BLOB is not going to be modified. }
|
|
ChkRslt(DbiOpenBlob(hCur, pRecBuf, 6, dbiREADONLY), DBIERR_NONE,
|
|
' Error - OpenBlob.');
|
|
|
|
{ Now get the size of the BLOB }
|
|
ChkRslt(DbiGetBlobSize(hCur, pRecBuf, 6, BlobSize), DBIERR_NONE,
|
|
' Error - GetBlobSize.');
|
|
|
|
{ Allocate the memory for the BLOB buffer. }
|
|
GetMem( phBlob, (sizeof(CHAR) * UINT16(BlobSize)));
|
|
|
|
{ Allocate memory for the pHalfBlob buffer }
|
|
GetMem(phHalfBlob, ((sizeof(CHAR) * trunc(UINT16(BlobSize)/2))+2));
|
|
|
|
{ Initialize the buffers to 0. }
|
|
FillChar(phBlob^, UINT16(BlobSize), #0);
|
|
FillChar(phHalfBlob^, trunc(UINT16(BlobSize)/2)+2, #0);
|
|
|
|
{ Get the BLOB from the table. }
|
|
ChkRslt(DbiGetBlob(hCur, pRecBuf, 6, 0, BlobSize, phBlob,
|
|
ActualSize),
|
|
DBIERR_NONE, ' Error - GetBlob.');
|
|
|
|
Screen('');
|
|
Screen(' This is the BLOB information in Record# '+IntToStr(iOff));
|
|
Screen('');
|
|
Screen(' This is the WHOLE BLOB Field');
|
|
Screen('');
|
|
WriteLn(phBlob);
|
|
|
|
{ Now we are going to get Half the BLOB and display that. To get
|
|
half the BLOB we start at half the total size BlobSize/2 and
|
|
retrieve BlobSize/2 bytes. }
|
|
ChkRslt(DbiGetBlob(hCur, pRecBuf, 6, trunc((BlobSize)/2),
|
|
trunc((BlobSize)/2), phHalfBlob, ActualSize),
|
|
DBIERR_NONE, ' Error - GetBlob.');
|
|
|
|
Screen(' This is HALF of the BLOB Field');
|
|
Screen('');
|
|
Screen(StrPas(phHalfBlob)) ;
|
|
|
|
{ Free the BLOB from memory. }
|
|
ChkRslt(DbiFreeBlob(hCur, pRecBuf, 6), DBIERR_NONE,
|
|
' Error - FreeBlob.');
|
|
|
|
{ Free the BLOB and half BLOB buffer form the program's memory. }
|
|
FreeMem(phBlob, (sizeof(BYTE) * UINT16(BlobSize)));
|
|
FreeMem(phHalfBlob, ((sizeof(BYTE) * trunc(UINT16(BlobSize)/2))+2));
|
|
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: SimpleBlobIO();
|
|
Input: None.
|
|
|
|
Return: None.
|
|
|
|
Description:
|
|
This example shows how to read and write BLOBs. This example
|
|
will cover how to access entire BLOB information and sections
|
|
of a BLOB.
|
|
===================================================================== }
|
|
|
|
var
|
|
rslt: DBIResult; { Value returned from IDAPI functions }
|
|
hDb: hDBIDb; { Handle to the database }
|
|
hCur: hDBICur; { Handle to the table }
|
|
TblProps: CURProps; { Table properties }
|
|
crTblDes: CRTblDesc; { Create Table descriptor }
|
|
rcdSize: UINT16; { Size of the record }
|
|
uNumFields, uNumIndexes: INT16;
|
|
const
|
|
pRecBuf : pBYTE = nil; { Pointer to the record buffer }
|
|
bOverWrite: BOOL = TRUE; { Overwrite, yes/no flag }
|
|
|
|
begin
|
|
Screen('*** Simple BLOB I/O Example ***');
|
|
|
|
Screen(' Initializing IDAPI...');
|
|
if (InitAndConnect(hDb) <> DBIERR_NONE) then { Terminate example if }
|
|
begin { Initialization fails }
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
|
|
{ Number of fields in the table }
|
|
uNumFields := trunc(sizeof(fldDes) / sizeof (fldDes[0]));
|
|
|
|
{ Number of indexes in the table }
|
|
uNumIndexes := trunc(sizeof(idxDes) / sizeof(idxDes));
|
|
|
|
Screen(' Setting the Database directory...');
|
|
ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
|
|
' Error - SetDirectory.');
|
|
|
|
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 }
|
|
crTblDes.iIdxCount := uNumIndexes ; { Number of indexes }
|
|
crTblDes.pidxDesc := @idxDes ; { Index descriptor }
|
|
|
|
Screen(' Creating table and indexes...');
|
|
ChkRslt(DbiCreateTable(hDb, bOverWrite, crTblDes),
|
|
DBIERR_NONE, ' Error - CreateTable.');
|
|
|
|
{ Reset the directory where the newly created database is }
|
|
ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
|
|
' Error - SetDirectory.');
|
|
|
|
rslt := ChkRslt(DbiOpenTable(hDb, pCHAR(szTblName), pCHAR(szTblType),
|
|
nil, nil, 0, dbiREADWRITE,
|
|
dbiOPENSHARED, xltFIELD, FALSE,
|
|
nil, hCur),
|
|
DBIERR_NONE, ' Error - OpenTable.');
|
|
if (rslt <> DBIERR_NONE) then { Check if successfull }
|
|
begin
|
|
CloseDbAndexit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
{ Get the proporties in order to determine the size of the record }
|
|
ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
|
|
' Error - GetCursorProps.');
|
|
rcdSize := TblProps.iRecBufSize; { size of record }
|
|
|
|
{ Allocate memory for the record buffer }
|
|
GetMem(pRecBuf, sizeof(BYTE) * rcdSize);
|
|
|
|
{ Fill the database with a preset string set in the FillRecord
|
|
function. }
|
|
FillRecord(hCur, pRecBuf, 1);
|
|
|
|
{ Display the BLOB }
|
|
DispBlob(hCur, pRecBuf, 1);
|
|
|
|
{ Create another record and fill it with the same
|
|
data. However, change the BLOB info with DbiPutBlob. }
|
|
FillRecord(hCur, pRecBuf, 2);
|
|
|
|
{ Display the new BLOB }
|
|
DispBlob(hCur, pRecBuf, 2);
|
|
|
|
{ free the buffer }
|
|
FreeMem(pRecBuf, sizeof(BYTE) * rcdSize);
|
|
|
|
Screen('');
|
|
Screen(' Close the '+szTblName+' table...');
|
|
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
|
|
Screen(' Delete the '+szTblName+' table...');
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szTblName), pCHAR(szTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
|
|
Screen('');
|
|
Screen(' Close the Database and exit IDAPI...');
|
|
CloseDbAndexit(hDb);
|
|
|
|
Screen('*** End of Example ***');
|
|
|
|
end.
|