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

Pascal/Delphi Source File | 1997-11-07 | 18.4 KB | 583 lines

{****************************************************************************
**
**  Copyright 1982-1997 Pervasive Software Inc. All Rights Reserved
**
****************************************************************************}
{****************************************************************************
   BTRSAM32.DPR
      This is a simple sample designed to allow you to confirm your
      ability to compile, link, and execute a Btrieve application for
      your target 32-bit environment using your compiler tools.

      This program demonstrates the Delphi interface for Btrieve on 32-Bit
      MS Windows NT and Windows 95, for Delphi 2.0 and 3.0.

    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.

      Delphi 2.0/3.0 Btrieve projects must be compiled after selecting the
      following from the Delphi project environment pull-down menus:

        PROJECT
           OPTIONS...
              COMPILER
                 CODE GENERATION
                    ALIGNED RECORD FIELDS ( de-select this )

        If you don't do this step, when the record is printed out, it will
        seem 'jumbled' because the record structure is not byte-packed.

        You may, instead, use the (*A-*) compiler directive, or declare all
        records as "packed," as shown below.  For more information, see the
        Delphi documentation.

      PROJECT FILES:
         - btr32.dpr       Borland project file
         - btr32.dof       Borland project file
         - btrsam32.dfm    Borland project file
         - btrsam32.pas    Source code for the simple sample
         - btrapi32.pas    Delphi interface to Btrieve
         - btrconst.pas    Btrieve constants file

****************************************************************************}
unit btrsam32;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, BtrConst, BtrAPI32;

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

  {********************************************************************
      IMPORTANT: You should modify the following to specify the
                complete path to 'sample.btr' for your environment.
  ********************************************************************}
  FILE_1              = 'c:\pvsw\samples\sample.btr';
  FILE_2              = 'c:\pvsw\samples\sample2.btr';

{***************************************************************************
  Record type definitions for Version operation
****************************************************************************}
type
  CLIENT_ID = packed record
    networkandnode : array[1..12] of char;
    applicationID  : array[1..3] of char;
    threadID       : smallint;
  end;

  VERSION_STRUCT = packed record
    version   : smallint;
    revision  : smallint;
    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   : smallint;
    pageSize    : smallint;
    indexCount  : smallint;
    reserved    : array[0..3] of char;
    flags       : smallint;
    dupPointers : byte;
    notUsed     : byte;
    allocations : smallint;
  end;

  KEY_SPECS = packed record
    position : smallint;
    length : smallint;
    flags : smallint;
    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  : smallint;
    currencyConst   : array[0..1] of char;
    rejectCount     : smallint;
    numberTerms     : smallint;
  end;

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

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

  FIELD_RETRIEVAL_HEADER = packed record
    fieldLen    : smallint;
    fieldOffset : smallint;
  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        : smallint;
    recPos        : longint;
    personRecord  : PERSON_STRUCT;
  end;

  POST_GNE_BUFFER = packed record
    numReturned : smallint;
    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;

{***************************************************************************
  Delphi-generated form definition
****************************************************************************}
  TForm1 = class(TForm)
    RunButton: TButton;
    ExitButton: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
    procedure RunButtonClick(Sender: TObject);
  private
  { Private declarations }
    ArrowCursor,
    WaitCursor:   HCursor;
    status:       smallint;
    bufferLength: smallint;
    personRecord: PERSON_STRUCT;
    recordsRead:  longint;
    procedure RunTest;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

{***********************************************************************
  Program starts here
************************************************************************}
implementation

{$R *.DFM}

