8 Replies - 392 Views - Last Post: 18 October 2017 - 12:03 AM Rate Topic: -----

#1 Dreamfall  Icon User is offline

  • D.I.C Head

Reputation: 1
  • View blog
  • Posts: 111
  • Joined: 26-January 15

Install fonts in windows if it is missing

Posted 17 October 2017 - 01:06 AM

Hi guys, I used an application with personal fonts, and I wanted to add the possibility, when launch the application, to silently install the fonts if they are missing in used computer, so you do not have to manually install them on the computers with missing fonts.

I use this code and start the application in Administrator mode, but cannot install any fonts.

    <DllImport("gdi32")>
    Public Shared Function AddFontResource(ByVal lpFileName As String) As Integer
    End Function

    <DllImport("user32.dll")>
    Public Shared Function SendMessage(ByVal hWnd As Integer, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    End Function

    <DllImport("kernel32.dll", SetLastError:=True)>
    Shared Function WriteProfileString(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Integer
    End Function

    Private Sub My_Load(sender As Object, e As EventArgs) Handles Me.Load

        'Dim Font_Name As String = "unispace bd.ttf"
        Dim Check_Font As String = 0
        For Each Check_Font In IO.Directory.GetFiles(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), "unispace bd.ttf") : Next
        If (Check_Font.Length > 1) = False Then

            'SaveFromResources(Path.Combine(Application.StartupPath, "Fonts\unispace bd.ttf"), My.Resources.unispace_bd)

            Dim Fonts_Source As String = Path.Combine(Application.StartupPath, "Fonts\unispace bd.ttf")
            Dim Fonts_Install As String = My.Computer.FileSystem.CombinePath(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), "unispace bd.ttf")

            Dim Ret As Integer
            Dim Res As Integer
            Dim FontPath As String

            Const WM_FONTCHANGE As Integer = &H1D
            Const HWND_BROADCAST As Integer = &HFFFF

            FontPath = Fonts_Install.ToString

            Ret = AddFontResource(Fonts_Source.ToString)
            Res = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
            Ret = WriteProfileString("Fonts", Path.GetFileName(FontPath) & " (TrueType)", FontPath.ToString)
            'Application.Restart()
            MsgBox(Path.GetFileName(Fonts_Source) & "Installed")
        End If

    End Sub



I hope in help to fix the problem and find a solution, Thank you

Is This A Good Question/Topic? 0
  • +

Replies To: Install fonts in windows if it is missing

#2 andrewsw  Icon User is online

  • the case is sol-ved
  • member icon

Reputation: 6380
  • View blog
  • Posts: 25,775
  • Joined: 12-December 12

Re: Install fonts in windows if it is missing

Posted 17 October 2017 - 01:12 AM

Do you get any errors?

Your loop on line 17 doesn't achieve anything, because the looping is ended by : Next on the same line. It is an empty loop.
Was This Post Helpful? 1
  • +
  • -

#3 Dreamfall  Icon User is offline

  • D.I.C Head

Reputation: 1
  • View blog
  • Posts: 111
  • Joined: 26-January 15

Re: Install fonts in windows if it is missing

Posted 17 October 2017 - 01:25 AM

The "For Next" loop only serves to verify the presence of the font in "c:\windows\fonts", if missing will be installed in the conditional "If (Check_Font.Length> 1) = False Then" but I do not think is the problem.

This post has been edited by Dreamfall: 17 October 2017 - 01:26 AM

Was This Post Helpful? 0
  • +
  • -

#4 IronRazer  Icon User is offline

  • Custom Control Freak
  • member icon

Reputation: 1447
  • View blog
  • Posts: 3,682
  • Joined: 01-February 13

Re: Install fonts in windows if it is missing

Posted 17 October 2017 - 12:45 PM

The first thing i would HIGHLY suggest doing is turning Option Strict on. You will see at least one or two Type Conversion Errors in your code. For example, the line below is declaring a String type variable but, you are assigning an Integer type number to it.
Dim Check_Font As String = 0


As andrewsw has already mentioned, your For Next loop (shown below) is not doing anything at all. It is not changing the length of the string assigned to your 'Check_Font' String variable.

