Discussion :

[istam3]

Bonjour, à la base ça paraît tout simple, c'est un code d'installation de fichier pour une appli, et si le fichier est de type ttf alors on en fait aussi une copie dans C:\Windows\Fonts pour l'installation.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
  for i := 0 to FFileList.Count - 1 do
    with TFile(FFileList[i]) do
    begin
      src_file:= IncludeTrailingPathDelimiter(src_dir + OrPath) + OrName;
      dst_file:= IncludeTrailingPathDelimiter(dst_dir + OrPath) + OrName;
 
      if not DirectoryExists(ExtractFilePath(dst_file)) then
        ForceDirectories(ExtractFilePath(dst_file));
 
      CopyFile(PWideChar(src_file), PWideChar(dst_file), not Overwrite);
 
      if (UpperCase(ExtractFileExt(src_file)) = '.TTF') then  {...1}
      begin
        dst_file:= 'C:\Windows\Fonts\' + ExtractFileName(src_file);
        CopyFile(PWideChar(src_file), PWideChar(dst_file), not Overwrite);
      end;
    end;

Cela fonctionne sous Xp mais pas du tout sous Windows 7 (pas encore testé sous Vista). Je pense que c'est encore une histoire de droit, mais comment résoudre ça par code ?

J'ai de plus essayer en ligne de commande et avec un fichier batch. Résultat identique pas de problème sous XP, impossible sous Windows 7.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

copy "c:\applicodebarre\code128.ttf" "c:\windows\fonts\code128.ttf"

Quelques recherche google non rien donné (en tout cas rien en ce qui concerne la faisabilité par code, tout parle de copier-coller), hormis c'est 2 lignes de commandes supplémentaires censé permettre de s'octroyer des droits sur le dossier C:\Windows\Fonts avant la copie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
takeown /f C:/Windows/Fonts /r /d o
icacls C:/Windows/Fonts /grant administrateurs:F /T

mais déjà, dés la première ligne j'ai le message suivant

Erreur: l'utilisateur actuellement connecté n'a pas les privilèges d'appartenance sur le fichier (ou dossier) "C:\Windows\Fonts"

Ce qui paraît logique puisque je TAPE une ligne de commande pour obtenir ces privilèges !!

Bref pour le moment j'en suis à ça

Toutes suggestions, que ce soit en Pascal, ligne de commande, voir même en vb, seront les bienvenues.

[istam3]

Et bien j'ai finalement réussi après avoir fait remonter ce post
http://www.developpez.net/forums/d80...windows-fonts/

qui propose de passer par l'Api Windows

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
      if (UpperCase(ExtractFileExt(src_file)) = '.TTF') then  {...1}
      begin
        if (AddFontResource(PWideChar(dst_file)) <> 0) then
          DispAndLogMsg('Reg Ok: ' + dst_file)
        else
          DispAndLogMsg('Reg Ko: ' + dst_file);
      end;

et ça marche sous Xp, Vista et Seven.

[ILP]

Pour installer mes polices, j'utilise du code qui ressemble à ça :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
// -> http://msdn.microsoft.com/library/ms534231
// Copie le fichier de police dans le répertoire Fonts de Windows
CopyFile('Police.ttf', Pchar(RepertoiresSpeciaux(CSIDL_FONTS) + '\Police.ttf'), False);
// Ajoute la police à la liste des polices de Windows
AddFontResource(Pchar(RepertoiresSpeciaux(CSIDL_FONTS) + '\Widgets.ttf'));
// Envoi un message à tous les programmes ouverts pour leur annoncer
// qu'une police à été ajoutée
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

Avec la fonction RepertoiresSpeciaux :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
const
  // Constantes pour la fonction RepertoiresSpeciaux()
  CSIDL_DESKTOP                 = $0000;
  CSIDL_INTERNET                = $0001;
  CSIDL_PROGRAMS                = $0002;
  CSIDL_CONTROLS                = $0003;
  CSIDL_PRINTERS                = $0004;
  CSIDL_PERSONAL                = $0005;
  CSIDL_FAVORITES               = $0006;
  CSIDL_STARTUP                 = $0007;
  CSIDL_RECENT                  = $0008;
  CSIDL_SENDTO                  = $0009;
  CSIDL_BITBUCKET               = $000a;
  CSIDL_STARTMENU               = $000b;
  CSIDL_DESKTOPDIRECTORY        = $0010;
  CSIDL_DRIVES                  = $0011;
  CSIDL_NETWORK                 = $0012;
  CSIDL_NETHOOD                 = $0013;
  CSIDL_FONTS                   = $0014;
  CSIDL_TEMPLATES               = $0015;
  CSIDL_COMMON_STARTMENU        = $0016;
  CSIDL_COMMON_PROGRAMS         = $0017;
  CSIDL_COMMON_STARTUP          = $0018;
  CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
  CSIDL_APPDATA                 = $001a;
  CSIDL_PRINTHOOD               = $001b;
  CSIDL_ALTSTARTUP              = $001d;
  CSIDL_COMMON_ALTSTARTUP       = $001e;
  CSIDL_COMMON_FAVORITES        = $001f;
  CSIDL_INTERNET_CACHE          = $0020;
  CSIDL_COOKIES                 = $0021;
  CSIDL_HISTORY                 = $0022;
  CSIDL_COMMON_APPDATA          = $0023;
  CSIDL_WINDOWS                 = $0024;
  CSIDL_SYSTEM                  = $0025;
  CSIDL_PROGRAM_FILES           = $0026;
  CSIDL_MYPICTURES              = $0027;
  CSIDL_PROFILE                 = $0028;
  CSIDL_SYSTEMX86               = $0029;
  CSIDL_PROGRAM_FILESX86        = $002A;
  CSIDL_PROGRAM_FILES_COMMON    = $002B;
  CSIDL_PROGRAM_FILES_COMMONX86 = $002C;
  CSIDL_COMMON_TEMPLATES        = $002D;
  CSIDL_COMMON_DOCUMENTS        = $002E;
  CSIDL_COMMON_ADMINTOOLS       = $002F;
  CSIDL_ADMINTOOLS              = $0030;
  CSIDL_FLAG_CREATE             = $8000;
  CSIDL_FLAG_DONT_VERIFY        = $4000;
  CSIDL_FLAG_MASK               = $FF00;
 
// Récupère l'adresse des répertoires spéciaux de Windows
function RepertoiresSpeciaux(Repertoire: Integer): String;
var
  SFolder:     pItemIDList;
  SpecialPath: array[0..MAX_PATH] of Char;
begin
  // -> http://msdn.microsoft.com/library/bb762203
  SHGetSpecialFolderLocation(Application.Handle, Repertoire, SFolder);
  // -> http://msdn.microsoft.com/library/bb762194
  SHGetPathFromIDList(SFolder, SpecialPath);
  Result := StrPas(SpecialPath);
end;