Discussion :

[AcidLines]

Bonjour,

Je me permets après plusieurs recherches, de poster ici mon problème.

Comme dis dans mon topic, mon BackGround s'éxecute 2 fois, alors qu'il n'est appelé qu'une seule fois dans mon Thread principal. J'ai beau faire du pas-à-pas, je ne comprend pas d'où provient cette double exécution.

Voici mon Thread Principal

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
 
#Region "Déclarations"
Public Const CNXStr As String = "Data Source=xwayr;Persist Security Info=True;User ID=icsf;Password=crossway"
Public Const Histo As Double = 2
Dim dossierApplicatif As String = My.Application.Info.DirectoryPath
Dim emplacementListeUf As String = Path.Combine(dossierApplicatif, "UfListe.txt")
Dim WithEvents BGWorkerADM As ComponentModel.BackgroundWorker
Dim WithEvents BGWorkerTC As ComponentModel.BackgroundWorker
Dim WithEvents BGWorkerPlanSoin As ComponentModel.BackgroundWorker
Dim WithEvents BGWorkerCopiePartage As ComponentModel.BackgroundWorker
Dim WithEvents BGWorkerCopieClient As ComponentModel.BackgroundWorker
Dim dossierTraces As String = dossierApplicatif & "\Traces"
Dim traceMain As RapportLog
Dim traceADM As New RapportLog(dossierTraces, "TraceADM")
Dim tracePlanSoin As New RapportLog(dossierTraces, "TraceIPS")
Dim traceTC As New RapportLog(dossierTraces, "TraceTC")
Dim traceCopieClient As New RapportLog(dossierTraces, "CopieClient")
Dim traceCopiePartage As New RapportLog(dossierTraces, "CopiePartage")
Dim UFliste As New List(Of UF)
Dim checkThreads As Boolean
Dim checkThreadsCopy As Boolean
Public Const crystalReportPath As String = "C:\refer_c\usv2\app\CrwReport.exe"
Dim shareDirectory As String
Dim clientDirectory As String
#End Region
 
Sub Main()
'Vérification du répertoire des traces
If Directory.Exists("Traces") = False Then
Directory.CreateDirectory("Traces")
Else
 
