روش کار با thread و timer

[A.jafari]

با سلام خدمت همه دوستان دلفی کار , دوستان میخواستم توی برنامه ام از timer استفاده کنم که بتونه هر چند ساعت یک بار یا در ساعتهای خاصی یک StrodProcedure رو اجرا کنه ولی باعث کند شدن برنامه هم نشه , اگر کسی در این رابطه اطلاعاتی داره ممنون میشم کمکم کنید:لبخندساده:

[یوسف زالی]

سلام.
برای این کار بهتره دنبال تعریف جاب در خود اس کیو ال باشید.

[vcldeveloper]

سلام،

این یک نمونه کد کامل، فقط لطفا همینطوری Copy\Paste اش نکنید توی پروژه تون؛ اول کد رو متوجه بشید، چون کار کردن با Thread ها مشکلات خاص خودش رو داره، و نمی تونید بدون درک یک کد، صرفا با کپی آن، کار خودتون رو پیش ببرید:


unit uSpExecuter;

interface

uses
SysUtils, Classes, DB, ADODB;

type
TOnErrorEvent = procedure (Sender: TObject; const ErrMsg: string) of object;

TSpExecuter = class(TThread)
private
FOnError : TOnErrorEvent;
FDataset : TCustomADODataSet;
protected
procedure DoOnError(const Msg: string);
procedure Execute; override;
public
constructor Create(Dataset: TCustomADODataSet; OnTerminateEvent: TNotifyEvent;
OnErrorEvent: TOnErrorEvent = nil);
destructor Destroy; override;
property StoredProc : TCustomADODataSet read FDataset;
property OnError: TOnErrorEvent read FOnError write FOnError;
end;

implementation

uses ActiveX;

resourcestring
StrNullReferencePassed = 'Null reference is passed for stored procedure.';

{ TSpExecuter }

constructor TSpExecuter.Create(Dataset: TCustomADODataSet; OnTerminateEvent: TNotifyEvent;
OnErrorEvent: TOnErrorEvent = nil);
begin
inherited Create(False);
Self.OnTerminate := OnTerminateEvent;
Self.OnError := OnErrorEvent;
FDataset := Dataset;
if not Assigned(FDataset) then
raise Exception.Create(StrNullReferencePassed);
end;

destructor TSpExecuter.Destroy;
begin
FOnError := nil;
inherited;
end;

procedure TSpExecuter.DoOnError(const Msg: string);
begin
if Assigned(FOnError) then
FOnError(Self, Msg);
end;

procedure TSpExecuter.Execute;
var
ErrMsg : string;
begin
NameThreadForDebugging('SP Executer');
try
CoInitialize(nil);
try
if Assigned(FDataset) and (not Terminated) then
begin
Synchronize(FDataset.DisableControls);
try
FDataset.Open;
finally
Synchronize(FDataset.EnableControls);
end;
end;
except
on E: Exception do
begin
ErrMsg := E.Message;
Synchronize(procedure
begin
DoOnError(ErrMsg);
end);
end;
end;
finally
CoUninitialize;
end;
end;


end.


نمونه فرمی که از Thread ساخته شده در کد بالا استفاده میکنه:


unit fMain;

interface

uses
SysUtils, Classes, Controls, Forms, Dialogs, DB, ADODB, ExtCtrls, Grids,
DBGrids, StdCtrls, uSpExecuter;

type
TfrmMain = class(TForm)
ADOStoredProc1: TADOStoredProc;
Timer1: TTimer;
ADOConnection1: TADOConnection;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
lblLastUpdate: TLabel;
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FSpExecuter : TSpExecuter;
procedure OnExecuterError(Sender: TObject; const Msg: string);
procedure OnExecuterTerminate(Sender: TObject);
procedure DestroyExtractor;
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.DestroyExtractor;
begin
if Assigned(FSpExecuter) then
begin
FSpExecuter.Terminate;
FSpExecuter.WaitFor;
FreeAndNil(FSpExecuter);
end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
ReportMemoryLeaksOnShutdown := True;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
DestroyExtractor;
end;

procedure TfrmMain.OnExecuterError(Sender: TObject; const Msg: string);
begin
/// DO NOT RAISE AN EXCEPTION HERE!
Timer1.Enabled := False;
MessageDlg(Msg, mtError, [mbOK], 0);
end;

procedure TfrmMain.OnExecuterTerminate(Sender: TObject);
begin
lblLastUpdate.Caption := 'Last Update: ' + TimeToStr(Now);
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
DestroyExtractor;
FSpExecuter := TSpExecuter.Create(ADOStoredProc1,
OnExecuterTerminate,
OnExecuterError);
end;

end.