{ --------------------------------------------------------------------------- }
{ AnyDAC Speed Tester - base classes                                          }
{ Copyright (c) 2004 by Dmitry Arefiev (www.da-soft.com)                      }
{                                                                             }
{ All rights reserved.                                                        }
{ --------------------------------------------------------------------------- }
{$I ADSpeed.inc}

unit ADSpeedBase;

interface

uses
  Windows, SysUtils, Classes, DB,
  daADStanIntf;

type
  TADSpeedCustomTest = class;
  TADSpeedCustomDataSet = class;
  TADSpeedCustomDBTest = class;
  TADSpeedTestManager = class;

  {---------------------------------------------------------------------------}
  { TADSpeedCustomTest                                                        }
  {---------------------------------------------------------------------------}
  TADSpeedProgressEvent = procedure (ATest: TADSpeedCustomTest) of object;
  TADSpeedCustomTest = class(TObject)
  private
    FPerfCounterPerSec: TLargeInteger;
    FPerfCounter: TLargeInteger;
    FTimes: Integer;
    FError: String;
    function GetTime: Double;
    function GetTimeStr: String;
  protected
    procedure InternalExecute; virtual; abstract;
    procedure InternalPrepareStep; virtual;
    procedure InternalPrepare; virtual;
    procedure InternalUnPrepare; virtual;
  public
    constructor Create; virtual;
    procedure Execute(AProgressEvent: TADSpeedProgressEvent);
    class function GetName: String; virtual; abstract;
    class function GetDescription: String; virtual;
    property Time: Double read GetTime;
    property TimeStr: string read GetTimeStr;
    property Times: Integer read FTimes write FTimes;
    property Error: String read FError write FError;
  end;

  {---------------------------------------------------------------------------}
  { TADSpeedCustomDataSet                                                     }
  {---------------------------------------------------------------------------}
  TADSpeedCustomDataSet = class(TObject)
  private
    FDataSet: TDataSet;
    FArraySize: Integer;
    FConnection: TObject;
  protected
    FArrayIndex: Integer;
    procedure SetArraySize(ATimes: Integer); virtual;
    procedure SetConnection(AConnection: TObject); virtual;
    procedure SetParam(AIndex: Integer; const AValue: Variant); virtual; abstract;
    function GetParam(AIndex: Integer): Variant; virtual; abstract;
    function GetSQL: String; virtual; abstract;
    procedure SetSQL(const Value: String); virtual; abstract;
  public
    constructor Create; virtual;
    procedure Prepare; virtual;
    procedure UnPrepare; virtual;
    procedure Execute; virtual; abstract;
    procedure StartTransaction; virtual; abstract;
    procedure RollbackTransaction; virtual; abstract;
    procedure Setup(AFetchAll, AWithBlobs, AReadOnly: Boolean); virtual;
    procedure DefineParam(const AName: String; ADataType: TFieldType;
      ADataSize: Integer; AParamType: TParamType); virtual; abstract;
    class function AllocConnection: TObject; virtual; abstract;
    class procedure OpenConnection(AConnection: TObject; const AConnDef: IADStanConnectionDef); virtual; abstract;
    class procedure CloseConnection(AConnection: TObject); virtual; abstract;
{$IFDEF AnyDACSPEED_ORA}
    class procedure SetOraSrvClientInfo(AConnection: TObject; const AInfo: String); virtual;
    class procedure SetOraSrvTestInfo(AConnection: TObject; const AInfo: String); virtual;
{$ENDIF}
    class function GetName: String; virtual; abstract;
    class function GetDescription: String; virtual;
    class function GetCanExecute: Boolean; virtual;
    property DataSet: TDataSet read FDataSet write FDataSet;
    property ArraySize: Integer read FArraySize write SetArraySize;
    property Connection: TObject read FConnection write SetConnection;
    property Params[AIndex: Integer]: Variant read GetParam write SetParam;
    property SQL: String read GetSQL write SetSQL;
  end;
  TADSpeedCustomDataSetClass = class of TADSpeedCustomDataSet;

  {---------------------------------------------------------------------------}
  { TADSpeedCustomDBTest                                                      }
  {---------------------------------------------------------------------------}
  TADSpeedCustomDBTest = class(TADSpeedCustomTest)
  private
    FTestingDataSet: TADSpeedCustomDataSet;
  protected
    procedure InternalPrepare; override;
    procedure InternalUnPrepare; override;
    procedure SetTestingDataSet(ADataSet: TADSpeedCustomDataSet); virtual;
  public
    destructor Destroy; override;
    property TestingDataSet: TADSpeedCustomDataSet read FTestingDataSet write SetTestingDataSet;
  end;
  TADSpeedCustomDBTestClass = class of TADSpeedCustomDBTest;

  {---------------------------------------------------------------------------}
  { TADSpeedTestManager                                                       }
  {---------------------------------------------------------------------------}
  TADSpeedTestStartEvent = procedure (AManager: TADSpeedTestManager) of object;
  TADSpeedTestProgressEvent = procedure (AManager: TADSpeedTestManager;
    ATest: TADSpeedCustomTest; APctDone: Integer) of object;
  TADSpeedTestEndEvent = procedure (AManager: TADSpeedTestManager) of object;
  TADSpeedTestErrorEvent = procedure (AManager: TADSpeedTestManager; E: Exception) of object;
  TADSpeedTestManager = class(TObject)
  private
    FTestClassList: TList;
    FDSClassList: TList;
    FDSConnectionList: TList;
    FTests: TList;
    FTestCountList: TList;
    FExclusions: TStringList;
    FOnStart: TADSpeedTestStartEvent;
    FOnProgress: TADSpeedTestProgressEvent;
    FOnError: TADSpeedTestErrorEvent;
    FOnEnd: TADSpeedTestEndEvent;
    FStep, FTotal: Integer;
    FIsRunning: Boolean;
    FCanceled: Boolean;
    FConnDefs: IADStanConnectionDefs;
    FConnDef: IADStanConnectionDef;
    FConnDefName: String;
    function GetDSClass(AIndex: Integer): TADSpeedCustomDataSetClass;
    function GetDSCount: Integer;
    function GetTestClass(AIndex: Integer): TADSpeedCustomDBTestClass;
    function GetTestCount: Integer;
    function GetTests(ADSInd, ATestInd: Integer): TADSpeedCustomDBTest;
    procedure DoProgress(ATest: TADSpeedCustomTest);
    function GetTestTimes(AIndex: Integer): Integer;
    procedure SetTestTimes(AIndex: Integer; ATimes: Integer);
    function GetDSConnection(AIndex: Integer): TObject;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ClearTests;
    procedure AllocTests;
    procedure RegisterTest(ATest: TADSpeedCustomDBTestClass; ADefTimes: Integer);
    procedure RegisterDS(ADS: TADSpeedCustomDataSetClass);
    procedure ExcludeTest(ATest: TADSpeedCustomDBTestClass; daADS: TADSpeedCustomDataSetClass);
    procedure Execute(ATest: TADSpeedCustomDBTestClass; ADS: TADSpeedCustomDataSetClass);
    function IndexOfTest(ATest: TADSpeedCustomDBTestClass): Integer;
    function IndexOfDS(ADS: TADSpeedCustomDataSetClass): Integer;
    procedure OpenConnection(AIndex: Integer);
    procedure OpenConnections;
    procedure CloseConnections;
    procedure Cancel;
    property DSCount: Integer read GetDSCount;
    property TestCount: Integer read GetTestCount;
    property DSClass[AIndex: Integer]: TADSpeedCustomDataSetClass read GetDSClass;
    property DSConnection[AIndex: Integer]: TObject read GetDSConnection;
    property TestClass[AIndex: Integer]: TADSpeedCustomDBTestClass read GetTestClass;
    property TestTimes[AIndex: Integer]: Integer read GetTestTimes write SetTestTimes;
    property Tests[ADSInd, ATestInd: Integer]: TADSpeedCustomDBTest read GetTests;
    property IsRunning: Boolean read FIsRunning;
    property ConnDef: IADStanConnectionDef read FConnDef;
    property ConnDefName: String read FConnDefName write FConnDefName;
    property OnStart: TADSpeedTestStartEvent read FOnStart write FOnStart;
    property OnProgress: TADSpeedTestProgressEvent read FOnProgress write FOnProgress;
    property OnError: TADSpeedTestErrorEvent read FOnError write FOnError;
    property OnEnd: TADSpeedTestEndEvent read FOnEnd write FOnEnd;
  end;

