options.frm

能处理星际争霸

    NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\", "MPQ Archive"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\DefaultIcon\", Path + App.EXEName + ".exe,1"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)
    BatKey = "HKEY_CLASSES_ROOT\" + GetReg("HKEY_CLASSES_ROOT\.bat\", "batfile") + "\"
    NewKey "HKEY_CLASSES_ROOT\.mscript\", "Mpq.Script"
    NewKey "HKEY_CLASSES_ROOT\.mbat\", "Mpq.Script"
    NewKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"
    SetReg "HKEY_CLASSES_ROOT\.mscript\ShellNew\NullFile", ""
    NewKey "HKEY_CLASSES_ROOT\Mpq.Script\", "Mo'PaQ 2000 Script"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Script\DefaultIcon\", GetReg(BatKey + "DefaultIcon\", "C:\WINDOWS\SYSTEM\shell32.dll,-153")
    NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\command\", GetReg(BatKey + "shell\edit\command\", "C:\WINDOWS\NOTEPAD.EXE %1")
    NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\", "&Run"
    NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " script " + Chr(34) + "%1" + Chr(34)
Else
    If GetReg("HKEY_CLASSES_ROOT\.mpq\") = "Mpq.Archive" Then
        DelKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"
        DelKey "HKEY_CLASSES_ROOT\.mpq\"
        SetReg "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", "not used"
        DelKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"
        DelKey "HKEY_CLASSES_ROOT\.mscript\"
        DelKey "HKEY_CLASSES_ROOT\.mbat\"
    End If
End If
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, vbNullString, vbNullString
If Option1(0).Value = True Then
    SetReg AppKey + "StartupPathType", 0, REG_DWORD
    Text3 = CurDir
ElseIf Option1(1).Value = True Then
    SetReg AppKey + "StartupPathType", 1, REG_DWORD
    Text3 = App.Path
ElseIf Option1(2).Value = True Then
    SetReg AppKey + "StartupPathType", 2, REG_DWORD
End If
Path = Text3
If Right(Path, 1) <> "\" Then Path = Path + "\"
If IsDir(Path) Then
    SetReg AppKey + "StartupPath", Text3
    ChDir Text3
End If
Select Case Combo2.ListIndex
Case 0
DefaultCompressID = -1
DefaultCompress = MAFA_COMPRESS_STANDARD
Case 1
DefaultCompressID = -3
DefaultCompress = MAFA_COMPRESS_DEFLATE
End Select
DefaultCompressLevel = Combo3.ListIndex - 1
SetReg AppKey + "DefaultCompress", DefaultCompressID, REG_DWORD
SetReg AppKey + "DefaultZlibLevel", DefaultCompressLevel, REG_DWORD
DelKey AppKey + "Compression\"
NewKey AppKey + "Compression\"
For xNum = 1 To UBound(NewExtNames)
    ExtList = ExtList + NewExtNames(xNum)
    SetReg AppKey + "Compression\" + NewExtNames(xNum), CStr(NewExtComp(xNum))
Next xNum
SetReg AppKey + "Compression\List", ExtList
NewKey SharedAppKey + "FileDefaultActions\"
For aNum = 1 To FileTypes.ListItems.Count
    dItem = GetReg("HKEY_CLASSES_ROOT\" + FileTypes.ListItems.Item(aNum).Key + "\shell\", "open")
    dItem = GetReg(SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, dItem)
    ndItem = FileTypes.ListItems.Item(aNum).Tag
    If LCase(dItem) <> LCase(ndItem) And ndItem <> "" Then
        SetReg SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, ndItem
    End If
Next aNum
Hide
If LCase(ListFile) <> LCase(NewListFile) Then
    ListFile = NewListFile
    SetReg AppKey + "ListFile", ListFile
    CD.FileName = OldFileName
    If FileExists(OldFileName) Then MpqEx.OpenMpq
End If
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command4_Click()
DelReg AppKey + "Status\WindowState"
DelReg AppKey + "Status\WindowHeight"
DelReg AppKey + "Status\WindowLeft"
DelReg AppKey + "Status\WindowTop"
DelReg AppKey + "Status\WindowWidth"
Check1.Value = 0
End Sub
Private Sub Command5_Click()
Dim Path As String
PathInput.hwndOwner = hWnd
Path = PathInputBox(PathInput, "WinMPQ Startup Path", Text3)
If Path <> "" Then Text3 = Path
End Sub
Private Sub Command6_Click()
Dim xNum As Integer
If List1.ListIndex > -1 Then
    For xNum = 1 To UBound(NewExtNames)
        If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
    Next xNum
    If xNum < UBound(NewExtNames) Then
        For xNum = xNum To UBound(NewExtNames) - 1
            NewExtNames(xNum) = NewExtNames(xNum + 1)
            NewExtComp(xNum) = NewExtComp(xNum + 1)
        Next xNum
    End If
    ReDim Preserve NewExtNames(UBound(NewExtNames) - 1) As String
    ReDim Preserve NewExtComp(UBound(NewExtComp) - 1) As Integer
    On Error Resume Next
    List1.RemoveItem List1.ListIndex
End If
End Sub
Private Sub Form_Load()
Dim Path As String, PathType As Integer, NewFileListNames As String
Dim ExtList As String
Dim aExt As String, aName As String, aNum As Long, DCompType As Long
On Error Resume Next
Left = MpqEx.Left + 330
If Left < 0 Then Left = 0
If Left + Width > Screen.Width Then Left = Screen.Width - Width
Top = MpqEx.Top + 315
If Top < 0 Then Top = 0
If Top + Height > Screen.Height Then Top = Screen.Height - Height
Path = App.Path
If Right(Path, 1) <> "\" Then Path = Path + "\"
Text1 = DefaultMaxFiles
Text5 = DefaultBlockSize
Text2 = LocaleID
OldFileName = CD.FileName
CD.FileName = ""
NewListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
For aNum = 1 To Len(NewListFile)
    If InStr(aNum, NewListFile, vbCrLf) Then
        aName = Mid(NewListFile, aNum, InStr(aNum, NewListFile, vbCrLf) - aNum)
        If FileExists(aName) Or IsDir(aName) Then
            FileLists.AddItem aName
            NewFileListNames = NewFileListNames + aName + vbCrLf
        End If
        aNum = InStr(aNum, NewListFile, vbCrLf) + 1
    Else
        aName = Mid(NewListFile, aNum)
        If FileExists(aName) Or IsDir(aName) Then
            FileLists.AddItem aName
            NewFileListNames = NewFileListNames + aName
        End If
        Exit For
    End If
Next aNum
NewListFile = NewFileListNames
If Right(NewListFile, 2) = vbCrLf Then NewListFile = Left(NewListFile, Len(NewListFile) - 2)
If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then Check1.Value = 1 Else Check1.Value = 0
If GetReg(AppKey + "ShowConfirmation", 1) > 0 Then Check3.Value = 1 Else Check3.Value = 0
If GetReg(AppKey + "UseDragDropWildcards", 1) > 0 Then Check4.Value = 1 Else Check4.Value = 0
If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Check5.Value = 1 Else Check5.Value = 0
If GetReg(AppKey + "AutofindFileLists", 0) > 0 Then Check7.Value = 1 Else Check7.Value = 0
If GetReg(AppKey + "UseOnlyAutofindLists", 1) > 0 Then Check8.Value = 1 Else Check8.Value = 0
If GetReg("HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive") = "Mpq.Archive" And InStr(1, GetReg("HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)), App.EXEName + ".exe", 1) > 0 Then Check2.Value = 1 Else Check2.Value = 0
Text3 = GetReg(AppKey + "StartupPath", CurDir)
PathType = GetReg(AppKey + "StartupPathType", 0)
If PathType < 0 Then PathType = 0
If PathType > 2 Then PathType = 2
Option1(PathType).Value = True
If PathType = 0 Then
    Text3 = CurDir
ElseIf PathType = 1 Then
    Text3 = App.Path
End If
ReDim NewExtNames(0) As String
ReDim NewExtComp(0) As Integer
Combo1.ListIndex = 1
DCompType = GetReg(AppKey + "DefaultCompress", -1)
Select Case DCompType
Case -3
Combo2.ListIndex = 1
Case Else
Combo2.ListIndex = 0
End Select
Combo3.ListIndex = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION) + 1
ExtList = GetReg(AppKey + "Compression\List", ".bik.smk.mp3.mpq.w3m.wav")
If InStr(1, ExtList, ".") > 0 And Len(ExtList) > 1 Then
Do
    ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
    ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer
    If InStr(2, ExtList, ".") > 0 Then
        NewExtNames(UBound(NewExtNames)) = Left(ExtList, InStr(2, ExtList, ".") - 1)
    Else
        NewExtNames(UBound(NewExtNames)) = ExtList
    End If
    ExtList = Mid(ExtList, Len(NewExtNames(UBound(NewExtNames))) + 1)
    List1.AddItem NewExtNames(UBound(NewExtNames))
    If LCase(NewExtNames(UBound(NewExtNames))) = ".bik" Then
        NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
    ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".smk" Then
        NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
    ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mp3" Then
        NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))
    ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mpq" Then
        NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))
    ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3m" Then
        NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))
    ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".wav" Then
        NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.wav", "0"))
    Else
        NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\" + NewExtNames(UBound(NewExtNames)), "-1"))
    End If
