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事件，程序就把下面的柵格中選擇的字段作為關鍵字段?！癓ocate”頁如圖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。編譯并運行應用服務器?，F在可以打開客戶程序的項目，它的數據模塊如圖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參數的值。中間的柵格用于顯示查詢的結果?！癉escription”框用于顯示Event_Description字段的值?！癙hoto”框用于顯示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構件。
