Bonjour à tous
Excusez-moi, c’est un peu long, mais j’ai mis un maximum d’informations.
Je crée une application qui puisse fonctionner en réseau, pour mes essais, j’utilise un réseau créé avec VirtualBox avec Win XP ou Win10.
Dans mon application programmée sous Lazarus, j’utilise FireBird pour gérer ma base de données.
J’utilise Windows10 64 bits avec:
Lazarus 2.0.12, avec compilation en 32bits, FPC 3.2.0
FireBird-3.0.10.33601_0_Win32
Les composants utilisés pour l’application:
TIBConnection
TSQLTransaction
TFBEventMonitor
TSQLQuery
TDataSource
Je n‘ai pas de soucis pour manipuler la base de données aussi bien en réseau qu’en local.
J’ai simplement un souci avec l’ événement de FireBird, l’application qui envoie le message, le reçois également, ce qui n’est pas prévu à l’origine, vu le lien ci-dessous.
Lien concernant TFBEventMonitor:
https://wiki.freepascal.org/TFBEventMonitor
Lien sur la présentation des événements:
https://firebirdsql.org/file/documen...ird_events.pdf
Je me suis inspiré de cette exemple de l’installation de Lazarus*:
d:\lazarus\fpc\3.2.0\source\packages\fcl-db\examples\fbeventstest.pp
Le message, l’événement est bien reçu des autres applications en mode réseau avec VirtualBox. Que ça soit sous WinXP ou Win10.
Ci-dessous des extraits de codes.
J’ai modifié la classe du navigateur, afin que je puisse gérer mes transactions, insérer, effacer et valider mes données.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
procedure TMyDBNavigator.BtnClick(Index: TNavigateBtn);
begin
//inherited BtnClick(Index);
if (DataSource<>nil) and (DataSource.State<>dsInactive) then begin
if not (csDesigning in ComponentState) and Assigned(BeforeAction) then
BeforeAction(Self,Index);
with DataSource.DataSet do begin
case Index of
nbPrior: begin Prior; end;
nbNext: Next;
nbFirst: begin First; end;
nbLast: Last;
nbInsert: ;//Insert;
nbEdit: Edit;
nbCancel: Cancel;
nbPost: ;
nbRefresh: Refresh;
nbDelete: ;
end;
end;
end;
if not (csDesigning in ComponentState) and Assigned(OnClick) then
OnClick(Self,Index);
end; |
Le code de nbPost du navigateur de l’application
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
with Data do
begin
if ValidationSaisies then
begin
Data.CommitTransaction(Data.SQLQueryStock,true,'toto'); // toto et le message d’essai
try
SQLQueryStock.Refresh;
SqlQueryStock.locate('ART_REFERENCE',VarART_REFERENCE,[loCaseInsensitive]);
VarART_REFERENCE := ''; //par précaution
except
On E : Exception do
Data.RollbackTransaction(Data.SQLQueryStock);
erreur(_Message32+ ' '+E.Message);
end;
end
else
begin
Data.RollbackTransaction(Data.SQLQueryStock);
erreur(_Message5);
end;
end
end; |
Le code du Commit
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
|
Procedure TData.CommitTransaction(Query:TSQLQuery;PasPourScript:boolean;Msg:String);
begin
try
if Query.SQLTransaction.Active then
begin
Query.UpdateMode:= upWhereAll;
if PasPourScript then Query.ApplyUpdates; // ne pas appliquer pour un script
Query.SQLTransaction.Commit;
Query.Active:= PasPourScript; // réouvrir la table après un Commit, sauf pour un script
if Msg <> '' then
begin
EnvoieMsgFireBird(Msg);
CheckSynchronize;
end;
end;
except
on E : EDatabaseError do
begin
RollbackTransaction(Query);
Erreur('La transaction a échouée, VOTRE modification n''est pas prise en compte.'+crlf+
' Il est possible qu''un autre poste ait apporté un changement à cet enregistrement, en même temps que vous.'+crlf+
1. ' La solution est d''actualiser et éventuellement de recommencer'+crlf+crlf+ E.Message);
end;
end;
end; |
Envoi de l’événement par une procédure stockée de la base de données
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
procedure TData.EnvoieMsgFireBird(NomDuMessage:string);
begin
if not getBaseEmbedded_presente then // pas en réseau, pas besoin de message
begin
try
IBConnection1.Open;
IBConnection1.ExecuteDirect('execute PROCEDURE Msg_MiseAJour '''+NomDuMessage+''';');
IBConnection1.Transaction.Commit;
except
on E:Exception do
begin
erreur('L''information de mise à jour de FireBird à échouée.'+crlf+crlf+E.message);
RollbackTransaction(SQLQueryScript);
end;
end;
end;
end; |
Code de la procédure stockée de la base de données
1
2
3
4
5
6
7
8
9
10
11
|
SET TERM ^ ;
ALTER PROCEDURE MSG_MISEAJOUR (
NOMDUMESSAGE VARCHAR(127) )
AS
BEGIN
/* write your code here */
POST_EVENT NomDuMessage;
END
^
SET TERM ; ^ |
Code de réception de l’événement de FireBird, pour recevoir l’événement, j’utilise un second TIBConnection avec FBEventMonitor qui recoit l’événement, pour l’instant, quand l’événement ‘toto’ est reçu, un simple message s’affiche, le problème l’appli qui crée l’événement reçoit aussi le message.
1
2
3
4
5
6
7
|
procedure TData.onEventAlertFB(Sender: TObject; EventName: string;
EventCount: longint; var CancelAlerts: boolean);
begin
ReceptionEventFB := EventName;
If EventName = 'toto' then showmessage('Merci toto');
end; |
La configuration de Firebird
RemoteAuxPort = 4050
ServerMode = Super
J’essaye une idée de contournement, comme les messages identiques sont comptés par ‘EventCount’, je vérifie le nombre de messages, comparé à une variable activée lors de l’envoi du message et s’il y a qu’un message, c’est celui que l’appli vient d’envoyer, donc j’ignore le message.
J’utilise VirtualBox avec deux WinXP avec chacun une appli et une autre appli sur le PC, (donc 3 appli qui tournent) sur le même PC.
L’exemple ci-dessous semble bien fonctionner, je modifie dans une appli une table avec plusieurs enregistrements différents, je valide, il y a coherence des messages, celui qui envoie ne reçoit pas de message. Les autres applis ont la variable «* EventCount*» de onEventAlertFB qui s’incrémente. Avec plusieurs incréments, il n’y a qu’un message, c’est normal, c’est la même chose, la même table à mettre à jour.
J’ai une variable global «*MsgFB_CetteAppli)*» mise à true quand l’appli envoie un message.
Emission des messages
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
procedure TData.EnvoieMsgFireBird(NomDuMessage:string);
begin
if not getBaseEmbedded_presente then //en réseau, besoin de message
begin
try
MsgFB_CetteAppli := true;
IBConnection1.Open;
IBConnection1.ExecuteDirect('execute PROCEDURE Msg_MiseAJour '''+NomDuMessage+''';');
IBConnection1.Transaction.Commit;
except
on E:Exception do
begin
{todo:traduire}
erreur('L''information de mise à jour de FireBird à* échouée.'+crlf+crlf+E.message);
RollbackTransaction(SQLQueryScript);
MsgFB_CetteAppli := false;
end;
end;
end;
end; |
Réception du/des messages
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
procedure TData.onEventAlertFB(Sender: TObject; EventName: string;
EventCount: longint; var CancelAlerts: boolean);
begin
ReceptionEventFB := EventName;
If EventName = 'toto' then
begin
If ((EventCount = 1) and not MsgFB_CetteAppli) or (EventCount > 1) then
begin
showmessage('Merci toto');
end
else
begin
MsgFB_CetteAppli := false;
end;
end;
end; |
Malgré le contournement créé ci-dessus, je préférerais que FireBird n’envoie pas de message à l’ emetteur.
Si vous avez des exemples, des liens, je suis preneur.
Merci de vos réponses.
Gestion de l’événement de FireBird avec Lazarus. Problème l’émetteur reçoit l’événement*
Répondre avec citation
Partager