1. Accueil
  2. Tous les snippets
  3. Snippets Delphi / Pascal
  4. Votre programme de mail comme client mail par défaut sous windows

Votre programme de mail comme client mail par défaut sous windows

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 940 fois - Téléchargée 20 fois

Commenter

Contenu du snippet

Basé la source de DelphiCool qui ne marche que sous WinXP et inférieur:
http://www.delphifr.com/codes/METTRE-SON-PROGRAMME-MAILS-DANS-CLIENTS-MAIL-WINDOWS_12192.aspx

j' ai voulu poster ma solution comme nouveau code source pour plus de visibilité :)
par contre, j' ai recopié la ligne suivante bêtement sans comprendre à quoi ça sert:
Reg.WriteBinaryData('EditFlags',DW, 4);

Il faut biensûr executer le code en mode Admin pour pouvoir modifier le registry!!!

Maurício

Source / Exemple : 


type
  TWindowsVersion = (wvUnknown, wvWin31, wvWin95, wvWin98, wvWinMe, wvWinNt3, wvWinNt4, wvWin2000, wvWinXP, wvWinVista, wvWin7_Or_Upper);

function VersionWindows: TWindowsVersion;
var
  VersionInfo: TOSVersionInfo;
begin
  RESULT := wvUnknown;

  // charger info
  VersionInfo.dwOSVersionInfoSize:=SizeOf(VersionInfo);
  GetVersionEx(VersionInfo);

  // en fonction de la version
  case VersionInfo.dwPlatformId of
      // win 3.1
      VER_PLATFORM_WIN32S:
        RESULT := wvWin31;

      // win 95 / 98 / me
      VER_PLATFORM_WIN32_WINDOWS:
        begin
          case VersionInfo.dwMinorVersion of
             // win 95
              0: RESULT := wvWin95;
             // win 98
             10: RESULT := wvWin98;
             // win millenium
             90: RESULT := wvWinMe;
          end;
        end;

      // win nt, 2000, XP ...
      VER_PLATFORM_WIN32_NT :
          case VersionInfo.dwMajorVersion of
             // win nt 3
             3: RESULT := wvWinNt3;
             // win nt4
             4: RESULT := wvWinNt4;
             // win 2000 et xp
             5: begin
                  case VersionInfo.dwMinorVersion of
                       // win 2000
                       0: RESULT := wvWin2000;
                       // win xp
                       1: RESULT := wvWinXP;
                  end;
                end;
             // win Vista
             6: RESULT := wvWinVista;
             else
                RESULT := wvWin7_Or_Upper;
          end;
  end;
end;

