Devart Forums

Code: Select all

program ODACBeforeExecTest;

uses
  Forms,
  uMain in 'uMain.pas' {Form1},
  CancelQry in 'CancelQry.pas' {CancelQryDlg};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Code: Select all

object CancelQryDlg: TCancelQryDlg
  Left = 480
  Top = 361
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsDialog
  Caption = 'Statement processing...'
  ClientHeight = 116
  ClientWidth = 250
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Verdana'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  Position = poOwnerFormCenter
  Scaled = False
  OnClose = FormClose
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 16
  object Label1: TLabel
    Left = 32
    Top = 80
    Width = 103
    Height = 16
    Caption = 'Execution time:'
  end
  object lblTime: TLabel
    Left = 140
    Top = 80
    Width = 22
    Height = 16
    Caption = '0:0'
  end
  object lblPending: TLabel
    Left = 20
    Top = 8
    Width = 200
    Height = 16
    Caption = 'Cancel pending, please wait...'
    Visible = False
  end
  object btnCancel: TButton
    Left = 88
    Top = 40
    Width = 75
    Height = 25
    Caption = 'Cancel'
    Default = True
    TabOrder = 0
    OnClick = btnCancelClick
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 100
    OnTimer = Timer1Timer
    Left = 188
    Top = 32
  end
end

Code: Select all

unit CancelQry;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TCancelQryDlg = class(TForm)
    Label1: TLabel;
    lblTime: TLabel;
    btnCancel: TButton;
    lblPending: TLabel;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    StartTime: TTime;
  public
    { Public declarations }
    Cancelled: Boolean;
  end;

implementation

{$R *.dfm}

procedure TCancelQryDlg.Timer1Timer(Sender: TObject);
var
  H, M, S, C: Word;
begin
  Timer1.Enabled := False;
  try
    DecodeTime(Now - StartTime, H, M, S, C);
    if (H > 0) then
      lblTime.Caption := Format('%d Hour %d Min', [H, M])
    else if (M > 0) then
      lblTime.Caption := Format('%d Min %d Sec', [M, S])
    else if (S > 0) then
    begin
      Timer1.Interval := 500;
      lblTime.Caption := Format('%d Seconds', [S]);
    end
    else
      lblTime.Caption := Format('0.%d Sec', [C]);
  finally // wrap up
    Timer1.Enabled := True;
    Application.ProcessMessages;
  end;    // try/finally
end;

procedure TCancelQryDlg.FormShow(Sender: TObject);
begin
  lblPending.Visible := False;
  Cancelled := False;
  StartTime := Now;
  Timer1.Interval := 100;
  Timer1.Enabled := True;
end;

procedure TCancelQryDlg.btnCancelClick(Sender: TObject);
begin
  Cancelled := True;
  lblPending.Visible := True;
  Timer1.Enabled := False;
  Self.Refresh;
  Application.ProcessMessages;
end;

procedure TCancelQryDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Timer1.Enabled then
    Timer1.Enabled := False;
  Action := caFree;
end;

end.

Code: Select all

object Form1: TForm1
  Left = 228
  Top = 177
  Width = 870
  Height = 453
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 152
    Top = 12
    Width = 681
    Height = 373
    DataSource = OraDataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object Button1: TButton
    Left = 16
    Top = 12
    Width = 75
    Height = 25
    Caption = 'Open Query'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 16
    Top = 48
    Width = 75
    Height = 25
    Caption = 'Close Query'
    Enabled = False
    TabOrder = 2
    OnClick = Button2Click
  end
  object Memo1: TMemo
    Left = 16
    Top = 88
    Width = 121
    Height = 177
    Lines.Strings = (
      '1. Click Open Query'
      ''
      '2. If you are in 9.3.10,'
      '  you will see an error'
      ''
      '  if you are in 9.3.9,'
      '  you will have clean'
      '  open.'
      ''
      '3. Click Close Query,'
      '    Repeat.')
    TabOrder = 3
  end
  object OraSession1: TOraSession
    Username = 'ODAC'
    Server = 'SYNDEV_ODAC'
    LoginPrompt = False
    Schema = 'ODAC'
    Left = 12
    Top = 372
    EncryptedPassword = 'B0FFBBFFBEFFBCFF'
  end
  object OraQuery1: TOraQuery
    Session = OraSession1
    SQL.Strings = (
      'select * from emp'
      'order by empno')
    BeforeExecute = OraQuery1BeforeExecute
    AfterExecute = OraQuery1AfterExecute
    Left = 44
    Top = 372
  end
  object OraDataSource1: TOraDataSource
    DataSet = OraQuery1
    Left = 72
    Top = 372
  end
end

Code: Select all

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, DBAccess, Ora, MemDS;

type
  TForm1 = class(TForm)
    OraSession1: TOraSession;
    OraQuery1: TOraQuery;
    OraDataSource1: TOraDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure OraQuery1BeforeExecute(Sender: TObject);
    procedure OraQuery1AfterExecute(Sender: TObject; Result: Boolean);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    QryStopped: Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  CancelQry;

var
  frmCancelQry: TCancelQryDlg;  

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  QryStopped := False;
  with OraQuery1 do
  begin
    Prepare;
    Open;
    while Executing do
    begin
      Application.ProcessMessages;
      if frmCancelQry.Cancelled then
      begin
        QryStopped := True;
        OraQuery1.BreakExec;
      end;
    end;    // while
  end;
end;

procedure TForm1.OraQuery1BeforeExecute(Sender: TObject);
begin
  Button1.Enabled := False;
  frmCancelQry := TCancelQryDlg.Create(Application);
  frmCancelQry.Show;
end;

procedure TForm1.OraQuery1AfterExecute(Sender: TObject; Result: Boolean);
begin
  try
    if QryStopped then
    begin
      frmCancelQry.Hide;
      MessageDlg('Query stopped by user.', mtInformation, [mbOK], 0);
    end;
  finally
    Button2.Enabled := True;
    try
      frmCancelQry.Close;
    except
      MessageDlg('An error trying to close the CancelQry form!', mtError, [mbOK], 0);
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OraQuery1.Active then
    OraQuery1.Close;
  Button2.Enabled := False;
  Button1.Enabled := True;
end;

end.