Accueil > > > DELPHI - AJOUT DE POLICES (APP. CONSOLE)
DELPHI - AJOUT DE POLICES (APP. CONSOLE)
Information sur la source
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
- 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.
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(V S.85).aspx - Fonction « SHGetPathFromIDList » http://msdn.microsoft.com/en-us/library/bb762194(V S.85).aspx 2. Ajout d'une police - Fonction « AddFontResource » (Windows GDI) http://msdn.microsoft.com/en-us/library/ms534231.a spx - Fonction « SendMessage » http://msdn.microsoft.com/en-us/library/ms644950(V S.85).aspx 3. Informations sur les codes erreurs (MS-DOS) http://support.microsoft.com/kb/74463
Fichier Zip
Historique
- 25 novembre 2008 17:28:23 :
- Description
- 25 novembre 2008 17:30:25 :
- Conclusion
- 25 novembre 2008 17:31:23 :
- Faute de frappe
- 25 novembre 2008 17:41:44 :
- Idem
- 25 novembre 2008 19:50:00 :
- Nom initial du répertoire source
- 25 novembre 2008 20:05:52 :
- Description
- 26 novembre 2008 08:26:42 :
- Présentation
- 26 novembre 2008 09:35:03 :
- Description (adresse du répertoire source)
- 26 novembre 2008 10:09:09 :
- Faute de frappe
- 26 novembre 2008 11:07:32 :
- Zip
- 26 novembre 2008 11:09:52 :
- Erreur de manip
- 26 novembre 2008 17:29:14 :
- Libération de la mémoire
- 26 novembre 2008 17:42:40 :
- Zip
- 26 novembre 2008 21:32:17 :
- Conclusion (rappel)
- 26 novembre 2008 23:02:08 :
- Commentaire
- 26 novembre 2008 23:13:17 :
- CS (commentaire)
- 27 novembre 2008 09:36:51 :
- Rappel (instruction halt)
- 27 novembre 2008 11:26:20 :
- Code source (instruction ExitCode)
- 27 novembre 2008 14:20:26 :
- Faute de frappe
- 27 novembre 2008 15:21:36 :
- Commentaire CS (code de sortie =1)
- 27 novembre 2008 16:08:56 :
- CS avec msg d'erreur
- 27 novembre 2008 16:46:10 :
- Nouvelle capture
- 27 novembre 2008 16:51:41 :
- Erreur manip.
- 27 novembre 2008 16:56:50 :
- Faute de frappe
- 27 novembre 2008 17:06:28 :
- Trop maladroit !
- 27 novembre 2008 18:13:33 :
- Erreur inattendue = 250 (en dehors de l'intervalle MS-DOS)
- 28 novembre 2008 10:35:30 :
- Ajout d'une option en ligne de commande (afficher message)
- 28 novembre 2008 10:42:05 :
- Zip
- 28 novembre 2008 10:53:41 :
- Err. de frappe
- 28 novembre 2008 11:11:19 :
- Description (options)
- 28 novembre 2008 12:28:25 :
- Présentation
- 28 novembre 2008 12:37:10 :
- Idem
- 28 novembre 2008 14:14:33 :
- Capture avec message
- 28 novembre 2008 16:17:31 :
- dpr sans gestionnaire de mémoire
- 01 décembre 2008 13:17:56 :
- fichier dpr plus générique que la source (ajout de la fonction isListedExt)
- 01 décembre 2008 14:04:14 :
- dpr (erreur de frappe)
- 01 décembre 2008 14:11:48 :
- Idem
- 01 décembre 2008 15:34:14 :
- Conclusion (source & dpr)
- 01 décembre 2008 16:12:51 :
- Condition d'affectation pour code de sortie = 250 (erreur inattendue)
- 02 décembre 2008 15:07:17 :
- MAJ : suppression de la copie du fichier.
Sur les versions actuelles de Windows, la copie du fichier déclenche l'ajout de polices.
- 02 décembre 2008 15:28:03 :
- Err manip
- 02 décembre 2008 16:24:01 :
- MAJ précédente erronée. La copie physique des fichiers est nécessaire.
- 02 décembre 2008 16:38:32 :
- Numérotation
- 02 décembre 2008 16:44:50 :
- Trop maladroit
- 02 décembre 2008 16:48:07 :
- zip
- 02 décembre 2008 17:32:42 :
- Purée... j'ai enfin compris. Y pas à dire, sans Microsoft, on s'ennuierait !
Cas particuliers d'un fichiers qui possèderait la bonne extension mais ne serait pas un fichier de fontes (ex. DUMMY.TTF).
- 02 décembre 2008 17:35:26 :
- Purée... j'ai enfin compris. Y pas à dire, sans Microsoft, on s'ennuierait !
Cas particuliers d'un fichiers qui possèderait la bonne extension mais ne serait pas un fichier de fontes (ex. DUMMY.TTF).
- 02 décembre 2008 19:12:00 :
- Condition de branchement. A force, j'en ai perdu la boule !
- 02 décembre 2008 23:49:34 :
- Suppression du fichier copié (fct de la version de Windows) si aucune ressource ajoutée
- 03 décembre 2008 00:03:20 :
- Commentaire CS
- 03 décembre 2008 12:16:56 :
- Conclusion (fichier DUMMY.TTF)
- 03 décembre 2008 14:45:26 :
- Msg : nbre de polices ajoutées
- 03 décembre 2008 14:58:32 :
- Conclusion
- 03 décembre 2008 15:31:33 :
- Présentation
- 03 décembre 2008 16:25:26 :
- Conclusion
- 04 décembre 2008 09:45:54 :
- Description (second paramètre)
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Help 2 ! Ajout de retour chariot ! [ par toto ]
Salut,Comment faire pour ajouter un retour chariot qd je veux dans un memo SVP ?MErci !toto
Mon premier ajout de source !! :o) [ par XJapan ]
Voila !!!!! J'ai deposer ma premiere Source !!!!!! :o))))))Mais je me demande si y a pas un soucie avec l'envoie de fichier zip... Parce k'il n'est pa
ajout de champs a une requete [ par tgomas ]
Bonjour,je voudrais pouvoir modifier une requete dynamiquement. J'arrive a modifier la requete sql, mais je n'arrive pas a ajouter des champs à mon ob
Ajout de ligne sur DBGrid [ par webazard ]
Bonjour, Voila je commence tout juste sur dephi et je voudrais savoir comment ajouter de lignes dans un DBGrid ou me dire quoi d'autre utiliser, mon s
ajout dynamique de menuitems [ par bgK ]
Salut à tous,J'ai créé un prog utilisant des plugins et qui ajoute un item dans le menu à chaque plugin trouvé.mais je ne sais pas comment faire pour
Ajout dynamique de ToolButton [ par SuperNoizo ]
J'aimerais ajouter des ToolButtons pendant l'execution de mon soft qq1 pourrait-il m'aider ?MerciSupeRNoiZo
Paramètres par adresse et non par valeur [ par Bruto ]
J'utilise qq fonctions et procédures qui ont pour but de de générer un numéro CLSID.Le prob est que je n'arrive pas à passer mes paramêtres par adress
ajout/suppression de programme [ par MyC ]
Bonjour, je cherche le moyen de pouvoir ajouter un élément dans "ajout/suppression de programme" à partir de code delphi, lors de l'installation d'un
URGENT ! Dbase ajout d'enrgistrement [ par kristof708 ]
sltComment puis je faire pour ajouter un enregistrement a un endroit precis de ma Dbase
Envoi d'un message VK_TAB (Tabulation) [ par seb92 ]
BonjourJ'essaye d'envoyer une tabulation à une fenêtre dont je connais le handle. Si les caractères alpha-numériques fonctionnent, il n'en est pas de
|
Derniers Blogs
PARUTION DE MON LIVRE SUR WPF 4PARUTION DE MON LIVRE SUR WPF 4 par odewit
La 2e édition de mon livre sur WPF sort aujourd'hui en version numérique et lundi en version papier :-)
L'ouvrage présente de façon approfondie les fonctionnalités de WPF 4 : graphisme 2D et 3D, animation, multimédia, interfaces utilisateur, databind...
Cliquez pour lire la suite de l'article par odewit EDM : COMMENT UTILISER L'HORIZONTAL ENTITY SPLITTINGEDM : COMMENT UTILISER L'HORIZONTAL ENTITY SPLITTING par Matthieu MEZIL
Une des raisons pour lesquelles j'adore l'Entity Framework est la puissance de son mapping. Beaucoup de développeurs pour ne pas dire la plus part n'en n'ont pas conscience. Pour rappel, j'ai réalisé des videos (en anglais) sur le mapping . Certains scena...
Cliquez pour lire la suite de l'article par Matthieu MEZIL [WP7DEV][REACTIVE] RENDRE LES REACTIVE EXTENSIONS PLUS STABLES[WP7DEV][REACTIVE] RENDRE LES REACTIVE EXTENSIONS PLUS STABLES par jay
Lorsque l'on développe des applications .NET, les exceptions non gérées dans des threads ont le désagréable effet de terminer le processus courant.
Dans l'exemple suivant.......(read more) ...
Cliquez pour lire la suite de l'article par jay WINDBG / SOS / PSSCOR2 : FAILED TO LOAD DATA ACCESS DLL (MSCORDACWKS)WINDBG / SOS / PSSCOR2 : FAILED TO LOAD DATA ACCESS DLL (MSCORDACWKS) par coq
Ceux d'entre nous qui analysent des dumps d'applications .NET (notamment ceux créés via WER après un crash) en dehors de l'environnement initial ont probablement tous été confrontés au moins une fois au message suivant, à la saisie d'une commande SOS ...
Cliquez pour lire la suite de l'article par coq
Logiciels
Microsoft Office (2010)MICROSOFT OFFICE (2010)Microsoft Office 2010 offre de nouveaux moyens flexibles et puissants pour optimiser votre travai... Cliquez pour télécharger Microsoft Office SeaMonkey (2.0.7)SEAMONKEY (2.0.7)Le projet SeaMonkey est issu d'un effort communautaire pour developper une application tout en un... Cliquez pour télécharger SeaMonkey Safari (5.0.2)SAFARI (5.0.2)Le navigateur d'Apple a lui aussi été mis à jour, aussi bien dans sa mouture Windows que celle po... Cliquez pour télécharger Safari Mozilla FireFox (4.0 béta 5)MOZILLA FIREFOX (4.0 BéTA 5)Firefox 4.0 béta 5
L'une des nouveautés visibles les plus attendues réside sans doute dans l'a... Cliquez pour télécharger Mozilla FireFox Mozilla Firefox (3.6.9)MOZILLA FIREFOX (3.6.9)Firefox 3.6.9 corrige les problèmes suivants :
* Introduced support for the X-FRAME-OPTION... Cliquez pour télécharger Mozilla Firefox
|