begin process at 2010 09 09 09:34:41
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Base de registre

 > CONNAITRE LA MESSAGERIE PAR DEFAUT D'UN UTILISATEUR 0.1

CONNAITRE LA MESSAGERIE PAR DEFAUT D'UN UTILISATEUR 0.1


 Information sur la source

Note :
8 / 10 - par 1 personne
8,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Base de registre Niveau :Débutant Date de création :08/06/2002 Date de mise à jour :08/06/2002 13:58:11 Vu / téléchargé :6 382 / 265

Auteur : Robinwood01

Ecrire un message privé
Site perso
Commentaire sur cette source (7)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
Ce code donne le nom de la messagerie par defaut.
Je cherche a faire un truc qui la lancerais automatiquement mais je suis embeté pour récupérer cette clef : HKEY_LOCAL_MACHINE\SOFTWARE\Clients\Mail\Outlook Express\shell\open\command", ""
Si quelqu'un arrive a le faire qu'il me mail à robinwood01@ifrance.com

Source

  • 'Dans le programme :
  • Private Sub Form_Load()
  • Label1.Caption = getstring(HKEY_LOCAL_MACHINE, "SOFTWARE\Clients\Mail", "")
  • End Sub
  • 'Dans le module :
  • 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_SUCCESS = 0&
  • Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
  • Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  • Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
  • Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
  • Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  • Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
  • Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
  • Public Const REG_SZ = 1 ' Unicode nul terminated String
  • Public Const REG_DWORD = 4 ' 32-bit number
  • Public Sub savekey(Hkey As Long, strPath As String)
  • Dim keyhand&
  • r = RegCreateKey(Hkey, strPath, keyhand&)
  • r = RegCloseKey(keyhand&)
  • End Sub
  • Public Function getstring(Hkey As Long, strPath As String, strValue As String)
  • 'EXAMPLE:
  • '
  • 'text1.text = getstring(HKEY_CURRENT_USE
  • ' R, "Software\VBW\Registry", "String")
  • '
  • Dim keyhand As Long
  • Dim datatype As Long
  • Dim lResult As Long
  • Dim strBuf As String
  • Dim lDataBufSize As Long
  • Dim intZeroPos As Integer
  • r = RegOpenKey(Hkey, strPath, keyhand)
  • lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
  • If lValueType = REG_SZ Then
  • strBuf = String(lDataBufSize, " ")
  • lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
  • If lResult = ERROR_SUCCESS Then
  • intZeroPos = InStr(strBuf, Chr$(0))
  • If intZeroPos > 0 Then
  • getstring = Left$(strBuf, intZeroPos - 1)
  • Else
  • getstring = strBuf
  • End If
  • End If
  • End If
  • End Function
  • Public Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
  • 'EXAMPLE:
  • '
  • 'Call savestring(HKEY_CURRENT_USER, "Sof
  • ' tware\VBW\Registry", "String", text1.tex
  • ' t)
  • '
  • Dim keyhand As Long
  • Dim r As Long
  • r = RegCreateKey(Hkey, strPath, keyhand)
  • r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
  • r = RegCloseKey(keyhand)
  • End Sub
  • Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
  • 'EXAMPLE:
  • '
  • 'text1.text = getdword(HKEY_CURRENT_USER
  • ' , "Software\VBW\Registry", "Dword")
  • '
  • Dim lResult As Long
  • Dim lValueType As Long
  • Dim lBuf As Long
  • Dim lDataBufSize As Long
  • Dim r As Long
  • Dim keyhand As Long
  • r = RegOpenKey(Hkey, strPath, keyhand)
  • lDataBufSize = 4
  • lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
  • If lResult = ERROR_SUCCESS Then
  • If lValueType = REG_DWORD Then
  • getdword = lBuf
  • End If
  • End If
  • r = RegCloseKey(keyhand)
  • End Function
  • Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
  • 'EXAMPLE"
  • '
  • 'Call SaveDword(HKEY_CURRENT_USER, "Soft
  • ' ware\VBW\Registry", "Dword", text1.text)
  • '
  • '
  • Dim lResult As Long
  • Dim keyhand As Long
  • Dim r As Long
  • r = RegCreateKey(Hkey, strPath, keyhand)
  • lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
  • 'If lResult <> error_success Then
  • ' Call errlog("SetDWORD", False)
  • r = RegCloseKey(keyhand)
  • End Function
  • Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
  • 'EXAMPLE:
  • '
  • 'Call DeleteKey(HKEY_CURRENT_USER, "Soft
  • ' ware\VBW")
  • '
  • Dim r As Long
  • r = RegDeleteKey(Hkey, strKey)
  • End Function
  • Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
  • 'EXAMPLE:
  • '
  • 'Call DeleteValue(HKEY_CURRENT_USER, "So
  • ' ftware\VBW\Registry", "Dword")
  • '
  • Dim keyhand As Long
  • r = RegOpenKey(Hkey, strPath, keyhand)
  • r = RegDeleteValue(keyhand, strValue)
  • r = RegCloseKey(keyhand)
  • End Function
