listing.frm

能处理星际争霸

         Caption         =   "&Compression"
         Begin VB.Menu mnuMCAuto 
            Caption         =   "Auto-Select"
            Checked         =   -1  'True
            Shortcut        =   {F4}
         End
         Begin VB.Menu mnuMCSep 
            Caption         =   "-"
         End
         Begin VB.Menu mnuMCNone 
            Caption         =   "&None"
            Shortcut        =   {F2}
         End
         Begin VB.Menu mnuMCStandard 
            Caption         =   "&Standard"
            Shortcut        =   {F3}
         End
         Begin VB.Menu mnuMCDeflate 
            Caption         =   "&Deflate"
            Shortcut        =   {F9}
         End
         Begin VB.Menu mnuMCAudio 
            Caption         =   "&Audio"
            Begin VB.Menu mnuMCALowest 
               Caption         =   "&Lowest (Best quality)"
               Shortcut        =   {F6}
            End
            Begin VB.Menu mnuMCAMedium 
               Caption         =   "&Medium"
               Shortcut        =   {F7}
            End
            Begin VB.Menu mnuMCAHighest 
               Caption         =   "&Highest (Least space)"
               Shortcut        =   {F8}
            End
         End
      End
      Begin VB.Menu mnuMEncrypt 
         Caption         =   "Encr&ypt Files"
      End
      Begin VB.Menu mnuMCompact 
         Caption         =   "Com&pact"
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuMAddToList 
         Caption         =   "Add File to Li&sting..."
         Shortcut        =   ^K
      End
      Begin VB.Menu mnuMSaveList 
         Caption         =   "Save File &List..."
         Shortcut        =   ^L
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "&Tools"
      Begin VB.Menu mnuTItem 
         Caption         =   "(Empty)"
         Enabled         =   0   'False
         Index           =   0
      End
      Begin VB.Menu mnuTSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuTMpqEmbed 
         Caption         =   "MPQ Embedder"
      End
      Begin VB.Menu mnuTSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuTAdd 
         Caption         =   "&Add/Remove..."
      End
   End
   Begin VB.Menu mnuOptions 
      Caption         =   "&Options..."
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuHReadme 
         Caption         =   "View &Readme..."
         Shortcut        =   {F1}
      End
      Begin VB.Menu mnuHSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHAbout 
         Caption         =   "&About..."
      End
   End
   Begin VB.Menu mnuPopup 
      Caption         =   "Popup Menu"
      Visible         =   0   'False
      Begin VB.Menu mnuPItem 
         Caption         =   "&Open"
         Index           =   0
      End
      Begin VB.Menu mnuPSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPTools 
         Caption         =   "&Tools"
         Begin VB.Menu mnuPTItem 
            Caption         =   "(Empty)"
            Index           =   0
         End
      End
      Begin VB.Menu mnuPSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPExtract 
         Caption         =   "&Extract"
      End
      Begin VB.Menu mnuPDelete 
         Caption         =   "&Delete"
      End
      Begin VB.Menu mnuPRename 
         Caption         =   "Rena&me"
      End
      Begin VB.Menu mnuPChLCID 
         Caption         =   "Change Locale &ID..."
      End
   End
End
Attribute VB_Name = "MpqEx"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Dim txtCommandHasFocus As Boolean, ShiftState As Boolean
Dim OpenFiles() As String, OpenFileDates() As Date, MpqDate As Date
Sub AddRecentFile(rFileName As String)
Dim bNum As Long, fNum As Long
NewKey AppKey + "Recent\"
For bNum = 1 To 8
    If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then
        For fNum = bNum To 7
            If Not IsEmpty(GetReg(AppKey + "Recent\File" + CStr(fNum + 1))) Then
                SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
            Else
                Exit For
            End If
        Next fNum
        SetReg AppKey + "Recent\File" + CStr(fNum), rFileName
        Exit For
    End If
Next bNum
If fNum = 0 Then
    For bNum = 1 To 8
        If IsEmpty(GetReg(AppKey + "Recent\File" + CStr(bNum))) Then
            SetReg AppKey + "Recent\File" + CStr(bNum), rFileName
            Exit For
        ElseIf bNum = 8 Then
            For fNum = 1 To 7
                SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
            Next fNum
            SetReg AppKey + "Recent\File" + CStr(bNum), rFileName
        End If
    Next bNum
