Discussion :

[MADA BLACK]

Bonjour tout le monde
Svp gentelman
Si vous pouvez m'aider a resoudre ce probleme
J'ai un font nomme (Bubblegum) .. je l'ai posé dans le dossier (Fontart\Debug)
Je veux copier ce font dans le disque (C\windows\Fonts)
Malheureusement j'obtien ce message d'erreur
"L'acces au chemin d'acces C:\windows\Fonts\Bubblegum.TTF est refuse"
Comment resoudre ce probleme svp je ne veux pas copier ce font manuellement
Voici tout mon code :

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
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
Imports System.Runtime.InteropServices
Imports System.IO
Imports Microsoft.Win32
Public Class Form1
    <DllImport("gdi32.dll", EntryPoint:="AddFontResourceW")>
    Private Shared Function AddFontResourceW(<MarshalAs(UnmanagedType.LPWStr)> ByVal lpFilename As String) As Integer
    End Function
 
    <DllImport("gdi32.dll", EntryPoint:="RemoveFontResourceW")>
    Private Shared Function RemoveFontResourceW(<MarshalAs(UnmanagedType.LPWStr)> ByVal lpFileName As String) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    <DllImport("user32.dll", EntryPoint:="SendMessageW")>
    Private Shared Function SendMessageW(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    End Function
    Private Const WM_FONTCHANGE As Integer = &H1D
    Private Const HWND_BROADCAST As Integer = &HFFFF
    Private Sub Transmettre_Font()
        Dim Font_Name As String = "Bubblegum (TrueType)"
        Dim Font_File_Name As String = "Bubblegum.ttf"
 
        Dim SourceFontFile As String = (Application.StartupPath & "\Fontart\Bubblegum.TTF")
 
        Dim DestinationFontFile As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), Path.GetFileName(SourceFontFile))
        If Not File.Exists(DestinationFontFile) Then
            Try
                File.Copy(SourceFontFile, DestinationFontFile) 'copy the font file to the system's font folder
            Catch ex As Exception
                MessageBox.Show(ex.Message, "Copy Failed...")
                Exit Sub
            End Try
            'Add the 'copied' font file to the system's font resource table. If AddFontResource fails it returns 0, otherwise it returns the number of fonts successfully added to the table.
            If AddFontResourceW(DestinationFontFile) > 0 Then
                'open the Fonts registry key with 'write' access.
                Dim FontRegKey As RegistryKey = Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", True)
                If FontRegKey IsNot Nothing Then
                    Try
                        FontRegKey.SetValue(Path.GetFileNameWithoutExtension(DestinationFontFile) & " (TrueType)", Path.GetFileName(DestinationFontFile)) 'add a Value to the Fonts registry key for your font.
                    Catch ex As Exception
                        MessageBox.Show(ex.Message, "Failed To Register Font...")
                    End Try
                    FontRegKey.Close()
                Else
                    MessageBox.Show("Could not open the fonts registry key.", "Failed To Register Font...")
                End If
                'broadcast the WM_FONTCHANGE message to all opened applications to let them know a font resource has changed.
                SendMessageW(New IntPtr(HWND_BROADCAST), WM_FONTCHANGE, IntPtr.Zero, IntPtr.Zero)
            Else
                MessageBox.Show("Could not add the font to the system resource table.", "Install Failed...")
            End If
        Else
            MessageBox.Show("A font with the same filename already exists in the system font folder.", "Install Failed...")
        End If
    End Sub
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Call Transmettre_Font()
    End Sub
End Class

Merci beaucoup d'avance pour l'aide
Cordialement
MADA

[clementmarcotte]

Bonjour,

Je ne suis pas prêt à le jurer, mais je pense que VB doit être lancé en tant qu'administrateur. Sauf horreur de ma part, la sécurité de Windows considère le dossier des polices comme un dossier système.

[MADA BLACK]

Merci beaucoup maitre clementmarcotte pour l'aide
Oui vous avez bien raison .. il s'agit d'administrateur .. mais y'a pas un moyen pour passer l'affaire dans windows\fonts
Cordialement
MADA

[StringBuilder]

Ça fait longtemps que j'ai pas fait ça, mais depuis Windows 95 (donc ça date un peu) normalement le répertoire "windows\fonts" est totalement protégé et géré par le système.

Le fait que tu puisses faire des copiers/coller en interactif dans ce dossier n'est en réalité qu'un artifice de l'exporateur.
Il me semble qu'en BATCH, un copy dans ce dossier ne fonctionne pas non plus.

Si mes souvenirs sont bons, pour placer une font dans ce dossier, il ne faut pas la copier dedans, mais tout simplement l'installer.

Et si mes souvenirs sont bon, il suffit de faire un Process.Start() sur la font elle-même.
=> Ça va alors installer la font sur le système, et la recopier dans "windows\fonts".

[MADA BLACK]

Salut StringBuilder
Merci beaucoup pour vos remarques et impeccables .. logiques conseils
Je vais chercher comment l'installer dans C et j'espère qu'elle fonctionne
Amicalement
MADA

Gentelman..
Franchement j'ai beaucoup cherché sur le net..dans google..dans tous les titres ayant ( installe font Vb net )
Mais je n'ai pas réussi
Si vous avez quelques suggestions svp
Amicalement
MADA

[wallace1]

Bonsoir,

Si tu ne trouves pas de réponses en vbnet cherches en c# et adaptes le code en vbnet :
https://stackoverflow.com/questions/...92546#21992546

Ceci fonctionne :

Code :

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

1
2
3
4
 
        Dim shell = New Shell32.Shell()
        Dim fontFolder As Shell32.Folder = shell.NameSpace(&H14)
        fontFolder.CopyHere("D:\Bureau\LATINWD.TTF")

AU PRÉALABLE IL FAUT :

1- Importer dans les références du projet C:\Windows\SysWow64\Shell32.dll pour un OS 64bits ou C:\Windows\System32\Shell32.dll pour un OS 32bits
2- Paramétrer le fichier Manifest en RequireAdministrator.


++