Soyez le premier à donner votre avis sur cette source.
Snippet vu 6 596 fois - Téléchargée 18 fois
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;
Toute façon j'utilise un webmail, baah Outlook
Cordialement, 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+
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 !
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.