Delphi - ajout de polices (app. console)

Soyez le premier à donner votre avis sur cette source.

Vue 6 802 fois - Téléchargée 447 fois

Description

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

FENETRES
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

Explication sur le dernière MAJ :
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).
FENETRES
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

Les idées d'amélioration me sont venues dans le désordre. Entre nous, je doute que ma prochaine mission me laisse autant de temps à consacrer à codes-sources alors j'en ai profité gouluement.

A bientôt
cs_Forman
Messages postés
600
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1
Wow ça fait un sacré paquet de mises à jour, bon boulot!

À bientôt et bon courage pour la suite.
FENETRES
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

En raison de l'aimable collaboration de Forman, j'ai fait l'effort de poster une mise à jour irréprochable. J'espère avoir réussi.
FENETRES
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

Autrement dit, même la mémoire allouée aux variables n'est pas libérée.

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

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.