ex1u.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

Unit Ex1U;

{$I XQ_FLAG.INC}
Interface

{.$DEFINE USE_DBF_ENGINE}
{$DEFINE QUERYBUILDER}   { use query builder in the demo. Comment if not used }
Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, XQuery, Db, DBTables, StdCtrls, ComCtrls, Menus, ExtCtrls,
  DBCtrls, Buttons, QBaseExpr, SyntaxHi, XQMiscel, xqbase
{$IFDEF USE_DBF_ENGINE}
  , halcn6DB
  , gs6_shel
{$ENDIF}
{$IFDEF QUERYBUILDER}
  , QBuilder
  , OQBExQry
{$ENDIF}
  ;
  

Type
  TfrmTest = Class(TForm)
    About1: TMenuItem;
    Button3: TButton;
    Button4: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    ComboBox1: TComboBox;
    Contents1: TMenuItem;
    DBGrid2: TDBGrid;
    DBGrid3: TDBGrid;
    DBGrid4: TDBGrid;
    DBGrid5: TDBGrid;
    DBGrid6: TDBGrid;
    DBImage1: TDbImage;
    DBLabel1: TDbText;
    DBMemo1: TDbMemo;
    DBNavigator2: TDbNavigator;
    DBNavigator3: TDbNavigator;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    DataSource3: TDataSource;
    DataSource4: TDataSource;
    DataSource5: TDataSource;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Exit1: TMenuItem;
    File1: TMenuItem;
    Help1: TMenuItem;
    Howtobuy1: TMenuItem;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    MainMenu1: TMainMenu;
    N5: TMenuItem;
    N6: TMenuItem;
    PageControl1: TPageControl;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    PopupMenu2: TPopupMenu;
    RichEdit2: TRichEdit;
    RichEdit3: TRichEdit;
    RichEdit4: TRichEdit;
    SaveDialog1: TSaveDialog;
    Saveresultsetastext1: TMenuItem;
    StatusBar1: TStatusBar;
    SyntaxHighlighter1: TSyntaxHighlighter;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    Table1: TTable;
    Table2: TTable;
    Table3: TTable;
    Table4: TTable;
    Table5: TTable;
    XQuery1: TXQuery;
    XQuery2: TXQuery;
    xQuery3: TXQuery;
    xQuery4: TXQuery;
    Table1CustNo: TFloatField;
    Table1Company: TStringField;
    Table1Addr1: TStringField;
    Table1Addr2: TStringField;
    Table1City: TStringField;
    Table1State: TStringField;
    Table1Zip: TStringField;
    Table1Country: TStringField;
    Table1Phone: TStringField;
    Table1FAX: TStringField;
    Table1TaxRate: TFloatField;
    Table1Contact: TStringField;
    Table1LastInvoiceDate: TDateTimeField;
    Table2OrderNo: TFloatField;
    Table2CustNo: TFloatField;
    Table2SaleDate: TDateTimeField;
    Table2ShipDate: TDateTimeField;
    Table2EmpNo: TIntegerField;
    Table2ShipToContact: TStringField;
    Table2ShipToAddr1: TStringField;
    Table2ShipToAddr2: TStringField;
    Table2ShipToCity: TStringField;
    Table2ShipToState: TStringField;
    Table2ShipToZip: TStringField;
    Table2ShipToCountry: TStringField;
    Table2ShipToPhone: TStringField;
    Table2ShipVIA: TStringField;
    Table2PO: TStringField;
    Table2Terms: TStringField;
    Table2PaymentMethod: TStringField;
    Table2ItemsTotal: TCurrencyField;
    Table2TaxRate: TFloatField;
    Table2Freight: TCurrencyField;
    Table2AmountPaid: TCurrencyField;
    Table3OrderNo: TFloatField;
    Table3ItemNo: TFloatField;
    Table3PartNo: TFloatField;
    Table3Qty: TIntegerField;
    Table3Discount: TFloatField;
    Table4PartNo: TFloatField;
    Table4VendorNo: TFloatField;
    Table4Description: TStringField;
    Table4OnHand: TFloatField;
    Table4OnOrder: TFloatField;
    Table4Cost: TCurrencyField;
    Table4ListPrice: TCurrencyField;
    Table5SpeciesNo: TFloatField;
    Table5Category: TStringField;
    Table5Common_Name: TStringField;
    Table5SpeciesName: TStringField;
    Table5Lengthcm: TFloatField;
    Table5Length_In: TFloatField;
    Table5Notes: TMemoField;
    Table5Graphic: TGraphicField;
    Panel5: TPanel;
    Label2: TLabel;
    DBLabel2: TDbText;
    PageControlSQLExamples: TPageControl;
    TabSheetSQLString: TTabSheet;
    Panel8: TPanel;
    PanelSideButtons: TPanel;
    Button2: TButton;
    Button5: TButton;
    BtnQBuilder: TButton;
    ButtonRunSQL: TBitBtn;
    TabSheetResultDataSet: TTabSheet;
    Panel9: TPanel;
    DBGrid1: TDBGrid;
    Panel10: TPanel;
    DBNavigator1: TDbNavigator;
    Panel1: TPanel;
    Bar1: TProgressBar;
    SpeedButton1: TSpeedButton;
    SaveDialog2: TSaveDialog;
    TreeView1: TTreeView;
    Panel11: TPanel;
    RichEdit1: TRichEdit;
    Splitter1: TSplitter;
    ChkParse: TCheckBox;
    Panel12: TPanel;
    MemoParse: TMemo;
    TreeView2: TTreeView;
    Button1: TButton;
    Procedure ButtonRunSQLClick(Sender: TObject);
    Procedure Button3Click(Sender: TObject);
    Procedure Button4Click(Sender: TObject);
    Procedure XQuery1Progress(Sender: TObject; Status: TXProgressStatus; Min, Max, Position: Integer);
    Procedure Contents1Click(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
    Procedure About1Click(Sender: TObject);
    Procedure Howtobuy1Click(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure Exit1Click(Sender: TObject);
    Procedure PageControl1Change(Sender: TObject);
    Procedure SyntaxHighlighter1PosChange(Sender: TObject; Row, Col: Integer);
    Procedure Button2Click(Sender: TObject);
    Procedure Button5Click(Sender: TObject);
    Procedure Button6Click(Sender: TObject);
    Procedure Button7Click(Sender: TObject);
    Procedure Button8Click(Sender: TObject);
    Procedure XQuery1CreateIndex(Sender: TObject; Unique, Descending: Boolean; Const TableName, IndexName: String; ColumnExprList: TStringList);
    Procedure XQuery1DropTable(Sender: TObject; Const TableName: String);
    Procedure XQuery1DropIndex(Sender: TObject; Const TableName, IndexName: String);
    Procedure XQuery1CreateTable(Sender: TObject; CreateTable: TCreateTableItem);
    Procedure XQuery1SyntaxError(Sender: TObject; Const ErrorMsg, OffendingText: String; LineNum, ColNum, TextLen: Integer);
    Procedure Button12Click(Sender: TObject);
    Procedure BtnQBuilderClick(Sender: TObject);
    Procedure Saveresultsetastext1Click(Sender: TObject);
    Procedure PageControlSQLExamplesChange(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure XQuery1AlterTable(Sender: TObject;
      CreateTable: TCreateTableItem);
    procedure XQuery1ResolveDataset(Sender: TObject;
      const Filename: String; var ATableName: String;
      var Dataset: TDataSet);
    procedure TreeView1Click(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure ChkParseClick(Sender: TObject);
    procedure TreeView2Click(Sender: TObject);
    procedure XQuery1SetRange(Sender: TObject;
      RelOperator: TRelationalOperator; DataSet: TDataSet;
      const FieldNames, StartValues, EndValues: String;
      IsJoining: Boolean);
    procedure XQuery1CancelRange(Sender: TObject; DataSet: TDataSet;
      IsJoining: Boolean);
    procedure XQuery1IndexNeededFor(Sender: TObject; DataSet: TDataSet;
      const FieldNames: String; ActivateIndex, IsJoining: Boolean;
      var Accept: Boolean);
    procedure XQuery1CancelFilter(Sender: TObject; DataSet: TDataSet;
      IsJoining: Boolean);
    procedure XQuery1SetFilter(Sender: TObject; DataSet: TDataSet;
      const Filter: String; IsJoining: Boolean; var Handled: Boolean);
    procedure xQuery4BeforeInsert(DataSet: TDataSet);
    procedure XQuery1UDFCheck(Sender: TObject; const Identifier: String;
      Params: TParameterList; var DataType: TExprType; var MaxLen: Integer;
      var Accept: Boolean);
    procedure XQuery1UDFSolve(Sender: TObject; const Identifier: String;
      Params: TParameterList; var Value: Variant);
    procedure Button1Click(Sender: TObject);
    procedure XQuery1CancelQuery(Sender: TObject; var Cancel: Boolean);
  Private
    fAnalizer: TSqlAnalizer;
    {$IFDEF QUERYBUILDER}
    fOQBDialog: TOQBuilderDialog;
    fOQBxQuery: TOQBEnginexQry;
    {$ENDIF}
    {$IFNDEF LEVEL3}
    Procedure PopupDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    Procedure PopupMeasureItem(Sender: TObject; ACanvas: TCanvas; Var Width, Height: Integer);
    {$ENDIF}
    procedure SelectionChange;
    procedure ParseSQL;
    procedure AnalizerChange;
  Public
  End;

Var
  frmTest: TfrmTest;

Implementation

{$R *.DFM}

Uses
  DemoAb, DemoReg, BDE, XQYacc, HTMLQry, ShellApi;

vAR
  Start: Boolean = True;


Const
  CRLF = #13#10;
  (* Examples of SQL statements supported (some of them not useful at all but will show you the syntax supported)  *)

Procedure TfrmTest.ButtonRunSQLClick(Sender: TObject);
Begin
  PageControlSQLExamples.ActivePage := TabSheetResultDataSet;
  XQuery1.Close;
  RichEdit1.WordWrap := False; //There is a silly bug in RichEdit. It returns wrapped lines as new lines.
  XQuery1.Sql.Assign(RichEdit1.Lines);
  RichEdit1.WordWrap := True; //We're havin wordwrapping again
  XQuery1.Filtered := False;
  If ButtonRunSQL.Caption = 'Run SQL' Then
    XQuery1.Open //Run SQL
  Else
    XQuery1.ExecSql; //Exec SQL
  ButtonRunSQL.Enabled := False;

  { User wants to parse the SQL statement }
  if ChkParse.Checked then
  begin
    MemoParse.Lines.Clear;
    ParseSQL;
  end;
End;

Procedure TfrmTest.Button3Click(Sender: TObject);
Begin
  XQuery1.Filter   := ComboBox1.Text;
  XQuery1.Filtered := True;
End;

Procedure TfrmTest.Button4Click(Sender: TObject);
Begin
  XQuery2.Close;
  XQuery2.Sql.SetText(PChar(RichEdit2.Text));
  XQuery2.Open;
End;

Procedure TfrmTest.XQuery1Progress(Sender: TObject; Status: TXProgressStatus; Min, Max, Position: Integer);
Begin

  Case Status Of
    PsXStart: Begin
        If (Min = 0) Or (Max = 0) Then Exit;
        Bar1.Visible := True;
        Bar1.Min := Min;
        Bar1.Max := Max;
        Bar1.Position := Position;
      End;
    PsXProgress: Begin
        If Position = 0 Then Exit;
        Bar1.Position := Position;
      End;
    PsXEnd: Begin
        Bar1.Visible := False;
      End;
  End;
End;

Procedure TfrmTest.Contents1Click(Sender: TObject);
Begin
  Application.HelpCommand(HELP_CONTENTS, 0);
End;

Procedure TfrmTest.FormCreate(Sender: TObject);
var
  TreeNode: TTreeNode;
Begin

  Application.HelpFile := ExtractFilePath(Application.ExeName) + 'txquery.hlp';
  ComboBox1.ItemIndex := 0;
  {$IFNDEF LEVEL3}
  PopupMenu2.OwnerDraw := True;
  {$ELSE}
  Button5.Visible := False;
  {$ENDIF}

  with TreeView1.Items do
  begin
     AddObject(nil, 'BETWEEN',Pointer(1));
     TreeNode:= Add(nil, 'DISTINCT');
        AddChildObject(TreeNode, 'Agregate',Pointer(2));
        AddChildObject(TreeNode, 'Record',Pointer(3));
     TreeNode:= Add(nil, 'GROUP BY');
        AddChildObject(TreeNode, 'Sample 1',Pointer(4));
        AddChildObject(TreeNode, 'Sample 2',Pointer(5));
        AddChildObject(TreeNode, 'Sample 2',Pointer(6));
     AddObject(nil, 'IN',Pointer(7));
     TreeNode:= Add(nil, 'JOIN');
        AddChildObject(TreeNode, 'Sample',Pointer(8));
        AddChildObject(TreeNode, 'SELECT',Pointer(9));
        AddChildObject(TreeNode, 'WHERE',Pointer(10));
        AddChildObject(TreeNode, 'Multiple Fields',Pointer(11));
        AddChildObject(TreeNode, 'Table Alias',Pointer(12));
     TreeNode:= Add(nil, 'LIKE');
        AddChildObject(TreeNode, 'Sample 1',Pointer(13));
        AddChildObject(TreeNode, 'Sample 2',Pointer(14));
        AddChildObject(TreeNode, 'Sample 3',Pointer(15));
     AddObject(nil, 'UNION',Pointer(16));
     TreeNode:= Add(nil, 'ORDER BY');
        AddChildObject(TreeNode, 'Sample 1',Pointer(17));
        AddChildObject(TreeNode, 'Sample 2',Pointer(18));
        AddChildObject(TreeNode, 'Sample 3',Pointer(19));
     AddObject(nil, 'SELECT',Pointer(20));
     TreeNode:= Add(nil, 'FUNCTIONS');
        AddChildObject(TreeNode, 'UDFs',Pointer(21));
        AddChildObject(TreeNode, 'Solved in event',Pointer(22));
     TreeNode:= Add(nil, 'SUBQUERIES');
        AddChildObject(TreeNode, 'Sample 1',Pointer(23));
        AddChildObject(TreeNode, 'Sample 2',Pointer(24));
        AddChildObject(TreeNode, 'In SELECT clause',Pointer(25));
        AddChildObject(TreeNode, 'In FROM clause',Pointer(36));
     TreeNode:= Add(nil, 'TRANSFORM...PIVOT');
        AddChildObject(TreeNode, 'Sample 1',Pointer(26));
        AddChildObject(TreeNode, 'Sample 2',Pointer(27));
        AddChildObject(TreeNode, 'Sample 3',Pointer(28));
     AddObject(nil, 'CREATE TABLE',Pointer(29));
     AddObject(nil, 'ALTER TABLE',Pointer(30));
     AddObject(nil, 'CREATE INDEX',Pointer(31));
     AddObject(nil, 'DROP TABLE',Pointer(32));
     AddObject(nil, 'DROP INDEX',Pointer(33));
     AddObject(nil, 'CASE...WHEN...ELSE...END', Pointer(34));
     AddObject(nil, 'OnResolveDataset event',Pointer(35));
     //AddObject(nil, 'CASE',Pointer(35));
  end;
  TreeView1.FullExpand;

  Table1.Open;
  Table2.Open;