var
  ADSpeedTestManager: TADSpeedTestManager;

implementation

uses
  daADStanFactory;

{---------------------------------------------------------------------------}
{ TADSpeedCustomTest                                                        }
{---------------------------------------------------------------------------}
constructor TADSpeedCustomTest.Create;
begin
  inherited Create;
  QueryPerformanceFrequency(FPerfCounterPerSec);
  FTimes := 1;
  FPerfCounter := 0;
  FError := '';
end;

{---------------------------------------------------------------------------}
class function TADSpeedCustomTest.GetDescription: String;
begin
  Result := '';
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomTest.Execute(AProgressEvent: TADSpeedProgressEvent);
var
  i: Integer;
  C1, C2: TLargeInteger;
begin
  FPerfCounter := 0;
  FError := '';
  try
    InternalPrepare;
    try
      for i := 1 to FTimes do begin
        InternalPrepareStep;
        QueryPerformanceCounter(C1);
        InternalExecute;
        QueryPerformanceCounter(C2);
        FPerfCounter := FPerfCounter + (C2 - C1);
        if Assigned(AProgressEvent) then
          AProgressEvent(Self);
      end;
    finally
      InternalUnPrepare;
    end;
  except
    on E: Exception do begin
      FPerfCounter := -1;
      FError := E.ClassName + ': ' + E.Message;
    end;
  end;
