listing.frm

能处理星际争霸

            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(CD.FileName, Param(2))
                        hMPQ = mOpenMpq(CD.FileName)
                        If hMPQ Then
                            For pNum = 1 To Len(Files)
                                fEndLine = InStr(pNum, Files, vbCrLf)
                                fLine = Mid(Files, pNum, fEndLine - pNum)
                                fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
                                StatBar.SimpleText = "Renaming " + fLine + " => " + fLine2 + "..."
                                If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
                                    SFileCloseFile hFile
                                    MpqDeleteFile hMPQ, fLine2
                                    MpqRenameFile hMPQ, fLine, fLine2
                                Else
                                    MpqRenameFile hMPQ, fLine, fLine2
                                End If
                                If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                                RenameInListing fLine, fLine2
                                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)
                        End If
                        If fCount > 1 Then
                            StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " renamed"
                        End If
                    Else
                    StatBar.SimpleText = "You must use wildcards with new name"
                    End If
                Else
                    hMPQ = mOpenMpq(CD.FileName)
                    If hMPQ Then
                        If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
                            SFileCloseFile hFile
                            MpqDeleteFile hMPQ, Param(3)
                            MpqRenameFile hMPQ, Param(2), Param(3)
                        Else
                            MpqRenameFile hMPQ, Param(2), Param(3)
                        End If
                        MpqCloseUpdatedArchive hMPQ, 0
                    End If
                    If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                    RenameInListing Param(2), Param(3)
                    StatBar.SimpleText = StatBar.SimpleText + " Done"
                End If
            Else
                StatBar.SimpleText = "Required parameter missing"
            End If
        Else
            StatBar.SimpleText = "No archive open"
        End If
    Case "m", "move"
        If CD.FileName <> "" Then
            For pNum = 1 To Len(Param(2))
                If InStr(pNum, Param(2), "\") Then
                    pNum = InStr(pNum, Param(2), "\")
                Else
                    Exit For
                End If
            Next pNum
            fLineTitle = Mid(Param(2), pNum)
            If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
            Param(3) = Param(3) + fLineTitle
            If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Moving " + Param(2) + " => " + Param(3) + "..."
            If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then
                If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
                    Files = MpqDir(CD.FileName, Param(2))
                    hMPQ = mOpenMpq(CD.FileName)
                    If hMPQ Then
                        For pNum = 1 To Len(Files)
                            fEndLine = InStr(pNum, Files, vbCrLf)
                            fLine = Mid(Files, pNum, fEndLine - pNum)
                            fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
                            StatBar.SimpleText = "Moving " + fLine + " => " + fLine2 + "..."
                            If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
                                SFileCloseFile hFile
                                MpqDeleteFile hMPQ, fLine2
                                MpqRenameFile hMPQ, fLine, fLine2
                            Else
                                MpqRenameFile hMPQ, fLine, fLine2
                            End If
                            If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                            RenameInListing fLine, fLine2
                            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)
                    End If
                    If fCount > 1 Then
                        StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " moved"
                    End If
                Else
                    hMPQ = mOpenMpq(CD.FileName)
                    If hMPQ Then
                        If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
                            SFileCloseFile hFile
                            MpqDeleteFile hFile, Param(3)
                            MpqRenameFile hFile, Param(2), Param(3)
                        Else
                            MpqRenameFile hFile, Param(2), Param(3)
                        End If
                        MpqCloseUpdatedArchive hMPQ, 0
                    End If
                    If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                    RenameInListing Param(2), Param(3)
                    StatBar.SimpleText = StatBar.SimpleText + " Done"
                End If
            Else
                StatBar.SimpleText = "Required parameter missing"
            End If
        Else
            StatBar.SimpleText = "No archive open"
        End If
    Case "d", "del", "delete"
        If CD.FileName <> "" Then
            If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Deleting " + Param(2) + "..."
            If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
                If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
                    Files = MpqDir(CD.FileName, Param(2))
                    hMPQ = mOpenMpq(CD.FileName)
                    If hMPQ Then
                        For pNum = 1 To Len(Files)
                            fEndLine = InStr(pNum, Files, vbCrLf)
                            fLine = Mid(Files, pNum, fEndLine - pNum)
                            StatBar.SimpleText = "Deleting " + fLine + "..."
                            MpqDeleteFile hMPQ, fLine
                            If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                            RemoveFromListing fLine
                            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)
                    End If
                    If fCount > 1 Then
                        StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " deleted"
                    End If
                Else
                    hMPQ = mOpenMpq(CD.FileName)
                    If hMPQ Then
                        MpqDeleteFile hMPQ, Param(2)
                        MpqCloseUpdatedArchive hMPQ, 0
                    End If
                    If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
                    RemoveFromListing Param(2)
                    StatBar.SimpleText = StatBar.SimpleText + " Done"
                End If
            Else
                StatBar.SimpleText = "Required parameter missing"
            End If
        Else
            StatBar.SimpleText = "No archive open"
        End If
    Case "f", "flush", "compact"
        If CD.FileName <> "" Then
            MousePointer = 11
            StatBar.SimpleText = "Flushing " + CD.FileName + "..."
            hMPQ = mOpenMpq(CD.FileName)
            If hMPQ Then
                MpqCompactArchive hMPQ
                MpqCloseUpdatedArchive hMPQ, 0
            End If
            If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
            StatBar.SimpleText = StatBar.SimpleText + " Done"
            MousePointer = 0
            OpenMpq
        Else
            StatBar.SimpleText = "No archive open"
        End If
    Case "l", "list"
        If CD.FileName <> "" Then
            If Param(2) <> "" Then
                StatBar.SimpleText = "Creating list..."
                MousePointer = 11
                If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then
                    Files = MpqDir(CD.FileName, Param(2))
                    Param(2) = Param(3)
                Else
                    Files = MpqDir(CD.FileName, "*")
                End If
                fNum = FreeFile
                Open FullPath(CurPath, Param(2)) For Binary As #fNum
                Put #fNum, 1, Files
                Close #fNum
                StatBar.SimpleText = StatBar.SimpleText + " Done"
                MousePointer = 0
            Else
                StatBar.SimpleText = "Required parameter missing"
            End If
        Else
            StatBar.SimpleText = "No archive open"
        End If
    Case "s", "script"
        StatBar.SimpleText = "Running script " + Param(2) + "..."
        If Param(2) <> "" Then
            MousePointer = 11
            RunScript FullPath(CurPath, Param(2))
            MousePointer = 0
            StatBar.SimpleText = StatBar.SimpleText + " Done"
        Else
            StatBar.SimpleText = "Required parameter missing"
        End If
    Case "x", "exit", "quit"
        Unload Me
    Case Else
        If Left(Param(1), 1) <> ";" Then
            If LCase(Param(1)) = "cd" Or LCase(Param(1)) = "chdir" Then
                On Error Resume Next
                ChDir Param(2)
                On Error GoTo 0
                txtCommand_GotFocus
            ElseIf Left(LCase(Param(1)), 3) = "cd." Or Left(LCase(Param(1)), 3) = "cd\" Then
                On Error Resume Next
                ChDir Mid(Param(1), 3)
                On Error GoTo 0
                txtCommand_GotFocus
            ElseIf Left(LCase(Param(1)), 6) = "chdir." Or Left(LCase(Param(1)), 6) = "chdir\" Then
                On Error Resume Next
                ChDir Mid(Param(1), 6)
                On Error GoTo 0
                txtCommand_GotFocus
            ElseIf Mid(Param(1), 2, 1) = ":" And (Len(Param(1)) = 2 Or Right(Param(1), 1) = "\") Then
                On Error Resume Next
                ChDrive Left(Param(1), 2)
                On Error GoTo 0
                txtCommand_GotFocus
            Else
                Shell "command.com /k " + sLine, 1
            End If
        End If
    End Select
End If
End Sub
Sub BuildRecentFileList()
Dim rNum As Long, rNum2 As Long, RecentFile As String, FirstSep As Long, LastSep As Long, RItem As Menu
For Each RItem In mnuFRecent
    If RItem.Index <> 0 Then Unload RItem
Next RItem
rNum2 = 1
For rNum = 8 To 1 Step -1
    RecentFile = GetReg(AppKey + "Recent\File" + CStr(rNum))
    If FileExists(RecentFile) Then
        mnuFRecent(0).Visible = True
        On Error Resume Next
        Load mnuFRecent(rNum2)
        On Error GoTo 0
        mnuFRecent(rNum2).Tag = RecentFile
        If TextWidth(RecentFile) > TextWidth("________________________________") Then
            FirstSep = InStr(RecentFile, "\")
            If FirstSep > 0 Then
                For LastSep = FirstSep + 1 To Len(RecentFile)
                    If InStr(LastSep, RecentFile, "\") > 0 Then
                        LastSep = InStr(LastSep, RecentFile, "\")
                    Else
                        Exit For
                    End If
                Next LastSep
                RecentFile = Left(RecentFile, FirstSep) + "..." + Mid(RecentFile, LastSep - 1)
            End If
        End If
        mnuFRecent(rNum2).Caption = "&" + CStr(rNum2) + " " + RecentFile
        rNum2 = rNum2 + 1
    End If
    If rNum2 > 4 Then Exit For
Next rNum
End Sub
Sub BuildToolsList()
Dim tNum As Long, ToolName As String, ToolCommand, TItem As Menu
For Each TItem In mnuTItem
    If TItem.Index <> 0 Then Unload TItem
Next TItem
For Each TItem In mnuPTItem
    If TItem.Index <> 0 Then Unload TItem
Next TItem
mnuTItem(0).Caption = "(Empty)"
mnuPTItem(0).Caption = mnuTItem(0).Caption
mnuTItem(0).Tag = ""
mnuPTItem(0).Tag = ""
Do
    ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))
    ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))
    If ToolName = "" Then ToolName = ToolCommand
    If ToolName <> "" Then
        On Error Resume Next
        Load mnuTItem(tNum)
        Load mnuPTItem(tNum)
        On Error GoTo 0
        mnuTItem(tNum).Tag = ToolCommand
        mnuPTItem(tNum).Tag = mnuTItem(tNum).Tag
        If InStr(ToolName, "&") = 0 And tNum < 9 Then
            mnuTItem(tNum).Caption = "&" + CStr(tNum + 1) + " " + ToolName
        ElseIf InStr(ToolName, "&") = 0 And tNum = 9 Then
            mnuTItem(tNum).Caption = "&0 " + ToolName
        Else
            mnuTItem(tNum).Caption = ToolName
        End If
        mnuPTItem(tNum).Caption = mnuTItem(tNum).Caption
    End If
    tNum = tNum + 1
Loop Until ToolName = ""
End Sub
Sub OpenMpq()
Dim Path, FileCont As String, bNum As Long, FileLine As String, nFiles As Long, MpqFileName As String, FileFilter As String, TItem As Menu, hMPQ As Long, hFile As Long, FileEntries() As FILELISTENTRY
On Error Resume Next
If FileExists(CD.FileName) And FileLen(CD.FileName) = 0 Then
    ReDim FileList(0) As String
    List.ListI