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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
| Namespace Utilitaire
Public Class DecoderMail
'Variables
Private oMail As Mail
Private oIndesirable As ContactsIndesirables
Private oAscii As Conversion.AsciiIso
Private oES As ES
#Region "Constructeur"
Public Sub New(ByVal M As Mail, ByVal C As ContactsIndesirables)
oMail = M
oIndesirable = C
End Sub
#End Region
''''''''''''''''''''''' Méthodes ''''''''''''''''''''''''
'publiques
#Region "on extrait les élements"
Public Sub ExtractionElements()
Dim NumMAil As Integer = 0
Dim strChaine As String = ""
Dim booTrouver As Boolean
'on va chercher le fichier
oES = New ES(oMail.AdresseCorpsEntier)
strChaine = oES.OuvrirFichier()
'on extrait les différentes informations
RecupereEntete(strChaine, oMail)
recupereCorpsHtml(strChaine, oMail)
recupereCorpsTxt(strChaine, oMail)
RecuperePJ(strChaine, oMail)
'on change la catégorie
booTrouver = False
For Each C As ContactIndesirable In oIndesirable
If C.AdresseMail = oMail.AdresseEmetteur OrElse C.Nom = oMail.NomEmetteur Then
booTrouver = True
Exit For
End If
Next
'si on a trouve l'adresse mail ou le nom de l'émetteur dans les indésirables,
' on met le mail dans les indésirables
If booTrouver Then
oMail.Categorie = Mail.Categories.Indesirable
Else
oMail.Categorie = Mail.Categories.BoiteReception
End If
End Sub
#End Region
'privées
#Region "Recupere entete"
Private Sub RecupereEntete(ByVal strChaine As String, ByVal omail As Mail)
Dim intIndex As Integer
Dim strTMP As String = ""
oAscii = New Conversion.AsciiIso
With omail
'on récupère :
'l'émetteur
intindex = strChaine.ToLower.IndexOf("from:")
If intindex <> -1 Then
strTMP = strChaine.Substring(intindex + 6)
strTMP = strTMP.Substring(0, strTMP.IndexOf(vbCrLf))
If strTMP.IndexOf("<") = -1 Then
.NomEmetteur = strTMP.Trim(" "c).Replace("""", "")
.AdresseEmetteur = strTMP.Trim(" "c).Replace("""", "")
Else
.NomEmetteur = oAscii.DecodeToAscii(strTMP.Substring(0, strTMP.IndexOf("<") - 1).Replace("""", ""))
.AdresseEmetteur = strTMP.Substring(strTMP.IndexOf("<") + 1, strTMP.IndexOf(">") - strTMP.IndexOf("<") - 1)
End If
Else 'si on trouve pas
.NomEmetteur = "Inconnu"
.AdresseEmetteur = "Inconnu"
End If
'l'objet
intindex = strChaine.ToLower.IndexOf("subject:")
If intindex <> -1 Then
strTMP = strChaine.Substring(intindex + 9)
.Objet = oAscii.DecodeToAscii(strTMP.Substring(0, strTMP.IndexOf(vbCrLf)))
Else 'si on trouve pas
.Objet = "Aucun"
End If
'Date
Try
intIndex = strChaine.ToLower.IndexOf("date:")
If intIndex <> -1 Then
strTMP = strChaine.Substring(intIndex + 6)
strTMP = strTMP.Substring(0, strTMP.IndexOf(vbCrLf))
strTMP = strTMP.Substring(0, strTMP.LastIndexOf(":") + 2)
.DateMail = CType(Format(strTMP, "General Date"), Date)
Else
.DateMail = Now.Date
End If
Catch ex As Exception
.DateMail = Now.Date
End Try
'récepteur
intindex = strChaine.ToLower.IndexOf("to:")
If intindex <> -1 Then
strTMP = strChaine.Substring(intindex + 4)
strTMP = strTMP.Substring(0, strTMP.IndexOf(vbCr))
If strTMP.IndexOf("<") = -1 Then
.NomRecepteur = strTMP.Trim(" "c)
.AdresseRecepteur = strTMP.Trim(" "c)
Else
.NomRecepteur = oAscii.DecodeToAscii(strTMP.Substring(0, strTMP.IndexOf("<")).Replace("""", ""))
.AdresseRecepteur = strTMP.Substring(strTMP.IndexOf("<") + 1, strTMP.IndexOf(">") - strTMP.IndexOf("<") - 1)
End If
Else 'on trouve pas
'normalement il doit y avoir l'émetteur sinon on la recevrait pas
End If
'Priorité:
intIndex = strChaine.ToLower.IndexOf("x-priority:")
If intIndex <> -1 Then
.Priorite = Convert.ToInt32(strChaine.Substring(intIndex + 12, 1))
Else
.Priorite = 3
End If
'Adresse de réponse
intIndex = strChaine.ToLower.IndexOf("reply-to:")
If intIndex <> -1 Then
strTMP = strChaine.Substring(intIndex + 10)
.ReplyTo = strTMP.Substring(0, strTMP.IndexOf(vbCr))
Else 'sinon on met l'adresse de l'émetteur
.ReplyTo = .AdresseEmetteur
End If
'le message n'est pas encore lu
.Lu = "1"
End With
End Sub
#End Region
#Region "recupere corps HTML"
Private Sub recupereCorpsHtml(ByVal strChaine As String, ByRef omail As Mail)
Dim intIndex As Integer = 0
oAscii = New Conversion.AsciiIso
'on récupère la partie du mail qui est au format html
'avant de commencer, on enlève les = à la fin des lignes, cela peut empêcher
'la détection du <html>
'strChaine = strChaine.Replace("=" & ChrW(13) & ChrW(10), "")
intIndex = strChaine.ToLower.IndexOf("content-type: text/html")
If intIndex <> -1 Then
'on commence juste avant le <html> après le boudary
strChaine = strChaine.Substring(intIndex + 24)
intIndex = strChaine.ToLower.IndexOf("<html>")
If intIndex <> -1 Then
strChaine = strChaine.Substring(intIndex)
Else
'si on ne trouve pas le html on commence après le premier double saut à la ligne
strChaine = strChaine.Substring(strChaine.IndexOf(vbCrLf & vbCrLf))
End If
' Maintenant il faut trouver où la partie s'arrête :
' soit avant un autre boudary soit à la fin du mail (.) , soit après la balise </html>
If strChaine.ToLower.IndexOf("</html>") <> -1 Then
'si on trouve la balise </html> c'est le must
intIndex = strChaine.ToLower.IndexOf("</html>")
strChaine = strChaine.Substring(0, intIndex + 7)
ElseIf strChaine.ToLower.IndexOf("boundary") <> -1 Then
'si on trouve une autre balise boudary on s'arrête au saut à ligne juste avant.
intIndex = strChaine.ToLower.IndexOf("boundary")
strChaine = strChaine.Substring(0, intIndex)
strChaine = strChaine.Substring(0, strChaine.LastIndexOf(vbCr))
ElseIf strChaine.ToLower.LastIndexOf(".") <> -1 Then
'sinon on s'arrête avant le . final
strChaine = strChaine.Substring(0, strChaine.LastIndexOf("."))
Else 'sinon il y a une erreur
strChaine = "- Erreur -"
End If
Else
strChaine = "- pas de format html -"
End If
'on convertit si c'est de l'iso, du windows ou des caras speciaux
strChaine = oAscii.DecodeToAscii(strChaine)
'on enregistre dans un fichier
oES = New Utilitaire.ES(omail.Identifiant & "\CorpHtml.htm", ES.Dossier.Body)
With oES
.Enregistrer(strChaine)
End With
omail.AdresseCorpsHtml = oES.CheminFichier
oES = Nothing
oAscii = Nothing
End Sub
#End Region
#Region "recupere corps txt"
Private Sub recupereCorpsTxt(ByVal strChaine As String, ByVal oMail As Mail)
Dim intIndex As Integer = 0
oAscii = New Conversion.AsciiIso
On Error Resume Next
'on recupere la partie du mail qui est au format text
intIndex = strChaine.ToLower.IndexOf("content-type: text/plain")
If intIndex <> -1 Then
'ici on a trouvé la balise
strChaine = strChaine.Substring(intIndex + 24)
'la partie text commence juste apres les 2 prochain saut à la ligne
strChaine = strChaine.Substring(strChaine.IndexOf(vbCrLf & vbCrLf))
'maintenant il faut trouver la fin de la partie text
If strChaine.ToLower.IndexOf("boundary") <> -1 Then
'si on trouve une autre artie apres, on 'arrete juste avant
intIndex = strChaine.ToLower.IndexOf("boundary")
strChaine = strChaine.Substring(0, intIndex)
strChaine = strChaine.Substring(0, strChaine.LastIndexOf(vbCrLf & vbCrLf))
ElseIf strChaine.ToLower.IndexOf("content-type: text/html") <> -1 Then
'on regarde si on trouve une partie HTML apres
intIndex = strChaine.ToLower.IndexOf("content-type: text/html")
strChaine = strChaine.Substring(0, intIndex)
strChaine = strChaine.Substring(0, strChaine.LastIndexOf(vbCrLf & vbCrLf))
ElseIf strChaine.LastIndexOf(".") <> -1 Then
's'il n'y a pas d'autre partie, on s'arrete juste avant le point final
strChaine = strChaine.Substring(0, strChaine.LastIndexOf("."))
Else 'il y a une erreur
strChaine = "- Erreur - "
End If
Else
'si on n'a pas trouvé la partie text on a 2 solutions : soit il n'y a pas de partie text,
'soit il n'y a qu'une partie text et elle n'est pas decrite.
If strChaine.ToLower.IndexOf("content-type: text/html") <> -1 Then
strChaine = "- Pas de partie text - "
Else
strChaine = strChaine.Substring(Convert.ToInt32(oMail.NombreCaraEntete))
If strChaine.ToLower.IndexOf("boundary") <> -1 Then
'si on trouve une autre partie apres, on s'arrete juste avant (une piece jointe part exemple)
intIndex = strChaine.ToLower.IndexOf("boundary")
strChaine = strChaine.Substring(0, intIndex)
strChaine = strChaine.Substring(0, strChaine.LastIndexOf(vbCrLf & vbCrLf))
ElseIf strChaine.LastIndexOf(".") <> -1 Then
's'il n'y a pas d'autre partie, on s'arrete juste avant le point final
strChaine = strChaine.Substring(0, strChaine.LastIndexOf("."))
Else 'il y a une erreur
strChaine = "- Erreur - "
End If
End If
End If
'on convertit si c'est de l'iso, du windows ou des caras speciaux
'on rajoute des balise pour les entrées car le text va être lu par un navigateur
strChaine = oAscii.DecodeToAscii(strChaine, True)
'on ajoutes des liens là ou il y a écrit http://
strChaine = oAscii.AjoutLiens(strChaine)
'on enregistre dans un fichier
oES = New Utilitaire.ES(oMail.Identifiant & "\Corptext.txt", ES.Dossier.Body)
With oES
.Enregistrer(strChaine)
End With
oMail.AdresseCorpsText = oES.CheminFichier
oES = Nothing
oAscii = Nothing
End Sub
#End Region
#Region "Recupere Les pieces jointes"
Private Sub RecuperePJ(ByRef strText As String, ByVal omail As Mail)
Dim strTmp As String = strText
Dim strTmp2 As String = ""
Dim intIndex As Integer = 0
Dim o64 As New Conversion.Base64
Dim oPJS As New PJs
Dim oPJ As PJ
' on recherche des parties qui contiennent les piéces jointes
' c'est à dire les parties boudary ou le content-Type et différent
' de Content-Type: Multipart/Alternative, ...
intIndex = strText.ToLower.IndexOf("content-type:")
While intIndex <> -1
strTmp = strText.Substring(intIndex)
'si c'est une PJ
If RecherchePj(strTmp.Substring(0, strTmp.IndexOf(vbCr))) Then
'on isole la partie
strTmp = strTmp.Substring(0, strTmp.ToLower.IndexOf("boundary"))
strTmp = strTmp.Substring(0, strTmp.LastIndexOf(vbCrLf))
'on recupere les informations
oPJ = New PJ
With oPJ
'on recupere le format
intIndex = strTmp.ToLower.IndexOf("content-type")
If intIndex <> -1 Then
strTmp2 = strTmp.Substring(intIndex + 12)
strTmp2 = strTmp2.Substring(0, strTmp2.IndexOf(vbCrLf))
.Format = recupereInfo(strTmp2)
Else
.Format = "- Inconnu -"
End If
intIndex = strTmp.ToLower.IndexOf("name")
If intIndex <> -1 Then
strTmp2 = strTmp.Substring(intIndex + 12)
strTmp2 = strTmp2.Substring(0, strTmp2.IndexOf(vbCrLf))
.NomFichier = recupereInfo(strTmp2)
Else
.NomFichier = "- Inconnu -"
End If
intIndex = strTmp.ToLower.IndexOf("content-id")
If intIndex <> -1 Then
strTmp2 = strTmp.Substring(intIndex + 12)
strTmp2 = strTmp2.Substring(0, strTmp2.IndexOf(vbCrLf))
.Identifiant = recupereInfo(strTmp2)
Else
.Identifiant = "- Inconnu -"
End If
'strTmp = strTmp.Substring(strTmp.IndexOf(vbCrLf & vbCrLf))
'strTmp = strTmp.Substring(0, strTmp.IndexOf("=") + 1)
'strTmp = strTmp.Replace(" ", "").Replace(vbCrLf, "")
'strTmp = o64.base64ToByte(strTmp)
'oES = New ES(.NomFichier, ES.Dossier.Body)
'oES.Enregistrer(strTmp)
End With
Else
End If
strText = strText.Substring(intIndex + 13)
intIndex = strText.ToLower.IndexOf("content-type:")
End While
End Sub
#End Region
#Region "RecherchePj"
Private Function RecherchePj(ByVal T As String) As Boolean
T = T.Substring(0, T.IndexOf(";"))
T = T.Trim(" "c)
If T.ToLower <> "content-type: multipart/alternative" AndAlso T.ToLower <> "content-type: text/plain" AndAlso T.ToLower <> "content-type: text/html" _
AndAlso T.ToLower <> "content-type: multipart/mixed" AndAlso T.ToLower <> "content-type: multipart/related" Then
Return True
Else
Return False
End If
End Function
#End Region
#Region "REcupereInfo"
Private Function recupereInfo(ByVal T As String) As String
T = T.Replace(":", "").Replace(";", "").Replace("""", "").Replace("=", "").Replace("<", "").Replace(">", "").Trim(" "c)
Return T
End Function
#End Region
End Class
End Namespace |
