Delphi - ajout de polices (app. console)

0/5 (13 avis)

Vue 7 561 fois - Téléchargée 511 fois

Télécharger le projet
Commenter

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
Télécharger le projet

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
2 déc. 2008 à 17:56
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
28 nov. 2008 à 15:28
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
28 nov. 2008 à 15:18
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
28 nov. 2008 à 14:54
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
28 nov. 2008 à 11:19
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).
S'inscrire maintenant

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.

Du même auteur (FENETRES)