METTRE SON PROGRAMME POUR LES MAILS, DANS LES CLIENTS MAIL DE WINDOWS
alec_002
Messages postés3Date d'inscriptionjeudi 18 mars 2004StatutMembreDernière intervention27 octobre 2006
-
27 oct. 2006 à 00:39
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 2014
-
10 mars 2010 à 17:16
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 10 mars 2010 à 17:16
Ha oui c' est vrai, peux tu m' expliquer à quoi ça sert:
Reg.WriteBinaryData('EditFlags',DW, 4);
j' ai utilisé bêtement ...
A+
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 10 mars 2010 à 17:14
Salut DelphiCool,
j' 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!
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;
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;
// if not MailClientExists(RegName)
// then begin
AddClientMail(ParamStr(0), RegName, RegNameNoSpaces, RegDescription, RegShellCommandSend, RegShellCommandMailBox, RegDefaultIcon);
SetClientMailAsDefault(RegName, RegNameNoSpaces);
// end;
DelphiCool
Messages postés455Date d'inscriptionmardi 24 juillet 2001StatutMembreDernière intervention10 mars 2009 9 mars 2010 à 20:46
à l'époque seven et vista n'existaient pas.
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
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 9 mars 2010 à 13:26
Salut DelphiCool,
malheureusement, ç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
DelphiCool
Messages postés455Date d'inscriptionmardi 24 juillet 2001StatutMembreDernière intervention10 mars 2009 27 oct. 2006 à 06:35
Il faut récolter les infos qui se trouve dans ParamStr()
alec_002
Messages postés3Date d'inscriptionjeudi 18 mars 2004StatutMembreDernière intervention27 octobre 2006 27 oct. 2006 à 00:39
Bonjour,
Est-ce que tu pourrais détailler d'avantage la partie où tu dis :
"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."
En effet, lorsque je clique sur un lien mailto, ça ouvre mon soft rien de plus, mais je ne sais pas comment récupérer les informations ... récupérer ce qui se trouve dans le mailto .
10 mars 2010 à 17:16
Reg.WriteBinaryData('EditFlags',DW, 4);
j' ai utilisé bêtement ...
A+
10 mars 2010 à 17:14
j' 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;
9 mars 2010 à 20:46
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
9 mars 2010 à 13:26
malheureusement, ç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
27 oct. 2006 à 06:35
27 oct. 2006 à 00:39
Est-ce que tu pourrais détailler d'avantage la partie où tu dis :
"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."
En effet, lorsque je clique sur un lien mailto, ça ouvre mon soft rien de plus, mais je ne sais pas comment récupérer les informations ... récupérer ce qui se trouve dans le mailto .
D'avance merci pour ta réponse.
alec