smps2mid.frm

VERSION 5.00
Begin VB.Form MainForm 
   BorderStyle     =   1  'Fest Einfach
   Caption         =   "SMPS -> MID"
   ClientHeight    =   4485
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   6240
   Icon            =   "smps2mid.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   299
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   416
   StartUpPosition =   3  'Windows-Standard
   Begin VB.CheckBox NoKeyDisplcCheck 
      Caption         =   "Ignore Key &Displacement"
      Height          =   255
      Left            =   3000
      TabIndex        =   21
      Top             =   2040
      Width           =   3015
   End
   Begin VB.CheckBox BoostYMCheck 
      Caption         =   "boost YM2612 volume"
      Height          =   255
      Left            =   3000
      TabIndex        =   6
      Top             =   1680
      Value           =   1  'Aktiviert
      Width           =   3015
   End
   Begin VB.CheckBox NoteVelCheck 
      Caption         =   "use Note &Velocity (else Volume Ctrl.)"
      Height          =   255
      Left            =   3000
      TabIndex        =   5
      Top             =   1320
      Width           =   3015
   End
   Begin VB.TextBox MemBaseText 
      Alignment       =   1  'Rechts
      Height          =   285
      Left            =   4440
      MaxLength       =   4
      TabIndex        =   11
      Text            =   "0000"
      Top             =   2715
      Width           =   855
   End
   Begin VB.TextBox BaseOfsText 
      Alignment       =   1  'Rechts
      Height          =   285
      Left            =   4440
      MaxLength       =   7
      TabIndex        =   17
      Text            =   "000000"
      Top             =   3435
      Width           =   855
   End
   Begin VB.CommandButton AddPntButton 
      Caption         =   "&Add to List"
      Height          =   255
      Left            =   3120
      TabIndex        =   18
      Top             =   3840
      Width           =   1215
   End
   Begin VB.TextBox PntLstText 
      Alignment       =   1  'Rechts
      Height          =   285
      Left            =   4440
      MaxLength       =   7
      TabIndex        =   14
      Text            =   "000000"
      Top             =   3075
      Width           =   855
   End
   Begin VB.ComboBox GameList 
      Height          =   315
      ItemData        =   "smps2mid.frx":030A
      Left            =   4200
      List            =   "smps2mid.frx":030C
      Style           =   2  'Dropdown-Liste
      TabIndex        =   8
      Top             =   2355
      Width           =   1815
   End
   Begin VB.CommandButton ClearLstButton 
      Caption         =   "&Clear List"
      Height          =   255
      Left            =   4680
      TabIndex        =   19
      Top             =   3840
      Width           =   1215
   End
   Begin VB.TextBox MidiResText 
      Alignment       =   1  'Rechts
      Height          =   285
      Left            =   3720
      TabIndex        =   4
      Text            =   "0"
      Top             =   930
      Width           =   615
   End
   Begin VB.CommandButton S2M_Button 
      Caption         =   "&SMPS2MID"
      Height          =   495
      Left            =   4560
      TabIndex        =   2
      Top             =   240
      Width           =   1215
   End
   Begin VB.ListBox FileList 
      Height          =   3960
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2655
   End
   Begin VB.CommandButton OpenButton 
      Caption         =   "&Open File"
      Height          =   495
      Left            =   3000
      TabIndex        =   1
      Top             =   240
      Width           =   1215
   End
   Begin VB.Label Hex3Label 
      Caption         =   "0x"
      Height          =   255
      Left            =   4200
      TabIndex        =   10
      Top             =   2760
      Width           =   255
   End
   Begin VB.Label MemBaseLabel 
      Caption         =   "Z80 Mem &Base:"
      Height          =   255
      Left            =   3000
      TabIndex        =   9
      Top             =   2760
      Width           =   1215
   End
   Begin VB.Label BaseOfsLabel 
      Caption         =   "Base O&ffset:"
      Height          =   255
      Left            =   3000
      TabIndex        =   15
      Top             =   3480
      Width           =   1215
   End
   Begin VB.Label Hex2Label 
      Caption         =   "0x"
      Height          =   255
      Left            =   4200
      TabIndex        =   16
      Top             =   3480
      Width           =   255
   End
   Begin VB.Label HexLabel 
      Caption         =   "0x"
      Height          =   255
      Left            =   4200
      TabIndex        =   13
      Top             =   3120
      Width           =   255
   End
   Begin VB.Label PntLstLabel 
      Caption         =   "&Pointer List:"
      Height          =   255
      Left            =   3000
      TabIndex        =   12
      Top             =   3120
      Width           =   1215
   End
   Begin VB.Label STypeLabel 
      Caption         =   "SMPS &Type:"
      Height          =   255
      Left            =   3000
      TabIndex        =   7
      Top             =   2400
      Width           =   1095
   End
   Begin VB.Label GameLabel 
      Height          =   255
      Left            =   120
      TabIndex        =   20
      Top             =   4140
      UseMnemonic     =   0   'False
      Width           =   5895
   End
   Begin VB.Label MidiResLabel 
      Caption         =   "Midi Res:"
      Height          =   255
      Left            =   3000
      TabIndex        =   3
      Top             =   960
      Width           =   735
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' 96 chars per line
'23456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
'00000000111111111122222222223333333333444444444455555555556666666666777777777788888888889999999

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (ByRef hpvDest As Any, ByRef hpvSource As Any, ByVal cbCopy As Long)


Private Const FCC_SEGA As Long = &H41474553
Private Const FCC_SONI As Long = &H494E4F53
Private Const FCC_OERG As Long = &H6772654F
Private Const FCC_CHAO As Long = &H4F414843
Private Const FCC_RIST As Long = &H54534952
Private Const FCC_TMR_ As Long = &H20524D54
Private Const FCC_SNCB As Long = &H42434E53
    

Private Type SMPS_ENTRY
    Offset As Long
    Length As Long
End Type

Private Const FILE_TYPE_BIN As Byte = &H0
Private Const FILE_TYPE_ROM As Byte = &H1
Private Const FILE_TYPE_BAD As Byte = &HFF

Private Const ROMTYPE_S1 As Byte = &H0
Private Const ROMTYPE_SMPSPLAY As Byte = &H80
Private Const ROMTYPE_S2B As Byte = &H1
Private Const ROMTYPE_S2 As Byte = &H2
Private Const ROMTYPE_S3 As Byte = &H3
Private Const ROMTYPE_S3K As Byte = &H4
Private Const ROMTYPE_S3D As Byte = &H5
Private Const ROMTYPE_SC As Byte = &H6
Private Const ROMTYPE_GEN_68K As Byte = &H7
Private Const ROMTYPE_RST As Byte = &H8
Private Const ROMTYPE_S1SMS As Byte = &H10
Private Const ROMTYPE_S2SMS As Byte = &H11
Private Const ROMTYPE_S2GG As Byte = &H12
Private Const ROMTYPE_SCSMS As Byte = &H13
Private Const ROMTYPE_SCGG As Byte = &H14
Private Const ROMTYPE_STTGG As Byte = &H15
Private Const ROMTYPE_S96 As Byte = &H16
Private Const ROMTYPE_SLAB As Byte = &H17
Private Const ROMTYPE_SSPINSMS As Byte = &H18
Private Const ROMTYPE_SCD As Byte = &H20
Private Const ROMTYPE_KC As Byte = &H30
Private Const ROMTYPE_UNKNOWN As Byte = &HFE
Private Const ROMTYPE_NONE As Byte = &HFF