Step through this in your head (and debug it too), you would have found this problem already if you learn to debug your code. Anyways, in the first line below you know that 'Check_Font' is "0" which is only 1 character in length. Then the next line, the loop adds nothing to the Check_Font string. Finally, the If Then statement is checking if the length of the Check_Font string is greater than 1. The length will never be greater than 1 so, your code to install the font will never get run.
    Dim Check_Font As String = 0
    For Each Check_Font In IO.Directory.GetFiles(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), "unispace bd.ttf") : Next
    If (Check_Font.Length > 1) = False Then



I am not sure why you are making it so complicated for yourself when all you need to do is check if the file exists in the system's font folder. That can be easily done using the File.Exists Method...
        Dim FontFilename As String = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), "unispace bd.ttf")
        If Not IO.File.Exists(FontFilename) Then

            'do font install...

        End If



I would also not recommend using the WriteProfileString function because, as mentioned in that link, it is only provided for compatibility with 16-bit versions of windows. In any modern day windows version, you should be adding the font to the registry to make the installation persistent, not just installed for the current session. You can read that at that link also.

The registry key you want to create a new Value in is "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts". You can read about that in the AddFontResource function document.
Was This Post Helpful? 1
  • +
  • -

#5 modi123_1  Icon User is offline

  • Suitor #2
  • member icon



Reputation: 13493
  • View blog
  • Posts: 53,899
  • Joined: 12-June 08

Re: Install fonts in windows if it is missing

Posted 17 October 2017 - 12:52 PM

I would like to hope you are announcing you are installing stuff on the user's machine, and not just totally being silent about it.
Was This Post Helpful? 1
  • +
  • -

#6 Dreamfall  Icon User is offline

  • D.I.C Head

Reputation: 1
  • View blog
  • Posts: 111
  • Joined: 26-January 15

Re: Install fonts in windows if it is missing

Posted 17 October 2017 - 03:20 PM

View PostIronRazer, on 17 October 2017 - 12:45 PM, said:

The first thing i would HIGHLY suggest doing is turning Option Strict on. You will see at least one or two Type Conversion Errors in your code. For example, the line below is declaring a String type variable but, you are assigning an Integer type number to it.
Dim Check_Font As String = 0


As andrewsw has already mentioned, your For Next loop (shown below) is not doing anything at all. It is not changing the length of the string assigned to your 'Check_Font' String variable.

Step through this in your head (and debug it too), you would have found this problem already if you learn to debug your code. Anyways, in the first line below you know that 'Check_Font' is "0" which is only 1 character in length. Then the next line, the loop adds nothing to the Check_Font string. Finally, the If Then statement is checking if the length of the Check_Font string is greater than 1. The length will never be greater than 1 so, your code to install the font will never get run.
    Dim Check_Font As String = 0
    For Each Check_Font In IO.Directory.GetFiles(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), "unispace bd.ttf") : Next
    If (Check_Font.Length > 1) = False Then



I am not sure why you are making it so complicated for yourself when all you need to do is check if the file exists in the system's font folder. That can be easily done using the File.Exists Method...
        Dim FontFilename As String = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), "unispace bd.ttf")
        If Not IO.File.Exists(FontFilename) Then

            'do font install...

        End If



I would also not recommend using the WriteProfileString function because, as mentioned in that link, it is only provided for compatibility with 16-bit versions of windows. In any modern day windows version, you should be adding the font to the registry to make the installation persistent, not just installed for the current session. You can read that at that link also.

The registry key you want to create a new Value in is "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts". You can read about that in the AddFontResource function document.



Hi Razer, those were just tests, Of course I tried the "File.Exists" method, even though the "For-Next" loop works fine for checking the names of the fonts installed in "C:\Windows\Fonts". The condition "If (Check_Font.Length> 1) = False" returned the false value if the name is missing, the string search in the loop was not executed by" * .ttf "extension but by the name specific "unispace bd.ttf".
Nevertheless I have solved it in other ways, but I did not understand why I not view the font name in the "C:\Windows\Fonts" folder once installed and functioning in the system used. :neat:/>

View Postmodi123_1, on 17 October 2017 - 12:52 PM, said:

I would like to hope you are announcing you are installing stuff on the user's machine, and not just totally being silent about it.


:eek:/>
Was This Post Helpful? 0
  • +
  • -

#7 IronRazer  Icon User is offline

  • Custom Control Freak
  • member icon

Reputation: 1447
  • View blog
  • Posts: 3,682
  • Joined: 01-February 13

Re: Install fonts in windows if it is missing

Posted 17 October 2017 - 04:27 PM

You know, now that i look again at the code you had to check if the file existed, i have to admit that i was wrong. I did not look at it close enough i guess but, that would fill the string with the font filename if it existed. However, putting it in a loop is not necessary. 8)

Quote

but I did not understand why I not view the font name in the "C:\Windows\Fonts" folder once installed and functioning in the system used

I don't see anywhere in the code that you copied the font file to the system's Font folder. If you don't copy it there, you won't find it there.

Normally you would follow these steps to install a font...

(1) Copy the font file to the system's font folder.
(2) Call the AddFontResource function, passing it the filename of the file in the system's font folder. This adds it to the systems font table
(3) Add the font name to the registry as i mentioned in my prior post.
(4) Call the SenMessage function to broadcast the WM_FONTCHANGE message to notify all opened applications.

However, you can install the font without copying it to the system's font folder (that is what you where doing). There are some restrictions with doing this that is mentioned in the msdn documents. Doing it without copying the font to the system's folder means that you would have to check the Font registry key for a value of the file to see if it is installed or not. If you decide to use the WriteProfileString function instead which i would not recommend, then you would need to use the GetProfileString function to see if it is installed or not.
Was This Post Helpful? 1
  • +
  • -

#8 IronRazer  Icon User is offline

  • Custom Control Freak
  • member icon

Reputation: 1447
  • View blog
  • Posts: 3,682
  • Joined: 01-February 13

Re: Install fonts in windows if it is missing

Posted 17 October 2017 - 05:50 PM

Just to give a simple example that registers the font in the registry as i and MS recommend doing on newer OS's, I threw this together. I tested it and commented it a little to try helping understand what it is doing. It seems to work pretty good on my end.

If you look at the msdn documents for the AddFontResource function, you can see that the function can be used for several different font types but, this example is only good for (.ttf) TrueType fonts. However, it would not take much to modify the registry Value name to add the correct font type to it automatically such as (TrueType), (OpenType), or others. I have it set to a fixed string of "TrueType" in this example.

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 Button_InstallFont_Click(sender As Object, e As EventArgs) Handles Button_InstallFont.Click

        Dim SourceFontFile As String = "C:\TestFolder\Fonts\Ancient Geek.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
End Class


Was This Post Helpful? 1
  • +
  • -

#9 Dreamfall  Icon User is offline

  • D.I.C Head

Reputation: 1
  • View blog
  • Posts: 111
  • Joined: 26-January 15

Re: Install fonts in windows if it is missing

Posted 18 October 2017 - 12:03 AM

Ahhhheee .... I'm :stupid:/>/> , I don't know why but I was convinced that with the only Marshal method, we copied automatically also the Font file into the system font directory.
I missed the copy parts... :lol: , even if with only the creation of the registry keys the Fonts worked perfectly.

Dim Font_Name As String = "Unispace-Bold (TrueType)"
        Dim Font_File_Name As String = "unispace bd.ttf"
        If My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", Font_Name.ToString, Nothing) Is Nothing = True Then
            Dim Fonts_Source As String = Path.Combine(Application.StartupPath, "MyFonts", Font_File_Name.ToString)
            Dim Fonts_Install As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Fonts), Font_File_Name.ToString)
            Dim RetKey As Integer
            Dim Res As Integer
            Const WM_FONTCHANGE As Integer = &H1D
            Const HWND_BROADCAST As Integer = &HFFFF
            RetKey = AddFontResource(Fonts_Source.ToString)
            Res = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
            RetKey = WriteProfileString("Fonts", Font_Name.ToString, Fonts_Install.ToString)
            Application.DoEvents()
            Application.Restart()
        Else
            Msgbox....Fonts AllReady Installed In Keyreg..
        End If



Thanks Razer, there is nothing to do, here you do make the difference with others, you are the best. :^:/>/>

This post has been edited by Dreamfall: 18 October 2017 - 12:10 AM

Was This Post Helpful? 0
  • +
  • -

Page 1 of 1