Loop Until ExtList = ""
End If
Do
    aExt = EnumKey("HKEY_CLASSES_ROOT\", aNum)
    If Left(aExt, 1) = "." Then
        aName = GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")
        If aName <> "" Then
            On Error GoTo AlreadyExists
            FileTypes.ListItems.Add(, aName, GetReg("HKEY_CLASSES_ROOT\" + aName + "\", UCase(Mid(aExt, 2)) + " File")).ToolTipText = UCase(aExt)
            On Error Resume Next
        End If
    ElseIf LCase(aExt) = "*" Then
        FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
        If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " All Files"
    ElseIf LCase(aExt) = "unknown" Then
        FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
        If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " Unknown File"
    End If
    aNum = aNum + 1
Loop Until aExt = ""
Exit Sub
AlreadyExists:
    FileTypes.ListItems.Item(aName).ToolTipText = FileTypes.ListItems.Item(aName).ToolTipText + " " + UCase(aExt)
Resume Next
End Sub
Private Sub Form_Resize()
FileTypes.ColumnHeaders.Item(1).Width = FileTypes.Width - 30 * Screen.TwipsPerPixelX
End Sub

Private Sub Form_Unload(Cancel As Integer)
CD.FileName = OldFileName
End Sub
Private Sub List1_Click()
Dim xNum As Integer, OldExtComp As Integer
If List1.ListIndex > -1 Then
    Combo1.Enabled = True
    For xNum = 1 To UBound(NewExtNames)
        If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
    Next xNum
    Select Case NewExtComp(xNum)
    Case -2
        AudioC(0).Value = True
        Combo1.ListIndex = 0
    Case -1
        AudioC(0).Value = True
        Combo1.ListIndex = 1
    Case -3
        AudioC(0).Value = True
        Combo1.ListIndex = 2
    Case 0, 1, 2
        OldExtComp = NewExtComp(xNum)
        Combo1.ListIndex = 3
        AudioC(OldExtComp).Value = True
    Case Else
        AudioC(0).Value = True
        Combo1.ListIndex = 1
    End Select
Else
    Combo1.ListIndex = 1
    Combo1.Enabled = False
End If
End Sub
Private Sub Option1_Click(Index As Integer)
If Index = 2 Then
    Text3.Enabled = True
    Command5.Enabled = True
Else
    Text3.Enabled = False
    Command5.Enabled = False
End If
End Sub
Private Sub Tabs_Click()
Dim TabDisp As PictureBox
For Each TabDisp In TabDisps
    TabDisp.Visible = False
Next TabDisp
TabDisps(Tabs.SelectedItem.Index).Visible = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub

Private Sub Text5_Change()
On Error Resume Next
If Text5 <> "" Then
    If Text5 > 23 Then Text5 = 23
    If Text5 <= 23 Then _
        ActualBlockSize = CStr((512 * 2 ^ Text5) / 1024) + " KB"
Else
    ActualBlockSize = ""
End If
On Error GoTo 0
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub Text1_LostFocus()
If Text1 = "" Then Text1 = 0
'If Text1 < 16 Then Text1 = 16
'If Text1 > 262144 Then Text1 = 262144
End Sub
Private Sub Text5_LostFocus()
If Text5 = "" Then Text5 = DEFAULT_BLOCK_SIZE
If Text5 > 23 Then Text5 = 23
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
Dim NewValue As Long
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> Asc("-") Then KeyAscii = 0
On Error GoTo TooBig
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = Asc("-") Then NewValue = CLng(Text2 + Chr(KeyAscii))
On Error GoTo 0
Exit Sub
TooBig:
KeyAscii = 0
End Sub
Private Sub Text2_LostFocus()
If Text2 = "" Then Text2 = 0
End Sub
Private Sub Text4_GotFocus()
cmdAdd.Default = True
End Sub
Private Sub Text4_LostFocus()
Command1.Default = True
End Sub
Private Sub Actions_Click()
On Error GoTo NotSelected
FileTypes.SelectedItem.Tag = FileTypes.SelectedItem.Tag
On Error GoTo 0
If FileTypes.SelectedItem.Selected = True Then
    FileTypes.SelectedItem.Tag = ActID(Actions.ListIndex + 1)
End If
NotSelected:
End Sub
Private Sub FileTypes_ItemClick(ByVal Item As ListItem)
Dim aNum As Long, aItem As String, aName As String, bNum As Long, dItem As String
Label8 = Item.ToolTipText
Actions.Clear
ReDim ActID(0) As String
aName = Item.Key
Do
    aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)
    If aItem <> "" Then
        If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
            Actions.AddItem "Open with..."
        Else
            Actions.AddItem GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", UCase(Left(aItem, 1)) + Mid(aItem, 2))
        End If
        ReDim Preserve ActID(UBound(ActID) + 1) As String
        ActID(UBound(ActID)) = aItem
        aNum = aNum + 1
    End If
Loop Until aItem = ""
If Item.Tag = "" Then
    dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")
    dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)
Else
    dItem = Item.Tag
End If
If Actions.ListCount > 0 Then Actions.ListIndex = 0
For bNum = 0 To Actions.ListCount - 1
    If LCase(ActID(bNum + 1)) = LCase(dItem) Then
        Actions.ListIndex = bNum
    End If
Next bNum
Item.Tag = dItem
End Sub