Parce qu'elles diffusent couramment des mises à jour par télétransmission, les DSI réclament souvent des programmes de type console.
Le mini projet actuel avait pour objet de créer un outil permettant d'uniformiser à distance la liste des polices installées sur les postes clients.
Options en ligne de commande :
...\Win32_AddFonts.exe [Adresse du répertoire source]
/M
Comme indiqué ci-avant, l'adresse du répertoire source peut être déclarée en ligne de commande. Par défaut, un répertoire nommé « Fonts » sera recherché à l'emplacement de l'exécutable. Le second paramètre optionnel correspond à une option d'affichage d'un message d'information précisant le nombre de polices ajoutées ou l'erreur rencontrée.
Source / 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;
isMsgDisplayed: boolean;
const
FOLDER_NAME_FONTS='Fonts';
PATH_DELIMITER='\';
OPTION_MSG='/M';
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) then begin
SHGetPathFromIDList(PItem, SpecialPath);
Result:=SpecialPath;
end else
Result:='';
end;
begin
{ Initialisation des variables }
FullPath:=''; SrceFolder:=''; DestFolder:='';
SrceFile:=''; DestFile:=''; FontsAdded:=0;
isMsgDisplayed:=False;
try
{ Option d'affichage en ligne de commande }
case ParamCount of
1: if (ParamStr(1)=OPTION_MSG) then isMsgDisplayed:=True;
2: if (ParamStr(2)=OPTION_MSG) then isMsgDisplayed:=True;
end;
{ Répertoire source }
if (ParamCount>0) and (ParamStr(1)<>OPTION_MSG) 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;
// Supprimer les caractères accentués sous MS-DOS (OEM)
raise Exception.Create('le repertoire source est manquant.');
end else
SrceFolder:=FullPath;
{ Répertoire de destination }
FullPath:='';
FullPath:=SpecialFolder(CSIDL_FONTS);
if not DirectoryExists(FullPath) then begin
// Le code de sortie est égal à 253 (le répertoire de destination est manquant)
ExitCode:=253;
raise Exception.Create('le repertoire de destination est manquant.');
end else
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
DestFile:= DestFolder + PATH_DELIMITER + Info.FindData.cFileName;
if not FileExists(DestFile) then begin
SrceFile:=SrceFolder + PATH_DELIMITER + Info.FindData.cFileName;
if CopyFile(PChar(SrceFile), PChar(DestFile), False) then
if (AddFontResource(PChar(SrceFile))=0) then begin
// Supprimer le fichier copié sans création d'une nouvelle police
if FileExists(DestFile) then DeleteFile(DestFile);
// 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 echoue.',[Info.Name]);
end else
inc(FontsAdded)
else 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 echoue.',[Info.Name]);
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 repertoire source est vide.');
end;
{ Nombre de polices ajoutées }
if isMsgDisplayed then
case FontsAdded of
0: WriteLn(ExtractFileName(ParamStr(0)), ' : aucune police n''a ete ajoutee.');
1: WriteLn(ExtractFileName(ParamStr(0)), ' : seule la police ', ExtractFilename(DestFile), ' a ete ajoutee.');
else
WriteLn(ExtractFileName(ParamStr(0)), ' : ', IntToStr(FontsAdded), ' polices ont ete ajoutees.');
end;
except
on E:Exception do begin
if isMsgDisplayed then WriteLn('Erreur : ', E.Message);
// Le code de sortie sera égal à 250 si une erreur inattendue se produit
if (ExitCode=0) then ExitCode:=250;
end;
end;
end.
Conclusion :
Compiler le programme et renommer le répertoire source (Fonts_00 en Fonts) pour exécuter le fichier batch (test.bat) d'ajout de polices (cf. capture).
Par rapport à la source, le fichier « dpr » comprend en plus une fonction qui permet de filter les fichiers à traiter par leurs extensions (ttf, fon, otf...).
Le fichier « DUMMY.TTF » est un faux fichier de fontes permettant de tester la suppression d'un éventuel fichier copié sans création d'une nouvelle police.
Rappel : l'instruction halt provoque une sortie anormale sans libération de la mémoire ni finalisation.
Bibliographie Microsoft (MSDN) :
1. Recherche du répertoire système « Fonts »
- Fonction « SHGetSpecialFolderLocation »
http://msdn.microsoft.com/en-us/library/bb762203(VS.85).aspx
- Fonction « SHGetPathFromIDList »
http://msdn.microsoft.com/en-us/library/bb762194(VS.85).aspx
2. Ajout d'une police
- Fonction « AddFontResource » (Windows GDI)
http://msdn.microsoft.com/en-us/library/ms534231.aspx
- Fonction « SendMessage »
http://msdn.microsoft.com/en-us/library/ms644950(VS.85).aspx
3. Informations sur les codes erreurs (MS-DOS)
http://support.microsoft.com/kb/74463
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.