Stopper une Exception [Résolu]

[BuzzLeclaire]

Bonjour,

Dans mon application je suis tombé sur un soucis que je n'avais pas pensé.

J'utilise un TApplicationEvent pour gérer mes erreurs

Extrait

Code :

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
procedure TFPrincipal.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
var
  Lasterror: Integer;
  TextError: String;
begin
 
  Try
    TextError := 'Erreur pendant l''opération demandée, tentative impossible.';
    if (E is quelqueschose) then
    begin
      case AnsiIndexStr(SourceErreur,['liaison logiciel','sauvegarde','préférences réseau','Nonidentifié']) of
        0:
          MessageDlg('L''accès à la liaison logiciel n''est pas possible actuellement.'+#13+#10+
          'La base de données ' + Logiciel.Base +#13+#10+
          'est déjà ouverte par un autre programme en réseau ou en local sur votre poste.'+#13+#10+#13+#10+
          'Veuillez stopper cet accès avant de réaliser la liaison logiciel.'+#13+#10+
          'Si le problème persiste veuillez contacter votre revendeur.'
          ,mtError,[mbOK],0);
        1:
        begin
          MessageDlg('L''accès à la sauvegarde n''est pas possible actuellement.'+#13+#10+
          'La base de données ' + Logiciel.Base +#13+#10+
          'est déjà ouverte par un autre programme en réseau ou en local sur votre poste.'+#13+#10+#13+#10+
          'Veuillez stopper cet accès avant de réaliser votre sauvegarde.'+#13+#10+
          'Si le problème persiste veuillez contacter votre revendeur.'
          ,mtError,[mbOK],0);
 
//...
 
            With TFFicheErreurs.Create(Self) do
            begin
              Try
                Height := 73;
                sLabelMessageClaire.Caption := TextError;
                sEditTable.Visible  := False;
                sLabelTable.Visible := False;
    //            sEditTable.Text        := DecompositionSql(FData.QryLibre.SQL.Text);
                sEditUnite.Text        := UniteErreur;
                sEditMethode.Text      := ProcedureOuFonctionErreur;
                sEditClassName.Text    := E.ClassName;
                sMemoDescription.Text  := xxx.Description;
                sEditSource.Text       := xxx.Source;
                sEditNumero.Text       := xxx.Number);
                sEditNativeErreur.text := xxx.NativeError);
                sEditSQLState.text     := xxx.SQLState;
 
                ShowModal;
              Finally
                Release;
              End;
            end;
 
//...
 
 
        end;
 
// ...
end;

Lorsque je lance la sauvegarde, je passe en ouverture de base exclusive

Code :

1
2
3
4
5
6
7
8
9
procedure TFSauvegarde.FormCreate(Sender: TObject);
begin
 
  SourceErreur := 'sauvegarde'; // Permet un message spécifique sur l'accès Exclusive à la base
  FData.CnxPlg.Close;
  FData.CnxPlg.Mode := cmShareExclusive;
  FData.CnxPlg.Open;
//...
end;

J'ai bien ma fenêtre d'erreur qui s'ouvre permettant de donner, un descriptif, la source de l'erreur, la possibilité de la signaler par internet.

Mon problème c'est que cette fenêtre s'affiche sans arrêt, j'en ai donc plein qui s'ouvre. Comment je peux stopper l'erreur pour pas qu'elle ne se propage pas ?

Merci de votre aide.

[Ph. B.]

Bonjour,

Envoyé par BuzzLeclaire

J'utilise un TApplicationEvent pour gérer mes erreurs
...
J'ai bien ma fenêtre d'erreur qui s'ouvre permettant de donner, un descriptif, la source de l'erreur, la possibilité de la signaler par internet.

Mon problème c'est que cette fenêtre s'affiche sans arrêt, j'en ai donc plein qui s'ouvre. Comment je peux stopper l'erreur pour pas qu'elle ne se propage pas ?

Je n'ai pas vu de except relatif au try dans l'extrait (trop restreint) de code ? sur quel événement ?
La fenêtre s'affiche sans arrêt, c'est que dans le code, il doit y avoir une boucle ?

[BuzzLeclaire]

Salut Ph.

Il n'y a aucune Bloucle dans la procédure Event, je fais juste afficher une TForm selon des conditions.

Comme tu peux le voir :

Code :

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
procedure TFPrincipal.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
var
  Lasterror: Integer;
  TextError: String;
begin
 
    TextError := 'Erreur pendant l''opération demandée, tentative impossible.';
    if (E is QuelQuelChose) then
    begin
      case AnsiIndexStr(SourceErreur,['liaison logiciel','sauvegarde','préférences réseau','Nonidentifié']) of
        0:
          MessageDlg('L''accès à la liaison logiciel n''est pas possible actuellement.'+#13+#10+
          'La base de données ' + Logiciel.Base +#13+#10+
          'blabla'
          ,mtError,[mbOK],0);
        1:
        begin
          MessageDlg('L''accès à la sauvegarde n''est pas possible actuellement.'+#13+#10+
          'La base de données ' + Logiciel.Base +#13+#10+
          'blabla'
          ,mtError,[mbOK],0);
 
        end;
        2:
          MessageDlg('L''accès aux préférences réseau n''est pas possible actuellement.'+#13+#10+
          'La base de données ' + Logiciel.Base +#13+#10+
          'blabla'
          ,mtError,[mbOK],0);
        else
        begin
          LastError := xxx.Count-1;
          if LastError >= 0 then
          begin
            Case StrToIntDef((xxxx.SQLState),-1) of
              3001 : TextError := 'Argument invalide ou taille maxi de la base atteint.';
              3002 : TextError := 'Impossible d''ouvrir votre session.';
              //...
            end;
            With TFFicheErreurs.Create(Self) do
            begin
              Try
//... Je raccourci
                ShowModal;
              Finally
                Release;
              End;
            end;
          end
          else
          begin
            With TFFicheErreurs.Create(Self) do
            begin
              Try
//... Je raccourci
                ShowModal;
              Finally
                Release;
              End;
            end;
          end;
        end;
      end;
    end
    else
    begin
      if (E is EDivByZero) or (E is EZeroDivide) then  TextError :='Division par zéro impossible.'
      else
        if E is EFOpenError then TextError :='Fichier introuvable ou ouverture impossible.'
        else
          if E is EFCreateError then TextError :='Impossible de créer le fichier.'
          else
            if E is //...
 
      if (SourceErreur <> 'Scroll sComboBox') then
      begin
        With TFFicheErreurs.Create(Self) do
        begin
          Try
//... Je raccourci
            ShowModal;
          Finally
            Release;
          End;
        end;
      end;
    end;
end;

[tourlourou]

donc c'est l'appel qui se fait à chaque exception lors d'une demande d'opération de sauvegarde ?

sinon, est-ce que ça change en mettant :

Code :

1
2
3
4
5
6
TextError := 'Erreur pendant l''opération demandée, tentative impossible.';
on E: QuelQuelChose
do begin
  case AnsiIndexStr(SourceErreur,['liaison logiciel','sauvegarde','préférences réseau','Nonidentifié']) of
    0: // ...
end;

[Ph. B.]

Re,

Envoyé par BuzzLeclaire

Il n'y a aucune Bloucle dans la procédure Event, je fais juste afficher une TForm selon des conditions.

Pour la boucle, ce n'est pas au sein de cette procédure que je l'envisage, mais ailleurs dans le code, et qui déclencherait des exceptions en boucle....
Et en traçant pas à pas le code, on détecte quelque chose ?

[BuzzLeclaire]

Voilà ce que je fais

1) j'ouvre ma base expres avec ACCESS
3) j'ouvre logiciel sur cette même base
2) je clique sur un item d'un menu

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
procedure TFPrincipal.MenuItemSauvegardeClick(Sender: TObject);
begin
  UniteErreur := 'Principal';
  ProcedureOuFonctionErreur := 'MenuItemSauvegardeClick';
 
  if UnSeulUtilisateurEncours then
  begin
    With TFSauvegarde.Create(Self) do
    begin
      try
        ShowModal;
      finally
        Release;
      end;
    end;
  end;
end;

Et dans le create de la form sauvegarde

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure TFSauvegarde.FormCreate(Sender: TObject);
begin
  UniteErreur := 'Sauvegarde';
  ProcedureOuFonctionErreur := 'FormCreate';
 
  SourceErreur := 'sauvegarde'; // Permet un message spécifique sur l'accès Exclusive à la base
  FData.CnxPlg.Close;
  FData.CnxPlg.Mode := cmShareExclusive;
  FData.CnxPlg.Open;
 
  if not (LirePositionFenetre(Self,Self.Name)) then
  Begin
  // Alors la taille par defaut est forcée
    Self.Left   := (Screen.Width-Self.Width) div 2;
    Self.Top    := (Screen.Height-Self.Height) div 2;
  end;
 
end;

L'erreur arrive sur la ligne
FData.CnxPlg.Open;

Forcément puisque je prends le mode cmShareExclusive;

Mais je comprends pas pourquoi j'ai une propagation de l'erreur, et c'est toujours la même erreur, c'est pas une erreur en soit c'est juste que je peux pas être en mode exclusif puisque la base est ouverte ailleurs. Si pendant la création multiple de mes fenêtre d'erreur, je ferme ACCESS, les erreurs s’arrête, enfin j'ai plus de fenêtre qui s'ouvre m’alertant des erreurs.

[BuzzLeclaire]

Bien,

J'avais un Timer qui n'était pas désactivé , qui fais des lectures dans la base.

Merci à vous.