Datatid 1999 #6/Datatid_1999-06.iso/internet/Tango352Promo/P.SQL/PTKPKG.1/BTRSAMPD.PAS

Pascal/Delphi Source File | 1997-11-07 | 15.9 KB | 519 lines

{*************************************************************************
**
**  Copyright 1982-1997 Pervasive Software Inc. All Rights Reserved
**
*************************************************************************}
{*************************************************************************
  BTRSAMPD.PAS
    This program demonstrates the Btrieve Interface using Borland Pascal
    for MS Windows.

    This program does the following operations on the sample file:
    - gets the Microkernel Database Engine version using BTRVID
    - opens sample.btr
    - gets a record on a known value of Key 0
    - displays the retrieved record
    - performs a stat operation
    - creates an empty 'clone' of sample.btr and opens it
    - performs a 'Get Next Extended' operation to extract a subset
      of the records in sample.btr
    - inserts those records into the cloned file
    - closes both files

    IMPORTANT:
    You must specify the complete path to the directory that contains
    the sample Btrieve data file, 'sample.btr'.  See IMPORTANT, below.
*************************************************************************}
program btrsampd;

uses
  Strings,    { Pascal System functions }
  btrapid,    { btrieve interface unit }
  btrconst;   { Btrieve Constants Unit }

const
  {********************************************************************
      IMPORTANT: You should modify the following to specify the
                complete path to 'sample.btr' for your environment.
  ********************************************************************}
  FILE1_NAME          = 'c:\pvsw\samples\sample.btr' + #0;
  FILE2_NAME          = 'c:\pvsw\samples\sample2.btr' + #0;

  { program constants }
  MY_THREAD_ID        = 50;
  EXIT_WITH_ERROR     = 1;
  VERSION_OFFSET      = 0;
  REVISION_OFFSET     = 2;
  PLATFORM_ID_OFFSET  = 4;

{***************************************************************************
  Record type definitions for Version operation
****************************************************************************}
type
  CLIENT_ID = packed record
    networkandnode : array[0..11] of char;
    applicationID  : array[0..2] of char;
    threadID       : integer;
  end;

  VERSION_STRUCT = packed record
    version   : integer;
    revision  : integer;
    MKDEId    : char;
  end;

{***************************************************************************
  Definition of record from 'sample.btr'
****************************************************************************}

  {* Use 'zero-based' arrays of char for writeln() compatibility *}
  PERSON_STRUCT = packed record
    ID          : longint;
    FirstName   : array[0..15] of char;
    LastName    : array[0..25] of char;
    Street      : array[0..30] of char;
    City        : array[0..30] of char;
    State       : array[0..2]  of char;
    Zip         : array[0..10] of char;
    Country     : array[0..20] of char;
    Phone       : array[0..13] of char;
  end;

{***************************************************************************
  Record type definitions for Stat and Create operations
****************************************************************************}
  FILE_SPECS = packed record
    recLength   : integer;
    pageSize    : integer;
    indexCount  : integer;
    reserved    : array[0..3] of char;
    flags       : integer;
    dupPointers : byte;
    notUsed     : byte;
    allocations : integer;
  end;

  KEY_SPECS = packed record
    position : integer;
    length : integer;
    flags : integer;
    reserved : array [0..3] of char;
    keyType : char;
    nullChar : char;
    notUsed : array[0..1] of char;
    manualKeyNumber : byte;
    acsNumber : byte;
  end;

  FILE_CREATE_BUF = packed record
    fileSpecs : FILE_SPECS;
    keySpecs  : array[0..4] of KEY_SPECS;
  end;

