PureBasic

Code : Tout sélectionner

Global res.s, cr.s, ConnID.l
Global Fichier.s

cr.s=Chr(13)+Chr(10)

Procedure send(msg.s)
  SendNetworkData(ConnID,@msg,Len(msg))
  Debug "Send: "+msg
EndProcedure

Procedure.s wait()
  res=""
  For tmp=1 To 4999
    res+" "
  Next
  ReceiveNetworkData(ConnID,@res,4999)
  Debug "received: "+res
  res=Left(res,3)
  ProcedureReturn res
EndProcedure

Procedure SendMail(Port.b, mailserver.s,mailto.s,mailfrom.s,subject.s,MsgBody.s)
  If InitNetwork()
    ConnID = OpenNetworkConnection(mailserver,Port)
    If ConnID
      wait()
      error=0
      If res="220"
        send("HELO "+mailfrom+cr)
        wait()
        If res="250"
          Delay(100)
          send("MAIL FROM: <"+mailfrom+">"+cr)
          wait()
          If res="250"
            send("RCPT TO: <"+mailto+">"+cr)
            wait()
            If res="250"
              send("DATA"+cr)
              wait()
              If res="354"
                Delay(100)
                ;- Partie 1 : En tête
                send("From: <"+mailfrom+">"+cr)
                send("To: <"+mailto+">"+cr)
                send("Subject: "+subject+cr)
                send("Date: "+D$+cr)
                send("MIME-Version: 1.0"+cr)
                send("Content-Type: multipart/mixed;"+cr)
                send("	boundary="+Chr(34)+"-=_NextPart"+cr+cr)
                
                ;- Partie 2 : Heuuu!!! Je sais pas
                send("X-Priority: 3"+cr)
                send("X-MSMail-Priority: Normal"+cr)
                send("X-Mailer: PBMailer"+cr)
                send("X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1409"+cr+cr)
                send("This is a multi-part message in MIME format."+cr+cr)
                
                ;- Partie 3 : Texte du message
                send("---=_NextPart"+cr)
                send("Content-Type: text/plain;"+cr)
                send("charset="+Chr(34)+"iso-8859-1"+Chr(34)+cr)
                send("Content-Transfer-Encoding: 7bit"+cr+cr)
                send(MsgBody +cr+cr); Message
                
                ;- Partie 4 : Piece jointe
                ;/ La partie qui est commentée, fait référence à la LinkedList() qui
                ;/ contient le chemin des fichiers à mettre en pièce jointe
                
                ;ResetList(Fichiers())
                ;While NextElement(Fichiers())
                ;If Fichiers()\Selected = 1
                ;Fichier$ = Fichiers()\Fichier
                
                send("---=_NextPart"+cr)
                send("Content-Type: application/octet-stream;"+cr)
                send("name="+Chr(34)+GetFilePart(Fichier$)+Chr(34)+cr)
                send("Content-Transfer-Encoding: 7bit"+cr)
                send("Content-Disposition: attachment; filename="+Chr(34)+GetFilePart(Fichier)+Chr(34)+cr);"+Cr)
                Delay(200)
                
                If ReadFile(0, Fichier)
                  Buffer.l = Lof()
                  *Mem0= AllocateMemory(Buffer)
                  If *Mem0
                    ReadData(*Mem0, Buffer)
                    send(PeekS(*Mem0, Buffer) + cr)
                  EndIf
                EndIf
                send(cr)
                send("---=_NextPart"+cr)
                send("--"+cr+"--"+cr+cr)
                Delay(150)
                
                ;EndIf
                ;Wend
                
                send(""+cr)
                send("."+cr)
                wait()
                If res="250"
                  Delay(100)
                  send("Quit"+cr)
                  wait()
                  ProcedureReturn 1
                EndIf
              EndIf
            EndIf
          EndIf
        EndIf
      EndIf
      CloseNetworkConnection(ConnID)
    EndIf
  EndIf
EndProcedure

Procedure.l popbeforesmtp(Port.b,Pop3_Server.s,mailuser.s,mailpass.s)
  If InitNetwork()
    ConnID = OpenNetworkConnection(Pop3_Server,Port)
    If ConnID
      wait()
      error=0
      If res="+OK"
        send("user "+mailuser+cr)
        wait()
        If res="+OK"
          Delay(100)
          send("pass "+mailpass+cr)
          wait()
          If res="+OK"
            Delay(100)
            send("QUIT"+cr)
            wait()
            ProcedureReturn 1
          EndIf
        EndIf
      EndIf
      CloseNetworkConnection(ConnID)
    EndIf
  EndIf
EndProcedure

;- Essai du code

;/ Destinataire
Dest.s="E-mail du destinataire"

;/ Expéditeur
Smtp.s="Smtp de l'expéditeur"
PortSmtp.b = 25
Pop3.s="Pop ou Pop3 de l'expéditeur"
PortPop.b = 110
Expe.s="E-Mail de l'expéditeur"
Pass.s="Mot de passe de l'expéditeur"

;/ Message
Sujet.s="Sujet du message"
Msge.s = "Mettre le message ici"
Fichier.s = "Chemin du fichier à joindre"

;/ Identification
Ident = 1 
; On met ident = 1, quand on est obligé de s'identifier sur POP3 pour poster
; C'est le cas chez certains fournisseurs d'accès comme OVH, par exemple

;/

If Ident = 1
  If popbeforesmtp(PortPop,Pop3,Expe,Pass)
    SendMail(PortSmtp, Smtp.s,Dest.s,Expe.s,Sujet.s,Msge.s)
  Else
    MessageRequester("","Erreur",#MB_ICONERROR)
  EndIf
Else
  SendMail(PortSmtp, Smtp.s,Dest.s,Expe.s,Sujet.s,Msge.s)
EndIf
;