vwemirror/TeslaRel410
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ccc6ee6914e2d45a33e9739ffc47c4c5d18003b3
TeslaRel410/BORLAND/BDE/EXAMPLES/PASCAL/IDXEXPR.PAS
T
CydandClaude Fable 5 63312e07f9 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>
2026-07-19 07:33:26 -05:00

368 lines
14 KiB
ObjectPascal
Raw Blame History

{ idxexpr.pas }
program IdxExpr;
{$N+}
{$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; { Set the length of the name fields }
{ Name of table to be created. }
szTblName = 'orders';
{ Name of the master table. }
szMasterTblName = 'cust';
{ Table type to use. }
szTblType = szDBASE;
{ Key expression used to link the detail table. }
szMstrExp = 'TRIM(CITY) + ", " + STATE_PROV';
{ Field Descriptor used in creating a table }
fldDes: array[0..2] of FLDDesc = (
( { Field 1 - Customer Number }
iFldNum: 1; { Field Number }
szName: 'CITY_STATE'; { Field Name }
iFldType: fldZSTRING; { Field Type }
iSubType: fldUNKNOWN; { Field Subtype }
iUnits1: 35; { 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 }
),
( { Field 2 - Name }
iFldNum: 2; szName: 'NAME';
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
iUnits1: NAMELEN; iUnits2: 0;
iOffset: 0; iLen: 0;
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
efldrRights: fldrREADWRITE
),
( { Field 3 - Phone }
iFldNum: 3; szName: 'Phone';
iFldType: fldZSTRING; iSubType: fldUNKNOWN;
iUnits1: NAMELEN; iUnits2: 0;
iOffset: 0; iLen: 0;
iNullOffset: 0; efldvVchk: fldvNOCHECKS;
efldrRights: fldrREADWRITE
)
); { Array of field descriptors }
{ Index Descriptor - describes the Indexe associated with the
detail table. }
idxDes: IDXDesc = (
{ Production Index - expression index }
szName: 'orders.mdx'; { Name }
iIndexId: 0; { Number }
szTagName: 'CITY_STATE'; { Tag name ( for dBASE ) }
szFormat: ''; { Optional format ( BTREE,
HASH, etc ) }
bPrimary: FALSE; { Primary? }
bUnique: FALSE; { Unique? }
bDescending: FALSE; { Descending? }
bMaintained: TRUE; { Maintained? }
bSubSet: FALSE; { SubSet? }
bExpIdx: FALSE; { Expression index? }
iCost: 0; { for QBE only }
iFldsInKey: 1; { Fields in key }
iKeyLen: 1; { Length in bbytes }
bOutofDate: FALSE; { Index out of date? }
iKeyExpType: 0; { Key type of expression }
aiKeyFld: (1,0,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)
);
{=====================================================================
Function:
AddRecord();
Input: pointer to the cursor handle, Customer Number (FLOAT),
Customer Name(pCHAR), and Customer phone number (pCHAR).
Return: Result of adding the record to the table
Desc: This function will add a record to the given table.
===================================================================== }
function AddRecord (hCur: hDBICur; pszCityState: pCHAR; pszName: pCHAR;
pszPhone: pCHAR): DBIResult;
var
rslt: DBIResult; { Value returned from IDAPI functions }
TblProps: CURProps; { Table Properties }
pRecBuf: pBYTE; { Record Buffer }
begin
{ Allocate a record buffer }
ChkRslt(DbiGetCursorProps(hCur, TblProps), DBIERR_NONE,
' Error - GetCursorProps.');
GetMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
if not Assigned(pRecBuf) then
begin
AddRecord := DBIERR_NOMEMORY;
exit;
end;
ChkRslt(DbiInitRecord(hCur, pRecBuf), DBIERR_NONE,
' Error - InitRecord.');
{ City_State }
ChkRslt(DbiPutField(hCur, 1, pRecBuf, (pszCityState)),
DBIERR_NONE, ' Error - PutField.');
{ Customer Name }
ChkRslt(DbiPutField(hCur, 2, pRecBuf, (pszName)),
DBIERR_NONE, ' Error - PutField.');
{ Customer Phone Number }
ChkRslt(DbiPutField(hCur, 3, pRecBuf, (pszPhone)),
DBIERR_NONE, ' Error - PutField.');
rslt := ChkRslt(DbiInsertRecord(hCur, dbiNOLOCK, pRecBuf),
DBIERR_NONE, ' Error - InsertRecord.');
FreeMem(pRecBuf, TblProps.iRecBufSize * sizeof(BYTE));
AddRecord := rslt;
end;
{=====================================================================
Function:
InitTable();
Input: pointer to the database handle.
Return: result of the table initialization.
Desc: This function will create a table and fill the table
with a number of records. The function uses
another function called AddRecord which adds records to
the table.
===================================================================== }
function
InitTable (phDb: hDBIDb): DBIResult;
var
rslt: DBIResult; { Value returned from IDAPI functions }
hCur: hDBICur; { Cursor handle for the table that is
created }
crTblDes: CRTblDesc; { Table Descriptor }
uNumFields, uNumIndexes: INT16;
const
bOverWrite: BOOL = TRUE; { Overwrite, yes/no flag }
begin
{ The number of fields in the table - note that fldDesc is defined
globally }
uNumFields := trunc( sizeof(fldDes) / sizeof (fldDes[0]) );
uNumIndexes := 1;
{ 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 }
crTblDes.iIdxCount := uNumIndexes ; { Number of indexes }
crTblDes.pidxDesc := @idxDes ; { Index descriptor }
Screen(' Creating table and indexes...');
rslt := ChkRslt(DbiCreateTable(phDb, bOverWrite, crTblDes),
DBIERR_NONE, ' Error - CreateTable.');
if (rslt <> DBIERR_NONE) then
begin
InitTable := rslt;
exit;
end;
ChkRslt(DbiOpenTable(phDb, pCHAR(szTblName), pCHAR(szTblType),
nil, nil, 0, dbiREADWRITE, dbiOPENSHARED,
xltFIELD, FALSE, nil, hCur),
DBIERR_NONE, ' Error - OpenTable.');
Screen(' Adding Records to the table...');
rslt := AddRecord(hCur, 'Kapaa Kauai, HI', 'Kapaa Dive Shoppe',
'(408)-321-1729');
rslt := AddRecord(hCur, 'Kapaa Kauai, HI', 'Kapaa Dive Shoppe',
'(408)-321-1729');
rslt := AddRecord(hCur, 'Freeport, ', 'Unisco', '(415)-567-1799');
rslt := AddRecord(hCur, 'Freeport, ', 'Divers', '(415)-365-6159');
ChkRslt(DbiCloseCursor(hCur), DBIERR_NONE,
' Error - CloseCursor.');
InitTable := rslt;
end;
{=====================================================================
Function:
IndexExpr();
Description:
This example shows how to create expression indexes and
link two tables together based upon the expression index
(which is similar to Set Relation to... in the dBASE language).
When the link is established, you will only be able to see a
subset of the records in the Detail table which correspond
to the current record of the Master table.
===================================================================== }
var
hDb: hDBIDb; { Database handle }
hCur: hDBICur; { Cursor handle to the detail table. }
hMCur: hDBICur; { Cursor handle to the master table. }
MyDesc: pIDXDesc; { Index Descriptor }
i: UINT16; { For looping. }
{const
szIndexFileName: array[0..DBIMAXNAMELEN] of CHAR = ('0');
szIndex: array[0..DBIMAXNAMELEN] of CHAR = ('FullInfo');
}
begin
Screen('*** dBASE Expression Index Example ***');
Screen(' Initializing IDAPI...');
if (InitAndConnect(hDb) <> DBIERR_NONE) then { Terminate example if }
begin { Initialization fails }
Screen('');
Screen('*** End of Example ***');
exit;
end;
GetMem(MyDesc, sizeof(IDXDesc));
if not Assigned(MyDesc) then
begin
Screen(' Out of memory - shutting down IDAPI...');
CloseDbAndExit(hDb);
Screen('');
Screen('*** End of Example ***');
exit;
end;
Screen(' Setting the default Database directory...');
ChkRslt(DbiSetDirectory(hDb, pCHAR(szTblDirectory)), DBIERR_NONE,
' Error - SetDirectory.');
if (InitTable(hDb) <> DBIERR_NONE) then
begin
Screen(' Clean up IDAPI...');
CloseDbAndExit(hDb);
Screen('');
Screen('*** End of Example ***');
exit;
end;
Screen(' Open the '+szTblName+' table as the detail table '+
' (must be opened in shared mode)...');
if (ChkRslt ( DbiOpenTable(hDb, pCHAR(szTblName), pCHAR(szTblType),
(idxDes.szName), (idxDes.szTagName),
0, dbiREADWRITE, dbiOPENSHARED,
xltFIELD, FALSE, nil, hCur),
DBIERR_NONE, 'OpenTable' ) <> DBIERR_NONE) then
begin
CloseDbAndExit(hDb);
Screen('');
Screen('*** End of Example ***');
exit;
end;
Screen(' Open the '+szMasterTblName+' table, which is used as'+
' the master table...');
if (ChkRslt ( DbiOpenTable(hDb, pCHAR(szMasterTblName), pCHAR(szTblType),
nil, nil, 0, dbiREADWRITE, dbiOPENSHARED,
xltFIELD, FALSE, nil, hMCur),
DBIERR_NONE, 'OpenTable' ) <> DBIERR_NONE) then
begin
CloseDbAndExit(hDb);
Screen('');
Screen('*** End of Example ***');
exit;
end;
ChkRslt(DbiSetToBegin(hMCur), DBIERR_NONE, ' Error - SetToBegin.');
{ Put the Cust table into link mode. }
ChkRslt(DbiBeginLinkMode(hMCur), DBIERR_NONE,
' Error - BeginLinkMode.');
{ Put the Orders table into link mode. }
ChkRslt(DbiBeginLinkMode(hCur), DBIERR_NONE,
' Error - BeginLinkMode.');
{ Now link the two cursors/tables together. }
Screen(' Link the two tables togther');
ChkRslt(DbiLinkDetailToExp(hMCur, hCur, 0, pCHAR(szMstrExp)),
DBIERR_NONE, ' Error - LinkDetailToExp.');
{ The detail table has matching data only for the first two records
of the master table. }
for i := 0 to 2 do
begin
{ Display master record.}
Screen('');
Screen(' This is the master record');
ChkRslt(DisplayTable(hMCur, 1), DBIERR_NONE,
' Error - DisplayTable.');
{ Display all the detail records.}
Screen('');
Screen(' This is the detail record(s)');
ChkRslt(DisplayTable(hCur, 0), DBIERR_NONE,
' Error - DisplayTable.');
end;
Screen('');
Screen(' There are no records in the detail table for the');
Screen(' third record in the master table. Therefore, it');
Screen(' should come up blank');
Screen('');
Screen(' End the link...');
ChkRslt(DbiUnlinkDetail(hCur),
DBIERR_NONE, ' Error - EndLinkMode.');
ChkRslt(DbiEndLinkMode(hMCur),
DBIERR_NONE, ' Error - EndLinkMode.');
ChkRslt(DbiEndLinkMode(hCur),
DBIERR_NONE, ' Error - EndLinkMode.');
Screen(' Close the '+szMasterTblName+' table...');
ChkRslt(DbiCloseCursor(hMCur), DBIERR_NONE,
' Error - CloseCursor.');
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.
Reference in New Issue View Git Blame Copy Permalink