oraclecancellableutils.pas

contains synchronous routines to open queries with possibility to cancel execution,is intended for D

{*******************************************************}
{                                                       }
{           Add-on for Direct Oracle Access             }
{           Utils to open cancellable queries           }
{                                                       }
{      Copyright (c) 2000 by Dmitry V. Bolshakov        }
{                                                       }
{*******************************************************}

unit OracleCancellableUtils;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls,
  OracleData, Oracle;

type

  OpenQueryType = (oqtOpen,oqtRefresh,oqtExec);

  TfQueryCancel = class(TForm)
    bCancel: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    procedure bCancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    FDataSet: TOracleDataSet;
    FShowCancelWinDelay:LongWord;
    StartTime:TTime;
    procedure ThreadDone(Sender: TObject);
  public
    function OpenCancellableQuery(DataSet: TOracleDataSet; ShowCancelWinDelay:LongWord; OpenQueryType:OpenQueryType):Boolean;
  end;

  TQueryThread = class(TThread)
  private
    FDataSet: TOracleDataSet;
    FSynchronizeException:TObject;
    FOpenQueryType:OpenQueryType;
    FCanceled:Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(DataSet: TOracleDataSet; TerminateEvent:TNotifyEvent; OpenQueryType:OpenQueryType);
    function WaitFor(TimeOut:LongWord): LongWord;
  end;

const
  fQueryCancel: TfQueryCancel = nil;

{-------------------------------------------------------------------------------

  Functions to open and execute queries with possibility of interruptions.

  Parameters:

  DataSet: TOracleDataSet  - The query which need to open and execute.

  ShowCancelWinAfter:LongWord - The window to cancel query don't appears
                            immediately but appears only through the gap of the
                            time specified by this parameters in millisecond.
                            By default, window shows through 1 second.
  Result:
    Functions return False if query was canceled, else it return True.
-------------------------------------------------------------------------------}

function OpenCancellableQuery(DataSet: TOracleDataSet; ShowCancelWinDelay:LongWord = 1000):Boolean;
function RefreshCancellableQuery(DataSet: TOracleDataSet; ShowCancelWinDelay:LongWord = 1000):Boolean;
function ExecCancellableQuery(DataSet: TOracleDataSet; ShowCancelWinDelay:LongWord = 1000):Boolean;


implementation

{$R *.DFM}

function OpenCancellableQuery(DataSet: TOracleDataSet; ShowCancelWinDelay:LongWord = 1000):Boolean;
begin
  if not Assigned(fQueryCancel) then
    fQueryCancel := TfQueryCancel.Create(Application);
  Result := fQueryCancel.OpenCancellableQuery(DataSet,ShowCancelWinDelay,oqtOpen);
end;

function RefreshCancellableQuery(DataSet: TOracleDataSet; ShowCancelWinDelay:LongWord = 1000):Boolean;
begin
  if not Assigned(fQueryCancel) then
    fQueryCancel := TfQueryCancel.Create(Application);
  Result := fQueryCancel.OpenCancellableQuery(DataSet,ShowCancelWinDelay,oqtRefresh);
end;

function ExecCancellableQuery(DataSet: TOracleDataSet; ShowCancelWinDelay:LongWord = 1000):Boolean;
begin
  if not Assigned(fQueryCancel) then
    fQueryCancel := TfQueryCancel.Create(Application);
  Result := fQueryCancel.OpenCancellableQuery(DataSet,ShowCancelWinDelay,oqtExec);
end;

{ TSortThread }

constructor TQueryThread.Create(DataSet: TOracleDataSet;
                                TerminateEvent:TNotifyEvent;
                                OpenQueryType:OpenQueryType);
begin
  FDataSet := DataSet;
  FreeOnTerminate := False;
  OnTerminate := TerminateEvent;
  FOpenQueryType := OpenQueryType;
  FCanceled := False;
  inherited Create(False);
end;

type
  PRaiseFrame = ^TRaiseFrame;
  TRaiseFrame = record
    NextRaise: PRaiseFrame;
    ExceptAddr: Pointer;
    ExceptObject: TObject;
    ExceptionRecord: PExceptionRecord;
  end;

procedure TQueryThread.Execute;
begin
  try
    case FOpenQueryType of
      oqtOpen:
        begin
          FDataSet.Close;
          FDataSet.Open;
        end;
      oqtRefresh:
        FDataSet.Refresh;
      oqtExec:
        FDataSet.ExecSQL;
    end;
  except
    if ((ExceptObject is EOracleError) and ((ExceptObject as EOracleError).ErrorCode = 1013)) then
      FCanceled := True
    else if RaiseList <> nil then
      begin
        FSynchronizeException := PRaiseFrame(RaiseList)^.ExceptObject;
        PRaiseFrame(RaiseList)^.ExceptObject := nil;
      end;
  end;
end;


{ TfQueryCancel }
var
  FSynchronizeException:TObject;

function TfQueryCancel.OpenCancellableQuery(DataSet: TOracleDataSet;
                                            ShowCancelWinDelay:LongWord;
                                            OpenQueryType:OpenQueryType):Boolean;
var AThread:TQueryThread;
    WaitResult:DWORD;
begin
  FDataSet := DataSet;
  FShowCancelWinDelay := ShowCancelWinDelay;
  AThread := TQueryThread.Create(DataSet,ThreadDone,OpenQueryType);
  try
    WaitResult := AThread.WaitFor(FShowCancelWinDelay);
    if WaitResult = WAIT_TIMEOUT then
      ShowModal;

    FSynchronizeException := AThread.FSynchronizeException;
    Result := not AThread.FCanceled;
  finally
    AThread.Free;
  end;
  if Assigned(FSynchronizeException) then raise FSynchronizeException;
end;

procedure TfQueryCancel.ThreadDone(Sender: TObject);
begin
  Close;
  //window will not be closed till any message presened in queue
  PostMessage(Handle,WM_NULL,0,0);
end;

procedure TfQueryCancel.bCancelClick(Sender: TObject);
begin
  if FDataSet <> nil then
    FDataSet.Session.BreakExecution;
end;

function TQueryThread.WaitFor(TimeOut:LongWord): LongWord;
var
  Msg: TMsg;
  H: THandle;
begin
  H := Handle;
  if GetCurrentThreadID = MainThreadID then
  begin
    Result := MsgWaitForMultipleObjects(1, H, False, TimeOut,QS_SENDMESSAGE);
    while Result = WAIT_OBJECT_0 + 1 do
    begin
      PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
      Result := MsgWaitForMultipleObjects(1, H, False, TimeOut,QS_SENDMESSAGE);
    end;
  end
  else
    Result := WaitForSingleObject(H, TimeOut);
//  GetExitCodeThread(H, Result);
end;

procedure TfQueryCancel.FormShow(Sender: TObject);
begin
  Timer1.Enabled := True;
  StartTime := Now();
  Label1.Caption := FormatDateTime('hh:mm:ss',0);
  Label1.Update();
end;

procedure TfQueryCancel.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Timer1.Enabled := False;
end;

procedure TfQueryCancel.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := FormatDateTime('hh:mm:ss',Now()-StartTime);
  Label1.Update();
end;

end.