Thread - fazer select ou query ficar em segundo plano e cancelar antes de terminar

Top  Previous  Next

// colocar select em segundo plano e cancelar antes dele terminar

// voce vai precisar de 2 unit's:  MainUnit e SegundoPlanoUnit

// aqui o Fonte e form das 2. sendo que a SegundoPlanoForm não é auto-create

 

// -------------------------------------- MainUnit ---------------------------------- //

 

unit MainUnit;

 

interface

 

uses Forms, DBXpress, DB, DBClient, SimpleDS, dbxDataSet, SqlExpr, SysUtils,

     StdCtrls, Controls, ExtCtrls, Classes, Grids, DBGrids;

 

type

  TForm1 = class(TForm)

    Conexao: TSQLConnection;

    Qy: TdbxDataSet;

    DataSource1: TDataSource;

    DBGrid1: TDBGrid;

    Panel1: TPanel;

    Label6: TLabel;

    Button1: TButton;

    Button3: TButton;

    Label1: TLabel;

    MsgLabel: TLabel;

    procedure Button1Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

  private

    procedure AoTerminar(Sender: TObject);

    procedure Roda(Sender: TObject);

  end;

 

var

  Form1: TForm1;

 

implementation

 

uses Unit2;

 

{$R *.dfm}

 

//////////////////////////////////////////////////////////////////////////////// internas

 

procedure TForm1.AoTerminar(Sender: TObject);

begin

  if SegundoPlano_Concluido then

  begin

    MsgLabel.Caption := MsgLabel.Caption + 'TERMINOU OK! reg(' + IntToStr(Qy.RecordCount) + ') ' + TimeToStr(Time);

    SegundoPlanoForm.Close;

  end

  else

  begin

    MsgLabel.Caption := 'TERMINOU CANCELADO! ' + TimeToStr(Time);

    Qy.EnableControls;

  end;

end;

 

procedure TForm1.Roda(Sender: TObject);

begin

  if Qy.Select('select * from VW_BASE order by nm_base') then

    Label6.Caption := FloatToStr(Qy.Tempo);

  MsgLabel.Caption := 'Rotina principal concluída: ' + TimeTostr(Time) + ' ';

end;

 

///////////////////////////////////////////////////////////////////////////////// form

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  if Assigned(SegundoPlanoForm) and (SegundoPlanoForm <> nil) then FreeAndNil(SegundoPlanoForm);

  SegundoPlanoForm := TSegundoPlanoForm.Create(Self);

  SegundoPlanoForm.RotinaTerminar := AoTerminar;

  SegundoPlanoForm.RotinaRoda     := Roda;

  SegundoPlanoForm.Show;

end;

 

procedure TForm1.Button3Click(Sender: TObject);

begin

  Qy.Select('select * from VW_BASE order by nm_base');

  Label6.Caption := FloatToStr(Qy.Tempo);

end;

 

end.

 

//// Form

 

