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构件。