'Suppression des traces
Console.WriteLine("Epuration des traces")
For Each fichier As String In Directory.GetFiles("Traces")
If File.GetCreationTime("Traces\" & fichier).AddDays(Histo) < Now Then
File.Delete(fichier)
End If
Next
End If
traceMain = New RapportLog(dossierTraces, "TraceGenerale")
Console.WriteLine("Démarrage de la procédure dégradée IPS")
Console.WriteLine()
traceMain.addEvenement("Démarrage de la procédure dégradée IPS")
　
'Création du répertoire des Fichiers
If Directory.Exists("xway") = False Then
Directory.CreateDirectory("xway")
End If
 
'Vérification des process en cours de la dernière opération
Console.WriteLine("Vérification des process CrystalReport")
traceMain.addEvenement("Vérification des process CrystalReport")
Dim loadProcesses As Process()
loadProcesses = Process.GetProcessesByName("CrwReport")
For Each loadProcess In loadProcesses
loadProcess.Kill()
Next
 
'Instanciation des Threads de traitements
'ADM
BGWorkerADM = New ComponentModel.BackgroundWorker
AddHandler BGWorkerADM.DoWork, AddressOf BGWorkerADm_DoWork
 
'PLANSOIN
BGWorkerPlanSoin = New ComponentModel.BackgroundWorker
AddHandler BGWorkerPlanSoin.DoWork, AddressOf BGWorkerPlanSoin_DoWork
 
'TC
BGWorkerTC = New ComponentModel.BackgroundWorker
AddHandler BGWorkerTC.DoWork, AddressOf BGWorkerTC_DoWork
 
'COPIES CLIENTS
BGWorkerCopieClient = New ComponentModel.BackgroundWorker
AddHandler BGWorkerCopieClient.DoWork, AddressOf BGWorkerCopieClient_DoWork
 
'COPIES PARTAGE
BGWorkerCopiePartage = New ComponentModel.BackgroundWorker
AddHandler BGWorkerCopiePartage.DoWork, AddressOf BGWorkerCopiePartage_DoWork
 
'Alimentation de la liste des UF
Console.WriteLine()
Console.WriteLine("Récupération de la liste de UF")
traceMain.addEvenement("Récupération de la liste de UF")
Dim lectureFichier As New StreamReader(emplacementListeUf)
Dim ligneCourrante As String
Dim recupValeurs() As String
Dim UFCourrante As UF
ligneCourrante = lectureFichier.ReadLine
While Not Trim(ligneCourrante) = String.Empty
recupValeurs = Split(ligneCourrante, ";", 3)
 
'Création de l'objet UF
UFCourrante = New UF(recupValeurs(0), recupValeurs(1), recupValeurs(2))
 
'Ajout de l'objet à la collection d'UF
UFliste.Add(UFCourrante)
ligneCourrante = lectureFichier.ReadLine
End While
lectureFichier.Close()
 
'Création des répertoires d'UF
Console.WriteLine("Création des répertoires d'UF")
traceMain.addEvenement("Création des répertoires d'UF")
 
For Each monUf As UF In UFliste
If Directory.Exists("xway\" & monUf.getNumUf) = False Then
Directory.CreateDirectory("xway\" & monUf.getNumUf)
End If
Next
 
'Démarrage des Threads
Console.WriteLine()
Console.WriteLine("Démarrage des Threads de création des PDF")
traceMain.addEvenement("Démarrage des Threads de création des PDF")
Console.WriteLine()
checkThreads = True
 
BGWorkerADM.RunWorkerAsync()
Console.WriteLine("-THREAD ADM : OK")
 
'BGWorkerPlanSoin.RunWorkerAsync()
'Console.WriteLine("-THREAD PLANSOIN : OK")
 
'BGWorkerTC.RunWorkerAsync()
'Console.WriteLine("-THREAD TC : OK")
 
Dim timeThreads As Integer
timeThreads = 0
 
'Vérifications des threads
While checkThreads = True
timeThreads = timeThreads + 1
Console.Write(".")
System.Threading.Thread.Sleep(1000)
Select Case True
Case BGWorkerADM.IsBusy
Case BGWorkerPlanSoin.IsBusy
Case BGWorkerTC.IsBusy
Case Else
checkThreads = False
End Select
End While
 
Console.WriteLine()
Console.WriteLine("Fin des traitements de création de PDF (" & timeThreads & " Secondes)")
traceMain.addEvenement("Fin des traitements de création de PDF (" & timeThreads & " Secondes)")
 
'Une fois que les threads sont libérés. Copie des fichier, gestion de l'historique des dossiers
If checkThreads = False Then
checkThreadsCopy = True
timeThreads = 0
 
'Démarrage des Threads de répartition
Console.WriteLine("Démarrage de la répartition des fichiers créés")
traceMain.addEvenement("Démarrage de la répartition des fichiers créés")
 
'Copie des fichiers sur les partages
BGWorkerCopiePartage.RunWorkerAsync()
 
'Copie des fichiers sur les clients
BGWorkerCopieClient.RunWorkerAsync()
 
'Vérification des Threads de répartitions
While checkThreadsCopy = True
timeThreads = timeThreads + 1
Console.Write(".")
System.Threading.Thread.Sleep(1000)
 
Select Case True
Case BGWorkerCopieClient.IsBusy
Case BGWorkerCopiePartage.IsBusy
Case Else
checkThreadsCopy = False
End Select
End While
 
Console.WriteLine("Fin des traitements de répartition des PDF (" & timeThreads & " Secondes)")
traceMain.addEvenement("Fin des traitements de répartition de PDF (" & timeThreads & " Secondes)")
 
If checkThreadsCopy = False Then
'Suppression des fichiers actuels du serveur
 
Console.WriteLine("Suppression des fichiers du serveur")
traceMain.addEvenement("Suppression des fichiers du serveur")
For Each MonUf As UF In UFliste
 
Try
Dim repertoireActif As String
repertoireActif = dossierApplicatif & "\xway\" & MonUf.getNumUf
For Each fichier As String In Directory.GetFiles(repertoireActif)
File.Delete(fichier)
traceMain.addEvenement("-Fichier supprimé :" & fichier)
Next
 
Catch ex As Exception
traceMain.addEvenement("Erreur lors de la suppression des fichiers de :" & dossierApplicatif & "\wxay\" & MonUf.getNumUf)
End Try
 
Next
End If
End If
 
Console.WriteLine("Fin de la procédure dégradée IPS")
traceMain.addEvenement("Fin de la procédure dégradée IPS")

Et voici l'action de mon BGWorker Incriminé.

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
 
#Region "BGWORKER ADM Abonnement"
Private Sub BGWorkerADm_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BGWorkerADM.DoWork
traceADM.addEvenement("Démarrage Thread ADM")
Dim crystalReportADMArgs As String
Dim crystalADM As New Process
'Passage de paramètre Crystal pour chaque UF
For Each monUf As UF In UFliste
crystalReportADMArgs = dossierApplicatif & "\ProDegADM.rpt EXPORT_PDF PARAMSCR=NOUMHEB:'" & monUf.getNOUMHEB & "' OUT=" & dossierApplicatif & "\xway\" & monUf.getNumUf & "\ADM" & Replace(Now.Date.ToShortDateString, "/", "_") & "_" & Replace(Now.ToShortTimeString, ":", "_") & ".pdf"
crystalADM = Process.Start(crystalReportPath, crystalReportADMArgs)
traceADM.addEvenement("Création PDF pour " & monUf.getNumUf)
traceADM.addEvenement("Commande : " & crystalReportPath & " " & crystalReportADMArgs)
While crystalADM.HasExited = False
Threading.Thread.Sleep(50)
End While
Next
traceADM.addEvenement("Fin Thread ADM")
End Sub
 
#End Region

[Sankasssss]

Bonjour,

ceci est tout à fait normal car vous liez l’évènement via AddHandler BGWorkerADM.DoWork, AddressOf BGWorkerADm_DoWork alors qu'il est déjà traité par Handles BGWorkerADM.DoWorkEnlevez un dès deux et ça fonctionnera beaucoup mieux

[AcidLines]

En effet, c'est mieux.
Merci beaucoup.