Beispiel zur Ausführung einer SQL Anweisung in einem eigenen Thread

/*****************************************************************************/
  Demo zur Ausführung einer SQL Anweisung in einem eigenen Thread
  während der Ausführungszeit läuft eine Progressbar
  erstellt am 08.08.2000 von Rene Kadner (www.kadner-online.de)
  Umgebung: Win2000 Server dt., Delphi5 Enterprise SP1 dt., RxTools 2.75
/*****************************************************************************/

unit Auswertung1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, Grids, DBGrids, RXDBCtrl, ComCtrls, ExtCtrls, Menus, StdCtrls,
Buttons, RXSpin, DBTables, Placemnt, Mask, DBCtrls;

type
  TFAuswertung = class(TForm)
    StatusBar1: TStatusBar; // mit 2 Panels
    MainMenu1: TMainMenu; // mit 2 Menüeinträgen: Close und Start
    MN_EXIT: TMenuItem;
    MN_NEW: TMenuItem;
    Label1: TLabel;
    RxSpinEdit1: TRxSpinEdit; // für Query Parameter
    Timer1: TTimer;
    ProgressBar1: TProgressBar; // Intervall := 100, Enabled := FALSE
    procedure FormCreate(Sender: TObject);
    procedure MN_EXITClick(Sender: TObject);
    procedure MN_NEWClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    IsRunigThread: BOOLEAN;
    procedure StartThread;
    procedure StopThread(Sender: TObject);
  public
    { Public-Deklarationen }
  end;

type
  TSQLThread = class(TThread)
  private
    fJahr: integer;
    procedure DoSync;
  protected
    sQuery: TQuery;
    procedure Execute; override;
    procedure RunSQL;
  public
    constructor Create(jahr: integer);
  end;

var
  FAuswertung: TFAuswertung;

implementation

{$R *.DFM}

//****************************************************************************//
// Class Methoden - FAuswertung
//****************************************************************************//

{ TFAuswertung }

{------------------------------------------------------------------------------}
procedure TFAuswertung.FormCreate(Sender: TObject);
begin
  IsRunigThread := FALSE;
end;

{------------------------------------------------------------------------------}
procedure TFAuswertung.FormCloseQuery(Sender: TObject;var CanClose: Boolean);
begin
  CanClose := not IsRunigThread;
end;

{------------------------------------------------------------------------------}
procedure TFAuswertung.MN_EXITClick(Sender: TObject);
begin
  close;
end;

{------------------------------------------------------------------------------}
procedure TFAuswertung.MN_NEWClick(Sender: TObject);
begin
  if MessageDlg('Achtung ! Die Datenneuerstellung dauert bis zu 25s. Daten erstellen ?',
      mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
  StatusBar1.Panels[1].Text := 'Daten werden neu eingetragen. Bitte warten.';
  Application.ProcessMessages;
  StartThread;
end;

{------------------------------------------------------------------------------}
procedure TFAuswertung.StartThread;
begin
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := TRUE;
  Timer1.Interval := 100;
  Timer1.Enabled := TRUE;
  IsRunigThread := TRUE;
  Screen.Cursor := -19; // Sanduhr mit Griffel
  Application.ProcessMessages;
  with TSQLThread.Create( RxSpinEdit1.AsInteger ) do OnTerminate := StopThread;
end;

{------------------------------------------------------------------------------}
procedure TFAuswertung.StopThread(Sender: TObject);
begin
  ProgressBar1.Position := 0;
  ProgressBar1.Visible := FALSE;
  Timer1.Enabled := FALSE;
  Screen.Cursor := crDefault;
  IsRunigThread := FALSE;
  StatusBar1.Panels[1].Text := 'Fertig, Daten wurden neu eingetragen.';
  // Hier gehts normal weiter, z.B. Neuanzeige der Werte ...
end;

{------------------------------------------------------------------------------}
procedure TFAuswertung.Timer1Timer(Sender: TObject);
var i: integer;
begin
  i := ProgressBar1.Position;
  inc(i);if i > ProgressBar1.Max then i := 0;
  ProgressBar1.Position := i;
  Application.ProcessMessages;
end;

//****************************************************************************//
// Class Methoden - Thread
//****************************************************************************//

{ TSQLThread }

{------------------------------------------------------------------------------}
constructor TSQLThread.Create(jahr: integer);
begin
  fjahr := jahr;
  FreeOnTerminate := True;
  inherited Create(False);
end;

{------------------------------------------------------------------------------}
procedure TSQLThread.DoSync;
begin
  Application.ProcessMessages;
end;

{------------------------------------------------------------------------------}
procedure TSQLThread.Execute;
begin
  RunSQL;
end;

{------------------------------------------------------------------------------}
procedure TSQLThread.RunSQL;
begin
  Synchronize(DoSync);
  sQuery := TQuery.Create(nil);
  sQuery.DatabaseName := 'DB_VIS';
  sQuery.SQL.Clear;
  sQuery.SQL.Add('vis_sp_initAuswertung '+IntToStr(fjahr));
  sQuery.ExecSQL;
  sQuery.Close;
  Synchronize(DoSync); // der hier war ganz wichtig, sonst gings nicht (?)
  sQuery.SQL.Clear;
  sQuery.SQL.Add('vis_sp_FillAuswertung '+IntToStr(fjahr));
  sQuery.ExecSQL;
  sQuery.Close;
  sQuery.Free;
  if Terminated then Exit;
end;

end.