object Form1: TForm1

  Left = 260

  Top = 108

  Width = 783

  Height = 648

  Caption = 'Power Thread!'

  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 = 0

    Top = 0

    Width = 775

    Height = 575

    Align = alClient

    DataSource = DataSource1

    TabOrder = 0

    TitleFont.Charset = DEFAULT_CHARSET

    TitleFont.Color = clWindowText

    TitleFont.Height = -11

    TitleFont.Name = 'MS Sans Serif'

    TitleFont.Style = []

  end

  object Panel1: TPanel

    Left = 0

    Top = 575

    Width = 775

    Height = 44

    Align = alBottom

    TabOrder = 1

    object Label6: TLabel

      Left = 300

      Top = 8

      Width = 58

      Height = 13

      Caption = '00:00,000'

      Font.Charset = DEFAULT_CHARSET

      Font.Color = clNavy

      Font.Height = -11

      Font.Name = 'MS Sans Serif'

      Font.Style = [fsBold]

      ParentFont = False

    end

    object Label1: TLabel

      Left = 252

      Top = 8

      Width = 43

      Height = 13

      Caption = 'Tempo:'

      Font.Charset = DEFAULT_CHARSET

      Font.Color = clWindowText

      Font.Height = -11

      Font.Name = 'MS Sans Serif'

      Font.Style = [fsBold]

      ParentFont = False

    end

    object MsgLabel: TLabel

      Left = 252

      Top = 24

      Width = 24

      Height = 13

      Caption = 'Msg'

      Font.Charset = DEFAULT_CHARSET

      Font.Color = clWindowText

      Font.Height = -11

      Font.Name = 'MS Sans Serif'

      Font.Style = [fsBold]

      ParentFont = False

    end

    object Button1: TButton

      Left = 8

      Top = 10

      Width = 106

      Height = 25

      Caption = 'Select THREAD'

      TabOrder = 0

      OnClick = Button1Click

    end

    object Button3: TButton

      Left = 124

      Top = 10

      Width = 106

      Height = 25

      Caption = 'Select NORMAL'

      TabOrder = 1

      OnClick = Button3Click

    end

  end

  object Conexao: TSQLConnection

    ConnectionName = 'IBConnection'

    DriverName = 'Interbase'

    GetDriverFunc = 'getSQLDriverINTERBASE'

    LibraryName = 'dbexpint.dll'

    LoginPrompt = False

    Params.Strings = (

      'DriverName=Interbase'

      'Database=SERVER02:d:\fbs\bistekteste.fbs'

      'RoleName=RoleName'

      'User_Name=sysdba'

      'Password=masterkey'

      'ServerCharSet='

      'SQLDialect=3'

      'ErrorResourceFile='

      'LocaleCode=0000'

      'BlobSize=-1'

      'CommitRetain=False'

      'WaitOnLocks=True'

      'Interbase TransIsolation=ReadCommited'

      'Trim Char=False')

    VendorLib = 'gds32.dll'

    Left = 328

    Top = 188

  end

  object Qy: TdbxDataSet

    Aggregates = <>

    Connection = Conexao

    DataSet.MaxBlobSize = -1

    DataSet.Params = <>

    PacketRecords = 30000

    Params = <>

    MensagemAguardar = 'Aguarde um momento...'

    Left = 412

    Top = 188

  end

  object DataSource1: TDataSource

    DataSet = Qy

    Left = 472

    Top = 188

  end

end

 

// -------------------------------------- SegundoPlanoUnit ---------------------------------- //

 

unit SegundoPlanoUnit;

 

interface

 

uses Forms, Controls, StdCtrls, Graphics, ExtCtrls, Classes;

 

