fmloadds.pas

三层cs结构实例 水平相当高的高人开发的软件 有要就留着用吧

unit fmLoadDS;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, ExtCtrls, DBCtrls, Grids, DBGrids, ActiveX,
  MADB, ComCtrls;

const
  WM_UPDATEMEMO = WM_USER + 1008;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    MADOConnection1: TMADOConnection;
    MADODataset1: TMADODataset;
    Label1: TLabel;
    Edit1: TEdit;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    DBGrid1: TDBGrid;
    Label3: TLabel;
    DBNavigator1: TDBNavigator;
    Button1: TButton;
    Button2: TButton;
    Label5: TLabel;
    Edit3: TEdit;
    TabSheet2: TTabSheet;
    Button4: TButton;
    Button3: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Label2: TLabel;
    Memo1: TMemo;
    TabSheet3: TTabSheet;
    DBGrid2: TDBGrid;
    DBGrid3: TDBGrid;
    MADODataset2: TMADODataset;
    MADODataset3: TMADODataset;
    DataSource2: TDataSource;
    DataSource3: TDataSource;
    Button8: TButton;
    Button9: TButton;
    Edit2: TEdit;
    Label4: TLabel;
    Label6: TLabel;
    Edit4: TEdit;
    Label7: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    Label8: TLabel;
    Button10: TButton;
    MADOQuery1: TMADOQuery;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ConnectClick(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
  private
    FClientCount: Integer;
  public
    procedure UpdateMemoLine(var Msg: TMessage); message WM_UPDATEMEMO;
  end;

  TClientThread = class;

  TClientTest = class(TMADOConnection)
  private
    FClientID: string;
    FLastRecv: Integer;
    FLastSent: Integer;
    FThread: TClientThread;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetRecordset;
    property ClientID: string read FClientID write FClientID;
    property LastRecv: Integer read FLastRecv;
    property LastSent: Integer read FLastSent;
  end;

  TClientThread = class(TThread)
  private
    FClient: TClientTest;
    FStopEvent: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(AClient: TClientTest);
    destructor Destroy; override;
    procedure Terminate;
  end;

var
  MAHost: string;
  MAPort: Integer;
  MASQL: string;
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  RecvCount: Integer;
begin
  MADOConnection1.MConnection.Host := Edit1.Text;
  MADOConnection1.MConnection.Port := StrToIntDef(Edit3.Text, 10080);
  RecvCount := MADOConnection1.MConnection.ReceiveBytes;
  MADODataset1.Active := False;
  MADODataset1.CommandText := Edit2.Text;
  MADODataset1.Active := True;
  //MADOQuery1.Active := true;
  RecvCount := MADOConnection1.MConnection.ReceiveBytes - RecvCount;
  Label3.Caption := Format('Record:%d   Field: %d   Size:%d Bytes   Time: %dms',
    [MADODataset1.RecordCount, MADODataset1.FieldCount, RecvCount, MADOConnection1.MConnection.LastExpend]);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  SentCount: Integer;
begin
  SentCount := MADOConnection1.MConnection.SendBytes;
  MADODataset1.UpdateBatch;
  SentCount := MADOConnection1.MConnection.SendBytes - SentCount;
  Label3.Caption := Format('Post  DataSize:%d Bytes   Time: %dms',
    [SentCount, MADOConnection1.MConnection.LastExpend]);
end;

procedure TForm1.ConnectClick(Sender: TObject);
var
  I: Integer;
begin
  MAHost := Edit1.Text;
  MAPort := StrToIntDef(Edit3.Text, 10080);
  MASQL := Edit4.Text;
  try
    for I := 0 to TComponent(Sender).Tag - 1 do
    begin
      TClientTest.Create(Self).ClientID := Format('CLIENT%.3d', [FClientCount]);
      Inc(FClientCount);
    end;
  finally
    Label2.Caption := Format('Client Count: %d', [FClientCount]);
  end;
end;

{ TClientTest }

constructor TClientTest.Create(AOwner: TComponent);
begin
  inherited;
  MConnection.Enabled := True;
  MConnection.Host := MAHost;
  MConnection.Port := MAPort;
  FThread := TClientThread.Create(Self);
  FThread.Resume;
end;

destructor TClientTest.Destroy;
begin
  FThread.Free;
  inherited;
end;

procedure TClientTest.GetRecordset;
var
  RS: _Recordset;
begin
  FLastRecv := MConnection.ReceiveBytes;
  FLastSent := MConnection.SendBytes;
  RS := Execute(MASQL) as _Recordset;
  FLastRecv := MConnection.ReceiveBytes - FLastRecv;
  FLastSent := MConnection.SendBytes - FLastSent;
  SendMessage(Form1.Handle, WM_UPDATEMEMO, Integer(Self), 0);
end;

{ TClientThread }

constructor TClientThread.Create(AClient: TClientTest);
begin
  inherited Create(True);
  FClient := AClient;
  FStopEvent := CreateEvent(nil, True, False, nil);
end;

destructor TClientThread.Destroy;
begin
  Terminate;
  WaitFor;
  CloseHandle(FStopEvent);
  inherited;
end;

procedure TClientThread.Execute;
var
  WaitTime: Cardinal;
begin
  CoInitialize(nil);
  Randomize;
  while not Terminated do
  try
    WaitTime := Random(60000); //1 minute Random
    if WaitForSingleObject(FStopEvent, WaitTime) = WAIT_TIMEOUT then
      FClient.GetRecordset;
  except
  end;
  CoUninitialize;
end;

procedure TClientThread.Terminate;
begin
  inherited Terminate;
  SetEvent(FStopEvent);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  I: Integer;
  Component: TComponent;
begin
  for I := ComponentCount - 1 downto 0 do
  begin
    Component := Components[I];
    if Component is TClientTest then
    begin
      Component.Free;
      Dec(FClientCount, 1);
    end;
  end;
  Label2.Caption := Format('Client Count: %d', [FClientCount]);
end;

procedure TForm1.UpdateMemoLine(var Msg: TMessage);
begin
  with TClientTest(Msg.WParam) do
  Memo1.Lines.Add(
    Format('[%s] SentBytes: %d,  ReceivedBytes: %d, SpentTime: %d ms',
    [ClientID, LastSent, LastRecv, MConnection.LastExpend]))
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  MADOConnection1.MConnection.Host := Edit1.Text;
  MADOConnection1.MConnection.Port := StrToIntDef(Edit3.Text, 10080);
  MADODataset2.Active := False;
  MADODataset3.Active := False;
  //
  MADODataset2.CommandText := Edit5.Text;
  MADODataset3.CommandText := Edit6.Text;
  MADOConnection1.BeginBatch;
  try
    MADODataset2.Open;
    MADODataset3.Open;
    MADOConnection1.CommitBatch;
  except
    MADOConnection1.RollbackBatch;
    raise;
  end;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  if not (MADODataset2.Active and MADODataset3.Active) then Exit;
  MADOConnection1.BeginBatch;
  try
    MADODataset2.UpdateBatch;
    MADODataset3.UpdateBatch;
    MADOConnection1.CommitBatch;
  except
    MADOConnection1.RollbackBatch;
    raise;
  end;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
  MADOConnection1.BeginTrans;
  try
    MADOConnection1.Execute(''); // replace SQL Script here
    MADOConnection1.Execute('');
    MADODataset1.UpdateBatch;
    MADOConnection1.CommitTrans;
  except
    MADOConnection1.RollbackTrans;
    raise;
  end;
end;

end.