第十四章 剖析几个MIDAS示范程序
MIDAS是Multi-Tier Distributed Application Services Suite的简称，为Delphi 4的一个关键技术。对于初学者来说，MIDAS具有相当的难度，因此，这一章详细剖析几个MIDAS示范程序，以帮助读者理解和掌握MIDAS技术。
与一般的数据库应用程序不同的是，只有当应用服务器正在运行的情况下，才能打开、编译和运行“瘦”客户程序的项目。
14.1 一个ActiveForm的例子
Delphi 4可以把分布式的数据库结构引申到Internet/Intranet上，把“瘦”客户程序作为ActiveForm嵌入到网页中让人们下载，然后在当地执行。
这一节剖析一个ActiveForm的示范程序，项目名称叫empeditx，它可以在C:/Program Files/Borland/Delphi4/Demos/Midas/Activefm目录中找到。它的主窗体如图14.1所示。
在打开这个项目之前，先要编译、运行位于C:/ProgramFiles/Borland/Delphi4/Demos/ Midas/Empedit目录中的Server项目，这是个应用服务器，如图14.2所示。
这里还要交代一下，在应用服务器上，用一个TQuery构件引入数据集，它的SQL语句如下：
Select * From Employee
在这个ActiveForm上，有一个TDCOMConnection构件，用于以DCOM方式连接应用服务器，它的ServerName属性设为Serv.EmpServer，它的ServerGUID设为{53BC6562-5B3E-11D0-9FFC-00A0248E4B9A}。
ActiveForm用TClientDataSet构件从应用服务器引入数据集，它的RemoteServer属性设为MidasConnection即TDCOMConnection构件的名称，它的ProviderName属性设为EmpQuery即应用服务器上的TQuery构件，由它来提供IProvider接口。
ActiveForm上有几个数据控件，用于显示数据，它们都通过一个TDataSource构件获得数据。此外，ActiveForm上还有一个TDBNavigator构件，用于浏览数据集。
由于本节要介绍的示范程序是一个ActiveForm，它的大部分代码与类型库有关，我们只把其中涉及到MIDAS技术的部分“拎”出来。
当用户单击ActiveForm上的“Get Employees”按钮时，就从应用服务器检索数据。每次检索到的记录数取决于TClientDataSet构件的PacketRecords属性。
Procedure TEmpEditForm.QueryButtonClick(Sender: TObject);
Begin
Employees.Close;
{ Employees是TClientDataSet构件的名称}E
mployees.Open;
End;
当用户单击ActiveForm上的“Update Employees”按钮时，把用户对数据的修改写到数据集中。
Procedure TEmpEditForm.UpdateButtonClick(Sender: TObject);
Begin
Employees.ApplyUpdates(-1);
End;
当用户单击ActiveForm上的“Undo Last Change”按钮时，取消用户对数据的修改。
Procedure TEmpEditForm.UndoButtonClick(Sender: TObject);
Begin
Employees.UndoLastChange(True);
End;
为了测试这个ActiveForm，首先需要把它发布到Web服务器上，供下载用。为此，要使用“Project”菜单上的“Web Deployment Options”命令设置有关Web发布的选项，主要是指定ActiveForm在Web服务器上的URL。然后使用“Project”菜单上的“WebDeploy”命令把ActiveForm发布到Web服务器上。
14.2 一个动态传递SQL语句的示范程序
这一节要剖析一个动态传递SQL语句的示范程序，可以在C:/Program Files/Borland/Delphi4/Demos/Midas/Adhoc目录中找到。
这个程序分为应用服务器和客户程序两个部分。当客户程序通过IProvider接口调用DataRequest请求数据时，把用户输入的SQL语句传递给应用服务器，这样，应用服务器上的TQuery构件就能够根据用户的要求来查询数据库，这就是本示范程序的基本思路。
先来剖析应用服务器，看它的数据模块，如图14.3所示。
图14.3 数据模块
数据模块上有这么几个构件：
一个TSession构件，它的SessionName属性设为Session1_2。
一个TDatabase构件，它的SessionName属性设为Session1_2，并且定义了一个专用的别名叫ADHOC。
一个TQuery构件，它的DatabaseName属性设为ADHOC，它的SessionName属性也设为Session1_2，而它的SQL属性为空，因为SQL语句由客户程序动态地传递过来。
一个TProvider构件，它的DataSet属性设为AdHocQuery即TQuery构件的名称。
现在我们暂时不管数据模块，再来看看应用服务器的主窗体，如图14.4所示。
图14.4 应用服务器的主窗体
主窗体上显示两个计数，一个是当前连接应用服务器的客户数(Clients)，另一个是已经执行的查询次数(Queries)。
用什么来判断当前的客户数，这与数据模块的实例方式有关。我们可以回到数据模块的单元，看看它的初始化代码：
Initialization
TComponentFactory.Create(ComServer, TAdHocQueryDemo,
Class_AdHocQueryDemo, ciMultiInstance);
End.
可以看出，这个数据模块的实例方式设为ciMultiInstance，表示每当有一个客户连接应用服务器，就会创建数据模块的一个新的实例。因此，数据模块的实例数就是当前的客户数。怎样统计数据模块的实例数呢？很简单，只要处理数据模块的OnCreate事件。
Procedure TAdHocQueryDemo.AdHocQueryDemoCreate(Sender: TObject);
Begin
MainForm.UpdateClientCount(1);
End;
当一个客户退出连接时，将删除一个数据模块的实例，此时将触发数据模块的OnDestroy事件：
Procedure TAdHocQueryDemo.AdHocQueryDemoDestroy(Sender: TObject);
Begin
MainForm.UpdateClientCount(-1);
End;
其中，UpdateClientCount函数是在主窗体的单元中定义的：
Procedure TMainForm.UpdateClientCount(Incr: Integer);
Begin
FClientCount := FClientCount + Incr;
ClientCount.Caption := IntToStr(FClientCount);
End;
请读者注意Incr参数的作用。怎样统计已经执行过的查询数呢？很简单，只要统计TQuery构件被激活的次数就可以了。因此，程序处理了TQuery构件的AfterOpen事件。Procedure TAdHocQueryDemo.AdHocQueryAfterOpen(DataSet: TDataSet);
Begin
MainForm.IncQueryCount;
End;
IncQueryCount是在主窗体的单元中定义的：
Procedure TMainForm.IncQueryCount;
Begin
Inc(FQueryCount);
QueryCount.Caption := IntToStr(FQueryCount);
End;
在打开客户程序的项目之前，必须先编译和运行应用服务器的项目。好，现在我们打开客户程序的项目，它的主窗体如图14.5所示。
这个客户程序用一个TDCOMConnection构件连接应用服务器，它的ServerName属性设为Serv.AdHocQueryDemo。客户程序用TClientDataSet构件从应用服务器引入数据集，它的RemoteServer属性设为TDCOMConnection构件的名称，它的ProviderName属性设为AdHocQuery，这是应用服务器输出的 IProvider接口。
客户程序上有一个栅格，用于显示数据，栅格与数据集之间通过TDataSource构件连接。此外，客户程序上有一个多行文本编辑器，让用户输入SQL语句。有一个组合框用于选择要访问的数据库。我们还是先从处理OnCreate事件的句柄开始。
Procedure TForm1.FormCreate(Sender: TObject);
var I: Integer;DBNames: OleVariant;
Begin
RemoteServer.Connected := True;
DBNames := RemoteServer.AppServer.GetDatabaseNames;
If VarIsArray(DBNames) then
For I := 0 to VarArrayHighBound(DBNames, 1) Do
DatabaseName.Items.Add(DBNames[I]);
DatabaseNameClick(Self);
End;
首先，把TDCOMConnection构件的Connected属性设为True，将连接应用服务器。TDCOMConnection构件的AppServer属性将返回应用服务器上数据模块的接口，通过此接口就可以调用远程数据模块的方法，例如GetDatabaseNames。GetDatabaseNames是在应用服务器的数据模块单元中定义的：
Function TAdHocQueryDemo.GetDatabaseNames: OleVariant;
var I: Integer;
DBNames: TStrings;
Begin
DBNames := TStringList.Create;
Try
Session1.GetDatabaseNames(DBNames);
Result := VarArrayCreate([0, DBNames.Count - 1], varOleStr);
For I := 0 to DBNames.Count - 1 DoResult[I] := DBNames[I];
FinallyDBNames.Free;
End;
End;
GetDatabaseNames函数的作用是返回一个数组，该数组由所有已定义的别名和BDE会话期对象专用的别名组成。现在我们回到客户程序中，调用了数据模块的GetDatabaseNames函数后，就把检索到别名加到窗体右上角的组合框中，然后调用DatabaseNameClick函数。
Procedure TForm1.DatabaseNameClick(Sender: TObject);
var Password: string;
Begin
If DatabaseName.Text <> '' then
Begin
ClientData.Close;
Try
RemoteServer.AppServer.SetDatabaseName(DatabaseName.Text, '');
Except
On E: Exception DoIf E.Message = 'Password Required' then
Begin
If InputQuery(E.Message, 'Enter password', Password) then
RemoteServer.AppServer.SetDatabaseName(DatabaseName.Text, Password);
End
Else
Raise;
End;
End;
End;
调用DatabaseNameClick的目的是使应用服务器与另一个数据库连接，这就需要通过AppServer属性获得数据模块的接口，然后调用数据模块单元的SetDatabaseName。SetDatabaseName是在应用服务器的数据模块单元中定义的：
Procedure TAdHocQueryDemo.SetDatabaseName(const DBName, Password: WideString);
Begin
Try
Database1.Close;
Database1.AliasName := DBName;
If Password <> '' then
Database1.Params.Values['PASSWORD'] := Password;
Database1.Open;
Except
{如果数据库打开失败，很可能是因为该数据库需要口令}
On E: EDBEngineError DoIf (Password = '') then Raise Exception.Create('Password Required')Else
Raise;
End;
End;
SetDatabaseName的作用是修改TDatabase构件的AliasName属性，然后连接新的数据库，如果失败，就触发一个异常。在客户程序的DatabaseNameClick过程中，如果出现异常，就弹出一个输入框，让用户输入口令，然后再次调用数据模块的SetDatabaseName。
当用户在“Query”框中输入了SQL语句，就可以单击“Run Query”按钮执行这个查询。问题是，只有应用服务器才可以执行查询，那么客户程序是怎样把SQL语句传递给应用服务器的呢？这就是本示范程序的关键之处。
Procedure TForm1.RunButtonClick(Sender: TObject);
Begin
ClientData.Close;
ClientData.Provider.DataRequest(SQL.Lines.Text);
ClientData.Open;
End;
原来，客户程序通过IProvider接口调用DataRequest把用户输入的SQL语句传递给应用服务器。客户程序通过IProvider接口调用DataRequest将在应用服务器端触发OnDataRequest事件，我们来看看应用服务器是怎样处理OnDataRequest事件的。
Function TAdHocQueryDemo.AdHocProviderDataRequest(Sender: TObject; Input: OleVariant): OleVariant;
Begin
AdHocQuery.SQL.Text := Input;
End;
至此，一个动态传递SQL语句的示范程序剖析完毕，请读者仔细琢磨其中的编程技巧。实际上，通过IProvider接口调用DataRequest可以传递任何信息。
14.4 一个全面演示TClientDataSet功能的示范程序
这一节介绍一个演示TClientDataSet功能的示范程序，项目名称叫Alchtest，它可以在C:/Program Files/Borland/Delphi4/Demos/Midas/Alchtest目录中找到，主窗体如图14.6所示。
这个程序的总体思路是，用一个多页控件让用户修改TClientDataSet的属性或者调用它的方法，然后在下面的TAB控件中演示修改后的效果。
程序首先在处理OnCreate事件的句柄中做了一些初始化的工作。
Procedure TDBClientTest.FormCreate(Sender: TObject);
var I: Integer;
Begin
Database1.Close;
FMaxErrors := -1;
FPacketRecs := -1;
SetCurrentDirectory(PChar(ExtractFilePath(ParamStr(0))));
For I := 0 to StatusBar.Panels.Count - 1 do
StatusBar.Panels[I].Text := '';
Application.OnIdle := ShowHeapStatus;
Application.OnHint := OnHint;
StreamSettings(False);
SetEventsVisible(ViewEvents.Checked);
End;
其中，指定ShowHeapStatus作为处理应用程序的OnIdle事件的句柄，指定OnHint作为处理应用程序的OnHint事件的句柄。ShowHeapStatus是这样定义的：
Procedure TDBClientTest.ShowHeapStatus(Sender: TObject; var Done: Boolean);
Begin
Caption := Format('Client DataSet Test Form - (Blocks=%d Bytes=%d)',[AllocMemCount, AllocMemSize]);
End;
ShowHeapStatus的作用是在应用程序空闲的时候，在主窗口的标题栏显示堆的状态，其中，AllocMemCount是当前分配的内存块数，AllocMemSize是当前分配的内存总长度。
OnHint是这样定义的：
Procedure TDBClientTest.OnHint(Sender: TObject);
Begin
StatusMsg := Application.Hint;
End;
StatusMsg是一个自定义的属性，用于表达要在状态栏上显示的提示信息。
在处理OnCreate事件的句柄中还调用了StreamSettings函数。StreamSettings是非常有用的，当窗体关闭时，就调用StreamSettings把窗体上一些控件的状态保存到一个配置文件中。当窗体弹出时，就调用StreamSettings读取配置文件以初始化窗体上的控件。
Procedure TDBClientTest.StreamSettings(Write: Boolean);
Procedure WriteStr(const OptName, Value: string);
Begin
FConfig.WriteString('Settings', OptName, Value);
End;
Procedure WriteBool(const OptName: string; Value: Boolean);
Begin
FConfig.WriteBool('Settings', OptName, Value);
End;
Function ReadStr(const OptName: string): string;
Begin
Result := FConfig.ReadString('Settings', OptName, '');
End;
Function ReadBool(const OptName: string): Boolean;
Begin
Result := FConfig.ReadBool('Settings', OptName, False);
End;
Function FindPage(const PageName: string): TTabSheet;
var I: Integer;
Begin
For I := AreaSelector.PageCount - 1 downto 0 do
Begin
Result := AreaSelector.Pages[I];
If Result.Caption = PageName then Exit;
End;
Result := ProviderPage;
End;
Procedure ProcessComponents(Components: array of TComponent);
varI: Integer;
Begin
If Write then
Begin
For I := Low(Components) to High(Components) Do
If Components[I] is TCustomEdit then
With TEdit(Components[I]) do WriteStr(Name, Text)
Else if Components[I] is TComboBox then
With TDBComboBox(Components[I]) do WriteStr(Name, Text)
Else if Components[I] is TCheckBox then
With TCheckBox(Components[I]) do WriteBool(Name, Checked)
Else if Components[I] is TAction then
With TAction(Components[I]) do WriteBool(Name, Checked)
Else if Components[I] is TPageControl then
With TPageControl(Components[I]) doWriteStr(Name,ActivePage.Caption);
End;
Else
Begin
For I := Low(Components) to High(Components) do
If Components[I] is TCustomEdit then
With TEdit(Components[I]) do Text := ReadStr(Name)
Else if Components[I] is TComboBox then
With TComboBox(Components[I]) do Text := ReadStr(Name)
Else if Components[I] is TCheckBox then
With TCheckBox(Components[I]) do Checked := ReadBool(Name)
Else if Components[I] is TAction then
With TAction(Components[I]) do Checked := ReadBool(Name)
Else if Components[I] is TPageControl then
With TPageControl(Components[I]) doActivePage := FindPage(ReadStr(Name));
End;
End;
Begin
GetConfigFile;
If not Write and (ReadStr('AreaSelector') = '') then Exit;
ProcessComponents([AreaSelector, DatabaseName, MasterTableName,DetailTableName, MasterSQL, DetailSQL, poCascadedDeletes, poCascadedUpdates,poDelayedDetails, poDelayedBlobs, poIncludeFieldProps, poReadOnly,DisableProvider, ObjectView, SparseArrays, MixedData, FetchOnDemand,DisableProvider, ResolveToDataSet, DataRows, CreateDataSetDesc,EnableBCD, RequestLiveQuery, ViewEvents, DisplayDetails, IncludeNestedObject]);
End;
StreamSettings用Write参数来区分现在是要读还是写。StreamSettings中又嵌套了几个过程和函数，其中，WriteStr、WriteBool、ReadStr、ReadBool分别用于在配置文件中存取字符串和布尔类型的信息，FindPage函数搜索并返回一个特定的对象，而ProcessComponents则用于存取与具体构件有关的信息。
GetConfigFile函数用于创建一个TIniFile对象的实例(如果还没有创建的话)。
Function TDBClientTest.GetConfigfile: TIniFile;
Begin
If FConfig = nil Then
FConfig := TIniFile.Create(ChangeFileExt(ParamStr(0), '.INI'));
Result := FConfig;
End;
请读者注意StreamSettings是怎样调用ProcessComponents函数的。ProcessComponents需要传递一个数组，数组中的元素就是窗体上的一些控件的名称。
我们先翻到“Provider”页，看看怎样指定数据库和建立Master/Detail关系，如图14.7所示。
图14.7 “Provider”页
“Database”框用于指定要访问的数据库。当用户下拉此框时，将触发OnDropDown事件。如果此时“Database”框还是空的话，就调用TSession的GetDatabaseNames函数把所有已定义的BDE别名和专用的别名填到“Database”框中。
Procedure TDBClientTest.DatabaseNameDropDown(Sender: TObject);
Begin
If DatabaseName.Items.Count = 0 then
Session.GetDatabaseNames(DatabaseName.Items);
End;
当用户在“Database”框中选择一个别名，将触发OnClick事件。此时，就调用CheckDatabase连接另一个数据库。由于数据库已改变，“Master/DetailTables”框内的内容应当清掉。
Procedure TDBClientTest.DatabaseNameClick(Sender: TObject);
Begin
If (DatabaseName.Text <> '') and not DatabaseName.DroppedDown then
Begin
CheckDatabase(True);
MasterTableName.Items.Clear;
MasterTableName.Text := '';
DetailTableName.Text := '';
ClientData.Close;
End;
End;
用户也可以直接在“Database”框键入一个数据库别名，然后按Enter键，此时将触发OnKeyPress事件。
Procedure TDBClientTest.DatabaseNameKeyPress(Sender: TObject; var Key: Char);
Begin
If Key = #13 then
Begin
If DatabaseName.DroppedDown then
DatabaseName.DroppedDown := False;
DatabaseNameClick(Sender);Key := #0;
End;
End;
好，现在让我们看看CheckDatabase是怎样定义的：
Procedure TDBClientTest.CheckDatabase(CloseFirst: Boolean);
var SPassword, SUserName: string;
Begin
If not CloseFirst and Database1.Connected and(Database1.AliasName = DatabaseName.Text) then Exit;
Database1.Close;
Database1.AliasName := DatabaseName.Text;
Session.GetAliasParams(Database1.AliasName, Database1.Params);
If Database1.Params.IndexOfName('PATH') = -1 then
Begin
SPassword := ConfigFile.ReadString('Passwords', Database1.AliasName, '');
If SPassword = '' then
Begin
SUserName := Database1.Params.Values['USER NAME'];
If not LoginDialog('DatabaseName.Text', SUserName, SPassword) then Exit;
Database1.Params.Values['USER NAME'] := SUserName;
End;
Database1.Params.Values['PASSWORD'] := SPassword;
End;
If EnableBCD.Checked then Database1.Params.Add('ENABLE BCD=TRUE');
Database1.Open;
If Database1.IsSQLBased and (SPassword <> '') thenConfigFile.WriteString('Passwords', Database1.AliasName, SPassword);
End;
CheckDatabase用于连接一个用户指定的数据库。如果当前连接的就是用户指定的数据库，CheckDatabase就什么也不干。如果不是的话，首先要调用TDatabase构件的Close断开与数据库的连接，然后把TDatabase构件的AliasName 属性设为用户选择的别名，并调用BDE会话期对象的GetAliasParams取出这个别名的参数。
注意，对于本地数据库来说，只有一个PATH参数，而对于SQL数据库来说，参数就有好几个，因此，可以用有没有PATH参数来区分本地数据库和SQL数据库。如果是SQL数据库的话，就要设置USER NAME和PASSWORD参数给出用户名和口令。如果“Settings”菜单上的“EnableBCD”命令被选中的话，就增加一个ENABLE BCD参数，并把它的值设为TRUE。然后调用Open重新连接数据库。
这个程序还能够让客户选择“Master/Detail”关系中的Master表和Detail表，这是在“Master/Detail Tables”框中选择的，其中，上面一个组合框用于选择Master表，下面一个组合框用于选择Detail表。当用户在组合框中选择一个表，将触发OnClick事件。
Procedure TDBClientTest.MasterTableNameClick(Sender: TObject);
Begin
With Sender as TComboBox Do
If not DroppedDown and (MasterTable.TableName <> Text) then OpenTable.Execute;
End;
当用户下拉“Master/Detail Tables”框中的一个组合框，将触发OnDropDown事件。此时就调用BDE会话期对象的GetTableNames把当前数据库中的所有表格的名称填到组合框中，供用户选择。
Procedure TDBClientTest.MasterTableNameDropDown(Sender: TObject);
Begin
CheckDatabase(False);
With Sender as TComboBox do
If (Items.Count < 1) and (Database1.AliasName <> '') then
Session.GetTableNames(Database1.DatabaseName, '', True, False, Items);
End;
用户也可以直接在“Master/Detail Tables”框中的一个组合框内键入一个表格的名称，然后按Enter键，此时将触发OnKeyPress事件。
Procedure TDBClientTest.MasterTableNameKeyPress(Sender: TObject; var Key: Char);
Begin
If Key = #13 then
Begin
With Sender as TComboBox Do
If DroppedDown then DroppedDown := False;
OpenTable.Execute;
Key := #0;
End;
End;
注意：上面都是以选择Master表的组合框为例的，实际上，选择Detail表的操作完全一样，代码如下。
Procedure TDBClientTest.DetailTableNameClick(Sender: TObject);
Begin
With Sender as TComboBox Do
If not DroppedDown and (DetailTable.TableName <> Text) then
OpenTable.Execute;
End;
在上面几个事件句柄中，OpenTable是一个动作列表，这是Delphi 4新增加的功能。在窗体上双击TActionList构件，将打开一个如图14.8所示的编辑器。
图14.8 动作列表编辑器
在这个编辑器中找出OpenTable这个动作，然后在对象观察器中可以发现， 执行这个动作的代码是OpenTableExecute函数。
Procedure TDBClientTest.OpenTableExecute(Sender: TObject);
Begin
ClearEventLog.Execute;
If MasterTableName.Text <> '' then OpenDataSet(MasterTable);
End;
而OpenDataSet是这样定义的：
Procedure TDBClientTest.OpenDataSet(Source: TDBDataSet);
Begin
Screen.Cursor := crHourGlass;
Try
ClientData.Data := Null;
Source.Close;
If not DisableProvider.Checked then
Begin
BDEProvider.DataSet := Source;
SetProviderOptions;
ClientData.ProviderName := BDEProvider.Name;
ActiveDataSet := ClientData;
End
Else
ActiveDataSet := Source;
MasterGrid.SetFocus;
StatusMsg := 'Dataset Opened';
FinallyScreen.Cursor := crDefault;
End;
StreamSettings(True);
End;
OpenDataSet通过一个叫DisableProvider的复选框来决定是否使用TProvider构件。如果没有选中“Disable Provider”这个复选框，表示使用TProvider构件，此时就把TProvider构件的DataSet属性设为MasterTable，然后调用SetProviderOptions来设置TProvider构件的选项，接着设置TClientDataSet构件的ProviderName属性指定这个TProvider构件，最后把ActiveDataSet变量设为此TClientDataSet构件。如果用户选中“Disable Provider”复选框，表示不使用TProvider构件，此时就直接把ActiveDataSet设为MasterTable。
SetProviderOptions是这样定义的：
Procedure TDBClientTest.SetProviderOptions;
var Opts: TProviderOptions;
Begin
Opts := [];If poDelayedDetails.Checked then
Include(Opts, poFetchDetailsOnDemand);
if poDelayedBlobs.Checked then Include(Opts, poFetchBlobsOnDemand);
if poCascadedDeletes.Checked then Include(Opts, poCascadeDeletes);
if poCascadedUpdates.Checked then Include(Opts, poCascadeUpdates);
if poReadOnly.Checked then Include(Opts, Provider.poReadOnly);
if poIncludeFieldProps.Checked then Include(Opts, poIncFieldProps);
BDEProvider.Options := Opts;
End;
SetProviderOptions实际上是根据“Settings”菜单上的“Provider Options”命令的一些子命令是否被选中来设置TProvider构件的Options属性。这个程序还可以让用户在“Master/Detail Queries”框中输入SQL语句。当用户输入了SQL语句并且按下Enter键，将触发OnKeyPress事件。
Procedure TDBClientTest.MasterSQLKeyPress(Sender: TObject; var Key: Char);
Begin
If Key = #13 then
Begin
OpenQuery.Execute;
Key := #0;
End;
End;
其中，OpenQuery也是一个动作，执行它的是OpenQueryExecute函数。OpenQueryExecute是这样定义的：
Procedure TDBClientTest.OpenQueryExecute(Sender: TObject);
Begin
If UpperCase(Copy(MasterSQL.Text, 1, 6)) = 'SELECT' then
OpenDataSet(MasterQuery)
Else
Begin
CheckDatabase(False);
MasterQuery.RequestLive := True;
MasterQuery.SQL.Text := MasterSQL.Text;
MasterQuery.ExecSQL;
StatusMsg := Format('%d rows were affected', [MasterQuery.RowsAffected]);
End;
Events.Items.
Begin
Update;
Try
Events.Clear;
Finally
Events.Items.EndUpdate;
End;
End;
OpenQueryExecute首先判断用户输入的SQL语句是否为SELECT。如果是的话，就调用OpenDataSet执行SELECT语句。如果不是的话，就调用ExecSQL执行SQL语句。
当用户翻到“Fields”页，将触发FieldsPage(TTabSheet对象)的OnShow事件，此时就把数据集中的字段和字段定义对象名称分别显示在两个多行文本编辑器中，如图14.9所示。
图14.9 “Fields”页
Procedure TDBClientTest.FieldsPageShow(Sender: TObject);
Procedure WriteFullNames(Fields: TFields);
var I: Integer;
Begin
For I := 0 to Fields.Count - 1 Do
With Fields[I] Do
Begin
FieldList.Lines.Add(Format('%d) %s', [FieldNo, FullName]));
If Fields[I].DataType in [ftADT, ftArray] then
WriteFullNames(TObjectField(Fields[I]).Fields);
End;
End;
Procedure WriteLists(DataSet: TDataSet);
var I: Integer;
Begin
FieldList.Clear;
For I := 0 to DataSet.FieldList.Count - 1 Do
With DataSet.FieldList Do
FieldList.Lines.Add(Format('%d) %s', [Fields[I].FieldNo, Strings[I]]));
FieldDefList.Clear;
DataSet.FieldDefs.Updated := False;
DataSet.FieldDefList.Update;
For I := 0 to DataSet.FieldDefList.Count - 1 Do
With DataSet.FieldDefList Do
FieldDefList.Lines.Add(Format('%d) %s', [FieldDefs[I].FieldNo, Strings[I]]));
End;
var DataSet: TDataSet;
Begin
DataSet := DBNavigator1.DataSource.DataSet;
If Assigned(DataSet) and DataSet.Active then
Begin
WriteLists(DataSet)
End
Else
Begin
CheckDatabase(False);
MasterTable.TableName := MasterTableName.Text;
WriteLists(MasterTable);
End;
End;
首先要说明的是，FieldsPageShow中嵌套了WriteFullNames，其实WriteFullNames完全是多余的。FieldsPageShow先获取当前的数据集。如果当前的数据集已打开的话，就调用WriteLists显示字段对象和字段定义对象的列表。如果当前数据集没有打开，就显示MasterTable中的字段对象和字段定义对象的列表。当用户翻到“Indexes”页，将触发IndexPage(TTabSheet对象)的OnShow事件，此时就把当前数据集中的索引列出来，用户也可以创建新的索引或者删除一个索引。“Indexes”页如图14.10所示。
图14.10 “Indexes”页
Procedure TDBClientTest.IndexPageShow(Sender: TObject);
Begin
If not Assigned(ActiveDataSet) or not ActiveDataSet.Active then
OpenTable.Execute;
RefreshIndexNames(0);
End;
IndexPageShow首先检查当前是否打开了一个数据集，如果没有，就执行OpenTable的代码即打开数据集，然后调用RefreshIndexNames函数列出所有的索引名称。
Procedure TDBClientTest.RefreshIndexNames(NewItemIndex: Integer);
var I: Integer;
IndexDefs: TIndexDefs;
Begin
IndexList.Clear;
If ActiveDataSet = MasterTable then
IndexDefs := MasterTable.IndexDefs
Else
IndexDefs := ClientData.IndexDefs;
IndexDefs.Update;
For I := 0 to IndexDefs.Count - 1 Do
If IndexDefs[I].Name = '' then IndexList.Items.Add('')
Else
IndexList.Items.Add(IndexDefs[I].Name);
If IndexList.Items.Count > 0 then
Begin
If NewItemIndex < IndexList.Items.Count then
IndexList.ItemIndex := NewItemIndex
ElseIndexList.ItemIndex := 0;
ShowIndexParams;
End;
End;
RefreshIndexNames又调用ShowIndexParams检索索引的选项，用这些选项来初始化“Indexes”页上的几个编辑框和复选框。
Procedure TDBClientTest.ShowIndexParams;varIndexDef: TIndexDef;
Begin
If ActiveDataSet = MasterTable then
IndexDef := MasterTable.IndexDefs[IndexList.ItemIndex]
Else
IndexDef := ClientData.IndexDefs[IndexList.ItemIndex];
idxCaseInsensitive.Checked := ixCaseInsensitive in IndexDef.Options;idxDescending.Checked := ixDescending in IndexDef.Options;idxUnique.Checked := ixUnique in IndexDef.Options;idxPrimary.Checked := ixPrimary in IndexDef.Options;IndexFields.Text := IndexDef.Fields;
DescFields.Text := IndexDef.DescFields;
CaseInsFields.Text := IndexDef.CaseInsFields;
End;
如果用户在列表框中选择了另一个索引，就应当相应地刷新这些选项。Procedure TDBClientTest.IndexListClick(Sender: TObject);
Begin
If ActiveDataSet = MasterTable then
MasterTable.IndexName := MasterTable.IndexDefs[IndexList.ItemIndex].Name
Else
ClientData.IndexName := ClientData.IndexDefs[IndexList.ItemIndex].Name;
ShowIndexParams;
End;
如果要创建一个新的索引，用户必须事先设置索引的选项，然后单击“CreateIndex”按钮。
Procedure TDBClientTest.CreateIndexClick(Sender: TObject);
var IndexName: string;Options: TIndexOptions;
Begin
IndexName := Format('Index%d', [IndexList.Items.Count+1]);
If InputQuery('Create Index', 'Enter IndexName:', IndexName) then
Begin
Options := [];
If idxCaseInsensitive.Checked then Include(Options, ixCaseInsensitive);
If idxDescending.Checked then Include(Options, ixDescending);
If idxUnique.Checked then Include(Options, ixUnique);
If idxPrimary.Checked then Include(Options, ixPrimary);
If ActiveDataSet = MasterTable then
Begin
MasterTable.Close;
MasterTable.AddIndex(IndexName,IndexFields.Text,Options,DescFields.Text);
MasterTable.Open;
End
Else
ClientData.AddIndex(IndexName, IndexFields.Text, Options,DescFields.Text, CaseInsFields.Text);
StatusMsg := 'Index Created';
RefreshIndexNames(IndexList.Items.Count);
End;
End;
CreateIndexClick首先弹出一个输入框，让用户输入索引名称，然后根据用户设置的选项来设置索引的Options属性。
在调用AddIndex之前，首先要区分当前的数据集是MasterTable还是ClientData，为什么要区分MasterTable和ClientData呢？因为对于一般的数据集构件来说，在创建索引之前必须先关闭数据集，而对于TClientDataSet构件来说，则不必先关闭数据集。
用户也可以先选择一个索引，然后单击“Delete Index”按钮删除这个索引。
Procedure TDBClientTest.DeleteIndexClick(Sender: TObject);
Begin
If IndexList.ItemIndex > -1 then
If ActiveDataSet = MasterTable then
Begin
MasterTable.Close;
MasterTable.DeleteIndex(MasterTable.IndexDefs[IndexList.ItemIndex].Name);
MasterTable.Open;
End
Else
ClientData.DeleteIndex(ClientData.IndexDefs[IndexList.ItemIndex].Name);
End;
与调用AddIndex一样，在调用DeleteIndex之前，首先要区分当前的数据集是MasterTable还是ClientData。当用户翻到“Filters”页，就可以设置过滤条件，如图14.11所示。
图14.11 “Filters”页
当“Filters”页刚刚打开的时候，将触发OnShow事件，这样就可以初始化“Filter”框。这里运用了一个编程技巧，先从下面的栅格中取出一个字段，然后判断这个字段的数据类型是不是ftString、ftMemo或ftFixedChar中的一种，如果是的话，过滤条件表达式的运算符后面的值要用引号括起来。
Procedure TDBClientTest.FilterPageShow(Sender: TObject);
var Field: TField;LocValue,QuoteChar: String;
Begin
If (Filter.Text = '') and Assigned(ActiveDataSet) and ActiveDataSet.Active then
Begin
Field := MasterGrid.SelectedField;If Field = nil then Exit;
With ActiveDataSet DoTryDisableControls;
MoveBy(3);
LocValue := Field.Value;
First;
Finally
EnableControls;
End;
If Field.DataType in [ftString, ftMemo, ftFixedChar] then
QuoteChar := ''''
Else QuoteChar := '';
Filter.Text := Format('%s=%s%s%1:s', [Field.FullName, QuoteChar, LocValue]);
End;
End;
用户可以在“Filter”框内键入新的过滤条件，当用户按下Enter键或把输入焦点移走，就会把用户输入的过滤条件表达式赋给当前数据集的Filter属性。当用户翻到“FindKey”页，就可以输入一个键值，然后在数据集中搜索特定的记录，如图14.12所示。
图14.12 “FindKey”页
当用户单击“Find Key”或“Find Nearest”按钮，就开始搜索特定的记录。
Procedure TDBClientTest.FindKeyClick(Sender: TObject);
Begin
If ActiveDataSet = ClientData then
With ClientData Do
Begin
SetKey;IndexFields[0].AsString := FindValue.Text;
KeyExclusive := Self.KeyExclusive.Checked;If FindPartial.Checked then KeyFieldCount := 0;
If Sender = Self.FindNearest then GotoNearest else
If not GotoKey then StatusMsg := 'Not found';
End
Else
if ActiveDataSet = MasterTable then
With MasterTable Do
Begin
SetKey;
IndexFields[0].AsString := FindValue.Text;
KeyExclusive := Self.KeyExclusive.Checked;
If FindPartial.Checked then KeyFieldCount := 0;
If Sender = Self.FindNearest then GotoNearest
Else
if GotoKey thenStatusMsg := 'Record Found'
Else StatusMsg := 'Not found';
End;
End;
首先，要区分当前数据集是ClientData还是MasterTable，调用SetKey使数据集进入dsSetKey状态，把用户输入的键值赋给索引中的第一个字段。然后根据Sender参数判断用户按下的是“Find Key”按钮还是“Find Nearest”按钮，如果是后者，就调用GotoNearest，如果是前者，就调用GotoKey，最后根据GotoKey的返回值显示有关信息。
当用户翻到“Locate”页，将触发LocatePage(TTabSheet对象)的OnShow事件，程序就把下面的栅格中选择的字段作为关键字段。“Locate”页如图14.13所示。
图14.13 “Locate”页
Procedure TDBClientTest.LocatePageShow(Sender: TObject);
var Field: TField;
Begin
If (ActiveDataSet <> nil) and ActiveDataSet.Active then
BeginField := MasterGrid.SelectedField;
If LocateField.Items.Count = 0 then
LocateFieldDropDown(LocateField);
If (LocateField.Text = '')or(LocateField.Items.IndexOf(Field.FieldName) < 1) then
LocateField.Text := Field.FieldName;
With ActiveDataSet Do
Try
DisableControls;
MoveBy(3);
LocateEdit.Text := Field.Value;
First;
Finally
EnableControls;
End;
End;
End;
用户也可以在“Field”框选择一个关键字段。当用户下拉“Field”框时，触发OnDropDown事件，这样就可以把当前数据集中的字段显示到“Field”框中。
Procedure TDBClientTest.LocateFieldDropDown(Sender: TObject);
Begin
ActiveDataSet.GetFieldNames(LocateField.Items);
End;
当用户选择了关键字段并且输入了键值，就可以单击“Locate”按钮开始定位记录。
Procedure TDBClientTest.LocateButtonClick(Sender: TObject);varOptions: TLocateOptions;LocateValue: Variant;
Begin
Options := [];
If locCaseInsensitive.Checked then Include(Options, loCaseInsensitive);
If locPartialKey.Checked then Include(Options, loPartialKey);
If LocateNull.Checked then LocateValue := Null
Else
LocateValue := LocateEdit.Text;
If ActiveDataSet.Locate(LocateField.Text, LocateValue, Options) then
StatusMsg := 'Record Found'
Else
StatusMsg := 'Not found';
End;
前面几行代码主要是设置有关选项，其中，如果用户选中“Null Value”复选框的话，就把键值设为Null。然后调用当前数据集的Locate函数定位记录，并根据Locate函数的返回值显示相应的信息。
14.6 一个登录的示范程序
这一节剖析一个登录示范程序，它可以在C:/Program Files/Borland/Delphi4/Demos/Midas/Login目录中找到。
这个程序分为应用服务器和客户程序两个部分。应用服务器的主窗体上有一个列表框，用于记载曾经登录到应用服务器上的用户名，如图14.16所示。
应用服务器上的数据模块如图14.17所示。
数据模块上只有一个TTable构件，它的DatabaseName属性设为DBDEMOS，TableName属性设为COUNTRY。数据模块上没有TProvider构件，由TTable构件提供IProvider接口。
这个数据模块的实例方式设为ciMultiInstance，这意味着每当一个客户连接应用服务器时，就会创建数据模块的一个新的实例，当客户不再连接应用服务器时，就删除数据模块的实例。因此，这个程序利用数据模块的OnCreate事件做了一些初始化的工作，利用数据模块的OnDestroy事件从列表框中删除一个用户名。
Procedure TLoginDemo.LoginDemoCreate(Sender: TObject);
Begin
FLoggedIn := False;
End;
为什么要把FLoggedIn变量设为False呢？其原因后面将解释。
Procedure TLoginDemo.LoginDemoDestroy(Sender: TObject);
Begin
With Form1.ListBox1.Items do Delete(IndexOf(FUserName));
End;
编译和运行这个应用服务器。打开客户程序的项目，它的主窗体如图14.18所示。
窗体上的TDCOMConnection构件用于连接应用服务器，它的ServerName属性设为Server.LoginDemo，它的LoginPrompt属性设为True。窗体上的TClientDataSet构件的RemoteServer属性指定了TDCOMConnection构件，它的ProviderName属性设为Country。
此外，窗体上有一个栅格用于显示数据集中的数据，还有一个“Open”按钮用于打开数据集。
由于TDCOMConnection构件的LoginPrompt属性设为True，当客户程序试图连接应用服务器时就会弹出一个“Remote Login”对话框，要求用户输入用户名和口令。登录以后，就触发OnLogin事件。在处理这个事件的句柄中，客户程序通过AppServer属性获得数据模块的接口，从而调用数据模块的Login。
Procedure TForm1.DCOMConnection1Login(Sender: TObject; Username,Password: String);
Begin
DCOMConnection1.AppServer.Login(UserName, Password);
End;
在应用服务器的数据模块单元中，Login是这样定义的。
Procedure TLoginDemo.Login(const UserName, Password: WideString);
Begin
Form1.ListBox1.Items.Add(UserName);
FLoggedIn := True;
FUserName := UserName;
End;
Login把用户名加到列表框中，然后把FLoggedIn变量设为True，表示用户已登录。当用户单击“Open”按钮，就调用TClientDataSet构件的Open打开数据集。
Procedure TForm1.Button1Click(Sender: TObject);
Begin
ClientDataSet1.Open;
End;
14.7 一个演示Master/Detail关系的示范程序
这一节剖析一个演示Master/Detail关系的示范程序，它可以在C:/ProgramFiles/Borland/Delphi4/ Demos/Midas/Mstrdtl目录中找到。
这个程序分为应用服务器和客户程序两个部分。应用服务器有一个窗体，不过，这个窗体其实是多余的，如果不想显示，可以打开应用服务器的项目文件，加入这么一行：
Application.ShowMainForm := False;
应用服务器的数据模块如图14.19所示。
应用服务器的数据模块上有这么几个构件：
名为Database的TDatabase构件，其AliasName属性设为IBLOCAL，并且定义了一个应用程序专用的别名叫ProjectDB。其Params属性提供了用户名和口令。
名为Project的TTable构件，其DatabaseName属性设为ProjectDB，它的TableName属性设为PROJECT(注意：必须已运行Interbase Server)。
名为Employee的TQuery构件，其DatabaseName属性设为ProjectDB，它的SQL语句如下：Select * From EMPLOYEE_PROJECT E Where E.PROJ_ID= :PROJ_ID
名为EmpProj的TQuery构件，其DatabaseName属性设为ProjectDB，它的SQL语句如下：Select EMP_NO,FULL_NAME From EMPLOYEE
名为UpdateQuery的TQuery构件，其DatabaseName属性设为ProjectDB，它的SQL语句目前是空的。
名为ProjectProvider的TProvider构件，其DataSet属性设为Project。
名为ProjectSource的TDataSource构件，其DataSet属性设为Project。编译并运行应用服务器。现在可以打开客户程序的项目，它的数据模块如图14.20所示。
图14.20 数据模块
客户程序的数据模块上有这么几个构件：
名为DCOMConnection的TDCOMConnection构件，其ServerName属性设为Serv.ProjectData。
名为Project的TClientDataSet构件，其RemoteServer属性设为DCOMConnection它的ProviderName属性设为ProjectProvider。并且建立了一个叫ProjectEmpProj的永久字段对象，它的类型是TDataSetField。与Project对应的TDataSource构件叫ProjectSource。
名为Emp_Proj的TClientDataSet构件，其RemoteServer属性和ProviderName属性都是空的，但它的DataSetField属性设为叫ProjectEmpProj的字段对象，这就构成了Master/Detail关系。与Emp_Proj对应的TDataSource构件叫EmpProjSource。
名为Employee的TClientDataSet构件，其RemoteServer属性指定了TDCOMConnection构件，但它的ProviderName属性设为Employee。与Employee对应的TDataSource构件叫EmployeeSource。
我们再来看客户程序的主窗体，如图14.21所示。
左边一个栅格只显示Project数据集中的PROJ_NAME字段即项目名称，“Product”框显示Project数据集中的PRODUCT字段，“Description”框显示Project数据集中的PROJ_DESC字段，并且用一个TDBNavigator构件为Project数据集导航。
右下角的栅格显示Emp_Proj数据集中一个叫EmployeeName的字段的值，这是个Lookup字段，它的LookupDataSet属性设为Employee，它的LookupKeyField属性设为EMP_NO，它的LookupResultField属性设为FULL_NAME。当用户用导航器浏览Project数据集的记录时，右下角的栅格就从Employee数据集中查找与EMP_NO字段匹配的记录，并且显示其中的FULL_NAME字段。
由于右下角的栅格只建立了一个永久的列对象，因此，可以把这一列的宽度设为与栅格本身同宽，它是在处理窗体的OnCreate事件的句柄中进行的。
Procedure TClientForm.FormCreate(Sender: TObject);
Begin
MemberGrid.Columns[0].Width :=MemberGrid.ClientWidth - GetSystemMetrics(SM_CXVSCROLL);
End;
由于一个项目中不止一个雇员，为了醒目起见，可以把其中的负责人加粗显示，这需要处理栅格的OnDrawColumnCell事件。
Procedure TClientForm.MemberGridDrawColumnCell(Sender: TObject; const Rect: TRect;DataCol: Integer;Column: TColumn;State: TGridDrawState);
Begin
If DM.ProjectTEAM_LEADER.Value = DM.Emp_ProjEMP_NO.Value then MemberGrid.Canvas.Font.Style := [fsBold];
MemberGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
End;
怎样来判断其中的负责人呢？在Project数据集中，有一个TEAM_LEADER 字段，它存储的是项目负责人的雇员编号。在Emp_Proj数据集中，有一个EMP_NO，它存储的也是雇员编号，如果这两者相等，即表示该雇员是项目负责人。当用户单击“Add”按钮，就可以在栅格中增加一条记录，即在项目中增加一个雇员。
Procedure TClientForm.AddBtnClick(Sender: TObject);
Begin
MemberGrid.SetFocus;
DM.Emp_Proj.Append;
MemberGrid.EditorMode := True;
End;
由于栅格事先建立了一个永久的列对象，而该列对象的FieldName属性指定了一个Lookup字段，所以，用户可以从一个组合框中选择一个值。
当用户单击“Delete”按钮，就删除当前记录，即一个雇员。
Procedure TClientForm.DeleteBtnClick(Sender: TObject);
Begin
DM.Emp_Proj.Delete;
End;
当用户先选择其中一个雇员，然后单击“Leader”按钮，就把该雇员设为项目负责人。
Procedure TClientForm.LeaderBtnClick(Sender: TObject);
var NewLeader: Integer;
Begin
NewLeader := DM.Emp_ProjEMP_NO.Value;
If not (DM.Project.State in dsEditModes) then DM.Project.Edit;
DM.ProjectTEAM_LEADER.Value := NewLeader;
MemberGrid.Refresh;
End;
增加、删除或修改了记录后，用户应当单击“Apply Update”按钮更新数据库。
Procedure TClientForm.ApplyUpdatesBtnClick(Sender: TObject);
Begin
DM.ApplyUpdates;
End;
在数据模块的单元中，ApplyUpdates是这样定义的：
Procedure TDM.ApplyUpdates;
Begin
If Project.ApplyUpdates(0) = 0 then Project.Refresh;
End;
可以看出，数据模块的ApplyUpdates又调用了TClientDataSet构件的ApplyUpdates，并且把MaxErrors参数设为0，这样，只要应用服务器发现有一个错误的记录，更新就停止。
当用户在左边的栅格中试图增加一个新的项目时，会触发TClientDataSet构件的OnNewRecord事件。由于这个栅格只显示了PROJ_NAME字段，用户不能直接输入PROJ_ID字段的值，因此，程序在处理OnNewRecord事件的句柄中推出一个输入框，让用户输入PROJ_ID字段的值。如果用户输入的字符超过了该字段允许的长度，就触发一个异常。
如果用户没有输入任何字符，也触发一个异常。
Procedure TDM.ProjectNewRecord(DataSet: TDataSet);
va rValue: String;
Begin
If InputQuery('Project ID','Enter Project ID:',Value) then
Begin
If Length(Value) > ProjectPROJ_ID.Size then
Raise Exception.CreateFmt('Project ID can only be %d characters',[ProjectPROJ_ID.Size]);If Length(Value) = 0 then
Raise Exception.Create('Project ID is required');
End
Else
SysUtils.Abort;
ProjectPROJ_ID.Value := Value;
End;
由于Project数据集与Employee数据集之间存在着Master/Detail关系，当删除Project数据集的一条记录时，应当先删除Employee数据集中关联的记录。应用服务器利用TProvider构件的BeforeUpdateRecord事件实现了这一点。
Procedure TProjectData.ProjectProviderBeforeUpdateRecord(Sender: TObject; SourceDS: TDataSet;DeltaDS: TClientDataSet; UpdateKind: TUpdateKind; var Applied: Boolean);
Const DeleteQuery = 'Delete From EMPLOYEE_PROJECT where PROJ_ID = :ProjID';
Begin
If (UpdateKind = ukDelete) and (SourceDS = Project) then
Begin
UpdateQuery.SQL.Text := DeleteQuery;
UpdateQuery.Params[0].AsString := DeltaDS.FieldByName('PROJ_ID').AsString;
UpdateQuery.ExecSQL;
End;
End;
14.9 一个动态设置查询参数的示范程序
这一节剖析一个动态设置查询参数的示范程序，它可以在C:/ProgramFiles/Borland/Delphi4/ Demos/ Midas/Setparam目录中找到。
这个程序分为应用服务器和客户程序两个部分。当客户程序通过TClientDataSet构件的Params属性设置参数时，这些参数会自动地传递给应用服务器上的TQuery构件，这样就能够根据用户的要求来查询数据库，这就是本示范程序的基本思路。
我们来剖析应用服务器，先看它的数据模块，如图14.24所示。图14.24 数据模块数据模块上只有一个TQuery构件，它的DatabaseName属性设为DBDEMOS，它的SQL语句如下：
Select * From EventsWhere Event_Date >= :Start_Date and Event_Date <= :End_Date Order by Event_Date
可以看出，这个SQL语句中有两个参数，一个是:Start_Date，另一个是:End_Date。
现在我们暂时不管数据模块，再来看看应用服务器的主窗体，如图14.25所示。
图14.25 应用服务器的主窗体
主窗体上显示两个计数，一个是当前连接应用服务器的客户数(Clients)，另一个是已经执行的查询次数(Queries)。用什么来判断当前的客户数，这与数据模块的实例方式有关。我们可以回到数据模块的单元，看看它的初始化代码：
Initialization
TComponentFactory.Create(ComServer, TSetParamDemo,
Class_SetParamDemo, ciMultiInstance);
End.
可以看出，这个数据模块的实例方式设为ciMultiInstance，表示每当有一个客户连接应用服务器，就会创建数据模块的一个新的实例。因此，数据模块的实例数就是当前的客户数。怎样统计数据模块的实例数呢？很简单，只要处理数据模块的OnCreate事件。
Procedure TSetParamDemo.SetParamDemoCreate(Sender: TObject);
Begin
MainForm.UpdateClientCount(1);
End;
当一个客户退出连接，将删除一个数据模块的实例，此时将触发数据模块的OnDestroy事件：
Procedure TSetParamDemo.SetParamDemoCreate(Sender: TObject);
Begin
MainForm.UpdateClientCount(1);
End;
其中，UpdateClientCount是在主窗体的单元中定义的：
Procedure TMainForm.UpdateClientCount(Incr: Integer);
Begin
FClientCount := FClientCount + Incr;
ClientCount.Caption := IntToStr(FClientCount);
End;
请注意Incr参数的作用。怎样统计已经执行过的查询数呢？也很简单，只要统计TQuery构件被激活的次数就可以了。因此，程序处理了TQuery构件的AfterOpen事件。
Procedure TSetParamDemo.EventsAfterOpen(DataSet: TDataSet);
Begin
MainForm.IncQueryCount;
End;
IncQueryCount是在主窗体的单元中定义的：
Procedure TMainForm.IncQueryCount;
Begin
Inc(FQueryCount);
QueryCount.Caption := IntToStr(FQueryCount);
End;
编译和运行这个应用服务器。打开客户程序的项目，它的主窗体如图14.26所示。
窗体上有一个TDCOMConnection构件用于连接应用服务器，有一个叫Events的TClientDataSet构件，用于引入数据集。
“Starting Date”框用于输入:Start_Date参数的值，
“Ending Date”框用于输入:End_Date参数的值。中间的栅格用于显示查询的结果。“Description”框用于显示Event_Description字段的值。“Photo”框用于显示Event_Photo字段的值。
客户程序在处理窗体的OnCreate事件的句柄中对“Starting Date”框和“EndingDate”框进行初始化。
Procedure TForm1.FormCreate(Sender: TObject);
Begin
StartDate.Text := DateToStr(EncodeDate(96, 6, 19));
EndDate.Text := DateToStr(EncodeDate(96, 6, 21));
End;
用户可以在这两个框中重新输入其他日期，然后单击“Show Events”按钮。
Procedure TForm1.ShowEventsClick(Sender: TObject);
Begin
Events.Close;
Events.Params.ParamByName('Start_Date').AsDateTime:=StrToDateTime(StartDate.Text);Events.Params.ParamByName('End_Date').AsDateTime :=StrToDateTime(EndDate.Text);
Events.Open;
End;
首先，要调用TClientDataset构件的Close关闭数据集，然后分别设置Start_Date参数和End_Date参数的值，最后，调用TClientDataset构件的Open打开数据集，此时，这两个参数就被自动传递给应用服务器上的TQuery构件。
MIDAS是Multi-Tier Distributed Application Services Suite的简称，为Delphi 4的一个关键技术。对于初学者来说，MIDAS具有相当的难度，因此，这一章详细剖析几个MIDAS示范程序，以帮助读者理解和掌握MIDAS技术。
与一般的数据库应用程序不同的是，只有当应用服务器正在运行的情况下，才能打开、编译和运行“瘦”客户程序的项目。
14.1 一个ActiveForm的例子
Delphi 4可以把分布式的数据库结构引申到Internet/Intranet上，把“瘦”客户程序作为ActiveForm嵌入到网页中让人们下载，然后在当地执行。
这一节剖析一个ActiveForm的示范程序，项目名称叫empeditx，它可以在C:/Program Files/Borland/Delphi4/Demos/Midas/Activefm目录中找到。它的主窗体如图14.1所示。
在打开这个项目之前，先要编译、运行位于C:/ProgramFiles/Borland/Delphi4/Demos/ Midas/Empedit目录中的Server项目，这是个应用服务器，如图14.2所示。
这里还要交代一下，在应用服务器上，用一个TQuery构件引入数据集，它的SQL语句如下：
Select * From Employee
在这个ActiveForm上，有一个TDCOMConnection构件，用于以DCOM方式连接应用服务器，它的ServerName属性设为Serv.EmpServer，它的ServerGUID设为{53BC6562-5B3E-11D0-9FFC-00A0248E4B9A}。
ActiveForm用TClientDataSet构件从应用服务器引入数据集，它的RemoteServer属性设为MidasConnection即TDCOMConnection构件的名称，它的ProviderName属性设为EmpQuery即应用服务器上的TQuery构件，由它来提供IProvider接口。
ActiveForm上有几个数据控件，用于显示数据，它们都通过一个TDataSource构件获得数据。此外，ActiveForm上还有一个TDBNavigator构件，用于浏览数据集。
由于本节要介绍的示范程序是一个ActiveForm，它的大部分代码与类型库有关，我们只把其中涉及到MIDAS技术的部分“拎”出来。
当用户单击ActiveForm上的“Get Employees”按钮时，就从应用服务器检索数据。每次检索到的记录数取决于TClientDataSet构件的PacketRecords属性。
Procedure TEmpEditForm.QueryButtonClick(Sender: TObject);
Begin
Employees.Close;
{ Employees是TClientDataSet构件的名称}E
mployees.Open;
End;
当用户单击ActiveForm上的“Update Employees”按钮时，把用户对数据的修改写到数据集中。
Procedure TEmpEditForm.UpdateButtonClick(Sender: TObject);
Begin
Employees.ApplyUpdates(-1);
End;
当用户单击ActiveForm上的“Undo Last Change”按钮时，取消用户对数据的修改。
Procedure TEmpEditForm.UndoButtonClick(Sender: TObject);
Begin
Employees.UndoLastChange(True);
End;
为了测试这个ActiveForm，首先需要把它发布到Web服务器上，供下载用。为此，要使用“Project”菜单上的“Web Deployment Options”命令设置有关Web发布的选项，主要是指定ActiveForm在Web服务器上的URL。然后使用“Project”菜单上的“WebDeploy”命令把ActiveForm发布到Web服务器上。
14.2 一个动态传递SQL语句的示范程序
这一节要剖析一个动态传递SQL语句的示范程序，可以在C:/Program Files/Borland/Delphi4/Demos/Midas/Adhoc目录中找到。
这个程序分为应用服务器和客户程序两个部分。当客户程序通过IProvider接口调用DataRequest请求数据时，把用户输入的SQL语句传递给应用服务器，这样，应用服务器上的TQuery构件就能够根据用户的要求来查询数据库，这就是本示范程序的基本思路。
先来剖析应用服务器，看它的数据模块，如图14.3所示。
图14.3 数据模块
数据模块上有这么几个构件：
一个TSession构件，它的SessionName属性设为Session1_2。
一个TDatabase构件，它的SessionName属性设为Session1_2，并且定义了一个专用的别名叫ADHOC。
一个TQuery构件，它的DatabaseName属性设为ADHOC，它的SessionName属性也设为Session1_2，而它的SQL属性为空，因为SQL语句由客户程序动态地传递过来。
一个TProvider构件，它的DataSet属性设为AdHocQuery即TQuery构件的名称。
现在我们暂时不管数据模块，再来看看应用服务器的主窗体，如图14.4所示。
图14.4 应用服务器的主窗体
主窗体上显示两个计数，一个是当前连接应用服务器的客户数(Clients)，另一个是已经执行的查询次数(Queries)。
用什么来判断当前的客户数，这与数据模块的实例方式有关。我们可以回到数据模块的单元，看看它的初始化代码：
Initialization
TComponentFactory.Create(ComServer, TAdHocQueryDemo,
Class_AdHocQueryDemo, ciMultiInstance);
End.
可以看出，这个数据模块的实例方式设为ciMultiInstance，表示每当有一个客户连接应用服务器，就会创建数据模块的一个新的实例。因此，数据模块的实例数就是当前的客户数。怎样统计数据模块的实例数呢？很简单，只要处理数据模块的OnCreate事件。
Procedure TAdHocQueryDemo.AdHocQueryDemoCreate(Sender: TObject);
Begin
MainForm.UpdateClientCount(1);
End;
当一个客户退出连接时，将删除一个数据模块的实例，此时将触发数据模块的OnDestroy事件：
Procedure TAdHocQueryDemo.AdHocQueryDemoDestroy(Sender: TObject);
Begin
MainForm.UpdateClientCount(-1);
End;
其中，UpdateClientCount函数是在主窗体的单元中定义的：
Procedure TMainForm.UpdateClientCount(Incr: Integer);
Begin
FClientCount := FClientCount + Incr;
ClientCount.Caption := IntToStr(FClientCount);
End;
请读者注意Incr参数的作用。怎样统计已经执行过的查询数呢？很简单，只要统计TQuery构件被激活的次数就可以了。因此，程序处理了TQuery构件的AfterOpen事件。Procedure TAdHocQueryDemo.AdHocQueryAfterOpen(DataSet: TDataSet);
Begin
MainForm.IncQueryCount;
End;
IncQueryCount是在主窗体的单元中定义的：
Procedure TMainForm.IncQueryCount;
Begin
Inc(FQueryCount);
QueryCount.Caption := IntToStr(FQueryCount);
End;
在打开客户程序的项目之前，必须先编译和运行应用服务器的项目。好，现在我们打开客户程序的项目，它的主窗体如图14.5所示。
这个客户程序用一个TDCOMConnection构件连接应用服务器，它的ServerName属性设为Serv.AdHocQueryDemo。客户程序用TClientDataSet构件从应用服务器引入数据集，它的RemoteServer属性设为TDCOMConnection构件的名称，它的ProviderName属性设为AdHocQuery，这是应用服务器输出的 IProvider接口。
客户程序上有一个栅格，用于显示数据，栅格与数据集之间通过TDataSource构件连接。此外，客户程序上有一个多行文本编辑器，让用户输入SQL语句。有一个组合框用于选择要访问的数据库。我们还是先从处理OnCreate事件的句柄开始。
Procedure TForm1.FormCreate(Sender: TObject);
var I: Integer;DBNames: OleVariant;
Begin
RemoteServer.Connected := True;
DBNames := RemoteServer.AppServer.GetDatabaseNames;
If VarIsArray(DBNames) then
For I := 0 to VarArrayHighBound(DBNames, 1) Do
DatabaseName.Items.Add(DBNames[I]);
DatabaseNameClick(Self);
End;
首先，把TDCOMConnection构件的Connected属性设为True，将连接应用服务器。TDCOMConnection构件的AppServer属性将返回应用服务器上数据模块的接口，通过此接口就可以调用远程数据模块的方法，例如GetDatabaseNames。GetDatabaseNames是在应用服务器的数据模块单元中定义的：
Function TAdHocQueryDemo.GetDatabaseNames: OleVariant;
var I: Integer;
DBNames: TStrings;
Begin
DBNames := TStringList.Create;
Try
Session1.GetDatabaseNames(DBNames);
Result := VarArrayCreate([0, DBNames.Count - 1], varOleStr);
For I := 0 to DBNames.Count - 1 DoResult[I] := DBNames[I];
FinallyDBNames.Free;
End;
End;
GetDatabaseNames函数的作用是返回一个数组，该数组由所有已定义的别名和BDE会话期对象专用的别名组成。现在我们回到客户程序中，调用了数据模块的GetDatabaseNames函数后，就把检索到别名加到窗体右上角的组合框中，然后调用DatabaseNameClick函数。
Procedure TForm1.DatabaseNameClick(Sender: TObject);
var Password: string;
Begin
If DatabaseName.Text <> '' then
Begin
ClientData.Close;
Try
RemoteServer.AppServer.SetDatabaseName(DatabaseName.Text, '');
Except
On E: Exception DoIf E.Message = 'Password Required' then
Begin
If InputQuery(E.Message, 'Enter password', Password) then
RemoteServer.AppServer.SetDatabaseName(DatabaseName.Text, Password);
End
Else
Raise;
End;
End;
End;
调用DatabaseNameClick的目的是使应用服务器与另一个数据库连接，这就需要通过AppServer属性获得数据模块的接口，然后调用数据模块单元的SetDatabaseName。SetDatabaseName是在应用服务器的数据模块单元中定义的：
Procedure TAdHocQueryDemo.SetDatabaseName(const DBName, Password: WideString);
Begin
Try
Database1.Close;
Database1.AliasName := DBName;
If Password <> '' then
Database1.Params.Values['PASSWORD'] := Password;
Database1.Open;
Except
{如果数据库打开失败，很可能是因为该数据库需要口令}
On E: EDBEngineError DoIf (Password = '') then Raise Exception.Create('Password Required')Else
Raise;
End;
End;
SetDatabaseName的作用是修改TDatabase构件的AliasName属性，然后连接新的数据库，如果失败，就触发一个异常。在客户程序的DatabaseNameClick过程中，如果出现异常，就弹出一个输入框，让用户输入口令，然后再次调用数据模块的SetDatabaseName。
当用户在“Query”框中输入了SQL语句，就可以单击“Run Query”按钮执行这个查询。问题是，只有应用服务器才可以执行查询，那么客户程序是怎样把SQL语句传递给应用服务器的呢？这就是本示范程序的关键之处。
Procedure TForm1.RunButtonClick(Sender: TObject);
Begin
ClientData.Close;
ClientData.Provider.DataRequest(SQL.Lines.Text);
ClientData.Open;
End;
原来，客户程序通过IProvider接口调用DataRequest把用户输入的SQL语句传递给应用服务器。客户程序通过IProvider接口调用DataRequest将在应用服务器端触发OnDataRequest事件，我们来看看应用服务器是怎样处理OnDataRequest事件的。
Function TAdHocQueryDemo.AdHocProviderDataRequest(Sender: TObject; Input: OleVariant): OleVariant;
Begin
AdHocQuery.SQL.Text := Input;
End;
至此，一个动态传递SQL语句的示范程序剖析完毕，请读者仔细琢磨其中的编程技巧。实际上，通过IProvider接口调用DataRequest可以传递任何信息。
14.4 一个全面演示TClientDataSet功能的示范程序
这一节介绍一个演示TClientDataSet功能的示范程序，项目名称叫Alchtest，它可以在C:/Program Files/Borland/Delphi4/Demos/Midas/Alchtest目录中找到，主窗体如图14.6所示。
这个程序的总体思路是，用一个多页控件让用户修改TClientDataSet的属性或者调用它的方法，然后在下面的TAB控件中演示修改后的效果。
程序首先在处理OnCreate事件的句柄中做了一些初始化的工作。
Procedure TDBClientTest.FormCreate(Sender: TObject);
var I: Integer;
Begin
Database1.Close;
FMaxErrors := -1;
FPacketRecs := -1;
SetCurrentDirectory(PChar(ExtractFilePath(ParamStr(0))));
For I := 0 to StatusBar.Panels.Count - 1 do
StatusBar.Panels[I].Text := '';
Application.OnIdle := ShowHeapStatus;
Application.OnHint := OnHint;
StreamSettings(False);
SetEventsVisible(ViewEvents.Checked);
End;
其中，指定ShowHeapStatus作为处理应用程序的OnIdle事件的句柄，指定OnHint作为处理应用程序的OnHint事件的句柄。ShowHeapStatus是这样定义的：
Procedure TDBClientTest.ShowHeapStatus(Sender: TObject; var Done: Boolean);
Begin
Caption := Format('Client DataSet Test Form - (Blocks=%d Bytes=%d)',[AllocMemCount, AllocMemSize]);
End;
ShowHeapStatus的作用是在应用程序空闲的时候，在主窗口的标题栏显示堆的状态，其中，AllocMemCount是当前分配的内存块数，AllocMemSize是当前分配的内存总长度。
OnHint是这样定义的：
Procedure TDBClientTest.OnHint(Sender: TObject);
Begin
StatusMsg := Application.Hint;
End;
StatusMsg是一个自定义的属性，用于表达要在状态栏上显示的提示信息。
在处理OnCreate事件的句柄中还调用了StreamSettings函数。StreamSettings是非常有用的，当窗体关闭时，就调用StreamSettings把窗体上一些控件的状态保存到一个配置文件中。当窗体弹出时，就调用StreamSettings读取配置文件以初始化窗体上的控件。
Procedure TDBClientTest.StreamSettings(Write: Boolean);
Procedure WriteStr(const OptName, Value: string);
Begin
FConfig.WriteString('Settings', OptName, Value);
End;
Procedure WriteBool(const OptName: string; Value: Boolean);
Begin
FConfig.WriteBool('Settings', OptName, Value);
End;
Function ReadStr(const OptName: string): string;
Begin
Result := FConfig.ReadString('Settings', OptName, '');
End;
Function ReadBool(const OptName: string): Boolean;
Begin
Result := FConfig.ReadBool('Settings', OptName, False);
End;
Function FindPage(const PageName: string): TTabSheet;
var I: Integer;
Begin
For I := AreaSelector.PageCount - 1 downto 0 do
Begin
Result := AreaSelector.Pages[I];
If Result.Caption = PageName then Exit;
End;
Result := ProviderPage;
End;
Procedure ProcessComponents(Components: array of TComponent);
varI: Integer;
Begin
If Write then
Begin
For I := Low(Components) to High(Components) Do
If Components[I] is TCustomEdit then
With TEdit(Components[I]) do WriteStr(Name, Text)
Else if Components[I] is TComboBox then
With TDBComboBox(Components[I]) do WriteStr(Name, Text)
Else if Components[I] is TCheckBox then
With TCheckBox(Components[I]) do WriteBool(Name, Checked)
Else if Components[I] is TAction then
With TAction(Components[I]) do WriteBool(Name, Checked)
Else if Components[I] is TPageControl then
With TPageControl(Components[I]) doWriteStr(Name,ActivePage.Caption);
End;
Else
Begin
For I := Low(Components) to High(Components) do
If Components[I] is TCustomEdit then
With TEdit(Components[I]) do Text := ReadStr(Name)
Else if Components[I] is TComboBox then
With TComboBox(Components[I]) do Text := ReadStr(Name)
Else if Components[I] is TCheckBox then
With TCheckBox(Components[I]) do Checked := ReadBool(Name)
Else if Components[I] is TAction then
With TAction(Components[I]) do Checked := ReadBool(Name)
Else if Components[I] is TPageControl then
With TPageControl(Components[I]) doActivePage := FindPage(ReadStr(Name));
End;
End;
Begin
GetConfigFile;
If not Write and (ReadStr('AreaSelector') = '') then Exit;
ProcessComponents([AreaSelector, DatabaseName, MasterTableName,DetailTableName, MasterSQL, DetailSQL, poCascadedDeletes, poCascadedUpdates,poDelayedDetails, poDelayedBlobs, poIncludeFieldProps, poReadOnly,DisableProvider, ObjectView, SparseArrays, MixedData, FetchOnDemand,DisableProvider, ResolveToDataSet, DataRows, CreateDataSetDesc,EnableBCD, RequestLiveQuery, ViewEvents, DisplayDetails, IncludeNestedObject]);
End;
StreamSettings用Write参数来区分现在是要读还是写。StreamSettings中又嵌套了几个过程和函数，其中，WriteStr、WriteBool、ReadStr、ReadBool分别用于在配置文件中存取字符串和布尔类型的信息，FindPage函数搜索并返回一个特定的对象，而ProcessComponents则用于存取与具体构件有关的信息。
GetConfigFile函数用于创建一个TIniFile对象的实例(如果还没有创建的话)。
Function TDBClientTest.GetConfigfile: TIniFile;
Begin
If FConfig = nil Then
FConfig := TIniFile.Create(ChangeFileExt(ParamStr(0), '.INI'));
Result := FConfig;
End;
请读者注意StreamSettings是怎样调用ProcessComponents函数的。ProcessComponents需要传递一个数组，数组中的元素就是窗体上的一些控件的名称。
我们先翻到“Provider”页，看看怎样指定数据库和建立Master/Detail关系，如图14.7所示。
图14.7 “Provider”页
“Database”框用于指定要访问的数据库。当用户下拉此框时，将触发OnDropDown事件。如果此时“Database”框还是空的话，就调用TSession的GetDatabaseNames函数把所有已定义的BDE别名和专用的别名填到“Database”框中。
Procedure TDBClientTest.DatabaseNameDropDown(Sender: TObject);
Begin
If DatabaseName.Items.Count = 0 then
Session.GetDatabaseNames(DatabaseName.Items);
End;
当用户在“Database”框中选择一个别名，将触发OnClick事件。此时，就调用CheckDatabase连接另一个数据库。由于数据库已改变，“Master/DetailTables”框内的内容应当清掉。
Procedure TDBClientTest.DatabaseNameClick(Sender: TObject);
Begin
If (DatabaseName.Text <> '') and not DatabaseName.DroppedDown then
Begin
CheckDatabase(True);
MasterTableName.Items.Clear;
MasterTableName.Text := '';
DetailTableName.Text := '';
ClientData.Close;
End;
End;
用户也可以直接在“Database”框键入一个数据库别名，然后按Enter键，此时将触发OnKeyPress事件。
Procedure TDBClientTest.DatabaseNameKeyPress(Sender: TObject; var Key: Char);
Begin
If Key = #13 then
Begin
If DatabaseName.DroppedDown then
DatabaseName.DroppedDown := False;
DatabaseNameClick(Sender);Key := #0;
End;
End;
好，现在让我们看看CheckDatabase是怎样定义的：
Procedure TDBClientTest.CheckDatabase(CloseFirst: Boolean);
var SPassword, SUserName: string;
Begin
If not CloseFirst and Database1.Connected and(Database1.AliasName = DatabaseName.Text) then Exit;
Database1.Close;
Database1.AliasName := DatabaseName.Text;
Session.GetAliasParams(Database1.AliasName, Database1.Params);
If Database1.Params.IndexOfName('PATH') = -1 then
Begin
SPassword := ConfigFile.ReadString('Passwords', Database1.AliasName, '');
If SPassword = '' then
Begin
SUserName := Database1.Params.Values['USER NAME'];
If not LoginDialog('DatabaseName.Text', SUserName, SPassword) then Exit;
Database1.Params.Values['USER NAME'] := SUserName;
End;
Database1.Params.Values['PASSWORD'] := SPassword;
End;
If EnableBCD.Checked then Database1.Params.Add('ENABLE BCD=TRUE');
Database1.Open;
If Database1.IsSQLBased and (SPassword <> '') thenConfigFile.WriteString('Passwords', Database1.AliasName, SPassword);
End;
CheckDatabase用于连接一个用户指定的数据库。如果当前连接的就是用户指定的数据库，CheckDatabase就什么也不干。如果不是的话，首先要调用TDatabase构件的Close断开与数据库的连接，然后把TDatabase构件的AliasName 属性设为用户选择的别名，并调用BDE会话期对象的GetAliasParams取出这个别名的参数。
注意，对于本地数据库来说，只有一个PATH参数，而对于SQL数据库来说，参数就有好几个，因此，可以用有没有PATH参数来区分本地数据库和SQL数据库。如果是SQL数据库的话，就要设置USER NAME和PASSWORD参数给出用户名和口令。如果“Settings”菜单上的“EnableBCD”命令被选中的话，就增加一个ENABLE BCD参数，并把它的值设为TRUE。然后调用Open重新连接数据库。
这个程序还能够让客户选择“Master/Detail”关系中的Master表和Detail表，这是在“Master/Detail Tables”框中选择的，其中，上面一个组合框用于选择Master表，下面一个组合框用于选择Detail表。当用户在组合框中选择一个表，将触发OnClick事件。
Procedure TDBClientTest.MasterTableNameClick(Sender: TObject);
Begin
With Sender as TComboBox Do
If not DroppedDown and (MasterTable.TableName <> Text) then OpenTable.Execute;
End;
当用户下拉“Master/Detail Tables”框中的一个组合框，将触发OnDropDown事件。此时就调用BDE会话期对象的GetTableNames把当前数据库中的所有表格的名称填到组合框中，供用户选择。
Procedure TDBClientTest.MasterTableNameDropDown(Sender: TObject);
Begin
CheckDatabase(False);
With Sender as TComboBox do
If (Items.Count < 1) and (Database1.AliasName <> '') then
Session.GetTableNames(Database1.DatabaseName, '', True, False, Items);
End;
用户也可以直接在“Master/Detail Tables”框中的一个组合框内键入一个表格的名称，然后按Enter键，此时将触发OnKeyPress事件。
Procedure TDBClientTest.MasterTableNameKeyPress(Sender: TObject; var Key: Char);
Begin
If Key = #13 then
Begin
With Sender as TComboBox Do
If DroppedDown then DroppedDown := False;
OpenTable.Execute;
Key := #0;
End;
End;
注意：上面都是以选择Master表的组合框为例的，实际上，选择Detail表的操作完全一样，代码如下。
Procedure TDBClientTest.DetailTableNameClick(Sender: TObject);
Begin
With Sender as TComboBox Do
If not DroppedDown and (DetailTable.TableName <> Text) then
OpenTable.Execute;
End;
在上面几个事件句柄中，OpenTable是一个动作列表，这是Delphi 4新增加的功能。在窗体上双击TActionList构件，将打开一个如图14.8所示的编辑器。
图14.8 动作列表编辑器
在这个编辑器中找出OpenTable这个动作，然后在对象观察器中可以发现， 执行这个动作的代码是OpenTableExecute函数。
Procedure TDBClientTest.OpenTableExecute(Sender: TObject);
Begin
ClearEventLog.Execute;
If MasterTableName.Text <> '' then OpenDataSet(MasterTable);
End;
而OpenDataSet是这样定义的：
Procedure TDBClientTest.OpenDataSet(Source: TDBDataSet);
Begin
Screen.Cursor := crHourGlass;
Try
ClientData.Data := Null;
Source.Close;
If not DisableProvider.Checked then
Begin
BDEProvider.DataSet := Source;
SetProviderOptions;
ClientData.ProviderName := BDEProvider.Name;
ActiveDataSet := ClientData;
End
Else
ActiveDataSet := Source;
MasterGrid.SetFocus;
StatusMsg := 'Dataset Opened';
FinallyScreen.Cursor := crDefault;
End;
StreamSettings(True);
End;
OpenDataSet通过一个叫DisableProvider的复选框来决定是否使用TProvider构件。如果没有选中“Disable Provider”这个复选框，表示使用TProvider构件，此时就把TProvider构件的DataSet属性设为MasterTable，然后调用SetProviderOptions来设置TProvider构件的选项，接着设置TClientDataSet构件的ProviderName属性指定这个TProvider构件，最后把ActiveDataSet变量设为此TClientDataSet构件。如果用户选中“Disable Provider”复选框，表示不使用TProvider构件，此时就直接把ActiveDataSet设为MasterTable。
SetProviderOptions是这样定义的：
Procedure TDBClientTest.SetProviderOptions;
var Opts: TProviderOptions;
Begin
Opts := [];If poDelayedDetails.Checked then
Include(Opts, poFetchDetailsOnDemand);
if poDelayedBlobs.Checked then Include(Opts, poFetchBlobsOnDemand);
if poCascadedDeletes.Checked then Include(Opts, poCascadeDeletes);
if poCascadedUpdates.Checked then Include(Opts, poCascadeUpdates);
if poReadOnly.Checked then Include(Opts, Provider.poReadOnly);
if poIncludeFieldProps.Checked then Include(Opts, poIncFieldProps);
BDEProvider.Options := Opts;
End;
SetProviderOptions实际上是根据“Settings”菜单上的“Provider Options”命令的一些子命令是否被选中来设置TProvider构件的Options属性。这个程序还可以让用户在“Master/Detail Queries”框中输入SQL语句。当用户输入了SQL语句并且按下Enter键，将触发OnKeyPress事件。
Procedure TDBClientTest.MasterSQLKeyPress(Sender: TObject; var Key: Char);
Begin
If Key = #13 then
Begin
OpenQuery.Execute;
Key := #0;
End;
End;
其中，OpenQuery也是一个动作，执行它的是OpenQueryExecute函数。OpenQueryExecute是这样定义的：
Procedure TDBClientTest.OpenQueryExecute(Sender: TObject);
Begin
If UpperCase(Copy(MasterSQL.Text, 1, 6)) = 'SELECT' then
OpenDataSet(MasterQuery)
Else
Begin
CheckDatabase(False);
MasterQuery.RequestLive := True;
MasterQuery.SQL.Text := MasterSQL.Text;
MasterQuery.ExecSQL;
StatusMsg := Format('%d rows were affected', [MasterQuery.RowsAffected]);
End;
Events.Items.
Begin
Update;
Try
Events.Clear;
Finally
Events.Items.EndUpdate;
End;
End;
OpenQueryExecute首先判断用户输入的SQL语句是否为SELECT。如果是的话，就调用OpenDataSet执行SELECT语句。如果不是的话，就调用ExecSQL执行SQL语句。
当用户翻到“Fields”页，将触发FieldsPage(TTabSheet对象)的OnShow事件，此时就把数据集中的字段和字段定义对象名称分别显示在两个多行文本编辑器中，如图14.9所示。
图14.9 “Fields”页
Procedure TDBClientTest.FieldsPageShow(Sender: TObject);
Procedure WriteFullNames(Fields: TFields);
var I: Integer;
Begin
For I := 0 to Fields.Count - 1 Do
With Fields[I] Do
Begin
FieldList.Lines.Add(Format('%d) %s', [FieldNo, FullName]));
If Fields[I].DataType in [ftADT, ftArray] then
WriteFullNames(TObjectField(Fields[I]).Fields);
End;
End;
Procedure WriteLists(DataSet: TDataSet);
var I: Integer;
Begin
FieldList.Clear;
For I := 0 to DataSet.FieldList.Count - 1 Do
With DataSet.FieldList Do
FieldList.Lines.Add(Format('%d) %s', [Fields[I].FieldNo, Strings[I]]));
FieldDefList.Clear;
DataSet.FieldDefs.Updated := False;
DataSet.FieldDefList.Update;
For I := 0 to DataSet.FieldDefList.Count - 1 Do
With DataSet.FieldDefList Do
FieldDefList.Lines.Add(Format('%d) %s', [FieldDefs[I].FieldNo, Strings[I]]));
End;
var DataSet: TDataSet;
Begin
DataSet := DBNavigator1.DataSource.DataSet;
If Assigned(DataSet) and DataSet.Active then
Begin
WriteLists(DataSet)
End
Else
Begin
CheckDatabase(False);
MasterTable.TableName := MasterTableName.Text;
WriteLists(MasterTable);
End;
End;
首先要说明的是，FieldsPageShow中嵌套了WriteFullNames，其实WriteFullNames完全是多余的。FieldsPageShow先获取当前的数据集。如果当前的数据集已打开的话，就调用WriteLists显示字段对象和字段定义对象的列表。如果当前数据集没有打开，就显示MasterTable中的字段对象和字段定义对象的列表。当用户翻到“Indexes”页，将触发IndexPage(TTabSheet对象)的OnShow事件，此时就把当前数据集中的索引列出来，用户也可以创建新的索引或者删除一个索引。“Indexes”页如图14.10所示。
图14.10 “Indexes”页
Procedure TDBClientTest.IndexPageShow(Sender: TObject);
Begin
If not Assigned(ActiveDataSet) or not ActiveDataSet.Active then
OpenTable.Execute;
RefreshIndexNames(0);
End;
IndexPageShow首先检查当前是否打开了一个数据集，如果没有，就执行OpenTable的代码即打开数据集，然后调用RefreshIndexNames函数列出所有的索引名称。
Procedure TDBClientTest.RefreshIndexNames(NewItemIndex: Integer);
var I: Integer;
IndexDefs: TIndexDefs;
Begin
IndexList.Clear;
If ActiveDataSet = MasterTable then
IndexDefs := MasterTable.IndexDefs
Else
IndexDefs := ClientData.IndexDefs;
IndexDefs.Update;
For I := 0 to IndexDefs.Count - 1 Do
If IndexDefs[I].Name = '' then IndexList.Items.Add('')
Else
IndexList.Items.Add(IndexDefs[I].Name);
If IndexList.Items.Count > 0 then
Begin
If NewItemIndex < IndexList.Items.Count then
IndexList.ItemIndex := NewItemIndex
ElseIndexList.ItemIndex := 0;
ShowIndexParams;
End;
End;
RefreshIndexNames又调用ShowIndexParams检索索引的选项，用这些选项来初始化“Indexes”页上的几个编辑框和复选框。
Procedure TDBClientTest.ShowIndexParams;varIndexDef: TIndexDef;
Begin
If ActiveDataSet = MasterTable then
IndexDef := MasterTable.IndexDefs[IndexList.ItemIndex]
Else
IndexDef := ClientData.IndexDefs[IndexList.ItemIndex];
idxCaseInsensitive.Checked := ixCaseInsensitive in IndexDef.Options;idxDescending.Checked := ixDescending in IndexDef.Options;idxUnique.Checked := ixUnique in IndexDef.Options;idxPrimary.Checked := ixPrimary in IndexDef.Options;IndexFields.Text := IndexDef.Fields;
DescFields.Text := IndexDef.DescFields;
CaseInsFields.Text := IndexDef.CaseInsFields;
End;
如果用户在列表框中选择了另一个索引，就应当相应地刷新这些选项。Procedure TDBClientTest.IndexListClick(Sender: TObject);
Begin
If ActiveDataSet = MasterTable then
MasterTable.IndexName := MasterTable.IndexDefs[IndexList.ItemIndex].Name
Else
ClientData.IndexName := ClientData.IndexDefs[IndexList.ItemIndex].Name;
ShowIndexParams;
End;
如果要创建一个新的索引，用户必须事先设置索引的选项，然后单击“CreateIndex”按钮。
Procedure TDBClientTest.CreateIndexClick(Sender: TObject);
var IndexName: string;Options: TIndexOptions;
Begin
IndexName := Format('Index%d', [IndexList.Items.Count+1]);
If InputQuery('Create Index', 'Enter IndexName:', IndexName) then
Begin
Options := [];
If idxCaseInsensitive.Checked then Include(Options, ixCaseInsensitive);
If idxDescending.Checked then Include(Options, ixDescending);
If idxUnique.Checked then Include(Options, ixUnique);
If idxPrimary.Checked then Include(Options, ixPrimary);
If ActiveDataSet = MasterTable then
Begin
MasterTable.Close;
MasterTable.AddIndex(IndexName,IndexFields.Text,Options,DescFields.Text);
MasterTable.Open;
End
Else
ClientData.AddIndex(IndexName, IndexFields.Text, Options,DescFields.Text, CaseInsFields.Text);
StatusMsg := 'Index Created';
RefreshIndexNames(IndexList.Items.Count);
End;
End;
CreateIndexClick首先弹出一个输入框，让用户输入索引名称，然后根据用户设置的选项来设置索引的Options属性。
在调用AddIndex之前，首先要区分当前的数据集是MasterTable还是ClientData，为什么要区分MasterTable和ClientData呢？因为对于一般的数据集构件来说，在创建索引之前必须先关闭数据集，而对于TClientDataSet构件来说，则不必先关闭数据集。
用户也可以先选择一个索引，然后单击“Delete Index”按钮删除这个索引。
Procedure TDBClientTest.DeleteIndexClick(Sender: TObject);
Begin
If IndexList.ItemIndex > -1 then
If ActiveDataSet = MasterTable then
Begin
MasterTable.Close;
MasterTable.DeleteIndex(MasterTable.IndexDefs[IndexList.ItemIndex].Name);
MasterTable.Open;
End
Else
ClientData.DeleteIndex(ClientData.IndexDefs[IndexList.ItemIndex].Name);
End;
与调用AddIndex一样，在调用DeleteIndex之前，首先要区分当前的数据集是MasterTable还是ClientData。当用户翻到“Filters”页，就可以设置过滤条件，如图14.11所示。
图14.11 “Filters”页
当“Filters”页刚刚打开的时候，将触发OnShow事件，这样就可以初始化“Filter”框。这里运用了一个编程技巧，先从下面的栅格中取出一个字段，然后判断这个字段的数据类型是不是ftString、ftMemo或ftFixedChar中的一种，如果是的话，过滤条件表达式的运算符后面的值要用引号括起来。
Procedure TDBClientTest.FilterPageShow(Sender: TObject);
var Field: TField;LocValue,QuoteChar: String;
Begin
If (Filter.Text = '') and Assigned(ActiveDataSet) and ActiveDataSet.Active then
Begin
Field := MasterGrid.SelectedField;If Field = nil then Exit;
With ActiveDataSet DoTryDisableControls;
MoveBy(3);
LocValue := Field.Value;
First;
Finally
EnableControls;
End;
If Field.DataType in [ftString, ftMemo, ftFixedChar] then
QuoteChar := ''''
Else QuoteChar := '';
Filter.Text := Format('%s=%s%s%1:s', [Field.FullName, QuoteChar, LocValue]);
End;
End;
用户可以在“Filter”框内键入新的过滤条件，当用户按下Enter键或把输入焦点移走，就会把用户输入的过滤条件表达式赋给当前数据集的Filter属性。当用户翻到“FindKey”页，就可以输入一个键值，然后在数据集中搜索特定的记录，如图14.12所示。
图14.12 “FindKey”页
当用户单击“Find Key”或“Find Nearest”按钮，就开始搜索特定的记录。
Procedure TDBClientTest.FindKeyClick(Sender: TObject);
Begin
If ActiveDataSet = ClientData then
With ClientData Do
Begin
SetKey;IndexFields[0].AsString := FindValue.Text;
KeyExclusive := Self.KeyExclusive.Checked;If FindPartial.Checked then KeyFieldCount := 0;
If Sender = Self.FindNearest then GotoNearest else
If not GotoKey then StatusMsg := 'Not found';
End
Else
if ActiveDataSet = MasterTable then
With MasterTable Do
Begin
SetKey;
IndexFields[0].AsString := FindValue.Text;
KeyExclusive := Self.KeyExclusive.Checked;
If FindPartial.Checked then KeyFieldCount := 0;
If Sender = Self.FindNearest then GotoNearest
Else
if GotoKey thenStatusMsg := 'Record Found'
Else StatusMsg := 'Not found';
End;
End;
首先，要区分当前数据集是ClientData还是MasterTable，调用SetKey使数据集进入dsSetKey状态，把用户输入的键值赋给索引中的第一个字段。然后根据Sender参数判断用户按下的是“Find Key”按钮还是“Find Nearest”按钮，如果是后者，就调用GotoNearest，如果是前者，就调用GotoKey，最后根据GotoKey的返回值显示有关信息。
当用户翻到“Locate”页，将触发LocatePage(TTabSheet对象)的OnShow事件，程序就把下面的栅格中选择的字段作为关键字段。“Locate”页如图14.13所示。
图14.13 “Locate”页
Procedure TDBClientTest.LocatePageShow(Sender: TObject);
var Field: TField;
Begin
If (ActiveDataSet <> nil) and ActiveDataSet.Active then
BeginField := MasterGrid.SelectedField;
If LocateField.Items.Count = 0 then
LocateFieldDropDown(LocateField);
If (LocateField.Text = '')or(LocateField.Items.IndexOf(Field.FieldName) < 1) then
LocateField.Text := Field.FieldName;
With ActiveDataSet Do
Try
DisableControls;
MoveBy(3);
LocateEdit.Text := Field.Value;
First;
Finally
EnableControls;
End;
End;
End;
用户也可以在“Field”框选择一个关键字段。当用户下拉“Field”框时，触发OnDropDown事件，这样就可以把当前数据集中的字段显示到“Field”框中。
Procedure TDBClientTest.LocateFieldDropDown(Sender: TObject);
Begin
ActiveDataSet.GetFieldNames(LocateField.Items);
End;
当用户选择了关键字段并且输入了键值，就可以单击“Locate”按钮开始定位记录。
Procedure TDBClientTest.LocateButtonClick(Sender: TObject);varOptions: TLocateOptions;LocateValue: Variant;
Begin
Options := [];
If locCaseInsensitive.Checked then Include(Options, loCaseInsensitive);
If locPartialKey.Checked then Include(Options, loPartialKey);
If LocateNull.Checked then LocateValue := Null
Else
LocateValue := LocateEdit.Text;
If ActiveDataSet.Locate(LocateField.Text, LocateValue, Options) then
StatusMsg := 'Record Found'
Else
StatusMsg := 'Not found';
End;
前面几行代码主要是设置有关选项，其中，如果用户选中“Null Value”复选框的话，就把键值设为Null。然后调用当前数据集的Locate函数定位记录，并根据Locate函数的返回值显示相应的信息。
14.6 一个登录的示范程序
这一节剖析一个登录示范程序，它可以在C:/Program Files/Borland/Delphi4/Demos/Midas/Login目录中找到。
这个程序分为应用服务器和客户程序两个部分。应用服务器的主窗体上有一个列表框，用于记载曾经登录到应用服务器上的用户名，如图14.16所示。
应用服务器上的数据模块如图14.17所示。
数据模块上只有一个TTable构件，它的DatabaseName属性设为DBDEMOS，TableName属性设为COUNTRY。数据模块上没有TProvider构件，由TTable构件提供IProvider接口。
这个数据模块的实例方式设为ciMultiInstance，这意味着每当一个客户连接应用服务器时，就会创建数据模块的一个新的实例，当客户不再连接应用服务器时，就删除数据模块的实例。因此，这个程序利用数据模块的OnCreate事件做了一些初始化的工作，利用数据模块的OnDestroy事件从列表框中删除一个用户名。
Procedure TLoginDemo.LoginDemoCreate(Sender: TObject);
Begin
FLoggedIn := False;
End;
为什么要把FLoggedIn变量设为False呢？其原因后面将解释。
Procedure TLoginDemo.LoginDemoDestroy(Sender: TObject);
Begin
With Form1.ListBox1.Items do Delete(IndexOf(FUserName));
End;
编译和运行这个应用服务器。打开客户程序的项目，它的主窗体如图14.18所示。
窗体上的TDCOMConnection构件用于连接应用服务器，它的ServerName属性设为Server.LoginDemo，它的LoginPrompt属性设为True。窗体上的TClientDataSet构件的RemoteServer属性指定了TDCOMConnection构件，它的ProviderName属性设为Country。
此外，窗体上有一个栅格用于显示数据集中的数据，还有一个“Open”按钮用于打开数据集。
由于TDCOMConnection构件的LoginPrompt属性设为True，当客户程序试图连接应用服务器时就会弹出一个“Remote Login”对话框，要求用户输入用户名和口令。登录以后，就触发OnLogin事件。在处理这个事件的句柄中，客户程序通过AppServer属性获得数据模块的接口，从而调用数据模块的Login。
Procedure TForm1.DCOMConnection1Login(Sender: TObject; Username,Password: String);
Begin
DCOMConnection1.AppServer.Login(UserName, Password);
End;
在应用服务器的数据模块单元中，Login是这样定义的。
Procedure TLoginDemo.Login(const UserName, Password: WideString);
Begin
Form1.ListBox1.Items.Add(UserName);
FLoggedIn := True;
FUserName := UserName;
End;
Login把用户名加到列表框中，然后把FLoggedIn变量设为True，表示用户已登录。当用户单击“Open”按钮，就调用TClientDataSet构件的Open打开数据集。
Procedure TForm1.Button1Click(Sender: TObject);
Begin
ClientDataSet1.Open;
End;
14.7 一个演示Master/Detail关系的示范程序
这一节剖析一个演示Master/Detail关系的示范程序，它可以在C:/ProgramFiles/Borland/Delphi4/ Demos/Midas/Mstrdtl目录中找到。
这个程序分为应用服务器和客户程序两个部分。应用服务器有一个窗体，不过，这个窗体其实是多余的，如果不想显示，可以打开应用服务器的项目文件，加入这么一行：
Application.ShowMainForm := False;
应用服务器的数据模块如图14.19所示。
应用服务器的数据模块上有这么几个构件：
名为Database的TDatabase构件，其AliasName属性设为IBLOCAL，并且定义了一个应用程序专用的别名叫ProjectDB。其Params属性提供了用户名和口令。
名为Project的TTable构件，其DatabaseName属性设为ProjectDB，它的TableName属性设为PROJECT(注意：必须已运行Interbase Server)。
名为Employee的TQuery构件，其DatabaseName属性设为ProjectDB，它的SQL语句如下：Select * From EMPLOYEE_PROJECT E Where E.PROJ_ID= :PROJ_ID
名为EmpProj的TQuery构件，其DatabaseName属性设为ProjectDB，它的SQL语句如下：Select EMP_NO,FULL_NAME From EMPLOYEE
名为UpdateQuery的TQuery构件，其DatabaseName属性设为ProjectDB，它的SQL语句目前是空的。
名为ProjectProvider的TProvider构件，其DataSet属性设为Project。
名为ProjectSource的TDataSource构件，其DataSet属性设为Project。编译并运行应用服务器。现在可以打开客户程序的项目，它的数据模块如图14.20所示。
图14.20 数据模块
客户程序的数据模块上有这么几个构件：
名为DCOMConnection的TDCOMConnection构件，其ServerName属性设为Serv.ProjectData。
名为Project的TClientDataSet构件，其RemoteServer属性设为DCOMConnection它的ProviderName属性设为ProjectProvider。并且建立了一个叫ProjectEmpProj的永久字段对象，它的类型是TDataSetField。与Project对应的TDataSource构件叫ProjectSource。
名为Emp_Proj的TClientDataSet构件，其RemoteServer属性和ProviderName属性都是空的，但它的DataSetField属性设为叫ProjectEmpProj的字段对象，这就构成了Master/Detail关系。与Emp_Proj对应的TDataSource构件叫EmpProjSource。
名为Employee的TClientDataSet构件，其RemoteServer属性指定了TDCOMConnection构件，但它的ProviderName属性设为Employee。与Employee对应的TDataSource构件叫EmployeeSource。
我们再来看客户程序的主窗体，如图14.21所示。
左边一个栅格只显示Project数据集中的PROJ_NAME字段即项目名称，“Product”框显示Project数据集中的PRODUCT字段，“Description”框显示Project数据集中的PROJ_DESC字段，并且用一个TDBNavigator构件为Project数据集导航。
右下角的栅格显示Emp_Proj数据集中一个叫EmployeeName的字段的值，这是个Lookup字段，它的LookupDataSet属性设为Employee，它的LookupKeyField属性设为EMP_NO，它的LookupResultField属性设为FULL_NAME。当用户用导航器浏览Project数据集的记录时，右下角的栅格就从Employee数据集中查找与EMP_NO字段匹配的记录，并且显示其中的FULL_NAME字段。
由于右下角的栅格只建立了一个永久的列对象，因此，可以把这一列的宽度设为与栅格本身同宽，它是在处理窗体的OnCreate事件的句柄中进行的。
Procedure TClientForm.FormCreate(Sender: TObject);
Begin
MemberGrid.Columns[0].Width :=MemberGrid.ClientWidth - GetSystemMetrics(SM_CXVSCROLL);
End;
由于一个项目中不止一个雇员，为了醒目起见，可以把其中的负责人加粗显示，这需要处理栅格的OnDrawColumnCell事件。
Procedure TClientForm.MemberGridDrawColumnCell(Sender: TObject; const Rect: TRect;DataCol: Integer;Column: TColumn;State: TGridDrawState);
Begin
If DM.ProjectTEAM_LEADER.Value = DM.Emp_ProjEMP_NO.Value then MemberGrid.Canvas.Font.Style := [fsBold];
MemberGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
End;
怎样来判断其中的负责人呢？在Project数据集中，有一个TEAM_LEADER 字段，它存储的是项目负责人的雇员编号。在Emp_Proj数据集中，有一个EMP_NO，它存储的也是雇员编号，如果这两者相等，即表示该雇员是项目负责人。当用户单击“Add”按钮，就可以在栅格中增加一条记录，即在项目中增加一个雇员。
Procedure TClientForm.AddBtnClick(Sender: TObject);
Begin
MemberGrid.SetFocus;
DM.Emp_Proj.Append;
MemberGrid.EditorMode := True;
End;
由于栅格事先建立了一个永久的列对象，而该列对象的FieldName属性指定了一个Lookup字段，所以，用户可以从一个组合框中选择一个值。
当用户单击“Delete”按钮，就删除当前记录，即一个雇员。
Procedure TClientForm.DeleteBtnClick(Sender: TObject);
Begin
DM.Emp_Proj.Delete;
End;
当用户先选择其中一个雇员，然后单击“Leader”按钮，就把该雇员设为项目负责人。
Procedure TClientForm.LeaderBtnClick(Sender: TObject);
var NewLeader: Integer;
Begin
NewLeader := DM.Emp_ProjEMP_NO.Value;
If not (DM.Project.State in dsEditModes) then DM.Project.Edit;
DM.ProjectTEAM_LEADER.Value := NewLeader;
MemberGrid.Refresh;
End;
增加、删除或修改了记录后，用户应当单击“Apply Update”按钮更新数据库。
Procedure TClientForm.ApplyUpdatesBtnClick(Sender: TObject);
Begin
DM.ApplyUpdates;
End;
在数据模块的单元中，ApplyUpdates是这样定义的：
Procedure TDM.ApplyUpdates;
Begin
If Project.ApplyUpdates(0) = 0 then Project.Refresh;
End;
可以看出，数据模块的ApplyUpdates又调用了TClientDataSet构件的ApplyUpdates，并且把MaxErrors参数设为0，这样，只要应用服务器发现有一个错误的记录，更新就停止。
当用户在左边的栅格中试图增加一个新的项目时，会触发TClientDataSet构件的OnNewRecord事件。由于这个栅格只显示了PROJ_NAME字段，用户不能直接输入PROJ_ID字段的值，因此，程序在处理OnNewRecord事件的句柄中推出一个输入框，让用户输入PROJ_ID字段的值。如果用户输入的字符超过了该字段允许的长度，就触发一个异常。
如果用户没有输入任何字符，也触发一个异常。
Procedure TDM.ProjectNewRecord(DataSet: TDataSet);
va rValue: String;
Begin
If InputQuery('Project ID','Enter Project ID:',Value) then
Begin
If Length(Value) > ProjectPROJ_ID.Size then
Raise Exception.CreateFmt('Project ID can only be %d characters',[ProjectPROJ_ID.Size]);If Length(Value) = 0 then
Raise Exception.Create('Project ID is required');
End
Else
SysUtils.Abort;
ProjectPROJ_ID.Value := Value;
End;
由于Project数据集与Employee数据集之间存在着Master/Detail关系，当删除Project数据集的一条记录时，应当先删除Employee数据集中关联的记录。应用服务器利用TProvider构件的BeforeUpdateRecord事件实现了这一点。
Procedure TProjectData.ProjectProviderBeforeUpdateRecord(Sender: TObject; SourceDS: TDataSet;DeltaDS: TClientDataSet; UpdateKind: TUpdateKind; var Applied: Boolean);
Const DeleteQuery = 'Delete From EMPLOYEE_PROJECT where PROJ_ID = :ProjID';
Begin
If (UpdateKind = ukDelete) and (SourceDS = Project) then
Begin
UpdateQuery.SQL.Text := DeleteQuery;
UpdateQuery.Params[0].AsString := DeltaDS.FieldByName('PROJ_ID').AsString;
UpdateQuery.ExecSQL;
End;
End;
14.9 一个动态设置查询参数的示范程序
这一节剖析一个动态设置查询参数的示范程序，它可以在C:/ProgramFiles/Borland/Delphi4/ Demos/ Midas/Setparam目录中找到。
这个程序分为应用服务器和客户程序两个部分。当客户程序通过TClientDataSet构件的Params属性设置参数时，这些参数会自动地传递给应用服务器上的TQuery构件，这样就能够根据用户的要求来查询数据库，这就是本示范程序的基本思路。
我们来剖析应用服务器，先看它的数据模块，如图14.24所示。图14.24 数据模块数据模块上只有一个TQuery构件，它的DatabaseName属性设为DBDEMOS，它的SQL语句如下：
Select * From EventsWhere Event_Date >= :Start_Date and Event_Date <= :End_Date Order by Event_Date
可以看出，这个SQL语句中有两个参数，一个是:Start_Date，另一个是:End_Date。
现在我们暂时不管数据模块，再来看看应用服务器的主窗体，如图14.25所示。
图14.25 应用服务器的主窗体
主窗体上显示两个计数，一个是当前连接应用服务器的客户数(Clients)，另一个是已经执行的查询次数(Queries)。用什么来判断当前的客户数，这与数据模块的实例方式有关。我们可以回到数据模块的单元，看看它的初始化代码：
Initialization
TComponentFactory.Create(ComServer, TSetParamDemo,
Class_SetParamDemo, ciMultiInstance);
End.
可以看出，这个数据模块的实例方式设为ciMultiInstance，表示每当有一个客户连接应用服务器，就会创建数据模块的一个新的实例。因此，数据模块的实例数就是当前的客户数。怎样统计数据模块的实例数呢？很简单，只要处理数据模块的OnCreate事件。
Procedure TSetParamDemo.SetParamDemoCreate(Sender: TObject);
Begin
MainForm.UpdateClientCount(1);
End;
当一个客户退出连接，将删除一个数据模块的实例，此时将触发数据模块的OnDestroy事件：
Procedure TSetParamDemo.SetParamDemoCreate(Sender: TObject);
Begin
MainForm.UpdateClientCount(1);
End;
其中，UpdateClientCount是在主窗体的单元中定义的：
Procedure TMainForm.UpdateClientCount(Incr: Integer);
Begin
FClientCount := FClientCount + Incr;
ClientCount.Caption := IntToStr(FClientCount);
End;
请注意Incr参数的作用。怎样统计已经执行过的查询数呢？也很简单，只要统计TQuery构件被激活的次数就可以了。因此，程序处理了TQuery构件的AfterOpen事件。
Procedure TSetParamDemo.EventsAfterOpen(DataSet: TDataSet);
Begin
MainForm.IncQueryCount;
End;
IncQueryCount是在主窗体的单元中定义的：
Procedure TMainForm.IncQueryCount;
Begin
Inc(FQueryCount);
QueryCount.Caption := IntToStr(FQueryCount);
End;
编译和运行这个应用服务器。打开客户程序的项目，它的主窗体如图14.26所示。
窗体上有一个TDCOMConnection构件用于连接应用服务器，有一个叫Events的TClientDataSet构件，用于引入数据集。
“Starting Date”框用于输入:Start_Date参数的值，
“Ending Date”框用于输入:End_Date参数的值。中间的栅格用于显示查询的结果。“Description”框用于显示Event_Description字段的值。“Photo”框用于显示Event_Photo字段的值。
客户程序在处理窗体的OnCreate事件的句柄中对“Starting Date”框和“EndingDate”框进行初始化。
Procedure TForm1.FormCreate(Sender: TObject);
Begin
StartDate.Text := DateToStr(EncodeDate(96, 6, 19));
EndDate.Text := DateToStr(EncodeDate(96, 6, 21));
End;
用户可以在这两个框中重新输入其他日期，然后单击“Show Events”按钮。
Procedure TForm1.ShowEventsClick(Sender: TObject);
Begin
Events.Close;
Events.Params.ParamByName('Start_Date').AsDateTime:=StrToDateTime(StartDate.Text);Events.Params.ParamByName('End_Date').AsDateTime :=StrToDateTime(EndDate.Text);
Events.Open;
End;
首先，要调用TClientDataset构件的Close关闭数据集，然后分别设置Start_Date参数和End_Date参数的值，最后，调用TClientDataset构件的Open打开数据集，此时，这两个参数就被自动传递给应用服务器上的TQuery构件。
