⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 ODAC+SDAC源代码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Chart, StdCtrls, TeEngine, TeeProcs, Debug, Series,
  MemDS, DBAccess, MSAccess, OLEDBAccess, OLEDBC, SdacVcl,
  Db, DBTables, ADODB, DBXpress, SqlExpr, FMTBcd, DBClient, Provider;

type
  TfmMain = class(TForm)
    MSConnection: TMSConnection;
    MSQuery: TMSQuery;
    scCreate: TMSSQL;
    scDrop: TMSSQL;
    Chart: TChart;
    Tollbar: TPanel;
    btFetchTest: TButton;
    meResult: TMemo;
    btConnect: TButton;
    btDisconnect: TButton;
    Database: TDatabase;
    BDEQuery: TQuery;
    btMasterDetailTest: TButton;
    btSPCallTest: TButton;
    cbSDAC: TCheckBox;
    cbBDE: TCheckBox;
    cbADO: TCheckBox;
    edFetchRows: TEdit;
    Label1: TLabel;
    btCreate: TButton;
    btDrop: TButton;
    ADOConnection: TADOConnection;
    ADOQuery: TADOQuery;
    cbMark: TCheckBox;
    MSQuery1: TMSQuery;
    BDEQuery1: TQuery;
    ADOQuery1: TADOQuery;
    ADOStoredProc: TADOStoredProc;
    MSStoredProc: TMSStoredProc;
    BDEStoredProc: TStoredProc;
    lbSDAC: TLabel;
    lbBDE: TLabel;
    lbADO: TLabel;
    MSSQL: TMSSQL;
    btDataLoadingTest: TButton;
    cbdbExpress: TCheckBox;
    lbdbExpress: TLabel;
    BorlandSQLConnection: TSQLConnection;
    BorlandSQLQuery: TSQLQuery;
    BorlandSQLQuery1: TSQLQuery;
    BorlandSQLStoredProc: TSQLStoredProc;
    btnMultiExecuting: TButton;
    Bevel1: TBevel;
    Bevel2: TBevel;
    btnInsertPost: TButton;
    MSTable: TMSTable;
    BDETable: TTable;
    ADOTable: TADOTable;
    Splitter1: TSplitter;
    DataSetProvider1: TDataSetProvider;
    BorlandClientDataSet: TClientDataSet;
    BorlandSQLTable: TSQLTable;
    Bevel3: TBevel;
    cbResultLog: TCheckBox;
    Bevel4: TBevel;
    Bevel5: TBevel;
    cbdbExpSda: TCheckBox;
    lbdbExpSda: TLabel;
    CrLabSQLConnection: TSQLConnection;
    CrLabSQLQuery: TSQLQuery;
    Series2: TLineSeries;
    Series3: TLineSeries;
    Series4: TLineSeries;
    Series5: TLineSeries;
    CrLabSQLQuery1: TSQLQuery;
    CrLabSQLTable: TSQLTable;
    CrLabClientDataSet: TClientDataSet;
    DataSetProvider2: TDataSetProvider;
    Series1: TLineSeries;
    CrLabSQLStoredProc: TSQLStoredProc;
    scCreate2: TMSSQL;
    procedure btConnectClick(Sender: TObject);
    procedure btDisconnectClick(Sender: TObject);
    procedure btFetchTestClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edFetchRowsExit(Sender: TObject);
    procedure btCreateClick(Sender: TObject);
    procedure btDropClick(Sender: TObject);
    procedure cbMarkClick(Sender: TObject);
    procedure btMasterDetailTestClick(Sender: TObject);
    procedure btSPCallTestClick(Sender: TObject);
    procedure btnMultiExecutingClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnInsertPostClick(Sender: TObject);
    procedure cbSetInternalNameClick(Sender: TObject);
    procedure cbResultLogClick(Sender: TObject);
    procedure btDataLoadingTestClick(Sender: TObject);
    procedure CrLabSQLConnectionAfterConnect(Sender: TObject);
    procedure cbPermitPrepareClick(Sender: TObject);
  private
    TickInfo: TTickInfo;
    //LoadCount: integer;

    function FetchTest(DataSet:TDataSet; Recs:integer): integer;
    function MasterDetailTest(Master: TDataSet; Detail: TDataSet; Recs: integer): integer;
    function SPCallTest(StoredProc: TComponent; Count: integer): integer;
    //function DataLoadingTest(Loader: TComponent; Count: integer): integer;
    function MultiExecutingTest(Query: TComponent; Count: integer): integer;
    function InsertPostTest(Table: TDataSet; Count: integer): integer;

    procedure ExecSQL(const SQL: string);

    procedure CheckConnected;
    procedure PrintResults;

  public
    constructor Create(Owner:TComponent); override;
    destructor Destroy; override;
  end;

var
  fmMain: TfmMain;

implementation

uses
  Variants;

{$R *.DFM}

constructor TfmMain.Create(Owner:TComponent);
begin
  inherited;

  TickInfo := TTickInfo.Create;
  Caption := 'MS SQL Data Access Demos - SDAC ' + SDACVersion + ' performance';
