Envoi d'emails

Oliv · Message par **Oliv** » dim. 05/sept./2004 21:37

Voilà la source de mon client pour envoyer des emails, il était déjà dans le musée mais MacRain me l'a redemandé alors je le remets

Code : Tout sélectionner

InitNetwork()

;- Declarations
; Constantes
#INormal = 0
Enumeration ; Gadgets
  #Boutton_A
  #Texte_Objet
  #Adresse_Carnet
  #Adresse
  #OT_Port
  #OS_Port
  #OT_Adresse
  #OB
  #OS_Adresse
  #OT_SMTP
  #OS_SMTP
  #Modifier_Carnet
  #OT_Nom
  #OS_Nom
  #Objet
  #Message
EndEnumeration

Enumeration ; Menus
  #Envoyer
  #About
  #Effacer
  #Quitter
  #Options
  #Copier
  #Sys_Envoyer
  #Sys_Carnet
  #Sys_Quitter
  #Sys_Options
  #Sys_Ouvrir
  #Coller
  #Couper
  #Carnet
  #Nouveau_Contact
  #Supprimer_Contact
EndEnumeration

; Structures
Structure Adresse
  Nom.s
  Adresse.s
EndStructure

; Listes
NewList Carnet.adresse()
Declare LoadLinkedList_String(File.s)
Declare Options(Parametre.b)
Loadlinkedlist_String("Carnet.mail")

; Buffer
*Buffer = AllocateMemory(2000)

; Variables
ClientID.l
Eol.s = Chr(13) + Chr(10) : Date.s : Old_Date.s

If OpenPreferences("Mail.prefs") = 0
  MessageRequester("Bonjour","Bonjour," + Eol + "Vous lancez mail pour la Première fois," + Eol + "merci de rentrer vos paramètres.")
  Port_Smtp = 25
  Options(1)
Else
  Port_SMTP.l = ReadPreferenceLong("Port_SMTP",-1)
  Adresse_Utilisateur.s = ReadPreferenceString("Adresse_Utilisateur","")
  Serveur_SMTP.s = ReadPreferenceString("Serveur_SMTP","")
  Nom.s = ReadPreferenceString("Nom",Nom)
EndIf
ClosePreferences()

Global Eol,ClientID,*Buffer,Selection.s,Port_SMTP.l,Adresse_Utilisateur.s,Serveur_SMTP.s,Nom.s,Show.b

