home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Runimage / Delphi50 / Demos / Ado / Adotest / adomain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  72.9 KB  |  2,484 lines
  1. unit AdoMain;
  2.  
  3. { Test program for ADO Components }
  4.  
  5. interface
  6.  
  7. uses
  8.   Windows, Sysutils, Forms, IniFiles, ImgList, Controls, Classes,
  9.   ActnList, Menus, Dialogs, ComCtrls, ComObj, ToolWin, Db, ADOInt,
  10.   Grids, DBGrids, Provider, ADODB, DBClient, DBCtrls, ExtCtrls,
  11.   StdCtrls, Buttons, SQLEdit;
  12.  
  13. type
  14.   TADODBTest = class(TForm)
  15.     Connection: TADOConnection;
  16.     MasterTable: TADOTable;
  17.     DetailTable: TADOTable;
  18.     MasterQuery: TADOQuery;
  19.     DetailQuery: TADOQuery;
  20.     MasterProc: TADOStoredProc;
  21.     ADODataSet: TADODataSet;
  22.     Provider: TDataSetProvider;
  23.     MasterClientData: TClientDataSet;
  24.     MasterDataSource: TDataSource;
  25.     DetailDataSource: TDataSource;
  26.     DetailGrid: TDBGrid;
  27.     MasterGrid: TDBGrid;
  28.     DBMemo1: TDBMemo;
  29.     DBImage1: TDBImage;
  30.  
  31.     { Actions }
  32.     ActionList1: TActionList;
  33.     SaveToFile: TAction;
  34.     OpenQuery: TAction;
  35.     OpenTable: TAction;
  36.     BatchUpdate: TAction;
  37.     ExitApplication: TAction;
  38.     CloseActiveDataSet: TAction;
  39.     LoadFromFile: TAction;
  40.     CancelBatch: TAction;
  41.     ExecuteCommand: TAction;
  42.     StreamFormOut: TAction;
  43.     StreamFormIn: TAction;
  44.     ClearField: TAction;
  45.     ViewEvents: TAction;
  46.     PrevQuery: TAction;
  47.     NextQuery: TAction;
  48.     RefreshData: TAction;
  49.     ClearEventLog: TAction;
  50.     DisplayDetails: TAction;
  51.     HelpAbout: TAction;
  52.     UseClientCursor: TAction;
  53.     UseTableDirect: TAction;
  54.     UseShapeProvider: TAction;
  55.     AsyncConnect: TAction;
  56.     AsyncExecute: TAction;
  57.     AsyncFetch: TAction;
  58.     OpenProcedure: TAction;
  59.     MainMenu1: TMainMenu;
  60.     FileReopen: TMenuItem;
  61.     FileMenu: TMenuItem;
  62.     PopupMenu1: TPopupMenu;
  63.     ToolBar1: TToolBar;
  64.     ImageList1: TImageList;
  65.     OpenDialog: TOpenDialog;
  66.     SaveDialog: TSaveDialog;
  67.     StatusBar: TStatusBar;
  68.     AreaSelector: TPageControl;
  69.     DataPanel: TPanel;
  70.     FilterPage: TTabSheet;
  71.     LocatePage: TTabSheet;
  72.     IndexPage: TTabSheet;
  73.     FieldsPage: TTabSheet;
  74.     SourcePage: TTabSheet;
  75.     IndexList: TListBox;
  76.     NavigatorPanel: TPanel;
  77.     BlobCtrlPanel: TPanel;
  78.     GridPanel: TPanel;
  79.     DBNavigator1: TDBNavigator;
  80.     Filter: TEdit;
  81.     FindFirst: TButton;
  82.     FindNext: TButton;
  83.     Filtered: TCheckBox;
  84.     IndexFields: TEdit;
  85.     PrevQuery1: TSpeedButton;
  86.     Events: TListBox;
  87.     DescFields: TEdit;
  88.     CaseInsFields: TEdit;
  89.     MasterTableName: TComboBox;
  90.     DetailTableName: TComboBox;
  91.     MasterSQL: TMemo;
  92.     DetailSQL: TMemo;
  93.     GridSplitter: TSplitter;
  94.     ClearEventsButton: TToolButton;
  95.     LocateEdit: TEdit;
  96.     LocateField: TComboBox;
  97.     locPartialKey: TCheckBox;
  98.     LocateNull: TCheckBox;
  99.     UseClientCursorItem: TMenuItem;
  100.     UseadCmdTableDirect1: TMenuItem;
  101.     CursorTypeItem: TMenuItem;
  102.     CurTypeKeyset: TMenuItem;
  103.     Dynamic1: TMenuItem;
  104.     CurTypeUnspecified: TMenuItem;
  105.     CurTypeForwardOnly: TMenuItem;
  106.     CurTypeStatic: TMenuItem;
  107.     DBEditScroller: TScrollBox;
  108.     LockTypeItem: TMenuItem;
  109.     LckTypeUnspecified: TMenuItem;
  110.     LckTypeReadOnly: TMenuItem;
  111.     LckTypePessimistic: TMenuItem;
  112.     LckTypeOptimistic: TMenuItem;
  113.     LckTypeBatchOptimistic: TMenuItem;
  114.     ReadOnlyLabel: TLabel;
  115.     ConnectionString: TComboBox;
  116.     EditConnStr: TSpeedButton;
  117.     Label1: TLabel;
  118.     Label2: TLabel;
  119.     ProcedureNames: TGroupBox;
  120.     TableNames: TGroupBox;
  121.     QueryStrings: TGroupBox;
  122.     MasterProcName: TComboBox;
  123.     Splitter1: TSplitter;
  124.     DetailMasterSource: TDataSource;
  125.     DetailQuerySource: TDataSource;
  126.     CloseConnection: TAction;
  127.     Disconnect1: TMenuItem;
  128.     BatchUpdates1: TMenuItem;
  129.     CancelBatch1: TMenuItem;
  130.     BatchUpdateButton: TToolButton;
  131.     CancelBatchButton: TToolButton;
  132.     AsyncConnect1: TMenuItem;
  133.     AsyncExecute1: TMenuItem;
  134.     AsyncFetch1: TMenuItem;
  135.     ADOCommand: TADOCommand;
  136.     ProgressBar: TProgressBar;
  137.     MaxRecords: TAction;
  138.     MaxRecords1: TMenuItem;
  139.     DetailProcName: TComboBox;
  140.     DetailProc: TADOStoredProc;
  141.     ToolButton1: TToolButton;
  142.     OpenProcedure1: TMenuItem;
  143.     DetailProcSource: TDataSource;
  144.     EditCommandText: TSpeedButton;
  145.     ParamPage: TTabSheet;
  146.     ParameterList: TListBox;
  147.     ParameterName: TEdit;
  148.     ParameterValue: TEdit;
  149.     ParameterSize: TEdit;
  150.     ParameterNameLabel: TLabel;
  151.     ParameterScale: TEdit;
  152.     ParameterPrecision: TEdit;
  153.     PTypeLabel: TLabel;
  154.     PValueLabel: TLabel;
  155.     PSizeLabel: TLabel;
  156.     PScaleLabel: TLabel;
  157.     PPrecisionLabel: TLabel;
  158.     ParameterDirectionGroup: TRadioGroup;
  159.     ParamAttributes: TGroupBox;
  160.     PANullableCheckBox: TCheckBox;
  161.     PASignedCheckBox: TCheckBox;
  162.     PALongCheckBox: TCheckBox;
  163.     AddParameterButton: TButton;
  164.     RefreshParametersButton: TButton;
  165.     ParameterType: TComboBox;
  166.     ToolButton3: TToolButton;
  167.     MidasApplyUpdatesButton: TToolButton;
  168.     MidasApplyUpdates: TAction;
  169.     ADOButton: TRadioButton;
  170.     MidasButton: TRadioButton;
  171.     MidasCancelUpdates: TAction;
  172.     MidasCancelButton: TToolButton;
  173.     ApplyUpdatesMidas1: TMenuItem;
  174.     CancelUpdatesMidas1: TMenuItem;
  175.     N6: TMenuItem;
  176.     SQLParams: TRadioButton;
  177.     ProcParams: TRadioButton;
  178.     TestButton: TButton;
  179.     FieldSchemaGrid: TDBGrid;
  180.     FieldSchemaSource: TDataSource;
  181.     FieldSchema: TADODataSet;
  182.     FieldSchemaCOLUMN_NAME: TWideStringField;
  183.     FieldSchemaDATA_TYPE: TWordField;
  184.     FieldSchemaNUMERIC_PRECISION: TWordField;
  185.     FieldSchemaCHARACTER_MAXIMUM_LENGTH: TIntegerField;
  186.     FieldSchemaNUMERIC_SCALE: TSmallintField;
  187.     EnableBCD: TAction;
  188.     EnableBCD1: TMenuItem;
  189.     DisconnectDataSet: TAction;
  190.     DisconnectDataSet1: TMenuItem;
  191.     DetailClientData: TClientDataSet;
  192.     FilterGroupBox: TRadioGroup;
  193.     BlobAsImage: TAction;
  194.     BlobfieldasImage1: TMenuItem;
  195.     LoadBlobFromFile: TAction;
  196.     LoadBlobfromfile1: TMenuItem;
  197.     IndexOptions: TGroupBox;
  198.     idxCaseInsensitive: TCheckBox;
  199.     idxDescending: TCheckBox;
  200.     idxPrimary: TCheckBox;
  201.     idxUnique: TCheckBox;
  202.  
  203.     procedure FilterKeyPress(Sender: TObject; var Key: Char);
  204.     procedure FormCreate(Sender: TObject);
  205.     procedure FormDestroy(Sender: TObject);
  206.     procedure MasterSQLKeyPress(Sender: TObject; var Key: Char);
  207.     procedure IndexListClick(Sender: TObject);
  208.     procedure GridTitleClick(Column: TColumn);
  209.     procedure LocateButtonClick(Sender: TObject);
  210.     procedure FindFirstClick(Sender: TObject);
  211.     procedure FilterExit(Sender: TObject);
  212.     procedure DataSourceDataChange(Sender: TObject; Field: TField);
  213.     procedure DataSetAfterOpen(DataSet: TDataSet);
  214.     procedure LocateFieldDropDown(Sender: TObject);
  215.     procedure FindNextClick(Sender: TObject);
  216.     procedure MasterTableNameClick(Sender: TObject);
  217.     procedure PopupMenu1Popup(Sender: TObject);
  218.     procedure FieldSelect(Sender: TObject);
  219.     procedure GridColEnter(Sender: TObject);
  220.     procedure StreamFormOutClick(Sender: TObject);
  221.     procedure StreamFormInClick(Sender: TObject);
  222.     procedure LoadFromFileExecute(Sender: TObject);
  223.     procedure SaveToFileExecute(Sender: TObject);
  224.     procedure EditActionsUpdate(Sender: TObject);
  225.     procedure FieldsPageShow(Sender: TObject);
  226.     procedure OpenQueryExecute(Sender: TObject);
  227.     procedure ExecSQLExecute(Sender: TObject);
  228.     procedure OpenTableExecute(Sender: TObject);
  229.     procedure BatchUpdateExecute(Sender: TObject);
  230.     procedure MasterTableNameDropDown(Sender: TObject);
  231.     procedure ConnectionStringClick(Sender: TObject);
  232.     procedure ConnectionStringKeyPress(Sender: TObject; var Key: Char);
  233.     procedure FilteredClick(Sender: TObject);
  234.     procedure FilterPageShow(Sender: TObject);
  235.     procedure IndexPageShow(Sender: TObject);
  236.     procedure ExitApplicationExecute(Sender: TObject);
  237.     procedure CloseActiveDataSetExecute(Sender: TObject);
  238.     procedure FileActionsUpdate(Sender: TObject);
  239.     procedure MasterTableNameKeyPress(Sender: TObject; var Key: Char);
  240.     procedure DetailTableNameClick(Sender: TObject);
  241.     procedure MasterTableAfterOpen(DataSet: TDataSet);
  242.     procedure MasterTableBeforeClose(DataSet: TDataSet);
  243.     procedure GridSetFocus(Sender: TObject);
  244.     procedure LocatePageShow(Sender: TObject);
  245.     procedure LocateNullClick(Sender: TObject);
  246.     procedure DataSetAfterScroll(DataSet: TDataSet);
  247.     procedure DataSetBeforeCancel(DataSet: TDataSet);
  248.     procedure DataSetBeforeClose(DataSet: TDataSet);
  249.     procedure DataSetBeforeDelete(DataSet: TDataSet);
  250.     procedure DataSetBeforeEdit(DataSet: TDataSet);
  251.     procedure DataSetBeforeInsert(DataSet: TDataSet);
  252.     procedure DataSetBeforePost(DataSet: TDataSet);
  253.     procedure DataSetBeforeScroll(DataSet: TDataSet);
  254.     procedure DataSetCalcFields(DataSet: TDataSet);
  255.     procedure DataSetError(DataSet: TDataSet; E: EDatabaseError;
  256.       var Action: TDataAction);
  257.     procedure DataSetNewRecord(DataSet: TDataSet);
  258.     procedure DataSetAfterPost(DataSet: TDataSet);
  259.     procedure DataSetAfterInsert(DataSet: TDataSet);
  260.     procedure DataSetAfterEdit(DataSet: TDataSet);
  261.     procedure DataSetAfterDelete(DataSet: TDataSet);
  262.     procedure DataSetAfterCancel(DataSet: TDataSet);
  263.     procedure MasterQueryAfterOpen(DataSet: TDataSet);
  264.     procedure MasterQueryBeforeClose(DataSet: TDataSet);
  265.     procedure CancelBatchExecute(Sender: TObject);
  266.     procedure ClearFieldExecute(Sender: TObject);
  267.     procedure ViewEventsExecute(Sender: TObject);
  268.     procedure DisplayDetailsExecute(Sender: TObject);
  269.     procedure DataSourceStateChange(Sender: TObject);
  270.     procedure DataSourceUpdateData(Sender: TObject);
  271.     procedure RefreshDataExecute(Sender: TObject);
  272.     procedure ClearEventLogExecute(Sender: TObject);
  273.     procedure ClearEventLogUpdate(Sender: TObject);
  274.     procedure HelpAboutExecute(Sender: TObject);
  275.     procedure DataSetAfterClose(DataSet: TDataSet);
  276.     procedure FileMenuClick(Sender: TObject);
  277.     procedure ClosedFileClick(Sender: TObject);
  278.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  279.     procedure PrevQueryExecute(Sender: TObject);
  280.     procedure PrevQueryUpdate(Sender: TObject);
  281.     procedure NextQueryExecute(Sender: TObject);
  282.     procedure MasterTableAfterScroll(DataSet: TDataSet);
  283.     procedure MasterTableBeforeScroll(DataSet: TDataSet);
  284.     procedure RadioItemClick(Sender: TObject);
  285.     procedure DataSetBeforeOpen(DataSet: TDataSet);
  286.     procedure BooleanActionExecute(Sender: TObject);
  287.     procedure EditConnStrClick(Sender: TObject);
  288.     procedure MasterTableBeforeOpen(DataSet: TDataSet);
  289.     procedure DetailTableBeforeOpen(DataSet: TDataSet);
  290.     procedure MasterQueryBeforeOpen(DataSet: TDataSet);
  291.     procedure DetailQueryBeforeOpen(DataSet: TDataSet);
  292.     procedure MasterProcBeforeOpen(DataSet: TDataSet);
  293.     procedure UseShapeProviderExecute(Sender: TObject);
  294.     procedure OnFilterRecord(DataSet: TDataSet; var Accept: Boolean);
  295.     procedure BinaryGetText(Sender: TField; var Text: string;
  296.       DisplayText: Boolean);
  297.     procedure BinarySetText(Sender: TField; const Text: string);
  298.     procedure ConnectionBeginTransComplete(Connection: TADOConnection;
  299.       TransactionLevel: Integer; const Error: Error;
  300.       var EventStatus: TEventStatus);
  301.     procedure ConnectionCommitTransComplete(Connection: TADOConnection;
  302.       const Error: Error; var EventStatus: TEventStatus);
  303.     procedure ConnectionConnectComplete(Connection: TADOConnection;
  304.       const Error: Error; var EventStatus: TEventStatus);
  305.     procedure ConnectionDisconnect(Connection: TADOConnection;
  306.       var EventStatus: TEventStatus);
  307.     procedure ConnectionExecuteComplete(Connection: TADOConnection;
  308.       RecordsAffected: Integer; const Error: Error;
  309.       var EventStatus: TEventStatus; const Command: _Command;
  310.       const Recordset: _Recordset);
  311.     procedure ConnectionInfoMessage(Connection: TADOConnection;
  312.       const Error: Error; var EventStatus: TEventStatus);
  313.     procedure ConnectionRollbackTransComplete(Connection: TADOConnection;
  314.       const Error: Error; var EventStatus: TEventStatus);
  315.     procedure ConnectionWillConnect(Connection: TADOConnection;
  316.       var ConnectionString, UserID, Password: WideString;
  317.       var ConnectOptions: TConnectOption; var EventStatus: TEventStatus);
  318.     procedure ConnectionWillExecute(Connection: TADOConnection;
  319.       var CommandText: WideString; var CursorType: TCursorType;
  320.       var LockType: TADOLockType; var CommandType: TCommandType;
  321.       var ExecuteOptions: TExecuteOptions; var EventStatus: TEventStatus;
  322.       const Command: _Command; const Recordset: _Recordset);
  323.     procedure CloseConnectionExecute(Sender: TObject);
  324.     procedure DataSetFetchComplete(DataSet: TCustomADODataSet;
  325.       const Error: Error; var EventStatus: TEventStatus);
  326.     procedure ExceptionHandler(Sender: TObject; E: Exception);
  327.     procedure ConnectionLogin(Sender: TObject; Username, Password: String);
  328.     procedure MasterGridColumnMoved(Sender: TObject; FromIndex,
  329.       ToIndex: Integer);
  330.     procedure MaxRecordsExecute(Sender: TObject);
  331.     procedure ProcNameDropDown(Sender: TObject);
  332.     procedure MasterProcNameKeyPress(Sender: TObject; var Key: Char);
  333.     procedure MasterProcNameClick(Sender: TObject);
  334.     procedure DetailProcNameClick(Sender: TObject);
  335.     procedure OpenProcedureExecute(Sender: TObject);
  336.     procedure DetailProcBeforeOpen(DataSet: TDataSet);
  337.     procedure MasterProcAfterOpen(DataSet: TDataSet);
  338.     procedure EditCommandTextClick(Sender: TObject);
  339.     procedure ParamPageShow(Sender: TObject);
  340.     procedure RefreshParametersButtonClick(Sender: TObject);
  341.     procedure ParameterListClick(Sender: TObject);
  342.     procedure AddParameterButtonClick(Sender: TObject);
  343.     procedure ParameterDataChange(Sender: TObject);
  344.     procedure MasterSQLChange(Sender: TObject);
  345.     procedure MidasApplyUpdatesExecute(Sender: TObject);
  346.     procedure ADOButtonClick(Sender: TObject);
  347.     procedure MidasButtonClick(Sender: TObject);
  348.     procedure MasterClientDataReconcileError(DataSet: TClientDataSet;
  349.       E: EReconcileError; UpdateKind: TUpdateKind;
  350.       var Action: TReconcileAction);
  351.     procedure MidasCancelUpdatesExecute(Sender: TObject);
  352.     procedure ParameterSourceClick(Sender: TObject);
  353.     procedure FieldSchemaDATA_TYPEGetText(Sender: TField; var Text: String;
  354.       DisplayText: Boolean);
  355.     procedure DisconnectDataSetExecute(Sender: TObject);
  356.     procedure FieldValidate(Sender: TField);
  357.     procedure TestButtonClick(Sender: TObject);
  358.     procedure DataSetFetchProgress(DataSet: TCustomADODataSet; Progress,
  359.       MaxProgress: Integer; var EventStatus: TEventStatus);
  360.     procedure FilterGroupBoxClick(Sender: TObject);
  361.     procedure BlobAsImageUpdate(Sender: TObject);
  362.     procedure BlobAsImageExecute(Sender: TObject);
  363.     procedure LoadBlobFromFileExecute(Sender: TObject);
  364.   private
  365.     FConfig: TIniFile;
  366.     FMaxErrors: Integer;
  367.     FPacketRecs: Integer;
  368.     FActiveDataSet: TDataSet;
  369.     FADOSource: TCustomADODataSet;
  370.     FActiveDataSource: TDataSource;
  371.     FStatusMsg: string;
  372.     FClosedTables: TStringList;
  373.     FMasterQueries: TStringList;
  374.     FDetailQueries: TStringList;
  375.     FQueryIndex: Integer;
  376.     FModifiedParameter: Integer;
  377.     FMovingColumn: Boolean;
  378.     FParamSource: TParameters;
  379.     FLastDataFile: String;
  380.     FLastFormFile: String;
  381.  
  382.     function GetConfigFile: TIniFile;
  383.     procedure RefreshIndexNames;
  384.     procedure SetActiveDataSet(Value: TDataSet);
  385.     procedure SetEventsVisible(Visible: Boolean);
  386.     procedure SetQueryText;
  387.     procedure SetStatusMsg(const Msg: string);
  388.     procedure ShowHeapStatus(Sender: TObject; var Done: Boolean);
  389.     procedure UpdateReOpenMenu;
  390.     procedure OnHint(Sender: TObject);
  391.     procedure ClearProgressBar;
  392.     procedure ShowProgressBar(const Msg: string);
  393.     procedure ProcessQuery(SelectQuery: Boolean);
  394.     procedure WriteParameterData;
  395.     procedure UpdateParameterList;
  396.     procedure ShowIndexParams;
  397.     procedure SetRecordSetEvents(Hook: Boolean; DataSet: TCustomADODataSet);
  398.     function GetActiveDataSet: TDataSet;
  399.   public
  400.     procedure BindControls(DataSet: TDataSet);
  401.     procedure CheckConnection(CloseFirst: Boolean = False);
  402.     procedure OpenDataSet(Source: TCustomADODataSet);
  403.     procedure StreamSettings(Write: Boolean);
  404.     procedure LogEvent(const EventStr: string; Component: TComponent = nil);
  405.     procedure RefreshParameters(Parameters: TParameters);
  406.     property StatusMsg: string read FStatusMsg write SetStatusMsg;
  407.     property ActiveDataSet: TDataSet read GetActiveDataSet write SetActiveDataSet;
  408.     property ActiveDataSource: TDataSource read FActiveDataSource write FActiveDataSource;
  409.     property ADOSource: TCustomADODataSet read FADOSource write FADOSource;
  410.     property ConfigFile: TIniFile read GetConfigFile;
  411.   end;
  412.  
  413. var
  414.   ADODBTest: TADODBTest;
  415.  
  416. implementation
  417.  
  418. uses
  419.   OLEDB, DBLogDlg, ADOConEd, RecError;
  420.  
  421. procedure ShowProperties(Props: Properties);
  422. var
  423.   I: Integer;
  424.   F: TForm;
  425.   Button: TButton;
  426. begin
  427.   F := CreateMessageDialog('', mtInformation, [mbCancel]);
  428.   F.Height := Screen.Height div 2;
  429.   F.Width := Screen.Width div 2;
  430.   Button := F.Components[2] as TButton;
  431.   Button.Top := F.ClientHeight - Button.Height - 5;
  432.   Button.Left := (F.ClientWidth - Button.Width) div 2;
  433.   F.Caption := 'Properties';
  434.   with TMemo.Create(F) do
  435.   begin
  436.     SetBounds(5, 5, F.ClientWidth-10, F.ClientHeight - 40);
  437.     Parent := F;
  438.     for I := 0 to Props.Count - 1 do
  439.       with Props[I] do
  440.         Lines.Add(Format('%-30s: %s', [Name, VarToStr(Value)]));
  441.   end;
  442.   F.ShowModal;
  443. end;
  444.  
  445. {$R *.DFM}
  446.  
  447. procedure TADODBTest.FormCreate(Sender: TObject);
  448.  
  449.   procedure SetupControls;
  450.   var
  451.     I: Integer;
  452.   begin
  453.     for I := 0 to StatusBar.Panels.Count - 1 do
  454.       StatusBar.Panels[I].Text := '';
  455.     ProgressBar.Parent := StatusBar;
  456.     ProgressBar.SetBounds(0, 2, StatusBar.Panels[0].Width, StatusBar.Height - 2);
  457.     { Set these dynamically since the form may have been scaled }
  458.     DataPanel.Constraints.MinWidth := DataPanel.Width;
  459.     AreaSelector.Constraints.MinWidth := AreaSelector.Width;
  460.     Constraints.MinHeight := Height - (DataPanel.Height - DataPanel.Constraints.MinHeight);
  461.     SetEventsVisible(ViewEvents.Checked);
  462.   end;
  463.  
  464. begin
  465.   FMaxErrors := -1;
  466.   FPacketRecs := -1;
  467.   FModifiedParameter := -1;
  468.   ActiveDataSource := MasterDataSource;
  469.   SetCurrentDirectory(PChar(ExtractFilePath(ParamStr(0))));
  470.   Application.OnIdle := ShowHeapStatus;
  471.   Application.OnHint := OnHint;
  472.   FClosedTables := TStringList.Create;
  473.   FMasterQueries := TStringList.Create;
  474.   FDetailQueries := TStringList.Create;
  475.   StreamSettings(False);
  476.   SetupControls;
  477.   ParameterSourceClick(Self);
  478. end;
  479.  
  480. procedure TADODBTest.FormDestroy(Sender: TObject);
  481. begin
  482.   if Assigned(FConfig) then
  483.     StreamSettings(True);
  484.   FConfig.Free;
  485.   FDetailQueries.Free;
  486.   FMasterQueries.Free;
  487.   FClosedTables.Free;
  488. end;
  489.  
  490. procedure TADODBTest.ExitApplicationExecute(Sender: TObject);
  491. begin
  492.   Application.Terminate;
  493. end;
  494.  
  495. procedure TADODBTest.HelpAboutExecute(Sender: TObject);
  496. begin
  497.   ShowMessage(Caption+#13#10+'Copyright (c) 1999 Inprise Corporation');
  498. end;
  499.  
  500. procedure TADODBTest.OnHint(Sender: TObject);
  501. begin
  502.   if FindVCLWindow(Mouse.CursorPos) <> ConnectionString then
  503.     ConnectionString.Hint := ConnectionString.Text;
  504.   StatusMsg := Application.Hint;
  505. end;
  506.  
  507. procedure TADODBTest.ExceptionHandler(Sender: TObject; E: Exception);
  508. begin
  509.   ClearProgressBar;
  510.   SysUtils.ShowException(ExceptObject, ExceptAddr);
  511. end;
  512.  
  513. { View Options }
  514.  
  515. procedure TADODBTest.SetEventsVisible(Visible: Boolean);
  516. var
  517.   EventsWidth: Integer;
  518. begin
  519.   Constraints.MinWidth := 0;
  520.   if Events.Visible <> Visible then
  521.   begin
  522.     DataPanel.Anchors := DataPanel.Anchors - [akRight];
  523.     AreaSelector.Anchors := AreaSelector.Anchors  - [akRight];
  524.     try
  525.       EventsWidth := Events.Width + 5;
  526.       Events.Visible := Visible;
  527.       if not Visible then
  528.         EventsWidth := -EventsWidth;
  529.       ClientWidth := ClientWidth + EventsWidth;
  530.     finally
  531.       DataPanel.Anchors := DataPanel.Anchors + [akRight];
  532.       AreaSelector.Anchors := AreaSelector.Anchors  + [akRight];
  533.     end;
  534.   end;
  535.   if Visible then
  536.     Constraints.MinWidth := DataPanel.Constraints.MinWidth + Events.Width + 22 else
  537.     Constraints.MinWidth := DataPanel.Constraints.MinWidth + 18;
  538. end;
  539.  
  540. procedure TADODBTest.ViewEventsExecute(Sender: TObject);
  541. begin
  542.   ViewEvents.Checked := not ViewEvents.Checked;
  543.   SetEventsVisible(ViewEvents.Checked);
  544. end;
  545.  
  546. procedure TADODBTest.DisplayDetailsExecute(Sender: TObject);
  547. begin
  548.   DisplayDetails.Checked := not DisplayDetails.Checked;
  549. end;
  550.  
  551. { Settings }
  552.  
  553. function TADODBTest.GetConfigFile: TIniFile;
  554. begin
  555.   if FConfig = nil then
  556.     FConfig := TIniFile.Create(ChangeFileExt(ParamStr(0), '.INI'));
  557.   Result := FConfig;
  558. end;
  559.  
  560. procedure TADODBTest.StreamSettings(Write: Boolean);
  561.  
  562.   procedure WriteStr(const OptName: string; Value: Variant);
  563.   begin
  564.     FConfig.WriteString('Settings', OptName, Value);
  565.   end;
  566.  
  567.   procedure WriteBool(const OptName: string; Value: Boolean);
  568.   begin
  569.     FConfig.WriteBool('Settings', OptName, Value);
  570.   end;
  571.  
  572.   procedure WriteStrings(const SectName: string; Values: TStrings);
  573.   var
  574.     I: Integer;
  575.   begin
  576.     FConfig.EraseSection(SectName);
  577.     for I := 0 to Values.Count - 1 do
  578.       FConfig.WriteString(SectName, IntToStr(I), Values[I]);
  579.   end;
  580.  
  581.   function ReadStr(const OptName: string): Variant;
  582.   begin
  583.     Result := FConfig.ReadString('Settings', OptName, '');
  584.   end;
  585.  
  586.   function ReadBool(const OptName: string): Boolean;
  587.   begin
  588.     Result := FConfig.ReadBool('Settings', OptName, False);
  589.   end;
  590.  
  591.   procedure ReadStrings(const SectName: string; Values: TStrings);
  592.   var
  593.     I: Integer;
  594.     S: string;
  595.   begin
  596.     for I := 0 to 99 do
  597.     begin
  598.       S := FConfig.ReadString(SectName, IntToStr(I), '');
  599.       if S = '' then Break;
  600.       Values.Add(S);
  601.     end;
  602.   end;
  603.  
  604.   function FindPage(const PageName: string): TTabSheet;
  605.   var
  606.     I: Integer;
  607.   begin
  608.     for I := AreaSelector.PageCount - 1 downto 0 do
  609.     begin
  610.       Result := AreaSelector.Pages[I];
  611.       if Result.Caption = PageName then Exit;
  612.     end;
  613.     Result := SourcePage;
  614.   end;
  615.  
  616.   procedure ProcessComponents(Components: array of TComponent);
  617.   var
  618.     I,J: Integer;
  619.   begin
  620.     if Write then
  621.     begin
  622.       for I := Low(Components) to High(Components) do
  623.         if Components[I] is TCustomEdit then
  624.           with TEdit(Components[I]) do
  625.             WriteStr(Name, Text)
  626.         else if Components[I] is TComboBox then
  627.           with TDBComboBox(Components[I]) do
  628.             WriteStr(Name, Text)
  629.         else if Components[I] is TCheckBox then
  630.           with TCheckBox(Components[I]) do
  631.             WriteBool(Name, Checked)
  632.         else if Components[I] is TRadioButton then
  633.           with TRadioButton(Components[I]) do
  634.             WriteBool(Name, Checked)
  635.         else if Components[I] is TAction then
  636.           with TAction(Components[I]) do
  637.             WriteBool(Name, Checked)
  638.         else if Components[I] is TPageControl then
  639.           with TPageControl(Components[I]) do
  640.             WriteStr(Name, ActivePage.Caption)
  641.         else if Components[I] is TMenuItem then
  642.           with TMenuItem(Components[I]) do
  643.             for J := 0 to Count-1 do
  644.               if Items[J].Checked then
  645.               begin
  646.                 WriteStr(Name, J);
  647.                 System.Break;
  648.               end;
  649.     end
  650.     else
  651.     begin
  652.       for I := Low(Components) to High(Components) do
  653.         if Components[I] is TCustomEdit then
  654.           with TEdit(Components[I]) do
  655.             Text := ReadStr(Name)
  656.         else if Components[I] is TComboBox then
  657.           with TComboBox(Components[I]) do
  658.             Text := ReadStr(Name)
  659.         else if Components[I] is TCheckBox then
  660.           with TCheckBox(Components[I]) do
  661.             Checked := ReadBool(Name)
  662.         else if Components[I] is TRadioButton then
  663.           with TRadioButton(Components[I]) do
  664.             Checked := ReadBool(Name)
  665.         else if Components[I] is TAction then
  666.           with TAction(Components[I]) do
  667.             Checked := ReadBool(Name)
  668.         else if Components[I] is TPageControl then
  669.           with TPageControl(Components[I]) do
  670.             ActivePage := FindPage(ReadStr(Name))
  671.         else if Components[I] is TMenuItem then
  672.           with TMenuItem(Components[I]) do
  673.             Items[ReadStr(Name)].Checked := True;
  674.     end;
  675.   end;
  676.  
  677. begin
  678.   GetConfigFile;
  679.   if not Write and (ReadStr('AreaSelector') = '') then
  680.   begin
  681.     ConnectionString.Text := 'FILE NAME=' + DataLinkDir + '\DBDEMOS.UDL';
  682.     Exit;
  683.   end;
  684.   ProcessComponents([AreaSelector, ConnectionString, MasterTableName,
  685.     DetailTableName, MasterProcName, DetailProcName, MasterSQL, DetailSQL, ViewEvents, DisplayDetails,
  686.     UseClientCursor, UseTableDirect, UseShapeProvider, CursorTypeItem,
  687.     LockTypeItem, AsyncConnect, AsyncExecute, AsyncFetch, MidasButton,
  688.     ProcParams, EnableBCD]);
  689.   if Write then
  690.   begin
  691.     WriteStrings('ConnectionStrings', ConnectionString.Items);
  692.     WriteStrings('ClosedTables', FClosedTables);
  693.     WriteStrings('MasterQueries', FMasterQueries);
  694.     WriteStrings('DetailQueries', FDetailQueries);
  695.     FConfig.UpdateFile;
  696.   end else
  697.   begin
  698.     ReadStrings('ConnectionStrings', ConnectionString.Items);
  699.     ReadStrings('ClosedTables', FClosedTables);
  700.     ReadStrings('MasterQueries', FMasterQueries);
  701.     ReadStrings('DetailQueries', FDetailQueries);
  702.   end;
  703. end;
  704.  
  705. procedure TADODBTest.RadioItemClick(Sender: TObject);
  706. begin
  707.   (Sender as TMenuItem).Checked := True;
  708. end;
  709.  
  710. procedure TADODBTest.BooleanActionExecute(Sender: TObject);
  711. begin
  712.   TAction(Sender).Checked := not TAction(Sender).Checked;
  713. end;
  714.  
  715. procedure TADODBTest.UseShapeProviderExecute(Sender: TObject);
  716. begin
  717.   BooleanActionExecute(Sender);
  718.   Connection.Close;
  719. end;
  720.  
  721. procedure TADODBTest.MaxRecordsExecute(Sender: TObject);
  722. var
  723.   MaxRecs: string;
  724. begin
  725.   MaxRecs := IntToStr(MaxRecords.Tag);
  726.   if InputQuery(Application.Title,  MaxRecords.Hint, MaxRecs) then
  727.     MaxRecords.Tag := StrToInt(MaxRecs);
  728. end;
  729.  
  730. { Status Information }
  731.  
  732. procedure TADODBTest.ShowHeapStatus(Sender: TObject; var Done: Boolean);
  733. begin
  734.   Caption := Format('ADO DB Controls Test Application - (Blocks=%d Bytes=%d)',
  735.     [AllocMemCount, AllocMemSize]);
  736. end;
  737.  
  738. procedure TADODBTest.SetStatusMsg(const Msg: string);
  739. begin
  740.   StatusBar.Panels[0].Text := Msg;
  741. end;
  742.  
  743. procedure TADODBTest.ShowProgressBar(const Msg: string);
  744. begin
  745.   ProgressBar.Show;
  746.   StatusBar.Panels[3].Text := Msg+'...';
  747.   while ProgressBar.Visible do
  748.   begin
  749.     ProgressBar.StepIt;
  750.     Application.ProcessMessages;
  751.     Sleep(ProgressBar.Position);
  752.   end;
  753. end;
  754.  
  755. procedure TADODBTest.ClearProgressBar;
  756. begin
  757.   ProgressBar.Hide;
  758.   ProgressBar.Position := 0;
  759.   StatusBar.Panels[3].Text := '';
  760. end;
  761.  
  762. procedure TADODBTest.DataSourceDataChange(Sender: TObject;
  763.   Field: TField);
  764. const
  765.   StatusStrs: array[TUpdateStatus] of string = ('Unmodified',
  766.     'Modified', 'Inserted', 'Deleted');
  767. begin
  768.   if (Sender = ActiveDataSource) and Assigned(ActiveDataSource.DataSet) and ActiveDataSource.DataSet.IsSequenced then
  769.   begin
  770.     with ActiveDataSource.DataSet do
  771.     begin
  772.       if IsEmpty then
  773.       begin
  774.         StatusBar.Panels[1].Text := '';
  775.         StatusBar.Panels[3].Text := '(empty)';
  776.       end else
  777.       begin
  778.         StatusBar.Panels[1].Text := StatusStrs[UpdateStatus];
  779.         if (State = dsBrowse) and (Field = nil) then
  780.         begin
  781.           StatusBar.Panels[3].Text := Format('%d of %d', [RecNo, RecordCount]);
  782.           StatusMsg := '';
  783.         end;
  784.       end;
  785.       if ActiveControl is TDBGrid then
  786.         GridColEnter(TDBGrid(ActiveControl));
  787.     end;
  788.   end;
  789.   LogEvent('OnDataChange', Sender as TComponent);
  790. end;
  791.  
  792. procedure TADODBTest.GridColEnter(Sender: TObject);
  793. const
  794.   NullStr: array[Boolean] of string = ('','[NULL]');
  795. var
  796.   Field: TField;
  797.  
  798.   procedure TrackBlobs;
  799.   begin
  800.     if Field.DataSet <> MasterDataSource.DataSet then Exit;
  801.     if (Field is TMemoField) and (Field <> DBMemo1.Field) then
  802.       DBMemo1.DataField := Field.FieldName
  803.     else if (Field is TGraphicField) and (Field <> DBImage1.Field) then
  804.       DBImage1.DataField := Field.FieldName;
  805.   end;
  806.  
  807.   procedure ShowOriginalValues;
  808.   var
  809.     V: Variant;
  810.   begin
  811.     if Field.Dataset.CanModify then
  812.     begin
  813.       V := Field.OldValue;
  814.       if not VarIsNull(V) and (V <> Field.Value) then
  815.         StatusMsg := Format('Orignal Value: %s', [VarToStr(V)]) else
  816.         StatusMsg := '';
  817.     end;
  818.   end;
  819.  
  820. begin
  821.   Field := (Sender as TDBGrid).SelectedField;
  822.   if Assigned(Field) then
  823.   begin
  824.     (Sender as TDBGrid).Hint := Field.ClassName;
  825.     StatusBar.Panels[0].Text := Field.ClassName;
  826.     StatusBar.Panels[2].Text := NullStr[Field.IsNull];
  827.     TrackBlobs;
  828.     if ActiveDataSet.UpdateStatus = usModified then
  829.       ShowOriginalValues;
  830.   end;
  831. end;
  832.  
  833. { Connection Operations }
  834.  
  835. procedure TADODBTest.CheckConnection(CloseFirst: Boolean);
  836. const
  837.   ConnectOptionValues: array [Boolean] of TConnectOption = (coConnectUnspecified, coAsyncConnect);
  838. var
  839.   ConnStr: string;
  840.   Index: Integer;
  841. begin
  842.   if not CloseFirst and Connection.Connected then Exit;
  843.   Connection.Close;
  844.   MasterClientData.Close;
  845.   ConnStr := ConnectionString.Text;
  846.   Connection.ConnectionString := ConnStr;
  847.   Connection.ConnectOptions := ConnectOptionValues[AsyncConnect.Checked];
  848.   if UseShapeProvider.Checked then
  849.     Connection.Provider := 'MSDataShape';
  850.   Index := ConnectionString.Items.IndexOf(ConnStr);
  851.   if Index > 0 then
  852.     ConnectionString.Items.Delete(Index);
  853.   if Index <> 0 then
  854.   begin
  855.     ConnectionString.Items.Insert(0, ConnStr);
  856.     while ConnectionString.Items.Count > 20 do
  857.       ConnectionString.Items.Delete(20);
  858.   end;
  859.   ConnectionString.ItemIndex := 0;
  860.   Application.ProcessMessages;
  861.   Connection.Open;
  862.   if AsyncConnect.Checked and (stConnecting in Connection.State) then
  863.     ShowProgressBar('Connecting');
  864. //  ShowProperties(Connection.Properties);
  865. end;
  866.  
  867. procedure TADODBTest.EditConnStrClick(Sender: TObject);
  868. begin
  869.   Connection.Close;
  870.   Connection.ConnectionString := ConnectionString.Text;
  871.   if EditConnectionString(Connection) then
  872.   begin
  873.     ConnectionString.Text := Connection.ConnectionString;
  874.     ConnectionStringClick(Sender);
  875.   end;
  876. end;
  877.  
  878. procedure TADODBTest.ConnectionStringClick(Sender: TObject);
  879. begin
  880.   if (ConnectionString.Text <> '') and not ConnectionString.DroppedDown then
  881.   begin
  882.     CheckConnection(True);
  883.     MasterTableName.Items.Clear;
  884.     MasterTableName.Text := '';
  885.     DetailTableName.Items.Clear;
  886.     DetailTableName.Text := '';
  887.     MasterProcName.Items.Clear;
  888.     MasterProcName.Text := '';
  889.     DetailProcName.Items.Clear;
  890.     DetailProcName.Text := '';
  891.   end;
  892. end;
  893.  
  894. procedure TADODBTest.ConnectionStringKeyPress(Sender: TObject; var Key: Char);
  895. begin
  896.   if Key = #13 then
  897.   begin
  898.     if ConnectionString.DroppedDown then
  899.       ConnectionString.DroppedDown := False;
  900.     ConnectionStringClick(Sender);
  901.     Key := #0;
  902.   end;
  903. end;
  904.  
  905. procedure TADODBTest.CloseConnectionExecute(Sender: TObject);
  906. begin
  907.   Connection.Close;
  908. end;
  909.  
  910. { Common DataSet Operations }
  911.  
  912. procedure TADODBTest.OpenDataSet(Source: TCustomADODataSet);
  913.  
  914.   procedure ShowFetchProgress;
  915.   begin
  916.     while stFetching in ADOSource.RecordSetState do
  917.     begin
  918.       with ADOSource do
  919.         StatusBar.Panels[3].Text := Format('%d of %d', [RecNo, RecordCount]);
  920.       Application.ProcessMessages;
  921.     end;
  922.   end;
  923.  
  924. begin
  925.   ClearEventLog.Execute;
  926.   Screen.Cursor := crHourGlass;
  927.   try
  928.     Source.Close;
  929.     MasterClientData.Close;
  930.     ADOSource := TCustomADODataSet(Source);
  931.     SetRecordSetEvents(UseClientCursor.Checked, ADOSource);
  932.     Provider.DataSet := ADOSource;
  933.     if MidasButton.Checked then ActiveDataSet := MasterClientData else
  934.     begin
  935.       ActiveDataSet := Source;
  936.       ShowFetchProgress;
  937.     end;
  938.     if MasterGrid.Visible then MasterGrid.SetFocus;
  939.   finally
  940.     Screen.Cursor := crDefault;
  941.   end;
  942.   StreamSettings(True);
  943. end;
  944.  
  945. procedure TADODBTest.DisconnectDataSetExecute(Sender: TObject);
  946. begin
  947.   ADOSource.Connection := nil;
  948. end;
  949.  
  950. function TADODBTest.GetActiveDataSet: TDataSet;
  951. begin
  952.   if not Assigned(FActiveDataSet) then
  953.     DatabaseError('No active dataset');
  954.   Result := FActiveDataSet;
  955. end;
  956.  
  957. procedure TADODBTest.SetActiveDataSet(Value: TDataSet);
  958.  
  959.   function GetDetailDataSet: TDataSet;
  960.   var
  961.     I: Integer;
  962.   begin
  963.     Result := nil;
  964.     if (Value = MasterTable) and DetailTable.Active then
  965.        Result := DetailTable
  966.     else if (Value = MasterQuery) and DetailQuery.Active then
  967.       Result := DetailQuery
  968.     else if (Value = MasterProc) and DetailProc.Active then
  969.       Result := DetailProc
  970.     else for I := 0 to Value.Fields.Count - 1 do
  971.       if Value.Fields[I] is TDataSetField then
  972.       begin
  973.         Result := TDataSetField(Value.Fields[I]).NestedDataSet;
  974.         Break;
  975.       end;
  976.   end;
  977.  
  978. begin
  979.   StatusBar.Panels[2].Text := '';
  980.   MasterDataSource.Enabled := False;
  981.   DetailDataSource.Enabled := False;
  982.   try
  983.     MasterGrid.DataSource := nil;
  984.     FActiveDataSet := Value;
  985.     DetailDataSource.DataSet := nil;
  986.     MasterDataSource.DataSet := Value;
  987.     if Assigned(Value) then
  988.     begin
  989.       Value.Open;
  990.       if AsyncExecute.Checked and (Value.State = dsOpening) then
  991.         ShowProgressBar('Executing');
  992.       if DisplayDetails.Checked then
  993.         DetailDataSource.DataSet := GetDetailDataSet;
  994.     end;
  995.     BindControls(Value);
  996.   finally
  997.     MasterDataSource.Enabled := True;
  998.     DetailDataSource.Enabled := True;
  999.   end;
  1000.   if Assigned(Value) then
  1001.   begin
  1002.     Update;
  1003.     StatusMsg := 'ActiveDataSet is ' + Value.Name;
  1004.     if Assigned(AreaSelector.ActivePage.OnShow) then
  1005.       AreaSelector.ActivePage.OnShow(nil);
  1006.   end;
  1007. end;
  1008.  
  1009. procedure TADODBTest.DataSetBeforeOpen(DataSet: TDataSet);
  1010. var
  1011.   I: Integer;
  1012. begin
  1013.   with DataSet as TCustomADODataSet do
  1014.   begin
  1015.     if Connection = nil then
  1016.       Connection := Self.Connection;
  1017.     CheckConnection(False);
  1018.     if UseClientCursor.Checked then
  1019.       CursorLocation := clUseClient else
  1020.       CursorLocation := clUseServer;
  1021.     for I := 0 to CursorTypeItem.Count - 1 do
  1022.     if CursorTypeItem.Items[I].Checked then
  1023.     begin
  1024.       CursorType := TCursortype(I);
  1025.       Break;
  1026.     end;
  1027.     for I := 0 to LockTypeItem.Count - 1 do
  1028.     if LockTypeItem.Items[I].Checked then
  1029.     begin
  1030.       LockType := TADOLocktype(I);
  1031.       Break;
  1032.     end;
  1033.     ExecuteOptions := [];
  1034.     if AsyncExecute.Checked then
  1035.       ExecuteOptions := [eoAsyncExecute];
  1036.     if AsyncFetch.Checked then
  1037.       ExecuteOptions := ExecuteOptions + [eoAsyncFetchNonBlocking];
  1038.     MaxRecords := Self.MaxRecords.Tag;
  1039.     EnableBCD := Self.EnableBCD.Checked;
  1040.   end;
  1041.   LogEvent('BeforeOpen', DataSet);
  1042. end;
  1043.  
  1044. procedure TADODBTest.DataSetAfterOpen(DataSet: TDataSet);
  1045. begin
  1046.   ClearProgressBar;
  1047. //  ShowProperties(ADOSource.RecordSet.Fields[0].Properties);
  1048.   LogEvent('AfterOpen', DataSet);
  1049. end;
  1050.  
  1051. procedure TADODBTest.DataSetAfterClose(DataSet: TDataSet);
  1052. begin
  1053.   LogEvent('AfterClose', DataSet);
  1054.   if DataSet = FActiveDataSet then
  1055.     FActiveDataSet := nil;
  1056.   if DataSet = ADOSource then
  1057.     FilterGroupBox.ItemIndex := -1;
  1058. end;
  1059.  
  1060. procedure TADODBTest.DataSetFetchComplete(DataSet: TCustomADODataSet;
  1061.   const Error: Error; var EventStatus: TEventStatus);
  1062. begin
  1063.   LogEvent('FetchComplete', DataSet);
  1064. end;
  1065.  
  1066. procedure TADODBTest.FormCloseQuery(Sender: TObject;
  1067.   var CanClose: Boolean);
  1068. begin
  1069.   CloseActiveDataSet.Execute;
  1070. end;
  1071.  
  1072. { Table Operations }
  1073.  
  1074. procedure TADODBTest.MasterTableNameDropDown(Sender: TObject);
  1075. begin
  1076.   try
  1077.     CheckConnection(False);
  1078.     with Sender as TComboBox do
  1079.       if Items.Count < 1 then
  1080.         Connection.GetTableNames(Items);
  1081.   except
  1082.     { Eat any exceptions so the combobox doesn't paint funny }
  1083.   end;
  1084. end;
  1085.  
  1086. procedure TADODBTest.MasterTableNameKeyPress(Sender: TObject; var Key: Char);
  1087. begin
  1088.   if Key = #13 then
  1089.   begin
  1090.     with Sender as TComboBox do
  1091.     if DroppedDown then DroppedDown := False;
  1092.     OpenTable.Execute;
  1093.     Key := #0;
  1094.   end;
  1095. end;
  1096.  
  1097. procedure TADODBTest.MasterTableNameClick(Sender: TObject);
  1098. begin
  1099.   with Sender as TComboBox do
  1100.   if not DroppedDown then
  1101.   begin
  1102.     DetailTableName.Text := '';
  1103.     OpenTable.Execute;
  1104.   end;
  1105. end;
  1106.  
  1107. procedure TADODBTest.DetailTableNameClick(Sender: TObject);
  1108. begin
  1109.   with Sender as TComboBox do
  1110.     if not DroppedDown and (DetailTable.TableName <> Text) then
  1111.       OpenTable.Execute;
  1112. end;
  1113.  
  1114. procedure TADODBTest.UpdateReOpenMenu;
  1115. var
  1116.   I: Integer;
  1117. begin
  1118.   while FileReOpen.Count > 0 do
  1119.     FileReOpen.Items[0].Free;
  1120.   for I := 0 to FClosedTables.Count - 1 do
  1121.     FileReOpen.Add(NewItem(Format('%d) %s', [I, FClosedTables[I]]), 0, False,
  1122.       True, ClosedFileClick, 0, ''));
  1123. end;
  1124.  
  1125. procedure TADODBTest.ClosedFileClick(Sender: TObject);
  1126. var
  1127.   S: string;
  1128.   Index, P, P2: Integer;
  1129. begin
  1130.   S := Copy(TMenuItem(Sender).Caption, 5, MAXINT);
  1131.   P := Pos(':', S);
  1132.   P2 := Pos('/', S);
  1133.   if P2 > 0 then
  1134.     DetailTableName.Text := Copy(S, P2+1, MAXINT) else
  1135.   begin
  1136.     DetailTableName.Text := '';
  1137.     P2 := MAXINT;
  1138.   end;
  1139.   MasterTableName.Text := Copy(S, P+1, P2-P-1);
  1140.   Index := FClosedTables.IndexOf(S);
  1141.   if Index > -1 then
  1142.     FClosedTables.Delete(Index);
  1143.   OpenTable.Execute;
  1144. end;
  1145.  
  1146. procedure TADODBTest.OpenTableExecute(Sender: TObject);
  1147. begin
  1148.   if MasterTableName.Text <> '' then
  1149.   begin
  1150.     MasterTable.Close;
  1151.     OpenDataSet(MasterTable);
  1152.   end;
  1153. end;
  1154.  
  1155. procedure TADODBTest.CloseActiveDataSetExecute(Sender: TObject);
  1156. begin
  1157.   ActiveDataSet.Close;
  1158. end;
  1159.  
  1160. procedure TADODBTest.MasterTableBeforeOpen(DataSet: TDataSet);
  1161. begin
  1162.   DataSetBeforeOpen(DataSet);
  1163.   MasterTable.TableDirect := UseTableDirect.Checked;
  1164.   MasterTable.TableName := MasterTableName.Text;
  1165.   DetailTable.MasterSource := nil;
  1166. end;
  1167.  
  1168. procedure TADODBTest.DetailTableBeforeOpen(DataSet: TDataSet);
  1169. begin
  1170.   DataSetBeforeOpen(DataSet);
  1171.   DetailTable.TableDirect := UseTableDirect.Checked;
  1172.   DetailTable.TableName := DetailTableName.Text;
  1173. end;
  1174.  
  1175. procedure TADODBTest.MasterTableAfterOpen(DataSet: TDataSet);
  1176. var
  1177.   I: Integer;
  1178.   Field: TField;
  1179.   MasterFields: string;
  1180. begin
  1181.   if DetailTableName.Text <> '' then
  1182.   begin
  1183.     DetailTable.Open;
  1184.     if MasterTableName.Text = DetailTableName.Text then
  1185.       MasterFields := MasterTable.Fields[0].FieldName+';'
  1186.     else
  1187.       for I := 0 to DetailTable.Fields.Count - 1 do
  1188.       begin
  1189.         Field := MasterTable.FindField(DetailTable.Fields[I].FieldName);
  1190.         if Field <> nil then
  1191.         begin
  1192.           if DetailTable.IndexDefs.GetIndexForFields(MasterFields + Field.FieldName, False) <> nil then
  1193.             MasterFields := MasterFields + Field.FieldName + ';';
  1194.         end;
  1195.       end;
  1196.     if MasterFields = '' then
  1197.       DatabaseError('Cannot determine linking fields for detail');
  1198.     SetLength(MasterFields, Length(MasterFields)-1);
  1199.     DetailTable.IndexFieldNames := MasterFields;
  1200.     DetailTable.MasterFields := MasterFields;
  1201.     DetailTable.MasterSource := DetailMasterSource;
  1202.   end;
  1203.   DataSetAfterOpen(DataSet);
  1204. end;
  1205.  
  1206. procedure TADODBTest.FileMenuClick(Sender: TObject);
  1207. begin
  1208.   UpdateReOpenMenu;
  1209.   FileReOpen.Enabled := FClosedTables.Count > 0;
  1210. end;
  1211.  
  1212. procedure TADODBTest.MasterTableBeforeClose(DataSet: TDataSet);
  1213.  
  1214.   procedure UpdateClosedTables;
  1215.   var
  1216.     TableEntry: string;
  1217.   begin
  1218.     TableEntry := MasterTable.TableName;
  1219.     if DetailTable.Active then
  1220.     begin
  1221.       TableEntry := TableEntry + '/' + DetailTable.TableName;
  1222.       DetailTable.Close;
  1223.     end;
  1224.     if FClosedTables.IndexOf(TableEntry) = -1 then
  1225.     begin
  1226.       FClosedTables.Insert(0, TableEntry);
  1227.       if FClosedTables.Count > 9 then
  1228.         FClosedTables.Delete(9);
  1229.     end;
  1230.   end;
  1231.  
  1232. begin
  1233.   UpdateClosedTables;
  1234.   DetailTable.Close;
  1235.   DataSetBeforeClose(Dataset);
  1236. end;
  1237.  
  1238. { Query Operations }
  1239.  
  1240. procedure TADODBTest.ProcessQuery(SelectQuery: Boolean);
  1241.  
  1242.   procedure UpdateQueryHistory;
  1243.   var
  1244.     DSQL: string;
  1245.   begin
  1246.     if FMasterQueries.IndexOf(MasterSQL.Text) <> -1 then Exit;
  1247.     FMasterQueries.Add(MasterSQL.Text);
  1248.     DSQL := DetailSQL.Text;
  1249.     if DSQL = '' then DSQL := '(empty)';
  1250.     FDetailQueries.Insert(0, DSQL);
  1251.     if FMasterQueries.Count > 9 then
  1252.     begin
  1253.       FMasterQueries.Delete(0);
  1254.       FDetailQueries.Delete(0);
  1255.     end;
  1256.   end;
  1257.  
  1258. var
  1259.   RecordsAffected: Integer;
  1260. begin
  1261.   CheckConnection(False);
  1262.   if SelectQuery then
  1263.   begin
  1264.     MasterQuery.Close;
  1265.     MasterQuery.SQL.Text := MasterSQL.Text;
  1266.     WriteParameterData;
  1267.     OpenDataSet(MasterQuery)
  1268.   end else
  1269.   begin
  1270.     if SQLParams.Checked then
  1271.     begin
  1272.       ADOCommand.CommandType := cmdText;
  1273.       ADOCommand.CommandText := MasterSQL.Text;
  1274.     end else
  1275.     begin
  1276.       ADOCommand.CommandType := cmdStoredProc;
  1277.       ADOCommand.CommandText := MasterProcName.Text;
  1278.     end;
  1279.     if ParameterList.Items.Count > 0 then
  1280.     begin
  1281.       WriteParameterData;
  1282.       ADOCommand.Parameters.Assign(FParamSource);
  1283.     end;
  1284.     ADOCommand.Execute(RecordsAffected, EmptyParam);
  1285.     StatusMsg := Format('%d rows were affected', [RecordsAffected]);
  1286.     if ProcParams.Checked then
  1287.       MasterProc.Parameters.Assign(ADOCommand.Parameters);
  1288.   end;
  1289.   UpdateQueryHistory;
  1290. end;
  1291.  
  1292. procedure TADODBTest.ExecSQLExecute(Sender: TObject);
  1293. begin
  1294.   ProcessQuery(False);
  1295. end;
  1296.  
  1297. procedure TADODBTest.OpenQueryExecute(Sender: TObject);
  1298. begin
  1299.   ProcessQuery(True);
  1300. end;
  1301.  
  1302. procedure TADODBTest.PrevQueryUpdate(Sender: TObject);
  1303. begin
  1304.   PrevQuery.Enabled := FQueryIndex < (FMasterQueries.Count - 1);
  1305. end;
  1306.  
  1307. procedure TADODBTest.PrevQueryExecute(Sender: TObject);
  1308. begin
  1309.   Assert(FQueryIndex < (FMasterQueries.Count - 1));
  1310.   Inc(FQueryIndex);
  1311.   SetQueryText;
  1312. end;
  1313.  
  1314. procedure TADODBTest.NextQueryExecute(Sender: TObject);
  1315. begin
  1316.   if FQueryIndex > -1 then
  1317.     Dec(FQueryIndex);
  1318.   SetQueryText;
  1319. end;
  1320.  
  1321. procedure TADODBTest.MasterSQLKeyPress(Sender: TObject; var Key: Char);
  1322. begin
  1323.   if Key = #13 then
  1324.   begin
  1325.     OpenQuery.Execute;
  1326.     Key := #0;
  1327.   end;
  1328. end;
  1329.  
  1330. procedure TADODBTest.SetQueryText;
  1331. var
  1332.   DSQL: string;
  1333. begin
  1334.   if FQueryIndex > -1 then
  1335.   begin
  1336.     MasterSQL.Text := FMasterQueries[FQueryIndex];
  1337.     DSQL := FDetailQueries[FQueryIndex];
  1338.     if DSQL = '(empty)' then DSQL := '';
  1339.     DetailSQL.Text := DSQL;
  1340.   end else
  1341.   begin
  1342.     MasterSQL.Text := '';
  1343.     DetailSQL.Text := '';
  1344.   end;
  1345. end;
  1346.  
  1347. procedure TADODBTest.EditCommandTextClick(Sender: TObject);
  1348. var
  1349.   Command: string;
  1350. begin
  1351.   CheckConnection(False);
  1352.   Command := MasterSQL.Text;
  1353.   if EditSQL(Command, Connection.GetTableNames, Connection.GetFieldNames) then
  1354.     MasterSQL.Text := Command;
  1355. end;
  1356.  
  1357. procedure TADODBTest.MasterQueryBeforeOpen(DataSet: TDataSet);
  1358. begin
  1359.   DataSetBeforeOpen(DataSet);
  1360.   MasterQuery.SQL.Text := MasterSQL.Text;
  1361. end;
  1362.  
  1363. procedure TADODBTest.DetailQueryBeforeOpen(DataSet: TDataSet);
  1364. begin
  1365.   DataSetBeforeOpen(DataSet);
  1366.   DetailQuery.SQL.Text := DetailSQL.Text;
  1367.   DetailQuerySource.Dataset := MasterQuery;
  1368.   if DetailQuery.Parameters.Count = 0 then
  1369.     RefreshParameters(DetailQuery.Parameters);
  1370. end;
  1371.  
  1372. procedure TADODBTest.MasterQueryAfterOpen(DataSet: TDataSet);
  1373. begin
  1374.   if Trim(DetailSQL.Text) <> '' then
  1375.     DetailQuery.Open else
  1376.     DetailQuerySource.Dataset := nil;
  1377.   DataSetAfterOpen(DataSet);
  1378. end;
  1379.  
  1380. procedure TADODBTest.MasterQueryBeforeClose(DataSet: TDataSet);
  1381. begin
  1382.   DetailQuery.Close;
  1383.   DataSetBeforeClose(DataSet);
  1384. end;
  1385.  
  1386. { Stored Procedures }
  1387.  
  1388. procedure TADODBTest.MasterProcBeforeOpen(DataSet: TDataSet);
  1389. begin
  1390.   DataSetBeforeOpen(DataSet);
  1391.   MasterProc.ProcedureName := MasterProcName.Text;
  1392.   WriteParameterData;
  1393. end;
  1394.  
  1395. procedure TADODBTest.MasterProcAfterOpen(DataSet: TDataSet);
  1396. begin
  1397.   if DetailProcName.Text <> '' then
  1398.     DetailProc.Open;
  1399.   DataSetAfterOpen(DataSet);
  1400. end;
  1401.  
  1402. procedure TADODBTest.DetailProcBeforeOpen(DataSet: TDataSet);
  1403. begin
  1404.   DataSetBeforeOpen(DataSet);
  1405.   DetailProc.ProcedureName := DetailProcName.Text;
  1406.   RefreshParameters(DetailProc.Parameters);
  1407. end;
  1408.  
  1409. procedure TADODBTest.OpenProcedureExecute(Sender: TObject);
  1410. begin
  1411.   if MasterProcName.Text <> '' then
  1412.   begin
  1413.     MasterProc.Close;
  1414.     OpenDataSet(MasterProc);
  1415.   end;
  1416. end;
  1417.  
  1418. procedure TADODBTest.ProcNameDropDown(Sender: TObject);
  1419. begin
  1420.   CheckConnection(False);
  1421.   with Sender as TComboBox do
  1422.     if Items.Count < 1 then
  1423.       Connection.GetProcedureNames(Items);
  1424. end;
  1425.  
  1426. procedure TADODBTest.MasterProcNameKeyPress(Sender: TObject;
  1427.   var Key: Char);
  1428. begin
  1429.   if Key = #13 then
  1430.   begin
  1431.     with Sender as TComboBox do
  1432.     if DroppedDown then DroppedDown := False;
  1433.     Key := #0;
  1434.   end;
  1435.  
  1436. end;
  1437.  
  1438. procedure TADODBTest.MasterProcNameClick(Sender: TObject);
  1439. begin
  1440.   with Sender as TComboBox do
  1441.   if not DroppedDown then
  1442.     DetailProcName.Text := '';
  1443. end;
  1444.  
  1445. procedure TADODBTest.DetailProcNameClick(Sender: TObject);
  1446. begin
  1447. end;
  1448.  
  1449. { Packet Save/Load }
  1450.  
  1451. procedure TADODBTest.LoadFromFileExecute(Sender: TObject);
  1452. begin
  1453.   OpenDialog.FilterIndex := 1;
  1454.   OpenDialog.FileName := FLastDataFile;
  1455.   if OpenDialog.Execute then
  1456.   begin
  1457.     ADODataSet.LoadFromFile(OpenDialog.FileName);
  1458.     FLastDataFile := OpenDialog.FileName;
  1459.     ActiveDataSet := ADODataSet;
  1460.     ADOSource := ADODataSet;
  1461.   end;
  1462. end;
  1463.  
  1464. procedure TADODBTest.SaveToFileExecute(Sender: TObject);
  1465. begin
  1466.   SaveDialog.FilterIndex := 1;
  1467.   SaveDialog.FileName := FLastDataFile;
  1468.   if SaveDialog.Execute then
  1469.   begin
  1470.     ADOSource.SaveToFile(SaveDialog.FileName, pfADTG);
  1471.     FLastDataFile := SaveDialog.FileName;
  1472.   end;
  1473. end;
  1474.  
  1475. procedure TADODBTest.FileActionsUpdate(Sender: TObject);
  1476. begin
  1477.   SaveToFile.Enabled := Assigned(FActiveDataSet) and ActiveDataSet.Active;
  1478.   CloseActiveDataSet.Enabled := SaveToFile.Enabled;
  1479.   DisconnectDataset.Enabled := SaveToFile.Enabled;
  1480.   CloseConnection.Enabled := Connection.Connected;
  1481. end;
  1482.  
  1483. { Streaming }
  1484.  
  1485. procedure TADODBTest.StreamFormOutClick(Sender: TObject);
  1486. begin
  1487.   SaveDialog.FilterIndex := 2;
  1488.   SaveDialog.FileName := FLastFormFile;
  1489.   if SaveDialog.Execute then
  1490.   begin
  1491.     WriteComponentResFile(SaveDialog.FileName, Self);
  1492.     FLastFormFile := SaveDialog.FileName;
  1493.   end;
  1494. end;
  1495.  
  1496. procedure TADODBTest.StreamFormInClick(Sender: TObject);
  1497. var
  1498.   Form: TADODBTest;
  1499. begin
  1500.   OpenDialog.FilterIndex := 2;
  1501.   OpenDialog.FileName := FLastFormFile;
  1502.   if OpenDialog.Execute then
  1503.   begin
  1504.     Form := TADODBTest.CreateNew(Application, 0);
  1505.     ReadComponentResFile(OpenDialog.FileName, Form);
  1506.     FLastFormFile := OpenDialog.FileName;
  1507.     Form.FormCreate(Form);
  1508.   end;
  1509. end;
  1510.  
  1511. { DB Control Linking }
  1512.  
  1513. procedure TADODBTest.BindControls(DataSet: TDataSet);
  1514.  
  1515.   procedure DeleteDBEditControls;
  1516.   var
  1517.     I: Integer;
  1518.   begin
  1519.     with DBEditScroller do
  1520.       for I := ComponentCount - 1 downto 0 do
  1521.         if (Components[I] is TDBEdit) or (Components[I] is TLabel) then
  1522.           Components[I].Free;
  1523.   end;
  1524.  
  1525.   procedure SetDisplayType(ForwardOnly: Boolean);
  1526.   begin
  1527.     if ForwardOnly then
  1528.     begin
  1529.       MasterGrid.Visible := False;
  1530.       MasterGrid.DataSource := nil;
  1531.       DBEditScroller.Height := GridPanel.Height;
  1532.       DBEditScroller.HorzScrollBar.Position := 0;
  1533.       DBEditScroller.VertScrollBar.Position := 0;
  1534.       DBNavigator1.VisibleButtons := [nbNext, nbInsert, nbDelete, nbEdit,
  1535.         nbPost, nbCancel, nbRefresh];
  1536.     end else
  1537.     begin
  1538.       MasterGrid.Visible := True;
  1539.       MasterGrid.DataSource := MasterDataSource;
  1540.       DBEditScroller.Height := 0;
  1541.       DBNavigator1.VisibleButtons := [nbFirst, nbPrior, nbNext, nbLast,
  1542.         nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
  1543.     end;
  1544.   end;
  1545.  
  1546.   procedure CreateDBEdit(F: TField);
  1547.   var
  1548.     LabelTop: Integer;
  1549.   begin
  1550.     with TDBEdit.Create(DBEditScroller) do
  1551.     begin
  1552.       Left := 65;
  1553.       Top := (F.FieldNo - 1) * (Height + 5) + 5;
  1554.       LabelTop := Top + 3;
  1555.       Width := F.DisplayWidth * Canvas.TextWidth('0');
  1556.       Parent := DBEditScroller;
  1557.       DataSource := MasterDataSource;
  1558.       DataField := F.FieldName;
  1559.     end;
  1560.     with TLabel.Create(DBEditScroller) do
  1561.     begin
  1562.       AutoSize := False;
  1563.       Alignment := taRightJustify;
  1564.       Left := 3;
  1565.       Top := LabelTop;
  1566.       Width := 59;
  1567.       Parent := DBEditScroller;
  1568.       Caption := F.DisplayLabel+':';
  1569.     end;
  1570.   end;
  1571.  
  1572. var
  1573.   I: Integer;
  1574.   Field: TField;
  1575. begin
  1576.   DBMemo1.DataField := '';
  1577.   DBImage1.DataField := '';
  1578.   DetailGrid.Visible := False;
  1579.   GridSplitter.Visible := False;
  1580.   BlobCtrlPanel.Visible := False;
  1581.   DBImage1.Visible := False;
  1582.   DBMemo1.Visible := False;
  1583.   ReadOnlyLabel.Visible := False;
  1584.   if Assigned(DataSet) and DataSet.Active then
  1585.   begin
  1586.     SetDisplayType((DataSet is TCustomADODataSet) and not
  1587.       TCustomADODataSet(DataSet).Supports([coBookmark, coMovePrevious]));
  1588.     for I := 0 to DataSet.FieldCount - 1 do
  1589.     begin
  1590.       Field := DataSet.Fields[I];
  1591.       Field.OnValidate := FieldValidate;
  1592.       case Field.DataType of
  1593.         ftMemo:
  1594.           if DBMemo1.DataField = '' then
  1595.           begin
  1596.             DBMemo1.DataField := Field.FieldName;
  1597.             DBMemo1.Visible := True;
  1598.           end;
  1599.         ftGraphic:
  1600.           if DBImage1.DataField = '' then
  1601.           begin
  1602.             DBImage1.DataField := DataSet.Fields[I].FieldName;
  1603.             DBImage1.Visible := True;
  1604.           end;
  1605.         ftDataSet, ftReference:
  1606.           if DisplayDetails.Checked and (DetailDataSource.DataSet = nil) then
  1607.           begin
  1608.             DetailDataSource.DataSet := TDataSetField(DataSet.Fields[I]).NestedDataSet;
  1609.           end;
  1610.         ftBytes, ftVarBytes:
  1611.           begin
  1612.             Field.OnGetText := BinaryGetText;
  1613.             Field.OnSetText := BinarySetText;
  1614.             Field.DisplayWidth := (Field.Size + 3);
  1615.           end;
  1616.         else
  1617.           if not MasterGrid.Visible then
  1618.             CreateDBEdit(Field);
  1619.       end;
  1620.     end;
  1621.     BlobCtrlPanel.Visible := DBMemo1.Visible or DBImage1.Visible;
  1622.     ReadOnlyLabel.Visible := not DataSet.CanModify;
  1623.     if Assigned(DetailDataSource.DataSet) then
  1624.     begin
  1625.       GridSplitter.Visible := True;
  1626.       DetailGrid.Visible := True;
  1627.     end;
  1628.   end else
  1629.     DeleteDBEditControls;
  1630. end;
  1631.  
  1632. procedure TADODBTest.GridSetFocus(Sender: TObject);
  1633. begin
  1634.   if not Assigned(FActiveDataSet) then Exit;
  1635.   ActiveDataSource := (Sender as TDBGrid).DataSource;
  1636.   DBNavigator1.DataSource := ActiveDataSource;
  1637.   DataSourceDataChange(ActiveDataSource, nil);
  1638. end;
  1639.  
  1640. procedure TADODBTest.PopupMenu1Popup(Sender: TObject);
  1641. var
  1642.   I: Integer;
  1643.   MI: TMenuItem;
  1644.   F, CurField: TField;
  1645. begin
  1646.   with PopupMenu1, ActiveDataSet do
  1647.   begin
  1648.     if PopupMenu1.PopupComponent = DBMemo1 then
  1649.       CurField := DBMemo1.Field else
  1650.       CurField := DBImage1.Field;
  1651.     while Items.Count > 0 do Items.Delete(0);
  1652.     MI := NewItem('(None)', 0, False, True, FieldSelect, 0, 'None');
  1653.     Items.Add(MI);
  1654.     for I := 0 to FieldCount - 1 do
  1655.       if Fields[I] is TBlobField then
  1656.       begin
  1657.         F := Fields[I];
  1658.         MI := NewItem(F.FieldName, 0, F=CurField, True, FieldSelect, 0, 'mi'+F.FieldName);
  1659.         MI.Tag := Integer(F);
  1660.         Items.Add(MI);
  1661.       end;
  1662.   end;
  1663. end;
  1664.  
  1665. procedure TADODBTest.FieldSelect(Sender: TObject);
  1666. var
  1667.   MI: TMenuItem;
  1668. begin
  1669.   MI := TMenuItem(Sender);
  1670.   if PopupMenu1.PopupComponent = DBImage1 then
  1671.   try
  1672.     if MI.Tag = 0 then
  1673.       DBImage1.DataField := '' else
  1674.       DBImage1.DataField := TField(MI.Tag).FieldName;
  1675.   except
  1676.     DBImage1.DataField := '';
  1677.     raise;
  1678.   end
  1679.   else if PopupMenu1.PopupComponent = DBMemo1 then
  1680.   try
  1681.     if MI.Tag = 0 then
  1682.       DBMemo1.DataField := '' else
  1683.       DBMemo1.DataField := TField(MI.Tag).FieldName;
  1684.   except
  1685.     DBMemo1.DataField := '';
  1686.     raise;
  1687.   end;
  1688. end;
  1689.  
  1690. { Editing / Updates }
  1691.  
  1692. procedure TADODBTest.EditActionsUpdate(Sender: TObject);
  1693. var
  1694.   Enabled: Boolean;
  1695. begin
  1696.   Enabled := Assigned(FActiveDataSet);
  1697.   BatchUpdate.Enabled := Assigned(ADOSource) and
  1698.     (ADOSource.LockType = ltBatchOptimistic);
  1699.   CancelBatch.Enabled := BatchUpdate.Enabled;
  1700.   ClearField.Enabled := Enabled;
  1701.   RefreshData.Enabled := Enabled;
  1702.   MidasApplyUpdates.Enabled := MasterClientData.Active and
  1703.     ((MasterClientData.ChangeCount > 0) or (MasterClientData.State in dsEditModes));
  1704.   MidasCancelUpdates.Enabled := MidasApplyUpdates.Enabled;
  1705.   LoadBlobFromFile.Enabled := Enabled and (MasterGrid.SelectedField is TBlobField);
  1706. end;
  1707.  
  1708. procedure TADODBTest.BatchUpdateExecute(Sender: TObject);
  1709. begin
  1710.   if ADOSource.Connection = nil then
  1711.   begin
  1712.     CheckConnection(False);
  1713.     ADOSource.Connection := Connection;
  1714.   end;
  1715.   ADOSource.UpdateBatch;
  1716. end;
  1717.  
  1718. procedure TADODBTest.CancelBatchExecute(Sender: TObject);
  1719. begin
  1720.   ADOSource.CancelUpdates;
  1721. end;
  1722.  
  1723. procedure TADODBTest.ClearFieldExecute(Sender: TObject);
  1724. var
  1725.   Field: TField;
  1726. begin
  1727.   Field := MasterGrid.SelectedField;
  1728.   if Field = nil then Exit;
  1729.   ActiveDataSet.Edit;
  1730.   Field.Clear;
  1731. end;
  1732.  
  1733. procedure TADODBTest.RefreshDataExecute(Sender: TObject);
  1734. begin
  1735.   ActiveDataSet.Refresh;
  1736. end;
  1737.  
  1738. procedure TADODBTest.BinaryGetText(Sender: TField; var Text: string;
  1739.   DisplayText: Boolean);
  1740. begin
  1741.   Text := Sender.AsString;
  1742. end;
  1743.  
  1744. procedure TADODBTest.BinarySetText(Sender: TField; const Text: string);
  1745. begin
  1746.   Sender.AsString := Text;
  1747. end;
  1748.  
  1749. procedure TADODBTest.BlobAsImageUpdate(Sender: TObject);
  1750. begin
  1751.   BlobAsImage.Enabled := Assigned(ActiveDataSource.DataSet) and ActiveDataSource.DataSet.Active and
  1752.     (MasterGrid.SelectedField is TBlobField);
  1753. end;
  1754.  
  1755. procedure TADODBTest.BlobAsImageExecute(Sender: TObject);
  1756. begin
  1757.   BlobCtrlPanel.Visible := True;
  1758.   DBImage1.Visible := True;
  1759.   DBImage1.DataField := MasterGrid.SelectedField.FieldName;
  1760. end;
  1761.  
  1762. procedure TADODBTest.LoadBlobFromFileExecute(Sender: TObject);
  1763. begin
  1764.   OpenDialog.FilterIndex := 3;
  1765.   if OpenDialog.Execute then
  1766.     TBlobField(MasterGrid.SelectedField).LoadFromFile(OpenDialog.FileName);
  1767. end;
  1768.  
  1769. { Indexes }
  1770.  
  1771. procedure TADODBTest.IndexPageShow(Sender: TObject);
  1772. begin
  1773.   if not (Assigned(ActiveDataSource) and Assigned(ActiveDataSource.DataSet)) then Exit;
  1774.   RefreshIndexNames;
  1775. end;
  1776.  
  1777. procedure TADODBTest.RefreshIndexNames;
  1778. var
  1779.   I: Integer;
  1780.   IndexDefs: TIndexDefs;
  1781. begin
  1782.   IndexList.Clear;
  1783.   if ActiveDataSet = MasterClientData then
  1784.     IndexDefs := MasterClientData.IndexDefs else
  1785.   if ADOSource is TADOTable then
  1786.     IndexDefs := TADOTable(ADOSource).IndexDefs else
  1787.   if ADOSource is TADODataSet then
  1788.     IndexDefs := TADODataSet(ADOSource).IndexDefs
  1789.   else
  1790.     Exit;
  1791.   IndexDefs.Update;
  1792.   for I := 0 to IndexDefs.Count - 1 do
  1793.     if IndexDefs[I].Name = '' then
  1794.       IndexList.Items.Add('<primary>') else
  1795.       IndexList.Items.Add(IndexDefs[I].Name);
  1796.   if IndexList.Items.Count > 0 then
  1797.   begin
  1798.     if (ADOSource = MasterTable) and (IndexList.Items.IndexOf(MasterTable.IndexName) > 0) then
  1799.       IndexList.ItemIndex := IndexList.Items.IndexOf(MasterTable.IndexName) else
  1800.       IndexList.ItemIndex := 0;
  1801.     ShowIndexParams;
  1802.   end;
  1803. end;
  1804.  
  1805. procedure TADODBTest.ShowIndexParams;
  1806. var
  1807.   IndexDef: TIndexDef;
  1808. begin
  1809.   if ActiveDataSource.DataSet is TADOTable then
  1810.     IndexDef := TADOTable(ActiveDataSource.DataSet).IndexDefs[IndexList.ItemIndex] else
  1811.   if ActiveDataSource.DataSet is TADODataSet then
  1812.     IndexDef := TADODataSet(ActiveDataSource.DataSet).IndexDefs[IndexList.ItemIndex]
  1813.   else
  1814.     Exit;
  1815.   idxCaseInsensitive.Checked := ixCaseInsensitive in IndexDef.Options;
  1816.   idxDescending.Checked := ixDescending in IndexDef.Options;
  1817.   idxUnique.Checked := ixUnique in IndexDef.Options;
  1818.   idxPrimary.Checked := ixPrimary in IndexDef.Options;
  1819.   IndexFields.Text := IndexDef.Fields;
  1820.   DescFields.Text := IndexDef.DescFields;
  1821.   CaseInsFields.Text := IndexDef.CaseInsFields;
  1822. end;
  1823.  
  1824. procedure TADODBTest.IndexListClick(Sender: TObject);
  1825. begin
  1826.   ShowIndexParams;
  1827.   if ActiveDataSet is TADOTable then
  1828.     with TADOTable(ActiveDataSet) do
  1829.     begin
  1830.       try
  1831.         { Only Jet 4 supports setting indexname while open }
  1832.         MasterTable.IndexName := IndexList.Items[IndexList.ItemIndex];
  1833.       except
  1834.         Close;
  1835.         MasterTable.IndexName := IndexList.Items[IndexList.ItemIndex];
  1836.         OpenTableExecute(nil);
  1837.       end;
  1838.     end;
  1839. end;
  1840.  
  1841. procedure TADODBTest.GridTitleClick(Column: TColumn);
  1842. var
  1843.   DataSet: TDataSet;
  1844. begin
  1845.   if not FMovingColumn then
  1846.   begin
  1847.     DataSet := Column.Field.DataSet;
  1848.     if DataSet is TCustomADODataSet then
  1849.     with TCustomADODataSet(DataSet) do
  1850.     begin
  1851.       if (Pos(Column.Field.FieldName, Sort) = 1) and (Pos(' DESC', Sort) = 0) then
  1852.         Sort := Column.Field.FieldName + ' DESC' else
  1853.         Sort := Column.Field.FieldName + ' ASC';
  1854.       StatusMsg := 'Sorted on '+Sort;
  1855.     end;
  1856.   end;
  1857.   FMovingColumn := False;
  1858. end;
  1859.  
  1860. procedure TADODBTest.MasterGridColumnMoved(Sender: TObject; FromIndex,
  1861.   ToIndex: Integer);
  1862. begin
  1863.   FMovingColumn := True;
  1864. end;
  1865.  
  1866. { Filters }
  1867.  
  1868. procedure TADODBTest.FilterPageShow(Sender: TObject);
  1869. var
  1870.   Field: TField;
  1871.   LocValue,
  1872.   QuoteChar: string;
  1873. begin
  1874.   if (Filter.Text = '') and Assigned(FActiveDataSet) and ActiveDataSet.Active then
  1875.   begin
  1876.     Field := MasterGrid.SelectedField;
  1877.     if Field = nil then Exit;
  1878.     with ActiveDataSet do
  1879.     try
  1880.       DisableControls;
  1881.       MoveBy(3);
  1882.       LocValue := VarToStr(Field.Value);
  1883.       First;
  1884.     finally
  1885.       EnableControls;
  1886.     end;
  1887.     if Field.DataType in [ftString, ftMemo, ftFixedChar] then
  1888.       QuoteChar := '''' else
  1889.       QuoteChar := '';
  1890.     Filter.Text := Format('%s=%s%s%1:s', [Field.FullName, QuoteChar, LocValue]);
  1891.   end;
  1892. end;
  1893.  
  1894. procedure TADODBTest.FilterKeyPress(Sender: TObject; var Key: Char);
  1895. begin
  1896.   FilterGroupBox.ItemIndex := -1;
  1897.   if Key = #13 then FilteredClick(Sender);
  1898. end;
  1899.  
  1900. procedure TADODBTest.FilterExit(Sender: TObject);
  1901. begin
  1902.   if Assigned(FActiveDataSet) then
  1903.     ActiveDataSet.Filter := Filter.Text;
  1904. end;
  1905.  
  1906. procedure TADODBTest.FilteredClick(Sender: TObject);
  1907. begin
  1908.   if Filtered.Checked then
  1909.     ActiveDataSet.Filter := Filter.Text;
  1910.   ActiveDataSet.Filtered := Filtered.Checked;
  1911. end;
  1912.  
  1913. procedure TADODBTest.FindFirstClick(Sender: TObject);
  1914. begin
  1915.   ActiveDataSet.Filter := Filter.Text;
  1916.   ActiveDataSet.FindFirst;
  1917. end;
  1918.  
  1919. procedure TADODBTest.FindNextClick(Sender: TObject);
  1920. begin
  1921.   if ActiveDataSet.Filter <> Filter.Text then
  1922.     ActiveDataSet.Filter := Filter.Text;
  1923.   ActiveDataSet.FindNext;
  1924. end;
  1925.  
  1926. procedure TADODBTest.FilterGroupBoxClick(Sender: TObject);
  1927. begin
  1928.   if not Assigned(ADOSource) then Exit;
  1929.   case FilterGroupBox.ItemIndex of
  1930.     0: ADOSource.FilterGroup := fgPendingRecords;
  1931.     1: ADOSource.FilterGroup := fgAffectedRecords;
  1932.     2: ADOSource.FilterGroup := fgFetchedRecords;
  1933.     3: ADOSource.FilterGroup := fgPendingRecords;
  1934.   else
  1935.     ADOSource.FilterGroup := fgNone;
  1936.   end;
  1937. end;
  1938.  
  1939.  
  1940. { Locate }
  1941.  
  1942. procedure TADODBTest.LocatePageShow(Sender: TObject);
  1943. var
  1944.   Field: TField;
  1945. begin
  1946.   if (FActiveDataSet <> nil) and ActiveDataSet.Active then
  1947.   begin
  1948.     Field := MasterGrid.SelectedField;
  1949.     if LocateField.Items.Count = 0 then
  1950.       LocateFieldDropDown(LocateField);
  1951.     if (LocateField.Text = '') or (LocateField.Items.IndexOf(Field.FieldName) < 1) then
  1952.       LocateField.Text := Field.FieldName;
  1953.     with ActiveDataSet do
  1954.     try
  1955.       DisableControls;
  1956.       MoveBy(3);
  1957.       LocateEdit.Text := VarToStr(Field.Value);
  1958.       First;
  1959.     finally
  1960.       EnableControls;
  1961.     end;
  1962.   end;
  1963. end;
  1964.  
  1965. procedure TADODBTest.LocateFieldDropDown(Sender: TObject);
  1966. begin
  1967.   ActiveDataSet.GetFieldNames(LocateField.Items);
  1968. end;
  1969.  
  1970. procedure TADODBTest.LocateButtonClick(Sender: TObject);
  1971.  
  1972.   function LocateValue: Variant;
  1973.   var
  1974.     I: Integer;
  1975.     Values: TStringList;
  1976.   begin
  1977.     if LocateNull.Checked then
  1978.       Result := Null
  1979.     else if Pos(',', LocateEdit.Text) < 1 then
  1980.       LocateValue := LocateEdit.Text
  1981.     else
  1982.     begin
  1983.       Values := TStringList.Create;
  1984.       try
  1985.         Values.CommaText := LocateEdit.Text;
  1986.         Result := VarArrayCreate([0,Values.Count-1], varVariant);
  1987.         for I := 0 to Values.Count - 1 do
  1988.           Result[I] := Values[I];
  1989.       finally
  1990.         Values.Free;
  1991.       end;
  1992.     end;
  1993.   end;
  1994.  
  1995. var
  1996.   Options: TLocateOptions;
  1997. begin
  1998.   Options := [];
  1999.   if locPartialKey.Checked then Include(Options, loPartialKey);
  2000.   if ActiveDataSet.Locate(LocateField.Text, LocateValue, Options) then
  2001.     StatusMsg := 'Record Found' else
  2002.     StatusMsg := 'Not found';
  2003. end;
  2004.  
  2005. procedure TADODBTest.LocateNullClick(Sender: TObject);
  2006. begin
  2007.   LocateEdit.Enabled := not LocateNull.Checked;
  2008. end;
  2009.  
  2010. { Midas Testing }
  2011.  
  2012. procedure TADODBTest.ADOButtonClick(Sender: TObject);
  2013. begin
  2014.   ActiveDataSet := ADOSource;
  2015. end;
  2016.  
  2017. procedure TADODBTest.MidasButtonClick(Sender: TObject);
  2018. begin
  2019.   if Assigned(ADOSource) or MasterClientData.Active then
  2020.     ActiveDataSet := MasterClientData;
  2021. end;
  2022.  
  2023. procedure TADODBTest.MidasApplyUpdatesExecute(Sender: TObject);
  2024. begin
  2025.   StatusMsg := 'ApplyUpdates: '+ IntToStr(MasterClientData.ApplyUpdates(-1));
  2026.   Beep;
  2027. end;
  2028.  
  2029. procedure TADODBTest.MidasCancelUpdatesExecute(Sender: TObject);
  2030. begin
  2031.   MasterClientData.CancelUpdates;
  2032.   StatusMsg := 'Updates canceled';
  2033. end;
  2034.  
  2035. procedure TADODBTest.MasterClientDataReconcileError(
  2036.   DataSet: TClientDataSet; E: EReconcileError; UpdateKind: TUpdateKind;
  2037.   var Action: TReconcileAction);
  2038. begin
  2039.   Action := HandleReconcileError(DataSet, UpdateKind, E);
  2040. end;
  2041.  
  2042. { FieldSchema }
  2043.  
  2044. procedure TADODBTest.FieldsPageShow(Sender: TObject);
  2045. begin
  2046.   CheckConnection(False);
  2047.   Connection.OpenSchema(siColumns, VarArrayOf([Unassigned, Unassigned, MasterTableName.Text, Unassigned]), EmptyParam, FieldSchema);
  2048. end;
  2049.  
  2050. procedure TADODBTest.FieldSchemaDATA_TYPEGetText(Sender: TField;
  2051.   var Text: String; DisplayText: Boolean);
  2052. begin
  2053.   case FieldSchemaData_TYPE.Value of
  2054.     $00000000: Text := 'adEmpty';
  2055.     $00000010: Text := 'adTinyInt';
  2056.     $00000002: Text := 'adSmallInt';
  2057.     $00000003: Text := 'adInteger';
  2058.     $00000014: Text := 'adBigInt';
  2059.     $00000011: Text := 'adUnsignedTinyInt';
  2060.     $00000012: Text := 'adUnsignedSmallInt';
  2061.     $00000013: Text := 'adUnsignedInt';
  2062.     $00000015: Text := 'adUnsignedBigInt';
  2063.     $00000004: Text := 'adSingle';
  2064.     $00000005: Text := 'adDouble';
  2065.     $00000006: Text := 'adCurrency';
  2066.     $0000000E: Text := 'adDecimal';
  2067.     $00000083: Text := 'adNumeric';
  2068.     $0000000B: Text := 'adBoolean';
  2069.     $0000000A: Text := 'adError';
  2070.     $00000084: Text := 'adUserDefined';
  2071.     $0000000C: Text := 'adVariant';
  2072.     $00000009: Text := 'adIDispatch';
  2073.     $0000000D: Text := 'adIUnknown';
  2074.     $00000048: Text := 'adGUID';
  2075.     $00000007: Text := 'adDate';
  2076.     $00000085: Text := 'adDBDate';
  2077.     $00000086: Text := 'adDBTime';
  2078.     $00000087: Text := 'adDBTimeStamp';
  2079.     $00000008: Text := 'adBSTR';
  2080.     $00000081: Text := 'adChar';
  2081.     $000000C8: Text := 'adVarChar';
  2082.     $000000C9: Text := 'adLongVarChar';
  2083.     $00000082: Text := 'adWChar';
  2084.     $000000CA: Text := 'adVarWChar';
  2085.     $000000CB: Text := 'adLongVarWChar';
  2086.     $00000080: Text := 'adBinary';
  2087.     $000000CC: Text := 'adVarBinary';
  2088.     $000000CD: Text := 'adLongVarBinary';
  2089.     $00000088: Text := 'adChapter';
  2090.     $00000040: Text := 'adFileTime';
  2091.     $00000089: Text := 'adDBFileTime';
  2092.     $0000008A: Text := 'adPropVariant';
  2093.     $0000008B: Text := 'adVarNumeric';
  2094.   else
  2095.     Text := '<Unknown>';
  2096.   end;
  2097.  
  2098. end;
  2099.  
  2100. { Event Logging }
  2101.  
  2102. procedure TADODBTest.LogEvent(const EventStr: string;
  2103.   Component: TComponent = nil);
  2104. var
  2105.   ItemCount: Integer;
  2106. begin
  2107.   if (csDestroying in ComponentState) or not Events.Visible then Exit;
  2108.   if (Component <> nil) and (Component.Name <> '') then
  2109.     Events.Items.Add(Format('%s(%s)', [EventStr, Component.Name])) else
  2110.     Events.Items.Add(EventStr);
  2111.   ItemCount := Events.Items.Count;
  2112.   Events.ItemIndex := ItemCount - 1;
  2113.   if ItemCount > (Events.ClientHeight div Events.ItemHeight) then
  2114.     Events.TopIndex := ItemCount - 1;
  2115. end;
  2116.  
  2117. procedure TADODBTest.ClearEventLogExecute(Sender: TObject);
  2118. begin
  2119.   Events.Items.Clear;
  2120. end;
  2121.  
  2122. procedure TADODBTest.ClearEventLogUpdate(Sender: TObject);
  2123. begin
  2124.   ClearEventLog.Enabled := Events.Visible and (Events.Items.Count > 0);
  2125. end;
  2126.  
  2127. procedure TADODBTest.SetRecordSetEvents(Hook: Boolean; DataSet: TCustomADODataSet);
  2128. begin
  2129.   if Hook then
  2130.   begin
  2131.     DataSet.OnFetchComplete := DataSetFetchComplete;
  2132.     DataSet.OnFetchProgress := DataSetFetchProgress;
  2133.   end
  2134.   else
  2135.   begin
  2136.     DataSet.OnFetchComplete := nil;
  2137.     DataSet.OnFetchProgress := nil;
  2138.   end;
  2139. end;
  2140.  
  2141. procedure TADODBTest.DataSetBeforeClose(DataSet: TDataSet);
  2142. begin
  2143.   LogEvent('BeforeClose');
  2144. end;
  2145.  
  2146. procedure TADODBTest.DataSetAfterScroll(DataSet: TDataSet);
  2147. begin
  2148.   LogEvent('AfterScroll', DataSet);
  2149. end;
  2150.  
  2151. procedure TADODBTest.DataSetBeforeCancel(DataSet: TDataSet);
  2152. begin
  2153.   LogEvent('BeforeCancel');
  2154. end;
  2155.  
  2156. procedure TADODBTest.DataSetBeforeDelete(DataSet: TDataSet);
  2157. begin
  2158.   LogEvent('BeforeDelete', DataSet);
  2159. end;
  2160.  
  2161. procedure TADODBTest.DataSetBeforeEdit(DataSet: TDataSet);
  2162. begin
  2163.   LogEvent('BeforeEdit', DataSet);
  2164. end;
  2165.  
  2166. procedure TADODBTest.DataSetBeforeInsert(DataSet: TDataSet);
  2167. begin
  2168.   LogEvent('BeforeInsert', DataSet);
  2169. end;
  2170.  
  2171. procedure TADODBTest.DataSetBeforePost(DataSet: TDataSet);
  2172. begin
  2173.   LogEvent('BeforePost', DataSet);
  2174. end;
  2175.  
  2176. procedure TADODBTest.DataSetBeforeScroll(DataSet: TDataSet);
  2177. begin
  2178.   LogEvent('BeforeScroll', DataSet);
  2179. end;
  2180.  
  2181. procedure TADODBTest.DataSetCalcFields(DataSet: TDataSet);
  2182. begin
  2183.   LogEvent('OnCalcFields', DataSet);
  2184. end;
  2185.  
  2186. procedure TADODBTest.DataSetError(DataSet: TDataSet;
  2187.   E: EDatabaseError; var Action: TDataAction);
  2188. begin
  2189.   LogEvent('OnDelete/OnEdit/OnPost Errors', DataSet);
  2190. end;
  2191.  
  2192. procedure TADODBTest.DataSetNewRecord(DataSet: TDataSet);
  2193. begin
  2194.   LogEvent('OnNewRecord', DataSet);
  2195. end;
  2196.  
  2197. procedure TADODBTest.DataSetAfterPost(DataSet: TDataSet);
  2198. begin
  2199.   LogEvent('AfterPost', DataSet);
  2200. end;
  2201.  
  2202. procedure TADODBTest.DataSetAfterInsert(DataSet: TDataSet);
  2203. begin
  2204.   LogEvent('AfterInsert', DataSet);
  2205. end;
  2206.  
  2207. procedure TADODBTest.DataSetAfterEdit(DataSet: TDataSet);
  2208. begin
  2209.   LogEvent('AfterEdit', DataSet);
  2210. end;
  2211.  
  2212. procedure TADODBTest.DataSetAfterDelete(DataSet: TDataSet);
  2213. begin
  2214.   LogEvent('AfterDelete', DataSet);
  2215. end;
  2216.  
  2217. procedure TADODBTest.DataSetAfterCancel(DataSet: TDataSet);
  2218. begin
  2219.   LogEvent('AfterCancel', DataSet);
  2220. end;
  2221.  
  2222. procedure TADODBTest.DataSourceStateChange(Sender: TObject);
  2223. begin
  2224.   LogEvent('OnStateChange', Sender as TComponent);
  2225. end;
  2226.  
  2227. procedure TADODBTest.DataSourceUpdateData(Sender: TObject);
  2228. begin
  2229.   LogEvent('OnUpdateData', Sender as TComponent);
  2230. end;
  2231.  
  2232. procedure TADODBTest.MasterTableBeforeScroll(DataSet: TDataSet);
  2233. begin
  2234.   LogEvent('BeforeScroll', DataSet);
  2235. end;
  2236.  
  2237. procedure TADODBTest.MasterTableAfterScroll(DataSet: TDataSet);
  2238. begin
  2239.   LogEvent('AfterScroll', DataSet);
  2240. end;
  2241.  
  2242. procedure TADODBTest.OnFilterRecord(DataSet: TDataSet; var Accept: Boolean);
  2243. begin
  2244.   Accept := (DataSet.Fields[0].AsInteger = 2);
  2245. end;
  2246.  
  2247. procedure TADODBTest.DataSetFetchProgress(DataSet: TCustomADODataSet;
  2248.   Progress, MaxProgress: Integer; var EventStatus: TEventStatus);
  2249. begin
  2250.   LogEvent(Format('FetchProgress: %d of %d', [Progress, MaxProgress]), DataSet);
  2251. end;
  2252.  
  2253. procedure TADODBTest.FieldValidate(Sender: TField);
  2254. begin
  2255.   LogEvent(Format('Val: %s=%s', [Sender.DisplayName, Sender.AsSTring]));
  2256. end;
  2257.  
  2258. { Connection Events }
  2259.  
  2260. procedure TADODBTest.ConnectionBeginTransComplete(
  2261.   Connection: TADOConnection; TransactionLevel: Integer;
  2262.   const Error: Error; var EventStatus: TEventStatus);
  2263. begin
  2264.   LogEvent('BeginTransComplete', Connection);
  2265. end;
  2266.  
  2267. procedure TADODBTest.ConnectionCommitTransComplete(Connection: TADOConnection;
  2268.   const Error: Error; var EventStatus: TEventStatus);
  2269. begin
  2270.   LogEvent('CommitTransComplete', Connection);
  2271. end;
  2272.  
  2273. procedure TADODBTest.ConnectionConnectComplete(Connection: TADOConnection;
  2274.   const Error: Error; var EventStatus: TEventStatus);
  2275. begin
  2276.   ClearProgressBar;
  2277.   LogEvent('ConnectComplete', Connection);
  2278. end;
  2279.  
  2280. procedure TADODBTest.ConnectionDisconnect(Connection: TADOConnection;
  2281.   var EventStatus: TEventStatus);
  2282. begin
  2283.   LogEvent('Disconnect', Connection);
  2284. end;
  2285.  
  2286. procedure TADODBTest.ConnectionExecuteComplete(Connection: TADOConnection;
  2287.   RecordsAffected: Integer; const Error: Error;
  2288.   var EventStatus: TEventStatus; const Command: _Command;
  2289.   const Recordset: _Recordset);
  2290. begin
  2291.   LogEvent('ExecuteComplete', Connection);
  2292. end;
  2293.  
  2294. procedure TADODBTest.ConnectionInfoMessage(Connection: TADOConnection;
  2295.   const Error: Error; var EventStatus: TEventStatus);
  2296. begin
  2297.   LogEvent('InfoMessage', Connection);
  2298. end;
  2299.  
  2300. procedure TADODBTest.ConnectionRollbackTransComplete(
  2301.   Connection: TADOConnection; const Error: Error;
  2302.   var EventStatus: TEventStatus);
  2303. begin
  2304.   LogEvent('RollbackTransComplete', Connection);
  2305. end;
  2306.  
  2307. procedure TADODBTest.ConnectionWillConnect(Connection: TADOConnection;
  2308.   var ConnectionString, UserID, Password: WideString;
  2309.   var ConnectOptions: TConnectOption; var EventStatus: TEventStatus);
  2310. begin
  2311.   LogEvent('WillConnect', Connection);
  2312. end;
  2313.  
  2314. procedure TADODBTest.ConnectionWillExecute(Connection: TADOConnection;
  2315.   var CommandText: WideString; var CursorType: TCursorType;
  2316.   var LockType: TADOLockType; var CommandType: TCommandType;
  2317.   var ExecuteOptions: TExecuteOptions; var EventStatus: TEventStatus;
  2318.   const Command: _Command; const Recordset: _Recordset);
  2319. begin
  2320.   LogEvent('WillExecute', Connection);
  2321. end;
  2322.  
  2323. procedure TADODBTest.ConnectionLogin(Sender: TObject; Username,
  2324.   Password: String);
  2325. begin
  2326.   LogEvent(Format('OnLogin - UID: %s PWD: %s',[UserName, Password]), Sender as TADOConnection);
  2327. end;
  2328.  
  2329. { Parameters }
  2330.  
  2331. procedure TADODBTest.ParameterSourceClick(Sender: TObject);
  2332. begin
  2333.   if SQLParams.Checked then
  2334.     FParamSource := MasterQuery.Parameters else
  2335.     FParamSource := MasterProc.Parameters;
  2336.   if not Showing then Exit;
  2337.   UpdateParameterList;
  2338. end;
  2339.  
  2340. procedure TADODBTest.RefreshParameters(Parameters: TParameters);
  2341. var
  2342.   I: Integer;
  2343.   NewParameter: TParameter;
  2344. begin
  2345.   try
  2346.     Parameters.Refresh;
  2347.   except
  2348.   end;
  2349.   if Parameters.Count = 0 then Exit;
  2350.   for I := 0 to Parameters.Count - 1 do
  2351.     with Parameters[I] do
  2352.       if Name[1] = '@' then
  2353.       begin
  2354.         NewParameter := Parameters.CreateParameter(Copy(Name, 2, 100), DataType, Direction, Size, Null);
  2355.         NewParameter.Index := I;
  2356.         Parameters[I].Free;
  2357.       end;
  2358. end;
  2359.  
  2360. procedure TADODBTest.ParamPageShow(Sender: TObject);
  2361. var
  2362.   FT: TFieldType;
  2363. begin
  2364.   if ParameterType.Items.Count = 0 then
  2365.     with ParameterType.Items do
  2366.       for FT := low(TFieldType) to high(TFieldType) do
  2367.         Add(FieldTypeNames[FT]);
  2368. end;
  2369.  
  2370. procedure TADODBTest.UpdateParameterList;
  2371. var
  2372.   I: Integer;
  2373. begin
  2374.   with ParameterList.Items do
  2375.   try
  2376.     BeginUpdate;
  2377.     Clear;
  2378.     for I := 0 to FParamSource.Count - 1 do
  2379.       Add(FParamSource[I].DisplayName);
  2380.     if ParameterList.Items.Count > 0 then
  2381.     begin
  2382.       if FModifiedParameter > -1 then
  2383.         ParameterList.ItemIndex := FModifiedParameter else
  2384.         ParameterList.ItemIndex := 0;
  2385.       ParameterListClick(ParameterList);
  2386.     end else
  2387.     begin
  2388.       ParameterName.Text := '';
  2389.       ParameterValue.Text := '';
  2390.     end;
  2391.   finally
  2392.     EndUpdate;
  2393.   end;
  2394. end;
  2395.  
  2396. procedure TADODBTest.RefreshParametersButtonClick(Sender: TObject);
  2397. begin
  2398.   CheckConnection(False);
  2399.   if SQLParams.Checked then
  2400.     MasterQuery.SQL.Text := MasterSQL.Text else
  2401.     MasterProc.ProcedureName := MasterProcName.Text;
  2402.   RefreshParameters(FParamSource);
  2403.   UpdateParameterList;
  2404. end;
  2405.  
  2406. procedure TADODBTest.AddParameterButtonClick(Sender: TObject);
  2407. begin
  2408.   FParamSource.CreateParameter('Param'+IntToStr(FParamSource.Count+1), ftInteger, pdInput, 0, 0);
  2409.   FModifiedParameter := -1;
  2410.   UpdateParameterList;
  2411. end;
  2412.  
  2413. procedure TADODBTest.ParameterListClick(Sender: TObject);
  2414. begin
  2415.   WriteParameterData;
  2416.   if ParameterList.ItemIndex < 0 then Exit;
  2417.   with FParamSource[ParameterList.ItemIndex] do
  2418.   begin
  2419.     ParameterName.Text := Name;
  2420.     ParameterValue.Text := VarToStr(Value);
  2421.     ParameterType.Text := FieldTypeNames[DataType];
  2422.     ParameterSize.Text := IntToStr(Size);
  2423.     ParameterScale.Text := IntToStr(NumericScale);
  2424.     ParameterPrecision.Text := IntToStr(Precision);
  2425.     ParameterDirectionGroup.ItemIndex := Ord(Direction)-1;
  2426.     PANullableCheckbox.Checked := paNullable in Attributes;
  2427.     PALongCheckbox.Checked := paLong in Attributes;
  2428.     PASignedCheckbox.Checked := paSigned in Attributes;
  2429.   end;
  2430.   FModifiedParameter := -1;
  2431. end;
  2432.  
  2433. procedure TADODBTest.WriteParameterData;
  2434. var
  2435.   DataTypeIndex: Integer;
  2436. begin
  2437.   if FModifiedParameter < 0 then Exit;
  2438.   with FParamSource[FModifiedParameter] do
  2439.   begin
  2440.     if Name <> ParameterName.Text then
  2441.     begin
  2442.       Name := ParameterName.Text;
  2443.       ParameterList.Items[FModifiedParameter] := Name;
  2444.     end;
  2445.     DataTypeIndex := ParameterType.Items.IndexOf(ParameterType.Text);
  2446.     if DataTypeIndex <> -1 then
  2447.       DataType := TFieldtype(DataTypeIndex) else
  2448.       DataType := ftInteger;
  2449.     Size := StrToInt(ParameterSize.Text);
  2450.     NumericScale := StrToInt(ParameterScale.Text);
  2451.     Precision := StrToInt(ParameterPrecision.Text);
  2452.     Direction := TParameterDirection(ParameterDirectionGroup.ItemIndex+1);
  2453.     if PANullableCheckbox.Checked then
  2454.       Attributes := [paNullable];
  2455.     if PALongCheckbox.Checked then
  2456.       Attributes := Attributes + [paLong];
  2457.     if PASignedCheckbox.Checked then
  2458.       Attributes := Attributes + [paSigned];
  2459.     if VarToStr(Value) <> ParameterValue.Text then
  2460.       Value := ParameterValue.Text;
  2461.   end;
  2462.   FModifiedParameter := -1;
  2463. end;
  2464.  
  2465. procedure TADODBTest.ParameterDataChange(Sender: TObject);
  2466. begin
  2467.   FModifiedParameter := ParameterList.ItemIndex;
  2468. end;
  2469.  
  2470. procedure TADODBTest.MasterSQLChange(Sender: TObject);
  2471. begin
  2472.   ParameterList.Items.Clear;
  2473. end;
  2474.  
  2475. { Test Code }
  2476.  
  2477. procedure TADODBTest.TestButtonClick(Sender: TObject);
  2478. begin
  2479.   { Put your test code here... }
  2480. end;
  2481.  
  2482.  
  2483. end.
  2484.