mpqstuff.bas

能处理星际争霸

Next bNum
Do Until InStr(NewFileName, "*") = 0
    NewFileName = Left(NewFileName, InStr(NewFileName, "*") - 1) + Mid(NewFileName, InStr(NewFileName, "*") + 1)
Loop
Do Until InStr(NewFileName, "?") = 0
    NewFileName = Left(NewFileName, InStr(NewFileName, "?") - 1) + Mid(NewFileName, InStr(NewFileName, "?") + 1)
Loop
RenameWithFilter = NewFileName
End Function
Function MpqDir(MpqFile As String, Filters As String)
Dim Files() As FILELISTENTRY, fNum As Long, szFileList As String, NamePos As Long, CurFileName As String
Dim hMPQ As Long
If SFileOpenArchive(MpqFile, 0, 0, hMPQ) Then
    If sListFiles(MpqFile, hMPQ, ListFile, Files) Then
        SFileCloseArchive hMPQ
        For fNum = 0 To UBound(Files)
            If Files(fNum).dwFileExists Then
                CurFileName = StrConv(Files(fNum).szFileName, vbUnicode)
                If MatchesFilter(CurFileName, Filters) Then
                    NamePos = InStr(1, szFileList, CurFileName + vbCrLf, 1)
                    If NamePos > 1 Then
                        NamePos = InStr(1, szFileList, vbCrLf + CurFileName + vbCrLf, 1)
                    End If
                    If NamePos > 0 Then _
                        szFileList = szFileList + CurFileName
                End If
            End If
        Next fNum
        MpqDir = MpqDir + CurFileName + vbCrLf
    Else
        SFileCloseArchive hMPQ
    End If
End If
End Function
Sub RunScript(ScriptName As String)
Dim fNum As Long, Script As String, sLine As String, Param() As String, bNum As Long, EndLine As Long, pNum As Long, EndParam As Long, MpqFile As String, OldDefaultMaxFiles As Long, cType As Integer, lNum As Long, OldPath As String, NewPath As String, Rswitch As Boolean, Files As String, fCount As Long, fEndLine As Long, fLine As String, ScriptNewFile As Boolean, CurPath As String, fLine2 As String, fLineTitle As String, hMPQ As Long, hFile As Long, dwFlags
If FileExists(ScriptName) = False Then
    ScriptOut.Show
    AddScriptOutput "Could not find script " + ScriptName + vbCrLf
    Exit Sub