{***************************************************************************
  Record type definitions for Get Next Extended operation
****************************************************************************}

  GNE_HEADER = packed record
    descriptionLen  : integer;
    currencyConst   : array[0..1] of char;
    rejectCount     : integer;
    numberTerms     : integer;
  end;

  TERM_HEADER = packed record
    fieldType       : byte;
    fieldLen        : integer;
    fieldOffset     : integer;
    comparisonCode  : byte;
    connector       : byte;
    value           : array[0..2] of char;
  end;

  RETRIEVAL_HEADER = packed record
    maxRecsToRetrieve   : integer;
    noFieldsToRetrieve  : integer;
  end;

  FIELD_RETRIEVAL_HEADER = packed record
    fieldLen    : integer;
    fieldOffset : integer;
  end;

  PRE_GNE_BUFFER = packed record
    gneHeader : GNE_HEADER;
    term1     : TERM_HEADER;
    term2     : TERM_HEADER;
    retrieval : RETRIEVAL_HEADER;
    recordRet : FIELD_RETRIEVAL_HEADER;
  end;

  RETURNED_REC = packed record
    recLen        : integer;
    recPos        : longint;
    personRecord  : PERSON_STRUCT;
  end;

  POST_GNE_BUFFER = packed record
    numReturned : integer;
    recs        : packed array[0..19] of RETURNED_REC;
  end;

  GNE_BUFFER_PTR = ^GNE_BUFFER;
  GNE_BUFFER = packed record
  case byte of
    1 : (preBuf  : PRE_GNE_BUFFER);
    2 : (postBuf : POST_GNE_BUFFER);
  end;

{***********************************************************************
  Variables
************************************************************************}
var
  { Btrieve function parameters }
  posBlock1     : string[128];
  posBlock2     : string[128];
  dataBuffer    : array[0..255] of char;
  dataLen       : word;
  keyBuf1       : string[255];
  keyBuf2       : string[255];
  keyNum        : integer;

  btrieveLoaded : boolean;
  personID      : longint;
  file1Open     : boolean;
  file2Open     : boolean;
  status        : integer;
  getStatus     : integer;
  i             : integer;
  posCtr        : integer;

  client        : CLIENT_ID;
  versionBuffer : array[1..3] of VERSION_STRUCT;
  fileCreateBuf : FILE_CREATE_BUF;
  gneBuffer     : GNE_BUFFER_PTR;
  personRecord  : PERSON_STRUCT;

{***********************************************************************
  Program starts here
************************************************************************}
begin { btrsamp }
  { initialize variables }
  btrieveLoaded := FALSE;
  file1Open := FALSE;
  file2Open := FALSE;
  keyNum := 0;
  status := B_NO_ERROR;
  getStatus := B_NO_ERROR;

  writeln;
  writeln('************ Btrieve Pascal Interface for Windows Demo ************');
  writeln;

  { set up the Client ID }
  fillchar(client.networkAndNode, sizeof(client.networkAndNode), #0);

{$ifdef ver70} {Note: Delphi 1.0 is ver80}
  client.applicationID := 'MT' + #0;     { must be greater than "AA" }
{$else}
  strpcopy(client.applicationID, 'MT');  { must be greater than "AA" }
  strcat(client.applicationID, #0);
{$endif}

  client.threadID := MY_THREAD_ID;

  fillchar(versionBuffer, sizeof(versionBuffer), #0);
  dataLen := sizeof(versionBuffer);

  status := BTRVID(
              B_VERSION,
              posBlock1,
              versionBuffer,
              dataLen,
              keyBuf1[1],
              keyNum,
              client);

  if status = B_NO_ERROR then begin
    writeln('Btrieve Versions returned are:');
    for i := 1 to 3 do begin
      with versionBuffer[i] do begin
        if (version > 0) then begin
          writeln(version, '.', revision, ' ', MKDEId);
        end
      end
    end;
    btrieveLoaded := TRUE;
  end else begin
    writeln('Btrieve B_VERSION status = ', status);
    if status <> B_RECORD_MANAGER_INACTIVE then begin
      btrieveLoaded := TRUE;
    end
  end;

  {* open sample.btr *}
  if status = B_NO_ERROR then begin
    fillchar(dataBuffer, sizeof(dataBuffer), #0);
    fillchar(keyBuf1, sizeof(keyBuf1), #0);
    keyNum := 0;
    dataLen := 0;

    keyBuf1 := FILE1_NAME;
    keyBuf2 := FILE2_NAME;

    status := BTRVID(
                  B_OPEN,
                  posBlock1,
                  dataBuffer,
                  dataLen,
                  keyBuf1[1],
                  keyNum,
                  client);

    writeln('Btrieve B_OPEN status = ', status);
    if status = B_NO_ERROR then begin
      file1Open := TRUE;
    end
  end;

  {* get the record using key 0 = a known value using B_GET_EQUAL *}
  if status = B_NO_ERROR then begin
    fillchar(personRecord, sizeof(personRecord), #0);
    dataLen := sizeof(personRecord);
    personID := 263512477;  {* this is really a social security number *}

    status := BTRVID(
                B_GET_EQUAL,
                posBlock1,
                personRecord,
                dataLen,
                personID,
                keyNum,
                client);

    writeln('Btrieve B_GET_EQUAL status = ', status);
    if status = B_NO_ERROR then with personRecord do begin
      writeln;
      writeln('Selected fields from the retrieved record are:');
      writeln('ID:      ', ID);
      writeln('Name:    ', FirstName, ' ',
                            LastName);
      writeln('Street:  ', Street);
      writeln('City:    ', City);
      writeln('State:   ', State);
      writeln('Zip:     ', Zip);
      writeln('Country: ', Country);
      writeln('Phone:   ', Phone);
      writeln;
    end;
  end;

  { perform a stat operation to populate the create buffer }
  fillchar(fileCreateBuf, sizeof(fileCreateBuf), #0);
  dataLen := sizeof(fileCreateBuf);
  keyNum  := -1;
  status := BTRVID(B_STAT,
                posBlock1,
                fileCreateBuf,
                dataLen,
                keyBuf1[1],
                keyNum,
                client);

  if (status = B_NO_ERROR) then begin
    { create and open sample2.btr }
    keyNum := 0;
    dataLen := sizeof(fileCreateBuf);
    status := BTRVID(B_CREATE,
                  posBlock2,
                  fileCreateBuf,
                  dataLen,
                  keyBuf2[1],
                  keyNum,
                  client);

    writeln('Btrieve B_CREATE status = ', status);
  end;

  if (status = B_NO_ERROR) then begin
    keyNum  := 0;
    dataLen := 0;

    status := BTRVID(
                B_OPEN,
                posBlock2,
                dataBuffer,
                dataLen,
                keyBuf2[1],
                keyNum,
                client);
    writeln('Btrieve B_OPEN status (sample2.btr) = ', status);
    if (status = B_NO_ERROR) then begin
      file2Open := TRUE;
    end;
  end;

  { now extract data from the original file, insert into new one }
  if (status = B_NO_ERROR) then begin
    { getFirst to establish currency }
    keyNum := 2; { STATE-CITY index }
    fillchar(personRecord, sizeof(personRecord), #0);
    fillchar(keyBuf1, sizeof(keyBuf1), #0);
    dataLen := sizeof(personRecord);

    getStatus := BTRVID(
                   B_GET_FIRST,
                   posBlock1,
                   personRecord,
                   dataLen,
                   keyBuf1[1],
                   keyNum,
                   client);

    writeln('Btrieve B_GET_FIRST status (sample.btr) = ', getStatus);
    writeln;
  end;

  if maxavail < SizeOf(GNE_BUFFER) then begin
    writeln('Insufficient memory to allocate buffer');
    halt(EXIT_WITH_ERROR);
  end else begin
    { Allocate memory on heap }
    gneBuffer := new(GNE_BUFFER_PTR);
  end;
  fillchar(gneBuffer^, sizeof(GNE_BUFFER), #0);
  strPCopy(gneBuffer^.preBuf.gneHeader.currencyConst, 'UC');
  while (getStatus = B_NO_ERROR) do begin
    gneBuffer^.preBuf.gneHeader.rejectCount := 0;
    gneBuffer^.preBuf.gneHeader.numberTerms := 2;
    posCtr := sizeof(GNE_HEADER);

    { fill in the first condition }
    gneBuffer^.preBuf.term1.fieldType := 11;
    gneBuffer^.preBuf.term1.fieldLen := 3;
    gneBuffer^.preBuf.term1.fieldOffset := 108;
    gneBuffer^.preBuf.term1.comparisonCode := 1;
    gneBuffer^.preBuf.term1.connector := 2;

    strPCopy(gneBuffer^.preBuf.term1.value, 'TX');
    inc(posCtr, (sizeof(TERM_HEADER)));

    { fill in the second condition }
    gneBuffer^.preBuf.term2.fieldType := 11;
    gneBuffer^.preBuf.term2.fieldLen := 3;
    gneBuffer^.preBuf.term2.fieldOffset := 108;
    gneBuffer^.preBuf.term2.comparisonCode := 1;
    gneBuffer^.preBuf.term2.connector := 0;
    strPCopy(gneBuffer^.preBuf.term2.value, 'CA');
    inc(posCtr, sizeof(TERM_HEADER));

    { fill in the projection header to retrieve whole record }
    gneBuffer^.preBuf.retrieval.maxRecsToRetrieve := 20;
    gneBuffer^.preBuf.retrieval.noFieldsToRetrieve := 1;
    inc(posCtr, sizeof(RETRIEVAL_HEADER));
    gneBuffer^.preBuf.recordRet.fieldLen := sizeof(PERSON_STRUCT);
    gneBuffer^.preBuf.recordRet.fieldOffset := 0;
    inc(posCtr, sizeof(FIELD_RETRIEVAL_HEADER));
    gneBuffer^.preBuf.gneHeader.descriptionLen := posCtr;

    dataLen := sizeof(GNE_BUFFER);
    getStatus := BTRVID(
                   B_GET_NEXT_EXTENDED,
                   posBlock1,
                   gneBuffer^,
                   dataLen,
                   keyBuf1,
                   keyNum,
                   client);

     writeln('Btrieve B_GET_NEXT_EXTENDED status = ', getStatus);

    { Get Next Extended can reach end of file and still return some records }
    if ((getStatus = B_NO_ERROR) or (getStatus = B_END_OF_FILE)) then begin
      writeln('GetNextExtended returned ', gneBuffer^.postBuf.numReturned, ' records.');
      for i := 0 to gneBuffer^.postBuf.numReturned - 1 do begin
{$ifdef ver70}
        dataLen := sizeof(PERSON_STRUCT);
        personRecord := gneBuffer^.postBuf.recs[i].personRecord;
        status := BTRVID(
                    B_INSERT,
                    posBlock2,
                    personRecord,
                    dataLen,
                    keyBuf2,
                    -1,   { no currency change }
                    client);
        if (status <> B_NO_ERROR) then begin
          writeln('Btrieve B_INSERT status = ', status);
          break;
        end;

{$else} {Turbo Pascal for Windows 1.5 does not support 'break'}
        if (status = B_NO_ERROR) then begin
          dataLen := sizeof(PERSON_STRUCT);
          personRecord := gneBuffer^.postBuf.recs[i].personRecord;
          status := BTRVID(
                      B_INSERT,
                      posBlock2,
                      personRecord,
                      dataLen,
                      keyBuf2,
                      -1,   { no currency change }
                      client);
        end;
        if (status <> B_NO_ERROR) then begin
          writeln('Btrieve B_INSERT status = ', status);
        end;
{$endif}

      writeln('Inserted ', gneBuffer^.postBuf.numReturned, ' records in new file, status = ', status);
      writeln;
    end;
    fillchar(gneBuffer^, sizeof(GNE_BUFFER), #0);
    gneBuffer^.preBuf.gneHeader.currencyConst := 'EG';
  end;
  dispose(gneBuffer);

  { close open files }
  keyNum := 0;
  if file1Open = TRUE then begin
    dataLen := 0;

    status := BTRVID(
                B_CLOSE,
                posBlock1,
                dataBuffer,
                dataLen,
                keyBuf1[1],
                keyNum,
                client);

    writeln('Btrieve B_CLOSE status (sample.btr) = ', status);
  end;

  if file2Open = TRUE then begin
    dataLen := 0;

    status := BTRVID(
                B_CLOSE,
                posBlock2,
                dataBuffer,
                dataLen,
                keyBuf2[1],
                keyNum,
                client);

    writeln('Btrieve B_CLOSE status (sample2.btr) = ', status);
  end;

{ Free Resources }
{$IFNDEF BTI_DOS_16P}
   dataLen := 0;
   status := BTRVID( B_STOP, posBlock1, DataBuffer,
                dataLen, keyBuf1[1], 0, client );
   writeln( 'Btrieve B_STOP status = ', status )
{$ENDIF}

END.