function MailClientExists(PrgName :string):boolean;
var HK: HKEY;
begin
  RegOpenKey(HKEY_LOCAL_MACHINE,PChar('Software\Clients\Mail\' + PrgName), HK);
  if HK <> 0
  then result := True
  else result := false;
  RegCloseKey(HK);
end;

procedure AddClientMail(PrgFile, PrgName, PrgNameNoSpaces, PrgDescription, ShellCommandSend, ShellCommandMailBox, IconPath: String);
var
  Reg: TRegistry;
  DW: DWord;
begin
  DW := $02;
  Reg := TRegistry.Create;

  try
// *** ENREGISTRER LE PROGRAMME DANS LA BASE DE REGISTRE (permet de visualiser notre appli dans la liste des clientmails possibles sous Windows Vista) *** //
    // Localisation :
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey('Software\RegisteredApplications', True);
    Reg.WriteString(PrgName, 'Software\Clients\Mail\' + PrgName + '\Capabilities');
    Reg.CloseKey;

    // Description :
    if (VersionWindows = wvWinVista) or (VersionWindows = wvWin7_Or_Upper)
    then begin
      Reg.RootKey := HKEY_CLASSES_ROOT;
      Reg.OpenKey('Local Settings\Software\Microsoft\Windows\Shell\MuiCache', True);
      Reg.WriteString(PrgFile, PrgDescription);
      Reg.CloseKey;
    end;

// *** ENREGITRER COMME CLIENT MAILS *** //
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey('Software\Clients\Mail\'+ PrgName, True);
    Reg.WriteString('', PrgName);
    Reg.CloseKey;

    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\Capabilities\FileAssociations', True);
    Reg.writestring('', '');
    Reg.CloseKey;
    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\Capabilities\StartMenu', True);
    Reg.writestring('Mail', PrgName);
    Reg.CloseKey;
    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\Capabilities\URLAssociations', True);
    Reg.writestring('mailto', PrgNameNoSpaces + '.URL.mailto');
    Reg.CloseKey;

    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\Protocols\mailto', True);
    Reg.writestring('', 'URL:MailTo Protocol');
    Reg.WriteBinaryData('EditFlags', DW, 4);
    Reg.writestring('URL Protocol', '');
    Reg.CloseKey;

    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\Protocols\mailto\DefaultIcon', True);
    Reg.writestring('', IconPath);
    Reg.CloseKey;

    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\Protocols\mailto\shell\open\command', True);
    Reg.writestring('', ShellCommandSend);
    Reg.CloseKey;

    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\shell\open\command', True);
    Reg.writestring('', ShellCommandMailBox);
    Reg.CloseKey;

// *** ADITIONNER CLÉ CodeNamePrg.URL.mailto *** //
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Reg.OpenKey(PrgNameNoSpaces + '.URL.mailto', True);
    Reg.WriteString('', 'URL:MailTo Protocol');
    Reg.WriteBinaryData('EditFlags', DW, 4);
    Reg.writestring('URL Protocol', '');
    Reg.CloseKey;

    Reg.OpenKey(PrgNameNoSpaces + '.URL.mailto\DefaultIcon', True);
    Reg.writestring('', IconPath);
    Reg.CloseKey;

    Reg.OpenKey(PrgNameNoSpaces + '.URL.mailto\shell\open\command', True);
    Reg.writestring('', ShellCommandSend);
    Reg.CloseKey;
  finally

  end;

  Reg.Free;
end;

procedure SetClientMailAsDefault(PrgName, PrgNameNoSpaces: String);
var
  Reg: TRegistry;
  DW: DWord;
  S: String;
begin
  DW := $02;

  Reg := TRegistry.Create;

  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey('Software\Clients\Mail', True);
    Reg.WriteString('', PrgName);
    Reg.CloseKey;

    Reg.OpenKey('SOFTWARE\CLASSES\mailto', True);
    Reg.writestring('','URL:MailTo Protocol');
    Reg.WriteBinaryData('EditFlags', DW, 4);
    Reg.writestring('URL Protocol', '');
    Reg.CloseKey;

    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\Protocols\mailto\DefaultIcon', True);
    s := Reg.ReadString('');
    Reg.CloseKey;
    Reg.OpenKey('SOFTWARE\CLASSES\mailto\DefaultIcon', True);
    Reg.writestring('',s);
    Reg.CloseKey;

    Reg.OpenKey('Software\Clients\Mail\' + PrgName + '\Protocols\mailto\shell\open\command', True);
    S := Reg.ReadString('');
    Reg.CloseKey;

    Reg.OpenKey('SOFTWARE\CLASSES\mailto\shell\open\command', True);
    Reg.writestring('', S);
    Reg.CloseKey;

    if (VersionWindows = wvWinVista) or (VersionWindows = wvWin7_Or_Upper)
    then begin
      Reg.RootKey := HKEY_CURRENT_USER;
      Reg.OpenKey('Software\Microsoft\Windows\Shell\Associations\UrlAssociations\mailto\UserChoice', True);
      Reg.WriteString('Progid', PrgNameNoSpaces + '.URL.mailto');
      Reg.CloseKey;
    end;
  finally

  end;

  Reg.Free;
end;

// Appel des fonctions dans notre projet:
  RegName := 'DelphiFr ClientMail';
  RegNameNoSpaces := 'DelphiFr';
  RegDescription := 'DelphiFrSoft Client mail';
  RegShellCommandSend := '"' + ParamStr(0) + '" "%1"';
  RegShellCommandMailBox := '"' + ParamStr(0) + '" -MailBox';
  RegDefaultIcon := '"' + ParamStr(0) + '",-3';

//  if not MailClientExists(RegName)
//  then begin
    AddClientMail(ParamStr(0), RegName, RegNameNoSpaces, RegDescription, RegShellCommandSend, RegShellCommandMailBox, RegDefaultIcon);
    SetClientMailAsDefault(RegName, RegNameNoSpaces);
//  end;

Conclusion :


Voilà,

je ne poste pas comme un projet tout fait pour des raisons évidentes.
Il faudra lire le paramStr(1) de votre projet clientmail pour récupérer le mail cliqué et d' autres informations facultatives comme le sujet et le corps du mail:
mailto:delphicool@monmail.com?subject?hello&cc=coo l@mail.lol&body=et%20voici%20le%20texte%20avec%20d es%20espaces

Je tiens à remercier DelphiCool qui m' a mis sur la voix grâce à son Post!!! :)

A+

A voir également

Ajouter un commentaire Commentaires
fuzzy
3 janv. 2016 à 22:59
Merci, c'est une application considérable
Bacterius
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
 9
16 mars 2010 à 11:36
Ok ^^
Toute façon j'utilise un webmail, baah Outlook

Cordialement, Bacterius !
cs_MAURICIO
Messages postés
2106
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
 5
16 mars 2010 à 10:03
Salut Bacterius,

les clés ne sont que modifiées. Pour ce qui est de revenir aux paramètres antérieurs, il suffit d' ouvrir ton programme de mail comme par exemple Outlook et de le redéfinir comme client mail par défaut ^^

A+
Bacterius
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
 9
16 mars 2010 à 06:45
Salut,
pour rattraper un peu le commentaire déplorable de Amdaklenet, je pense que la ligne "WriteBinaryData(EditFlags, DW, 4)" sert à définir des "flags" indiquant au système qu'il faut prendre le programme de mail choisi par l'utilisateur et non pas charger celui par défaut.

Par contre tu pourras mettre beaucoup de "with ... do", ça allégerait beaucoup le code car il y a beaucoup de Reg.

Et as-tu pensé à l'opération inverse : nettoyer le registre de toutes ces clefs et le remettre comme il était avant ? Car c'est important aussi (à moins que tu ne fasse que créer des nouvelles clefs qui peuvent être effacées, il faudra prendre une version du registre neuve et coder les noms des clefs en dur selon le système d'exploitation).

Cordalement, Bacterius !
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 (cs_MAURICIO)