DELPHI - AJOUT DE POLICES (APP. CONSOLE)
FENETRES
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009
-
26 nov. 2008 à 13:46
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009 - 2 déc. 2008 à 17:56
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009 - 2 déc. 2008 à 17:56
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/48536-delphi-ajout-de-polices-app-console
https://codes-sources.commentcamarche.net/source/48536-delphi-ajout-de-polices-app-console
2 déc. 2008 à 17:56
1. La copie physique d'un fichier est nécessaire. Sans elle, il n'est pas visible dans le répertoire système Fonts.
2. Malgré sa copie physique effective, une erreur de copie sera retournée si vous tentez de copier un fichier possédant une fausse extension de police (ex. DUMMY.TTF).
28 nov. 2008 à 15:28
A bientôt
28 nov. 2008 à 15:18
À bientôt et bon courage pour la suite.
28 nov. 2008 à 14:54
28 nov. 2008 à 11:19
Sinon dans sa dernière mise à jour, hormis la suppression de l'instruction halt, le projet a été enrichi avec l'ajout d'une option affichage (/M).
27 nov. 2008 à 10:13
Le danger potentiel est encore plus important que je l'imaginais. En activant le gestionnaire de mémoire, j'ai des fuites de mémoire lorsque le répertoire source est manquant (code de sortie = 251). Cette instruction halt est à proscrire purement et simplement !
Je corrige une nouvelle fois la source en adoptant ExitCode définitivement.
Merci d'avoir éclairé ma lanterne à ce point
26 nov. 2008 à 18:23
Cordialement,
26 nov. 2008 à 17:33
Encore merci
26 nov. 2008 à 16:45
A bientôt
26 nov. 2008 à 16:19
Par contre dans mon cas, à part le code de sortie, l'erreur doit être silencieuse.
Cordialement,
26 nov. 2008 à 15:41
Effectivement, je n'avais pas vu le problème que tu invoques à juste titre (FindFirst, FindClose).
Merci de ta contribution
PS : je me souviens avoir hésité à l'époque entre l'utilisation de ExitCode et Halt sans avoir vu le risque d'une fuite de mémoire.
26 nov. 2008 à 15:01
Tiens, ça je ne le savais pas...
Si j'ai bien compris ça installe un certain nombre de polices TrueType situées dans un répertoire donné, c'est bien ça? Le code a l'air propre et bien écrit en tout cas (même si un peu trop court à mon gout :-)
Une petite remarque: la procédure Halt est un peu brutale, et peut causer des "memory leaks". Exemple: après ton FindFirst, s'il y a un problème, tu vas quitter avant d'avoir fait FindClose.
À mon avis il doit être possible de réécrire ta procédure principale en utilisant la variable ReturnValue (qui permet de spécifier une valeur de retour pour ton application) et des branchements judicieusement placés pour libérer toutes les resources, même en cas d'échec.
Une autre solution aussi souvent utilisée en Delphi est l'utilisation des exceptions, et try...finally. Exemple:
program Win32_AddFonts;
{*******************************************************}
{ }
{ FENETRES pour Codes-Sources }
{ Autre publication interdite }
{ }
{ Programme de type console d'ajout de polices }
{ }
{*******************************************************}
{$APPTYPE CONSOLE}
uses
Windows, SysUtils, Shlobj, Messages;
var
FullPath, SrceFolder, DestFolder: string;
SrceFile, DestFile: string;
Info: TSearchRec;
FontsAdded: Integer;
const
FOLDER_NAME_FONTS='Fonts';
PATH_DELIMITER='\';
function SpecialFolder(AFolder: Integer): string;
{ Retourne un répertoire système Windows }
var
PItem: pItemIDList;
SpecialPath: array[0..MAX_PATH] of Char;
begin
if (SHGetSpecialFolderLocation(GetActiveWindow, AFolder, PItem)=0) and SHGetPathFromIDList(PItem, SpecialPath) then
Result:=SpecialPath
else
raise Exception.Create('Impossible de trouver le répertoire système des polices');
end;
begin
{ Initialisation des variables }
FullPath:=''; SrceFolder:=''; DestFolder:='';
SrceFile:=''; DestFile:=''; FontsAdded:=0;
try
{ Répertoire source }
if (ParamCount=1) and (DirectoryExists(ParamStr(1))) then
FullPath:=ParamStr(1)
else
FullPath:=ExtractFilePath(ParamStr(0)) + FOLDER_NAME_FONTS;
if not DirectoryExists(FullPath) then begin
{ Le code de sortie est égal à 251 (le répertoire source est manquant.) }
ExitCode:=251;
raise Exception.Create('Le répertoire source est manquant');
end;
SrceFolder:=FullPath;
{ Répertoire de destination }
FullPath:='';
try
FullPath:=SpecialFolder(CSIDL_FONTS);
if not DirectoryExists(FullPath) then
raise Exception.Create('Le répertoire de destination est manquant');
except
{ Le code de sortie est égal à 253 (le répertoire de destination est manquant.) }
ExitCode:=253;
raise;
end;
DestFolder:=FullPath;
{ Copie des fichiers (droit d'accès) et ajout des polices }
if (FindFirst(SrceFolder + PATH_DELIMITER + '*.ttf', faAnyFile, Info)=0) then begin
try
repeat
if (Info.Attr and faDirectory)=0 then begin
DestFile:= DestFolder + PATH_DELIMITER + Info.FindData.cFileName;
if not FileExists(DestFile) then begin
SrceFile:=SrceFolder + PATH_DELIMITER + Info.FindData.cFileName;
if not CopyFile(PChar(SrceFile), PChar(DestFile), False) then begin
{ Le code de sortie est égal à 254 (la copie d'un fichier a échoué.) }
ExitCode:=254;
raise Exception.CreateFmt('La copie du fichier %s a échoué',[Info.Name]);
end;
if AddFontResource(PChar(DestFile))=0 then begin
{ Le code de sortie est égal à 255 (l'ajout d'une police a échoué.) }
ExitCode:=255;
raise Exception.CreateFmt('L''ajout de la police %s a échoué',[Info.Name]);
end;
inc(FontsAdded);
end;
end;
until FindNext(Info)<>0;
finally
FindClose(Info);
end;
{ Diffusion de la mise à jour pour toutes les applications ouvertes }
if (FontsAdded>0) then SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end else begin
{ Le code de sortie est égal à 252 (le répertoire source est vide.) }
ExitCode:=252;
raise Exception.Create('le répertoire source est vide');
end;
except
on e:Exception do begin
{ Le programme retourne 1 (erreur inattendue) }
if ExitCode=0 then
ExitCode:=1;
WriteLn('Erreur : ',e.Message);
end else begin
ExitCode:=1;
WriteLn('Erreur inattendue');
end;
end;
end.
26 nov. 2008 à 13:46
« Etre ignorant de son ignorance est la maladie de l'ignorant. »
Amos Bronson Alcott