End If
BuildRecentFileList
End Sub
Sub BuildMpqActionList()
Dim Shift As Integer
On Error GoTo NotSelected
List.SelectedItem.Tag = List.SelectedItem.Tag
On Error GoTo 0
If List.SelectedItem.Selected = True Then
    Shift = 0
    If ShiftState = True Then Shift = vbShiftMask
    mnuMItem(0).Visible = True
    mnuMSep1.Visible = True
    BuildPopup List.SelectedItem.Tag, Shift, mnuMpq, mnuMItem
Else
    GoTo NotSelected
End If
Exit Sub
NotSelected:
Dim PItem As Menu
For Each PItem In mnuMItem
    If PItem.Index <> 0 Then Unload PItem
Next PItem
mnuMItem(0).Visible = False
mnuMSep1.Visible = False
End Sub
Sub BuildPopup(FileName As String, Shift As Integer, mnuRoot As Menu, mnuItem)
Dim aNum As Long, aItem As String, aName As String, bNum As Long, PItem As Menu, dItem As String
mnuRoot.Tag = 0
For Each PItem In mnuItem
    If PItem.Index <> 0 Then Unload PItem
Next PItem
If InStr(FileName, ".") = 0 Then
    GoSub AddGlobal
Else
    For bNum = 1 To Len(FileName)
        If InStr(bNum, FileName, ".") > 0 Then
            bNum = InStr(bNum, FileName, ".")
        Else
            Exit For
        End If
    Next bNum
    aName = Mid(FileName, bNum - 1)
    aName = GetReg("HKEY_CLASSES_ROOT\" + aName + "\")
    If aName = "" Then
        GoSub AddGlobal
        Exit Sub
    End If
    dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")
    dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)
    If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\command\")) Then
        If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\")) Then
            mnuItem(0).Caption = "Op&en with..."
        Else
            mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
        End If
        mnuItem(0).Tag = dItem
        mnuRoot.Tag = 1
        aNum = 0
        bNum = 1
    Else
        aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", 0)
        If aItem = "" Then
            GoSub AddGlobal
            Exit Sub
        End If
        If Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then
            If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
                mnuItem(0).Caption = "Op&en with..."
            Else
                mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
            End If
            mnuItem(0).Tag = aItem
            mnuRoot.Tag = 1
            aNum = 1
            bNum = 1
        Else
            aNum = 1
            bNum = 0
        End If
    End If
    Do
        aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)
        If aItem <> "" Then
            If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then
                On Error Resume Next
                Load mnuItem(bNum)
                On Error GoTo 0
                If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
                    mnuItem(bNum).Caption = "Op&en with..."
                Else
                    mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
                End If
                mnuItem(bNum).Tag = aItem
                mnuRoot.Tag = mnuRoot.Tag + 1
                bNum = bNum + 1
            End If
            aNum = aNum + 1
        End If
    Loop Until aItem = ""
    GoSub AddGlobal
    If Shift And vbShiftMask Then GoSub AddUnknown
End If
Exit Sub
AddGlobal:
    aNum = 0
    bNum = mnuRoot.Tag
    dItem = ""
    If bNum = 0 Then
        dItem = GetReg("HKEY_CLASSES_ROOT\*\shell\", "open")
        dItem = GetReg(SharedAppKey + "FileDefaultActions\*", dItem)
        If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\command\")) Then
            If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\")) Then
                mnuItem(bNum).Caption = "Op&en with..."
            Else
                mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
            End If
            mnuItem(bNum).Tag = dItem
            mnuRoot.Tag = mnuRoot.Tag + 1
            bNum = bNum + 1
        End If
    End If
    Do
        aItem = EnumKey("HKEY_CLASSES_ROOT\*\shell\", aNum)
        If aItem <> "" Then
            If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\command\")) Then
                On Error Resume Next
                Load mnuItem(bNum)
                On Error GoTo 0
                If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\")) Then
                    mnuItem(bNum).Caption = "Op&en with..."
                Else
                    mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
                End If
                mnuItem(bNum).Tag = aItem
                mnuRoot.Tag = mnuRoot.Tag + 1
                bNum = bNum + 1
            End If
            aNum = aNum + 1
        End If
    Loop Until aItem = ""
    If bNum = 0 Then
        GoSub AddUnknown
        Exit Sub
    End If
Return
AddUnknown:
    aNum = 0
    bNum = mnuRoot.Tag
    dItem = ""
    If bNum = 0 Then
        dItem = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\", "open")
        dItem = GetReg(SharedAppKey + "FileDefaultActions\Unknown", dItem)
        If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\command\")) Then
            If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\")) Then
                mnuItem(bNum).Caption = "Op&en with..."
            Else
                mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
            End If