'requires: 
'a multiline textbox named "info"
'a button named "btnOpen"
'a textbox named "textbox1"
'
Option Explicit On
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions
Imports Microsoft.VisualBasic

Public Class Form1

    Private Sub btnOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOpen.Click

        Dim path As String

        OpenFileDialog1.Filter = "SoundFont 2 files (*.sf2)|*.sf2|All files (*.*)|*.*"
        OpenFileDialog1.FilterIndex = 1
        OpenFileDialog1.DefaultExt = "sf2"
        OpenFileDialog1.FileName = ""
        If OpenFileDialog1.ShowDialog(Me) = DialogResult.Cancel Then Exit Sub
        path = OpenFileDialog1.FileName

        Dim WholeFile As Byte() = My.Computer.FileSystem.ReadAllBytes(path)

        Dim a As Integer = 0
        Dim l As Integer = 0
        Dim BasePtr As Long = 0
        Dim PresetListSize As Long = 0
        Dim FindTag As String = ""

        Dim pBank As String = ""
        Dim pIndex As String = ""
        Dim pName As String = ""

        Dim temp As Integer = 0

        Dim SB As New StringBuilder

' go to end of file

        BasePtr = UBound(WholeFile) - 4

' search backwards for "phdr" tag, because the presets seem to be at the end of  the file
        Do
            FindTag = Chr(WholeFile(BasePtr))
            FindTag = FindTag & Chr(WholeFile(BasePtr + 1))
            FindTag = FindTag & Chr(WholeFile(BasePtr + 2))
            FindTag = FindTag & Chr(WholeFile(BasePtr + 3))
            If FindTag = "phdr" Then Exit Do
            BasePtr = BasePtr - 1
            If BasePtr = 0 Then Exit Do
        Loop

        BasePtr = BasePtr + 4

        Dim iL As Integer
        Dim h4 As String = Hex$(WholeFile(BasePtr))
        Dim h3 As String = Hex$(WholeFile(BasePtr + 1))
        Dim h2 As String = Hex$(WholeFile(BasePtr + 2))
        Dim h1 As String = Hex$(WholeFile(BasePtr + 3))

        PresetListSize = "&h" + h1 + h2 + h3 + h4

        Dim PArray(PresetListSize \ 38) As String

        BasePtr = BasePtr + 4

        Dim p(19) As Char
        For l = 1 To PresetListSize Step 38
            pName = ""
            For iL = 0 To 19
                p(iL) = Chr(WholeFile(BasePtr + iL).ToString)
            Next

            For I As Integer = 0 To 19
                Dim c As Char = p(I)
                If c <> " "c Then
                    If Char.IsWhiteSpace(c) Or Char.IsControl(c) Or c = Chr(13) Then
                        p(I) = "~"c
                    Else
                        p(I) = c
                    End If
                End If
                If p(I) = "~" Then Exit For
                pName = pName + p(I)
            Next I

            BasePtr = BasePtr + 20

            h2 = Hex$(WholeFile(BasePtr))
            h1 = Hex$(WholeFile(BasePtr + 1))
            temp = "&h" + h1 + h2
            pIndex = temp.ToString("000")

            BasePtr = BasePtr + 2

            h2 = Hex$(WholeFile(BasePtr))
            h1 = Hex$(WholeFile(BasePtr + 1))
            temp = "&h" + h1 + h2
            pBank = temp.ToString("000")

            BasePtr = BasePtr + 2

            BasePtr = BasePtr + 14

            PArray(a) = pBank + ":" + pIndex + ":" + pName

            a = a + 1

        Next

        Array.Sort(PArray)

' put "options " into textbox for [popup]
        info.Text = "options "

        For l = 0 To UBound(PArray)
            If InStr(PArray(l), "EOP") > 0 Then Exit For
            If Not PArray(l) Is Nothing Then



                SB.Append(PArray(l))
                SB.AppendLine()

            End If


        Next


' get the applications path
        Dim SP As String = System.IO.Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().CodeBase)
        SP = New Uri(SP).LocalPath
        TextBox1.Text = SP

' replace spaces with hyphen
        For l = 0 To SB.Length - 1
            If SB(l) = Chr(32) Then SB(l) = Chr(45)
        Next
' replace carriage return with space
        For l = 0 To SB.Length - 1
            If SB(l) = Chr(13) Then SB(l) = Chr(32)
        Next
        info.Text = info.Text & SB.ToString
        Erase WholeFile
        WholeFile = Nothing

' write [popup] compatible text

        Using writer As StreamWriter = New StreamWriter(SP & "\soundfont2.txt")

            writer.WriteLine(info.Text)

        End Using

    End Sub


End Class