Imports System.IO

Imports System.Text



Private Function GetFontNameFromFile(ByVal fontFilePath As String) As String

    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



        'バージョンが1.0じゃないなら終了 

        If ttOffsetTable.uMajorVersion <> 1 Or ttOffsetTable.uMinorVersion <> 0 Then

            Return strRet

        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("SHIFT-JIS")

            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 strRet



        '***************Nameテーブルヘッダ読込*************** 

        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



        '***************Nameテーブルレコード読込*************** 

        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



            'NameID = 1 がフォント名らしい 

            If ttRecord.uNameID <> 1 Then Continue 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 = Encoding.GetEncoding("SHIFT-JIS")

            strRet = enc.GetString(buf)



            If strRet <> "" Then Exit For



            fs.Seek(nPos, SeekOrigin.Begin)

        Next



        Return strRet

    End Using

End Function