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+
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.