'Dans le programme :
Private Sub Form_Load()
Label1.Caption = getstring(HKEY_LOCAL_MACHINE, "SOFTWARE\Clients\Mail", "")
End Sub



'Dans le module :
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_SUCCESS = 0&

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
    Public Const REG_SZ = 1 ' Unicode nul terminated String
    Public Const REG_DWORD = 4 ' 32-bit number
Public Sub savekey(Hkey As Long, strPath As String)
    Dim keyhand&
    r = RegCreateKey(Hkey, strPath, keyhand&)
    r = RegCloseKey(keyhand&)
End Sub
Public Function getstring(Hkey As Long, strPath As String, strValue As String)
    'EXAMPLE:
    '
    'text1.text = getstring(HKEY_CURRENT_USE
    '     R, "Software\VBW\Registry", "String")
    '
    Dim keyhand As Long
    Dim datatype As Long
    Dim lResult As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
    r = RegOpenKey(Hkey, strPath, keyhand)
    lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)


    If lValueType = REG_SZ Then
        strBuf = String(lDataBufSize, " ")
        lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)


        If lResult = ERROR_SUCCESS Then
            intZeroPos = InStr(strBuf, Chr$(0))


            If intZeroPos > 0 Then
                getstring = Left$(strBuf, intZeroPos - 1)
            Else
                getstring = strBuf
            End If
        End If
    End If
End Function
Public Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
    'EXAMPLE:
    '
    'Call savestring(HKEY_CURRENT_USER, "Sof
    '     tware\VBW\Registry", "String", text1.tex
    '     t)
    '
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(Hkey, strPath, keyhand)
    r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
    r = RegCloseKey(keyhand)
End Sub
Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
    'EXAMPLE:
    '
    'text1.text = getdword(HKEY_CURRENT_USER
    '     , "Software\VBW\Registry", "Dword")
    '
    Dim lResult As Long
    Dim lValueType As Long
    Dim lBuf As Long
    Dim lDataBufSize As Long
    Dim r As Long
    Dim keyhand As Long
    r = RegOpenKey(Hkey, strPath, keyhand)
    lDataBufSize = 4
    lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)


    If lResult = ERROR_SUCCESS Then


        If lValueType = REG_DWORD Then
            getdword = lBuf
        End If
    End If
    r = RegCloseKey(keyhand)
End Function
Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
    'EXAMPLE"
    '
    'Call SaveDword(HKEY_CURRENT_USER, "Soft
    '     ware\VBW\Registry", "Dword", text1.text)
    '
    '
    Dim lResult As Long
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(Hkey, strPath, keyhand)
    lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
    'If lResult <> error_success Then
    '     Call errlog("SetDWORD", False)
    r = RegCloseKey(keyhand)
End Function
Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
    'EXAMPLE:
    '
    'Call DeleteKey(HKEY_CURRENT_USER, "Soft
    '     ware\VBW")
    '
    Dim r As Long
    r = RegDeleteKey(Hkey, strKey)
End Function
Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
    'EXAMPLE:
    '
    'Call DeleteValue(HKEY_CURRENT_USER, "So
    '     ftware\VBW\Registry", "Dword")
    '
    Dim keyhand As Long
    r = RegOpenKey(Hkey, strPath, keyhand)
    r = RegDeleteValue(keyhand, strValue)
    r = RegCloseKey(keyhand)
End Function
 

 Conclusion

Pour voir mes programmes : http://www.robisoft.fr.st (Envois de SMS + compression JPG + Créateur d'installation de vos programmes, ...)
L'envois de SMS remarche correctement.

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources de la même categorie