End If
fNum = FreeFile
Open ScriptName For Binary As #fNum
Script = String(LOF(fNum), Chr(0))
Get #fNum, 1, Script
Close #fNum
OldPath = CurDir
If InStr(ScriptName, "\") > 0 Then
    For bNum = 1 To Len(ScriptName)
        If InStr(bNum, ScriptName, "\") > 0 Then
            bNum = InStr(bNum, ScriptName, "\")
            NewPath = Left(ScriptName, bNum)
        End If
    Next bNum
    If Mid(NewPath, 2, 1) = ":" Then ChDrive Left(NewPath, 1)
    ChDir NewPath
End If
CurPath = CurDir
If Right(Script, 2) <> vbCrLf Then Script = Script + vbCrLf
ScriptOut.Show
AddScriptOutput "Script: " + ScriptName + vbCrLf + vbCrLf
OldDefaultMaxFiles = DefaultMaxFiles
lNum = 1
For bNum = 1 To Len(Script)
    EndLine = InStr(bNum, Script, vbCrLf)
    sLine = Mid(Script, bNum, EndLine - bNum)
    If Right(sLine, 1) <> " " Then sLine = sLine + " "
    If sLine <> "" Then
        AddScriptOutput "Line " + CStr(lNum) + ": "
        ReDim Param(0) As String
        For pNum = 1 To Len(sLine)
            If Mid(sLine, pNum, 1) = Chr(34) Then
                pNum = pNum + 1
                EndParam = InStr(pNum, sLine, Chr(34))
            Else
                EndParam = InStr(pNum, sLine, " ")
            End If
            If EndParam = 0 Then EndParam = Len(sLine) + 1
            If pNum <> EndParam Then
                If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
                    ReDim Preserve Param(UBound(Param) + 1) As String
                    Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
                End If
            End If
            pNum = EndParam
        Next pNum
        If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
        Select Case LCase(Param(1))
        Case "o", "open"
            If Param(2) <> "" Then
                MpqFile = Param(2)
                If Param(3) <> "" And FileExists(MpqFile) = False Then
                    DefaultMaxFiles = Param(3)
                End If
                If FileExists(MpqFile) Then
                    AddScriptOutput "Opened " + MpqFile + vbCrLf
                Else
                    AddScriptOutput "Created new " + MpqFile + vbCrLf
                End If
                NewPath = CurPath
            Else
                AddScriptOutput "Required parameter missing" + vbCrLf
            End If
        Case "n", "new"
            If Param(2) <> "" Then
                MpqFile = Param(2)
                If Param(3) <> "" Then
                    DefaultMaxFiles = Param(3)
                End If
                ScriptNewFile = True
                AddScriptOutput "Created new " + MpqFile + vbCrLf
                NewPath = CurPath
            Else
                AddScriptOutput "Required parameter missing" + vbCrLf
            End If
        Case "c", "close"
            If MpqFile <> "" Then
                If LCase(CD.FileName) = LCase(FullPath(NewPath, MpqFile)) Then MpqEx.Timer1.Enabled = True
                AddScriptOutput "Closed " + MpqFile + vbCrLf
                MpqFile = ""
            Else
                AddScriptOutput "No archive open" + vbCrLf
            End If
        Case "p", "pause"
            AddScriptOutput "Pause not supported" + vbCrLf
        Case "a", "add"
            If MpqFile <> "" Then
                cType = 0
                Rswitch = False
                fCount = 0
                Files = ""
                fEndLine = 0
                fLine = ""
                dwFlags = MAFA_REPLACE_EXISTING
                If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
                For pNum = 3 To UBound(Param)
                    If LCase(Param(pNum)) = "/wav" Then
                        cType = 2
                        dwFlags = dwFlags Or MAFA_COMPRESS
                    ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
                        cType = 1
                        dwFlags = dwFlags Or MAFA_COMPRESS
                    ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then
                        cType = -1
                    ElseIf LCase(Param(pNum)) = "/r" Then
                        Rswitch = True
                    End If
                Next pNum
                If Left(Param(3), 1) = "/" Or Param(3) = "" Then
                    If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
                        Param(3) = ""
                    Else
                        Param(3) = Param(2)
                    End If
                End If
                If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
                    If InStr(Param(2), "\") > 0 Then
                        For pNum = 1 To Len(Param(2))
                            If InStr(pNum, Param(2), "\") > 0 Then
                                pNum = InStr(pNum, Param(2), "\")
                                Files = Left(Param(2), pNum)
                            End If
                        Next pNum
                    End If
                    If ScriptNewFile = True Then
                        If FileExists(FullPath(NewPath, MpqFile)) Then Kill FullPath(NewPath, MpqFile)
                        ScriptNewFile = False
                    End If
                    Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
                    hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
                    If hMPQ = 0 Then
                        AddScriptOutput "Can't create archive " + MpqFile + vbCrLf
                        GoTo CommandError
                    End If
                    For pNum = 1 To Len(Files)
                        fEndLine = InStr(pNum, Files, vbCrLf)
                        fLine = Mid(Files, pNum, fEndLine - pNum)
                        If pNum > 1 Then
                            AddScriptOutput "Line " + CStr(lNum) + ": "
                        End If
                        If cType = 0 Then
                            AddScriptOutput "Adding " + fLine + "..."
                        ElseIf cType = 1 Then
                            AddScriptOutput "Adding compressed " + fLine + "..."
                        ElseIf cType = 2 Then
                            AddScriptOutput "Adding compressed WAV " + fLine + "..."
                        ElseIf cType = -1 Then
                            AddScriptOutput "Adding " + fLine + " (compression auto-select)..."
                        End If
                        If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
                            If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
                            If cType = 2 Then
                                MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
                            ElseIf cType = -1 Then
                                mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
                            ElseIf cType = 1 Then
                                MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
                            Else
                                MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
                            End If
                        Else
                            If cType = 2 Then
                                MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0
                            ElseIf cType = -1 Then
                                mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
                            ElseIf cType = 1 Then
                                MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
                            Else
                                MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
                            End If
                        End If
                        AddScriptOutput " Done" + vbCrLf
                        SendMessageA ScriptOut.oText.hWnd, WM_PAINT, 0, &O0
                        fCount = fCount + 1
                        pNum = fEndLine + 1
                    Next pNum
                    MpqCloseUpdatedArchive hMPQ, 0
                    If fCount > 1 Then
                        AddScriptOutput "Line " + CStr(lNum) + ":  " + CStr(fCount) + " files of " + Param(2) + " added" + vbCrLf
                    End If
                Else
                    AddScriptOutput " Required parameter missing" + vbCrLf
                End If
            Else
                AddScriptOutput "No archive open" + vbCrLf
            End If
        Case "e", "extract"
            If MpqFile <> "" Then
                If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Extracting " + Param(2) + "..."
                cType = 0
                For pNum = 3 To UBound(Param)
                    If LCase(Param(pNum)) = "/fp" Then
                        cType = 1
                        Exit For
                    End If
                Next pNum
                If Left(Param(3), 1) = "/" Then Param(3) = ""
                If Param(3) = "" Then Param(3) = "."
                If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
                    If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
                        Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
                        If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
                            AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf
                            GoTo CommandError
                        End If
                        For pNum = 1 To Len(Files)
                            fEndLine = InStr(pNum, Files, vbCrLf)
                            fLine = Mid(Files, pNum, fEndLine - pNum)
                            If pNum > 1 Then
                                AddScriptOutput "Line " + CStr(lNum) + ": "
                            End If
                            AddScriptOutput "Extracting " + fLine + "..."
                            sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
                            AddScriptOutput " Done" + vbCrLf
                            
                            fCount = fCount + 1
                            pNum = fEndLine + 1
                        Next pNum
                        SFileCloseArchive hMPQ
                        If fCount > 1 Then
                            AddScriptOutput "Line " + CStr(lNum) + ":  " + CStr(fCount) + " files of " + Param(2) + " extracted" + vbCrLf
                        End If
                    Else
                        If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
                            AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf
                            GoTo CommandError
                        End If
                        sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
                        SFileCloseArchive hMPQ
                        AddScriptOutput " Done" + vbCrLf
                    End If
                Else
                    AddScriptOutput " Required parameter missing" + vbCrLf
                End If
            Else
                AddScriptOutput "No archive open" + vbCrLf
            End If
        Case "r", "ren", "rename"
            If MpqFile <> "" Then
                If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Renaming " + Param(2) + " => " + Param(3) + "..."
                If Param(2) <> "" And Param(3) <> "" Then
                    If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
                        If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then
                            Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))