biosdir.cls

awd bios文件的修改工具

            MsgBox "This version of this program does not know what to do with BIOSType " & mBT & ". Do NOT use the generated file."
            lS = ""
        End Select
    Next lI
    pGenBIOS = lS
End Function

Private Function pGetBIOSArray(iStr As String) As Variant
Dim lL As Long
Dim lC As Long
Dim lCs As Double
Dim lA() As String
    lL = 1
    Do Until lL = 0
        lL = InStr(lL, iStr, "-lh")
        If Mid(iStr, lL + 4, 1) = "-" Then
            ReDim Preserve lA(lC)
            ReDim Preserve mR(lC)
            'set base value
            lCs = 3
            'Read the header size
            lCs = lCs + S2B(Mid(iStr, lL - 2, 1))
            'Add the Data Size
            lCs = lCs + S2DW(Mid(iStr, lL + 5, 4))
            'Fetch the Data into the string
            lA(lC) = Mid(iStr, lL - 2, lCs)
            mR(lC) = pGenRomTags(lA(lC))
            'Deal with special locations
            If ((lL = 131075) And (mBT = 0)) Then mR(lC).RomLocation_RomSeg = 131072
            If ((lL = 131075) And (mBT = 3)) Then mR(lC).RomLocation_RomSeg = 131072
            If ((lL = 241667) And (mBT = 3)) Then mR(lC).RomLocation_RomSeg = 241664
            If ((lL = 131075) And (mBT = 4)) Then mR(lC).RomLocation_RomSeg = 131072
            If ((lL = 212995) And (mBT = 4)) Then mR(lC).RomLocation_RomSeg = 212992
            If ((lL = 131075) And (mBT = 6)) Then mR(lC).RomLocation_RomSeg = 131072
            If ((lL = 212995) And (mBT = 6)) Then mR(lC).RomLocation_RomSeg = 212992

            lL = lL + 1
            lC = lC + 1
        Else
            If lL <> 0 Then
                lL = lL + 1
            End If
        End If
    Loop
    pGetBIOSArray = lA
End Function

Private Function pGenRomTags(iStr As String) As RomSeg
Dim lR As RomSeg
    lR.RomFile_RomSeg = Trim2File(Mid(iStr, 23, S2B(Mid(iStr, 22, 1))))
    lR.RomOffset_RomSeg = S2W(Mid(iStr, 16, 2))
    lR.RomBase_RomSeg = S2W(Mid(iStr, 18, 2))
    pGenRomTags = lR
End Function

Public Function pGenDef() As String
    pGenDef = "<BIOS>" & vbCrLf & "<Base>RomBase.bin</Base>" & vbCrLf & "<BIOSType>" & mBT & "</BIOSType>" & vbCrLf & pRomString & "</BIOS>" & vbCrLf
End Function

Private Function pRomString() As String
Dim lS As String
Dim lC As Long
    For lC = LBound(mR) To UBound(mR)
        lS = lS & "<Rom>" & vbCrLf
        lS = lS & "<Name>" & mR(lC).RomFile_RomSeg & "</Name>" & vbCrLf
        lS = lS & "<Base>" & mR(lC).RomBase_RomSeg & "</Base>" & vbCrLf
        If mR(lC).RomOffset_RomSeg <> "" Then
            lS = lS & "<Offset>" & mR(lC).RomOffset_RomSeg & "</Offset>" & vbCrLf
        End If
        If mR(lC).RomLocation_RomSeg <> "" Then
            lS = lS & "<Location>" & mR(lC).RomLocation_RomSeg & "</Location>" & vbCrLf
        End If
        lS = lS & "</Rom>" & vbCrLf
    Next lC
    pRomString = lS
End Function

Private Sub pDecompress(iPath As String, iLHA As String)
Dim lDC As New LHA_Handler
    lDC.SetItem LHA_eRefs, iLHA
    pWriteFile iPath & lDC.GetItem(FileName_eRefs), lDC.GetItem(Data_eRefs)
End Sub

Private Sub pParseDefFile(iStr As String)
'Right now we're going to do this very wrong
Dim lP(0 To 1) As Long
Dim lNS As Long
Dim lPV As Long
    'check for BIOSType (which is NOT required)
    lP(0) = InStr(1, iStr, "<BIOSType>") + 10
    If lP(0) > 10 Then
        lP(1) = InStr(1, iStr, "</BIOSType>")
        mBT = Mid(iStr, lP(0), lP(1) - lP(0))
    Else
        mBT = 0
    End If

    'find base
    lP(0) = InStr(lNS + 1, iStr, "<Base>") + 6
    lNS = lP(0)
    'find base end
    lP(1) = InStr(lNS + 1, iStr, "</Base>")
    lNS = lP(1) + 7
    'Copy Base to mRB
    mRB = Mid(iStr, lP(0), lP(1) - lP(0))
    
    Do Until lNS < lPV
        lPV = lNS
        lP(0) = InStr(lNS + 1, iStr, "<Rom>") + 5
        lNS = lP(0)
        
        lP(1) = InStr(lNS + 1, iStr, "</Rom>")
        lNS = lP(1) + 6
        pParseRomDef Mid(iStr, lP(0), lP(1) - lP(0))
        ReDim Preserve mR(0 To UBound(mR) + 1)
    Loop
    ReDim Preserve mR(LBound(mR) To UBound(mR) - 2)
End Sub

