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;

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

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

// -------------------------------------- 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.

///////// 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