Envoi d'un simple mail

Progi1984 · Message par **Progi1984** » mar. 29/nov./2005 15:45

Voilà, suis en train de prog une appli ! Ouah

Bon, je voudrais que les users puissent m'envoyer un mail directement de l'appli.

Donc je cherche une procédure toute simple, pour envoyer un mail, qui accepterait le smtp de gmail ou free si possible !

PS : j'ai cherché et pas trouvé de code fonctionnel
Je cherche pas de userlibs

Chris · Message par **Chris** » mar. 29/nov./2005 15:49

J'avais fait un code la-dessus, mais je ne sais plus si c'était sur ce forum, ou sur celui de Cederavic qui sert de musée maintenant.

Progi1984 · Message par **Progi1984** » mar. 29/nov./2005 16:34

Je viens de regarder dans le musée : quedchi !

Chris · Message par **Chris** » mar. 29/nov./2005 16:45

J'ai regardé sur mes disques de sauvegarde, mais je ne le retrouve pas non plus

Chris · Message par **Chris** » mar. 29/nov./2005 16:50

J'ai retrouvé ça. Essaye de voir si tu peux en tirer queque chose.

Code : Tout sélectionner

;
;- Constantes Fenêtres
Enumeration
  #Win_Main
  #Win_Config
EndEnumeration

;- Constantes Menu
Enumeration
  #MenuBar_0
EndEnumeration
Enumeration
  #M_Header
  #M_Edit
  #M_Quit
  #M_Divers
  #M_Send
  #M_Help
  #M_CodeFr
  #M_Pure
  #M_Forum
  #M_About
EndEnumeration

;- Constantes Gadgets
Enumeration
  #Explo_Fichiers
  #Liste_Fichiers
  #Editeur
  #Btn_Send
  #C_Str_Chemin
  #C_Btn_Path
  #C_Text_2
  #C_Btn_Valid
  #C_Btn_Annul
  #C_Text_5
  #C_Str_Adresse
  #Frame3D_0
  #C_Str_Port_Smtp
  #C_Text_6
  #C_Str_Smtp
  #C_Text_7
  #Frame3D_1
  #C_Str_AdresseExp
  #Text_8
  #C_Str_Pass
  #C_Text_9
  #C_Chk_Pass
  #C_Str_Pop
  #Text_10
  #C_Str_Port_Pop
  #Text_11
  #SplitterV
  #SplitterH
EndEnumeration

#GetPath_PureBasic=-7


  ;- Structures et Listes Liées
Structure FICHIERS
  Fichier.s
  Selected.b