Private Sub pParseRomDef(iStr As String)
Dim lP(0 To 1) As Long
Dim lSeg As Long
    lSeg = UBound(mR)
    
    'check for Name (which is required)
    lP(0) = InStr(1, iStr, "<Name>") + 6
    lP(1) = InStr(1, iStr, "</Name>")
    mR(lSeg).RomFile_RomSeg = Mid(iStr, lP(0), lP(1) - lP(0))
    
    'check for Base (which is required)
    lP(0) = InStr(1, iStr, "<Base>") + 6
    lP(1) = InStr(1, iStr, "</Base>")
    mR(lSeg).RomBase_RomSeg = Mid(iStr, lP(0), lP(1) - lP(0))

    'check for Offset (which is NOT required)
    lP(0) = InStr(1, iStr, "<Offset>") + 8
    If lP(0) > 8 Then
        lP(1) = InStr(1, iStr, "</Offset>")
        mR(lSeg).RomOffset_RomSeg = Mid(iStr, lP(0), lP(1) - lP(0))
    End If

    'check for Location (which is NOT required)
    lP(0) = InStr(1, iStr, "<Location>") + 10
    If lP(0) > 10 Then
        lP(1) = InStr(1, iStr, "</Location>")
        mR(lSeg).RomLocation_RomSeg = Mid(iStr, lP(0), lP(1) - lP(0))
    End If
End Sub

Private Sub pInit()
    'generate a temp Directory
    'mCD = pGenTD
    
    mRB = ""
    ReDim mR(0)
End Sub

Private Sub pCopyDir(iSource As String, iDest As String)
Dim lI As Long
    pSafeDir iDest
    FileCopy iSource & "BIOSDEF.txt", iDest & "BIOSDEF.txt"
    FileCopy iSource & "RomBase.bin", iDest & "RomBase.bin"
    For lI = LBound(mR) To UBound(mR)
        FileCopy iSource & "Roms\" & mR(lI).RomFile_RomSeg, iDest & "Roms\" & mR(lI).RomFile_RomSeg
    Next lI
End Sub

'Utility Functions
Private Sub pSafeDir(iDir As String)
On Error Resume Next
    MkDir iDir
    MkDir iDir & "Roms"
out:
End Sub

Private Function pGenTD() As String
    'Create a Temp Directory
    pGenTD = Environ("TEMP") & "\" & Format(Now, "YYYYMMDDHHMMNNss") & "\"
    MkDir pGenTD
    MkDir pGenTD & "Roms"
End Function

Private Function pTestFile(iFileName As String) As Boolean
On Error GoTo lfail
Dim lF As Integer
    lF = FreeFile
    Open iFileName For Input Access Read As lF
    Close lF
    pTestFile = True
    Exit Function
lfail:
End Function

Private Function pLoadFile(iFileName As String) As String
Dim lS As String
Dim lF As Integer
    lF = FreeFile
    Open iFileName For Binary As lF
    lS = Space(LOF(lF))
    Get lF, , lS
    Close lF
    pLoadFile = lS
End Function

Private Sub pWriteFile(iFileName, iStr As String)
Dim lF As Integer
    lF = FreeFile
    Open iFileName For Binary As lF
    Put lF, , iStr
    Close lF
End Sub

Private Function S2B(iStr As String) As Byte
Dim lI As Byte
    For lI = 1 To 1
        S2B = Asc(Mid(iStr, lI, 1))
    Next lI
End Function

Private Function S2W(iStr As String) As Long
Dim lI As Long
Dim lL As Long
    For lI = 1 To 2
        S2W = S2W + (2 ^ (((lI - 1) * 8)) * Asc(Mid(iStr, lI, 1)))
    Next lI
End Function

Private Function S2DW(iStr As String) As Double
Dim lI As Integer
    For lI = 1 To 4
        S2DW = S2DW + (2 ^ (((lI - 1) * 8)) * Asc(Mid(iStr, lI, 1)))
    Next lI
End Function

Private Function B2S(iByte As Byte) As String
Dim lI As Integer
    For lI = 1 To 1
        B2S = B2S & Chr(Fix(iByte / (2 ^ (((lI - 1) * 8)))) And 255)
    Next lI
End Function

Private Function W2S(iLng As Long) As String
Dim lI As Integer
    For lI = 1 To 2
        W2S = W2S & Chr(Fix(iLng / (2 ^ (((lI - 1) * 8)))) And 255)
        'Debug.Print Asc(W2S)
    Next lI
End Function

Private Function DW2S(iDbl As Double) As String
Dim lI As Integer
    For lI = 1 To 4
        DW2S = DW2S & Chr(Fix(iDbl / (2 ^ (((lI - 1) * 8)))) And 255)
    Next lI
End Function

Private Function pInsert(iDest As String, iSource As String, iLoc As Long) As Long
Dim lL As Long 'length of iSource
Dim lS(0 To 1) As String 'left and right of iDest around iSource
    lL = Len(iSource)
    If iLoc + lL > Len(iDest) Then
        pInsert = -1
        Exit Function
    End If
    lS(0) = Left(iDest, iLoc)
    lS(1) = Right(iDest, Len(iDest) - (iLoc + lL))
    iDest = lS(0) & iSource & lS(1)
    pInsert = lL + iLoc
End Function

Private Sub Class_Initialize()
    'generate a temp Directory
    mCD = pGenTD
End Sub

Private Sub Class_Terminate()
On Error Resume Next
Dim lI As Long
    Kill mCD & "Rombase.bin"
    Kill mCD & "biosdef.txt"
    If LBound(mR) & "" = "I Love Bethie and Stephie" Then
        'Well Damn we caught a bug
        GoTo DirClean
    Else
        For lI = LBound(mR) To UBound(mR)
            Kill mCD & "Roms\" & mR(lI).RomFile_RomSeg
        Next lI
    End If
DirClean:
    RmDir mCD & "roms\"
    RmDir mCD
End Sub