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

Pascal/Delphi Source File | 1997-11-17 | 8.9 KB | 314 lines

{****************************************************************************
**
**  Copyright 1982-1997 Pervasive Software Inc. All Rights Reserved
**
****************************************************************************}
{****************************************************************************
     SQLSAM16.PAS
            This is a simple sample designed to allow you to confirm your
            ability to compile, link, and execute a Scalable SQL application for
            your target 16-bit environment using Borland Delphi.

            This program demonstrates the Delphi interface for Scalable SQL for
            MS Windows.  It uses SQL-level functions to fetch records from the
            'university' database that is  included with  Scalable SQL.

            This program does the following operations on the sample database:
            - logs into the database
            - gets a cursor
            - compiles a select statement
            - gets a record
            - displays selected portions of the retrieved record
            - frees resources
            - logs out of the database

            IMPORTANT: Be sure to provide the complete path to the sample
            database location, as shown below for a particular case.
            See 'IMPORTANT', below.

            PROJECT FILES:
                 - sql16.dpr     Borland project file
                 - sqlsam16.dfm  Borland project file
                 - sqlsam16.pas  Source code for the simple sample
                 - sqlapi16.pas  BTI interface to Scalable SQL

****************************************************************************}
unit Sqlsam16;

interface

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

{*****************************************************************************
     Constants
*****************************************************************************}
CONST
     TRUE    =  1;
     FALSE   =  0;
     SUCCESS =  0;
     FAILURE = -1;
     STATEMENT_BUFFER_SIZE = 1024;
     BYTE_COUNT_SIZE       = 2;
     SPACING_NOT_PERTINENT = 0;
     UserID   : CHAR = #0;
     Password : CHAR = #0;
     Reserved : CHAR = #0;
   DDpath   : string[ 20 ] = 'c:\pvsw\demodata';      { IMPORTANT }
   Datapath : string[ 20 ] = 'c:\pvsw\demodata';      { IMPORTANT }
     FETCH_FIRST        : integer = 1;
     INTERNAL_FORMAT    : integer = 0;


{***************************************************************************
     Structures
     Definition of record from the 'person' table
****************************************************************************}
TYPE
     PERSON_STRUCT = record
            RecLen         : word;
            ID             : longint;
      Dummy          : longint;
            FirstName      : array[0..15] of char;
            LastName       : array[0..25] of char;
            PermStreet     : array[0..30] of char;
            PermCity       : array[0..30] of char;
            PermState      : array[0..2] of char;
            PermZip        : array[0..10] of char;
            PermCountry    : array[0..20] 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;
            Phone          : array[0..9] of char;
            EmergencyPhone : array[0..19] of char;
            Unlisted       : char;
            DateOfBirth    : array[0..3] of char;
            EmailAddress   : array[0..30] of char;
            Sex            : char;
            Citizenship    : array[0..20] of char;
            Survey         : char;
            Smoker         : char;
            Married        : char;
            Children       : char;
            Disability     : char;
            Scholarship    : char;
            Comments       : array[0..199] of char;
     end;

     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: integer;
            personRecord: PERSON_STRUCT;
            recordsRead:  longint;

            procedure RunTest;
     public
            { Public declarations }
     end;

var
     Form1: TForm1;

implementation

{$R *.DFM}
VAR
     cursorID     :  integer;
     statement    :  string [255];
     statlen      :  integer;
     loginFlag    :  integer;
     cursorIDFlag :  integer;

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);
   loginFlag    :=  FALSE;
   cursorIDFlag :=  FALSE;
end;

procedure TForm1.ExitButtonClick(Sender: TObject);
begin
   {**************************************************
   ** Stop the engine
   **************************************************}
   status := XQLStop;
   if status > SUCCESS then
      begin

        status := FAILURE;
      end
   else
      begin
                status := SUCCESS;
      end;
   Close;
end;

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

