tek bir eksik yanı var.
uzun süren table1.open veya query1.open gibi işlemleriniz çalışmaya başladığı anda bu işlemler bitmeden kullanıcı programı kapatmaya çalıştığında sorunlar çıkıyor. güvenli bir şekilde programın kapatılabilmesi için threadin çalışmasının bitmesi gerekiyor.
unit1.pas
Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, DBTables, Db, Grids, DBGrids, StdCtrls, IBCustomDataSet,
IBTable, IBDatabase, Provider, DBClient, DBLocal, DBLocalI;
const
WM_OPENDATASET = WM_USER + 1;
WM_EXECUTESQL = WM_USER + 2;
type
TThreadDataSet = class(TThread)
private
procedure WMOpenDataSet(Msg: TMsg);
procedure WMExecSQL(Msg: TMsg);
protected
procedure Execute; override;
public
procedure Open(DataSet: TDataSet);
procedure ExecSQL(DataSet: TDataSet);
end;
TForm1 = class(TForm)
Table1: TTable;
Query1: TQuery;
Button1: TButton;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FThread : TThreadDataSet;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TThreadDataSet.ExecSQL(DataSet: TDataSet);
begin
PostThreadMessage(ThreadID, WM_EXECUTESQL, Integer(DataSet), 0);
end;
procedure TThreadDataSet.Execute;
var
Msg : TMsg;
begin
FreeOnTerminate := True;
PeekMessage(Msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
while not Terminated do begin
if GetMessage(Msg, 0, 0, 0) then
case Msg.Message of
WM_OPENDATASET: WMOpenDataSet(Msg);
WM_EXECUTESQL: WMExecSQL(Msg);
end;
end;
end;
procedure TThreadDataSet.Open(DataSet: TDataSet);
begin
PostThreadMessage(ThreadID, WM_OPENDATASET, Integer(DataSet), 0);
end;
procedure TThreadDataSet.WMExecSQL(Msg: TMsg);
var
Qry : TQuery;
begin
try
Qry := TQuery(Msg.wParam);
try
Qry.Open;
except
Qry.ExecSQL;
end;
except
On E: Exception do
ShowMessage(E.Message);
end;
end;
procedure TThreadDataSet.WMOpenDataSet(Msg: TMsg);
var
Ds : TDataSet;
begin
try
Ds := TDataSet(Msg.wParam);
Ds.Open;
except
On E: Exception do
ShowMessage(E.Message);
end;
end;
// --------------------------------------- //
procedure TForm1.FormCreate(Sender: TObject);
begin
FThread := TThreadDataSet.Create(False);
//thread nesnesini create ediyoruz
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FThread.Terminate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DataSource1.DataSet := Table1;
FThread.Open(Table1); //thread nesnesine tabloyu açtırıyoruz
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DataSource1.DataSet := Query1;
FThread.ExecSQL(Query1); // sql cümlesini çalıştırıyoruz
end;
end.
Kod: Tümünü seç
object Form1: TForm1
Left = 209
Top = 216
Width = 696
Height = 314
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 16
Top = 216
Width = 75
Height = 25
Caption = 'Tablo Aç'
TabOrder = 0
OnClick = Button1Click
end
object DBGrid1: TDBGrid
Left = 16
Top = 80
Width = 665
Height = 120
DataSource = DataSource1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object Button2: TButton
Left = 96
Top = 216
Width = 75
Height = 25
Caption = 'Sorgu Aç'
TabOrder = 2
OnClick = Button2Click
end
object Table1: TTable
DatabaseName = 'DBDEMOS'
TableName = 'country.db'
Left = 8
Top = 8
end
object Query1: TQuery
DatabaseName = 'DBDEMOS'
SQL.Strings = (
'select * from customer')
Left = 56
Top = 8
end
object DataSource1: TDataSource
DataSet = Table1
Left = 96
Top = 8
end
end