type

  TSegundoPlanoForm = class(TForm)

    CancelarBtn: TButton;

    MsgLabel: TLabel;

    Image1: TImage;

    procedure CancelarBtnClick(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

  private

  public

    Terminou      : Boolean; // após executar o terminar

    RotinaTerminar: TNotifyEvent;

    RotinaRoda    : TNotifyEvent;

  end;

 

  TSegundoPlano = class(TThread)

    Rotina: TNotifyEvent;

    procedure Execute; override;

    constructor Inicializar;

  end;

 

var

  SegundoPlanoForm: TSegundoPlanoForm;

  SegundoPlano: TSegundoPlano;

  SegundoPlano_Concluido: Boolean = False;

 

implementation

 

{$R *.dfm}

 

///////////////////////////////////////////////////////////////////////// Thread

 

procedure TSegundoPlano.Execute;

begin

  inherited;

  if Assigned(Rotina) then Rotina(nil);

  SegundoPlano_Concluido := True;

  Terminate;

end;

 

constructor TSegundoPlano.Inicializar;

begin

  inherited Create(True);

  Priority               := tpNormal;

  FreeOnTerminate        := True;

  SegundoPlano_Concluido := False;

end;

 

//////////////////////////////////////////////////////////////////////// Form

 

procedure TSegundoPlanoForm.CancelarBtnClick(Sender: TObject);

begin

  Close;

end;

 

procedure TSegundoPlanoForm.FormShow(Sender: TObject);

begin

  Terminou := False;

  SegundoPlano             := TSegundoPlano.Inicializar;

  SegundoPlano.OnTerminate := RotinaTerminar;

  SegundoPlano.Rotina      := RotinaRoda;

  SegundoPlano.Resume;

end;

 

procedure TSegundoPlanoForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

  if not SegundoPlano_Concluido then

  begin

    SegundoPlano.Suspend;

    SegundoPlano.Terminate;

    if Assigned(RotinaTerminar) then RotinaTerminar(Self);

  end;

end;

 

end.

 

 

///////// form

 

object SegundoPlanoForm: TSegundoPlanoForm

  Left = 344

  Top = 214

  BorderIcons = [biSystemMenu]

  BorderStyle = bsDialog

  Caption = 'Aguarde'

  ClientHeight = 92

  ClientWidth = 344

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  Position = poScreenCenter

  OnCloseQuery = FormCloseQuery

  OnShow = FormShow

  PixelsPerInch = 96

  TextHeight = 13

  object MsgLabel: TLabel

    Left = 60

    Top = 20

    Width = 71

    Height = 13

    Caption = 'Abrindo base...'

  end

  object Image1: TImage

    Left = 8

    Top = 12

    Width = 32

    Height = 32

    Picture.Data = {

      055449636F6E0000010001002020000100000000A80800001600000028000000

      2000000040000000010008000000000000040000000000000000000000010000

      0000000000000000000080000080000000808000800000008000800080800000

      C0C0C000C0DCC000F0CAA600CCFFFF0099FFFF0066FFFF0033FFFF00FFCCFF00

      CCCCFF0099CCFF0066CCFF0033CCFF0000CCFF00FF99FF00CC99FF009999FF00

      6699FF003399FF000099FF00FF66FF00CC66FF009966FF006666FF003366FF00

      0066FF00FF33FF00CC33FF009933FF006633FF003333FF000033FF00CC00FF00

      9900FF006600FF003300FF00FFFFCC00CCFFCC0099FFCC0066FFCC0066FFCC00

      33FFCC0000FFCC00FFCCCC00CCCCCC0099CCCC0066CCCC0033CCCC0000CCCC00

      FF99CC00CC99CC009999CC006699CC003399CC000099CC00FF66CC00CC66CC00

      9966CC006666CC003366CC000066CC00FF33CC00CC33CC009933CC006633CC00

      3333CC000033CC00FF00CC00CC00CC009900CC006600CC003300CC000000CC00

      FFFF9900CCFF990099FF990066FF990033FF990000FF9900FFCC9900CCCC9900

      99CC990066CC990033CC990000CC9900FF999900CC9999009999990066999900

      3399990000999900FF669900CC66990099669900666699003366990000669900

      FF339900CC33990099339900663399003333990000339900FF009900CC009900

      99009900660099003300990000009900FFFF6600CCFF660099FF660066FF6600

      33FF660000FF6600FFCC6600CCCC660099CC660066CC660033CC660000CC6600

      FF996600CC99660099996600669966003399660000996600FF666600CC666600

      99666600666666003366660000666600FF336600CC3366009933660066336600

      3333660000336600FF006600CC00660099006600660066003300660000006600

      FFFF3300CCFF330099FF330066FF330033FF330000FF3300FFCC3300CCCC3300

      99CC330066CC330033CC330000CC3300FF993300CC9933009999330066993300

      3399330000993300FF663300CC66330099663300666633003366330000663300

      FF333300CC33330099333300663333003333330000333300FF003300CC003300

      99003300660033003300330000003300CCFF000099FF000066FF000033FF0000

      FFCC0000CCCC000099CC000066CC000033CC000000CC0000FF990000CC990000

      99990000669900003399000000990000FF660000CC6600009966000066660000

      0066000033660000FF330000CC33000099330000663300003333000000330000

      CC0000009900000066000000330000000000DD000000BB000000AA0000008800

      0000770000005500000044000000220000DD000000BB000000AA000000880000

      00770000005500000044000000220000DDDDDD00555555007777770077777700

      44444400222222001111110077000000550000004400000022000000F0FBFF00

      A4A0A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000

      FFFFFF0000000000000000000000000000000000000000F0F0F0F0F0F0F0F0F0

      F0F0F0F00000000000000000000000000000000000CB00F0EBF7F7F7F7F7F7F7

      F7F7F7F000000000000A0B000000000000000000CBCBCBF0EB2FF7F7F7F7F7F7

      0000F7F0000000000000000B0C000000000000CBCBCBCBF0EBEBEBEBEBEBEBEB

      EBEBEBF00000000000000000000C0C00000000CBCBCBCBF0F0F0F0F0F0F0F0F0

      F0F0F0F000000000000000000000000D0D0D00000000CBCBCBCBF0EBEBEBEBEB

      F00000000000000000000000000000000D0D0D0000CBCBF0F0F0F0F0F0F0F0F0

      F0F0F0F000000000000000000000000D0D0D0000CBCBCBF0EBEBEBEBEBEBEBEB

      EBEBEBF00000000000000000000D0D0D0D0000CBCBCBCBF0F700FFBFFFBFFFBF

      FFBFEBF000000000000000000D0D0D0D00000000CBCBCBF0F700BFFFBFFFBFFF

      BFFFEBF00000000000000D0D0D0DFB0DFB0DFB000000CBF0F700FFBFFFBFFFBF

      FFBFEBF000000000000000000D0D0DFB0DFBFBFBFB0000F0F700BFFFBFFFBFFF

      BFFFEBF0000000000000CB000000FB0DFBFBFBFBFBFBFBF0F700FFBFFFBFFFBF

      FFBFEBF00000000000CBCBCBCB000000FBFBFBFB13FB13F0F700000000000000

      0000EBF000000000CBCBCBCBCBCBCB000000FB13FB1313F0F7F7F7F7F7F7F7F7

      F7F7EBF0000000CBCBCBCBCBCBCBCBCB00000013131313F0F0F0F0F0F0F0F0F0

      F0F0F0F000F0F0F0F0F0F0F0F0F0F0F0F0F000001313131313130000CBCBCBCB

      CBCBCB0000F0EBF7F7F7F7F7F7F7F7F7F7F0001313131313130000CBCBCBCBCB

      CBCB000000F0EB2FF7F7F7F7F7F70000F7F01313131313131313000000CBCBCB

      CB00000000F0EBEBEBEBEBEBEBEBEBEBEBF01313131313131313131300000000

      0000000000F0F0F0F0F0F0F0F0F0F0F0F0F01313131313131313131313131300

      0000000000000000F0EBEBEBEBEBF00013131313131313131313191913191319

      1319000000F0F0F0F0F0F0F0F0F0F0F0F0F01313131313131319131319191919

      1919000000F0EBEBEBEBEBEBEBEBEBEBEBF00013131313131913191919191919

      0000000000F0F700FFBFFFBFFFBFFFBFEBF00000131313191319191919190000

      0000000000F0F700BFFFBFFFBFFFBFFFEBF0CB00000019131919191900000000

      0000000000F0F700FFBFFFBFFFBFFFBFEBF0CBCBCB0000191919190000000000

      0000000000F0F700BFFFBFFFBFFFBFFFEBF000CBCBCB00001919000000000000

      0000000000F0F700FFBFFFBFFFBFFFBFEBF00000CBCBCB000000000000000000

      0000000000F0F7000000000000000000EBF0000000CB00000000000000000000

      0000000000F0F7F7F7F7F7F7F7F7F7F7EBF00000000000000000000000000000

      0000000000F0F0F0F0F0F0F0F0F0F0F0F0F00000000000000000000000000000

      00000000CFFFA000E1FF0000F03E0000F80C0000FE000000FF000007FFC00000

      FF000000FE000000F8000000F0000000F8000000F8000000F0000000E0000000

      C00000008000000080000001800000038000000780000001F000000080000000

      80000001800000078000001F8000007F800000FF800201FF800313FF8003BFFF

      8003FFFF}

  end

  object CancelarBtn: TButton

    Left = 134

    Top = 56

    Width = 75

    Height = 25

    Caption = 'Cancelar'

    TabOrder = 0

    OnClick = CancelarBtnClick

  end

end