threads.pas

Oracle Data Access Components Source Code ODAC v.6.70.0.45

unit Threads;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Ora, ThreadsData, ExtCtrls, OraClasses, OraScript, Db, MemDS, DBCtrls,
  Grids, DBGrids, DBAccess, OdacVcl, OdacDemoFrame, OdacDemoForm, Buttons,
  DAScript;

type
  TThreadsFrame = class(TOdacDemoFrame)
    Timer: TTimer;
    meErrorLog: TMemo;
    OraQuery: TOraQuery;
    OraDataSource: TOraDataSource;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    meSQL: TMemo;
    meLog: TMemo;
    DBGrid1: TDBGrid;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Panel5: TPanel;
    btStart: TSpeedButton;
    btStop: TSpeedButton;
    btRun: TSpeedButton;
    btRunMax: TSpeedButton;
    Panel6: TPanel;
    btOpen: TSpeedButton;
    btDeleteAll: TSpeedButton;
    DBNavigator1: TDBNavigator;
    Panel11: TPanel;
    Panel10: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    lbThreadCount: TLabel;
    lbExceptCount: TLabel;
    Panel13: TPanel;
    Panel14: TPanel;
    edCount: TEdit;
    Label3: TLabel;
    Panel9: TPanel;
    Shape1: TShape;
    rbInsert: TRadioButton;
    rbSelect: TRadioButton;
    Label4: TLabel;
    btClearLog: TSpeedButton;
    Panel12: TPanel;
    lbInterval: TLabel;
    lbTime: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    procedure btRunClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure btStartClick(Sender: TObject);
    procedure btStopClick(Sender: TObject);
    procedure edCountChange(Sender: TObject);
    procedure btRunMaxClick(Sender: TObject);
    procedure btClearLogClick(Sender: TObject);
    procedure btOpenClick(Sender: TObject);
    procedure rgModeClick(Sender: TObject);
    procedure btDeleteAllClick(Sender: TObject);

  private
    ThreadCount:integer;
    ThreadNum:integer;
    hCountSec:TRTLCriticalSection;
    BegTime:TDateTime;
    MaxThread: integer;
    Interval: integer;
    ExceptCount: integer;
    EventLog, ExceptLog: TStringList;

    procedure ShowStatus;

  public
    destructor Destroy; override;
    procedure Initialize; override;
    procedure SetDebug(Value: boolean); override;
  end;

  TDemoThread = class(TThread)
  private
    FFrame: TThreadsFrame;

  protected
    procedure Execute; override;

  public
    constructor Create(Frame: TThreadsFrame);
  end;

implementation

uses
  OraCall
  {$IFNDEF VER130}, Variants{$ENDIF};

{$R *.dfm}

constructor TDemoThread.Create(Frame: TThreadsFrame);
begin
  inherited Create(True);

  FFrame := Frame;
  FreeOnTerminate := True;
  Suspended := False;
end;

procedure TDemoThread.Execute;
var
  Data: TThreadsDataModule;
  ThreadNum: integer;
  i: integer;
begin
  EnterCriticalSection(FFrame.hCountSec);
    Inc(FFrame.ThreadCount);
    Inc(FFrame.ThreadNum);
    ThreadNum := FFrame.ThreadNum;
  LeaveCriticalSection(FFrame.hCountSec);
  Synchronize(FFrame.ShowStatus);

  Data := TThreadsDataModule.Create(nil);
  try
  try
    EnterCriticalSection(FFrame.hCountSec);
      FFrame.EventLog.Add(IntToStr(ThreadNum) + ' Connecting...');
    LeaveCriticalSection(FFrame.hCountSec);
    Synchronize(FFrame.ShowStatus);

    FFrame.AssignConnectionTo(Data.OraSession);
    Data.OraSession.ConnectPrompt := False;
    Data.OraSession.Connect;

    EnterCriticalSection(FFrame.hCountSec);
      FFrame.EventLog.Add(IntToStr(ThreadNum) + ' Connected');
    LeaveCriticalSection(FFrame.hCountSec);
    Synchronize(FFrame.ShowStatus);

    if FFrame.rbInsert.Checked then begin
    // INSERT
      Data.OraSQL.ParamByName('ID').AsInteger := Random(10000);
      Data.OraSQL.Execute;
      Data.OraSession.Commit;
      EnterCriticalSection(FFrame.hCountSec);
        FFrame.EventLog.Add(IntToStr(ThreadNum) + ' Executed');
      LeaveCriticalSection(FFrame.hCountSec);
      Synchronize(FFrame.ShowStatus);
    end
    else
      if FFrame.rbSelect.Checked then begin
    // SELECT
        Data.OraQuery.Open;
        i := 0;
        while not Data.OraQuery.Eof do begin
          Data.OraQuery.Next;
          Inc(i);
        end;
        EnterCriticalSection(FFrame.hCountSec);
          FFrame.EventLog.Add(IntToStr(ThreadNum) + ' Fetched ' + IntToStr(i) + ' rows');
        LeaveCriticalSection(FFrame.hCountSec);
        Synchronize(FFrame.ShowStatus);
        Data.OraQuery.Close;
      end;

    Data.OraSession.Disconnect;
    EnterCriticalSection(FFrame.hCountSec);
      FFrame.EventLog.Add(IntToStr(ThreadNum) + ' Disconnected');
    LeaveCriticalSection(FFrame.hCountSec);
    Synchronize(FFrame.ShowStatus);
  except
    on E:Exception do begin
      MessageBeep(1000);
      EnterCriticalSection(FFrame.hCountSec);
        FFrame.EventLog.Add(IntToStr(ThreadNum) + ' ' + IntToStr(FFrame.ThreadCount) + ' Exception ' + E.Message);
        FFrame.ExceptLog.Add(IntToStr(ThreadNum) + ' ' + IntToStr(FFrame.ThreadCount) + ' Exception ' + E.Message);
        Inc(FFrame.ExceptCount);
      LeaveCriticalSection(FFrame.hCountSec);
      Synchronize(FFrame.ShowStatus);
    end;
  end;
  finally
    Data.Free;
  end;

  EnterCriticalSection(FFrame.hCountSec);
    Dec(FFrame.ThreadCount);
  LeaveCriticalSection(FFrame.hCountSec);
  Synchronize(FFrame.ShowStatus);
  MessageBeep(1000);
