home *** CD-ROM | disk | FTP | other *** search
/ Datatid 1999 #6 / Datatid_1999-06.iso / internet / Tango352Promo / P.SQL / PTKPKG.1 / SQLSAM32.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-11-17  |  10.4 KB  |  332 lines
  1. {****************************************************************************
  2. **
  3. **  Copyright 1982-1997 Pervasive Software Inc. All Rights Reserved
  4. **
  5. ****************************************************************************}
  6. {****************************************************************************
  7.    SQLSAM32.PAS
  8.       This is a simple sample designed to allow you to confirm your
  9.       ability to compile, link, and execute a Scalable SQL application for
  10.       your target 32-bit environment using Borland Delphi.
  11.  
  12.       This program demonstrates the Delphi interface for Scalable SQL for
  13.       MS Windows NT and MS Windows 95.  It uses SQL-level functions to
  14.       fetch records from the  'university' database that is  included with
  15.       Scalable SQL.
  16.  
  17.       This program does the following operations on the sample database:
  18.       - logs into the database
  19.       - gets a cursor
  20.       - compiles a select statement
  21.       - gets a record
  22.       - displays selected portions of the retrieved record
  23.       - frees resources
  24.       - logs out of the database
  25.  
  26.       IMPORTANT:
  27.       - Be sure to provide the complete path to the sample
  28.         database location, as shown below for a particular case.
  29.         See 'IMPORTANT', below.
  30.  
  31.       - The following options are automatically set in the Borland project
  32.         file, sql32.dof:
  33.  
  34.         * This project must be compiled after selecting the following from
  35.           the Delphi project environment pull-down menus:
  36.  
  37.           PROJECT
  38.              OPTIONS...
  39.                 COMPILER
  40.                    CODE GENERATION
  41.                       ALIGNED RECORD FIELDS ( de-select this )
  42.  
  43.           If you don't do this step, when the record is printed out, it will
  44.           seem 'jumbled' because the record structure is not byte-packed.
  45.  
  46.       PROJECT FILES:
  47.          - sql32.dpr     Borland project file
  48.          - sql32.dof     Borland project file
  49.          - sqlsam32.dfm  Borland project file
  50.          - sqlsam32.pas  Source code for the simple sample
  51.          - sqlapi32.pas  BTI interface to Scalable SQL
  52.  
  53. ****************************************************************************}
  54. unit sqlsam32;
  55.  
  56. interface
  57.  
  58. uses
  59.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  60.   StdCtrls, SQLAPI32;
  61.  
  62. {*****************************************************************************
  63.    Constants
  64. *****************************************************************************}
  65. CONST
  66.    TRUE    =  1;
  67.    FALSE   =  0;
  68.    SUCCESS =  0;
  69.    FAILURE = -1;
  70.    STATEMENT_BUFFER_SIZE = 1024;
  71.    BYTE_COUNT_SIZE       = 2;
  72.    SPACING_NOT_PERTINENT = 0;
  73.    UserID          : CHAR = #0;
  74.    Password        : CHAR = #0;
  75.    Reserved        : CHAR = #0;
  76.    DDpath          : string[ 20 ] = 'c:\pvsw\demodata';      { IMPORTANT }
  77.    Datapath        : string[ 20 ] = 'c:\pvsw\demodata';      { IMPORTANT }
  78.    FETCH_FIRST     : integer = 1;
  79.    INTERNAL_FORMAT : integer = 0;
  80.  
  81.  
  82. {***************************************************************************
  83.    Structures
  84.    Definition of record from the 'person' table
  85. ****************************************************************************}
  86. type
  87.    PERSON_STRUCT = record
  88.       RecLen         : word;
  89.       ID             : longint;
  90.       Dummy          : longint;
  91.       FirstName      : array[0..15] of char;
  92.       LastName       : array[0..25] of char;
  93.       PermStreet     : array[0..30] of char;
  94.       PermCity       : array[0..30] of char;
  95.       PermState      : array[0..2] of char;
  96.       PermZip        : array[0..10] of char;
  97.       PermCountry    : array[0..20] of char;
  98.       Street         : array[0..30] of char;
  99.       City           : array[0..30] of char;
  100.       State          : array[0..2] of char;
  101.       Zip            : array[0..10] of char;
  102.       Phone          : array[0..9] of char;
  103.       EmergencyPhone : array[0..19] of char;
  104.       Unlisted       : char;
  105.       DateOfBirth    : array[0..3] of char;
  106.       EmailAddress   : array[0..30] of char;
  107.       Sex            : char;
  108.       Citizenship    : array[0..20] of char;
  109.       Survey         : char;
  110.       Smoker         : char;
  111.       Married        : char;
  112.       Children       : char;
  113.       Disability     : char;
  114.       Scholarship    : char;
  115.       Comments       : array[0..199] of char;
  116.    end;
  117.  
  118.   TForm1 = class(TForm)
  119.     RunButton: TButton;
  120.     ExitButton: TButton;
  121.     ListBox1: TListBox;
  122.     procedure FormCreate(Sender: TObject);
  123.     procedure ExitButtonClick(Sender: TObject);
  124.     procedure RunButtonClick(Sender: TObject);
  125. private
  126.     { Private declarations }
  127.       ArrowCursor,
  128.       WaitCursor:   HCursor;
  129.       status:       smallint;
  130.       bufferLength: smallint;
  131.       personRecord: PERSON_STRUCT;
  132.       recordsRead:  longint;
  133.       procedure RunTest;
  134.   public
  135.     { Public declarations }
  136.   end;
  137.  
  138. var
  139.   Form1: TForm1;
  140.  
  141. implementation
  142.  
  143. {$R *.DFM}
  144. VAR
  145.    cursorID     :  smallint;
  146.    statement    :  string [255];
  147.    statlen      :  smallint;
  148.    loginFlag    :  smallint;
  149.    cursorIDFlag :  smallint;
  150.  
  151. procedure WritelnLB( LB: TListBox; Str: String);
  152. begin
  153.    LB.Items.Add(Str);
  154. end;
  155.  
  156. procedure TForm1.FormCreate(Sender: TObject);
  157. begin
  158.    ArrowCursor  :=  LoadCursor(0, IDC_ARROW);
  159.    WaitCursor   :=  LoadCursor(0, IDC_WAIT);
  160.    loginFlag    :=  FALSE;
  161.    cursorIDFlag :=  FALSE;
  162. end;
  163.  
  164. procedure TForm1.RunTest;
  165. begin
  166.    ListBox1.Clear;
  167.    WritelnLB( ListBox1, 'Test started ...' );
  168.    {**************************************************
  169.    ** Login to the database
  170.    **************************************************}
  171.    status := XQLLogin(
  172.                 UserID,
  173.                 Password,
  174.                 DDpath[1],
  175.                 Datapath[1],
  176.                 Reserved,
  177.                 1);
  178.  
  179.    WritelnLB( ListBox1, 'XQLLogin status = ' + IntToStr(status) );
  180.    if status <> SUCCESS then
  181.       begin
  182.          status := FAILURE;
  183.          loginFlag    :=  FALSE;
  184.       end
  185.    else
  186.       begin
  187.          loginFlag := TRUE;
  188.       end;
  189.  
  190.    if status = SUCCESS then
  191.       begin
  192.          {**************************************************
  193.          ** Get a cursor ID
  194.          **************************************************}
  195.          status := XQLCursor (cursorID);
  196.          WritelnLB( ListBox1, 'XQLCursorID status = ' + IntToStr(status) );
  197.          if status <> SUCCESS then
  198.             begin
  199.                status := FAILURE;
  200.                cursorIDFlag :=  FALSE;
  201.             end
  202.          else
  203.             begin
  204.                cursorIDFlag := TRUE;
  205.             end;
  206.       end;
  207.  
  208.    if status = SUCCESS then
  209.       begin
  210.          {**************************************************
  211.          ** Compile the select statement
  212.          **************************************************}
  213.          statement := 'SELECT * from person where ID = 101135758 ' + #0;
  214.          Statlen   := length (Statement);
  215.  
  216.          status := XQLCompile(
  217.                       cursorID,
  218.                       statlen,
  219.                       statement [1] );
  220.  
  221.          WritelnLB( ListBox1, 'XQLCompile status = ' + IntToStr(status) );
  222.          if status > SUCCESS then
  223.             begin
  224.                status := FAILURE;
  225.             end
  226.          else
  227.             begin
  228.                WritelnLB( ListBox1, 'SELECT * from person where ID = 101135758' );
  229.             end;
  230.        end;
  231.  
  232.    if status = SUCCESS then
  233.       begin
  234.          {**************************************************
  235.          ** Fetch the record
  236.          **************************************************}
  237.          bufferLength := SizeOf( PERSON_STRUCT );
  238.  
  239.          recordsRead := 1;
  240.          status := XQLFetch(
  241.                       cursorID,
  242.                       FETCH_FIRST,
  243.                       bufferLength,
  244.                       personRecord,
  245.                       recordsRead,
  246.                       INTERNAL_FORMAT,
  247.                       SPACING_NOT_PERTINENT );
  248.  
  249.          WritelnLB( ListBox1, 'XQLFetch status = ' + IntToStr(status) );
  250.          if status <> SUCCESS then
  251.             begin
  252.                status := FAILURE;
  253.             end
  254.          else
  255.             begin
  256.                WritelnLB( ListBox1, '');
  257.                WritelnLB( ListBox1, 'Selected fields from the retrieved record are:' );
  258.                WritelnLB( ListBox1, format( 'Name:    %s  %s',
  259.                                     [personRecord.FirstName,
  260.                                      personRecord.LastName] ) );
  261.                WritelnLB( ListBox1, 'Country: ' + personRecord.PermCountry );
  262.                WritelnLB( ListBox1, 'Street:  ' + personRecord.PermStreet );
  263.                WritelnLB( ListBox1, 'City:    ' + personRecord.PermCity );
  264.                WritelnLB( ListBox1, 'State:   ' + personRecord.PermState );
  265.                WritelnLB( ListBox1, 'Zip:     ' + personRecord.PermZip );
  266.                WritelnLB( ListBox1, '');
  267.             end;
  268.       end;
  269.  
  270.    if cursorIDFlag = TRUE then
  271.       begin
  272.          {**************************************************
  273.          ** Free the resources
  274.          **************************************************}
  275.          status := XQLFree( cursorID );
  276.          WritelnLB( ListBox1, 'XQLFree status = ' + IntToStr(status) );
  277.          if status > SUCCESS then
  278.             begin
  279.                status := FAILURE;
  280.             end
  281.          else
  282.             begin
  283.                status := SUCCESS;
  284.             end;
  285.       end;
  286.  
  287.    if loginFlag = TRUE then
  288.       begin
  289.          {**************************************************
  290.          ** Logout of the database
  291.          **************************************************}
  292.          status := XQLLogout;
  293.          WritelnLB( ListBox1, 'XQLLogout status = ' + IntToStr(status) );
  294.          if status > SUCCESS then
  295.             begin
  296.                status := FAILURE;
  297.             end
  298.          else
  299.             begin
  300.                status := SUCCESS;
  301.             end;
  302.       end;
  303.    WritelnLB( ListBox1, 'Test ended ...' );
  304.  
  305. end;
  306.  
  307. procedure TForm1.ExitButtonClick(Sender: TObject);
  308. begin
  309.    {**************************************************
  310.    ** Stop the engine
  311.    **************************************************}
  312.    status := XQLStop;
  313.    if status > SUCCESS then
  314.       begin
  315.         status := FAILURE;
  316.       end
  317.    else
  318.       begin
  319.         status := SUCCESS;
  320.       end;
  321.    Close;
  322. end;
  323.  
  324. procedure TForm1.RunButtonClick(Sender: TObject);
  325. begin
  326.    SetCursor(WaitCursor);
  327.    RunTest;
  328.    SetCursor(ArrowCursor);
  329. end;
  330.  
  331. end.
  332.