{***********************************************************************
   Program 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        : smallint;

  btrieveLoaded : boolean;
  personID      : longint;
  file1Open     : boolean;
  file2Open     : boolean;
  status        : smallint;
  getStatus     : smallint;
  i             : smallint;
  posCtr        : smallint;
  client        : CLIENT_ID;
  versionBuffer : array[1..3] of VERSION_STRUCT;
  fileCreateBuf : FILE_CREATE_BUF;
  gneBuffer     : GNE_BUFFER_PTR;
  personRecord  : PERSON_STRUCT;

{***********************************************************************
   A helper procedure to write to the ListBox
************************************************************************}
procedure WritelnLB( LB: TListBox; Str: String);
begin
  LB.Items.Add(Str);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ArrowCursor    :=  LoadCursor(0, IDC_ARROW);
  WaitCursor     :=  LoadCursor(0, IDC_WAIT);
end;

{***********************************************************************
   This is the 'main' procedure of the sample
************************************************************************}
procedure TForm1.RunTest;
begin
  ListBox1.Clear;
  WritelnLB( ListBox1, 'Test started ...' );

  { initialize variables }
  btrieveLoaded := FALSE;
  file1Open := FALSE;
  file2Open := FALSE;
  keyNum := 0;
  status := B_NO_ERROR;
  getStatus := B_NO_ERROR;

  { set up the Client ID }
  fillchar(client.networkAndNode, sizeof(client.networkAndNode), #0);
  client.applicationID := 'MT' + #0;  { must be greater than "AA" }
  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
    writelnLB( ListBox1, 'Btrieve Versions returned are:' );
    for i := 1 to 3 do begin
      with versionBuffer[i] do begin
        if (version > 0) then begin
          writelnLB(ListBox1, intToStr(version) + '.' +
                     intToStr(revision) + ' ' + MKDEId);
        end
      end
    end;
    btrieveLoaded := TRUE;
  end else begin
    writelnLB(ListBox1, 'Btrieve B_VERSION status = ' + intToStr(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 := FILE_1 + #0;
    keyBuf2 := FILE_2 + #0;

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

    writelnLB(ListBox1, 'Btrieve B_OPEN status = ' + intToStr(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);

    writelnLB(ListBox1, 'Btrieve B_GET_EQUAL status = ' + intToStr(status));
    if status = B_NO_ERROR then with personRecord do begin
      writelnLB(ListBox1, '');
      writelnLB(ListBox1, 'Selected fields from the retrieved record are:');
      writelnLB(ListBox1, 'ID:      ' + intToStr(ID));
      writelnLB(ListBox1, 'Name:    ' + FirstName + ' ' +
                              LastName);
      writelnLB(ListBox1, 'Street:  ' + Street);
      writelnLB(ListBox1, 'City:    ' + City);
      writelnLB(ListBox1, 'State:   ' + State);
      writelnLB(ListBox1, 'Zip:     ' + Zip);
      writelnLB(ListBox1, 'Country: ' + Country);
      writelnLB(ListBox1, 'Phone:   ' + Phone);
      writelnLB(ListBox1, '');
    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);

    writelnLB(ListBox1, 'Btrieve B_CREATE status = ' + intToStr(status));
  end;

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

    status := BTRVID(
                B_OPEN,
                posBlock2,
                dataBuffer,
                dataLen,
                keyBuf2[1],
                keyNum,
                client);
    writelnLB(ListBox1, 'Btrieve B_OPEN status = ' + intToStr(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);

    writelnLB(ListBox1, 'Btrieve B_GET_FIRST status = ' + intToStr(GETstatus));
    writelnLB(ListBox1, '');
  end;

  { Allocate memory on heap }
  gneBuffer := new(GNE_BUFFER_PTR);
  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);

    writelnLB(ListBox1, 'Btrieve B_GET_NEXT_EXTENDED status = ' + intToStr(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
      writelnLB(ListBox1, 'GetNextExtended returned ' +
                intToStr(gneBuffer^.postBuf.numReturned) + ' records.');
      for i := 0 to gneBuffer^.postBuf.numReturned - 1 do begin
        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
          writelnLB(ListBox1, 'Btrieve B_INSERT status = ' + intToStr(status));
          break;
        end;
      end;

      writelnLB(ListBox1, 'Inserted ' + intToStr(gneBuffer^.postBuf.numReturned) +
                ' records in new file, status = ' + intToStr(status));
      writelnLB(ListBox1, '');
    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);

    writelnLB(ListBox1, 'Btrieve B_CLOSE status (sample.btr) = ' + intToStr(status));
  end;

  if file2Open = TRUE then begin
    dataLen := 0;

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

    writelnLB(ListBox1, 'Btrieve B_CLOSE status (sample2.btr) = ' + intToStr(status));
  end;

  { FREE RESOURCES }
  dataLen := 0;
  status := BTRVID( B_STOP, posBlock1, DataBuffer,
               dataLen, keyBuf1[1], 0, client );
  WritelnLB(ListBox1, 'Btrieve B_STOP status = ' + intToStr(status) );

end;

procedure TForm1.ExitButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.RunButtonClick(Sender: TObject);
begin
  SetCursor(WaitCursor);
  RunTest;
  SetCursor(ArrowCursor);
end;

end.