Subject proper threading with IBX
Author d_dude_2003
D7, IBX 7.08, FB 1.5

I have an app server which access FireBird GDB and also separate
thread which scans the same GDB and sends out emails.

It looks like this thread conflicts with the main application because
sometimes the main app hangs...

Can anyone tell me do i need to specify any transaction isolation
level, which one and any other advices are really appreciated.

Here is the thread code:

unit SMTPThread;

interface

uses
Classes, WinSock, ComCtrls, Forms, Windows, IdSMTP, IdMessage, DB,
SysUtils, DateUtils, IdException, IBCustomDataSet, IBQuery,
IBDatabase;

type
TSMTPThread = class(TThread)
private
FForm: TForm;
FSMTP: TIdSMTP;
FMessage: TIdMessage;

FIBDatabase: TIBDatabase;
FIBTransaction: TIBTransaction;
FIBQuery, FUpdateQuery: TIBQuery;

FS: String;

procedure UpdateForm;
protected
procedure Execute; override;
public
constructor Create(AForm: TForm; ASMTP: TIdSMTP; AMessage:
TIdMessage;
GDBName: String);
destructor Destroy; override;
end;

implementation

uses
WFServerMain;

constructor TSMTPThread.Create(AForm: TForm; ASMTP: TIdSMTP;
AMessage:
TIdMessage; GDBName: String);
function UniqueName: String;
var
DateTime: TDateTime;
THours, TMins, TSecs, TMSecs: Word;
TYear, TMonth, TDay: Word;
begin
DateTime := Now;
DecodeTime(DateTime, THours, TMins, TSecs, TMSecs);
DecodeDate(DateTime, TYear, TMonth, TDay);

Result := 'db_' + inttostr(TDay)
+ inttostr(THours)
+ inttostr(TMins)
+ inttostr(TSecs)
+ inttostr(TMSecs);
end;

begin
inherited Create(True); //create suspended
Priority := tpIdle;
FreeOnTerminate := False;
FForm := AForm;
FSMTP := ASMTP;
FMessage := AMessage;

//setup data access for our thread

FIBDatabase := TIBDatabase.Create(nil);
FIBDatabase.Name := UniqueName;
FIBDatabase.DatabaseName := GDBName;
FIBDatabase.Params.Add('USER_NAME=SYSDBA');
FIBDatabase.Params.Add('PASSWORD=masterkey');
FIBDatabase.LoginPrompt := False;

FIBTransaction := TIBTransaction.Create(nil);

FIBDatabase.DefaultTransaction := FIBTransaction;
FIBTransaction.DefaultDatabase := FIBDatabase;

FIBDatabase.Connected := True;

FIBQuery := TIBQuery.Create(nil);
FIBQuery.Database := FIBDatabase;
FIBQuery.Transaction := FIBTransaction;

FIBQuery.SQL.Text := 'SELECT * FROM MOC_OUTBOX WHERE PROCESSED
= ' +
chr(39) + 'N' + chr(39);

FUpdateQuery := TIBQuery.Create(nil);
FUpdateQuery.Database := FIBDatabase;
FUpdateQuery.Transaction := FIBTransaction;
end;

destructor TSMTPThread.Destroy;
begin
FUpdateQuery.Free;
FIBQuery.Close;
FIBQuery.Free;
FIBTransaction.Free;
FIBDatabase.Connected := False;
FIBDatabase.Free;
inherited Destroy
end;

procedure TSMTPThread.Execute;
begin
while not Terminated do
begin

FIBQuery.Close;
FIBQuery.Open;

with FIBQuery do
begin
First;
while not EOF do
begin
FMessage.From.Name := FieldByName('FromName').AsString;
FMessage.From.Address := FieldByName('FromAddress').AsString;
FMessage.Recipients.EMailAddresses := FieldByName
('ToName').AsString
+ ' <' + FieldByName('ToAddress').AsString + '>';
FMessage.Subject := FieldByName('Subject').AsString;

FS := FMessage.Subject;

Synchronize(UpdateForm);

FMessage.Body.Assign(TMemoField(FieldByName('BODY')));
try
if not FSMTP.Connected then
FSMTP.Connect;
FSMTP.Send(FMessage);

FS := 'Message sent';
Synchronize(UpdateForm);

FUpdateQuery.SQL.Text := 'UPDATE MOC_OUTBOX SET PROCESSED
= ' +
chr(39) + 'Y' + chr(39) + ' WHERE ID = ' +
IntToStr(FieldByName('ID').AsInteger);
FUpdateQuery.ExecSQL;
except
on E: Exception do
begin
FS := 'Exception: ' + E.Message;
Synchronize(UpdateForm);
end

end;
Next
end; //while not EOF
end; //with FIBQuery

//Suspend

end;
end;

procedure TSMTPThread.UpdateForm;
begin
TfrmMain(FForm).mmEmailLog.Lines.Add(FS);
end;

end.