Private Const MUS_PNT_S1 As Long = &H71A9C
Private Const MUS_PNT_OERG As Long = &H1704&
Private Const MUS_PNT_S2_1 As Long = &HF8000
Private Const MUS_PNT_S2_2 As Long = &HF0000
Private Const MUS_PNT_S3 As Long = &HE761A
Private Const MUS_PNT_SK As Long = &HF793E
Private Const MUS_PNT_S3D As Long = &HD3233
Private Const MUS_PNT_SC As Long = &H633F&
Private Const MUS_PNT_S1SMS As Long = &HC716&
Private Const MUS_PNT_S2SMS As Long = &H8BE7&
Private Const MUS_PNT_S2GG As Long = &H8AE6&
Private Const MUS_PNT_SCSMS As Long = &H90E1&
Private Const MUS_PNT_SCGG As Long = &H912F&
Private Const MUS_PNT_STTGG As Long = &H8B9C&
Private Const MUS_PNT_S96GG As Long = &H8B9C&   ' yes, it's the same address as STT
Private Const MUS_PNT_SLAB As Long = &H7CBBD
Private Const MUS_PNT_SSPINSMS As Long = &HD5DF&
Private Const MUS_PNT_KC As Long = &H76AE9
Private Const MUS_PNT_RST As Long = &HC852A

Private Const SMPSOPT_COMPRESSED = &H1
Private Const SMPSOPT_S2_MODE = &H2
Private Const SMPSOPT_IS_68K = &H0
Private Const SMPSOPT_IS_GEN = &H4
Private Const SMPSOPT_IS_RST = &H8
Private Const SMPSOPT_IS_Z80 = &H10
Private Const SMPSOPT_IS_32X = &H20
Private Const SMPSOPT_IS_S1SMS = &H80
Private Const SMPSOPT_IS_S2SMS = &H90
Private Const SMPSOPT_IS_SCD = &HC0

Private FileType As Byte
Private CurFileName As String
Private ROMType As Byte
Private SmpsOpts As Byte
Private ROMLen As Long
Private ROMData() As Byte
Private FileCount As Long
Private Files() As SMPS_ENTRY


Private SmpsLen As Long
Private SmpsData() As Byte
Private MidLen As Long
Private MidData() As Byte

Private Sub Form_Load()

    GameList.AddItem "Auto", &H0
    GameList.AddItem "Sonic 1", &H1
    GameList.AddItem "Sonic 2 Beta", &H2
    GameList.AddItem "Sonic 2", &H3
    GameList.AddItem "Sonic 3K and later", &H4
    GameList.AddItem "Sonic 1 SMS/GG", &H5
    GameList.AddItem "Sonic 2 SMS/GG", &H6
    GameList.AddItem "Sonic Chaos SMS/GG", &H7
    GameList.AddItem "Sonic Triple Trouble and later", &H8
    GameList.AddItem "Sonic CD", &H9
    GameList.AddItem "Knuckles' Chaotix", &HA
    GameList.AddItem "Ristar", &HB
    GameList.AddItem "Generic SMPS 68k", &HC
    GameList.AddItem "Sonic Spinball SMS/GG", &HD
    GameList.AddItem "Gen. SMPS Z80 a", &HE
    GameList.AddItem "Gen. SMPS Z80 b", &HF
    GameList.ListIndex = &H0
    GameLabel.Caption = "Nothing loaded."
    
    Opt_NoteVel = NoteVelCheck.Value
    Opt_BoostYM = BoostYMCheck.Value
    Opt_NoKeyDplc = NoKeyDisplcCheck.Value
    
    FileType = FILE_TYPE_BAD
    ROMType = ROMTYPE_NONE

End Sub

Private Sub MidiResText_KeyPress(KeyAscii As Integer)

    If (KeyAscii >= &H20 And KeyAscii < &H2F) Or KeyAscii > &H39 Then
        KeyAscii = &H0
        Beep
    End If

End Sub

Private Sub NoteVelCheck_Click()

    Opt_NoteVel = NoteVelCheck.Value

End Sub

Private Sub BoostYMCheck_Click()

    Opt_BoostYM = BoostYMCheck.Value

End Sub

Private Sub NoKeyDisplcCheck_Click()

    Opt_NoKeyDplc = NoKeyDisplcCheck.Value

End Sub

Private Function IsROM() As Boolean

    'Const FCC_SON As Long = &H4E4F53A2
    
    Dim TempLng As Long
    Dim TempLng2 As Long
    
    If LOF(1) < &H104 Then
        IsROM = False
        Exit Function
    End If
    
    ' usual Sega MegaDrive ROMs
    Get #1, 1 + &H100, TempLng
    If TempLng = FCC_SEGA Then
        IsROM = True
        Exit Function
    End If
    
    '' Check for Sonic 1 SMS
    'Get #1, 1 + LOF(1) - &H4, TempLng
    'If TempLng = FCC_SON Then
    '    IsROM = True
    '    Exit Function
    'End If
    
    '' Check for misc Sonic SMS ROMs
    'Get #1, 1 + &HC3, TempLng
    'If TempLng = FCC_SONI Then
    '    IsROM = True
    '    Exit Function
    'End If
    
    ' Check for usual SMS/GG ROMs
    Get #1, 1 + &H7FF0, TempLng
    Get #1, 1 + &H7FF4, TempLng2
    If TempLng = FCC_TMR_ And TempLng2 = FCC_SEGA Then
        IsROM = True
        Exit Function
    End If
    
    IsROM = False

End Function

Private Function IsSCD_Bin() As Boolean

    Dim TempLng As Long
    
    If LOF(1) < &H100 Then
        IsSCD_Bin = False
        Exit Function
    End If
    
    Get #1, 1 + &H0, TempLng
    If TempLng = FCC_SNCB Then
        IsSCD_Bin = True
        Exit Function
    End If
    
    IsSCD_Bin = False

End Function