Procedure Sys_Ouvrir()
  If IsIconic_(WindowID(0)) 
    ;cette ligne est utilisée pour l'effet d'agrandissement 
    ShowWindow_(WindowID(0),#sw_minimize) 
    ;Une tempo est nécessaire sinon ça ne fonctionne pas à tous les coups 
    Delay(250) 
    ShowWindow_(WindowID(0),#sw_restore)
    Show = 1
  EndIf
EndProcedure

Procedure Options(Parametre.b)
  OpenWindow(1,0,0,265,140,#PB_Window_MinimizeGadget | #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_TitleBar,"Options de Mail")
  CreateGadgetList(WindowID(1))
    TextGadget(#OT_Nom,7,5,30,20,"Nom :",#PB_Text_Center)
    StringGadget(#OS_Nom,43,5,217,20,Nom)
    TextGadget(#OT_Adresse,5,30,50,20,"Adresse:",#PB_Text_Center)
    StringGadget(#OS_Adresse,60,30,200,20,Adresse_Utilisateur)
    TextGadget(#OT_SMTP,5,55,50,20,"Serveur :",#PB_Text_Center)
    StringGadget(#OS_SMTP,60,55,200,20,Serveur_SMTP)
    TextGadget(#OT_Port,8,80,153,20,"Port SMTP (par convention 25) :",#PB_Text_Center)
    StringGadget(#OS_Port,168,80,93,20,Str(Port_SMTP))
    ButtonGadget(#OB,110,115,45,20,"OK")
  Repeat
    Select WaitWindowEvent()
      Case #PB_EventCloseWindow
        Sortie = 1
      Case #PB_EventGadget
        Select EventGadgetID()
          Case #OB
            Port_SMTP = Val(GetGadgetText(#OS_Port)) : Adresse_Utilisateur = GetGadgetText(#OS_Adresse) : Serveur_SMTP = GetGadgetText(#OS_SMTP) : Nom = GetGadgetText(#OS_Nom)
            CreatePreferences("Mail.prefs")
              WritePreferenceLong("Port_SMTP",Port_SMTP)
              WritePreferenceString("Adresse_Utilisateur",Adresse_Utilisateur)
              WritePreferenceString("Serveur_SMTP",Serveur_SMTP)
              WritePreferenceString("Nom",Nom)
            Sortie = 1
        EndSelect
    EndSelect
  Until Sortie = 1
  If parametre.b <> 1
    UseWindow(0)
    ActivateWindow()
  EndIf
  CloseWindow(1)
EndProcedure

Procedure Controle(Num.w)
  If Val(Left(PeekS(*Buffer),3)) <> Num
    ProcedureReturn 0
  Else
    ProcedureReturn 1
  EndIf
EndProcedure

Procedure Envoi_Reception(Texte.s,Num.w) 
  SendNetworkString(ClientID, Texte + Eol)  
  Repeat 
    FreeMemory(*Buffer) 
    *Buffer = AllocateMemory(2000)
    ReceiveNetworkData(ClientID,*Buffer,2000)
    Debug PeekS(*Buffer)
  Until NetworkClientEvent(ClientID) <> 2
  ProcedureReturn Controle(Num)
EndProcedure

Procedure SaveLinkedList_String(*FirstElement, StructureSize.l, File.s) 
  Protected *PosLL, StringPos.l, StringLength.l, StringAddress.l 
  If CreateFile(0, File) 
    *PosLL = *FirstElement 
    Repeat 
      For StringPos = 0 To StructureSize - 1 Step 4 
        StringAddress = PeekL(*PosLL + StringPos) 
        StringLength = Len(PeekS(StringAddress)) 
        WriteLong(StringLength) 
        WriteData(StringAddress, StringLength) 
      Next 
      *PosLL = PeekL(*PosLL - 8) + 8 
    Until *PosLL = 8 
    CloseFile(0) 
  EndIf 
EndProcedure

Procedure LoadLinkedList_String(File.s) 
  Protected StringPos.l, StringLength.l 
  If ReadFile(0,File) 
    ClearList(Carnet()) 
    While Eof(0) = 0 
      AddElement(Carnet()) 
      For StringPos = 1 To 2
        StringLength = ReadLong() 
        Select StringPos 
          Case 1 
            Carnet()\Nom = Space(StringLength) 
            ReadData(@Carnet()\Nom, StringLength) 
          Case 2 
            Carnet()\Adresse = Space(StringLength) 
            ReadData(@Carnet()\Adresse, StringLength) 
        EndSelect 
      Next 
    Wend 
    CloseFile(0) 
  EndIf 
EndProcedure 

Procedure Carnet_Adresses()
  OpenWindow(1,0,0,500,450,#PB_Window_MinimizeGadget | #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_TitleBar,"Carnet d'adresses de mail",WindowID(0))
  CreateGadgetList(WindowID(1))
    ListIconGadget(#Adresse_Carnet,5,5,490,440,"Nom",200,#PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_HeaderDragDrop)
    AddGadgetColumn(#Adresse_Carnet,1,"Adresse",286)
    ForEach Carnet()
      AddGadgetItem(#Adresse_Carnet,-1,Carnet()\Nom + Chr(10) + Carnet()\Adresse)
    Next
    
  CreateMenu(1,WindowID(1))
  MenuTitle("Actions")
    MenuItem(#Nouveau_Contact,"Creer un contact")
    MenuItem(#Modifier_Carnet,"Modifier le contact")
    MenuItem(#Supprimer_Contact,"Supprimmer le contact")
  MenuBar()
    MenuItem(#Envoyer,"Envoyer à ce contact")
  MenuBar()
    MenuItem(#Quitter,"Quitter")
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_EventCloseWindow
        Sortie = 1
      Case #PB_EventMenu
        Select EventMenuID()
          Case #Quitter
            Sortie = 1
          Case #Modifier_Carnet
            If GetGadgetState(#Adresse_Carnet) > -1
              SelectElement(Carnet(),GetGadgetState(#Adresse_Carnet))
              Carnet()\Nom = InputRequester("Nom du contact","Entrez le nom du contact : ",Carnet()\Nom)
              Carnet()\Adresse = InputRequester("Adresse du contact","Entrez l'adresse du contact : ",Carnet()\Adresse)
              SetGadgetItemText(#Adresse_Carnet,GetGadgetState(#Adresse_Carnet),Carnet()\Nom,0)
              SetGadgetItemText(#Adresse_Carnet,GetGadgetState(#Adresse_Carnet),Carnet()\Adresse,1)
            EndIf
          Case #Nouveau_Contact
            AddElement(Carnet())
            Carnet()\Nom = InputRequester("Nom du contact","Entrez le nom du contact : ","")
            Carnet()\Adresse = InputRequester("Adresse du contact","Entrez l'adresse du contact : ","")
            AddGadgetItem(#Adresse_Carnet,-1,Carnet()\Nom + Chr(10) + Carnet()\Adresse)
            FirstElement(Carnet())
            SaveLinkedlist_String(@Carnet(),SizeOf(Adresse),"Carnet.mail")
          Case #Supprimer_Contact
            If GetGadgetState(#Adresse_Carnet) > -1
              SelectElement(Carnet(),GetGadgetState(#Adresse_Carnet))
              DeleteElement(Carnet())
              FirstElement(Carnet())
              If CountList(Carnet()) > 0
                SaveLinkedlist_String(@Carnet(),SizeOf(Adresse),"Carnet.mail")
              Else
                DeleteFile("Carnet.mail")
              EndIf
              ClearGadgetItemList(#Adresse_Carnet)
              ForEach Carnet()
                AddGadgetItem(#Adresse_Carnet,-1,Carnet()\Nom + Chr(10) + Carnet()\Adresse)
              Next
            Else
              MessageRequester("Erreur","Aucun contact selectionné.")
            EndIf
          Case #Envoyer
            If GetGadgetState(#Adresse_Carnet) > -1
              Selection = GetGadgetItemText(#Adresse_Carnet,GetGadgetState(#Adresse_Carnet),1)
              Sortie = 1
            Else
              MessageRequester("Erreur","Aucun contact selectionné.")
            EndIf
        EndSelect
      Case #PB_Event_Gadget
        Select EventGadgetID()
          Case #Adresse_Carnet
            Select EventType()
              Case #PB_EventType_LeftDoubleClick
                Selection = GetGadgetItemText(#Adresse_Carnet,GetGadgetState(#Adresse_Carnet),1)
                Sortie = 1
            EndSelect
        EndSelect
    EndSelect
  Until Sortie = 1
  UseWindow(0)
  ActivateWindow()
  CloseWindow(1)
  If Selection <> "" : SetGadgetText(#Adresse,Selection) : Selection = "" : EndIf
EndProcedure

Procedure Systray_Click_Simple()
  Repeat
    Select EventMenuID()
      Case #Sys_Carnet
        Carnet_Adresses() : Sortie = 1
    EndSelect
Until Sortie = 1
EndProcedure


;- Debut du programme
OpenWindow(0,20,220,250,370,#PB_Window_SystemMenu | #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_MinimizeGadget,"Mail")
CreateGadgetList(WindowID(0))
  StringGadget(#Adresse,50,5,195,20,"")
  StringGadget(#Objet,50,30,195,20,"")
  HEdit.l = EditorGadget(#Message,5,55,240,270)
  ButtonGadget(#Boutton_A,5,5,40,20,"A :")
  TextGadget(#Texte_Objet,5,30,40,20,"Sujet :",#PB_Text_Center)
  
CreateMenu(0,WindowID(0))
  MenuTitle("Operations")
    MenuItem(#Envoyer,"Envoyer")
    MenuItem(#Effacer,"Effacer")
   MenuBar()
    MenuItem(#Carnet,"Carnet d'adresses")
    MenuItem(#Options,"Options")
   MenuBar()
    MenuItem(#Quitter,"Quitter")
  MenuTitle("Edition")
    MenuItem(#Couper,"Couper")
    MenuItem(#Copier,"Copier")
    MenuItem(#Coller,"Coller")
  MenuTitle("?")
    MenuItem(#About,"A propos de Mail")
    
CreatePopupMenu(1) 
  MenuItem(#Couper,"Couper")
  MenuItem(#Copier,"Copier")
  MenuItem(#Coller,"Coller")
  
CreatePopupMenu(2)
  MenuItem(#Sys_envoyer,"Envoyer un message")
 MenuBar()
  MenuItem(#Sys_Carnet,"Carnet d'adresses")
  MenuItem(#Sys_Options,"Options")
 MenuBar()
  MenuItem(#Sys_Ouvrir,"Ouvrir Mail")
  MenuItem(#Sys_Quitter,"Quitter")
  

CreateStatusBar(0,WindowID(0))
  AddStatusBarField(250)
  
AddSysTrayIcon(0,WindowID(0),CatchImage(#INormal,?INormal))
  SysTrayIconToolTip(0, "Icon 1")


Repeat
  Select WaitWindowEvent()
    Case #PB_EventCloseWindow
      Sortie = 1 
    Case #WM_RButtonDown 
      DisplayPopupMenu(1,WindowID(0))
    Case #WM_SIZE 
      If IsIconic_(WindowID(0)) 
        ShowWindow_(WindowID(0),#SW_Hide)
      EndIf
    Case #PB_EventMenu
      Select EventMenuID()
        Case #Quitter
          Sortie = 1
        Case #Coller
          SendMessage_(HEdit,#WM_PASTE,0,0)
        Case #Couper
          SendMessage_(HEdit,#WM_CUT,0,0)
        Case #Copier
          SendMessage_(HEdit,#WM_COPY,0,0)
        Case #Effacer
          SetGadgetText(#Adresse,"")
          SetGadgetText(#Objet,"")
          ClearGadgetItemList(#Message)
        Case #Envoyer
          If GetGadgetText(#Adresse) <> ""
            StatusBarText(0,0,"Connection en cours.")
            ClientID =  OpenNetworkConnection(Serveur_SMTP,Port_SMTP)
            If ClientID = 0
              MessageRequester("Erreur","Erreur de Connection." + Eol + "Verrifiez l'adresse SMTP et le port.",#MB_ICONError)
            Else
              Repeat 
                FreeMemory(*Buffer) 
                *Buffer = AllocateMemory(2000)
                ReceiveNetworkData(ClientID,*Buffer,2000)
                Debug PeekS(*Buffer)
              Until NetworkClientEvent(ClientID) <> 2
              If Envoi_Reception("HELO Mail",250) = 0
                MessageRequester("Erreur","Erreur de Connection." + Eol + "Verrifiez l'adresse SMTP et le port." + Eol + Left(PeekS(*Buffer),3),#MB_ICONError)
              Else
                StatusBarText(0,0,"Identification en cours.")
                If Envoi_Reception("MAIL FROM: <" + Adresse_Utilisateur + ">",250) = 0
                  MessageRequester("Erreur","Erreur d'identification." + Eol + "Verrifiez que votre l'adresse e-mail entrée est valide." + Eol + "Vous avez entré : " + Adresse_Utilisateur + Eol + Left(PeekS(*Buffer),3),#MB_ICONError)
                Else
                  StatusBarText(0,0,"Envoi en cours.")
                  If Envoi_Reception("RCPT To: <" + GetGadgetText(#Adresse) + ">",250) = 0
                    MessageRequester("Erreur","Erreur de transmition." + Eol + "Verrifiez que l'adresse e-mail du destinataire entrée est valide." + Eol + "Vous avez entré : " + GetGadgetText(#Adresse) + Eol + Left(PeekS(*Buffer),3),#MB_ICONError)
                  Else
                    If Envoi_Reception("DATA",354) = 0
                      MessageRequester("Erreur","Erreur d'envoi venant du serveur." + Eol + "Veuillez réessayer." + Eol + Left(PeekS(*Buffer),3),#MB_ICONError)
                    Else
                      Envoi_Reception("From: " + Chr(34) + Nom + Chr(34) + " <" + Adresse_Utilisateur + ">" + Eol + "To: <"+ GetGadgetText(#Adresse) + ">" + Eol + "Subject: " + GetGadgetText(#Objet) + Eol + GetGadgetText(#Message) + Eol + ".",250)
                      SetGadgetText(#Adresse,"")
                      SetGadgetText(#Objet,"")
                      ClearGadgetItemList(#Message)
                      Envoi_Reception("QUIT",221)
                    EndIf
                  EndIf
                EndIf
              EndIf
            EndIf
          Else
            MessageRequester("Attention","Aucune adresse," + Eol + "impossible d'envoyer l'e-mail.")
          EndIf
          If ClientID <> 0 : CloseNetworkConnection(ClientID) : ClientID = 0 : EndIf
          StatusBarText(0,0,Date,#PB_StatusBar_Center)
        Case #Options
          Options(0)
          ClosePreferences()
        Case #Carnet
          Carnet_Adresses()
        Case #About
          MessageRequester("A propos de Mail","Mail version 1.0" + Eol + "www.oliv.fr.fm",#MB_ICONInformation)
      EndSelect
    Case #PB_EventGadget
      Select EventGadgetID()
        Case #Boutton_A
          Carnet_Adresses()
      EndSelect
    Case #PB_Event_SysTray 
      Select EventType()
        Case #PB_EventType_LeftDoubleClick
          Sys_Ouvrir()
        Case #PB_EventType_RightClick
          DisplayPopupMenu(2,WindowID())
          Systray_Click_Simple()
      EndSelect
  EndSelect
  Date = FormatDate("%hh:%ii",Date())
  If Date <> Old_Date
    StatusBarText(0,0,Date,#PB_StatusBar_Center)
    Old_Date = Date
  EndIf
Until Sortie = 1
End

INormal:
  IncludeBinary "Normal.ico"

Backup · Message par **Backup** » dim. 05/sept./2004 23:05

Merci !

Flype · Message par **Flype** » lun. 06/sept./2004 7:11

simple et efficace

Le Soldat Inconnu

je peux le mettre sur codes-fr ?

Le Soldat Inconnu

tu devrais faire une lib

Code : Tout sélectionner

SendEmail(Adresse.s, Titre.s, texte.s, FichierJoint.s)

bon pour le fichier joint, c'est pas encore fait mais tu va bien nous pondre ça

Oliv · Message par **Oliv** » ven. 08/oct./2004 14:20

oui, le fichier joint je pense y arriver bientôt. pour la procédure c'est plutot

Code : Tout sélectionner

SendEmail(Adresse.s, Titre.s, texte.s, FichierJoint.s,Server.s)

Car tout le monde a un serveur smtp différent celon ses humeurs ou sa connection. Quand à la procédure va voir sur codearchiv mais je crois que ça doit déjà exister, pas sur

gansta93 · Message par **gansta93** » ven. 08/oct./2004 14:44

Bonjour,

Oui sur CodeArchive, y a même pour les pièces jointes et avec autentification.
Pour les pièces jointes.

Code : Tout sélectionner

; www.purearea.net (Sourcecode collection by cnesm)
; Author: PB
; Date: 22. November 2003

;Modified code originally posted by Paul IIRC  :) 

;USAGE: 
;PBSendMail( 
;                        RecipientEmailAddress as String 
;                        SenderEmailAddress as String 
;                        MailServerHost as String 
;                        Subject as String 
;                        Message as String 
;                        AttachmentIncluded as Byte (Flag: 0/1) 
;                     ) 

;NOTES: 
;When the 'AttachmentIncluded' flag is set to '1', the mail procedure loops through a linked list 
;called 'Attachments()' then encodes or processes the attachments. So to send attachments 
;you must have a linked list called 'Attachments()'. 

;=============================================== 
;-GLOBAL FLAGS / VARIABLES / STRUCTURES / ARRAYS 
;=============================================== 

Global ConnectionID.l 
Global MailResponse.s 

;Example linked list 
NewList Attachments.s() 
InsertElement(Attachments()) 
Attachments() = "C:\Documents And Settings\User\Desktop\Image.jpg" 
;InsertElement(Attachments()) 
;Attachments() = "C:\Documents And Settings\User\Desktop\Archive.zip" 
;InsertElement(Attachments()) 
;Attachments() = "C:\Documents And Settings\User\Desktop\ObscureText.fff" 

;=============================================== 
;-PROCEDURES 
;=============================================== 

;Check to see if the file is binary 
Procedure IsBinary(File.s) 
    If ReadFile(0, File) 
        While Loc() <> Lof() 
            CurrentByte.b = ReadByte() 
            If CurrentByte <= 9 Or CurrentByte = 127 
                CloseFile(0) 
                ProcedureReturn 1 
            EndIf 
            If CurrentByte > 10 And CurrentByte < 13 
                CloseFile(0) 
                ProcedureReturn 1 
            EndIf 
            If CurrentByte > 13 And CurrentByte < 32 
                CloseFile(0) 
                ProcedureReturn 1 
            EndIf 
        Wend 
    EndIf 
EndProcedure 

;Find the MIME type for a given file extension 
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 

;Send a piece of mail data 
Procedure SendMailData(msg.s) 
    SendNetworkData(ConnectionID, @msg, Len(msg)) 
EndProcedure 

;Check the server responses 
Procedure.s MailResponse() 
    MailResponse=Space(9999) 
    ReceiveNetworkData(ConnectionID,@MailResponse,9999) 
    MailResponse=Left(MailResponse,3) 
    ProcedureReturn MailResponse 
EndProcedure 

;Send the mail 
Procedure PBSendMail(RecipientEmailAddress.s, SenderEmailAddress.s, MailServerHost.s, Subject.s, Message.s, AttachmentIncluded.b) 
    If InitNetwork() 
        ConnectionID = OpenNetworkConnection(MailServerHost, 25) 
        If ConnectionID <> 0 
            MailResponse() 
            If MailResponse = "220" 
                Index = FindString(MailServerHost, ".", 1) 
                MailServerDomain.s = Mid(MailServerHost, Index + 1, Len(MailServerHost)) 
                SendMailData("HELO "+MailServerDomain+Chr(13)+Chr(10)) 
                MailResponse() 
                If MailResponse="250" 
                    Sleep_(125) 
                    SendMailData("MAIL FROM: <"+SenderEmailAddress+">"+Chr(13)+Chr(10)) 
                    MailResponse() 
                    If MailResponse="250" 
                        SendMailData("RCPT TO: <"+RecipientEmailAddress+">"+Chr(13)+Chr(10)) 
                        MailResponse() 
                        If MailResponse="250" 
                            SendMailData("DATA"+Chr(13)+Chr(10)) 
                            MailResponse() 
                            If MailResponse="354" 
                                Sleep_(125) 
                                SendMailData("X-Mailer: PBSendMail v1.0" + Chr(13) + Chr(10)) 
                                SendMailData("To: " + RecipientEmailAddress + Chr(13) + Chr(10)) 
                                SendMailData("From: " + SenderEmailAddress + Chr(13) + Chr(10)) 
                                SendMailData("Reply-To:" + SenderEmailAddress + Chr(13) + Chr(10)) 
                                SendMailData("Date: " + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) + Chr(13) + Chr(10)) 
                                SendMailData("Subject: " + Subject + Chr(13) + Chr(10)) 
                                SendMailData("MIME-Version: 1.0" + Chr(13) + Chr(10)) 
                                ;Handle any attachments 
                                If AttachmentIncluded 
                                    Debug "Processing 'multipart/mixed' Email..." 
                                    Boundry.s = "PBSendMailv1.0_Boundry_"+ FormatDate("%dd%mm%yyyy%hh%ii%ss", Date()) 
                                    SendMailData("Content-Type: multipart/mixed; boundary=" + Chr(34) + Boundry + Chr(13) + Chr(10) + Chr(34)) 
                                    SendMailData(Chr(13) + Chr(10)) 
                                    ;Main message 
                                    Debug "Processing Messsage..." 
                                    SendMailData("--" + Boundry + Chr(13) + Chr(10)) ; Boundry 
                                    SendMailData("Content-Type: text/plain; charset=" + Chr(34) + "iso-8859-1" + Chr(34) + Chr(13) + Chr(10)) 
                                    SendMailData("Content-Transfer-Encoding: 7bit" + Chr(13) + Chr(10)) 
                                    SendMailData(Chr(13) + Chr(10)) 
                                    Sleep_(125) 
                                    SendMailData(Message + Chr(13) + Chr(10)) 
                                    SendMailData(Chr(13) + Chr(10)) 
                                    Sleep_(125) 
                                    Debug "Processing Attachments..." 
                                    ResetList(Attachments()) 
                                    While(NextElement(Attachments())) 
                                        ;Attachment headers 
                                        SendMailData("--" + Boundry + Chr(13) + Chr(10)) ; Boundry 
                                        SendMailData("Content-Type: " + GetMIMEType(GetExtensionPart(Attachments())) + "; name=" + Chr(34) + GetFilePart(Attachments()) + Chr(34) + Chr(13) + Chr(10)) 
                                        If IsBinary(Attachments()) 
                                            SendMailData("Content-Transfer-Encoding: base64" + Chr(13) + Chr(10)) 
                                            SendMailData("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(Attachments()) + Chr(34) + Chr(13) + Chr(10)) 
                                            SendMailData(Chr(13) + Chr(10)) 
                                            Sleep_(125) 
                                            ;Encode the Attachments using Base64 
                                            If ReadFile(0, Attachments()) 
                                                InputBufferLength.l = Lof() 
                                                If AllocateMemory(0, InputBufferLength, 0) 
                                                    OutputBufferLength.l = InputBufferLength + InputBufferLength/3 + 2 
                                                    If OutputBufferLength < 64 : OutputBufferLength = 64 : EndIf 
                                                    If AllocateMemory(1, OutputBufferLength, 0) 
                                                        ReadData(UseMemory(0), InputBufferLength) 
                                                        Base64Encoder(UseMemory(0), InputBufferLength, UseMemory(1), OutputBufferLength) 
                                                        SendMailData(PeekS(UseMemory(1), OutputBufferLength) + Chr(13) + Chr(10)) 
                                                        Debug GetFilePart(Attachments()) + " (base64) Encoded" 
                                                    Else 
                                                        Debug "ERROR: Unable to allocate memory for Bank 1 to process " + GetFilePart(Attachments()) 
                                                        ProcedureReturn 0 
                                                    EndIf 
                                                Else 
                                                    Debug "ERROR: Unable to allocate memory for Bank 0 to process " + GetFilePart(Attachments()) 
                                                    ProcedureReturn 0 
                                                EndIf 
                                            Else 
                                                Debug "ERROR: Unable to read file: " + GetFilePart(Attachments()) 
                                                ProcedureReturn 0 
                                            EndIf 
                                            CloseFile(0) : FreeMemory(0) : FreeMemory(1) 
                                        Else 
                                            SendMailData("Content-Transfer-Encoding: 7bit" + Chr(13) + Chr(10)) 
                                            SendMailData("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(Attachments()) + Chr(34) + Chr(13) + Chr(10)) 
                                            SendMailData(Chr(13) + Chr(10)) 
                                            Sleep_(125) 
                                            If ReadFile(0, Attachments()) 
                                                InputBufferLength.l = Lof() 
                                                If AllocateMemory(0, InputBufferLength, 0) 
                                                    ReadData(UseMemory(0), InputBufferLength) 
                                                    SendMailData(PeekS(UseMemory(0), InputBufferLength) + Chr(13) + Chr(10)) 
                                                    Debug GetFilePart(Attachments()) + " (7bit) Processed" 
                                                Else 
                                                    Debug "ERROR: Unable to allocate memory for Bank 0 to process " + GetFilePart(Attachments()) 
                      ProcedureReturn 0 
                                                EndIf 
                                            Else 
                                                Debug "ERROR: Unable to read file: " + GetFilePart(Attachments()) 
                  ProcedureReturn 0 
                                            EndIf 
                                        EndIf 

                                        Sleep_(125) 
                                        SendMailData(Chr(13) + Chr(10)) 
                                    Wend 
                                    SendMailData("--" + Boundry + "--" + Chr(13) + Chr(10)) ; End Boundry 
                                Else 
                                    Debug "Processing messsage..." 
                                    SendMailData("Content-Type: text/plain; charset=" + Chr(34) + "iso-8859-1" + Chr(34) + Chr(13) + Chr(10)) 
                                    SendMailData("Content-Transfer-Encoding: 7bit" + Chr(13) + Chr(10)) 
                                    SendMailData(Chr(13) + Chr(10)) 
                                    Sleep_(125) 
                                    SendMailData(Message + Chr(13) + Chr(10)) 
                                EndIf 
                                Sleep_(125) 
                                SendMailData(Chr(13)+Chr(10)) 
                                SendMailData("."+Chr(13)+Chr(10)) 
                                MailResponse() 
                                If MailResponse="250" 
                                    Sleep_(125) 
                                    SendMailData("QUIT"+Chr(13)+Chr(10)) 
                                    MailResponse() 
                                    Debug "Mail sent successfully." 
                                    ProcedureReturn 1 
                                EndIf 
                            EndIf 
                        EndIf 
                    EndIf 
                EndIf 
            EndIf 
            CloseNetworkConnection(ConnectionID) 
        EndIf 
    EndIf 
EndProcedure 

;Testing: 
PBSendMail("theirmail@server.com", "yourmail@server.com", "smtp.server.com", "Subject Line", "Lorem Ipsum Dolar Sit Amet...", 0)

Bon j'ai pas regarder l'erreur qui est tout le temps avec allocatememory(), mais le principal y est

.
En espèrant ne pas être hors sujet même si ça doit être dure à faire

.

Anonyme2 · Message par **Anonyme2** » ven. 08/oct./2004 14:44

Oliv a écrit :oui, le fichier joint je pense y arriver bientôt. pour la procédure c'est plutot
Code : Tout sélectionner
SendEmail(Adresse.s, Titre.s, texte.s, FichierJoint.s,Server.s)
Car tout le monde a un serveur smtp différent celon ses humeurs ou sa connection. Quand à la procédure va voir sur codearchiv mais je crois que ça doit déjà exister, pas sur

Ca serait bien de na pas avoir à se soucier de Server.s, car si on fait un exe, ca se passe sans notre intervention

Oliv · Message par **Oliv** » ven. 08/oct./2004 15:15

Oui mais ça on ne peut pas, car le serveur smtp est pas le même chez wanadoo tele2, free, laposte etc...

Anonyme2 · Message par **Anonyme2** » ven. 08/oct./2004 15:18

Oliv a écrit :Oui mais ça on ne peut pas, car le serveur smtp est pas le même chez wanadoo tele2, free, laposte etc...

Ce qui veut dire qu'il faut y ajouter une config

gansta93 · Message par **gansta93** » ven. 08/oct./2004 19:02

Il y a aussi les autentifications... là encore CodeArchive... mais je ne peux pas le poster pour l'instant de tt façon qui ne le trouvera pas?