end;

{---------------------------------------------------------------------------}
function TADSpeedCustomTest.GetTime: Double;
begin
  if FPerfCounter = -1 then
    Result := 0
  else
    Result := FPerfCounter / FPerfCounterPerSec;
end;

{---------------------------------------------------------------------------}
function TADSpeedCustomTest.GetTimeStr: String;
begin
  if FPerfCounter = -1 then
    if FError = '' then
      Result := '<failed>'
    else
      Result := FError
  else if FPerfCounter <> 0 then
    Result := FormatFloat('0.0000', Time)
  else
    Result := '';
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomTest.InternalPrepareStep;
begin
  // nothing
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomTest.InternalPrepare;
begin
  // nothing
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomTest.InternalUnPrepare;
begin
  // nothing
end;

{---------------------------------------------------------------------------}
{ TADSpeedCustomDataSet                                                     }
{---------------------------------------------------------------------------}
constructor TADSpeedCustomDataSet.Create;
begin
  inherited Create;
  FDataSet := nil;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomDataSet.Prepare;
begin
  // nothing
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomDataSet.SetConnection(AConnection: TObject);
begin
  FConnection := AConnection;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomDataSet.SetArraySize(ATimes: Integer);
begin
  FArraySize := ATimes;
  FArrayIndex := 0;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomDataSet.UnPrepare;
begin
  // nothing
end;

{---------------------------------------------------------------------------}
class function TADSpeedCustomDataSet.GetDescription: String;
begin
  Result := '';
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomDataSet.Setup(AFetchAll, AWithBlobs, AReadOnly: Boolean);
begin
  // nothing
end;

{$IFDEF AnyDACSPEED_ORA}
{---------------------------------------------------------------------------}
class procedure TADSpeedCustomDataSet.SetOraSrvClientInfo(
  AConnection: TObject; const AInfo: String);
var
  oDS: TADSpeedCustomDataSet;
begin
  try
    oDS := Create;
    try
      if oDS.GetCanExecute then begin
        oDS.Connection := AConnection;
        oDS.Setup(False, False, True);
        oDS.SQL := 'begin dbms_application_info.set_client_info(''' + AInfo + '''); end;';
        oDS.Execute;
      end;
    finally
      oDS.Free;
    end;
  except
  end;
end;

{---------------------------------------------------------------------------}
class procedure TADSpeedCustomDataSet.SetOraSrvTestInfo(
  AConnection: TObject; const AInfo: String);
var
  oDS: TADSpeedCustomDataSet;
begin
  try
    oDS := Create;
    try
      if oDS.GetCanExecute then begin
        oDS.Connection := AConnection;
        oDS.Setup(False, False, True);
        oDS.SQL := 'begin dbms_application_info.set_module(''' + AInfo + ''', ''''); end;';
        oDS.Execute;
      end;
    finally
      oDS.Free;
    end;
  except
  end;
end;
{$ENDIF}

class function TADSpeedCustomDataSet.GetCanExecute: Boolean;
begin
  Result := True;
end;

{---------------------------------------------------------------------------}
{ TADSpeedCustomDBTest                                                      }
{---------------------------------------------------------------------------}
destructor TADSpeedCustomDBTest.Destroy;
begin
  FTestingDataSet.Free;
  FTestingDataSet := nil;
  inherited Destroy;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomDBTest.InternalPrepare;
begin
  with FTestingDataSet do begin
    DataSet.DisableControls;
{$IFDEF AnyDACSPEED_ORA}
    SetOraSrvTestInfo(Connection, GetName);
{$ENDIF}
    Prepare;
  end;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomDBTest.InternalUnPrepare;
begin
  with FTestingDataSet do begin
    DataSet.Active := False;
    Unprepare;
    DataSet.EnableControls;
  end;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedCustomDBTest.SetTestingDataSet(ADataSet: TADSpeedCustomDataSet);
begin
  FTestingDataSet := ADataSet;
end;

{---------------------------------------------------------------------------}
{ TADSpeedTestManager                                                       }
{---------------------------------------------------------------------------}
constructor TADSpeedTestManager.Create;
begin
  inherited Create;
  FTestClassList := TList.Create;
  FDSClassList := TList.Create;
  FTests := TList.Create;
  FExclusions := TStringList.Create;
  FExclusions.Sorted := True;
  FExclusions.Duplicates := dupError;
  FTestCountList := TList.Create;
  FDSConnectionList := TList.Create;
end;

{---------------------------------------------------------------------------}
destructor TADSpeedTestManager.Destroy;
var
  i: Integer;
begin
  ClearTests;
  FTestClassList.Free;
  FTestClassList := nil;
  FDSClassList.Free;
  FDSClassList := nil;
  FTests.Free;
  FTests := nil;
  FExclusions.Free;
  FExclusions := nil;
  FTestCountList.Free;
  FTestCountList := nil;
  for i := 0 to FDSConnectionList.Count - 1 do
    TObject(FDSConnectionList[i]).Free;
  FDSConnectionList.Free;
  FDSConnectionList := nil;
  FConnDef := nil;
  FConnDefs := nil;
  inherited Destroy;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.AllocTests;
var
  i, j: Integer;
  oTest: TADSpeedCustomDBTest;
  oDS: TADSpeedCustomDataSet;
begin
  if FTests.Count > 0 then
    Exit;
  for i := 0 to DSCount - 1 do
    for j := 0 to TestCount - 1 do begin
      if FExclusions.IndexOf(TestClass[j].ClassName + '$' + DSClass[i].ClassName) <> -1 then
        FTests.Add(nil)
      else begin
        oTest := TestClass[j].Create;
        oDS := DSClass[i].Create;
        oTest.Times := TestTimes[j];
        oTest.TestingDataSet := oDS;
        oTest.TestingDataSet.Connection := DSConnection[i];
        FTests.Add(oTest);
      end;
    end;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.ClearTests;
var
  i: Integer;
begin
  for i := 0 to FTests.Count - 1 do
    if FTests[i] <> nil then
      TADSpeedCustomDBTest(FTests[i]).Free;
  FTests.Clear;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.ExcludeTest(
  ATest: TADSpeedCustomDBTestClass;
  daADS: TADSpeedCustomDataSetClass);
begin
  FExclusions.Add(ATest.ClassName + '$' + daADS.ClassName);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.RegisterDS(ADS: TADSpeedCustomDataSetClass);
begin
  FDSClassList.Add(ADS);
  FDSConnectionList.Add(ADS.AllocConnection);
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.IndexOfDS(ADS: TADSpeedCustomDataSetClass): Integer;
begin
  Result := FDSClassList.IndexOf(ADS);
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.GetDSCount: Integer;
begin
  Result := FDSClassList.Count;
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.GetDSClass(AIndex: Integer): TADSpeedCustomDataSetClass;
begin
  Result := TADSpeedCustomDataSetClass(FDSClassList[AIndex]);
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.GetDSConnection(AIndex: Integer): TObject;
begin
  Result := TObject(FDSConnectionList[AIndex]);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.OpenConnection(AIndex: Integer);
begin
  DSClass[AIndex].OpenConnection(DSConnection[AIndex], FConnDef);
{$IFDEF AnyDACSPEED_ORA}
  DSClass[AIndex].SetOraSrvClientInfo(DSConnection[AIndex], DSClass[AIndex].GetName);
{$ENDIF}
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.OpenConnections;
var
  i: Integer;
begin
  if Assigned(FOnStart) then
    FOnStart(Self);
  FConnDef := nil;
  FConnDefs := nil;
  ADCreateInterface(IADStanConnectionDefs, FConnDefs);
  FConnDef := FConnDefs.ConnectionDefByName(FConnDefName);
  for i := 0 to DSCount - 1 do begin
    if Assigned(FOnProgress) then
      FOnProgress(Self, nil, MulDiv(i + 1, 100, DSCount));
    try
      OpenConnection(i);
    except
      on E: Exception do
        if Assigned(FOnError) then
          FOnError(Self, E);
    end;
  end;
  if Assigned(FOnEnd) then
    FOnEnd(Self);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.CloseConnections;
var
  i: Integer;
begin
  for i := 0 to DSCount - 1 do
    DSClass[i].CloseConnection(DSConnection[i]);
  FConnDef := nil;
  FConnDefs := nil;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.RegisterTest(ATest: TADSpeedCustomDBTestClass;
  ADefTimes: Integer);
begin
  FTestClassList.Add(ATest);
  FTestCountList.Add(Pointer(ADefTimes));
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.IndexOfTest(ATest: TADSpeedCustomDBTestClass): Integer;
begin
  Result := FTestClassList.IndexOf(ATest);
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.GetTestCount: Integer;
begin
  Result := FTestClassList.Count;
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.GetTestClass(AIndex: Integer): TADSpeedCustomDBTestClass;
begin
  Result := TADSpeedCustomDBTestClass(FTestClassList[AIndex]);
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.GetTestTimes(AIndex: Integer): Integer;
begin
  Result := Integer(FTestCountList[AIndex]);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.SetTestTimes(AIndex: Integer; ATimes: Integer);
var
  i: Integer;
begin
  FTestCountList[AIndex] := TObject(ATimes);
  if FTests.Count > 0 then
    for i := 0 to DSCount - 1 do
      Tests[i, AIndex].Times := ATimes;
end;

{---------------------------------------------------------------------------}
function TADSpeedTestManager.GetTests(ADSInd, ATestInd: Integer): TADSpeedCustomDBTest;
begin
  Result := TADSpeedCustomDBTest(FTests[TestCount * ADSInd + ATestInd]);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.DoProgress(ATest: TADSpeedCustomTest);
begin
  if MulDiv(FStep, 100, FTotal) <> MulDiv(FStep + 1, 100, FTotal) then begin
    Inc(FStep);
    if Assigned(FOnProgress) then
      FOnProgress(Self, ATest, MulDiv(FStep, 100, FTotal));
  end
  else
    Inc(FStep);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.Execute(ATest: TADSpeedCustomDBTestClass;
  ADS: TADSpeedCustomDataSetClass);
var
  i, j, i1, i2, j1, j2: Integer;
  oTest: TADSpeedCustomDBTest;
begin
  if FIsRunning then
    Exit;
  FIsRunning := True;
  FCanceled := False;
  try
    AllocTests;
    FTotal := 0;
    if ADS <> nil then begin
      i1 := IndexOfDS(ADS);
      i2 := i1;
    end
    else begin
      i1 := 0;
      i2 := DSCount - 1;
    end;
    if ATest <> nil then begin
      j1 := IndexOfTest(ATest);
      j2 := j1;
    end
    else begin
      j1 := 0;
      j2 := TestCount - 1;
    end;
    for i := i1 to i2 do
      for j := j1 to j2 do begin
        oTest := Tests[i, j];
        if oTest <> nil then
          FTotal := FTotal + oTest.Times;
      end;
    FStep := 0;
    if Assigned(FOnStart) then
      FOnStart(Self);
    for i := i1 to i2 do begin
      if FCanceled then
        Break;
      for j := j1 to j2 do begin
        if FCanceled then
          Break;
        oTest := Tests[i, j];
        if oTest <> nil then
          try
            oTest.Execute(DoProgress);
          except
            on E: Exception do
              if Assigned(FOnError) then
                FOnError(Self, E);
          end;
      end;
    end;
    if Assigned(FOnEnd) then
      FOnEnd(Self);
  finally
    FIsRunning := False;
  end;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedTestManager.Cancel;
begin
  FCanceled := True;
end;

end.