Private Sub OpenButton_Click()

    Dim FileName As String
    Dim TempLng As Long
    Dim CurFile As Long
    
    On Error GoTo OpenError
    
    FileName = OpenDialog("All supported files (*.bin; *.sms; *.gg; *.32x)|" & _
                                                "*.bin; *.sms; *.gg; *.32x|" & _
                            "SMPS Binaries (*.bin)|*.bin|" & _
                            "Sega MegaDrive ROMs (*.bin)|*.bin|" & _
                            "Sega Master System / Game Gear ROMs (*.sms; *.gg)|*.sms; *.gg" & _
                            "Sega 32x ROMs (*.32x)|*.32x|")
    If FileName = "" Then Exit Sub
    
    Open FileName For Binary Access Read As #1
        If IsROM() Or IsSCD_Bin() Then
            FileType = FILE_TYPE_ROM
            
            ROMLen = LOF(1)
            ReDim ROMData(&H0 To ROMLen - 1)
            Get #1, 1, ROMData()
        ElseIf LOF(1) <= &H10000 Then
            FileType = FILE_TYPE_BIN
            
            SmpsLen = LOF(1)
            ReDim SmpsData(&H0 To SmpsLen - 1)
            Get #1, 1, SmpsData()
        Else
            Close #1
            
            MsgBox "Invalid file!", vbCritical
            FileType = FILE_TYPE_BAD
            Exit Sub
        End If
    Close #1
    
    CurFileName = FileName
    ROMType = ROMTYPE_NONE
    SmpsOpts = &H0
    
    FileCount = &H0
    Erase Files()
    If FileType = FILE_TYPE_ROM Then
        ROMType = ROMTYPE_UNKNOWN
        SmpsOpts = &H0
        
        Call CopyMemory(TempLng, ROMData(&H100), &H4)
        If TempLng <> FCC_SEGA Then
            Call CopyMemory(TempLng, ROMData(&H7FF0), &H4)
            If TempLng <> FCC_TMR_ Then
                Call CopyMemory(TempLng, ROMData(&H0), &H4)
            End If
        End If
        If TempLng = FCC_SEGA Then
            ' Sega MegaDrive/32x ROM
            Call CopyMemory(TempLng, ROMData(&H120), &H4)
            If TempLng = FCC_SONI Or TempLng = FCC_OERG Or TempLng = FCC_CHAO Then
                If ROMData(&H13F) = &H47 Then ' Sonic 1
                    ROMType = ROMTYPE_S1
                    If CheckMusicPointers(MUS_PNT_S1, &H0) Then
                        Call ReadMusicPointers(MUS_PNT_S1, &H0, &H0)
                    End If
                    SmpsOpts = SMPSOPT_IS_68K
                ElseIf ROMData(&H13F) = &H32 Then   ' Sonic 2
                    If ROMData(&H11B) = &H31 Then   ' Year 1991 - S2 Beta
                        ROMType = ROMTYPE_S2B
                    Else 'If ROMData(&H11B) = &H32 Then ' Year 1992 - S2 Final
                        ROMType = ROMTYPE_S2
                    End If
                    If CheckMusicPointers(MUS_PNT_S2_1, &H1) Then
                        Call ReadMusicPointers(MUS_PNT_S2_1, MUS_PNT_S2_1, &H1, &H1E)
                        Call ReadMusicPointers(MUS_PNT_S2_2, MUS_PNT_S2_2, &H1)
                    End If
                    SmpsOpts = SMPSOPT_COMPRESSED Or SMPSOPT_IS_Z80 Or SMPSOPT_S2_MODE
                    'SmpsOfsLock = &H1380
                ElseIf ROMData(&H13F) = &H33 Then   ' Sonic 3
                    ROMType = ROMTYPE_S3
                    If CheckMusicPointers(MUS_PNT_S3, &H1) Then
                        Call ReadMusicPointers(MUS_PNT_S3 + &H0, &HC8000, &H1, &HA)
                        Call ReadMusicPointers(MUS_PNT_S3 + &H14, &HD0000, &H1, &H12)
                        Call ReadMusicPointers(MUS_PNT_S3 + &H38, &HD8000, &H1, &H11)
                        Call ReadMusicPointers(MUS_PNT_S3 + &H5A, &HC0000, &H1, &H4)
                    End If
                    SmpsOpts = SMPSOPT_IS_Z80
                ElseIf ROMData(&H126) = &H26 Then   ' Sonic & Knuckles
                    ROMType = ROMTYPE_S3K
                    If CheckMusicPointers(MUS_PNT_SK, &H1) Then
                        Call ReadMusicPointers(MUS_PNT_SK + &H0, &H2C8000, &H1, &H8)
                        Call ReadMusicPointers(MUS_PNT_SK + &H10, &HE8000, &H1, &H16)
                        Call ReadMusicPointers(MUS_PNT_SK + &H3C, &H2D0000, &H1, &HD)
                        Call ReadMusicPointers(MUS_PNT_SK + &H56, &HE0000, &H1, &H8)
                    End If
                    SmpsOpts = SMPSOPT_IS_Z80
                ElseIf ROMData(&H126) = &H53 Then   ' Sonic Studium (Sonic and Crackers)
                    ROMType = ROMTYPE_SC
                    If CheckMusicPointers(MUS_PNT_SC, &H1) Then
                        Call ReadMusicPointers(MUS_PNT_SC, &H10000, &H1)
                    End If
                    SmpsOpts = SMPSOPT_IS_Z80
                ElseIf ROMData(&H127) = &H44 Then   ' Sonic 3D
                    ROMType = ROMTYPE_S3D
                    If CheckMusicPointers(MUS_PNT_S3D, &H1) Then
                        Call ReadMusicPointers(MUS_PNT_S3D + &H0, &HC0000, &H1, &H9)
                        Call ReadMusicPointers(MUS_PNT_S3D + &H12, &HC8000, &H1, &HC)
                        Call ReadMusicPointers(MUS_PNT_S3D + &H2A, &HD0000, &H1)
                        
                        For CurFile = &H0 To FileCount - 1
                            If Files(CurFile).Offset = &HC96B3 Then
                                Files(CurFile).Offset = Files(CurFile).Offset + &H8000&
                            End If
                        Next CurFile
                    End If
                    SmpsOpts = SMPSOPT_IS_Z80
                ElseIf TempLng = FCC_CHAO Then
                    ROMType = ROMTYPE_KC
                    If CheckMusicPointers(MUS_PNT_KC, &H1) Then
                        Call ReadMusicPointers(MUS_PNT_KC + &H0, &H40000, &H1, &HE)
                        Call ReadMusicPointers(MUS_PNT_KC + &H1C, &H48000, &H1, &H17)
                        Call ReadMusicPointers(MUS_PNT_KC + &H4A, &H50000, &H1, &H4)
                    End If
                    SmpsOpts = SMPSOPT_IS_32X
                ElseIf ROMData(&H120) = &H4F And ROMData(&H124) = &H38 Then ' Oerg866 SMPS Player
                    ROMType = ROMTYPE_SMPSPLAY
                    TempLng = ReadBELong(ROMData(), MUS_PNT_OERG)
                    If CheckMusicPointers(TempLng, &H0) Then
                        Call ReadMusicPointers(TempLng, &H0, &H0)
                    End If
                    SmpsOpts = SMPSOPT_IS_68K
                End If
            Else
                Call CopyMemory(TempLng, ROMData(&H124), &H4)
                If TempLng = FCC_RIST Then
                    ROMType = ROMTYPE_RST
                    If CheckMusicPointers(MUS_PNT_RST, &H0) Then
                        Call ReadMusicPointers(MUS_PNT_RST, &H0, &H0)
                    End If
                    SmpsOpts = SMPSOPT_IS_68K Or SMPSOPT_IS_RST
                End If
            End If
        ElseIf TempLng = FCC_TMR_ Then
            ' Sega MasterSystem/GameGear ROM
            Call CopyMemory(TempLng, ROMData(&H4C), &H4)
            If TempLng = &H1010101 Then
                Call CopyMemory(TempLng, ROMData(&H7C), &H4)
            End If
            If TempLng = &H31393931 Then    ' Sonic 1 SMS
                ' valid for all versions (MS, GG v1.0, GG v1.1, GG Proto)
                ROMType = ROMTYPE_S1SMS
                If CheckMusicPointers(MUS_PNT_S1SMS, &H2) Then
                    Call ReadMusicPointers(MUS_PNT_S1SMS, &H8000&, &H2, &H15)
                End If
                SmpsOpts = SMPSOPT_IS_S1SMS
            ElseIf TempLng = &HC8243AC8 Then    ' Sonic Spinball SMS
                ' valid for Spinball SMS, others untested
                ROMType = ROMTYPE_SSPINSMS
                If CheckMusicPointers(MUS_PNT_SSPINSMS, &H2) Then
                    Call ReadMusicPointers(MUS_PNT_SSPINSMS, &H4000&, &H2, &H8)
                End If
                SmpsOpts = SMPSOPT_IS_S1SMS
            Else
                Call CopyMemory(TempLng, ROMData(&HC3), &H4)
                If TempLng = FCC_SONI Then  ' Sonic 2/Chaos/TT/Blast
                    Call CopyMemory(TempLng, ROMData(&HE0), &H4)
                    If TempLng = &H32393931 Then    ' Sonic 2
                        If ROMData(&HC0) = &H4D Then    ' M - Master System
                            ' valid for both, v1.0 and v2.2
                            ROMType = ROMTYPE_S2SMS
                            If CheckMusicPointers(MUS_PNT_S2SMS, &H2) Then
                                Call ReadMusicPointers(MUS_PNT_S2SMS, &H0&, &H2, &H13)
                            End If
                        Else 'If ROMData(&HC0) = &H47 Then  ' G - Game Gear
                            ROMType = ROMTYPE_S2GG
                            If CheckMusicPointers(MUS_PNT_S2GG, &H2) Then
                                Call ReadMusicPointers(MUS_PNT_S2GG, &H4000&, &H2, &H16)
                            End If
                        End If
                        SmpsOpts = SMPSOPT_IS_S2SMS
                    ElseIf TempLng = &H33393931 Then    ' Sonic Chaos
                        If ROMData(&HC0) = &H4D Then    ' M - Master System
                            ROMType = ROMTYPE_SCSMS
                            If CheckMusicPointers(MUS_PNT_SCSMS, &H2) Then
                                Call ReadMusicPointers(MUS_PNT_SCSMS, &H4000&, &H2, &H1F)
                            End If
                        Else 'If ROMData(&HC0) = &H47 Then  ' G - Game Gear
                            ' valid for both, Sonic Chaos (JUE) and Sonic & Tails (J)
                            ROMType = ROMTYPE_SCGG
                            If CheckMusicPointers(MUS_PNT_SCGG, &H2) Then
                                Call ReadMusicPointers(MUS_PNT_SCGG, &H4000&, &H2, &H1F)
                            End If
                        End If
                        SmpsOpts = SMPSOPT_IS_S2SMS
                    ElseIf TempLng = &H34393931 Then    ' Sonic Triple Trouble
                        ' valid for both, Sonic Triple Trouble (UE) and Sonic & Tails 2 (J)
                        ROMType = ROMTYPE_STTGG
                        If CheckMusicPointers(MUS_PNT_STTGG, &H2) Then
                            Call ReadMusicPointers(MUS_PNT_STTGG, &H4000&, &H2, &H23)
                        End If
                        SmpsOpts = SMPSOPT_IS_S2SMS
                    ElseIf TempLng = &H36393931 Then    ' Sonic Blast
                        ' MS version also says "GG" at offset 000C0h
                        ' valid for both, GG and MS version
                        ROMType = ROMTYPE_S96
                        If CheckMusicPointers(MUS_PNT_S96GG, &H2) Then
                            Call ReadMusicPointers(MUS_PNT_S96GG, &H4000&, &H2, &H18)
                        End If
                        SmpsOpts = SMPSOPT_IS_S2SMS
                    End If
                ElseIf TempLng = &H4DC0C333 Then
                    ROMType = ROMTYPE_SLAB
                    If CheckMusicPointers(MUS_PNT_SLAB, &H2) Then
                        Call ReadMusicPointers(MUS_PNT_SLAB, &H74000, &H2, &H11)
                    End If
                    SmpsOpts = SMPSOPT_IS_S2SMS
                End If
            End If
        ElseIf TempLng = FCC_SNCB Then
            ROMType = ROMTYPE_SCD
            TempLng = &H16 + ReadBEShort(ROMData(), &H16) + &H314
            Call ReadMusicPointers(TempLng, &H0, &H3, &H1)
            SmpsOpts = SMPSOPT_IS_SCD
        End If
    End If
    
    FileList.Clear
    If FileType = FILE_TYPE_ROM Then
        For CurFile = &H0 To FileCount - 1
            With Files(CurFile)
                FileList.AddItem HexOutput(CurFile + 1, 2) & vbTab & _
                                HexOutput(.Offset, 6) & vbTab & HexOutput(.Length, 4)
            End With
        Next CurFile
    Else
        TempLng = InStrRev(FileName, "\")
        FileList.AddItem Mid$(FileName, TempLng + 1)
    End If
    If FileList.ListCount > &H0 Then
        FileList.ListIndex = &H0
    End If
    
    If FileType = FILE_TYPE_BIN Then
        FileName = "SMPS Binary"
        If SmpsData(&H2) = &HFF Then
            TempLng = &H1380
        Else
            TempLng = &H0
        End If
        MemBaseText.Text = HexOutput(TempLng, &H4)
    ElseIf FileType = FILE_TYPE_ROM Then
        Select Case ROMType
        Case ROMTYPE_S1
            FileName = "Sonic 1"
        Case ROMTYPE_SMPSPLAY
            FileName = "Oerg866's SMPS Player"
        Case ROMTYPE_S2B
            FileName = "Sonic 2 Beta"
        Case ROMTYPE_S2
            FileName = "Sonic 2"
        Case ROMTYPE_S3
            FileName = "Sonic 3"
        Case ROMTYPE_S3K
            FileName = "Sonic 3 & Knuckles"
        Case ROMTYPE_S3D
            FileName = "Sonic 3D"
        Case ROMTYPE_SC
            FileName = "Sonic and Crackers"
        Case ROMTYPE_GEN_68K
            FileName = "Generic SMPS 68k"
        Case ROMTYPE_RST
            FileName = "Ristar"
        Case ROMTYPE_S1SMS
            FileName = "Sonic 1 (Master System)"
        Case ROMTYPE_S2SMS
            FileName = "Sonic 2 (Master System)"
        Case ROMTYPE_S2GG
            FileName = "Sonic 2 (Game Gear)"
        Case ROMTYPE_SCSMS
            FileName = "Sonic Chaos (Master System)"
        Case ROMTYPE_SCGG
            FileName = "Sonic Chaos (Game Gear)"
        Case ROMTYPE_STTGG
            FileName = "Sonic Triple Trouble (Game Gear)"
        Case ROMTYPE_S96
            FileName = "Sonic Blast (Master System / Game Gear)"
        Case ROMTYPE_SLAB
            FileName = "Sonic Labyrinth (Game Gear)"
        Case ROMTYPE_SSPINSMS
            FileName = "Sonic Spinball (Master System)"
        Case ROMTYPE_KC
            FileName = "Knuckles' Chaotix"
        Case ROMTYPE_UNKNOWN
            FileName = "Unknown ROM"
        Case Else
            FileName = "??"
        End Select
        GameList.ListIndex = &H0
    Else
        FileName = "??"
    End If
    Call GameList_Click
    GameLabel.Caption = FileName & " loaded."
    
    Exit Sub

OpenError:

    MsgBox "Error opening file!", vbCritical
    
    Exit Sub

End Sub

Private Function CheckMusicPointers(ByVal ListPos As Long, ByVal PntType As Byte) As Boolean

    Dim TempSht As Integer
    Dim TempLng As Long
    
    If ListPos = &H0 Then
        MsgBox "Bad Music Pointer!", vbExclamation
        CheckMusicPointers = False
        Exit Function
    End If
    
    CheckMusicPointers = True
    If PntType = &H0 Then
        Call CopyMemory(TempLng, ROMData(ListPos - &H4), &H4)
        If TempLng <> &H5FF0815 Then
            MsgBox "Music Pointers not found!", vbExclamation
            CheckMusicPointers = False
        End If
    ElseIf PntType = &H1 Then
        Call CopyMemory(TempSht, ROMData(ListPos), &H2)
        If Not CBool(TempSht And &H8000) Or CBool(TempSht And &H7000) Then
            MsgBox "Music Pointers not found!", vbExclamation
            CheckMusicPointers = False
        End If
    ElseIf PntType = &H2 Then
        Call CopyMemory(TempSht, ROMData(ListPos), &H2)
        'If CBool(TempSht And &H8000) Or (TempSht Or &H8000&) < ListPos Then
        'If ((TempSht And &H7FFF) Or &H8000&) < ListPos Then
        '    MsgBox "Music Pointers not found!", vbExclamation
        '    CheckMusicPointers = False
        'End If
    End If

End Function

Private Sub ReadMusicPointers(ByVal ListPos As Long, ByVal PntBase As Long, _
                                ByVal PntType As Byte, Optional ByVal MaxMusCnt As Integer)

    Dim CurPos As Long
    Dim MusCnt As Long
    Dim LastAddr As Long
    Dim CurFile As Long
    Dim TempSht As Integer
    Dim TempLng As Long
    Dim SameAddr As Integer
    Dim FirstAddr As Integer
    
    MusCnt = &H0
    CurPos = ListPos
    If PntType = &H0 Then
        LastAddr = &H0
        Do
            TempLng = ReadBELong(ROMData(), CurPos)
            If TempLng < LastAddr Or TempLng >= ROMLen Then Exit Do
            CurPos = CurPos + &H4
            MusCnt = MusCnt + &H1
            LastAddr = TempLng
        Loop
    ElseIf PntType = &H1 Then
        LastAddr = &H0
        Do
            Call CopyMemory(TempSht, ROMData(CurPos), &H2)
            CurPos = CurPos + &H2
            If Not CBool(TempSht And &H8000) Then Exit Do
            TempSht = TempSht And &H7FFF
            If (TempSht And &H7000) = &H0 And (LastAddr - TempSht) >= &H1000 Then Exit Do
            If (TempSht And &H3FFF) = &H0 And (TempSht - LastAddr) >= &H2000 Then Exit Do
            If LastAddr <> TempSht Then
                SameAddr = MusCnt
            End If
            LastAddr = TempSht
            MusCnt = MusCnt + &H1
            
            If MusCnt - SameAddr >= 8 Then
                MusCnt = SameAddr + &H1
                Exit Do
            End If
        Loop
    ElseIf PntType = &H2 Then
        LastAddr = &H0
        Call CopyMemory(FirstAddr, ROMData(CurPos), &H2)
        Do
            Call CopyMemory(TempSht, ROMData(CurPos), &H2)
            CurPos = CurPos + &H2
            'If CBool(TempSht And &H8000) Then Exit Do
            If (TempSht Xor FirstAddr) And &H8000 Then Exit Do
            TempSht = TempSht And &H7FFF
            'If (TempSht Or &H8000&) < ListPos Then Exit Do
            If LastAddr <> TempSht Then
                SameAddr = MusCnt
            End If
            LastAddr = TempSht
            MusCnt = MusCnt + &H1
            
            If MusCnt - SameAddr >= 8 Then
                MusCnt = SameAddr + &H1
                Exit Do
            End If
        Loop
    ElseIf PntType = &H3 Then
        MusCnt = &H1
    End If
    If MaxMusCnt > &H0 Then
        'If MusCnt > MaxMusCnt Then MusCnt = MaxMusCnt
        MusCnt = MaxMusCnt
    End If
    
    If MusCnt = &H0 Then Exit Sub
    
    ReDim Preserve Files(&H0 To FileCount + MusCnt - 1)
    CurPos = ListPos
    If PntType = &H0 Then
        LastAddr = ReadBELong(ROMData(), ListPos)
        Files(FileCount + &H0).Offset = LastAddr
        CurPos = CurPos + &H4
        For CurFile = &H1 To MusCnt - 1
            TempLng = ReadBELong(ROMData(), CurPos)
            Files(FileCount + CurFile).Offset = TempLng
            Files(FileCount + CurFile - 1).Length = TempLng - LastAddr
            LastAddr = TempLng
            CurPos = CurPos + &H4
        Next CurFile
        CurPos = LastAddr + ReadBEShort(ROMData(), LastAddr)
        Do Until ROMData(CurPos) = &H0
            CurPos = CurPos + &H19
        Loop
        Files(FileCount + CurFile - 1).Length = CurPos - TempLng
    ElseIf PntType = &H1 Or PntType = &H2 Then
        Files(FileCount + &H0).Length = -1
        For CurFile = &H0 To MusCnt - 1
            Call CopyMemory(TempSht, ROMData(CurPos), &H2)
            'If PntType = &H1 Then
                TempSht = TempSht And &H7FFF
            'End If
            TempLng = PntBase + (TempSht And &HFFFF&)
            Files(FileCount + CurFile).Offset = TempLng
            If ROMData(TempLng + &H2) = &HFF Then
                Call CopyMemory(TempSht, ROMData(TempLng), &H2)
                TempSht = TempSht + &H2
                If TempSht <= &H20 Then TempSht = -1
            Else
                TempSht = -1
            End If
            Files(FileCount + CurFile).Length = TempSht
            If CurFile > &H0 Then
                If Files(FileCount + CurFile - 1).Length = -1 Then
                    If TempLng >= LastAddr Then
                        Files(FileCount + CurFile - 1).Length = TempLng - LastAddr
                    Else
                        TempSht = LastAddr And &H7FFF
                        Files(FileCount + CurFile - 1).Length = &H8000& - TempSht
                    End If
                End If
            End If
            LastAddr = TempLng
            CurPos = CurPos + &H2
        Next CurFile
        
        Call CopyMemory(TempSht, ROMData(LastAddr), &H2)
        If Files(FileCount + CurFile - 1).Length = -1 Then
            If PntType = &H1 Then
                CurPos = LastAddr + (TempSht And &H7FFF)
                If (CurPos And &HFFFF8000) > (LastAddr And &HFFFF8000) Then _
                    CurPos = (CurPos And &HFFFF8000) - &H1
                If CurPos >= ROMLen Then CurPos = ROMLen - &H10
                Do Until ROMData(CurPos) = &H0
                    CurPos = CurPos + &H19
                Loop
                Files(FileCount + CurFile - 1).Length = CurPos - TempLng
            Else
                TempSht = LastAddr And &H7FFF
                Files(FileCount + CurFile - 1).Length = &H8000& - TempSht
            End If
        End If
    ElseIf PntType = &H3 Then
        LastAddr = ReadBELong(ROMData(), ListPos + &H0) And &H3FFFF   ' Pointer Offset
        
        CurPos = ReadBELong(ROMData(), LastAddr + &H4) And &H3FFFF  ' Music Data Address Offset
        TempLng = ReadBELong(ROMData(), LastAddr + &H8) And &H3FFFF ' Sound Data Address Offset
        CurPos = ReadBELong(ROMData(), CurPos) And &H3FFFF      ' Music Data Offset
        TempLng = ReadBELong(ROMData(), TempLng) And &H3FFFF    ' Sound Data Offset
        Files(FileCount + &H0).Offset = CurPos
        Files(FileCount + &H0).Length = TempLng - CurPos
    End If
    FileCount = FileCount + MusCnt
    
End Sub

Private Sub FileList_Click()

    Dim SmpsOfs As Long
    
    If FileType = FILE_TYPE_ROM Then
        Select Case ROMType
        Case ROMTYPE_S1, ROMTYPE_SMPSPLAY, ROMTYPE_GEN_68K, ROMTYPE_RST
            SmpsOfs = &H0
        Case ROMTYPE_S2B, ROMTYPE_S2
            If ROMData(Files(FileList.ListIndex).Offset + &H2) = &HFF Then
                SmpsOfs = &H1380
            Else
                SmpsOfs = &H8000& Or (Files(FileList.ListIndex).Offset And &H7FFF)
            End If
        Case ROMTYPE_S3, ROMTYPE_S3K, ROMTYPE_S3D, ROMTYPE_SC, ROMTYPE_KC
            SmpsOfs = &H8000& Or (Files(FileList.ListIndex).Offset And &H7FFF)
        Case ROMTYPE_S1SMS
            SmpsOfs = &H0
        Case ROMTYPE_S2SMS
            SmpsOfs = Files(FileList.ListIndex).Offset And &HFFFF&
        Case ROMTYPE_S2GG, ROMTYPE_SCSMS, ROMTYPE_SCGG, ROMTYPE_STTGG, ROMTYPE_S96, _
            ROMTYPE_SSPINSMS
            SmpsOfs = &H4000& + (Files(FileList.ListIndex).Offset And &H7FFF)
        Case ROMTYPE_SLAB
            SmpsOfs = &H8000& Or (Files(FileList.ListIndex).Offset And &H3FFF)
        Case ROMTYPE_SCD
            SmpsOfs = &H0
        Case ROMTYPE_UNKNOWN, ROMTYPE_NONE
            If Not MemBaseText.Enabled Then Exit Sub
            SmpsOfs = &H8000& Or (Files(FileList.ListIndex).Offset And &H7FFF)
        End Select
        MemBaseText.Text = HexOutput(SmpsOfs, &H4)
    End If

End Sub

Private Sub GameList_Click()

    Dim EnFlag As Boolean
    Dim BOfsFlag As Boolean
    Dim MemBasFlag As Boolean
    
    If FileType = FILE_TYPE_ROM Then
        EnFlag = True
    Else
        EnFlag = False
    End If
    Select Case GameList.ListIndex
    Case &H0
        If FileType = FILE_TYPE_ROM Then
            Select Case ROMType
            Case ROMTYPE_S1, ROMTYPE_SMPSPLAY, ROMTYPE_GEN_68K, ROMTYPE_RST
                BOfsFlag = False
                MemBasFlag = False
            Case ROMTYPE_S2B, ROMTYPE_S2, ROMTYPE_S3, ROMTYPE_S3K, ROMTYPE_S3D, ROMTYPE_SC, _
                ROMTYPE_S2SMS, ROMTYPE_S2GG, ROMTYPE_SCSMS, ROMTYPE_SCGG, ROMTYPE_STTGG, _
                ROMTYPE_S96, ROMTYPE_SLAB, ROMTYPE_KC, ROMTYPE_SSPINSMS
                BOfsFlag = True
                MemBasFlag = True
            Case ROMTYPE_S1SMS
                BOfsFlag = True
                MemBasFlag = False
            Case ROMTYPE_SCD
                BOfsFlag = False
                MemBasFlag = False
            Case ROMTYPE_UNKNOWN, ROMTYPE_NONE
                BOfsFlag = True
                MemBasFlag = True
            End Select
        Else
            BOfsFlag = False
            MemBasFlag = True
        End If
    Case &H1, &H9, &HA, &HB, &HC
        BOfsFlag = False
        MemBasFlag = False
    Case &H2, &H3, &H4, &H6, &H7, &H8, &HE, &HF
        BOfsFlag = True
        MemBasFlag = True
    Case &H5
        BOfsFlag = True
        MemBasFlag = False
    End Select
    
    PntLstLabel.Enabled = EnFlag
    HexLabel.Enabled = EnFlag
    PntLstText.Enabled = EnFlag
    AddPntButton.Enabled = EnFlag
    BaseOfsLabel.Enabled = BOfsFlag And EnFlag
    Hex2Label.Enabled = BOfsFlag And EnFlag
    BaseOfsText.Enabled = BOfsFlag And EnFlag
    MemBaseLabel.Enabled = MemBasFlag
    Hex3Label.Enabled = MemBasFlag
    MemBaseText.Enabled = MemBasFlag
    ClearLstButton.Enabled = EnFlag

End Sub

Private Sub PntLstText_GotFocus()

    PntLstText.SelStart = 0
    PntLstText.SelLength = Len(PntLstText.Text)

End Sub

Private Sub BaseOfsText_GotFocus()

    BaseOfsText.SelStart = 0
    BaseOfsText.SelLength = Len(BaseOfsText.Text)

End Sub

Private Sub MemBaseText_GotFocus()

    MemBaseText.SelStart = 0
    MemBaseText.SelLength = Len(MemBaseText.Text)

End Sub

Private Sub Sonic1MusicSearch()

    Dim FileStr As String
    Dim SearchStr As String
    Dim TempPos As Long
    
    ' Doing a String search should be the fastest way - at least in VB
    FileStr = StrConv(ROMData(), vbUnicode)
    ' Magic Bytes: 07 72 73 26 15 08 FF 05
    ' The Music Pointers are always located directly after them.
    SearchStr = Chr$(&H7) & "rs&" & Chr$(&H15) & Chr$(&H8) & Chr$(&HFF) & Chr$(&H5)
    
    TempPos = InStr(1, FileStr, SearchStr, vbBinaryCompare)
    If TempPos = 0 Then
        MsgBox "No Sonic 1 SMPS Driver found!", vbInformation
        Exit Sub
    End If
    TempPos = TempPos + &H8
    
    GameList.ListIndex = &H1
    PntLstText.Text = HexOutput(TempPos - 1, &H7)
    Call AddPntButton_Click

End Sub

Private Sub PntLstText_KeyPress(KeyAscii As Integer)

    Dim MsgAsk As VbMsgBoxResult
    
    If KeyAscii >= &H61 And KeyAscii <= &H7A Then _
        KeyAscii = KeyAscii - &H20
    
    If (KeyAscii >= &H20 And KeyAscii < &H30) Or _
        (KeyAscii > &H39 And KeyAscii < &H41) Or KeyAscii > &H46 Then
        KeyAscii = &H0
        Beep
        Exit Sub
    End If
    
    If KeyAscii = &H1 Then
        ' Ctrl + A
        KeyAscii = &H0
        
        MsgAsk = MsgBox("Perform automatic search for Sonic 1 SMPS?", vbQuestion Or vbYesNo)
        If MsgAsk = vbYes Then _
            Call Sonic1MusicSearch
    End If

End Sub

Private Sub BaseOfsText_KeyPress(KeyAscii As Integer)

    If KeyAscii >= &H61 And KeyAscii <= &H7A Then _
        KeyAscii = KeyAscii - &H20
    
    If (KeyAscii >= &H20 And KeyAscii < &H30) Or _
        (KeyAscii > &H39 And KeyAscii < &H41) Or KeyAscii > &H46 Then
        KeyAscii = &H0
        Beep
    End If

End Sub

Private Sub MemBaseText_KeyPress(KeyAscii As Integer)

    If KeyAscii >= &H61 And KeyAscii <= &H7A Then _
        KeyAscii = KeyAscii - &H20
    
    If (KeyAscii >= &H20 And KeyAscii < &H30) Or _
        (KeyAscii > &H39 And KeyAscii < &H41) Or KeyAscii > &H46 Then
        KeyAscii = &H0
        Beep
    End If

End Sub

Private Sub AddPntButton_Click()

    If FileType <> FILE_TYPE_ROM Then Exit Sub
    
    Dim PntType As Byte
    Dim ListAddr As Long
    Dim BaseOfs As Long
    Dim CurFile As Long
    
    ListAddr = CLng("&H" & PntLstText.Text)
    If BaseOfsText.Text = "" Then
        BaseOfs = ListAddr And Not &H7FFF&
    Else
        BaseOfs = CLng("&H" & BaseOfsText.Text)
    End If
    If ListAddr >= ROMLen Then
        MsgBox "Pointer List Address beyond EOF!", vbInformation
        Exit Sub
    End If
    If BaseOfs >= ROMLen Then
        MsgBox "Base Offset beyond EOF!", vbInformation
        Exit Sub
    End If
    
    Select Case GameList.ListIndex
    Case &H0
        Select Case ROMType
        Case ROMTYPE_S1, ROMTYPE_SMPSPLAY, ROMTYPE_GEN_68K, ROMTYPE_RST
            PntType = &H0
        Case ROMTYPE_S2B, ROMTYPE_S2, ROMTYPE_S3, ROMTYPE_S3K, ROMTYPE_S3D
            PntType = &H1
        Case ROMTYPE_S1SMS, ROMTYPE_S2SMS, ROMTYPE_S2GG, ROMTYPE_SCSMS, ROMTYPE_SCGG, _
            ROMTYPE_STTGG, ROMTYPE_S96, ROMTYPE_SLAB, ROMTYPE_KC, ROMTYPE_SSPINSMS, ROMTYPE_SC
            PntType = &H2
        Case ROMTYPE_SCD
            PntType = &H3
        Case ROMTYPE_UNKNOWN, ROMTYPE_NONE
            MsgBox "Please select a ROM Type!", vbInformation
            Exit Sub
        End Select
    Case &H1, &H9
        PntType = &H0
    Case &H2, &H3, &H4
        PntType = &H1
    Case &H5, &H6, &H7, &H8, &HA, &HE, &HF
        PntType = &H2
    End Select
    
    'If CheckMusicPointers(ListAddr, PntType) Then
        Call ReadMusicPointers(ListAddr, BaseOfs, PntType)
    'End If
    
    FileList.Clear
    If FileCount = &H0 Then Exit Sub
    For CurFile = &H0 To FileCount - 1
        With Files(CurFile)
            FileList.AddItem HexOutput(CurFile + 1, 2) & vbTab & _
                            HexOutput(.Offset, 6) & vbTab & HexOutput(.Length, 4)
        End With
    Next CurFile
    FileList.ListIndex = &H0

End Sub

Private Sub ClearLstButton_Click()

    If FileType <> FILE_TYPE_ROM Then Exit Sub

    FileList.Clear
    FileCount = &H0

End Sub

Private Sub SetConvOptions()

    Dim GameType As Byte
    Dim SmpsOfs As Long
    
    If GameList.ListIndex = &H0 Then
        If FileType = FILE_TYPE_ROM Then
            Select Case ROMType
            Case ROMTYPE_S1, ROMTYPE_SMPSPLAY
                GameType = &H1
            Case ROMTYPE_S2B
                GameType = &H2
            Case ROMTYPE_S2
                GameType = &H3
            Case ROMTYPE_S3, ROMTYPE_S3K, ROMTYPE_S3D
                GameType = &H4
            Case ROMTYPE_SC
                GameType = &HE
            Case ROMTYPE_S1SMS
                GameType = &H5
            Case ROMTYPE_S2SMS, ROMTYPE_S2GG, ROMTYPE_SLAB
                GameType = &H6
            Case ROMTYPE_SCSMS, ROMTYPE_SCGG
                GameType = &H7
            Case ROMTYPE_STTGG, ROMTYPE_S96
                GameType = &H8
            Case ROMTYPE_SCD
                GameType = &H9
            Case ROMTYPE_KC
                GameType = &HA
            Case ROMTYPE_GEN_68K
                GameType = &HC
            Case ROMTYPE_RST
                GameType = &HB
            Case ROMTYPE_SSPINSMS
                GameType = &HD
            Case Else
                GameType = &H0
            End Select
        Else
            GameType = &H0
        End If
    Else
        GameType = GameList.ListIndex
    End If
    
    If GameType = &H0 Then
        If FileType = FILE_TYPE_ROM Then
            SmpsOfs = Files(FileList.ListIndex).Offset
            If ROMData(SmpsOfs + &H0) = &HA And ROMData(SmpsOfs + &H1) = &H0 Then
                GameType = &H5  ' Sonic 1 SMS
            ElseIf ROMData(SmpsOfs + &H2) = &HFF Then
                GameType = &H3  ' compressed Sonic 2 music
            End If
        Else
            If SmpsData(&H0) = &HA And SmpsData(&H1) = &H0 Then
                GameType = &H5  ' Sonic 1 SMS
            ElseIf SmpsData(&H2) = &HFF Then
                GameType = &H3  ' compressed Sonic 2 music
            End If
        End If
    End If
    
    Select Case GameType
    Case &H0
        SmpsOpts = &H0
    Case &H1
        SmpsOpts = SMPSOPT_IS_68K
    Case &H2, &H3
        SmpsOpts = SMPSOPT_COMPRESSED Or SMPSOPT_IS_Z80 Or SMPSOPT_S2_MODE
        'SmpsOfsLock = &H1380
    Case &H4, &HE, &HF
        SmpsOpts = SMPSOPT_IS_Z80
    Case &H5
        SmpsOpts = SMPSOPT_IS_S1SMS
    Case &H6, &H7, &H8
        SmpsOpts = SMPSOPT_IS_S2SMS
    Case &H9
        SmpsOpts = SMPSOPT_IS_SCD
    Case &HA
        SmpsOpts = SMPSOPT_IS_32X
    Case &HB
        SmpsOpts = SMPSOPT_IS_68K Or SMPSOPT_IS_RST
    Case &HC
        SmpsOpts = SMPSOPT_IS_68K Or SMPSOPT_IS_GEN
    Case &HD
        SmpsOpts = SMPSOPT_IS_S1SMS Or &H1
    End Select
    
    Select Case GameType
    Case &H1 To &H4
        If SmpsOpts And SMPSOPT_IS_Z80 Then
            Opt_SmMode = SMPSVER_Z80
        Else
            Opt_SmMode = SMPSVER_68K
        End If
        Opt_SmModeSub = &H0
        If (SmpsOpts And SMPSOPT_IS_Z80) = SMPSOPT_IS_68K Or _
            CBool(SmpsOpts And SMPSOPT_S2_MODE) Then
            Opt_GamMode = COORD_S12
            If GameType = &H3 Then
                Opt_TmpMode = TEMPOMODE_S2
            Else
                Opt_TmpMode = TEMPOMODE_S12B
            End If
        Else
            Opt_GamMode = COORD_S3K
            Opt_TmpMode = TEMPOMODE_S3K
        End If
    Case &H5
        Opt_SmMode = &H0
        Opt_SmModeSub = &H0
        Opt_GamMode = &H0
        Opt_TmpMode = &H0
    Case &H6 To &H8
        Opt_SmMode = SMPSVER_SMS
        Opt_SmModeSub = GameType - &H6
        Opt_GamMode = COORD_SMS
        Opt_TmpMode = TEMPOMODE_S12B
    Case &H9
        Opt_SmMode = SMPSVER_PCM
        Opt_SmModeSub = &H0
        Opt_GamMode = COORD_PCM
        Opt_TmpMode = TEMPOMODE_S12B
    Case &HA
        Opt_SmMode = SMPSVER_32X
        Opt_SmModeSub = &H0
        Opt_GamMode = COORD_32X
        Opt_TmpMode = TEMPOMODE_S3K
    Case &HB
        Opt_SmMode = SMPSVER_68K
        Opt_SmModeSub = &H1
        Opt_GamMode = COORD_RST
        Opt_TmpMode = TEMPOMODE_S3K
    Case &HC
        Opt_SmMode = SMPSVER_68K
        Opt_SmModeSub = &H0
        Opt_GamMode = COORD_68K
        Opt_TmpMode = TEMPOMODE_S12B
    Case &HD
        Opt_SmMode = &H0
        Opt_SmModeSub = &H1
        Opt_GamMode = &H0
        Opt_TmpMode = &H0
    Case &HE, &HF
        Opt_SmMode = SMPSVER_Z80
        Opt_SmModeSub = &H0
        Opt_GamMode = IIf(GameType = &HF, COORD_Z80b, COORD_Z80a)
        Opt_TmpMode = TEMPOMODE_S3K
    Case Else
        Opt_SmMode = &H0
        Opt_SmModeSub = &H0
        Opt_GamMode = &H0
        Opt_TmpMode = &H0
    End Select
    
    On Error Resume Next
    Opt_MidRes = CByte(MidiResText.Text)
    On Error GoTo 0

End Sub

Private Sub S2M_Button_Click()

    If FileType = FILE_TYPE_BAD Then Exit Sub
    If FileType = FILE_TYPE_ROM And FileList.ListIndex = -1 Then Exit Sub
    
    Dim FileName As String
    Dim SmpsOfs As Long
    Dim DataOfs As Long
    Dim RomBankMode As Boolean
    Dim RetVal As Byte
    
    Call SetConvOptions
    
    If FileType = FILE_TYPE_ROM Then
        With Files(FileList.ListIndex)
            SmpsOfs = .Offset
            SmpsLen = .Length And &H7FFF
        End With
        If SmpsLen = &H0 Then Exit Sub
        
        RomBankMode = CBool(SmpsOpts And (SMPSOPT_IS_Z80 Or SMPSOPT_IS_32X))
        ' Compression and ROM bank mode are incompatible
        If ROMData(SmpsOfs + &H2) = &HFF Then RomBankMode = False
        'If SmpsOpts And &H80 Then RomBankMode = False
        
        If RomBankMode Then
            If SmpsOpts And &H80 Then
                ' Master System ROM Bank
                ReDim SmpsData(&H0 To &H3FFF)
                Call CopyMemory(SmpsData(&H0), ROMData(SmpsOfs And Not &H3FFF&), &H4000&)
                SmpsLen = &H4000&
            Else
                ReDim SmpsData(&H0 To &H7FFF)
                Call CopyMemory(SmpsData(&H0), ROMData(SmpsOfs And Not &H7FFF&), &H8000&)
                SmpsLen = &H8000&
            End If
        Else
            ReDim SmpsData(&H0 To SmpsLen - 1)
            Call CopyMemory(SmpsData(&H0), ROMData(SmpsOfs), SmpsLen)
        End If
    Else
        SmpsOfs = &H0
    End If
    
    On Error Resume Next
    SmpsOfs = CLng("&H" & MemBaseText.Text)
    On Error GoTo 0
    
    If (SmpsOpts And &HF0) <> SMPSOPT_IS_S1SMS Then
        If RomBankMode Then
            'DataOfs = SmpsOfs And &H8000&
            DataOfs = SmpsOfs And Not (SmpsLen - 1) And &HFFFF&
            SmpsOfs = SmpsOfs And (SmpsLen - 1)
            Call LoadSMPSData(SmpsLen, SmpsData(), DataOfs, SmpsOfs)
        Else
            Call LoadSMPSData(SmpsLen, SmpsData(), SmpsOfs, &H0)
        End If
        
        RetVal = SMPS2MID()
    Else
        Call LoadSMSData(SmpsLen, SmpsData(), SmpsOfs)
        
        RetVal = SMS2MID()
    End If
    
    If RetVal > &H0 Then
        'MsgBox "Error converting file!", vbCritical
        GameLabel.Caption = "Error converting file!"
        Exit Sub
    Else
        GameLabel.Caption = "File successfully converted."
    End If
    
    FileName = SaveDialog("Standard MIDI Files (*.mid)|*.mid")
    If FileName = "" Then Exit Sub
    MidLen = ReturnMIDData(MidData())
    
    Call SaveFile(FileName, MidLen, MidData())

End Sub

Private Sub SaveFile(ByVal FileName As String, ByVal DataLen As Long, ByRef Data() As Byte)

    Dim Ask As VbMsgBoxResult
    
    On Error GoTo SaveError
    
    Open FileName For Output As #2
    Close #2
    Open FileName For Binary Access Write As #2
        Put #2, 1, Data()
    Close #2
    
    Exit Sub

SaveError:

    Ask = MsgBox("Error saving file. Try again?", vbQuestion Or vbYesNo)
    If Ask = vbYes Then Resume
    
    Exit Sub

End Sub

Private Function ReadBELong(ByRef FileData() As Byte, ByVal Pos As Long) As Long

    Dim TempArr(&H0 To &H3) As Byte
    Dim TempLng As Long
    Dim CurByt As Byte
    
    For CurByt = &H0 To &H3
        TempArr(&H3 - CurByt) = FileData(Pos + CurByt)
    Next CurByt
    
    Call CopyMemory(TempLng, TempArr(&H0), &H4)
    ReadBELong = TempLng

End Function

Private Function ReadBEShort(ByRef FileData() As Byte, ByVal Pos As Long) _
                            As Integer

    Dim TempArr(&H0 To &H1) As Byte
    Dim TempSht As Integer
    Dim CurByt As Byte
    
    For CurByt = &H0 To &H1
        TempArr(&H1 - CurByt) = FileData(Pos + CurByt)
    Next CurByt
    
    Call CopyMemory(TempSht, TempArr(&H0), &H2)
    ReadBEShort = TempSht

End Function

Private Function HexOutput(ByVal Value As Long, ByVal Zeroes As Byte) As String

    Dim TempStr As String
    
    TempStr = Format$(Hex$(Value), String$(Zeroes, "@"))
    If Len(TempStr) <= Zeroes Then
        TempStr = Replace(TempStr, " ", "0")
    Else
        TempStr = Right$(TempStr, Zeroes)
    End If
    HexOutput = TempStr

End Function

Private Function OpenDialog(Filter As String, Optional Title As String) As String

    ' Function from gym2mid
    Dim OFLNM As OPENFILENAME
    Dim lReturn As Long
    
    Filter = Replace(Filter, "|", Chr$(0))
    With OFLNM
        .lStructSize = Len(OFLNM)
        .hwndOwner = Me.hWnd
        .hInstance = App.hInstance
        .lpstrFilter = Filter
        .nFilterIndex = 1
        .lpstrFile = String(257, &H0)
        .nMaxFile = Len(.lpstrFile) - 1
        .lpstrFileTitle = .lpstrFile
        .nMaxFileTitle = .nMaxFile
        '.lpstrInitialDir = ""
        If Title <> "" Then .lpstrTitle = Title
        .Flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST
        .lpstrDefExt = Mid$(Filter, InStrRev(Filter, ".") + 1)
        
        lReturn = GetOpenFileName(OFLNM)
        If lReturn <> 0 Then
            OpenDialog = .lpstrFile
            OpenDialog = Left$(OpenDialog, InStr(1, OpenDialog, Chr$(0)) - 1)
        Else
            OpenDialog = ""
        End If
    
    End With

End Function

Private Function SaveDialog(Filter As String, Optional Title As String, _
                            Optional FileTitle As String) As String

    ' Function from gym2mid
    Dim OFLNM As OPENFILENAME
    Dim lReturn As Long
    
    Filter = Replace(Filter, "|", Chr$(0))
    With OFLNM
        .lStructSize = Len(OFLNM)
        .hwndOwner = Me.hWnd
        .hInstance = App.hInstance
        .lpstrFilter = Filter
        .nFilterIndex = 1
        .lpstrFile = FileTitle & String(&H101 - Len(FileTitle), &H0)
        .nMaxFile = Len(.lpstrFile) - 1
        .lpstrFileTitle = .lpstrFile
        .nMaxFileTitle = .nMaxFile
        '.lpstrInitialDir = ""
        If Title <> "" Then .lpstrTitle = Title
        .Flags = OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST + _
                OFN_CREATEPROMPT
        .lpstrDefExt = Mid$(Filter, InStrRev(Filter, Chr$(0)) + 2)
        
        lReturn = GetSaveFileName(OFLNM)
        If lReturn <> 0 Then
            SaveDialog = .lpstrFile
            SaveDialog = Left$(SaveDialog, InStr(1, SaveDialog, Chr$(0)) - 1)
        Else
            SaveDialog = ""
        End If
    
    End With

End Function