listing.frm

能处理星际争霸

If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
sLine = CmdLine
If Right(sLine, 1) <> " " Then sLine = sLine + " "
If sLine <> "" Then
    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 "?", "h", "help"
        mnuHReadme_Click
    Case "o", "open"
        OldFileName = CD.FileName
        If Param(2) <> "" Then
            CD.FileName = FullPath(CurPath, Param(2))
        End If
        If Param(3) <> "" And FileExists(CD.FileName) = False And CD.FileName <> "" Then
            DefaultMaxFiles = Param(3)
        End If
        If FileExists(CD.FileName) Then
            OpenMpq
            If CD.FileName = "" Then
                CD.FileName = OldFileName
                StatBar.SimpleText = "The file does not contain an MPQ archive."
            Else
                StatBar.SimpleText = "Opened " + CD.FileName
                AddRecentFile CD.FileName
            End If
        ElseIf FileExists(CD.FileName) = False And CD.FileName <> "" Then
            ReDim FileList(0) As String
            List.ListItems.Clear
            ShowSelected
            ShowTotal
            NewFile = True
            ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
            mnuMpq.Enabled = True
            For Each TItem In mnuTItem
                TItem.Enabled = True
            Next TItem
            Toolbar.Buttons.Item("Add").Enabled = True
            Toolbar.Buttons.Item("Add Folder").Enabled = True
            Toolbar.Buttons.Item("Extract").Enabled = True
            Toolbar.Buttons.Item("Compact").Enabled = True
            Toolbar.Buttons.Item("List").Enabled = True
            If InStr(CD.FileName, "\") > 0 Then
                For bNum = 1 To Len(CD.FileName)
                    If InStr(bNum, CD.FileName, "\") > 0 Then
                        bNum = InStr(bNum, CD.FileName, "\")
                    Else
                        Exit For
                    End If
                Next bNum
            End If
            Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
            StatBar.SimpleText = "Created new " + CD.FileName
            AddRecentFile CD.FileName
        ElseIf CD.FileName = "" Then
            StatBar.SimpleText = "Required parameter missing"
        End If
    Case "n", "new"
        If Param(2) <> "" Then
            CD.FileName = FullPath(CurPath, Param(2))
            If Param(3) <> "" Then
                DefaultMaxFiles = Param(3)
            End If
            If CD.FileName <> "" Then
                ReDim FileList(0) As String
                List.ListItems.Clear
                ShowSelected
                ShowTotal
                NewFile = True
                ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
                mnuMpq.Enabled = True
                For Each TItem In mnuTItem
                    TItem.Enabled = True
                Next TItem
                Toolbar.Buttons.Item("Add").Enabled = True
                Toolbar.Buttons.Item("Add Folder").Enabled = True
                Toolbar.Buttons.Item("Extract").Enabled = True
                Toolbar.Buttons.Item("Compact").Enabled = True
                Toolbar.Buttons.Item("List").Enabled = True
                If InStr(CD.FileName, "\") > 0 Then
                    For bNum = 1 To Len(CD.FileName)
                        If InStr(bNum, CD.FileName, "\") > 0 Then
                            bNum = InStr(bNum, CD.FileName, "\")
                        Else
                            Exit For
                        End If
                    Next bNum
                End If
                Caption = "WinMPQ - " + Mid(CD.FileName, bNum)
                StatBar.SimpleText = "Created new " + CD.FileName
                AddRecentFile CD.FileName
            End If
        Else
            StatBar.SimpleText = "Required parameter missing"
        End If
    Case "c", "close"
        StatBar.SimpleText = "Close is for scripts only"
    Case "p", "pause"
        StatBar.SimpleText = "Pause not supported"
    Case "a", "add"
        If CD.FileName <> "" Then
            ReDim FileShortNames(0) As String
            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
                MousePointer = 11
                If NewFile = True Then
                    If FileExists(CD.FileName) Then Kill CD.FileName
                    NewFile = False
                End If
                Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
                List.Sorted = False
                FileFilter = mFilter
                hMPQ = mOpenMpq(CD.FileName)
                If hMPQ = 0 Then
                    StatBar.SimpleText = "Can't create archive " + CD.FileName
                    Exit Sub
                End If
                For pNum = 1 To Len(Files)
                    fEndLine = InStr(pNum, Files, vbCrLf)
                    fLine = Mid(Files, pNum, fEndLine - pNum)
                    If cType = 0 Then
                        StatBar.SimpleText = "Adding " + fLine + "..."
                    ElseIf cType = 1 Then
                        StatBar.SimpleText = "Adding compressed " + fLine + "..."
                    ElseIf cType = 2 Then
                        StatBar.SimpleText = "Adding compressed WAV " + fLine + "..."
                    ElseIf cType = -1 Then
                        StatBar.SimpleText = "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
                        If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                        mFilter.AddItem "*" + GetExtension(Param(3) + fLine)
                        For cNum = 1 To mFilter.ListCount - 1
                            If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
                                mFilter.RemoveItem cNum
                                Exit For
                            End If
                        Next cNum
                        If MatchesFilter(Param(3) + fLine, FileFilter) Then
                            ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String
                            FileShortNames(UBound(FileShortNames)) = Param(3) + fLine
                        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
                        If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                        mFilter.AddItem "*" + GetExtension(Param(3))
                        For cNum = 1 To mFilter.ListCount - 1
                            If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
                                mFilter.RemoveItem cNum
                                Exit For
                            End If
                        Next cNum
                        If MatchesFilter(Param(3), FileFilter) Then
                            ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String
                            FileShortNames(UBound(FileShortNames)) = Param(3)
                        End If
                    End If
                    StatBar.SimpleText = StatBar.SimpleText + " Done"
                    fCount = fCount + 1
                    pNum = fEndLine + 1
                Next pNum
                MpqCloseUpdatedArchive hMPQ, 0
                If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                If UBound(FileShortNames) > 1 Then
                    If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
                        StatBar.SimpleText = "Adding files to listing... 0% complete"
                        For pNum = 1 To UBound(FileShortNames)
                            If MatchesFilter(FileShortNames(pNum), FileFilter) Then
                                MpqAddToListing hMPQ, FileShortNames(pNum)
                            End If
                            On Error Resume Next
                            StatBar.SimpleText = "Adding files to listing... " + CStr(Int((pNum / UBound(FileShortNames)) * 100)) + "% complete"
                            On Error GoTo 0
                        Next pNum
                        SFileCloseArchive hMPQ
                    End If
                ElseIf UBound(FileShortNames) = 1 Then
                    AddToListing FileShortNames(1)
                End If
                MousePointer = 0
                If MatchesFilter("(listfile)", FileFilter) Then
                    AddToListing "(listfile)"
                End If
                mFilter = FileFilter
                List.Sorted = True
                RemoveDuplicates
                ShowTotal
                If fCount > 1 Then
                    StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " added"
                End If
            Else
                StatBar.SimpleText = "Required parameter missing"
            End If
        Else
            StatBar.SimpleText = "No archive open"
        End If
    Case "e", "extract"
        If CD.FileName <> "" Then
            If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "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
                MousePointer = 11
                If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
                    Files = MpqDir(CD.FileName, Param(2))
                    If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
                        StatBar.SimpleText = "Can't open archive " + CD.FileName
                        Exit Sub
                    End If
                    For pNum = 1 To Len(Files)
                        fEndLine = InStr(pNum, Files, vbCrLf)
                        fLine = Mid(Files, pNum, fEndLine - pNum)
                        StatBar.SimpleText = "Extracting " + fLine + "..."
                        sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
                        StatBar.SimpleText = StatBar.SimpleText + " Done"
                        fCount = fCount + 1
                        pNum = fEndLine + 1
                    Next pNum
                    SFileCloseArchive hMPQ
                    If fCount > 1 Then
                        StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " extracted"
                    End If
                Else
                    If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
                        StatBar.SimpleText = "Can't open archive " + CD.FileName
                        Exit Sub
                    End If
                    sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
                    SFileCloseArchive hMPQ
                    StatBar.SimpleText = StatBar.SimpleText + " Done"
                End If
                MousePointer = 0
            Else
                StatBar.SimpleText = "Required parameter missing"
            End If
        Else
            StatBar.SimpleText = "No archive open"
        End If
    Case "r", "ren", "rename"
        If CD.FileName <> "" Then
            If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Renaming " + Param(2) + " => " + Param(3) + "..."