|
 Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
 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(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
 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
Sources en rapport avec celle ci
 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
|
 Téléchargements
Logiciels à télécharger sur le même thème :
Comparez les prix Nouvelle version
|