home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Demos / Db / MtsPool / POOLING.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  2.7 KB  |  122 lines
  1. unit Pooling;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Classes, SysUtils, Controls, Forms, StdCtrls, DBTables, Registry, Db;
  7.  
  8. const
  9.   MTSRegistryKey : PChar = '\SOFTWARE\BORLAND\DATABASE ENGINE\SETTINGS\SYSTEM\INIT';
  10.                             
  11. type
  12.   TForm1 = class(TForm)
  13.     MTSPooling: TCheckBox;
  14.     Query1: TQuery;
  15.     Database1: TDatabase;
  16.     Label1: TLabel;
  17.     TestBtn: TButton;
  18.     StartTimeEdt: TEdit;
  19.     EndTimeEdt: TEdit;
  20.     ElpTimeEdt: TEdit;
  21.     Label2: TLabel;
  22.     Label3: TLabel;
  23.     Label4: TLabel;
  24.     Count: TEdit;
  25.     procedure TestBtnClick(Sender: TObject);
  26.     procedure DoTest;
  27.     procedure MTSPoolingClick(Sender: TObject);
  28.     procedure FormActivate(Sender: TObject);
  29.   private
  30.     { Private declarations }
  31.     dtStart, dtEnd, dtElp : TDateTime;
  32.   public
  33.     { Public declarations }
  34.   end;
  35.  
  36. var
  37.   Form1: TForm1;
  38.  
  39. implementation
  40.  
  41. {$R *.DFM}
  42.  
  43. procedure TForm1.TestBtnClick(Sender: TObject);
  44. var
  45.   Hour, Min, Sec, MSec : Word;
  46. begin
  47.   // Start the timer
  48.   dtStart := Now;
  49.   StartTimeEdt.Text := TimeToStr( dtStart );
  50.  
  51.   // Run the test
  52.   DoTest;
  53.   
  54.   // End the timer, and calculate the elapsed time
  55.   dtEnd := Now;
  56.   EndTimeEdt.Text := TimeToStr( dtEnd );
  57.  
  58.   dtElp := dtEnd - dtStart;
  59.   DecodeTime( dtElp, Hour, Min, Sec, MSec );
  60.   
  61.   ElpTimeEdt.Text := IntToStr( Hour * 60 + Min )  + ':' +
  62.                      IntToStr( Sec ) + '.' + IntToStr( MSec );
  63. end;
  64.  
  65. procedure TForm1.DoTest;
  66. var
  67.   iCnt : Integer;
  68. begin
  69.   // Close bde to ensure MTS Pooling param will be used
  70.   Session.Close;
  71.   for iCnt := 1 to StrToInt( Count.Text ) do
  72.   begin
  73.     Database1.Connected := True;
  74.     Query1.Active := True;
  75.  
  76.     Query1.Active := False;
  77.     Database1.Connected := False;
  78.   end;
  79.   Session.Close;
  80. end;
  81.   
  82. procedure TForm1.MTSPoolingClick(Sender: TObject);
  83. var
  84.   reg : TRegistry;
  85. begin
  86.   // Set the registry value to whatever the flag is
  87.   reg := TRegistry.Create;
  88.   reg.RootKey := HKEY_LOCAL_MACHINE;
  89.   if ( reg.OpenKey( MTSRegistryKey, False) ) then
  90.   begin
  91.     if MTSPooling.Checked then
  92.       reg.WriteString('MTS POOLING', 'TRUE')
  93.     else
  94.       reg.WriteString('MTS POOLING', 'FALSE');
  95.     reg.CloseKey;
  96.   end;
  97.   reg.Destroy;
  98. end;
  99.  
  100. procedure TForm1.FormActivate(Sender: TObject);
  101. var
  102.   reg : TRegistry;
  103.   keyValue : string;
  104. begin
  105.   // Determine the current registry value
  106.   reg := TRegistry.Create;
  107.   reg.RootKey := HKEY_LOCAL_MACHINE;
  108.   if ( reg.OpenKey( MTSRegistryKey, False) ) then
  109.   begin
  110.     keyValue := reg.ReadString('MTS POOLING');
  111.  
  112.     if ( keyValue = 'TRUE' ) then
  113.       MTSPooling.Checked := True
  114.     else
  115.       MTSPooling.Checked := False;
  116.     reg.CloseKey;
  117.   end;
  118.   reg.Destroy;
  119. end;
  120.  
  121. end.
  122.