1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Base de registre
  5. Connaitre la messagerie par defaut d'un utilisateur 0.1

Connaitre la messagerie par defaut d'un utilisateur 0.1

Soyez le premier à donner votre avis sur cette source.

Vue 9 714 fois - Téléchargée 383 fois

Télécharger le projet
Commenter

Description

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 / Exemple : 


'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.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Signaler
Messages postés
77
Date d'inscription
samedi 9 novembre 2002
Statut
Membre
Dernière intervention
6 juillet 2014
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).
Signaler
Messages postés
77
Date d'inscription
samedi 9 novembre 2002
Statut
Membre
Dernière intervention
6 juillet 2014
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
Signaler
Messages postés
77
Date d'inscription
samedi 9 novembre 2002
Statut
Membre
Dernière intervention
6 juillet 2014
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
Signaler
Messages postés
77
Date d'inscription
samedi 9 novembre 2002
Statut
Membre
Dernière intervention
6 juillet 2014
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
Signaler
Messages postés
962
Date d'inscription
samedi 19 janvier 2002
Statut
Membre
Dernière intervention
2 août 2010
 1
he scuse javais mal checker la source javais regarder la description:
HKEY_LOCAL_MACHINESOFTWAREClientsMailOutlook Expressshellopencommand

Donc puiske ceta outlook jai cru ke...
Afficher les 7 commentaires
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.