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

Pascal/Delphi Source File | 1997-11-07 | 16.0 KB | 520 lines

{*************************************************************************
**
**  Copyright 1982-1997 Pervasive Software Inc. All Rights Reserved
**
*************************************************************************}
{*************************************************************************
  BTRSAMPW.PAS
    This program demonstrates the Btrieve Interface for MS Windows using
    Borland Pascal version 7.0 or Turbo Pascal for Windows version 1.5.

    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 btrsampw;

uses
  WinCrt,     { text mode I/O library for Windows }
  Strings,    { Pascal System functions }
  btrapiw,    { 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}

      end;

      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 }
  dataLen := 0;
  status := BTRVID(B_STOP, posBlock1, DataBuffer,
               dataLen, keyBuf1[1], 0, client);
  writeln('Btrieve B_STOP status = ', status)

end.