Traitement d’un message entrant et découpage en fichiers

 

Ne pas oublier de supprimer les XXX (sur la 1ère et dernière ligne)

 

< XXXSCRIPT RunAt=Server Language=VBScript>

 

'Option Explicit

 

'---------------------------------------------------------------------------

---

' Global Variables

'---------------------------------------------------------------------------

---

dim amSession

dim fldrTarget

Dim messTarget

'---------------------------------------------------------------------------

---

' Event Handlers

'---------------------------------------------------------------------------

---

 

' DESCRIPTION: This event is fired when a new message is added to the folder

Public Sub Folder_OnMessageCreated

            set AMSession = EventDetails.Session

            idTargetFolder = EventDetails.FolderID

            idMessage = EventDetails.messageID

            Set fldrTarget = AMSession.GetFolder( idTargetFolder, Null )

            Set messTarget = AMSession.GetMessage( idMessage, Null )

            call save_item()

End Sub

 

' DESCRIPTION: This event is fired when a message in the folder is changed

Public Sub Message_OnChange

            set AMSession = EventDetails.Session

            idTargetFolder = EventDetails.FolderID

            idMessage = EventDetails.messageID

            Set fldrTarget = AMSession.GetFolder( idTargetFolder, Null )

            Set messTarget = AMSession.GetMessage( idMessage, Null )

            call save_item()

End Sub

 

' DESCRIPTION: This event is fired when a message is deleted from the folder

Public Sub Folder_OnMessageDeleted

            set AMSession = EventDetails.Session

            idTargetFolder = EventDetails.FolderID

            idMessage = EventDetails.messageID

            Set fldrTarget = AMSession.GetFolder( idTargetFolder, Null )

            Set messTarget = AMSession.GetMessage( idMessage, Null )

            call save_item()

End Sub

 

' DESCRIPTION: This event is fired when the timer on the folder expires

Public Sub Folder_OnTimer

End Sub

 

Public Function save_item()

       

        On Error Resume Next

        strFold = "C:\TEMP\ENTREE"

        Set oSys = CreateObject("Scripting.FilesystemObject")

        Set sysfolder = oSys.GetFolder(strFold)

       

'        saveFoldStr = messTarget.Subject

'       

'        If Not (oSys.FolderExists(strFold + "\" + saveFoldStr)) Then

'            Set dfold = sysfolder.subfolders.Add(saveFoldStr)

'        Else

'            Set dfold = oSys.GetFolder(strFold + "\" + saveFoldStr)

'        End If

 

            set dfold=oSys.GetFolder(strFold)

 

        StrRnd = gen_temp

 

        'sauvegarde du texte du message

        StrDestFile = dfold.Path + "\" + StrRnd + ".data"

        Set a = oSys.CreateTextFile(StrDestFile, True)

        a.Write (messTarget.Text)

        a.Close

 

        'sauvegarde de l'expediteur

        StrDestFile = dfold.Path + "\" + StrRnd + ".from"

        Set a = oSys.CreateTextFile(StrDestFile, True)

        a.WriteLine (messTarget.Sender)

        a.Close

 

        'sauvegarde du sujet

        StrDestFile = dfold.Path + "\" + StrRnd + ".subj"

        Set a = oSys.CreateTextFile(StrDestFile, True)

        a.WriteLine (messTarget.subject)

        a.Close

 

        'sauvegarde du destinataire

        StrDestFile = dfold.Path + "\" + StrRnd + ".dest"

        Set a = oSys.CreateTextFile(StrDestFile, True)

        a.Write (messTarget.recipients(1).name)

        a.Close

 

'    If Not (oSys.FolderExists(strFold + "\" + saveFoldStr + "\" + StrRnd+

"_" + saveFoldStr)) Then

'            Set attfold = dfold.subfolders.Add(StrRnd+ "_" + saveFoldStr)

'        Else

'            Set attfold = oSys.GetFolder(strFold + "\" + saveFoldStr + "\"

+ StrRnd+ "_" + saveFoldStr)

'        End If

        'sauvegarde des fichiers attachés       

            cpt=0

        For Each fAtt In messTarget.attachments

            If fAtt.Type = 1 Then

                fAtt.WriteToFile (strFold + "\" + StrRnd + ".att" +CStr(cpt)

)

            cpt=cpt+1

            End If

        Next

        'Suppression du message complet

            messtarget.delete       

 

 

End Function

Public Function gen_temp()

 

            n = Now()

            y = DatePart("yyyy", n)

            m = DatePart("m", n)

            d = DatePart("d", n)

            h = DatePart("h", n)

            mn = DatePart("n", n)

            s = DatePart("s", n)

                randomize

            r = Int((100 * Rnd))

            If m < 10 Then

                    SMonth = "0" + CStr(m)

            Else

                    SMonth = CStr(m)

            End If

 

            If d < 10 Then

                    SDay = "0" + CStr(d)

            Else

                    SDay = CStr(d)

            End If

 

            If h < 10 Then

                    SHour = "0" + CStr(h)

            Else

                    SHour = CStr(h)

            End If

 

            If mn < 10 Then

                    SMin = "0" + CStr(mn)

            Else

                    SMin = CStr(mn)

            End If

 

            If s < 10 Then

                    Ssec = "0" + CStr(s)

            Else

                    Ssec = CStr(s)

            End If

 

            If r < 10 Then

                    Srand = "0" + CStr(r)

            Else

                    Srand = CStr(r)

            End If

            gen_temp = "msg"+ CStr(y) + SMonth + SDay + SHour + SMin + Ssec +

Srand

 

End Function

 

 

</XXXSCRIPT>