EndStructure
NewList Fichiers.FICHIERS()

  ;{- Déclarations des procédures
Declare Open_Win_Main()
Declare Open_Win_Config()
Declare PopBeforeSmtp(PortPop3.s, Pop3_Server.s,MailUser.s,MailPass.s)
Declare Send(msg.s)
Declare.s Wait()
Declare SendMail(PortMail.s, MailServer.s,MailTo.s,MailFrom.s,Subject.s,MsgBody.s)
Declare CallBack(Hnd,Mess,wParam,lParam)
Declare Resize()
Declare ReloadCfg()
Declare SaveCfg()
Declare.s GetPath(type)
;}

  ;{- Variables Globales
Global ConnID.l,Destinataire$,Error,Expediteur$,Fichier,Fichier$,File$
Global WinRect.RECT,Buffer.l,Check.b,Chemin$,CR.s,D$,Index,J$,Jour,left
Global Index,J$,Jour,left
Global Password$,PbPath$,PortP,PortPop$,PortS,PortSmtp$,Quit,Res.s
Global RH,right,RV,Selected,ServeurPop$,ServeurSmtp$,Tmp,top,WH,WinRect,WW;}

  ;{- Variables Locales
CR.s=Chr(13)+Chr(10)
PbPath$ = GetPath(#GetPath_PureBasic)
Subject.s="PBCodes : Exemple(s) de code(s)";}

  ;- Procédures
Procedure Open_Win_Main()
  If OpenWindow(#Win_Main, 216, 0, 475, 370,  #PB_Window_SystemMenu | #PB_Window_SizeGadget |#PB_Window_MinimizeGadget |#PB_Window_MaximizeGadget , "PB-Codes FR : Tous les codes français de PureBasic")
    
    If CreateMenu(#MenuBar_0, WindowID())
      MenuTitle("Fichiers")
      MenuItem(#M_Header, "En-Tête")
      MenuBar()
      MenuItem(#M_Quit, "Quitter")
      MenuTitle("Options")
      OpenSubMenu("Configuration")
      MenuItem(#M_Divers, "Divers")
      CloseSubMenu()
      MenuBar()
      MenuItem(#M_Send, "Envoyer tout")
      MenuTitle("Aide")
      MenuItem(#M_Help, "Aide")
      OpenSubMenu("Sites Web")
      MenuItem(#M_CodeFr, "Codes FR")
      MenuItem(#M_Pure, "PureBasic")
      MenuItem(#M_Forum, "Forum PureBasic")
      CloseSubMenu()
      MenuBar()
      MenuItem(#M_About, "A Propos")
    EndIf
    
    If CreateGadgetList(WindowID())
      ExplorerTreeGadget(#Explo_Fichiers, 0, 0, 0, 0, "", #PB_Explorer_AlwaysShowSelection)
      ListViewGadget(#Liste_Fichiers, 0, 0, 0, 0,#LBS_MULTIPLESEL)
      EditorGadget(#Editeur, 0, 0, 0, 0)
      ButtonGadget(#Btn_Send, WW-100, WH-25, 90, 20, "Envoyer")
      SplitterGadget(#SplitterV,0,0,WW,WH-30,#Explo_Fichiers,#Liste_Fichiers,#PB_Splitter_Vertical)
      SplitterGadget(#SplitterH,0,0,WW,WH-30,#SplitterV,#Editeur)
    EndIf
    
  EndIf
EndProcedure

Procedure Open_Win_Config()
  If OpenWindow(#Win_Config, 309, 203, 318, 345,  #PB_Window_SystemMenu | #PB_Window_TitleBar , "PB-Codes FR : Configuration")
    If CreateGadgetList(WindowID())
      StringGadget(#C_Str_Chemin, 10, 250, 280, 20, "")
      ButtonGadget(#C_Btn_Path, 290, 250, 20, 20, "...")
      TextGadget(#C_Text_2, 10, 235, 95, 15, "Chemin des codes")
      ButtonGadget(#C_Btn_Valid, 70, 320, 90, 20, "Valider")
      ButtonGadget(#C_Btn_Annul, 165, 320, 90, 20, "Annuler")
      TextGadget(#C_Text_5, 10, 30, 160, 15, "Adresse e-mail destinataire")
      StringGadget(#C_Str_Adresse, 10, 45, 300, 20, "")
      Frame3DGadget(#Frame3D_0, 5, 5, 310, 65, "Destinataire")
      StringGadget(#C_Str_Port_Smtp, 275, 115, 35, 20, "",#ES_CENTER)
      TextGadget(#C_Text_6, 275, 100, 35, 15, "Port")
      StringGadget(#C_Str_Smtp, 10, 115, 260, 20, "")
      TextGadget(#C_Text_7, 10, 100, 160, 15, "Serveur SMTP")
      Frame3DGadget(#Frame3D_1, 5, 75, 310, 235, "Expéditeur")
      StringGadget(#C_Str_AdresseExp, 10, 205, 200, 20, "")
      TextGadget(#Text_8, 10, 190, 150, 15, "Adresse e-mail expéditeur")
      StringGadget(#C_Str_Pass, 215, 205, 95, 20, "",#PB_String_Password|#ES_CENTER)
      TextGadget(#C_Text_9, 215, 190, 95, 15, "Mot de Passe")
      CheckBoxGadget(#C_Chk_Pass, 10, 285, 300, 20, "Mot de passe requis pour la connexion")
      StringGadget(#C_Str_Pop, 10, 160, 260, 20, "")
      TextGadget(#Text_10, 10, 145, 145, 15, "Serveur POP / POP3")
      StringGadget(#C_Str_Port_Pop, 275, 160, 35, 20, "",#ES_CENTER)
      TextGadget(#Text_11, 280, 145, 35, 15, "Port")
    EndIf
  EndIf
  If Check = 1
    DisableGadget(#C_Str_Pass,0)
    DisableGadget(#C_Str_Port_Pop,0)
    DisableGadget(#C_Str_Pop,0)
  ElseIf Check = 0
    DisableGadget(#C_Str_Pass,1)
    DisableGadget(#C_Str_Port_Pop,1)
    DisableGadget(#C_Str_Pop,1)
  EndIf
EndProcedure

Procedure PopBeforeSmtp(PortPop3.s, Pop3_Server.s,MailUser.s,MailPass.s)
  PortP = Val(PortPop3)
  If InitNetwork()
    ConnID = OpenNetworkConnection(Pop3_Server,PortP)
    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

Procedure Send(msg.s)
  SendNetworkData(ConnID,@Msg,Len(Msg))
EndProcedure

Procedure.s Wait()
  Res=""
  For Tmp=1 To 4999
    Res+" "
  Next
  ReceiveNetworkData(ConnID,@Res,4999)
  Res=Left(Res,3) : Debug Res
  ProcedureReturn Res
EndProcedure

Procedure SendMail(PortMail.s, MailServer.s,MailTo.s,MailFrom.s,Subject.s,MsgBody.s)
  PortS = Val(PortMail)
  If InitNetwork()
    ConnID = OpenNetworkConnection(MailServer,PortS)
    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
                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 CallBack(Hnd,Mess,wParam,lParam)
  GetClientRect_(WindowID(#Win_Main),WinRect)
  WH = WinRect\bottom-WinRect\top
  WW = WinRect\right-WinRect\left
  
  Select Mess
    Case #WM_SIZE
      Resize()
    Case #WM_PAINT
      Resize()
  EndSelect
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure Resize()
  ResizeGadget(#SplitterV,-1,-1,WW,WH-30)
  ResizeGadget(#SplitterH,-1,-1,WW,WH-30)
  SetGadgetState(#SplitterH,WH/2)
  ResizeGadget(#Btn_Send, WW-100, WH-25, 90, 20)
EndProcedure

Procedure ReloadCfg()
  Global Destinataire$,PortPop$,ServeurPop$,PortSmtp$,ServeurSmtp$
  Global Password$,Check,Chemin$,Expediteur$
  
  OpenPreferences("PbCodes.cfg")
  PreferenceGroup("Mail")
  Destinataire$ = ReadPreferenceString("Destinataire","")
  PortSmtp$ = ReadPreferenceString("Port_SMTP","25")
  ServeurSmtp$ = ReadPreferenceString("Serveur_SMTP","")
  PortPop$ = ReadPreferenceString("Port_POP","110")
  ServeurPop$ = ReadPreferenceString("Serveur_POP","")
  Expediteur$ = ReadPreferenceString("Expediteur","")
  Password$ = ReadPreferenceString("Password","")
  Check = ReadPreferenceLong("Check",0)
  PreferenceGroup("Fichiers")
  Chemin$ = ReadPreferenceString("Chemin","C:\")
  ClosePreferences()
  SetGadgetText(#Explo_Fichiers,Chemin$)
EndProcedure

Procedure SaveCfg()
  If GetGadgetText(#C_Str_Adresse)<>"" And GetGadgetText(#C_Str_Port_Smtp) <>"" And GetGadgetText(#C_Str_Smtp) <> ""
    CreatePreferences("PbCodes.cfg")
    PreferenceGroup("Mail")
    WritePreferenceString("Destinataire",GetGadgetText(#C_Str_Adresse))
    WritePreferenceString("Port_SMTP",GetGadgetText(#C_Str_Port_Smtp))
    WritePreferenceString("Serveur_SMTP",GetGadgetText(#C_Str_Smtp))
    WritePreferenceString("Port_POP",GetGadgetText(#C_Str_Port_Pop))
    WritePreferenceString("Serveur_POP",GetGadgetText(#C_Str_Pop))
    WritePreferenceString("Expediteur",GetGadgetText(#C_Str_AdresseExp))
    WritePreferenceString("Password",GetGadgetText(#C_Str_Pass))
    WritePreferenceLong("Check",GetGadgetState(#C_Chk_Pass))
    PreferenceGroup("Fichiers")
    WritePreferenceString("Chemin",GetGadgetText(#C_Str_Chemin))
    ClosePreferences()
    CloseWindow(#Win_Config)
  EndIf
EndProcedure

Procedure.s GetPath(type)
  location$ = Space (#MAX_PATH+1)
  If type=#GetPath_PureBasic
    BufferSize=#MAX_PATH
    If GetVersion_() & $FF0000
      If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "Applications\PureBasic.exe\shell\open\command", 0, #KEY_ALL_ACCESS , @Key) = #ERROR_SUCCESS
        If RegQueryValueEx_(Key, "", 0, @type, @location$, @BufferSize) = #ERROR_SUCCESS
          location$ = GetPathPart(Mid(location$, 2, Len(location$)-7))
        EndIf
      EndIf
    Else
      If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Classes\PureBasic.exe\shell\open\command", 0, #KEY_ALL_ACCESS , @Key) = #ERROR_SUCCESS
        If RegQueryValueEx_(Key, "", 0, @type, @location$, @BufferSize) = #ERROR_SUCCESS
          location$ = GetPathPart(Mid(location$, 2, Len(location$)-7))
        EndIf
      EndIf
    EndIf
  EndIf
  If location$ And Right(location$,1)<>"\" : location$+"\" : EndIf
  ProcedureReturn location$
EndProcedure


  ;{- Calcul de la date
Jour = DayOfWeek(Date())
If Jour = 0 : J$ = "Dim"
ElseIf Jour = 1 : J$ = "Lun"
ElseIf Jour = 2 : J$ = "Mar"
ElseIf Jour = 3 : J$ = "Mer"
ElseIf Jour = 4 : J$ = "Jeu"
ElseIf Jour = 5 : J$ = "Ven"
ElseIf Jour = 6 : J$ = "Sam"
EndIf
D$ = J$+", "+FormatDate("%dd/%mm/%yyyy", Date());}

Open_Win_Main();{
ReloadCfg()

SetWindowCallback(@CallBack());}

Repeat;{
  
  Select WaitWindowEvent()
    ;- Evenements des menus
    Case #PB_EventMenu
      Select EventMenuID()
        
        Case #M_Quit        ;/ Quitte le programme
          Quit = 1
          
        Case #M_Help        ;/ Affiche l'aide
          
        Case #M_CodeFr      ;/ Site de Code-FR
          RunProgram("http://heisspiter.no-ip.com/~purebasic/")
          
        Case #M_Pure        ;/ Site de PureBasic
          RunProgram("http://www.purebasic.com/french/index.php3")
          
        Case #M_Forum       ;/ Forum de PureBasic
          RunProgram("http://purebasic.hmt-forum.com/index.php")
          
        Case #M_About       ;/ Affiche la boîte "A Propos"
          
        Case #M_Divers      ;/ Affiche la boîte de configuration
          Open_Win_Config()
          ActivateGadget(#C_Str_Smtp)
          
          OpenPreferences("PbCodes.cfg")
          PreferenceGroup("Mail")
          Destinataire$ = ReadPreferenceString("Destinataire",""): SetGadgetText(#C_Str_Adresse,Destinataire$)
          PortSmtp$ = ReadPreferenceString("Port_SMTP","25") : SetGadgetText(#C_Str_Port_Smtp,PortSmtp$)
          ServeurSmtp$ = ReadPreferenceString("Serveur_SMTP","") : SetGadgetText(#C_Str_Smtp, ServeurSmtp$)
          PortPop$ = ReadPreferenceString("Port_POP","110") : SetGadgetText(#C_Str_Port_Pop,PortPop$)
          ServeurPop$ = ReadPreferenceString("Serveur_POP","") : SetGadgetText(#C_Str_Pop, ServeurPop$)
          Expediteur$ = ReadPreferenceString("Expediteur","") : SetGadgetText(#C_Str_AdresseExp, Expediteur$)
          Password$ = ReadPreferenceString("Password",""):SetGadgetText(#C_Str_Pass,Password$)
          Check = ReadPreferenceLong("Check",0):SetGadgetState(#C_Chk_Pass,Check)
          PreferenceGroup("Fichiers")
          Chemin$ = ReadPreferenceString("Chemin","C:\") : SetGadgetText(#C_Str_Chemin,Chemin$)
          ClosePreferences()
          
          
        Case #M_Header      ;/
          
          
        Case #M_Send        ;/
          
          
      EndSelect
    Case #PB_EventGadget
      Select EventGadgetID()
        
        ;- Evenements Gadgets fenêtre principale
        Case #Explo_Fichiers :
          If GetGadgetState(#Explo_Fichiers) = #PB_Explorer_File
            If EventType() = #PB_EventType_Change
              File$ = GetGadgetText(#Explo_Fichiers)
              AddElement(Fichiers()): Index = ListIndex(Fichiers())
              Fichiers()\Fichier = File$
              Fichiers()\Selected = 0
              AddGadgetItem(#Liste_Fichiers,-1,GetFilePart(File$))
            EndIf
          EndIf
          
        Case #Liste_Fichiers
          ResetList(Fichiers())
          SelectElement(Fichiers(),GetGadgetState(#Liste_Fichiers))
          Fichiers()\Selected = GetGadgetItemState(#Liste_Fichiers,GetGadgetState(#Liste_Fichiers))
          
        Case #Btn_Send
          If Check = 0
            Debug "Check = "+Str(Check)
            SendMail(PortSmtp$,ServeurSmtp$,Destinataire$,Expediteur$,Subject,GetGadgetText(#Editeur))
          ElseIf Check = 1
            Debug "Check = "+Str(Check)
            If PopBeforeSmtp(PortPop$,ServeurPop$,Expediteur$,Password$)
              Delay(100)
              SendMail(PortSmtp$,ServeurSmtp$,Destinataire$,Expediteur$,Subject,GetGadgetText(#Editeur))
            Else
              MessageRequester("Erreur","Erreur d'identification",#MB_ICONERROR)
            EndIf
          EndIf
          
          ;- Evenements Gadgets fenêtre Config Generale
        Case #C_Btn_Annul
          CloseWindow(#Win_Config)
          
        Case #C_Btn_Valid
          SaveCfg()
          ReloadCfg()
          
        Case #C_Btn_Path
          Chemin$ = PathRequester("Dossier par défaut", PbPath$)
          SetGadgetText(#C_Str_Chemin,Chemin$)
          
        Case #C_Chk_Pass
          If GetGadgetState(#C_Chk_Pass) = 1
            DisableGadget(#C_Str_Pass,0)
            DisableGadget(#C_Str_Port_Pop,0)
            DisableGadget(#C_Str_Pop,0)
          Else
            DisableGadget(#C_Str_Pass,1)
            DisableGadget(#C_Str_Port_Pop,1)
            DisableGadget(#C_Str_Pop,1)
          EndIf
          
      EndSelect
    Case #PB_EventCloseWindow
      If EventWindowID() <> #Win_Main
        CloseWindow(EventWindowID())
        UseWindow(#Win_Main)
      Else
        Quit = 1
      EndIf
      
  EndSelect
Until Quit = 1;}
End

Progi1984 · Message par **Progi1984** » mar. 29/nov./2005 17:04

Je ne sais pas si je suis neuneu, mais impossible de faire fonctionner ton sendmail avec gmail ou free :'(

Chris · Message par **Chris** » mar. 29/nov./2005 17:12

Je sais qu'il fonctionnait sur le webmail sécurisé d'OVH et en mail normal, mais il me semble que j'avais des problèmes aussi avec le mail de LaPoste.

Oliv · Message par **Oliv** » mar. 29/nov./2005 18:11

Regarde sur PureArea il y a des exemples

Progi1984 · Message par **Progi1984** » mar. 29/nov./2005 18:33

Merci Oliv, je l'oublie toujours !

Code : Tout sélectionner

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=765&highlight=
; Author: stbi
; Date: 30. April 2003

Global res.s, cr.s, ConnID.l 
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.l sendmail(mailserver.s,mailto.s,mailfrom.s,subject.s,msgbody.s) 
  If InitNetwork() 
    ConnID = OpenNetworkConnection(mailserver,25) 
    If ConnID 
      wait() 
      error=0 
      If res="220" 
        send("HELO CGIapp"+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) 
                send("Date: "+cr) 
                send("From: <"+mailfrom+">"+cr) 
                send("To: <"+mailto+">"+cr) 
                send("Subject: "+subject+cr) 
                send("X-Mailer: PBMailer"+cr) 
                Delay(100) 
                send("--"+cr+"--"+cr+cr) 
                send(msgbody) 
                Delay(100) 
                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 

;============================== 
;-Enter Appropriate Information 

mailserver.s="smtp.laposte.net" 
mailfrom.s="votre url@laposte.net"  
mailto.s="votre@laposte.net"
subject.s="progi1984@free.fr123" 

If sendmail(mailserver,mailto,mailfrom,subject+"expediteur","This is a test message!"+cr+"What do you think?"+cr+"I prefer live in France rather tthan in russia") 
  MessageRequester("Done","Mail Sent Successfully!",0) 
  Else 
  MessageRequester("Error","Error Sending Mail.",#MB_ICONERROR) 
EndIf 
End

Progi1984 · Message par **Progi1984** » mar. 29/nov./2005 18:35

Comme c'est une appli, j'ai mis le mailfrom et le mailto identique, j'incorporeris l'expéditeur dans le sujet !

Sinon si vous changez le amilto, vous risquez d'avoir des erruers, j'avais mis mon adresse free, j'a eu qques erreurs. Le truc bizarre, c'est qu'il n'y ait aucune authentification pour utiliser un serveur smtp !

Progi1984 · Message par **Progi1984** » mar. 29/nov./2005 18:44

Ce code all a l'avantage de fonctionner parfaitement, mais nécessite une connexion à un serveur de messagerie authentifié, mais il peut envoyer des pièces jointes !

Code : Tout sélectionner

Global ConnectionID.l
Global CrLf.s
CrLf.s=Chr(13)+Chr(10)

Enumeration
#eHlo
#RequestAuthentication
#Username
#Password
#MailFrom
#RcptTo
#Data
#Quit
#Complete
EndEnumeration

;NewList Attachments.s()
;InsertElement(Attachments())
;Attachments() = "c:\afile.htm"
;InsertElement(Attachments())
;Attachments() = "c:\another.jpg"

Declare.s Base64Encode(strText.s)
;Declare SendFiles()
Declare.s GetMIMEType(Extension.s)
Declare Send(msg.s)
Declare SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s)



;Sending Mail with SMTP-AUTH
;sendesmtpmail("Clipper","my@email.com","your@email.com","username","password","auth.smtp.mailserver.com","Hallo","This is the body")
sendesmtpmail("Nom que vous voulez voir afficher pour l'expéditeur","mail pour la réponse","mail à qui vous l'envoyez","identifiant pour se connecter au serveur","mot de passe","serveur SMTP","Titre du msg","Contenu du msg")

; Don´t fill the Username if you want to sent regular
;sendesmtpmail("Clipper","my@email.com","your@email.com","","","smtp.mailserver.com","Hallo","This is the body")

Procedure SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s)
If InitNetwork()
   ConnectionID = OpenNetworkConnection(smtpserver, 25)
   If ConnectionID
      loop250.l=0
      Repeat   
         If NetworkClientEvent(ConnectionID)
            ReceivedData.s=Space(256)
            ct=ReceiveNetworkData(ConnectionID ,@ReceivedData,256)
            If ct
               cmdID.s=Left(ReceivedData,3)
               cmdText.s=Mid(ReceivedData,5,ct-6)
               Debug "<" + cmdID + " " + cmdText
               Select cmdID
                  Case "220"
                     If Len(username)>0
                        Send("Ehlo " + Hostname())
                        state=#eHlo
                     Else
                        send("HELO " + Hostname())
                        state=#MailFrom
                     EndIf   
                  Case "221"
                     send("[connection closed]")
                     state=#Complete
                     quit=1     
                  Case "235"
                     Send("MAIL FROM: <" + sender + ">")
                     state=#RcptTo
                   
                  Case "334"
                     If state=#RequestAuthentication
                        Send(Base64Encode(username))
                        state=#Username
                     EndIf
                     If state=#Username
                        Send(Base64Encode(password))
                        state=#Password
                     EndIf

                  Case "250"
                     Select state
                        Case #eHlo
                           send("AUTH LOGIN")
                           state=#RequestAuthentication     
                        Case #MailFrom   
                           Send("MAIL FROM: <" + sender + ">")
                           state=#RcptTo
                        Case #RcptTo
                           Send("RCPT TO: <" + recipient + ">")
                           state=#Data
                        Case #Data
                           Send("DATA")
                           state=#QUIT
                        Case #QUIT
                           Send("QUIT")
                     EndSelect
             
                  Case "251"
                        Send("DATA")
                        state=#Data
                  Case "354"
                     send("X-Mailer: eSMTP 1.0")
                     send("To: " + recipient)
                     send("From: " + name + " <" + sender + ">")
                     send("Reply-To: "+sender)
                     send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) )
                     send("Subject: " + Subject)
                     send("MIME-Version: 1.0")
                     ;soit cette ligne là si il ya des pièces jointes
send("Content-Type: multipart/mixed; boundary="+Chr(34)+"MyBoundary"+Chr(34))
                     ; soit celle là pour pas de pièces jointes
send("Content-Type: text/plain; boundary="+Chr(34)+"MyBoundary"+Chr(34))
                     Send("")
                     send("--MyBoundary")
                     Send("Content-Type: text/plain; charset=us-ascii")
                     Send("Content-Transfer-Encoding: 7bit")
                     send("")                     
                     Send(body.s)
                     send("--MyBoundary--")
                     Send(".")
             
                  Case "550"
                       
                     quit=1     
               EndSelect
            EndIf
         EndIf
         
      Until Quit = 1
      CloseNetworkConnection(ConnectionID)
      MessageRequester("","Ende")
   EndIf
EndIf         
EndProcedure

Procedure Send(msg.s)
;Delay(10)
Debug "> " + msg
msg+crlf.s
SendNetworkData(ConnectionID, @msg, Len(msg))
EndProcedure


; Procedure SendFiles()
; ResetList(Attachments())
; While(NextElement(Attachments()))
; file.s=Attachments()
; Send("")
; If ReadFile(0,file.s)
;    Debug file
;    InputBufferLength.l = Lof()
;    OutputBufferLength.l = InputBufferLength * 1.4
;    *memin=AllocateMemory(InputBufferLength)
;    If *memin
;       *memout=AllocateMemory(OutputBufferLength)
;       If *memout
;          Boundry.s = "--MyBoundary"
;          Send(Boundry)
;          Send("Content-Type: "+GetMIMEType(GetExtensionPart(file.s)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34))
;          send("Content-Transfer-Encoding: base64")
;          send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34))
;          send("")
;          ReadData(*memin,InputBufferLength)
;          Base64Encoder(*memin,60,*memout,OutputBufferLength)
;          send(PeekS(*memout,60)) ; this must be done because For i=0 To OutputBufferLength/60 doesn´t work
;          Base64Encoder(*memin,InputBufferLength,*memout,OutputBufferLength)               
;          For i=1 To OutputBufferLength/60
;              temp.s=Trim(PeekS(*memout+i*60,60))
;              If Len(temp)>0
;               send(temp)
;              EndIf
;          Next
;       EndIf
;    EndIf
;    FreeMemory(-1)
;    CloseFile(0)
; EndIf
; Wend
; ProcedureReturn
; EndProcedure


Procedure.s Base64Encode(strText.s)
    DefType.s Result
    *B64EncodeBufferA = AllocateMemory(Len(strText)+1)
    *B64EncodeBufferB = AllocateMemory((Len(strText)*3)+1)
    PokeS(*B64EncodeBufferA, strText)
    Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText)*3)
    Result = PeekS(*B64EncodeBufferB)
    FreeMemory(-1)
    ProcedureReturn Result
EndProcedure


Procedure.s GetMIMEType(Extension.s)
    Extension = "." + Extension
    hKey.l = 0
    KeyValue.s = Space(255)
    DataSize.l = 255
    If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, Extension, 0, #KEY_READ, @hKey)
        KeyValue = "application/octet-stream"
    Else
        If RegQueryValueEx_(hKey, "Content Type", 0, 0, @KeyValue, @DataSize)
            KeyValue = "application/octet-stream"
        Else
            KeyValue = Left(KeyValue, DataSize-1)
        EndIf
        RegCloseKey_(hKey)
    EndIf
    ProcedureReturn KeyValue
EndProcedure

julien · Message par **julien** » mar. 29/nov./2005 19:25

Et la lib Droopy ?, il y'a une fonction de send mail avec authentification SMTP (Gmail)

Progi1984 · Message par **Progi1984** » mar. 29/nov./2005 20:20

Gmail est spécial, vu qu'il faut utiliser du TLS !

Progi1984 · Message par **Progi1984** » mar. 29/nov./2005 21:56

Pour envoyer juste du texte, modifiez le case 354

et insérez :

Code : Tout sélectionner

                     send("X-Mailer: Your_App")
                     send("To: " + recipient)
                     send("From: " + name + " <" + sender + ">")
                     send("Reply-To: "+sender)
                     send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) )
                     send("Subject: " + Subject)
                     send("MIME-Version: 1.0")
                     Send("Content-Type: text/plain; charset=us-ascii")
                     Send("Content-Transfer-Encoding: 7bit")
                     send("")                     
                     Send(body.s)
                     Send(".")

Je suis en train de voir pour envoyer du HTML !

[edit] Il suffisait de modifier le content type (cad le type de contenu :p)

Code : Tout sélectionner

                     send("X-Mailer: ProgiToDo 1.0")
                     send("To: " + recipient)
                     send("From: " + name + " <" + sender + ">")
                     send("Reply-To: "+sender)
                     send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) )
                     send("Subject: " + Subject)
                     send("MIME-Version: 1.0")
                     Send("Content-Type: text/html; charset=us-ascii")
                     Send("Content-Transfer-Encoding: 7bit")
                     send("")                     
                     Send("<b>"+body.s+"</b>")
                     Send(".")

Intéressant :

http://www.laltruiste.com/annexe/entete_mime.html a écrit :Content-Type: type/sous-type; {charset = encodage} | {boundary = délimiteur} CRLF
représente le type et le sous-type (text/plain, image/jpeg, audio/basic, application/postscript, etc.) et l'encodage (US-ASCII ou ISO-8859-X) du contenu d'un courrier. Si le couple type/sous-type possède la valeur multipart/mixed ou multipart/alternative, l'attribut boundary permet de délimiter les parties encodées différemment par une chaîne de caractères spéciale.

Flype · Message par **Flype** » sam. 17/déc./2005 15:14

dans un autre genre, pour utiliser le programme de messagerie par default (outlook,thunderbird,etc...) j'ai fais un petit jeu de fonctions à tester. C'est une méthode très simple, donc robuste, mais pas adapté à toutes les situations (pas d'envoi d'email en tache de fond par ex,pas de pièces jointes).

Code : Tout sélectionner

; Jeu de fonctions 'mailto'
; Flype
; Déc. 2005

Structure MAILTO
  _To.s      ; Destinataires
  _Cc.s      ; Copies
  _Bcc.s     ; Copies cachées
  _Subject.s ; Sujet
  _Body.s    ; Message
EndStructure

Procedure.l MAILTO_New()
  ProcedureReturn AllocateMemory(SizeOf(MAILTO))
EndProcedure
Procedure.l MAILTO_Free(*a.MAILTO)
  FreeMemory(*a)
EndProcedure
Procedure.l MAILTO_Open(*a.MAILTO)
  ProcedureReturn RunProgram("mailto:"+*a\_To+"?&subject="+*a\_Subject+"&cc="+*a\_Cc+"&bcc="+*a\_Bcc+*a\_Body,"","",1)
EndProcedure
Procedure.l MAILTO_To(*a.MAILTO,value.s)
  If *a\_To : *a\_To + "," : EndIf
  *a\_To + value
EndProcedure
Procedure.l MAILTO_Cc(*a.MAILTO,value.s)
  If *a\_Cc : *a\_Cc + "," : EndIf
  *a\_Cc + value
EndProcedure
Procedure.l MAILTO_Bcc(*a.MAILTO,value.s)
  If *a\_Bcc : *a\_Bcc + "," : EndIf
  *a\_Bcc + value
EndProcedure
Procedure.l MAILTO_Subject(*a.MAILTO,value.s)
  *a\_Subject = value
EndProcedure
Procedure.l MAILTO_Body(*a.MAILTO,value.s)
  *a\_Body + "&body=" + value
EndProcedure

test = MAILTO_New()
If test
  MAILTO_To(test,"to1@demo.fr")
  MAILTO_To(test,"to2@demo.fr")
  MAILTO_To(test,"to3@demo.fr")
  MAILTO_Cc(test,"cc1@demo.fr")
  MAILTO_Cc(test,"cc2@demo.fr")
  MAILTO_Cc(test,"cc3@demo.fr")
  MAILTO_Bcc(test,"bcc1@demo.fr")
  MAILTO_Bcc(test,"bcc2@demo.fr")
  MAILTO_Bcc(test,"bcc3@demo.fr")
  MAILTO_Subject(test,"Démonstration de mailto")
  MAILTO_Body(test,"Bonjour,")
  MAILTO_Body(test,"")
  MAILTO_Body(test,"2ème ligne de texte")
  MAILTO_Body(test,"3ème ligne de texte")
  MAILTO_Body(test,"")
  MAILTO_Body(test,"Cordialement,")
  MAILTO_Body(test,"Flype")
  MAILTO_Open(test)
  MAILTO_Free(test)
EndIf