Mettre son programme pour les mails, dans les clients mail de windows
Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 381 fois - Téléchargée 37 fois
Contenu du snippet
Voici comment mettre son maileur perso préféré
dans les clients mail de windows.
Vous pourrez aussi le mettre par déault.
Quand vous cliquerais sur un lien Mailto:...., ce sera votre prog qui prendras la main.
Sauf pour AOL, qui boycott tout, grrrrrrr
pour mettre son prog dans les Clients Mail:
AjoutClientMail('Mail DelphiCool', 'paramsrtr(0)', 'chemin de votre icone');
pour mettre votre maileur par défaut:
SetMailClientAsDefault('Mail DelphiCool');
la ligne de commande sera dans paramstr(1)
PS : si vous avez un liens de ce type : mailto:delphicool@monmail.com?subject?hello&cc=cool@mail.lol&body=et%20voici%20le%20texte%20avec%20des%20espaces.
il faudras décortiquer la ligne de commande
pour extraire tout les element
et remplacer les %.. par le caractere adequat (c'est de l'hexa)
dans les clients mail de windows.
Vous pourrez aussi le mettre par déault.
Quand vous cliquerais sur un lien Mailto:...., ce sera votre prog qui prendras la main.
Sauf pour AOL, qui boycott tout, grrrrrrr
Source / Exemple :
unit ClientMail_unit;
interface
uses Registry, windows, Sysutils;
Function MailClientExists(Nom :string):boolean;
Procedure AjoutClientMail(Nom, CheminEtParametre, Icone :string);
Procedure SetMailClientAsDefault(Nom :string);
implementation
{¨¨¨¨¨¨¨¨ Set Mail Client As Default ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨}
Procedure SetMailClientAsDefault(Nom :string);
var Reg :TRegistry;
DW :DWord;
s :string;
begin
if not MailClientExists(Nom) then
begin
MessageBoxA(0, PChar('Le Client Mail : '+ Nom + ', n''existe pas!' ),'erreur',0);
exit;
end;
DW := $02;
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('Software\Clients\Mail',True);
Reg.WriteString('', Nom);
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\' + Nom + '\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\' + Nom + '\Protocols\MailTo\Shell\open\command', True);
s := Reg.ReadString('');
Reg.CloseKey;
Reg.OpenKey('SOFTWARE\CLASSES\mailto\shell\open\command', True);
Reg.writestring('',s);
Reg.Free;
end;
{¨¨¨¨¨¨¨¨ Mail Client Exists ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨}
Function MailClientExists(Nom :string):boolean;
var HK :HKEY;
begin
RegOpenKey(HKEY_LOCAL_MACHINE,PChar('Software\Clients\Mail\'+ Nom),HK);
if HK <> 0 then result := True
else result := false;
RegCloseKey(HK);
end;
{¨¨¨¨¨¨¨¨ Ajout Client Mail ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨}
Procedure AjoutClientMail(Nom, CheminEtParametre, Icone :string);
var Reg :TRegistry;
buf :Array[0..3]of byte;
DW :DWord;
begin
DW := $02;
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('Software\Clients\Mail\'+ Nom, True);
Reg.WriteString('', Nom);
Reg.CloseKey;
Reg.OpenKey('Software\Clients\Mail\' + Nom + '\Protocols\MailTo', True);
Reg.writestring('','URL:MailTo Protocol');
Reg.WriteBinaryData('EditFlags',DW, 4);
Reg.writestring('URL Protocol','');
Reg.CloseKey;
Reg.OpenKey('Software\Clients\Mail\' + Nom + '\Protocols\MailTo\DefaultIcon', True);
Reg.writestring('',icone);
Reg.CloseKey;
Reg.OpenKey('Software\Clients\Mail\' + Nom + '\Protocols\MailTo\Shell\open\command', True);
Reg.writestring('','"' + CheminEtParametre + '" "%1"');
Reg.CloseKey;
Reg.OpenKey('Software\Clients\Mail\' + Nom + '\Shell\open\command', True);
Reg.writestring('',CheminEtParametre + ' -MailBox');
Reg.CloseKey;
Reg.Free;
end;
end.
Conclusion :
pour mettre son prog dans les Clients Mail:
AjoutClientMail('Mail DelphiCool', 'paramsrtr(0)', 'chemin de votre icone');
pour mettre votre maileur par défaut:
SetMailClientAsDefault('Mail DelphiCool');
la ligne de commande sera dans paramstr(1)
PS : si vous avez un liens de ce type : mailto:delphicool@monmail.com?subject?hello&cc=cool@mail.lol&body=et%20voici%20le%20texte%20avec%20des%20espaces.
il faudras décortiquer la ligne de commande
pour extraire tout les element
et remplacer les %.. par le caractere adequat (c'est de l'hexa)
A voir également
- Mettre son programme pour les mails, dans les clients mail de windows
- Programmer des socket en c++ builder client/server socket - Conseils pratiques - C / C++ / C++.NET
- Envoi de mail avec windows 2003 server avec cdo (cdonts a ete remplacé..) - Codes sources - ASP / ASP.NET (E-mail)
- Programme avec tous les raccourcis des fenetres de propriétées windows (affichage,internet...) - Codes sources - Visual Basic / VB.NET (Système)
- Run-control vous alerte des qu'un programme s'enregistre pour se lancer au demarrage de windows xp - Codes sources - Visual Basic / VB.NET (Système)
- Delphi / Pascal : Votre programme de mail comme client mail par défaut sous windows - CodeS S - Guide
- Messages postés
-
2106
- Date d'inscription
- mardi 10 décembre 2002
- Statut
- Modérateur
- Dernière intervention
- 15 décembre 2014
5Reg.WriteBinaryData('EditFlags',DW, 4);
j' ai utilisé bêtement ...
A+
- Messages postés
-
2106
- Date d'inscription
- mardi 10 décembre 2002
- Statut
- Modérateur
- Dernière intervention
- 15 décembre 2014
5j' ai fini par résoudre le problème pour Vista et je suppose pour Win7 aussi...
Par contre, il faut malheureusement lancer l' appli comme Administrateur afin de modifier le Registry.
J' ai essayé de trouver comment executer seulement un bout de code en mode administrateur mais sans succès ...
Le souci que j' ai est que si mon appli est déjà ouverte, le système lance une nouvelle instance :(
Si tu as des solutions, je suis preneur!
A+
type
TWindowsVersao = (wvUnknown, wvWin31, wvWin95, wvWin98, wvWinMe, wvWinNt3, wvWinNt4, wvWin2000, wvWinXP, wvWinVista, wvWin7_Or_Upper);
function VersaoWindows: TWindowsVersao;
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 (VersaoWindows wvWinVista) or (VersaoWindows 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;
// *** ADICIONNER 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 (VersaoWindows wvWinVista) or (VersaoWindows 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;
Pour l'instant je n'ai pas trop le temps de chercher, de plus il faut que je m'installe un vista ou un seven.
XP Addicted :)
Mais si quelqu'un trouve l'info, je modifirai le source
- Messages postés
-
2106
- Date d'inscription
- mardi 10 décembre 2002
- Statut
- Modérateur
- Dernière intervention
- 15 décembre 2014
5malheureusement, ça ne marche pas sous Windows Vista (même en mode Administrator).
Par contre, sous XP, ça marche très bien!
J' ai essayé de le faire marcher sous Vista mais j' y arrive pas, si tu pouvais m' aider ...
A+
PS: ça manque de commentaires
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.