end;

destructor TfmMain.Destroy;
begin
  TickInfo.Free;

  inherited;
end;

function TfmMain.FetchTest(DataSet:TDataSet; Recs:integer):integer;
var
  i: integer;
  OpenTime: integer;
  FetchTime: integer;
  SQL: string;
begin
  SQL := 'SELECT * FROM Detail WHERE Code <= :Recs';

  if DataSet is TMSQuery then begin
    meResult.Lines.Add('> SDAC');
    TMSQuery(DataSet).SQL.Text := SQL;
    TMSQuery(DataSet).ParamByName('Recs').AsInteger := Recs
  end
  else
    if DataSet is TQuery then begin
      meResult.Lines.Add('> BDE');
      TQuery(DataSet).SQL.Text := SQL;
      TQuery(DataSet).ParamByName('Recs').AsInteger := Recs;
    end
    else
      if DataSet is TADOQuery then begin
        meResult.Lines.Add('> ADO');
        TADOQuery(DataSet).SQL.Text := SQL;
        TADOQuery(DataSet).Parameters.ParamByName('Recs').Value := Recs;
      end else
      if DataSet is TSQLQuery then begin
        meResult.Lines.Add('> dbExpress');
        TSQLQuery(DataSet).SQL.Text := SQL;
        TSQLQuery(DataSet).ParamByName('Recs').DataType := ftString;
        TSQLQuery(DataSet).ParamByName('Recs').Value := Recs;
      end;

  TickInfo.Start;
  DataSet.Open;
  OpenTime := TickInfo.GetInterval;
  meResult.Lines.Add('Opened in ' +  IntervalToStr(OpenTime));

  TickInfo.Start;

  i := 0;
  while not DataSet.EOF do begin
    Inc(i);
    DataSet.Next;
  end;
  FetchTime := TickInfo.GetInterval;
  meResult.Lines.Add('Fetched ' + IntToStr(i) + ' recs in ' + IntervalToStr(FetchTime));
  DataSet.Close;

  Result := OpenTime + FetchTime;
end;

function TfmMain.MasterDetailTest(Master: TDataSet; Detail: TDataSet; Recs: integer):integer;
var
  i, j: integer;
  FetchTime: integer;
  SQL,SQL1: string;
begin
  SQL := 'SELECT * FROM Master WHERE Code <= :Recs'; //RowNum
  SQL1 := 'SELECT * FROM Detail WHERE Master = :Code';
  if Master is TMSQuery then begin
    meResult.Lines.Add('> SDAC');
    TMSQuery(Master).SQL.Text := SQL;
    TMSQuery(Detail).SQL.Text := SQL1;
    TMSQuery(Master).ParamByName('Recs').AsInteger := Recs
  end
  else
    if Master is TQuery then begin
      meResult.Lines.Add('> BDE');
      TQuery(Master).SQL.Text := SQL;
      TQuery(Detail).SQL.Text := SQL1;
      TQuery(Master).ParamByName('Recs').AsInteger := Recs;
    end
    else
      if Master is TADOQuery then begin
        meResult.Lines.Add('> ADO');
        TADOQuery(Master).SQL.Text := SQL;
        TADOQuery(Detail).SQL.Text := SQL1;
        TADOQuery(Master).Parameters.ParamByName('Recs').Value := Recs;
      end else
      if Master is TSQLQuery then begin
        meResult.Lines.Add('> dbExpress');
        TSQLQuery(Master).SQL.Text := SQL;
        TSQLQuery(Detail).SQL.Text := SQL1;
        TSQLQuery(Master).ParamByName('Recs').DataType := ftString;
        TSQLQuery(Master).ParamByName('Recs').Value := Recs;
      end;

  TickInfo.Start;
  Master.Open;

  if Detail is TMSQuery then
    TMSQuery(Detail).Prepare
  else
    if Detail is TQuery then
      TQuery(Detail).Prepare
    else
      if Detail is TADOQuery then
        TADOQuery(Detail).Prepared := True
      else
      if Detail is TSQLQuery then begin
        TSQLQuery(Detail).Prepared := True;
        TSQLQuery(Detail).ParamByName('Code').DataType := ftInteger;
      end;

  i := 0;
  j := 0;
  while not Master.EOF do begin
    if Detail is TMSQuery then
      TMSQuery(Detail).ParamByName('Code').AsInteger := Master.FieldByName('Code').AsInteger
    else
      if Detail is TQuery then
        TQuery(Detail).ParamByName('Code').AsInteger := Master.FieldByName('Code').AsInteger
      else
        if Detail is TADOQuery then
          TADOQuery(Detail).Parameters.ParamByName('Code').Value := Master.FieldByName('Code').AsInteger
        else
        if Detail is TSQLQuery then
          TSQLQuery(Detail).ParamByName('Code').Value := Master.FieldByName('Code').AsInteger;

    Detail.Open;
    while not Detail.EOF do begin
      Inc(j);
      Detail.Next;
    end;
    Detail.Close;

    Inc(i);
    Master.Next;
  end;
  FetchTime := TickInfo.GetInterval;
  meResult.Lines.Add('Fetched ' + IntToStr(i) + ' master recs, ' +
    IntToStr(j) + ' detail recs in ' + IntervalToStr(FetchTime));

  if Detail is TMSQuery then
    TMSQuery(Detail).UnPrepare
  else
    if Detail is TQuery then
      TQuery(Detail).UnPrepare
    else
      if Detail is TADOQuery then
        TADOQuery(Detail).Prepared := False
      else
      if Detail is TSQLQuery then
        TSQLQuery(Detail).Prepared := False;

  Master.Close;

  Result := FetchTime;
end;

procedure TMSSQLExecute(Query: TComponent);
begin
  TMSSQL(Query).Execute;
end;

procedure TQueryExecSQL(Query: TComponent);
begin
  TQuery(Query).ExecSQL;
end;

procedure TADOQueryExecSQL(Query: TComponent);
begin
  TADOQuery(Query).ExecSQL;
end;

procedure TSQLQueryExecSQL(Query: TComponent);
begin
  TSQLQuery(Query).ExecSQL;
end;

type
  TExecSQLProc = procedure (Query: TComponent);

function TfmMain.MultiExecutingTest(Query: TComponent; Count: integer): integer;
var
  i:integer;
  ExecTime:integer;
  SQL: string;
  ExecSQLProc: TExecSQLProc;
begin
  SQL := 'DECLARE @a INT';

  ExecSQLProc := nil;
  if Query is TMSSQL then begin
    meResult.Lines.Add('> SDAC');
    TMSSQL(Query).SQL.Text := SQL;
    TMSSQL(Query).Prepared := True;
    ExecSQLProc := TMSSQLExecute;
  end
  else
    if Query is TQuery then begin
      meResult.Lines.Add('> BDE');
      TQuery(Query).SQL.Text := SQL;
      TQuery(Query).Prepared := True;
      ExecSQLProc := TQueryExecSQL;
    end
    else
      if Query is TADOQuery then begin
        meResult.Lines.Add('> ADO');
        TADOQuery(Query).SQL.Text := SQL;
        TADOQuery(Query).Prepared := True;
        ExecSQLProc := TADOQueryExecSQL;
      end else
      if Query is TSQLQuery then begin
        meResult.Lines.Add('> dbExpress');
        TSQLQuery(Query).SQL.Text := SQL;
        TSQLQuery(Query).Prepared := True;
        ExecSQLProc := TSQLQueryExecSQL;
      end;

  TickInfo.Start;

  for i := 1 to Count do
    ExecSQLProc(Query);

  ExecTime := TickInfo.GetInterval;
  meResult.Lines.Add('Executed ' + IntToStr(Count) + ' count ' + IntervalToStr(ExecTime));

  Result := ExecTime;
end;

function TfmMain.InsertPostTest(Table: TDataSet; Count: integer): integer;
var
  i:integer;
  ExecTime:integer;
  TableName: string;
begin
  TableName := 'DETAIL';
  ExecSQL('TRUNCATE TABLE ' + TableName);

  if Table is TMSTable then begin
    meResult.Lines.Add('> SDAC');
    TMSTable(Table).TableName := TableName;

    // ~10% performance
    TMSTable(Table).SQLInsert.Text := 'INSERT INTO DETAIL (Code, Master, Field1, Field2) VALUES (:Code, :Master, :Field1, :Field2)';
  end
  else
    if Table is TTable then begin
      meResult.Lines.Add('> BDE');
      TTable(Table).TableName := TableName;
    end
    else
      if Table is TADOTable then begin
        meResult.Lines.Add('> ADO');
        TADOTable(Table).TableName := TableName;
      end else
      if Table = BorlandClientDataSet then begin
        meResult.Lines.Add('> dbExpress');
        BorlandSQLTable.TableName  := TableName;
      end else
        if Table = CrLabClientDataSet then begin
          meResult.Lines.Add('> dbExpSda');
          CrLabSQLTable.TableName  := TableName;
        end;

  Table.Open;

  TickInfo.Start;

  for i := 1 to Count do begin
    Table.Insert;
    Table.FieldByName('CODE').Value := i;
    Table.FieldByName('Field1').AsString := '01234567890123456789';
    Table.FieldByName('Field2').AsString := '12345678901234567890';
    Table.Post;
  end;

  if Table = BorlandClientDataSet then
    BorlandClientDataSet.ApplyUpdates(0);
  if Table = CrLabClientDataSet then
    CrLabClientDataSet.ApplyUpdates(0);

  ExecTime := TickInfo.GetInterval;
  Table.Close;
  meResult.Lines.Add('Inserted ' + IntToStr(Count) + ' records ' + IntervalToStr(ExecTime));

  Result := ExecTime;
end;

procedure TfmMain.ExecSQL(const SQL: string);
var
  MSSQL: TMSSQL; 
begin
  MSSQL := TMSSQL.Create(nil);
  try
    MSSQL.Connection := MSConnection;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -