Bonjour à tous,

ne trouvant plus de pistes pour régler mon problème, je viens vous demander un coup de pouce.
Dans le cadre de mon travail je dois intervenir sur un programme qui a été développé en Visual Basic (VB6), et qui génère de temps à autres une erreur automation. Au même moment on constate un plantage du programme avec lequel il est interfacé (application de supervision d'une usine exécutée sur le même PC).
Le module VB a pour rôle de surveiller toutes les N secondes l'état d'une base de données Oracle distante, et de communiquer cet état au programme de supervision, qui lui-même se connecte de temps en temps à cette base pour y insérer des enregistrements. Le principe de surveillance de l'état est basé sur un OpenConnection() toutes les N secondes (voir extrait de code ci-dessous).
Les derniers essais effectuées ont mis en évidence un plantage du module VB au moment où la base de données Oracle n'était pas présente sur le réseau (PC serveur Oracle éteint ou base non démarrée sur le serveur).
Tout d'abord, on constate dès la perte de la base Oracle que le processus "VB.exe" passe en statut "Pas de réponse" dans le gestionnaire des tâches Windows XP, et l'application de supervision est très ralentie.
Au bout d'un temps indéfini le module VB plante, et le message d'erreur est le suivant : "Erreur d'exécution '2147417856 (80010100) ; Erreur automation ; Echec d'un appel système".
Mon intervention a pour but de régler ces problèmes, et faire en sorte que la déconnexion de la base de données Oracle soit bien notifiée à l'application de supervision, mais qu'en aucun cas elle ne ralentisse ni fasse "crasher" le système.
Vous trouverez ci-dessous l'extrait complet du code du module VB.
Ma question est la suivante : auriez-vous des suggestions de modifications du code du module VB de surveillance afin d'éviter ces problèmes ?
Merci à tous d'avance, et n'hésitez pas à me poser des questions car j'ai essayé d'être le plus clair possible dans mes explications mais ce n'est pas facile... Je répondrai dès que possible.

Contenu du projet VB (.vbp) :

1) Feuille 1 :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
 
Option Explicit
 
'Chemin Application
Private AppDir As String
 
'Connexion base Oracle
Private StrAccesORA As String
Private StrOdbcNameORA As String
Private IPServeur As String
Private OracleUser As String
Private OraclePass As String
Private VisibiliteIHM As Boolean
 
Const VarPanoRetour = "RETOUR_VB_SQL_OK"
Const VarPanoVerif = "VERIF_VB__SQL_OK"
 
'Gesvar
Dim WithEvents VERIF_VB As Gesvar32Lib.GesvarVariable
Dim WithEvents RETOUR_VB As Gesvar32Lib.GesvarVariable
Dim WithEvents VarGESVAR As Gesvar32Lib.GesvarDB
 
Private Sub Form_Load()
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
Timer2.Enabled = False
End Sub
 
Private Sub Timer1_Timer()
Timer1.Enabled = False
InitAppli
End Sub
Private Sub Timer2_Timer()
Dim ValeurGesvar
 
Timer2.Enabled = False
If ControlBase() = True Then
ValeurGesvar = 1
Else
ValeurGesvar = 0
End If
VarGESVAR.WriteVariable VarPanoRetour, ValeurGesvar
End Sub
 
Private Sub InitAppli()
Dim LectureBOOL As String
Dim Val_VERIF_VB As String
Dim ValeurGesvar
 
ValeurGesvar = 0
TextEtatLiaison.Text = "Indéterminé"
AppDir = App.Path & "\"
'Initialisation des variables à partir du fichier ini
On Error GoTo Err_LectORA_Ini
StrOdbcNameORA = Trim(LireClé("SERVEUR", "OdbcName", AppDir & "ORAControl.ini"))
If StrOdbcNameORA = "ErrIni" Then
GoTo Err_LectORA_Ini
End If
OracleUser = Trim(LireClé("SERVEUR", "OracleUser", AppDir & "ORAControl.ini"))
If OracleUser = "ErrIni" Then
GoTo Err_LectORA_Ini
End If
OraclePass = Trim(LireClé("SERVEUR", "OraclePass", AppDir & "ORAControl.ini"))
If OraclePass = "ErrIni" Then
GoTo Err_LectORA_Ini
End If
IPServeur = Trim(LireClé("SERVEUR", "ServeurIP", AppDir & "ORAControl.ini"))
If IPServeur = "ErrIni" Then
GoTo Err_LectORA_Ini
End If
'on lit une chaine de caractère (true ou false) et on affecte le boolean
LectureBOOL = Trim(LireClé("APPLICATION", "Visible", AppDir & "ORAControl.ini"))
If Not (UCase(LectureBOOL) = "TRUE" Or UCase(LectureBOOL) = "FALSE") Then
MsgBox "Valeur de l'item Visible incorrecte (soit True ou False) ou manquante", vbCritical, "Erreur Initialisation"
GoTo Err_LectORA_Ini
Else
If UCase(LectureBOOL) = "TRUE" Then
VisibiliteIHM = True
Else
VisibiliteIHM = False
End If
End If
'Etat de la fenêtre
EtatLiaison.Visible = VisibiliteIHM
On Error GoTo 0
 
On Error GoTo Err_Init_Gesvar
Set VERIF_VB = New Gesvar32Lib.GesvarVariable
VERIF_VB.VariableName = VarPanoVerif
Set RETOUR_VB = New Gesvar32Lib.GesvarVariable
RETOUR_VB.VariableName = VarPanoRetour
Set VarGESVAR = New Gesvar32Lib.GesvarDB
ValeurPanoVerif.Caption = CStr(VarGESVAR.ReadVariable(VarPanoVerif))
VarGESVAR.WriteVariable VarPanoRetour, ValeurGesvar
 
On Error GoTo 0
 
Timer2.Interval = 3000
Timer2.Enabled = True
Exit Sub
 
Err_LectORA_Ini:
MsgBox "Erreur de lecture du fichier de configuration ORAControl.ini", vbCritical, "Erreur Initialisation"
Unload EtatLiaison
Exit Sub
Err_Init_Gesvar:
MsgBox "Erreur de d'initialisation de Gesvar", vbCritical, "Erreur Initialisation"
Unload EtatLiaison
End Sub
 
Private Function ControlBase() As Boolean
Dim Bdd_ORA As Connection
Dim wrkODBC As Workspace
 
On Error GoTo Err_Connect
Timer2.Enabled = False
 
Set wrkODBC = CreateWorkspace("ODBCWorkspace", "admin", _
"", dbUseODBC)
 
wrkODBC.LoginTimeout = 0
 
StrAccesORA = "ODBC;DSN=" & StrOdbcNameORA & ";UID=" & OracleUser & ";PWD=" & OraclePass
Set Bdd_ORA = wrkODBC.OpenConnection("", _
dbDriverNoPrompt, False, _
StrAccesORA)
 
ControlBase = True
TextEtatLiaison.Text = "Liaison etablie"
On Error GoTo 0
 
On Error GoTo err_fermeture
 
Bdd_ORA.Close
wrkODBC.Close
Timer2.Enabled = True
Exit Function
 
Err_Connect:
ControlBase = False
wrkODBC.Close
TextEtatLiaison.Text = Ret_Erreur_Oracle
Timer2.Enabled = True
Exit Function
 
err_fermeture:
Resume Next
fin:
End Function
 
Private Sub VERIF_VB_OnVariableChange(ByVal Value, ByVal Validity As Long, ByVal ChangingTimeDate As Date, ByVal ChangingTimeMilliSecond As Long)
Dim ValeurGesvar
If Value = 1 Then
ValeurPanoVerif.Caption = CStr(Value)
EtatLiaison.Refresh
ValeurPanoVerif.Refresh
DoEvents
If ControlBase() = True Then
ValeurGesvar = 1
Else
ValeurGesvar = 0
End If
VarGESVAR.WriteVariable VarPanoRetour, ValeurGesvar
ValeurGesvar = 0
VarGESVAR.WriteVariable VarPanoVerif, ValeurGesvar
ValeurPanoVerif.Caption = CStr(VarGESVAR.ReadVariable(VarPanoVerif))
End If
End Sub
 
' Descriptif : - Fonctions de gestion des erreurs BD
'**************************************************
Public Function Ret_Erreur_Oracle() As String
 
Dim iP1 As Integer
Dim iP2 As Integer
Dim iPErr As Integer
Dim szErreur As String
 
On Error GoTo fin
Screen.MousePointer = 0
szErreur = Space$(0)
Select Case DBEngine.Errors(0).Source
Case "ODBC.QueryDef"
iPErr = InStr(DBEngine.Errors(0).Description, "Erreur Inconnue.")
If iPErr = 0 Then
iP1 = InStr(iP1 + 1, DBEngine.Errors(0).Description, "ORA-")
If iP1 > 0 Then
iP2 = InStr(iP1 + 1, DBEngine.Errors(0).Description, "ORA-")
szErreur = Mid$(DBEngine.Errors(0).Description, iP1, iP2 - iP1)
End If
Else
iP1 = InStr(iPErr, DBEngine.Errors(0).Description, "ORA-")
iP2 = InStr(iP1 + 1, DBEngine.Errors(0).Description, "ORA-")
If iP2 > 0 Then
szErreur = Mid$(DBEngine.Errors(0).Description, iP1, iP2 - iP1)
Else
szErreur = Mid$(DBEngine.Errors(0).Description, iP1)
End If
On Error Resume Next
End If
Case Else
szErreur = DBEngine.Errors(0).Description
End Select
Ret_Erreur_Oracle = Left$(szErreur, 254)
 
fin:
End Function
2) Module 1 :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 
Option Explicit
 
Public Declare Function GetPrivateProfileString Lib "KERNEL32" _
Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
 
 
'Fonction de lecture de fichier de configuration
Public Function LireClé(Section As String, Clé As String, Fichier As String) As String
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Cette fonction renvoie la valeur de la clé telle
' qu'on peut la trouver dans un fichier .ini quelconque.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ChaîneRésult As String
Dim RésultProfile As Integer
Dim i As Integer
 
ChaîneRésult = String(255, " ")
RésultProfile = GetPrivateProfileString(Section, Clé, "", _
ChaîneRésult, 255, Fichier)
If RésultProfile = 0 Then
LireClé = "ErrIni"
Exit Function
End If
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Une clé se termine par un chr(0), donc on le supprime
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ChaîneRésult = Trim(ChaîneRésult)
LireClé = Left(ChaîneRésult, Len(ChaîneRésult) - 1)
 
End Function