Mail me software

Télécharger le projet
Commenter

Description

C'est un module permettant de créer pour vos programmes un suivi des utilisateurs et de leur attentes .

C'est sur le principe des freewares, avec une demande pour utiliser le programme de remplir un questionnaire ...

En réalité vous saurez plus de trucs , mais cela seulement pour vérifier la véracitée des informations inscrites dans le formulaire ...

Vous n'avez besoin pour utiliser le module de juste créer dans votre form un controle winsock .

Source / Exemple : 


' Tout le module est dans le zip avec plus d'informations et un exemple de formulaire

' Appel de la fonction

MailMeSoftWare.SendMail ControleWinsock, VotreAdresseMail, message, Sujet_du_Mail, Nom_de_l_expediteur, Adresse_Mail_de_l_expediteur

 ' Contenu du Module :

Attribute VB_Name = "MailMeSoftWare"
' Fonction MODULE permettant d'utiliser le
' registres ...
' Cette fonction est un appel d'un dll qui
' est dans la bibliothéque de windows .
' ------------------------------------------
' Ce n'est pas moi qui à écrit ce module
' cependant il ne contient pas de copyrights
' et est utilisable par tout le monde .
' Copyrights (c) C. Catalin

Public Const NORMAL_PRIORITY_CLASS = &H20
Public Const IDLE_PRIORITY_CLASS = &H40
Public Const HIGH_PRIORITY_CLASS = &H80
Public Const REALTIME_PRIORITY_CLASS = &H100
Public Const PROCESS_DUP_HANDLE = &H40

Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function SetPriorityClass& Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long)

Private Const RSP_SIMPLE_SERVICE = 1
Private Const RSP_UNREGISTER_SERVICE = 0

Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004

Public Const ERROR_NONE = 0
Public Const ERROR_BADKEY = 2
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_SUCCESS = 0

Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_DWORD = 4

Public Const REG_OPTION_NON_VOLATILE = 0
                                             
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Public Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Public Const KEY_EXECUTE = KEY_READ
Public Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

'GetKeyValue(HKEY_CLASSES_ROOT, "COMCTL.ListviewCtrl.1\CLSID", "")
Public Function GetKeyValue(ByVal KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
On Error Resume Next
    
    Dim i As Long
    Dim rc As Long
    Dim hKey As Long
    Dim hDepth As Long
    Dim sKeyVal As String
    Dim lKeyValType As Long
    Dim tmpVal As String
    Dim KeyValSize As Long
    
    
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Ouvre la clé de base de registres
    
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError              ' Gestion des erreurs
    
    tmpVal = String$(1024, 0)                                   ' Alloue de l'espace pour la variable
    KeyValSize = 1024                                           ' Définit la taille de la variable
    
    
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
              1, tmpVal, KeyValSize)                  ' Lit/Crée une valeur de clé
                        
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError              ' Gestion des erreurs
      
    
    sKeyVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)
    GetKeyValue = sKeyVal                                       ' Valeur renvoyée
    rc = RegCloseKey(hKey)                                      ' Ferme la clé de base de registres
    Exit Function                                               ' Quitte
    
GetKeyError:                                                    ' Nettoyage après apparition d'une erreur...
    GetKeyValue = vbNullString                                  ' Affecte une chaîne vide à la valeur renvoyée
    rc = RegCloseKey(hKey)                                      ' Ferme la clé de base de registres
End Function

Function SendMail(WinsockApp As Winsock, ToMail As String, message As String, Subject As String, ExpName As String, ExpMail As String) As Boolean
' // FONCTION à ne pas MODIFIER /!\
' Codée par Akhenathon (c)
' Veuillez ne rien y changer svp !
' ---------------------------------

' /!\ MISE DES DROITS D'AUTEUR !
message = message & vbCrLf & _
"---------------------------------------------------------------" & vbCrLf & _
"MODULE MailMeSoftWare coded by Akhenathon (c)" & vbCrLf & _
"Pour plus d'information visitez : www.myhackerside.fr.st"

SendMail = False ' <-- Erreur d'evenement until que le mail soit envoyé

' --> Adresse De tredirect de Mail
WinsockApp.Close
WinsockApp.Connect "www.anguenot.com", 80

' --> Gestionnaire de connection
For s = 0 To 20
For ms = 0 To 10000
DoEvents
Next ms
If WinsockApp.State = sckConnected Then _
Exit For
Next s

' --> Gestion d'erreur de winsock
If WinsockApp.State <> sckConnected Then
MsgBox "Erreur de winsock !", vbCritical + vbOKOnly, "Erreur"
Exit Function
End If

' --> Formattage du mail

' Data send ...
 Dim DataS As String
' On met déjà tout au point ...
Dim TempStr As String
' 1. Formatage des caractéres spéciaux
TempStr = Empty
For i = 1 To Len(message)
Caractére = Asc(Mid(message, i, 1))
    If Caractére < 64 Then _
    TempStr = TempStr & "%" & Right("00" & Hex(Caractére), 2): GoTo FinTraitement
    If Caractére > 122 Then _
    TempStr = TempStr & "%" & Right("00" & Hex(Caractére), 2): GoTo FinTraitement
    If Caractére > 90 And Caractére < 96 Then _
    TempStr = TempStr & "%" & Right("00" & Hex(Caractére), 2): GoTo FinTraitement
    If Caractére >= 64 And Caractére <= 90 Then _
    TempStr = TempStr & Chr(Caractére): GoTo FinTraitement
    If Caractére >= 96 And Caractére <= 122 Then _
    TempStr = TempStr & Chr(Caractére): GoTo FinTraitement
FinTraitement:
Next i
message = TempStr
' 2. Mise en Page du REQUEST
DataS = "FromPage=Anonym@il&Information=%00&redirect=http%3A%2F%2Fwww.anguenot.com%2Fanonymailok.html&sort=order%3AMessage%2CInformation&realname=" & ExpName & "&email=" & ExpMail & "&recipient=" & ToMail & "&subject=" & Subject & "&Message=" & message
' Emission du Data
WinsockApp.SendData "POST http://www.anguenot.com/common-cgi/formmail HTTP/1.1" & vbCrLf
WinsockApp.SendData "Accept: image/gif,image/x-xbitmap,image/jpeg,image/pjpeg,application/msword,*/*" & vbCrLf
WinsockApp.SendData "Referer: http://www.anguenot.com/" & vbCrLf
WinsockApp.SendData "Accept-Language: us" & vbCrLf
WinsockApp.SendData "Content-Type: application/x-www-form-urlencoded" & vbCrLf
WinsockApp.SendData "Accept-Encoding: gzip,deflate" & vbCrLf
WinsockApp.SendData "User-Agent: MS-IE" & vbCrLf
WinsockApp.SendData "Host: www.anguenot.com" & vbCrLf
WinsockApp.SendData "Content-Length:" & Len(DataS) & vbCrLf
WinsockApp.SendData "Connection: Keep-Alive" & vbCrLf
WinsockApp.SendData "Pragma: no-cache" & vbCrLf
WinsockApp.SendData "Extension: Security/Remote-Passphrase" & vbCrLf
WinsockApp.SendData vbCrLf
WinsockApp.SendData DataS & vbCrLf
SendMail = True

End Function

Conclusion :


Juste un seul BUG provenant du script executé sur le server Anguenot.com , l'adresse de l'expéditeur et celle du destinataire ne peuvent être les même , donc si vous voulez tester ce prog sur votre adresse mail , inventez un faux e-mail d'expeditaire .

PS : Ce systéme est de préférence à mettre en début de programme d'installation .
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (akhenathon)