procedure TForm1.RunTest;
begin
     ListBox1.Clear;
     WritelnLB( ListBox1, 'Test started ...' );
     {**************************************************
     ** Login to the database
     **************************************************}
     status := XQLLogin(
                                UserID,
                                Password,
                                DDpath[1],
                                Datapath[1],
                                Reserved,
                                1);

     WritelnLB( ListBox1, 'XQLLogin status = ' + IntToStr(status) );
     if status <> SUCCESS then
            begin
                 status := FAILURE;
            end
     else
            begin
                 loginFlag := TRUE;
            end;

     if status = SUCCESS then
            begin
                 {**************************************************
                 ** Get a cursor ID
                 **************************************************}
                 status := XQLCursor (cursorID);
                 WritelnLB( ListBox1, 'XQLCursorID status = ' + IntToStr(status) );
                 if status <> SUCCESS then
                        begin
                             status := FAILURE;
                        end
                 else
                        begin
                             cursorIDFlag := TRUE;
                        end;
            end;

     if status = SUCCESS then
            begin
                 {**************************************************
                 ** Compile the select statement
                 **************************************************}
                 statement := 'SELECT * from person where ID = 101135758 ' + #0;
                 Statlen   := length (Statement);

                 status := XQLCompile(
                                            cursorID,
                                            statlen,
                                            statement [1] );

                 WritelnLB( ListBox1, 'XQLCompile status = ' + IntToStr(status) );
                 if status > SUCCESS then
                        begin
                             status := FAILURE;
                        end
                 else
                        begin
                             WritelnLB( ListBox1, 'SELECT * from person where ID = 101135758' );
                        end;
             end;

     if status = SUCCESS then
            begin
                 {**************************************************
                 ** Fetch the record
                 **************************************************}
                 bufferLength := SizeOf( PERSON_STRUCT );

                 recordsRead := 1;
                 status := XQLFetch(
                                            cursorID,
                                            FETCH_FIRST,
                                            bufferLength,
                                            personRecord,
                                            recordsRead,
                                            INTERNAL_FORMAT,
                                            SPACING_NOT_PERTINENT );

                 WritelnLB( ListBox1, 'XQLFetch status = ' + IntToStr(status) );
                 if status <> SUCCESS then
                        begin
                             status := FAILURE;
                        end
                 else
                        begin
                             WritelnLB( ListBox1, '');
                             WritelnLB( ListBox1, 'Selected fields from the retrieved record are:' );
                             WritelnLB( ListBox1, format('Name:    %s  %s',
                                           [personRecord.FirstName,
                                            personRecord.LastName]));
                             WritelnLB( ListBox1, 'Country: ' + personRecord.PermCountry );
                             WritelnLB( ListBox1, 'Street:  ' + personRecord.PermStreet );
                             WritelnLB( ListBox1, 'City:    ' + personRecord.PermCity );
                             WritelnLB( ListBox1, 'State:   ' + personRecord.PermState );
                             WritelnLB( ListBox1, 'Zip:     ' + personRecord.PermZip );
                             WritelnLB( ListBox1, '');
                        end;
            end;

     if cursorIDFlag = TRUE then
            begin
                 {**************************************************
                 ** Free the resources
                 **************************************************}
                 status := XQLFree( cursorID );
                 WritelnLB( ListBox1, 'XQLFree status = ' + IntToStr(status) );
                 if status > SUCCESS then
                        begin
                             status := FAILURE;
                        end
                 else
                        begin
                             status := SUCCESS;
                        end;
            end;

     if loginFlag = TRUE then
            begin
                 {**************************************************
                 ** Logout of the database
                 **************************************************}
                 status := XQLLogout;
                 WritelnLB( ListBox1, 'XQLLogout status = ' + IntToStr(status) );
                 if status > SUCCESS then
                        begin
                             status := FAILURE;
                        end
                 else
                        begin
                             status := SUCCESS;
                        end;
            end;
     WritelnLB( ListBox1, 'Test ended ...' );

end;

end.