17.5.2 設計一個數據庫查詢器
例17.2：在數據庫查詢器中，用戶可以選擇要查詢的數據庫，查詢數據庫中的那一個表、根據數據庫表中那一個字段進行查詢，並且可以方便地指定查詢條件，指定查詢條件主要包括指定邏輯運算符(=、>、<、<=、>=、like、in、NOT like、NOT in)和字段值。
例子全部的程序清單如下：
unit main;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, DB, DBTables, Buttons, ComCtrls, Tabnotbk;
type
TQueryForm = class(TForm)
BitBtn1: TBitBtn;
DataSource1: TDataSource;
Table1: TTable;
GroupBox1: TGroupBox;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label5: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
Edit1: TEdit;
ComboBox1: TComboBox;
BitBtn2: TBitBtn;
TabSheet2: TTabSheet;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ListBox2Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
end;
var
QueryForm: TQueryForm;
implementation
{$R *.DFM}
uses RSLTFORM;
procedure TQueryForm.FormCreate(Sender: TObject);
begin
Screen.Cursor := crHourglass;
{ Populate the alias list }
with ListBox1 do
begin
Items.Clear;
Session.GetAliasNames(Items);
end;
{ Make sure there are aliases defined }
Screen.Cursor := crDefault;
if ListBox1.Items.Count < 1 then
MessageDlg( 'There are no database aliases currently defined. You
need at least one alias to use this demonstration.',
mtError, [mbOK], 0 );
{ Default the drop-down list to the first value in the list }
ComboBox1.ItemIndex := 0;
end;
procedure TQueryForm.ListBox1Click(Sender: TObject);
var
strValue: string; { Holds the alias selected by the user }
bIsLocal: Boolean; { Indicates whether or not an alias is local }
slParams: TStringList; { Holds the parameters of the selected alias }
iCounter: Integer; { An integer counter variable for loops}
begin
{ Determine the alias name selected by the user }
with ListBox1 do
strValue := Items.Strings[ItemIndex];
{ Get the names of the tables in the alias and put them in the
appropriate list box, making sure the user's choices are reflected
in the list. }
ListBox2.Items.Clear;
Session.GetTableNames(strValue, { alias to enumerate }
'', { pattern to match }
CheckBox1.Checked, { show extensions flag }
CheckBox2.Checked, { show system tables flag }
ListBox2.Items); { target for table list }
{ Make sure there are tables defined in the alias. If not, show an
error; otherwise, clear the list box. }
Screen.Cursor := crDefault;
if ListBox2.Items.Count < 1 then
MessageDlg('There are no tables in the alias you selected. Please
choose another', mtError, [mbOK], 0 );
ListBox3.Items.Clear;
end;
procedure TQueryForm.ListBox2Click(Sender: TObject);
begin
Screen.Cursor := crHourglass;
try
{ First, disable the TTable object. }
if Table1.Active then
Table1.Close;
{ Open the selected table }
with ListBox1 do
Table1.DatabaseName := Items.Strings[ItemIndex];
with ListBox2 do
Table1.TableName := Items.Strings[ItemIndex];
{ Open the table and put a list of the field names in the Fields
list box. }
Table1.Open;
if Table1.Active then
Table1.GetFieldNames(ListBox3.Items);
finally
Screen.Cursor := crDefault;
end;
end;
procedure TQueryForm.BitBtn2Click(Sender: TObject);
var
strAlias, { Alias name selected by the user }
strTable, { Table name selected by the user }
strField, { Field name selected by the user }
strValue, { Field Value entered by the user }
strWhere, { WHERE clause for the user's query }
strQuote, { Holds quotes is the query field is text }
strQuery: string; { String used to construct the query }
frmQuery: TResultForm; { The Results form }
type
{ The following type is used with the Type drop-down
list. The text values corresponding with each item is
described in comments, along with the relevant SQL operators. }
etSQLOps = (soNoCondition, { not field conditions: no WHERE clause }
soEqual, { equals: = }
soNotEqual, { is not equal to: <> }
soLessThan, { is less than: < }
soLessEqual, { is less than or equal to: <= }
soMoreThan, { is greater than: > }
soMoreEqual, { is greater than or equal to: >= }
soStartsWith, { starts with: LIKE xx% }
soNoStartsWith, { doesn't start with: NOT LIKE xx% }
soEndsWith, { ends with: LIKE %xx }
soNoEndsWith, { doesn't end with: NOT LIKE %xx }
soContains, { contains: LIKE %xx% }
soNoContains, { doesn't contain: NOT LIKE %xx% }
soBlank, { is blank: }
soNotBlank, { is not blank: }
soInside, { contains only: IN ( xx, yy, zz ) }
soOutside); { doesn't contain: NOT IN (xx, yy, zz) }
begin
{ Initialize the variables needed to run the query }
with ListBox1 do
if ItemIndex = -1 then
raise Exception.Create('Can''t Run Query: No Alias Selected')
else
strAlias := Items.Strings[ItemIndex];
with ListBox2 do
if ItemIndex = -1 then
raise Exception.Create('Can''t Run Query: No Table Selected')
else
strTable := Items.Strings[ItemIndex];
with ListBox3 do
if ItemIndex = -1 then
begin
if ComboBox1.ItemIndex > Ord(soNocondition) then
raise Exception.Create('Can''t Run Query: No Field Selected')
else
strField := '';
end
else
strField := Items.Strings[ItemIndex];
if (Edit1.Text = '') and
(ComboBox1.ItemIndex > Ord(soNoCondition)) and
(ComboBox1.ItemIndex < Ord(soBlank)) then
raise Exception.create('Can''t Run Query: No Search Value Entered')
else
strValue := Edit1.Text;
{ See if the field being search is a string field. If so, then pad the
quote string with quotation marks; otherwise, set it to a null value. }
if strField <> '' then
with Table1.FieldByName(strField) do
if (DataType = ftString) or (DataType = ftMemo) then
strQuote := '"' else
strQuote := '';
{ Construct the WHERE clause of the query based on the user's choice
in Type. }
case etSQLOps(ComboBox1.ItemIndex) of
soNoCondition: strWhere := '';
soEqual: strWhere := strField + ' = ' + strQuote + strValue+ strQuote;
soNotEqual: strWhere := strField + ' <> ' + strQuote + strValue +
strQuote;
soLessThan: strWhere := strField + ' < ' + strQuote + strValue +
strQuote;
soLessEqual: strWhere := strField + ' <= ' + strQuote + strValue +
strQuote;
soMoreThan: strWhere := strField + ' > ' + strQuote + strValue +
strQuote;
soMoreEqual: strWhere := strField + ' >= ' + strQuote + strValue +
strQuote;
soStartsWith: strWhere := strField + ' LIKE ' + strQuote +
strValue + '%' + strQuote;
soNoStartsWith: strWhere := strField + ' NOT LIKE ' + strQuote +
strValue + '%' + strQuote;
soEndsWith: strWhere := strField + ' LIKE ' + strQuote +
'%' + strValue + strQuote;
soNoEndsWith: strWhere := strField + ' NOT LIKE ' +
strQuote + '%' + strValue + strQuote;
soContains: strWhere := strField + ' LIKE '+ strQuote+'%'+ strValue
+ '%' + strQuote;
soNoContains: strWhere := strField + ' NOT LIKE ' + strQuote + '%'
+ strValue + '%' + strQuote;
soBlank: strWhere := strField + ' IS NULL';
soNotBlank: strWhere := strField + ' IS NOT NULL';
end;
if ComboBox1.ItemIndex = Ord(soNoCondition) then
strQuery := 'SELECT * FROM "' + strTable + '"'
else if Table1.FieldByName(strField).DataType = ftString then
strQuery := 'SELECT * FROM "' + strTable + '" t WHERE t.' + strWhere
else
strQuery := 'SELECT * FROM "' + strTable + '" t WHERE t.' + strWhere;
{ Create an instance of the browser form. }
frmQuery := TResultForm.Create(Application);
{ Use a resource protection block in case an exception is raised. This
ensures that the memory allocated for the Results form is released. }
try
with frmQuery do
begin
Screen.Cursor := crHourglass;
if Query1.Active then Query1.Close;
Query1.DatabaseName := strAlias; {set the alias the query poitns to}
Query1.SQL.clear; { empty existing SQL in the query }
Query1.SQL.Add(strQuery); { add query string to query object }
Query1.Active := True; { try to run the query }
Screen.Cursor := crDefault;
if Query1.Active then
begin
{ If the query didn't return any records, there's no point in
displaying the form. In that event, raise an exception. }
if Query1.RecordCount < 1 then
raise Exception.create('No records matched your criteria.
Please try again.' );
{ write a message to the browse form's status line }
if strField = '' then
Panel3.Caption := 'Now showing all records from ' + strTable
+ '...'
else
Panel3.Caption := 'Now showing '+ strTable +' where '+ strField
+' contains values equal to '+ strValue + '...';
{ show the form }
ShowModal;
end;
end;
finally
frmQuery.Free;
end;
end;
end.
unit RSLTFORM;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls, DB,
Forms, DBCtrls, DBGrids, DBTables, Buttons, Grids, ExtCtrls, Dialogs;
type
TResultForm = class(TForm)
DBGrid1: TDBGrid;
DBNavigator: TDBNavigator;
Panel1: TPanel;
DataSource1: TDataSource;
Panel2: TPanel;
Panel3: TPanel;
Query1: TQuery;
SpeedButton2: TSpeedButton;
Panel4: TPanel;
SpeedButton1: TSpeedButton;
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
end;
var
ResultForm: TResultForm;
implementation
{$R *.DFM}
procedure TResultForm.SpeedButton1Click(Sender: TObject);
begin
Close;
end;
procedure TResultForm.SpeedButton2Click(Sender: TObject);
var
strText: string; { Variable to hold display text }
iCounter: Integer; { Loop counter variable }
begin
{ Build a string containing the query }
strText := '';
for iCounter := 0 to Query1.SQL.Count - 1 do
strText := strText + Query1.SQL[iCounter];
{ Display the query text }
MessageDlg('The underlying query is: ' + #10 + #10 + strText,
mtInformation, [mbOK], 0 );
end;
end.
