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

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

{****************************************************************************
**
**  Copyright 1982-1997 Pervasive Software Inc. All Rights Reserved
**
****************************************************************************}
{****************************************************************************
   BTRSAM16.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 16-bit environment using your compiler tools.

      This program demonstrates the Delphi interface for Btrieve on 16-Bit
      MS Windows 3.1, for Delphi 1.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 1.0 Btrieve projects must be compiled after selecting the
      following from the Delphi project environment pull-down menus:

        PROJECT
          OPTIONS...
            PROJECT
              COMPILER
                CODE GENERATION
                  WORD-ALIGNED DATA ( 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:
         - btr16.dpr       Borland project file
         - btrsam16.dfm    Borland project file
         - btrsam16.pas    Source code for the simple sample
         - btrapi16.pas    Delphi interface to Btrieve
         - btrconst.pas    Btrieve constants file

****************************************************************************}
unit btrsam16;

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, BtrConst, BtrAPI16;

{*****************************************************************************
   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.