Btrieve Interface for TP.
Submitted By:
WEBMASTER
Rating:
(Not rated) (
Rate It)
{$R-} {Range checking off}
{$B+} {Boolean complete evaluation on}
{$S+} {Stack checking on}
{$I+} {I/O checking on}
{$N-} {No numeric coprocessor}
{$M 65500,16384,655360} {Turbo 3 default stack and heap}
{ }
{ Module Name: TURXBTRV.PAS }
{ }
{ Description: This is the Btrieve interface for Turbo Pascal (MS-DOS). }
{ This routine sets up the parameter block expected by }
{ Btrieve, and issues interrupt 7B. It should be compiled }
{ with the $V- switch so that runtime checks will not be }
{ performed on the variable parameters. }
{ }
{ Synopsis: STAT := BTRV (OP, POS.START, DATA.START, DATALEN, }
{ KBUF.START, KEY); }
{ where }
{ OP is an integer, }
{ POS is a 128 byte array, }
{ DATA is an untyped parameter for the data buffer, }
{ DATALEN is the integer length of the data buffer, }
{ KBUF is the untyped parameter for the key buffer, }
{ and KEY is an integer. }
{ }
{ Returns: Btrieve status code (see Appendix B of the Btrieve Manual). }
{ }
{ Note: The Btrieve manual states that the 2nd, 3rd, and 5th }
{ parameters be declared as variant records, with an integer }
{ type as one of the variants (used only for Btrieve calls), }
{ as is shown in the example below. This is supported, but }
{ the restriction is no longer necessary. In other words, any }
{ variable can be sent in those spots as long as the variable }
{ uses the correct amount of memory so Btrieve does not }
{ overwrite other variables. }
{ }
{ var DATA = record case boolean of }
{ FALSE: ( START: integer ); }
{ TRUE: ( EMPLOYEE_ID: 0..99999; }
{ EMPLOYEE_NAME: packed array[1..50] of char; }
{ SALARY: real; }
{ DATA_OF_HIRE: DATE_TYPE ); }
{ end; }
{ }
{ There should NEVER be any string variables declared in the }
{ data or key records, because strings store an extra byte for }
{ the length, which affects the total size of the record. }
{ }
{ }
unit
Btrv5;
interface
uses
Dos, Crt;
const
Dublicates = 1;
Modifiable = 2;
Segmented = 16;
LString = 10;
ExtType = 256;
BOpen = 0;
BClose = 1;
BInsert = 2;
BUpdate = 3;
BDelete = 4;
BEqual = 5;
BNext = 6;
BPrev = 7;
BGreater = 8;
BGrEqual = 9;
BLess = 10;
BLsEqual = 11;
BFirst = 12;
BLast = 13;
BCreate = 14;
BStat = 15;
BBeginTr = 19;
BEndTr = 20;
BAbortTr = 21;
BGetPos = 22;
BGetDirect = 23;
type
KeySpec = record
KeyPos, KeyLen,
KeyFlags : integer;
NotUsed : array[1..4] of char;
KeyRsv : array[1..6] of byte
end;
FSpec = record
RecLen, PageSize ,
NdxCnt : integer;
NOfRec : longint;
Variable, Reserved,
PreAllc : integer;
KeyBuf : array[0..30] of KeySpec
end;
function BTRV (OP:integer; var POS,DATA; var DATALEN: integer;
var KBUF; KEY: integer): integer;
implementation
function BTRV;
const
VAR_ID = $6176; {id for variable length records - 'va'}
BTR_INT = $7B;
BTR2_INT = $2F;
BTR_OFFSET = $0033;
MULTI_FUNCTION = $AB;
{ ProcId is used for communicating with the Multi Tasking Version of }
{ Btrieve. It contains the process id returned from BMulti and should }
{ not be changed once it has been set. }
{ }
ProcId: integer = 0; { initialize to no process id }
MULTI: boolean = false; { set to true if BMulti is loaded }
VSet: boolean = false; { set to true if we have checked for BMulti }
type
ADDR32 = record {32 bit address}
OFFSET: integer;
SEGMENT: integer;
end;
BTR_PARMS = record
USER_BUF_ADDR: ADDR32; {data buffer address}
USER_BUF_LEN: integer; {data buffer length}
USER_CUR_ADDR: ADDR32; {currency block address}
USER_FCB_ADDR: ADDR32; {file control block address}
USER_FUNCTION: integer; {Btrieve operation}
USER_KEY_ADDR: ADDR32; {key buffer address}
USER_KEY_LENGTH: BYTE; {key buffer length}
USER_KEY_NUMBER: BYTE; {key number}
USER_STAT_ADDR: ADDR32; {return status address}
XFACE_ID: integer; {language interface id}
end;
var
STAT: integer; {Btrieve status code}
XDATA: BTR_PARMS; {Btrieve parameter block}
REGS: Dos.Registers; {register structure used on interrrupt call}
DONE: boolean;
begin
if Op = 19 then
begin
GotoXY(2, 25);
Write('Bekleyiniz...')
end;
REGS.AX := $3500 + BTR_INT;
INTR ($21, REGS);
if (REGS.BX <> BTR_OFFSET) then {make sure Btrieve is installed}
STAT := 20
else
begin
if (not VSet) then {if we haven't checked for Multi-User version}
begin
REGS.AX := $3000;
INTR ($21, REGS);
if ((REGS.AX AND $00FF) >= 3) then
begin
VSet := true;
REGS.AX := MULTI_FUNCTION * 256;
INTR (BTR2_INT, REGS);
MULTI := ((REGS.AX AND $00FF) = $004D);
end
else
MULTI := false;
end;
{make normal btrieve call}
with XDATA do
begin
USER_BUF_ADDR.SEGMENT := SEG (DATA);
USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
USER_BUF_LEN := DATALEN;
USER_FCB_ADDR.SEGMENT := SEG (POS);
USER_FCB_ADDR.OFFSET := OFS (POS); {set FCB address}
USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
USER_FUNCTION := OP; {set Btrieve operation code}
USER_KEY_ADDR.SEGMENT := SEG (KBUF);
USER_KEY_ADDR.OFFSET := OFS (KBUF); {set key buffer address}
USER_KEY_LENGTH := 255; {assume its large enough}
USER_KEY_NUMBER := KEY; {set key number}
USER_STAT_ADDR.SEGMENT := SEG (STAT);
USER_STAT_ADDR.OFFSET := OFS (STAT); {set status address}
XFACE_ID := VAR_ID; {set lamguage id}
end;
REGS.DX := OFS (XDATA);
REGS.DS := SEG (XDATA);
if (NOT MULTI) then {MultiUser version not installed}
INTR (BTR_INT, REGS)
else
begin
DONE := FALSE;
repeat
REGS.BX := ProcId;
REGS.AX := 1;
if (REGS.BX <> 0) then
REGS.AX := 2;
REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
INTR (BTR2_INT, REGS);
if ((REGS.AX AND $00FF) = 0) then
DONE := TRUE
else begin
REGS.AX := $0200;
INTR ($7F, REGS);
DONE := FALSE;
end;
until (DONE);
if (ProcId = 0) then
ProcId := REGS.BX;
end;
DATALEN := XDATA.USER_BUF_LEN;
end;
if Op in [20, 21] then
begin
GotoXY(2, 25);
Write(' ':13)
end;
BTRV := STAT;
end;
end.
