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>
277 lines
10 KiB
ObjectPascal
277 lines
10 KiB
ObjectPascal
{ prdxsort.pas }
|
|
program PrdxSort;
|
|
|
|
{$IfDef VER80}
|
|
uses SnipTool, SnipData, SysUtils, WinTypes, WinProcs,
|
|
DbiProcs, DbiTypes, DbiErrs;
|
|
{$Else}
|
|
uses WinTypes, WinCrt, Strings, DbiProcs, DbiTypes, DbiErrs,
|
|
SnipTool, SnipData;
|
|
{$EndIf}
|
|
|
|
const
|
|
NAMELEN = 30; { Default length of the mapped fields }
|
|
|
|
szTblName = 'vendors';
|
|
szSortedTblName = 'SortVend';
|
|
szTblType = 'PARADOX';
|
|
|
|
{ Field Descriptor used in mapping the fields of the table
|
|
Used in order to display the fields in the order that they
|
|
are sorted: 'State/Prov' and 'Street'. The 'Vendor Name' is
|
|
included as additional information.
|
|
See the fieldmap.c file for a description of field mapping }
|
|
|
|
fldDes: array[0..2] of FLDDesc = (
|
|
(
|
|
iFldNum: 1; { Field Number }
|
|
szName: 'State/Prov'; { 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: 'Street';
|
|
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
|
|
iUnits1: NAMELEN; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
),
|
|
(
|
|
iFldNum: 3; szName: 'Vendor Name';
|
|
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
|
|
iUnits1: NAMELEN; iUnits2: 0;
|
|
iOffset: 0; iLen: 0;
|
|
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
|
|
efldrRights: fldrREADWRITE
|
|
)
|
|
); { FldDescs1 }
|
|
|
|
|
|
{=====================================================================
|
|
Code: FindFirstChar();
|
|
|
|
Input: const char * - the string to search
|
|
|
|
Return: Pointer to the location in the string after the House
|
|
number
|
|
|
|
Description:
|
|
This function is used to skip the house number part
|
|
of the street address when sorting the table. This
|
|
allows the 'Street' field to be sorted according to
|
|
the street name.
|
|
===================================================================== }
|
|
function FindFirstChar (const szString: pchar): pCHAR {DBIFN};
|
|
|
|
var
|
|
uWhere: UINT16; { Counter to keep track of the current character
|
|
within the string }
|
|
|
|
begin
|
|
uWhere := 0;
|
|
{ Search for the first blank as part of the string -
|
|
This should be the start of the street name. }
|
|
while ((szString[uWhere] <> '') and
|
|
(szString[uWhere] <> ' ')) do
|
|
begin
|
|
uWhere := uWhere + 1;
|
|
end;
|
|
{ return the character after the space }
|
|
FindFirstChar := pCHAR((szString[uWhere+1])) ;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: StreetCompare();
|
|
|
|
Input:
|
|
pVOID pLdObj - Language driver, not used
|
|
pVOID pValue1 - First value to compare
|
|
pVOID pValue2 - Second value to compare
|
|
INT16 iLen - Length, not used
|
|
|
|
Return: -1 if (pValue1 < pValue2)
|
|
0 if (pValue1 = pValue2)
|
|
1 if (pValue1 > pValue2)
|
|
|
|
Description:
|
|
This function is used in comparing the 'Street'
|
|
field of the vendor table. This function will
|
|
sort according to the street name, not the address.
|
|
===================================================================== }
|
|
function StreetCompare (pLdObj: pointer; pValue1: pointer; pValue2: pointer;
|
|
iLen: INT16): INT16;
|
|
|
|
var
|
|
rslt: INT16; { Value returned from IDAPI functions }
|
|
szOne: pCHAR; { First value to compare }
|
|
szTwo: pCHAR; { Second value to compare }
|
|
|
|
begin
|
|
{ Dummy assignments to avoid warnings }
|
|
iLen := iLen;
|
|
pLdObj := pLdObj;
|
|
|
|
{ Skip leading numeric values - used to skip the House Number
|
|
portion of the street address. }
|
|
szOne := FindFirstChar( pValue1);
|
|
szTwo := FindFirstChar( pValue2);
|
|
|
|
{ Compare the values in the 'Street' field, starting the
|
|
strings at the first non-numeric character - sort on
|
|
Street name, not the house number on a given street. }
|
|
rslt := StrComp(szOne, szTwo);
|
|
|
|
{ If on the same street (pValue1 = pValue2),
|
|
compare House Number on the street }
|
|
if (rslt = 0) then
|
|
rslt := StrComp(pCHAR(pValue1), pCHAR(pValue2));
|
|
if (0 < rslt) then
|
|
rslt := 1;
|
|
if (rslt < 0) then
|
|
rslt := -1;
|
|
StreetCompare := rslt;
|
|
end;
|
|
|
|
{=====================================================================
|
|
Code: ParadoxSort();
|
|
|
|
Input: None.
|
|
|
|
Return: None.
|
|
|
|
Description:
|
|
This example shows how to sort on a field in a PARADOX
|
|
table. The example will use the DbiSortTable() function.
|
|
===================================================================== }
|
|
|
|
var
|
|
hDb: hDBIDb; { Handle to the Database }
|
|
hCur: hDBICur; { Handle to the table }
|
|
hSortCur: hDBICur; { Handle to the sorted table }
|
|
NOSRTFLDS: UINT16;
|
|
uNumFields: UINT16;
|
|
const
|
|
uSortFields: array[0..1] of UINT16 = ( 5, 3 );
|
|
bCaseIns: array[0..1] of BOOL = ( FALSE, FALSE);
|
|
SortOrd: array[0..1] of SORTOrder = ( sortASCEND, sortASCEND );
|
|
pfSortFn: array[0..1] of pfSORTCompFn = ( nil, nil );
|
|
uNumToSort: UINT32 = 10;
|
|
|
|
begin
|
|
Screen('*** Sorting Example ***');
|
|
|
|
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 default Database directory...');
|
|
ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
|
|
' Error - SetDirectory.');
|
|
|
|
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
|
|
CloseDbAndExit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
ChkRslt(DbiSetToBegin(hCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Display the unsorted '+szTblName+' table...');
|
|
ChkRslt(DisplayTable(hCur, uNumToSort), DBIERR_NONE,
|
|
' Error - DisplayTable.');
|
|
|
|
Screen(' ');
|
|
Screen(' Sort the '+szTblName+' table, using first the "State/Prov"'+
|
|
' field,');
|
|
Screen(' and then the "Street" field. The sorted'+
|
|
' records are saved in the '+szSortedTblName+' table');
|
|
|
|
{ Determine the number of fields in the sorted table }
|
|
NOSRTFLDS := trunc(sizeof(uSortFields) / sizeof(uSortFields[0]));
|
|
|
|
if (ChkRslt(DbiSortTable(hDb, pCHAR(szTblName), pCHAR(szTblType), nil,
|
|
pCHAR(szSortedTblName), nil, nil,
|
|
NOSRTFLDS, @uSortFields, @bCaseIns, @SortOrd,
|
|
@pfSortFn, FALSE, nil, uNumToSort),
|
|
DBIERR_NONE, ' Error - SortTable.')<> DBIERR_NONE) then
|
|
begin
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szSortedTblName), pCHAR(szTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
CloseDbAndExit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
Screen(' Open the sorted table ('+szSortedTblName+')....');
|
|
if (ChkRslt(DbiOpenTable(hDb, pCHAR(szSortedTblName),
|
|
pCHAR(szTblType), nil, nil, 0,
|
|
dbiREADWRITE, dbiOPENSHARED, xltFIELD,
|
|
FALSE, nil, hSortCur),
|
|
DBIERR_NONE, ' Error - OpenTable.') <> DBIERR_NONE) then
|
|
begin
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szSortedTblName), pCHAR(szTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
Screen(' Clean up IDAPI...');
|
|
CloseDbAndExit(hDb);
|
|
Screen('');
|
|
Screen('*** End of Example ***');
|
|
exit;
|
|
end;
|
|
|
|
Screen(' Change which fields of the table are displayed:');
|
|
Screen(' State/Prov, Street, and Vendor Name.');
|
|
|
|
{ Determine the number of fields that are part of the descriptor }
|
|
uNumFields := trunc(sizeof(FldDes) / sizeof (FldDes[0]));
|
|
|
|
{ Set the field mapping. }
|
|
ChkRslt(DbiSetFieldMap(hSortCur, uNumFields, @FldDes), DBIERR_NONE,
|
|
' Error - SetFieldMap.');
|
|
|
|
ChkRslt(DbiSetToBegin(hSortCur), DBIERR_NONE,
|
|
' Error - SetToBegin.');
|
|
|
|
Screen(' Display the sorted table ('+szSortedTblName+')...');
|
|
ChkRslt(DisplayTable(hSortCur, uNumToSort), DBIERR_NONE,
|
|
' Error - DisplayTable.');
|
|
|
|
Screen(' ');
|
|
Screen(' Close the origional table ('+szTblName+')...');
|
|
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
|
|
Screen(' Close the sorted table ('+szSortedTblName+')...');
|
|
ChkRslt(DbiCloseCursor(hSortCur), DBIERR_NONE,
|
|
' Error - CloseCursor.');
|
|
|
|
Screen(' Delete the sorted table ('+szSortedTblName+')...');
|
|
ChkRslt(DbiDeleteTable(hDb, pCHAR(szSortedTblName), pCHAR(szTblType)),
|
|
DBIERR_NONE, ' Error - DeleteTable.');
|
|
|
|
Screen(' Close the Database and exit IDAPI...');
|
|
CloseDbAndExit(hDb);
|
|
|
|
Screen('*** End of Example ***');
|
|
|
|
end.
|