Source avec Zip REGISTRY READ WRITE LOCAL OU DISTANT AVEC GESTION D'ERREURS ... par philholl
Source .NET (Dotnet) CLASSE .NET DE LECTURE/ÉCRITURE DANS LA BASE DE REGISTRE par NikatorS
Source avec Zip SUPPRESSION MESSAGE SÉCURITÉ À L'UTILISATION D'UN CONTRÔLE A... par mimiZanzan
Source avec Zip Source avec une capture Source .NET (Dotnet) SURVEILLER_CHANGEMENT_REGISTRE par Le Pivert
Source avec Zip Source .NET (Dotnet) AUTO-CONFIGURATION DES PARAMÈTRES DE PROXY D' INTERNET EXPLO... par drahcir

Commentaires et avis

Commentaire de yoman64 le 08/06/2002 18:02:56

Ben sa regarde juste si cest outlook!

Commentaire de Robinwood01 le 08/06/2002 18:34:43

Ben ça regarde laquelle est utilisé par defaut si toi c'est Outlook Express ben ca marque Outlook Express mais tout le monde n'utilise pas Outlook.
De plus la version 0.2 arrive et elle lance l'application de messagerie par defaut ...

Commentaire de yoman64 le 08/06/2002 19:04:41

he scuse javais mal checker la source javais regarder la description:
HKEY_LOCAL_MACHINESOFTWAREClientsMailOutlook Expressshellopencommand

Donc puiske ceta outlook jai cru ke...

Commentaire de jmc70 le 27/01/2003 20:32:15

Très bon code qui m'a rendu service et que j'ai trouvé tout de suite sur le site.
Bon, je réponds à ta question pour lancer la messagerie par défaut... un peu tard sans doute !
Imaginons une variable adresse$ qui contienne une chaîne du type "mailto:truc@machin.fr"
On peut alors écrire quelques lignes de code du type (je détaille en 5 lignes pour que ce soit bien clair pour tout le monde - la première fois application$ contient le nom de la messagerie comme tu l'expliques, la seconde fois, l'accès au programme auquel on passe l'adresse de l'expéditeur en paramètre - comme ça se fait d'habitude avec mailto:) :

If left$(adresse$, 7) = "mailto:" Then
    application$ = getstring(HKEY_LOCAL_MACHINE, "SOFTWAREClientsMail", "")
    application$ = getstring(HKEY_LOCAL_MACHINE, "SOFTWAREClientsMail" & application$ & "protocolsmailtoshellopencommand", "")
    a = Shell(application$ & " " & Mid$(adresse$, 8), 1)
End If
J'ai testé ça en zin98 avec Outlook installé par défaut. Si quelqu'un rencontre des problèmes avec une autre config, ça m'intéresse.
JMC70

Commentaire de jmc70 le 27/01/2003 21:01:10

Oups !!! Une petite erreur dans le passage du paramètre, corrigée ci-dessous.
If left$(adresse$, 7) = "mailto:" Then
    application$ = getstring(HKEY_LOCAL_MACHINE, "SOFTWAREClientsMail", "")
    application$ = getstring(HKEY_LOCAL_MACHINE, "SOFTWAREClientsMail" & application$ + "protocolsmailtoshellopencommand", "")
    a = Shell(left$(application$, Len(application$) - 2) & adresse$, 1)
End If
JMC70

Commentaire de jmc70 le 27/01/2003 21:07:10

Bon, de toute façon, il n'y a rien à faire, tous les anti-slashes sont perdus à la publication sur le site. Je la refais en les remplaçant par des | (vous penserez à remplacer tous les | par des anti-slashes).
If left$(adresse$, 7) = "mailto:" Then
    application$ = getstring(HKEY_LOCAL_MACHINE, "SOFTWARE|Clients|Mail", "")
    application$ = getstring(HKEY_LOCAL_MACHINE, "SOFTWARE|Clients|Mail|" & application$ + "|protocols|mailto|shell|open|command", "")
    a = Shell(left$(application$, Len(application$) - 2) & adresse$, 1)
End If

Commentaire de jmc70 le 01/02/2003 20:30:57

Je me suis aperçu, après test sur différentes machines, que le programme ne fonctionne pas toujours avec les OS supérieurs à Win98 (NT, 2000 ou XP par exemple). J'ai donc retravaillé le code pour proposer une version qui semble tourner sur tous les systèmes Windows (prise en compte de REG_EXPAND_SZ qui est un nouveau type défini dans la base de registre de ces OS).
Bon, j'espère que Robinwood1 ne m'en voudra pas (de toute façon, je signale sa contribution initiale dans mon article qui a le code 7337).

 Ajouter un commentaire




Nos sponsors


Sondage...

CalendriCode

Septembre 2010
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
27282930   

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,031 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales