Хорошо, это будет много кода ниже. Прежде всего, это из-за структур TTF и Endianess файлов TTF. Код изначально не мой, он взят из нескольких источников, которые я перенес на VB.NET и изменил несколько вещей вокруг. См. эту страницу для версии C ++, которая получает имя шрифта.
Этот код считывает реестр для установленных шрифтов (будь то в% windir% \ fonts или где-либо еще), фильтрует только те, которые имеют расширение .ttf (например, .fon и .ttc игнорируются), а затем пропускает эти шрифты. пути к файлам подпрограммы GetFontDetails, которая считывает и получает имя шрифта (uNameID # 1) и семейство Font Sub (aka Style, uNameID # 2). Если вы заинтересованы в том, чтобы получить больше свойств, чем те, перейдите по адресу name - Naming Table на веб-сайте Microsoft для типографики и найдите в своем браузере Имена имен . Затем он выводит имя шрифта, подсемейство шрифта и путь шрифта к окну консоли.
Создайте новое консольное приложение VB.NET, вставьте приведенный ниже код поверх модуля Module1 и нажмите F5 .
Без лишних слов:
Imports System.Linq
Imports System.IO
Imports System.Text
Module Module1
Sub Main()
Dim allInstalledFonts = From e In My.Computer.Registry.LocalMachine.OpenSubKey("Software\\Microsoft\\Windows NT\\CurrentVersion\\Fonts").GetValueNames
Select My.Computer.Registry.LocalMachine.OpenSubKey("Software\\Microsoft\\Windows NT\\CurrentVersion\\Fonts").GetValue(e)
Dim ttfFonts = From e In allInstalledFonts.Where(Function(e) e.ToString.EndsWith(".ttf") Or e.ToString.EndsWith(".otf"))
Dim ttfFontsPaths = From e In ttfFonts.Select(Function(e) If(Path.GetPathRoot(e.ToString) = "", Environment.GetFolderPath(Environment.SpecialFolder.Fonts) & "\" & e.ToString, e.ToString))
Dim fonts = From e As String In ttfFontsPaths Select GetFontDetails(e.ToString)
For Each f As InstalledFont In fonts
Console.WriteLine("Name: " & f.FontName & ", SubFamily: " & f.FontSubFamily & ", Path: " & f.FontPath)
Next
Console.ReadLine()
End Sub
Public Class InstalledFont
Property FontName As String
Property FontSubFamily As String
Property FontPath As String
Sub New(ByVal name As String, ByVal subfamily As String, ByVal path As String)
FontName = name
FontSubFamily = subfamily
FontPath = path
End Sub
End Class
Public Function GetFontDetails(ByVal fontFilePath As String) As InstalledFont
Dim FontName As String = String.Empty
Dim FontSubFamily As String = String.Empty
Dim encStr = "UTF-8"
Dim strRet As String = String.Empty
Using fs As New FileStream(fontFilePath, FileMode.Open, FileAccess.Read)
Dim ttOffsetTable As New TT_OFFSET_TABLE
With ttOffsetTable
.uMajorVersion = ReadUShort(fs)
.uMinorVersion = ReadUShort(fs)
.uNumOfTables = ReadUShort(fs)
.uSearchRange = ReadUShort(fs)
.uEntrySelector = ReadUShort(fs)
.uRangeShift = ReadUShort(fs)
End With
If ttOffsetTable.uMajorVersion <> 1 Or ttOffsetTable.uMinorVersion <> 0 Then
Return Nothing
End If
Dim tblDir As New TT_TABLE_DIRECTORY
Dim found As Boolean = False
For i As Integer = 0 To ttOffsetTable.uNumOfTables
With tblDir
.Initialize()
fs.Read(.szTag, 0, .szTag.Length)
.uCheckSum = ReadULong(fs)
.uOffset = ReadULong(fs)
.uLength = ReadULong(fs)
End With
Dim enc As Encoding = Encoding.GetEncoding(encStr)
Dim s As String = enc.GetString(tblDir.szTag)
If StrComp(s, "name") = 0 Then
found = True
Exit For
End If
Next
If Not found Then Return Nothing
fs.Seek(tblDir.uOffset, SeekOrigin.Begin)
Dim ttNTHeader As New TT_NAME_TABLE_HEADER
With ttNTHeader
.uFSelector = ReadUShort(fs)
.uNRCount = ReadUShort(fs)
.uStorageOffset = ReadUShort(fs)
End With
Dim ttRecord As New TT_NAME_RECORD
For j As Integer = 0 To ttNTHeader.uNRCount
With ttRecord
.uPlatformID = ReadUShort(fs)
.uEncodingID = ReadUShort(fs)
.uLanguageID = ReadUShort(fs)
.uNameID = ReadUShort(fs)
.uStringLength = ReadUShort(fs)
.uStringOffset = ReadUShort(fs)
End With
If ttRecord.uNameID > 2 Then Exit For
Dim nPos As Integer = fs.Position
fs.Seek(tblDir.uOffset + ttRecord.uStringOffset + ttNTHeader.uStorageOffset, SeekOrigin.Begin)
Dim buf(ttRecord.uStringLength - 1) As Byte
fs.Read(buf, 0, ttRecord.uStringLength)
Dim enc As Encoding
If ttRecord.uEncodingID = 3 Or ttRecord.uEncodingID = 1 Then
enc = Encoding.BigEndianUnicode
Else
enc = Encoding.UTF8
End If
strRet = enc.GetString(buf)
If ttRecord.uNameID = 1 Then FontName = strRet
If ttRecord.uNameID = 2 Then FontSubFamily = strRet
fs.Seek(nPos, SeekOrigin.Begin)
Next
Return New InstalledFont(FontName, FontSubFamily, fontFilePath)
End Using
End Function
Public Structure TT_OFFSET_TABLE
Public uMajorVersion As UShort
Public uMinorVersion As UShort
Public uNumOfTables As UShort
Public uSearchRange As UShort
Public uEntrySelector As UShort
Public uRangeShift As UShort
End Structure
Public Structure TT_TABLE_DIRECTORY
Public szTag() As Byte
Public uCheckSum As UInt32
Public uOffset As UInt32
Public uLength As UInt32
Public Sub Initialize()
ReDim szTag(3)
End Sub
End Structure
Public Structure TT_NAME_TABLE_HEADER
Public uFSelector As UShort
Public uNRCount As UShort
Public uStorageOffset As UShort
End Structure
Public Structure TT_NAME_RECORD
Public uPlatformID As UShort
Public uEncodingID As UShort
Public uLanguageID As UShort
Public uNameID As UShort
Public uStringLength As UShort
Public uStringOffset As UShort
End Structure
Private Function ReadChar(ByRef fs As FileStream, ByVal characters As Integer) As UInt16
Dim s(characters) As String
Dim buf(CByte(s.Length)) As Byte
buf = ReadAndSwap(fs, buf.Length)
Return BitConverter.ToUInt16(buf, 0)
End Function
Private Function ReadByte(ByRef fs As FileStream) As UInt16
Dim buf(10) As Byte
buf = ReadAndSwap(fs, buf.Length)
Return BitConverter.ToUInt16(buf, 0)
End Function
Private Function ReadUShort(ByRef fs As FileStream) As UInt16
Dim buf(1) As Byte
buf = ReadAndSwap(fs, buf.Length)
Return BitConverter.ToUInt16(buf, 0)
End Function
Private Function ReadULong(ByRef fs As FileStream) As UInt32
Dim buf(3) As Byte
buf = ReadAndSwap(fs, buf.Length)
Return BitConverter.ToUInt32(buf, 0)
End Function
Private Function ReadAndSwap(ByRef fs As FileStream, ByVal size As Integer) As Byte()
Dim buf(size - 1) As Byte
fs.Read(buf, 0, buf.Length)
Array.Reverse(buf)
Return buf
End Function
End Module