17.5 sql编程实例　

我们在学习了sql程序的编写方法之后，我们便可以着手创建自己的应用程序了，通过创建应用程序我们对delphi的强大功能就会有更深刻的印象，同时会进一步全面掌握有关sql编程的知识，在本节中我们主要介绍两个例子，前一个例子主要是用静态的sql语句编程，后一个例子是用动态sql语句编程。　

17.5.1 设计简单的sql程序编辑器　

例17.1：在这个例子中，我们设计一个交互式的sql程序编辑器，在这个编辑器中，我们可以根据sql语言的语法规则，编写常用的sql命令，并通过单击编辑器中的有关的按钮，直接执行编写好的sql命令，sql命令的执行结果也会及时地通过一个tdbgrid部件显示出来。　

表17.3 sql编辑器中个主要部件的属性

━━━━━━━━━━━━━━━━━━━━

部 件 属 性 值

────────────────────

form1 caption=sql程序编辑器

dbgrid1 datasource=datasource1

button1 caption=执行(&e)

button2 caption=清除(&c)

button3 caption=退出(&x)

button3 kind=bkclose

memo1

datasource1 dataset=query1

query1 databasename=demos

━━━━━━━━━━━━━━━━━━━━

因为我们在设置query1的databasename属性时将其设置为demos，所以我们设计的这个sql程序编辑器只能对deoms中的数据库表进行操作。

单击按钮button1的事件处理过程代码为：

程序清单17.1

procedure tform1.button1click(sender:tobject);

begin

query1.close;

query1.sql.clear;

query1.sql.add(memo1.text);

query1.open;

end;

单击按钮button2的事件处理过程为：

程序清单17.2

procedure tform1.button2click(sender:tobject);

begin

query1.close;

query1.sql.clear;

query1.excesql;

end;

下面我们对程序清单17.1和程序清单17.2中的程序代码进行简要的分析：

程序清单17.1中的程序代码是用来执行查询的。

query1.close;

这一行程序是用来关闭query1的，我们在前面的章节中介绍过，只有在调用close方法将tquery部件关闭之后，才能修改其sql属性值，执行close命令关闭查询是很安全的，如果查询已经被关闭了，调用该方法不会产生任何影响。

query1.sql.clear;

因为tquery部件的sql属性只能包含一条sql语句，调用clear方法的目的是为了清除sql属性原来的属性值即原来的sql命令语句，如果不调用clear方法清除原来的sql命令语句，当在后面的程序中调用add方法为sql属性设置新的sql命令语句时，delphi会将新的sql命令语句加在原来的sql命令语句，这样使得sql属性中包含两条独立的sql语句，这是不允许的。

query1.sql.add(memo.text);

该条命令是将sql编辑器的编辑区内的内容(tmemo部件memo1)设置成query1的sql属性值。

query1.open;

该语句用来执行query1中的sql命令语句，如果执行查询从数据库中获得查询结果，查询结果会在数据网格dbgrid1中显示出来。

程序清单２是用来清除查询的，其前两行语句跟程序清单１中的代码是一样的。query1.execsql有一些特别，调用execsql方法也是打开query1，execsql方法与open方法不一样的，请参看前面的章节，当query1中sql属性值为空时，即没有sql语句时，只能调用execsql方法来打开query1，如果调用open 方法会返回一个错误。 在执行完 query1.execsql语句之后，应用程序将会清除数据网格dbgrid1中的所有内容。　

17.5.2 设计一个数据库查询器　

例17.2：在数据库查询器中，用户可以选择要查询的数据库，查询数据库中的那一个表、根据数据库表中那一个字段进行查询，并且可以方便地指定查询条件，指定查询条件主要包括指定逻辑运算符(=、>、<、<=、>=、like、in、notlike、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.