end;

procedure TThreadsFrame.ShowStatus;
begin
  lbThreadCount.Caption := IntToStr(ThreadCount);
  lbExceptCount.Caption := IntToStr(ExceptCount);

  if meLog.Lines.Count > 1000 then
    meLog.Lines.Clear;
  meLog.Lines.AddStrings(EventLog);
  EventLog.Clear;

  meErrorLog.Lines.AddStrings(ExceptLog);
  ExceptLog.Clear;
end;

const
  Delay = 1000;

destructor TThreadsFrame.Destroy;
begin
  DeleteCriticalSection(hCountSec);
  EventLog.Free;
  ExceptLog.Free;

  inherited;
end;

procedure TThreadsFrame.Initialize;
begin
  inherited;

  OraQuery.Connection := Connection;

  MaxThread := 5;
  Interval := 2000;
  ExceptCount := 0;
  EventLog := TStringList.Create;
  ExceptLog := TStringList.Create;

  InitializeCriticalSection(hCountSec);
  Randomize;

  ThreadsDataModule := TThreadsDataModule.Create(Self);
  edCount.Text := IntToStr(MaxThread);
  rbSelect.Checked := True;
end;

procedure TThreadsFrame.btRunClick(Sender: TObject);
begin
  OraQuery.Session.Connect;
  if OraQuery.Session.Connected then
    TDemoThread.Create(Self);
end;

procedure TThreadsFrame.btRunMaxClick(Sender: TObject);
var
  i: integer;
begin
  OraQuery.Session.Connect;
  if OraQuery.Session.Connected then
    for i := 1 to MaxThread do
      TDemoThread.Create(Self);
end;

procedure TThreadsFrame.btStartClick(Sender: TObject);
begin
  edCount.Text := IntToStr(MaxThread);
  BegTime := Time;
  TimerTimer(nil);
end;

procedure TThreadsFrame.btStopClick(Sender: TObject);
begin
  Timer.Enabled := False;
end;

procedure TThreadsFrame.TimerTimer(Sender: TObject);
begin
  if ThreadCount < MaxThread then begin
    btRunClick(nil);
    if ThreadCount < (MaxThread div 10) * 9 then
      Dec(Interval, Interval div 10);
  end
  else
    Inc(Interval, Interval div 10);

  lbInterval.Caption := IntToStr(Interval);
  lbExceptCount.Caption := IntToStr(ExceptCount);
  Timer.Interval := Random(Interval - 1) + 1;
  lbTime.Caption := TimeToStr(Time - BegTime);

  lbInterval.Caption := lbInterval.Caption + ' / ' + IntToStr(Timer.Interval);

  Timer.Enabled := True;
end;

procedure TThreadsFrame.edCountChange(Sender: TObject);
begin
  MaxThread := StrToInt(edCount.Text);
end;

procedure TThreadsFrame.btClearLogClick(Sender: TObject);
begin
  meLog.Lines.Clear;
  meErrorLog.Lines.Clear;
  ThreadNum := 0;
  ExceptCount := 0;
  lbExceptCount.Caption := IntToStr(ExceptCount);
end;

procedure TThreadsFrame.btOpenClick(Sender: TObject);
begin
  OraQuery.Close;
  OraQuery.Open;
end;

procedure TThreadsFrame.rgModeClick(Sender: TObject);
begin
  if rbSelect.Checked then
    meSQL.Lines.Assign(ThreadsDataModule.OraQuery.SQL)
  else
    if rbInsert.Checked then
      meSQL.Lines.Assign(ThreadsDataModule.OraSQL.SQL)
end;

procedure TThreadsFrame.btDeleteAllClick(Sender: TObject);
begin
  OraQuery.Session.ExecSQL('DELETE FROM ThreadTable', [Null]);
  OraQuery.Session.Commit;
end;

procedure TThreadsFrame.SetDebug(Value: boolean);
begin
  OraQuery.Debug := Value;
end;

end.