Archived News
Search News Discussion Forum
Old Forum Install Programs More Downloads...
Troubleshooting Source Code
Format Specs.
Misc. Information
Non-SF Stuff
Links
Small banner for links to this site:
37 files changed:
| About.frm | [new file with mode: 0644] | patch | blob |
| About.frx | [new file with mode: 0644] | patch | blob |
| EditTItem.frm | [new file with mode: 0644] | patch | blob |
| EditTItem.frx | [new file with mode: 0644] | patch | blob |
| FileDialog.bas | [new file with mode: 0644] | patch | blob |
| FixIcon.bas | [new file with mode: 0644] | patch | blob |
| FoldName.frm | [new file with mode: 0644] | patch | blob |
| FoldName.frx | [new file with mode: 0644] | patch | blob |
| MpqStuff.bas | [new file with mode: 0644] | patch | blob |
| Options.frm | [new file with mode: 0644] | patch | blob |
| Options.frx | [new file with mode: 0644] | patch | blob |
| Registry.bas | [new file with mode: 0644] | patch | blob |
| ScriptOut.frm | [new file with mode: 0644] | patch | blob |
| ScriptOut.frx | [new file with mode: 0644] | patch | blob |
| ToolList.frm | [new file with mode: 0644] | patch | blob |
| ToolList.frx | [new file with mode: 0644] | patch | blob |
| WINMPQ.VBP | [new file with mode: 0644] | patch | blob |
| WinMPQ.ico | [new file with mode: 0644] | patch | blob |
| WinMPQ.res | [new file with mode: 0644] | patch | blob |
| WinMPQ.rtf | [new file with mode: 0644] | patch | blob |
| blank.gif | [new file with mode: 0644] | patch | blob |
| downarrow.gif | [new file with mode: 0644] | patch | blob |
| downarrowa.gif | [new file with mode: 0644] | patch | blob |
| downarrowg.gif | [new file with mode: 0644] | patch | blob |
| edit.gif | [new file with mode: 0644] | patch | blob |
| edita.gif | [new file with mode: 0644] | patch | blob |
| editg.gif | [new file with mode: 0644] | patch | blob |
| listing.frm | [new file with mode: 0644] | patch | blob |
| listing.frx | [new file with mode: 0644] | patch | blob |
| minus.gif | [new file with mode: 0644] | patch | blob |
| minusa.gif | [new file with mode: 0644] | patch | blob |
| minusg.gif | [new file with mode: 0644] | patch | blob |
| plus.gif | [new file with mode: 0644] | patch | blob |
| plusa.gif | [new file with mode: 0644] | patch | blob |
| uparrow.gif | [new file with mode: 0644] | patch | blob |
| uparrowa.gif | [new file with mode: 0644] | patch | blob |
| uparrowg.gif | [new file with mode: 0644] | patch | blob |
diff --git a/About.frm b/About.frm
--- /dev/null
+++ b/About.frm
@@ -0,0 +1,197 @@
+VERSION 4.00
+Begin VB.Form About
+ BorderStyle = 3 'Fixed Dialog
+ Caption = "About WinMPQ"
+ ClientHeight = 1305
+ ClientLeft = 1890
+ ClientTop = 2265
+ ClientWidth = 5820
+ Height = 1710
+ Icon = "About.frx":0000
+ Left = 1830
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 1305
+ ScaleWidth = 5820
+ ShowInTaskbar = 0 'False
+ Top = 1920
+ Width = 5940
+ Begin VB.CommandButton Command2
+ Caption = "About &Mpq Control"
+ Height = 375
+ Left = 4080
+ TabIndex = 4
+ Top = 600
+ Width = 1575
+ End
+ Begin VB.CommandButton Command1
+ Caption = "O&k"
+ Default = -1 'True
+ Height = 375
+ Left = 4920
+ TabIndex = 3
+ Top = 120
+ Width = 735
+ End
+ Begin VB.Label Label4
+ AutoSize = -1 'True
+ BackStyle = 0 'Transparent
+ Caption = "E-mail: blakflare@hotmail.com"
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
+ Name = "Times New Roman"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = -1 'True
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FF0000&
+ Height = 210
+ Left = 120
+ TabIndex = 5
+ Top = 1080
+ Width = 2280
+ End
+ Begin VB.Label Label3
+ AutoSize = -1 'True
+ BackStyle = 0 'Transparent
+ Caption = "ShadowFlare's Realm - http://shadowflare.ancillaediting.net/"
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
+ Name = "Times New Roman"
+ Size = 9.75
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = -1 'True
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FF0000&
+ Height = 480
+ Left = 120
+ TabIndex = 2
+ Top = 600
+ Width = 3855
+ WordWrap = -1 'True
+ End
+ Begin VB.Label Label2
+ AutoSize = -1 'True
+ Caption = "Copyright © ShadowFlare Software 2001-2002"
+ Height = 195
+ Left = 120
+ TabIndex = 1
+ Top = 360
+ Width = 3300
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "WinMPQ v"
+ Height = 195
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ Width = 780
+ End
+End
+Attribute VB_Name = "About"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+Function GetAppVersionString() As String
+GetAppVersionString = CStr(App.Major) + "."
+If Len(CStr(App.Minor)) < 2 Then
+ GetAppVersionString = GetAppVersionString + "0" + CStr(App.Minor)
+Else
+ GetAppVersionString = GetAppVersionString + CStr(App.Minor)
+End If
+If App.Revision <> 0 Then
+ If Len(CStr(App.Revision)) < 4 Then
+ GetAppVersionString = GetAppVersionString + "." + String(4 - Len(CStr(App.Revision)), "0") + CStr(App.Revision)
+ Else
+ GetAppVersionString = GetAppVersionString + "." + CStr(App.Revision)
+ End If
+End If
+End Function
+Private Sub Command1_Click()
+Unload Me
+End Sub
+
+Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF0000
+Label3.Font.underline = False
+Label4.ForeColor = &HFF0000
+Label4.Font.underline = False
+End Sub
+Private Sub Command2_Click()
+MpqEx.Mpq.AboutBox
+End Sub
+
+
+Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF0000
+Label3.Font.underline = False
+Label4.ForeColor = &HFF0000
+Label4.Font.underline = False
+End Sub
+Private Sub Form_Load()
+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
+Label1 = Label1 + GetAppVersionString
+End Sub
+Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF0000
+Label3.Font.underline = False
+Label4.ForeColor = &HFF0000
+Label4.Font.underline = False
+End Sub
+Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF0000
+Label3.Font.underline = False
+Label4.ForeColor = &HFF0000
+Label4.Font.underline = False
+End Sub
+Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF0000
+Label3.Font.underline = False
+Label4.ForeColor = &HFF0000
+Label4.Font.underline = False
+End Sub
+Private Sub Label3_Click()
+ShellExecute hWnd, vbNullString, "http://shadowflare.ancillaediting.net/", vbNullString, vbNullString, 1
+End Sub
+Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF00&
+End Sub
+Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF&
+Label3.Font.underline = True
+Label4.ForeColor = &HFF0000
+Label4.Font.underline = False
+End Sub
+Private Sub Label3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF0000
+Label3.Font.underline = False
+End Sub
+Private Sub Label4_Click()
+ShellExecute hWnd, vbNullString, "mailto:blakflare@hotmail.com", vbNullString, vbNullString, 1
+End Sub
+
+Private Sub Label4_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label4.ForeColor = &HFF00&
+End Sub
+Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label3.ForeColor = &HFF0000
+Label3.Font.underline = False
+Label4.ForeColor = &HFF&
+Label4.Font.underline = True
+End Sub
+
+Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
+Label4.ForeColor = &HFF0000
+Label4.Font.underline = False
+End Sub
diff --git a/About.frx b/About.frx
diff --git a/EditTItem.frm b/EditTItem.frm
--- /dev/null
+++ b/EditTItem.frm
@@ -0,0 +1,135 @@
+VERSION 4.00
+Begin VB.Form EditTItem
+ BorderStyle = 3 'Fixed Dialog
+ ClientHeight = 2535
+ ClientLeft = 1890
+ ClientTop = 2145
+ ClientWidth = 5535
+ Height = 2940
+ Icon = "EditTItem.frx":0000
+ Left = 1830
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 2535
+ ScaleWidth = 5535
+ ShowInTaskbar = 0 'False
+ Top = 1800
+ Width = 5655
+ Begin VB.CommandButton cmdBrowse
+ Caption = "&Browse..."
+ Height = 285
+ Left = 4560
+ TabIndex = 2
+ Top = 1680
+ Width = 855
+ End
+ Begin VB.CommandButton cmdCancel
+ Cancel = -1 'True
+ Caption = "&Cancel"
+ Height = 375
+ Left = 3120
+ TabIndex = 4
+ Top = 2040
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdOK
+ Caption = "O&K"
+ Default = -1 'True
+ Height = 375
+ Left = 960
+ TabIndex = 3
+ Top = 2040
+ Width = 1455
+ End
+ Begin VB.TextBox txtCommand
+ Height = 285
+ Left = 120
+ TabIndex = 1
+ Top = 1680
+ Width = 4335
+ End
+ Begin VB.TextBox txtName
+ Height = 285
+ Left = 120
+ TabIndex = 0
+ Top = 480
+ Width = 5295
+ End
+ Begin VB.Label Label1
+ Caption = "Title: (Use a && before a letter to make it the key for the menu option. Use &&&& to display a &&.)"
+ Height = 390
+ Left = 120
+ TabIndex = 5
+ Top = 0
+ Width = 5295
+ WordWrap = -1 'True
+ End
+ Begin VB.Label Label2
+ Caption = $"EditTItem.frx":000C
+ Height = 870
+ Left = 120
+ TabIndex = 6
+ Top = 840
+ Width = 5295
+ WordWrap = -1 'True
+ End
+End
+Attribute VB_Name = "EditTItem"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Dim ClickedOK As Boolean, Finished As Boolean
+Function EditItem(FormCaption As String, cName As String, cCommand As String) As String
+Left = ToolList.Left + 330
+If Left < 0 Then Left = 0
+If Left + Width > Screen.Width Then Left = Screen.Width - Width
+Top = ToolList.Top + 315
+If Top < 0 Then Top = 0
+If Top + Height > Screen.Height Then Top = Screen.Height - Height
+Caption = FormCaption
+txtName = cName
+txtCommand = cCommand
+Finished = False
+ClickedOK = False
+Show 1
+If ClickedOK = True Then
+ EditItem = txtName + vbCrLf + txtCommand
+Else
+ EditItem = cName + vbCrLf + cCommand
+End If
+Finished = True
+Unload Me
+End Function
+Private Sub cmdBrowse_Click()
+Dim OldFileName As String, OldPath As String
+CD.Flags = &H1000 Or &H4 Or &H2
+CD.Filter = "Programs (*.exe;*.com;*.bat)|*.exe;*.com;*.bat|All Files (*.*)|*.*"
+OldFileName = CD.FileName
+OldPath = CurDir
+If Mid(App.Path, 2, 1) = ":" Then
+ ChDrive Left(App.Path, 1)
+ ChDir Left(App.Path, 2) + "\"
+End If
+CD.FileName = ""
+If ShowOpen(CD) = False Then GoTo Cancel
+txtCommand = Chr(34) + CD.FileName + Chr(34)
+Cancel:
+CD.FileName = OldFileName
+If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
+ChDir OldPath
+End Sub
+Private Sub cmdCancel_Click()
+Hide
+End Sub
+Private Sub cmdOK_Click()
+ClickedOK = True
+Hide
+End Sub
+Private Sub Form_Unload(Cancel As Integer)
+If Finished = False Then
+ Cancel = True
+ Hide
+End If
+End Sub
diff --git a/EditTItem.frx b/EditTItem.frx
new file mode 100644 (file)
index 0000000..1f05922
Binary files /dev/null and b/EditTItem.frx differ
index 0000000..1f05922
Binary files /dev/null and b/EditTItem.frx differ
diff --git a/FileDialog.bas b/FileDialog.bas
--- /dev/null
+++ b/FileDialog.bas
@@ -0,0 +1,190 @@
+Attribute VB_Name = "FileDialog"
+Option Explicit
+
+Public NullPtr As String
+
+Type OPENFILENAME
+ lStructSize As Long
+ hwndOwner As Long
+ hInstance As Long
+ Filter As String
+ CustomFilter As String
+ nMaxCustFilter As Long
+ FilterIndex As Long
+ FileName As String
+ MaxFileSize As Long
+ FileTitle As String
+ MaxFileTitleSize As Long
+ InitDir As String
+ DialogTitle As String
+ Flags As Long
+ nFileOffset As Integer
+ nFileExtension As Integer
+ DefaultExt As String
+ lCustData As Long
+ lpfnHook As Long
+ lpTemplateName As String
+End Type
+
+Type BROWSEINFO
+ hwndOwner As Long
+ pidlRoot As Long
+ DisplayName As String
+ Title As String
+ Flags As Long
+ lpfn As Long
+ lParam As Long
+ iImage As Long
+End Type
+
+Declare Function CommDlgExtendedError Lib "Comdlg32.dll" () As Long
+Declare Function GetOpenFileName Lib "Comdlg32.dll" _
+ Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Boolean
+Declare Function GetSaveFileName Lib "Comdlg32.dll" _
+ Alias "GetSaveFileNameA" (lpofn As OPENFILENAME) As Boolean
+Declare Function SHBrowseForFolder Lib "Shell32.dll" _
+ (lpbi As BROWSEINFO) As Long
+Declare Function SHGetPathFromIDList Lib "Shell32.dll" ( _
+ pidl As Long, _
+ ByRef pszPath As Byte) As Boolean
+
+Public Const OFN_READONLY As Long = &H1
+Public Const OFN_OVERWRITEPROMPT As Long = &H2
+Public Const OFN_HIDEREADONLY As Long = &H4
+Public Const OFN_NOCHANGEDIR As Long = &H8
+Public Const OFN_SHOWHELP As Long = &H10
+Public Const OFN_ENABLEHOOK As Long = &H20
+Public Const OFN_ENABLETEMPLATE As Long = &H40
+Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
+Public Const OFN_NOVALIDATE As Long = &H100
+Public Const OFN_ALLOWMULTISELECT As Long = &H200
+Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
+Public Const OFN_PATHMUSTEXIST As Long = &H800
+Public Const OFN_FILEMUSTEXIST As Long = &H1000
+Public Const OFN_CREATEPROMPT As Long = &H2000
+Public Const OFN_SHAREAWARE As Long = &H4000
+Public Const OFN_NOREADONLYRETURN As Long = &H8000
+Public Const OFN_NOTESTFILECREATE As Long = &H10000
+Public Const OFN_NONETWORKBUTTON As Long = &H20000
+Public Const OFN_NOLONGNAMES As Long = &H40000 ' force no long names for 4.x modules
+Public Const OFN_EXPLORER As Long = &H80000 ' new look commdlg
+Public Const OFN_NODEREFERENCELINKS As Long = &H100000
+Public Const OFN_LONGNAMES As Long = &H200000 ' force long names for 3.x modules
+Public Const OFN_ENABLEINCLUDENOTIFY As Long = &H400000 ' send include message to callback
+Public Const OFN_ENABLESIZING As Long = &H800000
+
+Public Const BIF_RETURNONLYFSDIRS As Long = &H1 ' For finding a folder to start document searching
+Public Const BIF_DONTGOBELOWDOMAIN As Long = &H2 ' For starting the Find Computer
+Public Const BIF_STATUSTEXT As Long = &H4
+Public Const BIF_RETURNFSANCESTORS As Long = &H8
+Public Const BIF_EDITBOX As Long = &H10
+Public Const BIF_VALIDATE As Long = &H20 ' insist on valid result (or CANCEL)
+
+Public Const BIF_BROWSEFORCOMPUTER As Long = &H1000 ' Browsing for Computers.
+Public Const BIF_BROWSEFORPRINTER As Long = &H2000 ' Browsing for Printers
+Public Const BIF_BROWSEINCLUDEFILES As Long = &H4000 ' Browsing for Everything
+
+Function GetPathFromID(ByVal dwID As Long) As String
+Dim buffer(1 To 260) As Byte
+GetPathFromID = NullPtr
+If SHGetPathFromIDList(ByVal dwID, buffer(1)) Then
+ GetPathFromID = StrConv(buffer, vbUnicode)
+ StripNull GetPathFromID
+End If
+End Function
+Sub ReplaceChar(ByRef TextStr As String, ByVal Char As String, ByVal NewChar As String)
+If Len(Char) > 1 Then Char = Left$(Char, 1)
+If Len(NewChar) > 1 Then NewChar = Left$(NewChar, 1)
+Dim cNum As Long, cNum2 As Long
+For cNum = 1 To Len(TextStr)
+ cNum2 = InStr(cNum, TextStr, Char)
+ If cNum2 Then
+ cNum = cNum2
+ Mid$(TextStr, cNum, 1) = NewChar
+ Else
+ Exit Sub
+ End If
+Next cNum
+End Sub
+Sub StripNull(ByRef TextStr As String)
+Dim cNum As Long, cNum2 As Long
+For cNum = 1 To Len(TextStr)
+ cNum2 = InStr(cNum, TextStr, Chr$(0))
+ If cNum2 Then
+ cNum = cNum2
+ cNum2 = InStr(cNum + 1, TextStr, Chr$(0))
+ If cNum + 1 = cNum2 Or cNum2 = 0 Then
+ TextStr = Left(TextStr, cNum - 1)
+ Exit Sub
+ End If
+ Else
+ Exit Sub
+ End If
+Next cNum
+End Sub
+Sub InitFileDialog(ByRef lpFileDialog As OPENFILENAME)
+lpFileDialog.lStructSize = Len(lpFileDialog)
+lpFileDialog.hwndOwner = 0
+lpFileDialog.hInstance = 0
+lpFileDialog.Filter = NullPtr
+lpFileDialog.CustomFilter = NullPtr
+lpFileDialog.nMaxCustFilter = 0
+lpFileDialog.FilterIndex = 0
+lpFileDialog.FileName = NullPtr
+lpFileDialog.MaxFileSize = 260
+lpFileDialog.FileTitle = NullPtr
+lpFileDialog.MaxFileTitleSize = 260
+lpFileDialog.InitDir = NullPtr
+lpFileDialog.DialogTitle = NullPtr
+lpFileDialog.Flags = 0
+lpFileDialog.nFileOffset = 0
+lpFileDialog.nFileExtension = 0
+lpFileDialog.DefaultExt = NullPtr
+lpFileDialog.lCustData = 0
+lpFileDialog.lpfnHook = 0
+lpFileDialog.lpTemplateName = NullPtr
+End Sub
+Sub InitFolderDialog(ByRef lpFolderDialog As BROWSEINFO)
+lpFolderDialog.hwndOwner = 0
+lpFolderDialog.pidlRoot = 0
+lpFolderDialog.DisplayName = NullPtr
+lpFolderDialog.Title = NullPtr
+lpFolderDialog.Flags = 0
+lpFolderDialog.lpfn = 0
+lpFolderDialog.lParam = 0
+lpFolderDialog.iImage = 0
+End Sub
+Function ShowOpen(ByRef lpFileDialog As OPENFILENAME) As Boolean
+lpFileDialog.lStructSize = Len(lpFileDialog)
+ReplaceChar lpFileDialog.Filter, "|", Chr$(0)
+lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)
+If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _
+ lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))
+If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _
+ lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))
+ShowOpen = GetOpenFileName(lpFileDialog)
+lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)
+ReplaceChar lpFileDialog.Filter, Chr$(0), "|"
+StripNull lpFileDialog.FileName
+StripNull lpFileDialog.FileTitle
+End Function
+Function ShowSave(ByRef lpFileDialog As OPENFILENAME) As Boolean
+lpFileDialog.lStructSize = Len(lpFileDialog)
+ReplaceChar lpFileDialog.Filter, "|", Chr$(0)
+lpFileDialog.Filter = lpFileDialog.Filter + Chr$(0)
+If Len(lpFileDialog.FileName) <= lpFileDialog.MaxFileSize Then _
+ lpFileDialog.FileName = lpFileDialog.FileName + String$(lpFileDialog.MaxFileSize - Len(lpFileDialog.FileName), Chr$(0))
+If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _
+ lpFileDialog.FileTitle = lpFileDialog.FileTitle + String$(lpFileDialog.MaxFileTitleSize - Len(lpFileDialog.FileTitle), Chr$(0))
+ShowSave = GetSaveFileName(lpFileDialog)
+lpFileDialog.Filter = Left$(lpFileDialog.Filter, Len(lpFileDialog.Filter) - 1)
+ReplaceChar lpFileDialog.Filter, Chr$(0), "|"
+StripNull lpFileDialog.FileName
+StripNull lpFileDialog.FileTitle
+End Function
+Function ShowFolder(ByRef lpFolderDialog As BROWSEINFO) As Long
+If Len(lpFolderDialog.DisplayName) <= 260 Then _
+ lpFolderDialog.DisplayName = lpFolderDialog.DisplayName + String$(260 - Len(lpFolderDialog.DisplayName), Chr$(0))
+ShowFolder = SHBrowseForFolder(lpFolderDialog)
+StripNull lpFolderDialog.DisplayName
+End Function
diff --git a/FixIcon.bas b/FixIcon.bas
--- /dev/null
+++ b/FixIcon.bas
@@ -0,0 +1,42 @@
+Attribute VB_Name = "FixWindowIcon"
+Option Explicit
+
+Private Const WM_SETICON = &H80
+Private Const ICON_SMALL = 0
+Private Const IMAGE_ICON = 1
+Private Const LR_DEFAULTSIZE = &H40
+
+Private Declare Function GetModuleHandle Lib "Kernel32.dll" _
+ Alias "GetModuleHandleA" _
+ (ByRef lpModuleName As Any) As Long
+Private Declare Function LoadImage Lib "User32.dll" _
+ Alias "LoadImageA" ( _
+ ByVal hinst As Long, _
+ ByRef lpszName As Any, _
+ ByVal uType As Long, _
+ ByVal cxDesired As Long, _
+ ByVal cyDesired As Long, _
+ ByVal fuLoad As Long) As Long
+Private Declare Function SendMessageA Lib _
+ "User32.dll" _
+ (ByVal hWnd As Long, _
+ ByVal Msg As Long, _
+ ByVal Wp As Long, _
+ Lp As Any) As Long
+
+Sub FixIcon(hWnd As Long, lpszName)
+Dim hModule As Long, hIcon As Long, szName As String, nName As Long, Width As Long, Height As Long
+hModule = GetModuleHandle(ByVal 0&)
+If hModule = 0 Then Exit Sub
+Width = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionWidth", -270)) / Screen.TwipsPerPixelX - 2
+Height = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionHeight", -270)) / Screen.TwipsPerPixelY - 2
+If VarType(lpszName) = vbString Then
+ szName = lpszName
+ hIcon = LoadImage(hModule, szName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)
+ElseIf VarType(lpszName) = vbByte Or VarType(lpszName) = vbInteger Or VarType(lpszName) = vbLong Then
+ nName = lpszName
+ hIcon = LoadImage(hModule, ByVal nName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)
+End If
+If hIcon = 0 Then Exit Sub
+SendMessageA MpqEx.hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon
+End Sub
diff --git a/FoldName.frm b/FoldName.frm
--- /dev/null
+++ b/FoldName.frm
@@ -0,0 +1,85 @@
+VERSION 4.00
+Begin VB.Form FoldName
+ BorderStyle = 3 'Fixed Dialog
+ Caption = "Folder name..."
+ ClientHeight = 1935
+ ClientLeft = 1995
+ ClientTop = 2430
+ ClientWidth = 4575
+ Height = 2340
+ Icon = "FoldName.frx":0000
+ Left = 1935
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 1935
+ ScaleWidth = 4575
+ ShowInTaskbar = 0 'False
+ Top = 2085
+ Width = 4695
+ Begin VB.TextBox Text1
+ Height = 285
+ Left = 120
+ TabIndex = 1
+ Top = 1080
+ Width = 4335
+ End
+ Begin VB.CommandButton Command2
+ Cancel = -1 'True
+ Caption = "&Cancel"
+ Height = 375
+ Left = 2640
+ TabIndex = 3
+ Top = 1440
+ Width = 1335
+ End
+ Begin VB.CommandButton Command1
+ Caption = "O&K"
+ Default = -1 'True
+ Height = 375
+ Left = 600
+ TabIndex = 2
+ Top = 1440
+ Width = 1335
+ End
+ Begin VB.Label Label2
+ Caption = "Example: If ""title.wav"" is the original filename, and you type ""music\"" the file will become ""music\title.wav"""
+ Height = 495
+ Left = 120
+ TabIndex = 4
+ Top = 600
+ Width = 4335
+ WordWrap = -1 'True
+ End
+ Begin VB.Label Label1
+ Caption = "The text in the box below will be put at the beginnings of the names of every file you selected."
+ Height = 510
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ Width = 4335
+ WordWrap = -1 'True
+ End
+End
+Attribute VB_Name = "FoldName"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub Command1_Click()
+AddFolderName = Text1
+Unload Me
+End Sub
+Private Sub Command2_Click()
+AddFolderName = ""
+Unload Me
+End Sub
+Private Sub Form_Load()
+Left = MpqEx.Left + 330 * 2
+If Left < 0 Then Left = 0
+If Left + Width > Screen.Width Then Left = Screen.Width - Width
+Top = MpqEx.Top + 315 * 2
+If Top < 0 Then Top = 0
+If Top + Height > Screen.Height Then Top = Screen.Height - Height
+Text1 = AddFolderName
+End Sub
diff --git a/FoldName.frx b/FoldName.frx
diff --git a/MpqStuff.bas b/MpqStuff.bas
--- /dev/null
+++ b/MpqStuff.bas
@@ -0,0 +1,1118 @@
+Attribute VB_Name = "MpqStuff"
+Option Explicit
+
+Public Declare Function ShellExecute Lib _
+ "Shell32.dll" Alias "ShellExecuteA" _
+ (ByVal hWnd As Long, _
+ ByVal lpOperation As String, _
+ ByVal lpFile As String, _
+ ByVal lpParameters As String, _
+ ByVal lpDirectory As String, _
+ ByVal nShowCmd As Long) As Long
+Public Declare Sub SHChangeNotify Lib _
+ "Shell32.dll" (ByVal wEventId As Long, _
+ ByVal uFlags As Integer, _
+ ByVal dwItem1 As Any, _
+ ByVal dwItem2 As Any)
+Public Declare Function SendMessageA Lib _
+ "user32.dll" _
+ (ByVal hWnd As Long, _
+ ByVal Msg As Long, _
+ ByVal Wp As Long, _
+ Lp As Any) As Long
+Declare Function GetLongPathName Lib "Kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long
+Private Declare Sub CopyMemory Lib "Kernel32.dll" _
+ Alias "RtlMoveMemory" ( _
+ ByRef Destination As Any, _
+ ByRef Source As Any, _
+ ByVal Length As Long)
+
+Public CD As OPENFILENAME, PathInput As BROWSEINFO
+Public GlobalFileList() As String, FileList() As String, CX As Single, CY As Single, NewFile As Boolean, LocaleID As Long, ListFile As String, AddFolderName As String, ExtractPathNum As Long, CopyPathNum As Long
+Public Const AppKey As String = "HKEY_CURRENT_USER\Software\ShadowFlare\WinMPQ\", SharedAppKey As String = "HKEY_LOCAL_MACHINE\Software\ShadowFlare\WinMPQ\"
+Public Const MPQ_ERROR_INIT_FAILED As Long = &H85000001 'Unspecified error
+Public Const MPQ_ERROR_NO_STAREDIT As Long = &H85000002 'Can't find StarEdit.exe
+Public Const MPQ_ERROR_BAD_STAREDIT As Long = &H85000003 'Bad version of StarEdit.exe. Need SC/BW 1.07
+Public Const MPQ_ERROR_STAREDIT_RUNNING As Long = &H85000004 'StarEdit.exe is running. Must be closed
+Public Const SHCNE_ASSOCCHANGED As Long = &H8000000
+Public Const SHCNF_IDLIST As Long = &H0
+Public Const WM_SETREDRAW As Long = &HB
+Public Const WM_PAINT As Long = &HF
+Const gintMAX_SIZE% = 255
+Function PathInputBox(lpFolderDialog As BROWSEINFO, pCaption As String, StartFolder As String) As String
+lpFolderDialog.Title = pCaption
+Dim Result As Long
+Result = ShowFolder(lpFolderDialog)
+If Result = 0 Then Exit Function
+PathInputBox = GetPathFromID(Result)
+End Function
+Function GetLongPath(Path As String) As String
+ Dim strBuf As String, StrLength As Long
+ strBuf = Space$(gintMAX_SIZE)
+ StrLength = GetLongPathName(Path, strBuf, gintMAX_SIZE)
+ strBuf = Left(strBuf, StrLength)
+ If strBuf <> "" Then
+ GetLongPath = strBuf
+ Else
+ GetLongPath = Path
+ End If
+End Function
+Sub AddAutoFile(Mpq As String, File As String, MpqPath As String)
+Dim cType As Integer, bNum As Long, fExt As String
+For bNum = 1 To Len(File)
+ If InStr(bNum, File, ".") > 0 Then
+ bNum = InStr(bNum, File, ".")
+ Else
+ Exit For
+ End If
+Next bNum
+If bNum > 1 Then
+ fExt = Mid(File, bNum - 1)
+Else
+ fExt = File
+End If
+If LCase(fExt) = ".bik" Then
+ cType = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
+ElseIf LCase(fExt) = ".smk" Then
+ cType = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
+ElseIf LCase(fExt) = ".wav" Then
+ cType = CInt(GetReg(AppKey + "Compression\.wav", "0"))
+Else
+ cType = CInt(GetReg(AppKey + "Compression\" + fExt, "-1"))
+End If
+Select Case cType
+Case -2
+MpqEx.Mpq.AddFile Mpq, File, MpqPath, 0
+Case -1
+MpqEx.Mpq.AddFile Mpq, File, MpqPath, 1
+Case 0, 1, 2
+MpqEx.Mpq.AddWavFile Mpq, File, MpqPath, cType
+Case Else
+MpqEx.Mpq.AddFile Mpq, File, MpqPath, 1
+End Select
+End Sub
+Sub AddScriptOutput(sOutput As String)
+SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 0, ByVal 0&
+ScriptOut.oText = ScriptOut.oText + sOutput
+SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 1, ByVal 0&
+ScriptOut.oText.SelStart = Len(ScriptOut.oText)
+End Sub
+Function GetFileTitle(FileName As String) As String
+Dim bNum As Long
+If InStr(FileName, "\") > 0 Then
+ For bNum = 1 To Len(FileName)
+ If InStr(bNum, FileName, "\") > 0 Then
+ bNum = InStr(bNum, FileName, "\")
+ Else
+ Exit For
+ End If
+ Next bNum
+End If
+GetFileTitle = Mid(FileName, bNum)
+End Function
+Function ListFiles(MpqName As String, ByVal FileLists As String) As String
+Dim NewFileLists As String, nFileLists() As String, ListName As String, cNum As Long, cNum2 As Long, cNum3 As Long, MpqList1 As String, MpqList2 As String, Path As String, ListLen As Long, OldLists() As String, UseOnlyAutoList As Boolean
+If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then
+ ListFiles = MpqEx.Mpq.ListFiles(MpqName, FileLists)
+Else
+ UseOnlyAutoList = GetReg(AppKey + "UseOnlyAutofindLists", 1)
+ MpqList2 = GetExtension(MpqName)
+ MpqList1 = GetFileTitle(Left(MpqName, Len(MpqName) - Len(MpqList2))) + ".txt"
+ MpqList2 = GetFileTitle(MpqName) + ".txt"
+ Path = GetLongPath(App.Path)
+ If Right(Path, 1) <> "\" Then Path = Path + "\"
+ If UseOnlyAutoList Then ListLen = Len(FileLists)
+ If FileLists <> "" Then
+ FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
+ Else
+ FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
+ End If
+ ReDim nFileLists(0) As String
+ If UseOnlyAutoList Then ReDim OldLists(0) As String
+ For cNum = 1 To Len(FileLists)
+ cNum2 = InStr(cNum, FileLists, vbCrLf)
+ If cNum2 = 0 Then
+ cNum2 = Len(FileLists) + 1
+ End If
+ ListName = Mid(FileLists, cNum, cNum2 - cNum)
+ If UseOnlyAutoList Then
+ ReDim Preserve OldLists(UBound(OldLists) + 1) As String
+ OldLists(UBound(OldLists)) = GetLongPath(ListName)
+ End If
+ For cNum3 = 1 To Len(ListName)
+ If InStr(cNum3, ListName, "\") Then
+ cNum3 = InStr(cNum3, ListName, "\")
+ If FileExists(Left(ListName, cNum3) + MpqList1) Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList1)
+ End If
+ If FileExists(Left(ListName, cNum3) + MpqList2) Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList2)
+ End If
+ Else
+ Exit For
+ End If
+ Next cNum3
+ If FileExists(ListName) And ListName <> Path + App.EXEName + ".exe" And ListName <> MpqName Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(ListName)
+ End If
+ cNum = cNum2 + 1
+ Next cNum
+ If UseOnlyAutoList Then
+ For cNum = 1 To UBound(nFileLists)
+ For cNum2 = 1 To UBound(OldLists)
+ If LCase(nFileLists(cNum)) <> LCase(OldLists(cNum2)) Then
+ GoTo StartSearch
+ End If
+ Next cNum2
+ Next cNum
+ UseOnlyAutoList = False
+ End If
+StartSearch:
+ For cNum = 1 To UBound(nFileLists)
+ For cNum2 = 1 To UBound(nFileLists)
+ If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then
+ nFileLists(cNum2) = ""
+ End If
+ Next cNum2
+ If UseOnlyAutoList Then
+ For cNum2 = 1 To UBound(OldLists)
+ If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) Then
+ nFileLists(cNum) = ""
+ End If
+ Next cNum2
+ End If
+ If nFileLists(cNum) <> "" Then
+ NewFileLists = NewFileLists + nFileLists(cNum) + vbCrLf
+ End If
+ Next cNum
+ If Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2)
+ ListFiles = MpqEx.Mpq.ListFiles(MpqName, NewFileLists)
+End If
+End Function
+Function sListFiles(MpqName As String, hMPQ As Long, ByVal FileLists As String) As String
+Dim NewFileLists As String, nFileLists() As String, ListName As String, cNum As Long, cNum2 As Long, cNum3 As Long, MpqList1 As String, MpqList2 As String, Path As String, ListLen As Long, OldLists() As String, UseOnlyAutoList As Boolean
+If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then
+ sListFiles = MpqEx.Mpq.sListFiles(hMPQ, FileLists)
+Else
+ UseOnlyAutoList = GetReg(AppKey + "UseOnlyAutofindLists", 1)
+ MpqList2 = GetExtension(MpqName)
+ MpqList1 = GetFileTitle(Left(MpqName, Len(MpqName) - Len(MpqList2))) + ".txt"
+ MpqList2 = GetFileTitle(MpqName) + ".txt"
+ Path = GetLongPath(App.Path)
+ If Right(Path, 1) <> "\" Then Path = Path + "\"
+ If UseOnlyAutoList Then ListLen = Len(FileLists)
+ If FileLists <> "" Then
+ FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
+ Else
+ FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
+ End If
+ ReDim nFileLists(0) As String
+ If UseOnlyAutoList Then ReDim OldLists(0) As String
+ For cNum = 1 To Len(FileLists)
+ cNum2 = InStr(cNum, FileLists, vbCrLf)
+ If cNum2 = 0 Then
+ cNum2 = Len(FileLists) + 1
+ End If
+ ListName = Mid(FileLists, cNum, cNum2 - cNum)
+ If UseOnlyAutoList And cNum < ListLen Then
+ ReDim Preserve OldLists(UBound(OldLists) + 1) As String
+ OldLists(UBound(OldLists)) = GetLongPath(ListName)
+ End If
+ For cNum3 = 1 To Len(ListName)
+ If InStr(cNum3, ListName, "\") Then
+ cNum3 = InStr(cNum3, ListName, "\")
+ If FileExists(Left(ListName, cNum3) + MpqList1) Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList1)
+ End If
+ If FileExists(Left(ListName, cNum3) + MpqList2) Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList2)
+ End If
+ Else
+ Exit For
+ End If
+ Next cNum3
+ If FileExists(ListName) And ListName <> Path + App.EXEName + ".exe" And ListName <> MpqName Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(ListName)
+ End If
+ cNum = cNum2 + 1
+ Next cNum
+ If UseOnlyAutoList Then
+ For cNum = 1 To UBound(nFileLists)
+ For cNum2 = 1 To UBound(OldLists)
+ If LCase(nFileLists(cNum)) <> LCase(OldLists(cNum2)) Then
+ GoTo StartSearch
+ End If
+ Next cNum2
+ Next cNum
+ UseOnlyAutoList = False
+ End If
+StartSearch:
+ For cNum = 1 To UBound(nFileLists)
+ For cNum2 = 1 To UBound(nFileLists)
+ If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then
+ nFileLists(cNum2) = ""
+ End If
+ Next cNum2
+ If UseOnlyAutoList Then
+ For cNum2 = 1 To UBound(OldLists)
+ If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) Then
+ nFileLists(cNum) = ""
+ Exit For
+ End If
+ Next cNum2
+ End If
+ If nFileLists(cNum) <> "" Then
+ NewFileLists = NewFileLists + nFileLists(cNum) + vbCrLf
+ End If
+ Next cNum
+ If Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2)
+ sListFiles = MpqEx.Mpq.sListFiles(hMPQ, NewFileLists)
+End If
+End Function
+Sub mAddAutoFile(hMPQ As Long, File As String, MpqPath As String)
+Dim cType As Integer, bNum As Long, fExt As String
+For bNum = 1 To Len(File)
+ If InStr(bNum, File, ".") > 0 Then
+ bNum = InStr(bNum, File, ".")
+ Else
+ Exit For
+ End If
+Next bNum
+If bNum > 1 Then
+ fExt = Mid(File, bNum - 1)
+Else
+ fExt = File
+End If
+If LCase(fExt) = ".bik" Then
+ cType = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
+ElseIf LCase(fExt) = ".smk" Then
+ cType = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
+ElseIf LCase(fExt) = ".wav" Then
+ cType = CInt(GetReg(AppKey + "Compression\.wav", "0"))
+Else
+ cType = CInt(GetReg(AppKey + "Compression\" + fExt, "-1"))
+End If
+Select Case cType
+Case -2
+MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 0
+Case -1
+MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 1
+Case 0, 1, 2
+MpqEx.Mpq.mAddWavFile hMPQ, File, MpqPath, cType
+Case Else
+MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 1
+End Select
+End Sub
+Function DirEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean) As String
+Dim Files() As String, lNum As Long, Folders() As String
+If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\"
+ReDim Files(0) As String
+Files(0) = Dir(Path + Filter, Attributes)
+If Files(0) <> "" Then
+ Do
+ ReDim Preserve Files(UBound(Files) + 1) As String
+ Files(UBound(Files)) = Dir
+ Loop Until Files(UBound(Files)) = ""
+ ReDim Preserve Files(UBound(Files) - 1) As String
+End If
+For lNum = 0 To UBound(Files)
+ If Files(lNum) <> "" Then
+ If IsDir(Path + Files(lNum)) = False And (Attributes And vbDirectory) <> vbDirectory Then
+ DirEx = DirEx + Path + Files(lNum) + vbCrLf
+ ElseIf IsDir(Path + Files(lNum)) = True And (Attributes And vbDirectory) Then
+ DirEx = DirEx + Path + Files(lNum) + vbCrLf
+ End If
+ End If
+Next lNum
+If Recurse = True And (InStr(Filter, "?") > 0 Or InStr(Filter, "*") > 0) Then
+ ReDim Folders(0) As String
+ Folders(0) = Dir(Path, vbDirectory)
+ If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir
+ If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir
+ If Folders(0) <> "" Then
+ Do
+ ReDim Preserve Folders(UBound(Folders) + 1) As String
+ Folders(UBound(Folders)) = Dir
+ If Folders(UBound(Folders)) = "." Or Folders(UBound(Folders)) = ".." Then
+ ReDim Preserve Folders(UBound(Folders) - 1) As String
+ End If
+ Loop Until Folders(UBound(Folders)) = ""
+ ReDim Preserve Folders(UBound(Folders) - 1) As String
+ End If
+ For lNum = 0 To UBound(Folders)
+ If Folders(lNum) <> "" Then
+ If IsDir(Path + Folders(lNum)) Then
+ DirEx = DirEx + DirEx(Path + Folders(lNum), Filter, Attributes, Recurse)
+ End If
+ End If
+ Next lNum
+End If
+End Function
+Function GetExtension(FileName As String) As String
+Dim bNum As Long
+If InStr(FileName, ".") > 0 Then
+ For bNum = 1 To Len(FileName)
+ If InStr(bNum, FileName, ".") > 0 Then
+ bNum = InStr(bNum, FileName, ".")
+ Else
+ Exit For
+ End If
+ Next bNum
+ GetExtension = Mid(FileName, bNum - 1)
+Else
+ GetExtension = ""
+End If
+End Function
+Function IsDir(DirPath As String) As Boolean
+On Error GoTo IsNotDir
+If GetAttr(DirPath) And vbDirectory Then
+ IsDir = True
+Else
+ IsDir = False
+End If
+Exit Function
+IsNotDir:
+IsDir = False
+End Function
+Function FileExists(FileName As String) As Boolean
+On Error GoTo NoFile
+If (GetAttr(FileName) And vbDirectory) <> vbDirectory Then
+ FileExists = True
+Else
+ FileExists = False
+End If
+Exit Function
+NoFile:
+FileExists = False
+End Function
+Function IsMPQ(MpqFile As String) As Boolean
+Dim fNum As Long, Text As String, bNum As Long, MpqHead As Long
+If FileExists(MpqFile) = False Then
+ IsMPQ = False
+ Exit Function
+End If
+fNum = FreeFile
+Open MpqFile For Binary As #fNum
+For bNum = 1 To LOF(fNum) Step 2 ^ 20
+ Text = String(2 ^ 20 + 32, Chr(0))
+ If LOF(fNum) - bNum + 1 >= 2 ^ 20 + 32 Then
+ Get #fNum, bNum, Text
+ Else
+ Text = String(LOF(fNum) - bNum + 1, Chr(0))
+ Get #fNum, bNum, Text
+ End If
+ MpqHead = InStr(Text, "MPQ" + Chr(26))
+CheckAgain:
+ If MpqHead > 0 Then
+ If JBytes(Text, MpqHead + 4, 4) >= 32 And JBytes(Text, MpqHead + 12, 2) = 0 Then
+ Exit For
+ Else
+ MpqHead = InStr(MpqHead + 4, Text, "MPQ" + Chr(26))
+ GoTo CheckAgain
+ End If
+ End If
+Next bNum
+Close #fNum
+IsMPQ = True
+If MpqHead = 0 Then IsMPQ = False
+End Function
+Sub KillEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean)
+Dim Files() As String, lNum As Long, Folders() As String
+If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\"
+ReDim Files(0) As String
+Files(0) = Dir(Path + Filter, Attributes)
+If Files(0) <> "" Then
+ Do
+ ReDim Preserve Files(UBound(Files) + 1) As String
+ Files(UBound(Files)) = Dir
+ Loop Until Files(UBound(Files)) = ""
+ ReDim Preserve Files(UBound(Files) - 1) As String
+End If
+For lNum = 0 To UBound(Files)
+ If Files(lNum) <> "" Then
+ If IsDir(Path + Files(lNum)) = False Then
+ On Error Resume Next
+ Kill Path + Files(lNum)
+ On Error GoTo 0
+ End If
+ End If
+Next lNum
+If Recurse = True And (InStr(Filter, "?") > 0 Or InStr(Filter, "*") > 0) Then
+ ReDim Folders(0) As String
+ Folders(0) = Dir(Path, vbDirectory)
+ If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir
+ If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir
+ If Folders(0) <> "" Then
+ Do
+ ReDim Preserve Folders(UBound(Folders) + 1) As String
+ Folders(UBound(Folders)) = Dir
+ If Folders(UBound(Folders)) = "." Or Folders(UBound(Folders)) = ".." Then
+ ReDim Preserve Folders(UBound(Folders) - 1) As String
+ End If
+ Loop Until Folders(UBound(Folders)) = ""
+ ReDim Preserve Folders(UBound(Folders) - 1) As String
+ End If
+ For lNum = 0 To UBound(Folders)
+ If Folders(lNum) <> "" Then
+ If IsDir(Path + Folders(lNum)) Then
+ KillEx Path + Folders(lNum), Filter, Attributes, Recurse
+ On Error Resume Next
+ RmDir Path + Folders(lNum)
+ End If
+ On Error GoTo 0
+ End If
+ Next lNum
+End If
+End Sub
+Function FullPath(ByVal BasePath As String, File As String) As String
+If Right(BasePath, 1) <> "\" Then BasePath = BasePath + "\"
+If Mid(File, 2, 1) = ":" Or Left(File, 2) = "\\" Then
+ FullPath = File
+ElseIf Left(File, 1) = "\" Then
+ FullPath = Left(BasePath, 2) + File
+Else
+ FullPath = BasePath + File
+End If
+End Function
+Function MatchesFilter(FileName As String, ByVal Filters As String) As Boolean
+Dim bNum As Long, Filter As String
+If InStr(Filters, ";") Then
+ If Right(Filters, 1) <> ";" Then Filters = Filters + ";"
+ For bNum = 1 To Len(Filters)
+ Filter = Mid(Filters, bNum, InStr(bNum, Filters, ";") - bNum)
+ If Right(Filter, 3) = "*.*" Then Filter = Left(Filter, Len(Filter) - 2)
+ If LCase(FileName) Like LCase(Filter) Then
+ MatchesFilter = True
+ Exit Function
+ End If
+ bNum = InStr(bNum, Filters, ";")
+ Next bNum
+Else
+ If Right(Filters, 3) = "*.*" Then Filters = Left(Filters, Len(Filters) - 2)
+ If LCase(FileName) Like LCase(Filters) Then MatchesFilter = True
+End If
+End Function
+Function RenameWithFilter(FileName As String, OldFilter As String, NewFilter As String) As String
+Dim bNum As Long, Filters() As String, NewFileName As String, bNum2 As Long, bNum3 As Long, bNum4 As Long, bNum5 As Long
+If Right(OldFilter, 3) = "*.*" Then OldFilter = Left(OldFilter, Len(OldFilter) - 2)
+If Right(NewFilter, 3) = "*.*" Then NewFilter = Left(NewFilter, Len(NewFilter) - 2)
+ReDim Filters(0) As String
+bNum4 = 1
+For bNum = 1 To Len(OldFilter)
+ Select Case Mid(OldFilter, bNum, 1)
+ Case "*"
+ bNum2 = InStr(bNum + 1, OldFilter, "*")
+ bNum3 = InStr(bNum + 1, OldFilter, "?")
+ If bNum2 = 0 And bNum3 = 0 Then
+ bNum2 = Len(OldFilter) + 1
+ ElseIf (bNum3 < bNum2 Or bNum2 = 0) And bNum3 > 0 Then
+ bNum2 = bNum3
+ End If
+ bNum5 = InStr(bNum4, FileName, Mid(OldFilter, bNum + 1, bNum2 - bNum - 1), 1)
+ If bNum = Len(OldFilter) Then
+ bNum5 = Len(FileName) + 1
+ End If
+ If bNum5 = 0 Then
+ RenameWithFilter = FileName
+ Exit Function
+ End If
+ If bNum > 1 Then
+ If Mid(OldFilter, bNum - 1, 1) <> "*" And Mid(OldFilter, bNum - 1, 1) <> "?" Then
+ ReDim Preserve Filters(UBound(Filters) + 1) As String
+ End If
+ Else
+ ReDim Preserve Filters(UBound(Filters) + 1) As String
+ End If
+ Filters(UBound(Filters)) = Filters(UBound(Filters)) + Mid(FileName, bNum4, bNum5 - bNum4)
+ bNum4 = bNum5
+ Case "?"
+ bNum2 = bNum + 1
+ bNum5 = bNum4 + 1
+ If bNum > 1 Then
+ If Mid(OldFilter, bNum - 1, 1) <> "*" And Mid(OldFilter, bNum - 1, 1) <> "?" Then
+ ReDim Preserve Filters(UBound(Filters) + 1) As String
+ End If
+ Else
+ ReDim Preserve Filters(UBound(Filters) + 1) As String
+ End If
+ Filters(UBound(Filters)) = Filters(UBound(Filters)) + Mid(FileName, bNum4, 1)
+ bNum4 = bNum5
+ Case Else
+ bNum4 = bNum4 + 1
+ End Select
+ If bNum4 > Len(FileName) Then
+ If (Right(OldFilter, 1) <> "*" Or bNum + 1 < Len(OldFilter)) And bNum < Len(OldFilter) Then
+ RenameWithFilter = FileName
+ Exit Function
+ Else
+ Exit For
+ End If
+ End If
+Next bNum
+NewFileName = NewFilter
+For bNum = 1 To UBound(Filters)
+ bNum2 = InStr(bNum, NewFileName, "*")
+ bNum3 = InStr(bNum, NewFileName, "?")
+ If bNum2 = 0 And bNum3 = 0 Then
+ bNum2 = Len(NewFileName) + 1
+ ElseIf (bNum3 < bNum2 Or bNum2 = 0) And bNum3 > 0 Then
+ bNum2 = bNum3
+ End If
+ If bNum2 > Len(NewFileName) Then
+ RenameWithFilter = NewFileName
+ Exit Function
+ End If
+ bNum4 = 0
+ For bNum3 = bNum2 To Len(NewFileName)
+ Select Case Mid(NewFileName, bNum3, 1)
+ Case "*"
+ bNum4 = Len(Filters(bNum))
+ bNum3 = bNum3 + 1
+ Exit For
+ Case "?"
+ bNum4 = bNum4 + 1
+ Case Else
+ Exit For
+ End Select
+ Next bNum3
+ NewFileName = Left(NewFileName, bNum2 - 1) + Left(Filters(bNum), bNum4) + Mid(NewFileName, bNum3)
+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 String, bNum As Long, EndLine As Long, fName As String
+Files = ListFiles(MpqFile, ListFile)
+bNum = 1
+Do Until bNum > Len(Files)
+ EndLine = InStr(bNum, Files, vbCrLf)
+ If EndLine = 0 Then EndLine = Len(Files) + 1
+ fName = Mid(Files, bNum, EndLine - bNum)
+ If MatchesFilter(fName, Filters) Then
+ bNum = EndLine + 2
+ Else
+ Files = Left(Files, bNum - 1) + Mid(Files, EndLine + 2)
+ End If
+Loop
+MpqDir = Files
+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
+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 = MpqEx.Mpq.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
+ MpqEx.Mpq.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
+ MpqEx.Mpq.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 = ""
+ For pNum = 3 To UBound(Param)
+ If LCase(Param(pNum)) = "/wav" Then
+ cType = 2
+ ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
+ cType = 1
+ 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 = MpqEx.Mpq.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
+ MpqEx.Mpq.mAddWavFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 0
+ ElseIf cType = -1 Then
+ mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
+ ElseIf cType = 1 Then
+ MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 1
+ Else
+ MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 0
+ End If
+ Else
+ If cType = 2 Then
+ MpqEx.Mpq.mAddWavFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ ElseIf cType = -1 Then
+ mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
+ ElseIf cType = 1 Then
+ MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3), 1
+ Else
+ MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ End If
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ SendMessageA ScriptOut.oText.hWnd, WM_PAINT, 0, &O0
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqEx.Mpq.mCloseMpq hMPQ
+ 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 MpqEx.Mpq.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 + "..."
+ MpqEx.Mpq.sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
+ AddScriptOutput " Done" + vbCrLf
+
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqEx.Mpq.SFileCloseArchive hMPQ
+ If fCount > 1 Then
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " extracted" + vbCrLf
+ End If
+ Else
+ MpqEx.Mpq.GetFile FullPath(NewPath, MpqFile), Param(2), FullPath(CurPath, Param(3)), cType
+ 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))
+ 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
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
+ AddScriptOutput "Renaming " + fLine + " => " + fLine2 + "..."
+ If MpqEx.Mpq.FileExists(FullPath(NewPath, MpqFile), fLine2) Then
+ MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), fLine2
+ MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), fLine, fLine2
+ Else
+ MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), fLine, fLine2
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ If fCount > 1 Then
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " renamed" + vbCrLf
+ End If
+ Else
+ AddScriptOutput "You must use wildcards with new name" + vbCrLf
+ End If
+ Else
+ If MpqEx.Mpq.FileExists(FullPath(NewPath, MpqFile), Param(3)) Then
+ MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), Param(3)
+ MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), Param(2), Param(3)
+ Else
+ MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), Param(2), Param(3)
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ End If
+ Else
+ AddScriptOutput " Required parameter missing" + vbCrLf
+ End If
+ Else
+ AddScriptOutput "No archive open" + vbCrLf
+ End If
+ Case "m", "move"
+ If MpqFile <> "" Then
+ For pNum = 1 To Len(Param(2))
+ If InStr(bNum, Param(2), "\") Then
+ bNum = InStr(bNum, Param(2), "\")
+ Else
+ Exit For
+ End If
+ Next pNum
+ fLineTitle = Mid(Param(2), bNum)
+ 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 AddScriptOutput "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(FullPath(NewPath, MpqFile), Param(2))
+ 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
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
+ AddScriptOutput "Moving " + fLine + " => " + fLine2 + "..."
+ If MpqEx.Mpq.FileExists(FullPath(NewPath, MpqFile), fLine2) Then
+ MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), fLine2
+ MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), fLine, fLine2
+ Else
+ MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), fLine, fLine2
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ If fCount > 1 Then
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " moved" + vbCrLf
+ End If
+ Else
+ If MpqEx.Mpq.FileExists(FullPath(NewPath, MpqFile), Param(3)) Then
+ MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), Param(3)
+ MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), Param(2), Param(3)
+ Else
+ MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), Param(2), Param(3)
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ End If
+ Else
+ AddScriptOutput " Required parameter missing" + vbCrLf
+ End If
+ Else
+ AddScriptOutput "No archive open" + vbCrLf
+ End If
+ Case "d", "del", "delete"
+ If MpqFile <> "" Then
+ If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "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(FullPath(NewPath, MpqFile), Param(2))
+ 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 "Deleting " + fLine + "..."
+ MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), fLine
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ If fCount > 1 Then
+ AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " deleted" + vbCrLf
+ End If
+ Else
+ MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), Param(2)
+ AddScriptOutput " Done" + vbCrLf
+ End If
+ Else
+ AddScriptOutput " Required parameter missing" + vbCrLf
+ End If
+ Else
+ AddScriptOutput "No archive open" + vbCrLf
+ End If
+ Case "f", "flush", "compact"
+ If MpqFile <> "" Then
+ AddScriptOutput "Flushing " + MpqFile + "..."
+ MpqEx.Mpq.CompactMpq FullPath(NewPath, MpqFile)
+ AddScriptOutput " Done" + vbCrLf
+ Else
+ AddScriptOutput "No archive open" + vbCrLf
+ End If
+ Case "l", "list"
+ If MpqFile <> "" Then
+ If Param(2) <> "" Then
+ AddScriptOutput "Creating list..."
+ If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then
+ Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
+ Param(2) = Param(3)
+ Else
+ Files = ListFiles(FullPath(NewPath, MpqFile), ListFile)
+ End If
+ fNum = FreeFile
+ Open FullPath(CurPath, Param(2)) For Binary As #fNum
+ Put #fNum, 1, Files
+ Close #fNum
+ AddScriptOutput " Done" + vbCrLf
+ Else
+ AddScriptOutput " Required parameter missing" + vbCrLf
+ End If
+ Else
+ AddScriptOutput "No archive open" + vbCrLf
+ End If
+ Case "s", "script"
+ AddScriptOutput "Running script " + Param(2) + "..." + vbCrLf + vbCrLf
+ If Param(2) <> "" Then
+ RunScript FullPath(CurPath, Param(2))
+ Else
+ AddScriptOutput " Required parameter missing" + vbCrLf
+ End If
+ AddScriptOutput vbCrLf + "Continuing with previous script..." + vbCrLf
+ Case "x", "exit", "quit"
+ Unload MpqEx
+ 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
+ CurPath = CurDir
+ AddScriptOutput "Current directory is " + CurPath + vbCrLf
+ 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
+ CurPath = CurDir
+ AddScriptOutput "Current directory is " + CurPath + vbCrLf
+ 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
+ CurPath = CurDir
+ AddScriptOutput "Current directory is " + CurPath + vbCrLf
+ 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
+ CurPath = CurDir
+ AddScriptOutput "Current directory is " + CurPath + vbCrLf
+ Else
+ AddScriptOutput "Running command " + sLine + "..."
+ Shell "command.com /c " + sLine, 1
+ AddScriptOutput " Done" + vbCrLf
+ End If
+ Else
+ AddScriptOutput "Comment " + sLine + vbCrLf
+ End If
+ End Select
+ End If
+CommandError:
+ lNum = lNum + 1
+ bNum = EndLine + 1
+Next bNum
+MpqEx.Mpq.DefaultMaxFiles = OldDefaultMaxFiles
+If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
+ChDir OldPath
+End Sub
+Function SBytes(Num, Start As Long, Length As Long) As String
+Dim buffer() As Byte, NumData As Currency
+If Start + Length > 8 Then Length = 8 - Start
+On Error Resume Next
+NumData = Num / 10000
+ReDim buffer(7)
+CopyMemory buffer(0), NumData, 8
+On Error GoTo 0
+SBytes = Mid(StrConv(buffer, vbUnicode), Start + 1, Length)
+End Function
+Function FindMpqHeader(MpqFile As String) As Long
+Dim fNum As Long, Text As String, bNum As Long, MpqHead As Long
+If FileExists(MpqFile) = False Then
+ FindMpqHeader = -1
+ Exit Function
+End If
+fNum = FreeFile
+Open MpqFile For Binary As #fNum
+For bNum = 1 To LOF(fNum) Step 2 ^ 20
+ Text = String(2 ^ 20 + 32, Chr(0))
+ If LOF(fNum) - bNum + 1 >= 2 ^ 20 + 32 Then
+ Get #fNum, bNum, Text
+ Else
+ Text = String(LOF(fNum) - bNum + 1, Chr(0))
+ Get #fNum, bNum, Text
+ End If
+ MpqHead = InStr(Text, "MPQ" + Chr(26))
+CheckAgain:
+ If MpqHead > 0 Then
+ If JBytes(Text, MpqHead + 4, 4) >= 32 And JBytes(Text, MpqHead + 12, 2) = 0 Then
+ Exit For
+ Else
+ MpqHead = InStr(MpqHead + 4, Text, "MPQ" + Chr(26))
+ GoTo CheckAgain
+ End If
+ End If
+Next bNum
+Close #fNum
+FindMpqHeader = bNum + MpqHead - 2
+If MpqHead = 0 Then FindMpqHeader = -1
+End Function
+Function JBytes(Text As String, Start As Long, Length As Long)
+Dim buffer() As Byte, NumData As Currency
+If Start + Length - 1 > Len(Text) Then Length = Len(Text) - (Start - 1)
+On Error Resume Next
+ReDim buffer(Length - 1)
+buffer = StrConv(Mid(Text, Start, Length), vbFromUnicode)
+CopyMemory NumData, buffer(0), Length
+On Error GoTo 0
+JBytes = NumData * 10000
+End Function
+Function GetNumMpqFiles(MpqFile As String) As Long
+Dim fNum As Long, Text As String, MpqHeader As Long
+fNum = FreeFile
+Text = String(4, Chr(0))
+MpqHeader = FindMpqHeader(MpqFile)
+If MpqHeader > -1 Then
+ Open MpqFile For Binary As #fNum
+ Get #fNum, MpqHeader + 29, Text
+ Close #fNum
+ GetNumMpqFiles = JBytes(Text, 1, 4)
+End If
+End Function
diff --git a/Options.frm b/Options.frm
--- /dev/null
+++ b/Options.frm
@@ -0,0 +1,995 @@
+VERSION 4.00
+Begin VB.Form Options
+ BorderStyle = 3 'Fixed Dialog
+ Caption = "Options"
+ ClientHeight = 4695
+ ClientLeft = 1575
+ ClientTop = 1815
+ ClientWidth = 5415
+ Height = 5100
+ Icon = "Options.frx":0000
+ KeyPreview = -1 'True
+ Left = 1515
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 4695
+ ScaleWidth = 5415
+ ShowInTaskbar = 0 'False
+ Top = 1470
+ Width = 5535
+ Begin VB.CommandButton Command2
+ Caption = "&Cancel"
+ Height = 375
+ Left = 3120
+ TabIndex = 1
+ Top = 4200
+ Width = 1335
+ End
+ Begin VB.CommandButton Command1
+ Caption = "O&k"
+ Height = 375
+ Left = 960
+ TabIndex = 0
+ Top = 4200
+ Width = 1335
+ End
+ Begin VB.PictureBox TabDisps
+ BorderStyle = 0 'None
+ Height = 3495
+ Index = 1
+ Left = 240
+ ScaleHeight = 3495
+ ScaleWidth = 4995
+ TabIndex = 3
+ Top = 480
+ Width = 4995
+ Begin VB.TextBox Text1
+ Height = 285
+ Left = 0
+ MaxLength = 6
+ TabIndex = 9
+ Text = "1024"
+ Top = 600
+ Width = 1215
+ End
+ Begin VB.TextBox Text2
+ Height = 285
+ Left = 0
+ TabIndex = 8
+ Text = "0"
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.CheckBox Check2
+ Caption = "&Associate WinMPQ with MPQ Archives"
+ Height = 255
+ Left = 0
+ TabIndex = 7
+ Top = 1680
+ Value = 2 'Grayed
+ Width = 3375
+ End
+ Begin VB.CheckBox Check4
+ Caption = "Use &wildcards in filenames for drag and drop"
+ Height = 255
+ Left = 0
+ TabIndex = 6
+ Top = 2400
+ Value = 2 'Grayed
+ Width = 3735
+ End
+ Begin VB.CheckBox Check5
+ Caption = "Automatically update &modified files"
+ Height = 255
+ Left = 0
+ TabIndex = 5
+ Top = 2160
+ Value = 2 'Grayed
+ Width = 3015
+ End
+ Begin VB.CheckBox Check6
+ Caption = "&Load extra file information (disable this for quicker MPQ load times)"
+ Height = 255
+ Left = 0
+ TabIndex = 4
+ Top = 1920
+ Value = 2 'Grayed
+ Width = 4995
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "Maximum files for new archives: (this cannot be changed for an existing archive)"
+ Height = 495
+ Left = 0
+ TabIndex = 12
+ Top = 120
+ Width = 4335
+ WordWrap = -1 'True
+ End
+ Begin VB.Label Label2
+ AutoSize = -1 'True
+ Caption = "Locale ID for extracting"
+ Height = 195
+ Left = 0
+ TabIndex = 11
+ Top = 960
+ Width = 1650
+ End
+ Begin VB.Label Label3
+ Caption = $"Options.frx":000C
+ Height = 855
+ Left = 0
+ TabIndex = 10
+ Top = 2640
+ Width = 4935
+ End
+ End
+ Begin VB.PictureBox TabDisps
+ BorderStyle = 0 'None
+ Height = 3495
+ Index = 2
+ Left = 240
+ ScaleHeight = 3495
+ ScaleWidth = 4935
+ TabIndex = 23
+ Top = 480
+ Visible = 0 'False
+ Width = 4935
+ Begin VB.CheckBox Check8
+ Caption = "Do not use above lists when one is found by above option"
+ Height = 375
+ Left = 0
+ TabIndex = 49
+ Top = 2880
+ Value = 2 'Grayed
+ Width = 3375
+ End
+ Begin VB.CheckBox Check7
+ Caption = "Use file lists for similarly named archives"
+ Height = 195
+ Left = 0
+ TabIndex = 48
+ Top = 2640
+ Width = 3375
+ End
+ Begin VB.CommandButton cmdDelList
+ Caption = "&Remove"
+ Height = 375
+ Left = 3480
+ TabIndex = 45
+ Top = 1440
+ Width = 1335
+ End
+ Begin VB.ListBox FileLists
+ Height = 2205
+ Left = 0
+ TabIndex = 44
+ Top = 360
+ Width = 3375
+ End
+ Begin VB.CommandButton cmdAddList
+ Caption = "&Add List File..."
+ Height = 375
+ Left = 3480
+ TabIndex = 24
+ Top = 840
+ Width = 1335
+ End
+ Begin VB.Label Label11
+ Caption = "Note: Each file list added will increase the load time for archives."
+ Height = 255
+ Left = 0
+ TabIndex = 47
+ Top = 3240
+ Width = 4815
+ End
+ Begin VB.Label Label10
+ AutoSize = -1 'True
+ Caption = "File Lists:"
+ Height = 195
+ Left = 0
+ TabIndex = 46
+ Top = 120
+ Width = 645
+ End
+ End
+ Begin VB.PictureBox TabDisps
+ BorderStyle = 0 'None
+ Height = 3495
+ Index = 5
+ Left = 240
+ ScaleHeight = 3495
+ ScaleWidth = 4935
+ TabIndex = 13
+ Top = 480
+ Visible = 0 'False
+ Width = 4935
+ Begin VB.CommandButton Command4
+ Caption = "&Reset size/position"
+ Height = 375
+ Left = 360
+ TabIndex = 22
+ Top = 840
+ Width = 1695
+ End
+ Begin VB.CheckBox Check3
+ Caption = "Display &confirmation boxes"
+ Height = 255
+ Left = 0
+ TabIndex = 21
+ Top = 120
+ Value = 2 'Grayed
+ Width = 2415
+ End
+ Begin VB.CheckBox Check1
+ Caption = "&Save last window size and position"
+ Height = 255
+ Left = 0
+ TabIndex = 20
+ Top = 480
+ Value = 2 'Grayed
+ Width = 3015
+ End
+ Begin VB.Frame Frame1
+ Caption = "Startup Path"
+ Height = 1215
+ Left = 0
+ TabIndex = 14
+ Top = 2280
+ Width = 4935
+ Begin VB.OptionButton Option1
+ Caption = "Last &open folder"
+ Height = 255
+ Index = 0
+ Left = 120
+ TabIndex = 19
+ Top = 240
+ Value = -1 'True
+ Width = 1575
+ End
+ Begin VB.OptionButton Option1
+ Caption = "A&pplication folder"
+ Height = 255
+ Index = 1
+ Left = 1680
+ TabIndex = 18
+ Top = 240
+ Width = 1695
+ End
+ Begin VB.OptionButton Option1
+ Caption = "&User-defined folder"
+ Height = 255
+ Index = 2
+ Left = 120
+ TabIndex = 17
+ Top = 480
+ Width = 1695
+ End
+ Begin VB.TextBox Text3
+ Enabled = 0 'False
+ Height = 285
+ Left = 120
+ TabIndex = 16
+ Top = 840
+ Width = 3615
+ End
+ Begin VB.CommandButton Command5
+ Caption = "&Folder..."
+ Enabled = 0 'False
+ Height = 285
+ Left = 3840
+ TabIndex = 15
+ Top = 840
+ Width = 975
+ End
+ End
+ End
+ Begin VB.PictureBox TabDisps
+ BorderStyle = 0 'None
+ Height = 3495
+ Index = 4
+ Left = 240
+ ScaleHeight = 3495
+ ScaleWidth = 4935
+ TabIndex = 26
+ Top = 480
+ Visible = 0 'False
+ Width = 4935
+ Begin VB.ListBox Actions
+ Height = 1215
+ IntegralHeight = 0 'False
+ Left = 3120
+ TabIndex = 38
+ Top = 2280
+ Width = 1815
+ End
+ Begin MSComctlLib.ListView FileTypes
+ Height = 2535
+ Left = 0
+ TabIndex = 43
+ Top = 960
+ Width = 3015
+ _ExtentX = 5318
+ _ExtentY = 4471
+ View = 3
+ LabelEdit = 1
+ Sorted = -1 'True
+ MultiSelect = -1 'True
+ LabelWrap = -1 'True
+ HideSelection = -1 'True
+ _Version = 393217
+ ForeColor = -2147483640
+ BackColor = -2147483643
+ BorderStyle = 1
+ Appearance = 1
+ NumItems = 1
+ BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ Text = "Registered file types:"
+ Object.Width = 2540
+ EndProperty
+ End
+ Begin VB.Label Label9
+ AutoSize = -1 'True
+ Caption = "File extensions:"
+ Height = 195
+ Left = 3120
+ TabIndex = 42
+ Top = 960
+ Width = 1080
+ End
+ Begin VB.Label Label7
+ AutoSize = -1 'True
+ Caption = "Default action:"
+ Height = 195
+ Left = 3120
+ TabIndex = 40
+ Top = 2040
+ Width = 1035
+ End
+ Begin VB.Label Label8
+ Height = 855
+ Left = 3120
+ TabIndex = 41
+ Top = 1200
+ Width = 1755
+ End
+ Begin VB.Label Label6
+ AutoSize = -1 'True
+ Caption = $"Options.frx":00F6
+ Height = 855
+ Left = 0
+ TabIndex = 39
+ Top = 120
+ Width = 4935
+ WordWrap = -1 'True
+ End
+ End
+ Begin VB.PictureBox TabDisps
+ BorderStyle = 0 'None
+ Height = 3495
+ Index = 3
+ Left = 240
+ ScaleHeight = 3495
+ ScaleWidth = 4935
+ TabIndex = 25
+ Top = 480
+ Visible = 0 'False
+ Width = 4935
+ Begin VB.ListBox List1
+ Height = 1815
+ ItemData = "Options.frx":01CE
+ Left = 0
+ List = "Options.frx":01D0
+ Sorted = -1 'True
+ TabIndex = 35
+ Top = 720
+ Width = 1575
+ End
+ Begin VB.TextBox Text4
+ Height = 285
+ Left = 0
+ TabIndex = 34
+ Top = 360
+ Width = 855
+ End
+ Begin VB.CommandButton cmdAdd
+ Caption = "&Add"
+ Height = 285
+ Left = 960
+ TabIndex = 33
+ Top = 360
+ Width = 615
+ End
+ Begin VB.CommandButton Command6
+ Caption = "&Remove"
+ Height = 255
+ Left = 0
+ TabIndex = 32
+ Top = 2640
+ Width = 1095
+ End
+ Begin VB.ComboBox Combo1
+ Enabled = 0 'False
+ Height = 315
+ ItemData = "Options.frx":01D2
+ Left = 1800
+ List = "Options.frx":01DF
+ Style = 2 'Dropdown List
+ TabIndex = 31
+ Top = 720
+ Width = 2535
+ End
+ Begin VB.Frame Frame2
+ Caption = "Audio Compression"
+ Height = 1335
+ Left = 1800
+ TabIndex = 27
+ Top = 1200
+ Visible = 0 'False
+ Width = 2535
+ Begin VB.OptionButton AudioC
+ Caption = "Medium"
+ Height = 255
+ Index = 0
+ Left = 120
+ TabIndex = 30
+ Top = 600
+ Value = -1 'True
+ Width = 2175
+ End
+ Begin VB.OptionButton AudioC
+ Caption = "Highest (Least space)"
+ Height = 255
+ Index = 1
+ Left = 120
+ TabIndex = 29
+ Top = 960
+ Width = 2175
+ End
+ Begin VB.OptionButton AudioC
+ Caption = "Lowest (Best quality)"
+ Height = 255
+ Index = 2
+ Left = 120
+ TabIndex = 28
+ Top = 240
+ Width = 2175
+ End
+ End
+ Begin VB.Label Label5
+ Caption = "Compression type"
+ Height = 255
+ Left = 1800
+ TabIndex = 37
+ Top = 480
+ Width = 1935
+ End
+ Begin VB.Label Label4
+ Caption = "File Extension"
+ Height = 255
+ Left = 0
+ TabIndex = 36
+ Top = 120
+ Width = 1215
+ End
+ End
+ Begin MSComctlLib.TabStrip Tabs
+ Height = 3975
+ Left = 120
+ TabIndex = 2
+ Top = 120
+ Width = 5175
+ _ExtentX = 9128
+ _ExtentY = 7011
+ HotTracking = -1 'True
+ _Version = 393216
+ BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
+ NumTabs = 5
+ BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
+ Caption = "General"
+ ImageVarType = 2
+ EndProperty
+ BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
+ Caption = "File Lists"
+ ImageVarType = 2
+ EndProperty
+ BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628}
+ Caption = "Compression Auto-Selection"
+ ImageVarType = 2
+ EndProperty
+ BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628}
+ Caption = "File Associations"
+ ImageVarType = 2
+ EndProperty
+ BeginProperty Tab5 {1EFB659A-857C-11D1-B16A-00C0F0283628}
+ Caption = "Other"
+ ImageVarType = 2
+ EndProperty
+ EndProperty
+ End
+End
+Attribute VB_Name = "Options"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Dim OldFileName As String, NewListFile As String
+Dim NewExtNames() As String, NewExtComp() As Integer
+Dim ActID() As String
+
+Private Sub Check8_Click()
+If Check8.Value = 1 Then Check8.Value = 2
+End Sub
+Private Sub cmdAdd_Click()
+Dim eNum As Integer
+If Text4 <> "" Then
+ If Left(Text4, 1) <> "." Then Text4 = "." + Text4
+ For eNum = 1 To UBound(NewExtNames)
+ If Text4 = NewExtNames(eNum) Then Exit Sub
+ Next eNum
+ List1.AddItem Text4
+ ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
+ NewExtNames(UBound(NewExtNames)) = Text4
+ ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer
+ NewExtComp(UBound(NewExtComp)) = -1
+ Text4 = ""
+End If
+End Sub
+Private Sub cmdAddList_Click()
+Dim lNum As Long
+CD.Flags = &H1000 Or &H4 Or &H2
+CD.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
+If ShowOpen(CD) = False Then GoTo Cancel
+FileLists.AddItem CD.FileName
+If FileLists.ListCount > 0 Then
+ NewListFile = FileLists.List(0)
+Else
+ NewListFile = ""
+End If
+For lNum = 1 To FileLists.ListCount - 1
+ NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)
+Next lNum
+Cancel:
+End Sub
+Private Sub cmdDelList_Click()
+Dim lNum As Long
+If FileLists.ListIndex > -1 Then
+ FileLists.RemoveItem FileLists.ListIndex
+ If FileLists.ListCount > 0 Then
+ NewListFile = FileLists.List(0)
+ Else
+ NewListFile = ""
+ End If
+ For lNum = 1 To FileLists.ListCount - 1
+ NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)
+ Next lNum
+End If
+End Sub
+Private Sub Combo1_Click()
+Dim eNum As Integer
+For eNum = 1 To UBound(NewExtNames)
+ If List1.List(List1.ListIndex) = NewExtNames(eNum) Then Exit For
+Next eNum
+If UBound(NewExtNames) = 0 Then eNum = 0
+If Combo1.ListIndex = 2 Then
+ Frame2.Visible = True
+ NewExtComp(eNum) = Combo1.ListIndex - 2
+Else
+ Frame2.Visible = False
+ NewExtComp(eNum) = Combo1.ListIndex - 2
+End If
+End Sub
+Private Sub AudioC_Click(Index As Integer)
+Dim eNum As Integer
+For eNum = 1 To UBound(NewExtNames)
+ If List1.List(List1.ListIndex) = NewExtNames(eNum) Then Exit For
+Next eNum
+If UBound(NewExtNames) = 0 Then eNum = 0
+NewExtComp(eNum) = Index
+End Sub
+Private Sub Check1_Click()
+If Check1.Value = 1 Then Check1.Value = 2
+End Sub
+
+Private Sub Check2_Click()
+If Check2.Value = 1 Then Check2.Value = 2
+End Sub
+
+Private Sub Check3_Click()
+If Check3.Value = 1 Then Check3.Value = 2
+End Sub
+
+Private Sub Check4_Click()
+If Check4.Value = 1 Then Check4.Value = 2
+End Sub
+
+Private Sub Check5_Click()
+If Check5.Value = 1 Then Check5.Value = 2
+End Sub
+
+Private Sub Check6_Click()
+If Check6.Value = 1 Then Check6.Value = 2
+End Sub
+Private Sub Command1_Click()
+Dim Path As String, BatKey As String
+Dim eNum As Integer, ExtList As String
+Dim dItem As String, ndItem As String, aNum As Long
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+Text1_LostFocus
+Text2_LostFocus
+MpqEx.Mpq.DefaultMaxFiles = Text1
+LocaleID = Text2
+MpqEx.Mpq.SetLocale (LocaleID)
+NewKey AppKey
+SetReg AppKey + "DefaultMaxFiles", Text1, REG_DWORD
+SetReg AppKey + "LocaleID", Text2, REG_DWORD
+If Check1.Value > 0 Then
+ SetReg AppKey + "SaveWindowStatus", 1, REG_DWORD
+Else
+ SetReg AppKey + "SaveWindowStatus", 0, REG_DWORD
+End If
+If Check3.Value > 0 Then
+ SetReg AppKey + "ShowConfirmation", 1, REG_DWORD
+Else
+ SetReg AppKey + "ShowConfirmation", 0, REG_DWORD
+End If
+If Check4.Value > 0 Then
+ SetReg AppKey + "UseDragDropWildcards", 1, REG_DWORD
+Else
+ SetReg AppKey + "UseDragDropWildcards", 0, REG_DWORD
+End If
+If Check5.Value > 0 Then
+ SetReg AppKey + "CheckModDateTime", 1, REG_DWORD
+Else
+ SetReg AppKey + "CheckModDateTime", 0, REG_DWORD
+ MpqEx.Timer1.Enabled = False
+End If
+If Check6.Value > 0 Then
+ SetReg AppKey + "LoadExtraInfo", 1, REG_DWORD
+Else
+ SetReg AppKey + "LoadExtraInfo", 0, REG_DWORD
+End If
+If Check7.Value > 0 Then
+ SetReg AppKey + "AutofindFileLists", 1, REG_DWORD
+Else
+ SetReg AppKey + "AutofindFileLists", 0, REG_DWORD
+End If
+If Check8.Value > 0 Then
+ SetReg AppKey + "UseOnlyAutofindLists", 1, REG_DWORD
+Else
+ SetReg AppKey + "UseOnlyAutofindLists", 0, REG_DWORD
+End If
+If Check2.Value > 0 Then
+ NewKey "HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive"
+ NewKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"
+ SetReg "HKEY_CLASSES_ROOT\.mpq\ShellNew\NullFile", ""
+ 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
+DelKey AppKey + "Compression\"
+NewKey AppKey + "Compression\"
+For eNum = 1 To UBound(NewExtNames)
+ ExtList = ExtList + NewExtNames(eNum)
+ SetReg AppKey + "Compression\" + NewExtNames(eNum), CStr(NewExtComp(eNum))
+Next eNum
+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
+Path = PathInputBox(PathInput, "WinMPQ Startup Path", Text3)
+If Path <> "" Then Text3 = Path
+End Sub
+
+Private Sub Command6_Click()
+Dim eNum As Integer
+If List1.ListIndex > -1 Then
+ For eNum = 1 To UBound(NewExtNames)
+ If List1.List(List1.ListIndex) = NewExtNames(eNum) Then Exit For
+ Next eNum
+ If eNum < UBound(NewExtNames) Then
+ For eNum = eNum To UBound(NewExtNames) - 1
+ NewExtNames(eNum) = NewExtNames(eNum + 1)
+ NewExtComp(eNum) = NewExtComp(eNum + 1)
+ Next eNum
+ 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
+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 = MpqEx.Mpq.DefaultMaxFiles
+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) Then
+ FileLists.AddItem aName
+ NewFileListNames = NewFileListNames + aName + vbCrLf
+ End If
+ aNum = InStr(aNum, NewListFile, vbCrLf) + 1
+ Else
+ aName = Mid(NewListFile, aNum)
+ If FileExists(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 + "LoadExtraInfo", 1) > 0 Then Check6.Value = 1 Else Check6.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
+ExtList = GetReg(AppKey + "Compression\List", ".bik.smk.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))) = ".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 GoTo 0
+ End If
+ 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 eNum As Integer, OldExtComp As Integer
+If List1.ListIndex > -1 Then
+ Combo1.Enabled = True
+ For eNum = 1 To UBound(NewExtNames)
+ If List1.List(List1.ListIndex) = NewExtNames(eNum) Then Exit For
+ Next eNum
+ Select Case NewExtComp(eNum)
+ Case -2
+ AudioC(0).Value = True
+ Combo1.ListIndex = 0
+ Case -1
+ AudioC(0).Value = True
+ Combo1.ListIndex = 1
+ Case 0, 1, 2
+ OldExtComp = NewExtComp(eNum)
+ Combo1.ListIndex = 2
+ 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 Text1_LostFocus()
+If Text1 = "" Then Text1 = 0
+If Text1 < 16 Then Text1 = 16
+If Text1 > 262144 Then Text1 = 262144
+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
diff --git a/Options.frx b/Options.frx
diff --git a/Registry.bas b/Registry.bas
--- /dev/null
+++ b/Registry.bas
@@ -0,0 +1,244 @@
+Attribute VB_Name = "RegistryFunctions"
+Option Explicit
+
+Private Const HKEY_CLASSES_ROOT = &H80000000
+Private Const HKEY_CURRENT_USER = &H80000001
+Private Const HKEY_LOCAL_MACHINE = &H80000002
+Private Const HKEY_USERS = &H80000003
+Private Const HKEY_PERFORMANCE_DATA = &H80000004
+Private Const HKEY_CURRENT_CONFIG = &H80000005
+Private Const HKEY_DYN_DATA = &H80000006
+Private Const STANDARD_RIGHTS_ALL = &H1F0000
+Private Const KEY_QUERY_VALUE = &H1
+Private Const KEY_SET_VALUE = &H2
+Private Const KEY_CREATE_SUB_KEY = &H4
+Private Const KEY_ENUMERATE_SUB_KEYS = &H8
+Private Const KEY_NOTIFY = &H10
+Private Const SYNCHRONIZE = &H100000
+Private Const KEY_CREATE_LINK = &H20
+Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
+ KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _
+ Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
+ KEY_CREATE_LINK) And (Not SYNCHRONIZE))
+Private Const REG_OPTION_NON_VOLATILE = 0
+Global Const REG_NONE = 0
+Global Const REG_SZ = 1
+Global Const REG_EXPAND_SZ = 2
+Global Const REG_BINARY = 3
+Global Const REG_DWORD = 4
+Global Const REG_DWORD_LITTLE_ENDIAN = 4 ' Same as REG_DWORD
+Global Const REG_DWORD_BIG_ENDIAN = 5
+Global Const REG_LINK = 6
+Global Const REG_MULTI_SZ = 7
+Global Const REG_RESOURCE_LIST = 8
+Global Const REG_FULL_RESOURCE_DESCRIPTOR = 9
+Global Const REG_RESOURCE_REQUIREMENTS_LIST = 10
+
+Private Const REG_CREATED_NEW_KEY = &H1
+Private Const REG_OPENED_EXISTING_KEY = &H2
+
+Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
+ (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
+ ByVal samDesired As Long, phkResult As Long) As Long
+Private Declare Function RegCloseKey Lib "advapi32.dll" _
+ (ByVal hKey As Long) As Long
+Private Declare Function RegEnumValue Lib "advapi32.dll" _
+ Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex _
+ As Long, lpValueName As String, lpcbValueName As Long, ByVal _
+ lpReserved As Long, lpType As Long, lpData As Any, lpcbData As _
+ Long) As Long
+Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
+ Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex _
+ As Long, lpName As String, lpcbName As Long, ByVal _
+ lpReserved As Long, lpClass As String, lpcbClass As _
+ Long, lpftLastWriteTime As Any) As Long
+Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
+ Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _
+ As String, ByVal lpReserved As Long, lpType As Long, lpData As _
+ Any, lpcbData As Long) As Long
+Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
+ Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey _
+ As String, ByVal Reserved As Long, ByVal lpClass As String, _
+ ByVal dwOptions As Long, ByVal samDesired As Long, _
+ lpSecurityAttributes As Any, phkResult _
+ As Long, lpdwDisposition As Long) As Long
+Private Declare Function RegSetValueEx Lib "advapi32.dll" _
+ Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _
+ As String, ByVal Reserved As Long, ByVal dwType As Long, _
+ lpData As Any, ByVal cbData As Long) As Long
+Private Declare Function RegDeleteValue Lib "advapi32.dll" _
+ Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _
+ lpValueName As String) As Long
+Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias _
+ "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
+Sub ConvertValueName(Path As String, ByRef hKey As Long, ByRef Key As String, ValueName As String)
+Dim Data As String, bNum As Long
+Data = Mid$(Path, 1, InStr(Path, "\") - 1)
+Select Case Data
+Case "HKEY_CLASSES_ROOT"
+hKey = HKEY_CLASSES_ROOT
+Case "HKEY_CURRENT_USER"
+hKey = HKEY_CURRENT_USER
+Case "HKEY_LOCAL_MACHINE"
+hKey = HKEY_LOCAL_MACHINE
+Case "HKEY_USERS"
+hKey = HKEY_USERS
+Case "HKEY_PERFORMANCE_DATA"
+hKey = HKEY_PERFORMANCE_DATA
+Case "HKEY_CURRENT_CONFIG"
+hKey = HKEY_CURRENT_CONFIG
+Case "HKEY_DYN_DATA"
+hKey = HKEY_DYN_DATA
+End Select
+bNum = 1
+Do Until InStr(bNum, Path, "\") = 0
+bNum = InStr(bNum, Path, "\") + 1
+Loop
+On Error Resume Next
+Key = Mid$(Path, Len(Data) + 2, bNum - 2 - (Len(Data) + 1))
+ValueName = Mid$(Path, bNum)
+On Error GoTo 0
+End Sub
+Function GetReg(Path As String, Optional Default)
+Attribute GetReg.VB_Description = "Reads a value from the registry."
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long, NumData As Long
+ConvertValueName Path, hKey, Key, ValueName
+If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then
+ If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, vLen) = 0 Then
+ Data = String$(vLen, Chr$(0))
+ If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then
+ If RegQueryValueEx(kHandle, ValueName, 0&, 0&, NumData, vLen) = 0 Then
+ GetReg = NumData
+ End If
+ Else
+ If RegQueryValueEx(kHandle, ValueName, 0&, 0&, ByVal Data, vLen) = 0 Then
+ If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then
+ Data = Left$(Data, vLen - 1)
+ If Data <> "" Then GetReg = Data
+ Else
+ GetReg = Data
+ End If
+ End If
+ End If
+ End If
+ RegCloseKey kHandle
+ If Not IsEmpty(GetReg) Then Exit Function
+End If
+If Not IsError(Default) Then GetReg = Default
+End Function
+Function GetRegType(Path As String) As Long
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long, vType As Long
+ConvertValueName Path, hKey, Key, ValueName
+If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then
+ If RegQueryValueEx(kHandle, ValueName, 0&, vType, ByVal 0&, ByVal 0&) Then
+ GetRegType = vType
+ End If
+ RegCloseKey kHandle
+End If
+End Function
+Function EnumReg(ByVal Path As String, Index As Long) As String
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long
+If Right$(Path, 1) <> "\" Then Path = Path + "\"
+ConvertValueName Path, hKey, Key, ValueName
+ValueName = ""
+If RegOpenKeyEx(hKey, Key, 0&, KEY_QUERY_VALUE, kHandle) = 0 Then
+ vLen = 255
+ Data = String$(255, Chr$(0))
+ If RegEnumValue(kHandle, Index, ByVal Data, vLen, 0&, 0&, ByVal 0&, 0&) = 0 Then
+ Data = Left$(Data, vLen)
+ If Data = String$(255, Chr$(0)) Then Data = ""
+ EnumReg = Data
+ End If
+ RegCloseKey kHandle
+End If
+End Function
+Function EnumKey(ByVal Path As String, Index As Long) As String
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Data As String, vLen As Long
+If Right$(Path, 1) <> "\" Then Path = Path + "\"
+ConvertValueName Path, hKey, Key, ValueName
+ValueName = ""
+If RegOpenKeyEx(hKey, Key, 0&, KEY_ENUMERATE_SUB_KEYS, kHandle) = 0 Then
+ vLen = 255
+ Data = String$(255, Chr$(0))
+ If RegEnumKeyEx(kHandle, Index, ByVal Data, vLen, 0&, ByVal 0&, 0&, ByVal 0&) = 0 Then
+ Data = Left$(Data, vLen)
+ If Data = String$(255, Chr$(0)) Then Data = ""
+ EnumKey = Data
+ End If
+ RegCloseKey kHandle
+End If
+End Function
+Sub MultiStringToArray(MultiString As String, ByRef StrArray() As String)
+Dim cNum As Long, cNum2 As Long
+ReDim StrArray(0)
+For cNum = 1 To Len(MultiString)
+ cNum2 = InStr(cNum, MultiString, Chr(0))
+ If cNum2 = 0 Then cNum2 = Len(MultiString) + 1
+ ReDim Preserve StrArray(UBound(StrArray) + 1)
+ StrArray(UBound(StrArray)) = Mid$(MultiString, cNum, cNum2 - cNum)
+ cNum = cNum2
+Next cNum
+End Sub
+Sub ArrayToMultiString(StrArray() As String, ByRef MultiString As String)
+Dim sNum As Long
+MultiString = ""
+For sNum = 1 To UBound(StrArray)
+ MultiString = MultiString + StrArray(sNum) + Chr$(0)
+Next sNum
+End Sub
+Sub NewKey(ByVal Path As String, Optional Default, Optional vType)
+Attribute NewKey.VB_Description = "Creates a new key in the registry."
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Temp As Long, Setg As String, NumData As Long
+If Right$(Path, 1) <> "\" Then Path = Path + "\"
+ConvertValueName Path, hKey, Key, ValueName
+ValueName = ""
+If RegCreateKeyEx(hKey, Key, 0&, 0&, REG_OPTION_NON_VOLATILE, KEY_CREATE_SUB_KEY Or KEY_SET_VALUE, ByVal 0&, kHandle, Temp) = 0 Then
+ If Not IsError(Default) Then
+ If IsError(vType) Then vType = REG_SZ
+ If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then
+ NumData = Default
+ RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4
+ Else
+ Setg = Default
+ If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _
+ Setg = Setg + Chr$(0)
+ RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg)
+ End If
+ End If
+ RegCloseKey kHandle
+End If
+End Sub
+Sub SetReg(Path As String, NewValue, Optional vType)
+Attribute SetReg.VB_Description = "Writes a value to the registry."
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String, Setg As String, NumData As Long
+ConvertValueName Path, hKey, Key, ValueName
+If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then
+ If IsError(vType) Then vType = REG_SZ
+ If vType = REG_DWORD Or vType = REG_DWORD_BIG_ENDIAN Then
+ NumData = NewValue
+ RegSetValueEx kHandle, ValueName, 0&, vType, NumData, 4
+ Else
+ Setg = NewValue
+ If vType = REG_SZ Or vType = REG_EXPAND_SZ Or vType = REG_MULTI_SZ Then _
+ Setg = Setg + Chr$(0)
+ RegSetValueEx kHandle, ValueName, 0&, vType, ByVal Setg, Len(Setg)
+ End If
+ RegCloseKey kHandle
+End If
+End Sub
+Sub DelReg(Path As String)
+Attribute DelReg.VB_Description = "Deletes a value from the registry."
+Dim hKey As Long, kHandle As Long, Key As String, ValueName As String
+ConvertValueName Path, hKey, Key, ValueName
+If RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, kHandle) = 0 Then
+ RegDeleteValue kHandle, ValueName
+ RegCloseKey kHandle
+End If
+End Sub
+Sub DelKey(ByVal Path As String)
+Attribute DelKey.VB_Description = "Deletes a key from the registry."
+Dim hKey As Long, Key As String, Data As String
+If Right$(Path, 1) <> "\" Then Path = Path + "\"
+ConvertValueName Path, hKey, Key, Data
+RegDeleteKey hKey, Key
+End Sub
diff --git a/ScriptOut.frm b/ScriptOut.frm
--- /dev/null
+++ b/ScriptOut.frm
@@ -0,0 +1,52 @@
+VERSION 4.00
+Begin VB.Form ScriptOut
+ BorderStyle = 3 'Fixed Dialog
+ Caption = "Script Output"
+ ClientHeight = 4575
+ ClientLeft = 480
+ ClientTop = 1275
+ ClientWidth = 9615
+ Height = 4980
+ Icon = "ScriptOut.frx":0000
+ Left = 420
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 4575
+ ScaleWidth = 9615
+ ShowInTaskbar = 0 'False
+ Top = 930
+ Width = 9735
+ Begin VB.TextBox oText
+ BackColor = &H8000000F&
+ BorderStyle = 0 'None
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
+ Name = "Terminal"
+ Size = 9
+ Charset = 255
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 4575
+ Left = 0
+ Locked = -1 'True
+ MultiLine = -1 'True
+ TabIndex = 0
+ Top = 0
+ Width = 9615
+ End
+End
+Attribute VB_Name = "ScriptOut"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub Form_Load()
+Left = (Screen.Width - Width) / 2
+Top = (Screen.Height - Height) / 2
+End Sub
+Private Sub oText_Change()
+If Len(oText) > 8192 Then oText = Right(oText, 8192)
+End Sub
diff --git a/ScriptOut.frx b/ScriptOut.frx
new file mode 100644 (file)
index 0000000..b20c2b6
Binary files /dev/null and b/ScriptOut.frx differ
index 0000000..b20c2b6
Binary files /dev/null and b/ScriptOut.frx differ
diff --git a/ToolList.frm b/ToolList.frm
--- /dev/null
+++ b/ToolList.frm
@@ -0,0 +1,299 @@
+VERSION 4.00
+Begin VB.Form ToolList
+ BorderStyle = 3 'Fixed Dialog
+ Caption = "Add/Remove Tools"
+ ClientHeight = 2775
+ ClientLeft = 1575
+ ClientTop = 1815
+ ClientWidth = 4065
+ Height = 3180
+ Icon = "ToolList.frx":0000
+ Left = 1515
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 2775
+ ScaleWidth = 4065
+ ShowInTaskbar = 0 'False
+ Top = 1470
+ Width = 4185
+ Begin VB.CommandButton Command2
+ Cancel = -1 'True
+ Caption = "&Cancel"
+ Height = 375
+ Left = 1920
+ TabIndex = 3
+ Top = 2400
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdOK
+ Caption = "O&K"
+ Default = -1 'True
+ Height = 375
+ Left = 240
+ TabIndex = 2
+ Top = 2400
+ Width = 1455
+ End
+ Begin VB.ListBox tList
+ Height = 2370
+ IntegralHeight = 0 'False
+ Left = 0
+ TabIndex = 1
+ Top = 0
+ Width = 3600
+ End
+ Begin MSComctlLib.Toolbar Toolbar1
+ Height = 450
+ Left = 3600
+ TabIndex = 0
+ Top = 0
+ Width = 495
+ _ExtentX = 873
+ _ExtentY = 794
+ ButtonWidth = 820
+ ButtonHeight = 794
+ AllowCustomize = 0 'False
+ Style = 1
+ ImageList = "ImageList1"
+ DisabledImageList= "ImageList2"
+ HotImageList = "ImageList3"
+ _Version = 393216
+ BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
+ NumButtons = 6
+ BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Key = "Add"
+ ToolTipText = "Add a program to the list."
+ ImageIndex = 1
+ EndProperty
+ BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Key = "Remove"
+ ToolTipText = "Remove selected program from the list."
+ ImageIndex = 2
+ EndProperty
+ BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Key = "Edit"
+ ToolTipText = "Edit properties for selected program."
+ ImageIndex = 3
+ EndProperty
+ BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Style = 3
+ EndProperty
+ BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Key = "Up"
+ ToolTipText = "Move selected program up in the list."
+ ImageIndex = 4
+ EndProperty
+ BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Key = "Down"
+ ToolTipText = "Move selected program down in the list."
+ ImageIndex = 5
+ EndProperty
+ EndProperty
+ End
+ Begin MSComctlLib.ImageList ImageList3
+ Left = 3360
+ Top = 2400
+ _ExtentX = 1005
+ _ExtentY = 1005
+ BackColor = -2147483643
+ ImageWidth = 24
+ ImageHeight = 24
+ MaskColor = 12632256
+ _Version = 393216
+ BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
+ NumListImages = 5
+ BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":000C
+ Key = ""
+ EndProperty
+ BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":00D8
+ Key = ""
+ EndProperty
+ BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0188
+ Key = ""
+ EndProperty
+ BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0238
+ Key = ""
+ EndProperty
+ BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0310
+ Key = ""
+ EndProperty
+ EndProperty
+ End
+ Begin MSComctlLib.ImageList ImageList2
+ Left = 1560
+ Top = 2400
+ _ExtentX = 1005
+ _ExtentY = 1005
+ BackColor = -2147483643
+ ImageWidth = 24
+ ImageHeight = 24
+ MaskColor = 12632256
+ _Version = 393216
+ BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
+ NumListImages = 5
+ BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":03E8
+ Key = ""
+ EndProperty
+ BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":04C4
+ Key = ""
+ EndProperty
+ BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0574
+ Key = ""
+ EndProperty
+ BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0654
+ Key = ""
+ EndProperty
+ BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0734
+ Key = ""
+ EndProperty
+ EndProperty
+ End
+ Begin MSComctlLib.ImageList ImageList1
+ Left = 0
+ Top = 2280
+ _ExtentX = 1005
+ _ExtentY = 1005
+ BackColor = -2147483643
+ ImageWidth = 24
+ ImageHeight = 24
+ MaskColor = 12632256
+ _Version = 393216
+ BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
+ NumListImages = 5
+ BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0810
+ Key = ""
+ EndProperty
+ BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":08EC
+ Key = ""
+ EndProperty
+ BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":09A8
+ Key = ""
+ EndProperty
+ BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0A6C
+ Key = ""
+ EndProperty
+ BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "ToolList.frx":0B4C
+ Key = ""
+ EndProperty
+ EndProperty
+ End
+End
+Attribute VB_Name = "ToolList"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Dim tCommands() As String
+Private Sub cmdOK_Click()
+Dim tNum As Long
+DelKey AppKey + "Tools\"
+NewKey AppKey + "Tools\"
+For tNum = 0 To tList.ListCount - 1
+ SetReg AppKey + "Tools\Name" + CStr(tNum), tList.List(tNum)
+ SetReg AppKey + "Tools\Command" + CStr(tNum), tCommands(tNum + 1)
+Next tNum
+Unload Me
+End Sub
+Private Sub Command2_Click()
+Unload Me
+End Sub
+Private Sub Form_Load()
+Dim tNum As Long, ToolName As String, ToolCommand
+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
+ReDim tCommands(0) As String
+Do
+ ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))
+ ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))
+ If ToolName = "" Then ToolName = ToolCommand
+ If ToolName <> "" Then
+ ReDim Preserve tCommands(UBound(tCommands) + 1) As String
+ tCommands(UBound(tCommands)) = ToolCommand
+ tList.AddItem ToolName
+ End If
+ tNum = tNum + 1
+Loop Until ToolName = ""
+End Sub
+Private Sub tList_Click()
+If tList.ListIndex > -1 Then
+ Toolbar1.Buttons.Item("Remove").Enabled = True
+ Toolbar1.Buttons.Item("Edit").Enabled = True
+Else
+ Toolbar1.Buttons.Item("Remove").Enabled = False
+ Toolbar1.Buttons.Item("Edit").Enabled = False
+End If
+If tList.ListIndex > 0 Then
+ Toolbar1.Buttons.Item("Up").Enabled = True
+Else
+ Toolbar1.Buttons.Item("Up").Enabled = False
+End If
+If tList.ListIndex < tList.ListCount - 1 And tList.ListIndex > -1 Then
+ Toolbar1.Buttons.Item("Down").Enabled = True
+Else
+ Toolbar1.Buttons.Item("Down").Enabled = False
+End If
+End Sub
+Private Sub Toolbar1_ButtonClick(ByVal Button As Button)
+Dim TempText As String, tNum As Long
+Select Case Button.Key
+Case "Add"
+ TempText = EditTItem.EditItem("Add Command", "", "")
+ If TempText <> vbCrLf Then
+ tList.AddItem Left(TempText, InStr(TempText, vbCrLf) - 1)
+ ReDim Preserve tCommands(UBound(tCommands) + 1) As String
+ tCommands(UBound(tCommands)) = Mid(TempText, InStr(TempText, vbCrLf) + 2)
+ tList.ListIndex = tList.ListCount - 1
+ End If
+Case "Remove"
+ For tNum = tList.ListIndex + 1 To tList.ListCount - 1
+ tCommands(tNum) = tCommands(tNum + 1)
+ Next tNum
+ ReDim Preserve tCommands(UBound(tCommands) - 1) As String
+ tList.RemoveItem tList.ListIndex
+ tList_Click
+Case "Edit"
+ TempText = EditTItem.EditItem("Edit Command", tList.List(tList.ListIndex), tCommands(tList.ListIndex + 1))
+ tList.List(tList.ListIndex) = Left(TempText, InStr(TempText, vbCrLf) - 1)
+ tCommands(tList.ListIndex + 1) = Mid(TempText, InStr(TempText, vbCrLf) + 2)
+Case "Up"
+ TempText = tList.List(tList.ListIndex)
+ tList.List(tList.ListIndex) = tList.List(tList.ListIndex - 1)
+ tList.List(tList.ListIndex - 1) = TempText
+ TempText = tCommands(tList.ListIndex + 1)
+ tCommands(tList.ListIndex + 1) = tCommands(tList.ListIndex)
+ tCommands(tList.ListIndex) = TempText
+ tList.ListIndex = tList.ListIndex - 1
+Case "Down"
+ TempText = tList.List(tList.ListIndex)
+ tList.List(tList.ListIndex) = tList.List(tList.ListIndex + 1)
+ tList.List(tList.ListIndex + 1) = TempText
+ TempText = tCommands(tList.ListIndex + 1)
+ tCommands(tList.ListIndex + 1) = tCommands(tList.ListIndex + 2)
+ tCommands(tList.ListIndex + 2) = TempText
+ tList.ListIndex = tList.ListIndex + 1
+End Select
+End Sub
diff --git a/ToolList.frx b/ToolList.frx
diff --git a/WINMPQ.VBP b/WINMPQ.VBP
--- /dev/null
+++ b/WINMPQ.VBP
@@ -0,0 +1,33 @@
+Form=listing.frm
+Module=MpqStuff; MpqStuff.bas
+Module=RegistryFunctions; Registry.bas
+Module=FileDialog; FileDialog.bas
+Module=FixWindowIcon; FixIcon.bas
+Form=Options.frm
+Form=ScriptOut.frm
+Form=About.frm
+Form=FoldName.frm
+Form=ToolList.frm
+Form=EditTItem.frm
+Object={DA729162-C84F-11D4-A9EA-00A0C9199875}#1.60#0; MPQCON~1.OCX
+Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
+ProjWinSize=82,446,212,163
+ProjWinShow=2
+IconForm="MpqEx"
+HelpFile=""
+ResFile32="WinMPQ.res"
+Title="WinMPQ"
+ExeName32="WinMPQ.exe"
+Name="WinMPQ"
+HelpContextID="0"
+StartMode=0
+VersionCompatible32="0"
+MajorVer=1
+MinorVer=54
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="ShadowFlare Software"
+VersionFileDescription="ShadowFlare MPQ Archiver"
+VersionLegalCopyright="Copyright © ShadowFlare Software 2001-2002"
+VersionProductName="WinMPQ"
diff --git a/WinMPQ.ico b/WinMPQ.ico
diff --git a/WinMPQ.res b/WinMPQ.res
diff --git a/WinMPQ.rtf b/WinMPQ.rtf
--- /dev/null
+++ b/WinMPQ.rtf
@@ -0,0 +1,277 @@
+{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fprq2 Arial;}{\f1\fswiss\fprq2\fcharset0 Arial;}{\f2\fmodern\fprq1 Courier New;}{\f3\fnil\fcharset2 Symbol;}}\r
+{\colortbl ;\red0\green0\blue0;}\r
+\viewkind4\uc1\pard\b\f0\fs36 WinMPQ v1.\f1 54\b0\f0\fs20\par\r
+\par\r
+\pard\li360 This program is an mpq archiver I created as an example of a program using the Mpq Control. It currently has many features and is one of the best mpq archivers around.\par\r
+\pard\par\r
+\ul\b\fs24 Required Files (all may be downloaded from my page)\ulnone\b0\fs20\par\r
+\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720 Visual Basic 4 runtime libraries\par\r
+{\pntext\f3\'B7\tab}Microsoft Windows Common Controls\par\r
+{\pntext\f3\'B7\tab}Mpq Control and its required files\par\r
+\pard\par\r
+\ul\b\fs24 Mo'PaQ 2000 parameters and scripts in WinMPQ\ulnone\b0\fs20\par\r
+\pard\li360 WinMPQ has support for running Mo'PaQ 2000 (MPQ2k) parameters and scripts; it almost has full support for every parameter MPQ2k uses and has commands and additional features MPQ2k doesn't have. Also, the name of the MPQ archive only needs to be specified when opening files and using command-line parameters. (parts of this section are taken from the Mo'PaQ 2000 manual)\par\r
+\par\r
+\pard\ul General syntax:\ulnone\par\r
+\pard\li720 Filenames containing spaces must be enclosed in quotation marks like this:\par\r
+\par\r
+\f2 "filename with spaces"\f0\par\r
+\pard\par\r
+\ul Adding Files - the \b\i Add\b0\i0 Command\par\r
+\ulnone\tab The syntax for adding files is:\par\r
+\ul\par\r
+\pard\li720\ulnone\f2 a[dd] <MPQFile> <SourceFile> [DestinationFile] [/c] [/wav] [/auto] [/r]\f0\par\r
+\pard\par\r
+\pard\li720\cf1 Parameters in <> are required, ones in [] are optional. MPQFile is the MoPaQ to add the file(s) to. SourceFile is the file(s) to add to the MoPaQ. If there is only a single file being added (no wildcards are used), DestinationFile is the name that the file will be stored as in the MoPaQ. But, if there are multiple files to add (wildcards are used), DestinationFile is the \i directory\i0 to put the files in. /c tells WinMPQ to compress the file(s). /wav tells WinMPQ to add the file with WAV compression, which is recommended for .WAV files (if both /c and /wav are used, /c will be ignored and /wav used). /auto tells WinMPQ to automatically select the appropriate compression option for each file (if any other compression options are used, they will override this). /r tells WinMPQ to recurse through subdirectories when searching for files to add. If no DestinationFile is given, the file will be added with the same name as SourceFile.\par\r
+\par\r
+Wildcard characters (* and ?) are used by many command-line programs to represent multiple files. WinMPQ uses them currently only for the \b\i Add\b0\i0 command. Wildcards represent one or more unknown characters. The ? wildcard stands for a single unknown character, while * wildcards stand for any number of unknown characters.\cf0\par\r
+\pard\par\r
+\ul Extracting Files - the \b\i Extract\b0\i0 Command\par\r
+\pard\li720\cf1\ulnone The syntax for the extract command is:\par\r
+\par\r
+\f2 e[xtract] <MPQFile> <SourceFile> [DestinationDirectory] [/fp]\cf0\f0\par\r
+\pard\par\r
+\pard\li720\cf1 The parameters in <> are required, ones in [] are optional. SourceFile is the FULL name of the file(s) to be extracted from the MoPaQ, and DestinationDirectory is the directory in which to put the extracted file(s). If DestinationDirectory is absent, the file will be placed in the current directory. Wildcards may be used in SourceFile. The /r parameter MPQ2K uses currently isn't supported by WinMPQ. The /fp parameter specifies that WinMPQ should extract the files with the full path.\par\r
+\pard\cf0\par\r
+\ul Renaming Files - the \b\i Rename\b0\i0 Command\ulnone\par\r
+\pard\li720 The syntax for the rename command is:\par\r
+\pard\par\r
+\pard\li720\cf1\f2 r[ename] <MPQFile> <OldFileName> <NewFileName>\cf0\f0\par\r
+\pard\par\r
+\pard\li720\cf1 All parameters are required. OldFileName is the full filename of the file to be renamed, and NewFileName is the new name for the file. If wildcards are used with the rename command, they must be used for both OldFileName and NewFileName.\par\r
+\pard\cf0\par\r
+\ul Moving Files - the \b\i Move\b0\i0 Command\ulnone\par\r
+\pard\li720\cf1 The move command moves one or more files from one virtual directory (technically MoPaQs don't have directories like hard drives do) to another virtual directory. The syntax is as shown:\par\r
+\pard\cf0\par\r
+\pard\li720\cf1\f2 m[ove] <MPQFile> <SourceFile> <DestinationDirectory>\cf0\f0\par\r
+\pard\par\r
+\pard\li720\cf1 All parameters are required. SourceFile is the file(s) to be moved (wildcards allowed), DestinationDirectory is the virtual directory the file(s) to be moved will be placed in.\par\r
+\pard\cf0\par\r
+\ul Deleting Files - the \b\i Delete\b0\i0 Command\ulnone\par\r
+\pard\li720 The syntax for the delete file command is:\par\r
+\pard\par\r
+\pard\li720\cf1\f2 d[elete] <MPQFile> <FileToDelete>\cf0\f0\par\r
+\pard\par\r
+\pard\li720\cf1 All parameters are required. FileToDelete is just that, the file(s) to delete. Wildcards may be used in FileToDelete. /r can't be used with this command in WinMPQ.\par\r
+The first time you use the delete command, you might be rather surprised to find that a deleted file rarely takes up less space in a MoPaQ than a file that hasn't been deleted! This is due to the fact that the delete command only marks a file as deleted; it doesn't actually remove the file from the archive (to preempt the next question, no, you can't undelete a deleted file). To actually remove the file from the MoPaQ, you must use the flush command.\par\r
+\pard\cf0\par\r
+\ul Flushing Out an Archive - the \b\i Flush\b0\i0 Command\ulnone\par\r
+\pard\li720 The syntax for the flush command is:\par\r
+\pard\par\r
+\pard\li720\cf1\f2 f[lush] <MPQFile>\cf0\f0\par\r
+\pard\par\r
+\pard\li720\cf1 MPQFile is the file to flush.\par\r
+The flush command searches through a MoPaQ and purges the space deleted files occupy, shrinking the MoPaQ's size if there are any deleted files in it.\par\r
+\pard\cf0\par\r
+\ul Listing the Files in an Archive - the \b\i List\b0\i0 Command\ulnone\par\r
+\pard\li720 The syntax for the list files command is:\par\r
+\pard\par\r
+\pard\li720\cf1\f2 l[ist] <MPQFile> [Filter] <Out_File>\cf0\f0\par\r
+\pard\par\r
+\pard\li720\cf1 The parameters in <> are required, ones in [] are optional. This will list all the files in the MoPaQ to a text file. The [Filter] parameter is a wildcard filter that specifies what files to list. The <Out_File> parameter tells WinMPQ the file to write the listing to.\par\r
+\pard\cf0\par\r
+\ul Running Scripts - the \b\i Script\b0\i0 Command\ulnone\par\r
+\pard\li720 To run a script:\par\r
+\pard\par\r
+\pard\li720\cf1\f2 s[cript] <ScriptFile>\f0\par\r
+\pard\cf0\par\r
+\ul\b\fs24 Writing Scripts\ulnone\b0\fs20\par\r
+\pard\li360\cf1 A script is basically a file that contains a lot of command lines for WinMPQ to process. This allows you to compile one or more entire MoPaQs in a single process.\par\r
+\pard\li1440\par\r
+\pard\ul Differences Between the Command Line and Scripts\ulnone\par\r
+\pard\li720 For simplicity's sake, the command-line and script-line syntax are almost identical. There are a couple major points of difference, though.\par\r
+\par\r
+1.\tab MoPaQs must be explicitly opened in scripts.\par\r
+2.\tab Because of this, you don't need to specify which MoPaQ you are working with on every single line, as you did on the command-line.\par\r
+\pard\li1440\par\r
+\pard\ul Opening Archives - the \b\i Open\b0\i0 Command\ulnone\par\r
+\pard\li720 The very first thing you must do in scripts is to open the MoPaQ you want to work with. The general syntax for the 'open archive' command is:\par\r
+\pard\li1440\par\r
+\pard\li720\f2 o[pen] <MPQFile> [FileLimit]\par\r
+\pard\li1440\f0\par\r
+\pard\li720 Parameters in <> are required, ones in [] are optional. MPQFile is the file to open. FileLimit only takes affect when the archive is being created from scratch. It is the maximum number of files that this archive can hold, and is 1024 by default. If the MoPaQ already exists, FileLimit will have no effect, but no warning will be indicated. The FileLimit parameter has a minimum value of 16, and a maximum value of 262144.\par\r
+NOTE: Each file that a MoPaQ can hold (the FileLimit) takes up 16 bytes in the MoPaQ, regardless of whether or not it is used. This can add up. For example, an empty MoPaQ with a file limit of 262144 would be 4 MB large!\par\r
+\pard\li1440\par\r
+\pard\ul New Archives - the \b\i New\b0\i0 Command\ulnone\par\r
+\pard\li720 The general syntax for the 'new archive' command is:\par\r
+\pard\li1440\par\r
+\pard\li720\f2 n[ew] <MPQFile> [FileLimit]\par\r
+\pard\li1440\f0\par\r
+\pard\li720 Parameters in <> are required, ones in [] are optional. MPQFile is the file to open. This command will force WinMPQ to overwrite the archive and create a new one.\par\r
+\pard\li1440\par\r
+\pard\ul Closing Archives - the \b\i Close\b0\i0 Command\ulnone\par\r
+\pard\li720 MPQ2k requires this, but using it in WinMPQ isn't required. It is very simple to use the close command, as shown on the following line:\par\r
+\pard\li1440\par\r
+\pard\li720\f2 c[lose]\f0\par\r
+\pard\li1440\par\r
+\pard\ul Script Comments - the Semicolon \b\i ;\ulnone\b0\i0\par\r
+\pard\li720 On some occasions you may want to put comments in a script file for one reason or another. To do this, simply put a semicolon(;) as the first character on a line, and the line will be ignored, and no error will be signaled.\par\r
+\pard\cf0\par\r
+\cf1\ul Changing the Current Directory - the \b\i CD\b0\i0 or \b\i CHDIR\b0\i0 Command\ulnone\par\r
+\pard\li720 The syntax for this command is:\par\r
+\pard\li1440\par\r
+\pard\li720\f2 cd <NewDirectory>\par\r
+\pard\li1440\f0\par\r
+\pard\li720 Parameters in <> are required. NewDirectory is the directory the command will go to. Use "\f2 ..\f0 " to go to the parent directory.\par\r
+\par\r
+\pard\ul Changing the Current Drive - the \i X\b :\b0\i0 Command\ulnone\par\r
+\pard\li720 The syntax for this command is:\par\r
+\pard\li1440\par\r
+\pard\li720\f2 <DriveLetter>:\par\r
+\pard\li1440\f0\par\r
+\pard\li720 Parameters in <> are required. DriveLetter is the letter of the drive you want to switch to.\par\r
+\par\r
+\pard\ul Closing WinMPQ - the \b\i Exit\b0\i0 or \b\i Quit\b0\i0 Command\ulnone\par\r
+\pard\li720 The syntax for this command is:\par\r
+\pard\li1440\par\r
+\pard\li720\f2 x\par\r
+\pard\li360\f0 or\f2\par\r
+\pard\li720 exit\par\r
+\pard\li360\f0 or\f2\par\r
+\pard\li720 quit\par\r
+\pard\li1440\f0\par\r
+\pard\li720 This command closes WinMPQ.\par\r
+\par\r
+\pard\cf0\ul\b\fs24 The MPQ2k Command Box\ulnone\b0\fs20\par\r
+\pard\li360\cf1 This is a text box where you can type in different commands. The commands are the same as they are in the script files, but there are a few differences. The \b\i Open\b0\i0 command can be used to open an archive into the main listing in addition to using the open menu command. It can also be used by itself to reload an archive. Just like with scripts, you don't need to specify the name of the archive for commands other than the open command. All commands typed into the box affect the archive open in the main listing.\par\r
+\par\r
+\pard\cf0\ul\b\fs24 Locale ID\ulnone\b0\fs20\par\r
+\pard\li360 The locale ID determines what language version of a file is extracted. Currently you can't add files with anything other than language neutral, only extract. Here is a list of some of the ID numbers you can use to extract the other language versions of some of the files.\par\r
+\pard\par\r
+\pard\li720\tx3600 0\tab Language Neutral/English\par\r
+1031 (407 in hex)\tab German\par\r
+1033 (409 in hex)\tab English (neutral is usually used instead of this)\par\r
+1034 (40A in hex)\tab Spanish\par\r
+1036 (40C in hex)\tab French\par\r
+1040 (410 in hex)\tab Italian\par\r
+1046 (416 in hex)\tab Portuguese\par\r
+\pard\par\r
+\ul\b\fs24 Version notes\ulnone\b0\fs20\par\r
+\pard\li360 The menu option for running Mo'PaQ 2000 scripts has support for almost everything. The /r switch may only be used with Add, and the /lf and /p switches are not used with the List command because WinMPQ does not display the list to the screen. Scripts can be run within each other in WinMPQ. Use the /auto parameter with the Add command to use compression auto-selection.\par\r
+\pard\par\r
+\ul\b\fs24 Version history\ulnone\b0\fs20\par\r
+\par\r
+\ul\b 1.\f1 54\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Added an option to only use found file lists when using the option to automatically find file lists.\f0\par\r
+\f1{\pntext\f3\'B7\tab}Implemented a workaround for the icon color limitation in Visual Basic 4 programs. Now the icon shown when the program is running is 256 colors as it should be.\f0\par\r
+\pard\par\r
+\ul\b 1.\f1 53\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 No longer requires common dialog control.\f0\par\r
+\pard\par\r
+\ul\b 1.\f1 52\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Fixed a bug that would sometimes prevent adding a file if only one was dragged to WinMPQ or only one file was in the folder when using "Add Folder"\f0\par\r
+\pard\par\r
+\ul\b 1.\f1 51\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Files are no longer added twice when dragging them to WinMPQ.\f0\par\r
+\f1{\pntext\f3\'B7\tab}Changed compact confirmation message.\f0\par\r
+\pard\par\r
+\ul\b 1.\f1 50\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Fixed an error that would cause WinMPQ to crash if an archive was opened, a file was opened from the archive, and the archive was deleted.\f0\par\r
+\pard\par\r
+\ul\b 1.4\f1 9\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Added an option to automatically use file lists with filenames similar to the open mpq archive.\f0\par\r
+\pard\par\r
+\ul\b 1.48__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a bug which caused WinMPQ to reload the archive when adding files.\par\r
+{\pntext\f3\'B7\tab}The mpq archive listing will now be reloaded if a script is run which modifies the currently open archive.\par\r
+{\pntext\f3\'B7\tab}Added Warcraft III maps to open dialog filter.\par\r
+\pard\par\r
+\ul\b 1.47__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Adding a large number of files to an archive will no longer corrupt the file list in the archive.\par\r
+{\pntext\f3\'B7\tab}Script output will now start displaying immediately, rather than after a few lines have executed.\par\r
+\pard\par\r
+\ul\b 1.46__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Mpq archive loading progress is shown in the status bar now.\par\r
+{\pntext\f3\'B7\tab}Mpq archives load quicker.\par\r
+\pard\par\r
+\ul\b 1.45__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Combined all the options under the options menu into one dialog box with tabs.\par\r
+{\pntext\f3\'B7\tab}You may now load multiple file lists through the options menu.\par\r
+{\pntext\f3\'B7\tab}When dragging only one file from WinMPQ, the exact filename will always be given to the program you drag the file to, instead of using wildcards.\par\r
+{\pntext\f3\'B7\tab}The filenames in the archive listing are now updated when using the rename or delete commands through the mpq2k command box.\par\r
+{\pntext\f3\'B7\tab}Added extra names of existing commands.\par\r
+{\pntext\f3\'B7\tab}Almost has full support for Mpq2k scripts.\par\r
+\pard\par\r
+\ul\b 1.42__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a bug that caused WinMPQ to be unable to create or enumerate registry keys on Windows NT4, 2000, or XP.\par\r
+{\pntext\f3\'B7\tab}Fixed some bugs with the popup menu that appears when right-clicking files.\par\r
+{\pntext\f3\'B7\tab}WinMPQ now notifies Windows when it associates itself with files, so Windows will update the icon for MPQ archives.\par\r
+{\pntext\f3\'B7\tab}Added more checks for whether files exist. This was done to prevent crashes in some instances.\par\r
+\pard\par\r
+\ul\b 1.40__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a division by zero error that would occur when displaying the compression ratio of zero byte files.\par\r
+\pard\par\r
+\ul\b 1.39__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 WinMPQ no longer does checks on open files while the options window is open. Previously, this caused a message saying "This file is not an MPQ archive." to show when the options window is opened after you've opened files in the MPQ archive.\par\r
+\pard\par\r
+\ul\b 1.38__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a bug that caused a "File not found" message when WinMPQ would check the day and time a file was last modified. This caused WinMPQ to be unable to create new mpq archives.\par\r
+\pard\par\r
+\ul\b 1.37__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Added a file filter box for making WinMPQ display files with a certain file extension (separate filters with a semicolon ; for multiple filters).\par\r
+{\pntext\f3\'B7\tab}Added "Tools" menu for using the open mpq archive or the selected files in a program other than what they are associated with (example: a hex editor).\par\r
+{\pntext\f3\'B7\tab}Made some improvements with the way files are handled when opening a file in an MPQ archive or dragging files from an MPQ archive.\par\r
+{\pntext\f3\'B7\tab}Command prompt commands may be typed into the Mpq2k Command box at the bottom of the window.\par\r
+\pard\par\r
+\ul\b 1.35__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Added a popup-menu that allows you to open a file with a program other than the default.\par\r
+{\pntext\f3\'B7\tab}WinMPQ can now be set to open a program other than the default when opening a file from an MPQ archive.\par\r
+{\pntext\f3\'B7\tab}When you open a file from an MPQ archive and modify it, WinMPQ will display a prompt asking if you want to add the modified file.\par\r
+{\pntext\f3\'B7\tab}Added option to disable loading extra file information. This can be used to make MPQ archives load faster.\par\r
+\pard\par\r
+\ul\b 1.33__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a bug in the code that gets the names of files in a folder and its subfolders.\par\r
+\pard\par\r
+\ul\b 1.32__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 MPQ2k commands can be typed in at a box at the bottom of the WinMPQ window.\par\r
+{\pntext\f3\'B7\tab}WinMPQ now uses the startup parameters MPQ2k uses.\par\r
+{\pntext\f3\'B7\tab}Added recent file list to file menu.\par\r
+\pard\par\r
+\ul\b 1.30__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Files can be dragged to WinMPQ to add files and from WinMPQ to extract files.\par\r
+{\pntext\f3\'B7\tab}Added compression auto-selection option.\par\r
+{\pntext\f3\'B7\tab}Added menu option that adds all the files in a folder and its subfolders.\par\r
+{\pntext\f3\'B7\tab}Added menu option to create a file list with the listed filenames in the MPQ archive.\par\r
+{\pntext\f3\'B7\tab}Added option to set the folder WinMPQ starts up at.\par\r
+{\pntext\f3\'B7\tab}Added option to associate MPQ archives with WinMPQ.\par\r
+{\pntext\f3\'B7\tab}The Delete menu option no longer asks if you want to delete a file when none is selected.\par\r
+{\pntext\f3\'B7\tab}The Extract menu option will now prompt you for the folder it will extract files to and will also extract all the listed files when none are selected.\par\r
+{\pntext\f3\'B7\tab}Added option to suppress prompts.\par\r
+{\pntext\f3\'B7\tab}Filenames are shown on the title bar.\par\r
+{\pntext\f3\'B7\tab}Added a toolbar.\par\r
+\pard\tab\par\r
+\ul\b 1.20__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Optional parameters in Mo'PaQ 2000 scripts are now optional as they should be.\par\r
+{\pntext\f3\'B7\tab}Wildcards and the /r switch work when using the A command in scripts.\par\r
+{\pntext\f3\'B7\tab}Scripts are now run in the folder they are located instead of the program's folder.\par\r
+\pard\par\r
+\ul\b 1.15__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a bug that prevented WinMPQ from recognizing that audio compression is selected. Audio compression should work properly now.\par\r
+{\pntext\f3\'B7\tab}Added a way to assign a path to files you add without needing to rename them.\par\r
+\pard\par\r
+\ul\b 1.12__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a bug that caused embedded mpq archives to be improperly located, causing an overflow when finding the total number of files.\par\r
+\pard\par\r
+\ul\b 1.11__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed another renaming bug. It should work properly now.\par\r
+\pard\par\r
+\ul\b 1.10__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a bug that prevented the dialog box for adding files to show up on some systems.\par\r
+\pard\par\r
+\ul\b 1.01__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Fixed a file renaming bug.\par\r
+{\pntext\f3\'B7\tab}The method for finding embedded mpq archives is more reliable.\par\r
+\pard\par\r
+\ul\b 1.00__________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0 Initial release.\par\r
+\pard\par\r
+\ul\b\fs24 Bug Reports\ulnone\b0\fs20\par\r
+\par\r
+\pard\li360 If you find a bug, please send me an e-mail with a description of the error and step-by-step instuctions on how you made it happen.\par\r
+\pard\par\r
+-ShadowFlare\par\r
+\pard\li360 email:\tab blakflare@hotmail.com\par\r
+web page:\tab http://shadowflare.ancillaediting.net/\par\r
+}\r
+\0
\ No newline at end of file
diff --git a/blank.gif b/blank.gif
diff --git a/downarrow.gif b/downarrow.gif
new file mode 100644 (file)
index 0000000..bf27a6e
Binary files /dev/null and b/downarrow.gif differ
index 0000000..bf27a6e
Binary files /dev/null and b/downarrow.gif differ
diff --git a/downarrowa.gif b/downarrowa.gif
new file mode 100644 (file)
index 0000000..fa3a034
Binary files /dev/null and b/downarrowa.gif differ
index 0000000..fa3a034
Binary files /dev/null and b/downarrowa.gif differ
diff --git a/downarrowg.gif b/downarrowg.gif
new file mode 100644 (file)
index 0000000..011abba
Binary files /dev/null and b/downarrowg.gif differ
index 0000000..011abba
Binary files /dev/null and b/downarrowg.gif differ
diff --git a/edit.gif b/edit.gif
diff --git a/edita.gif b/edita.gif
diff --git a/editg.gif b/editg.gif
diff --git a/listing.frm b/listing.frm
--- /dev/null
+++ b/listing.frm
@@ -0,0 +1,2833 @@
+VERSION 4.00
+Begin VB.Form MpqEx
+ Caption = "WinMPQ"
+ ClientHeight = 3510
+ ClientLeft = 1245
+ ClientTop = 1785
+ ClientWidth = 6690
+ Height = 4200
+ Icon = "listing.frx":0000
+ Left = 1185
+ LinkTopic = "Form1"
+ ScaleHeight = 3510
+ ScaleWidth = 6690
+ Top = 1155
+ Width = 6810
+ Begin VB.Timer Timer1
+ Enabled = 0 'False
+ Interval = 5000
+ Left = 6120
+ Top = 2160
+ End
+ Begin VB.TextBox txtCommand
+ BackColor = &H8000000F&
+ Height = 285
+ Left = 1440
+ TabIndex = 1
+ Top = 2880
+ Width = 4695
+ End
+ Begin VB.CommandButton cmdGo
+ Caption = "Go"
+ Height = 285
+ Left = 6120
+ TabIndex = 2
+ Top = 2880
+ Width = 495
+ End
+ Begin VB.ComboBox mFilter
+ Height = 315
+ ItemData = "listing.frx":27A2
+ Left = 5220
+ List = "listing.frx":27A9
+ Sorted = -1 'True
+ TabIndex = 3
+ Text = "*"
+ Top = 30
+ Width = 675
+ End
+ Begin MSComctlLib.Toolbar Toolbar
+ Align = 1 'Align Top
+ Height = 345
+ Left = 0
+ TabIndex = 5
+ Top = 0
+ Width = 6690
+ _ExtentX = 11800
+ _ExtentY = 609
+ ButtonWidth = 1535
+ ButtonHeight = 556
+ Wrappable = 0 'False
+ Appearance = 1
+ Style = 1
+ ImageList = "ImageList1"
+ _Version = 393216
+ BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
+ NumButtons = 8
+ BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Caption = "New"
+ Key = "New"
+ Description = "Create a new archive"
+ ToolTipText = "Create a new archive"
+ ImageIndex = 1
+ EndProperty
+ BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Caption = "Open"
+ Key = "Open"
+ Description = "Open an existing archive"
+ ToolTipText = "Open an existing archive"
+ EndProperty
+ BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Caption = "Add"
+ Key = "Add"
+ Description = "Add files to the archive"
+ ToolTipText = "Add files to the archive"
+ EndProperty
+ BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Caption = "Add Folder"
+ Key = "Add Folder"
+ Description = "Add files from a folder and its subfolders"
+ ToolTipText = "Add files from a folder and its subfolders"
+ EndProperty
+ BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Caption = "Extract"
+ Key = "Extract"
+ Description = "Extract files from the archive"
+ ToolTipText = "Extract files from the archive"
+ EndProperty
+ BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Caption = "Compact"
+ Key = "Compact"
+ Description = "Clear deleted files from the archive"
+ ToolTipText = "Clear deleted files from the archive"
+ EndProperty
+ BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Key = "filterspace"
+ Style = 4
+ Object.Width = 675
+ EndProperty
+ BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
+ Enabled = 0 'False
+ Caption = "List"
+ Key = "List"
+ EndProperty
+ EndProperty
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = " MPQ2k &Command "
+ Height = 195
+ Left = 0
+ TabIndex = 6
+ Top = 2880
+ Width = 1425
+ End
+ Begin MSComctlLib.ImageList ImageList1
+ Left = 6120
+ Top = 1560
+ _ExtentX = 1005
+ _ExtentY = 1005
+ BackColor = -2147483643
+ ImageWidth = 1
+ ImageHeight = 1
+ MaskColor = 12632256
+ _Version = 393216
+ BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
+ NumListImages = 1
+ BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
+ Picture = "listing.frx":27B0
+ Key = ""
+ EndProperty
+ EndProperty
+ End
+ Begin MSComctlLib.StatusBar StatBar
+ Align = 2 'Align Bottom
+ Height = 300
+ Left = 0
+ TabIndex = 4
+ Top = 3210
+ Width = 6690
+ _ExtentX = 11800
+ _ExtentY = 529
+ _Version = 393216
+ BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
+ NumPanels = 2
+ BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
+ AutoSize = 1
+ Object.Width = 5664
+ MinWidth = 2
+ Key = "FileInfo"
+ EndProperty
+ BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
+ AutoSize = 1
+ Object.Width = 5664
+ MinWidth = 2
+ Key = "MpqInfo"
+ EndProperty
+ EndProperty
+ End
+ Begin MSComctlLib.ListView List
+ Height = 2295
+ Left = 0
+ TabIndex = 0
+ Top = 360
+ Width = 6015
+ _ExtentX = 10610
+ _ExtentY = 4048
+ View = 3
+ Arrange = 2
+ Sorted = -1 'True
+ MultiSelect = -1 'True
+ LabelWrap = -1 'True
+ HideSelection = -1 'True
+ OLEDragMode = 1
+ OLEDropMode = 1
+ AllowReorder = -1 'True
+ _Version = 393217
+ ForeColor = -2147483640
+ BackColor = -2147483643
+ BorderStyle = 1
+ Appearance = 1
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ OLEDragMode = 1
+ OLEDropMode = 1
+ NumItems = 5
+ BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ Key = "N"
+ Text = "Name"
+ Object.Width = 5080
+ EndProperty
+ BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ Alignment = 1
+ SubItemIndex = 1
+ Key = "S"
+ Text = "Size"
+ Object.Width = 1905
+ EndProperty
+ BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ Alignment = 1
+ SubItemIndex = 2
+ Key = "R"
+ Text = "Ratio"
+ Object.Width = 1129
+ EndProperty
+ BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ Alignment = 1
+ SubItemIndex = 3
+ Key = "PK"
+ Text = "Packed"
+ Object.Width = 1905
+ EndProperty
+ BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ SubItemIndex = 4
+ Key = "A"
+ Text = "Attributes"
+ Object.Width = 1129
+ EndProperty
+ End
+ Begin MPQCONTROLLib.MpqControl Mpq
+ Left = 6120
+ Top = 600
+ _Version = 65542
+ _ExtentX = 873
+ _ExtentY = 873
+ _StockProps = 0
+ TitleHidden = -1 'True
+ End
+ Begin VB.Menu mnuFile
+ Caption = "&File"
+ Begin VB.Menu mnuFNew
+ Caption = "&New..."
+ Shortcut = ^N
+ End
+ Begin VB.Menu mnuFOpen
+ Caption = "&Open..."
+ Shortcut = ^O
+ End
+ Begin VB.Menu mnuFReopen
+ Caption = "&Reopen Mpq"
+ Shortcut = {F5}
+ End
+ Begin VB.Menu mnuFScript
+ Caption = "Run Mo'PaQ 2000 &Script..."
+ Shortcut = ^S
+ End
+ Begin VB.Menu mnuFSep
+ Caption = "-"
+ End
+ Begin VB.Menu mnuFExit
+ Caption = "E&xit"
+ End
+ Begin VB.Menu mnuFRecent
+ Caption = "-"
+ Index = 0
+ Visible = 0 'False
+ End
+ End
+ Begin VB.Menu mnuMpq
+ Caption = "&Mpq"
+ Enabled = 0 'False
+ Begin VB.Menu mnuMAdd
+ Caption = "&Add..."
+ Shortcut = ^A
+ End
+ Begin VB.Menu mnuMAddFolder
+ Caption = "Add &Folder..."
+ Shortcut = ^F
+ End
+ Begin VB.Menu mnuMCompression
+ 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 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 mnuMExtract
+ Caption = "&Extract"
+ Shortcut = ^E
+ End
+ Begin VB.Menu mnuMDelete
+ Caption = "&Delete Del or"
+ Shortcut = ^D
+ End
+ Begin VB.Menu mnuMRename
+ Caption = "Rena&me"
+ Shortcut = ^R
+ End
+ Begin VB.Menu mnuMCompact
+ Caption = "Com&pact"
+ Shortcut = ^P
+ 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 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 mnuPSep
+ Caption = "-"
+ End
+ Begin VB.Menu mnuPExtract
+ Caption = "&Extract"
+ End
+ Begin VB.Menu mnuPDelete
+ Caption = "&Delete"
+ End
+ Begin VB.Menu mnuPRename
+ Caption = "Rena&me"
+ End
+ End
+End
+Attribute VB_Name = "MpqEx"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Dim txtCommandHasFocus 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 BuildPopup(FileName As String, Shift As Integer)
+Dim aNum As Long, aItem As String, aName As String, bNum As Long, PItem As Menu, dItem As String
+mnuPopup.Tag = 0
+For Each PItem In mnuPItem
+ If PItem.Index <> 0 Then Unload PItem
+Next PItem
+If InStr(FileName, ".") = 0 Then
+ GoSub AddUnknown
+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 AddUnknown
+ 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
+ mnuPItem(0).Caption = "Op&en with..."
+ Else
+ mnuPItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
+ End If
+ mnuPItem(0).Tag = dItem
+ mnuPopup.Tag = 1
+ aNum = 0
+ bNum = 1
+ Else
+ aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", 0)
+ If aItem = "" Then
+ GoSub AddUnknown
+ 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
+ mnuPItem(0).Caption = "Op&en with..."
+ Else
+ mnuPItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
+ End If
+ mnuPItem(0).Tag = aItem
+ mnuPopup.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 mnuPItem(bNum)
+ On Error GoTo 0
+ If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
+ mnuPItem(bNum).Caption = "Op&en with..."
+ Else
+ mnuPItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
+ End If
+ mnuPItem(bNum).Tag = aItem
+ mnuPopup.Tag = mnuPopup.Tag + 1
+ bNum = bNum + 1
+ End If
+ aNum = aNum + 1
+ End If
+ Loop Until aItem = ""
+ If Shift And vbShiftMask Then GoSub AddUnknown
+End If
+Exit Sub
+AddUnknown:
+ aNum = 0
+ bNum = mnuPopup.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
+ mnuPItem(bNum).Caption = "Op&en with..."
+ Else
+ mnuPItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
+ End If
+ mnuPItem(bNum).Tag = dItem
+ bNum = bNum + 1
+ End If
+ End If
+ Do
+ aItem = EnumKey("HKEY_CLASSES_ROOT\Unknown\shell\", aNum)
+ If aItem <> "" Then
+ If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\command\")) Then
+ On Error Resume Next
+ Load mnuPItem(bNum)
+ On Error GoTo 0
+ If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\")) Then
+ mnuPItem(bNum).Caption = "Op&en with..."
+ Else
+ mnuPItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
+ End If
+ mnuPItem(bNum).Tag = aItem
+ bNum = bNum + 1
+ End If
+ aNum = aNum + 1
+ End If
+ Loop Until aItem = ""
+Return
+End Sub
+Sub DelRecentFile(rFileName As String)
+Dim bNum As Long, fNum As Long
+For bNum = 1 To 8
+ If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then
+ For fNum = bNum To 7
+ SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))
+ Next fNum
+ DelReg AppKey + "Recent\File" + CStr(8)
+ Exit For
+ End If
+Next bNum
+BuildRecentFileList
+End Sub
+Sub AddToListing(AddedFile As String)
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long
+If Mpq.FileExists(CD.FileName, AddedFile) Then
+ L1 = AddedFile
+ fSize = Mpq.FileSize(CD.FileName, AddedFile)
+ cSize = Mpq.GetFileInfo(CD.FileName, AddedFile, 6)
+ If fSize / 1024 > 0 And fSize / 1024 < 1 Then
+ L2 = "<1KB"
+ ElseIf fSize = 0 Then
+ L2 = "0KB"
+ Else
+ L2 = CStr(Int(fSize / 1024)) + "KB"
+ End If
+ If cSize / 1024 > 0 And cSize / 1024 < 1 Then
+ L4 = "<1KB"
+ ElseIf cSize = 0 Then
+ L4 = "0KB"
+ Else
+ L4 = CStr(Int(cSize / 1024)) + "KB"
+ End If
+ If fSize <> 0 Then
+ L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
+ Else
+ L3 = "0%"
+ End If
+ fFlags = Mpq.GetFileInfo(CD.FileName, AddedFile, 7)
+ If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
+ If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
+ If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
+ On Error Resume Next
+ lIndex = List.ListItems.Add(, L1, L1).Index
+ On Error GoTo 0
+ If lIndex = 0 Then
+ lIndex = List.ListItems.Item(L1).Index
+ List.ListItems.Item(L1).ListSubItems.Clear
+ End If
+ List.ListItems.Item(lIndex).Tag = L1
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
+ If fSize <> 0 Then
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
+ Else
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
+ End If
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
+End If
+End Sub
+Sub MpqAddToListing(hMPQ As Long, AddedFile As String)
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hFile As Long
+If Mpq.SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
+ L1 = AddedFile
+ fSize = Mpq.SFileGetFileSize(hFile, 0)
+ cSize = Mpq.SFileGetFileInfo(hFile, 6)
+ If fSize / 1024 > 0 And fSize / 1024 < 1 Then
+ L2 = "<1KB"
+ ElseIf fSize = 0 Then
+ L2 = "0KB"
+ Else
+ L2 = CStr(Int(fSize / 1024)) + "KB"
+ End If
+ If cSize / 1024 > 0 And cSize / 1024 < 1 Then
+ L4 = "<1KB"
+ ElseIf cSize = 0 Then
+ L4 = "0KB"
+ Else
+ L4 = CStr(Int(cSize / 1024)) + "KB"
+ End If
+ If fSize <> 0 Then
+ L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
+ Else
+ L3 = "0%"
+ End If
+ fFlags = Mpq.SFileGetFileInfo(hFile, 7)
+ If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
+ If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
+ If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
+ On Error Resume Next
+ lIndex = List.ListItems.Add(, L1, L1).Index
+ On Error GoTo 0
+ If lIndex = 0 Then
+ lIndex = List.ListItems.Item(L1).Index
+ List.ListItems.Item(L1).ListSubItems.Clear
+ End If
+ List.ListItems.Item(lIndex).Tag = L1
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
+ If fSize <> 0 Then
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
+ Else
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
+ End If
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
+ Mpq.SFileCloseFile hFile
+End If
+End Sub
+Sub RemoveFromListing(RemovedFile As String)
+Dim FileCount As Long
+On Error GoTo FileRemoved
+Do
+List.ListItems.Remove RemovedFile
+FileCount = FileCount + 1
+Loop
+FileRemoved:
+If FileCount = 0 Then
+ For FileCount = 1 To List.ListItems.Count
+ If LCase(RemovedFile) = LCase(List.ListItems.Item(FileCount).Key) Then
+ List.ListItems.Remove FileCount
+ Exit Sub
+ End If
+ Next FileCount
+End If
+End Sub
+Sub RenameInListing(OldName As String, NewName As String)
+Dim lIndex As Long
+If LCase(OldName) <> LCase(NewName) Then RemoveFromListing NewName
+On Error GoTo RenameError
+lIndex = List.ListItems.Item(OldName).Index
+List.ListItems.Item(lIndex).Text = NewName
+List.ListItems.Item(lIndex).Tag = NewName
+On Error Resume Next
+List.ListItems.Item(lIndex).Key = NewName
+On Error GoTo 0
+Exit Sub
+RenameError:
+For lIndex = 1 To List.ListItems.Count
+ If LCase(OldName) = LCase(List.ListItems.Item(lIndex).Key) Then
+ List.ListItems.Item(lIndex).Text = NewName
+ List.ListItems.Item(lIndex).Tag = NewName
+ On Error Resume Next
+ List.ListItems.Item(lIndex).Key = NewName
+ On Error GoTo 0
+ Exit Sub
+ End If
+Next lIndex
+End Sub
+Sub ExecuteFile(FileName As String, Index As Integer)
+Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String
+If Index < mnuPopup.Tag Then
+ ShellExecute hWnd, mnuPItem(Index).Tag, FileName, vbNullString, vbNullString, 1
+Else
+ Param = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + mnuPItem(Index).Tag + "\command\")
+ Do
+ If InStr(Param, "%1") = 0 Then
+ Param = Param + " " + FileName
+ Else
+ bNum = InStr(Param, "%1")
+ Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
+ End If
+ Loop While InStr(Param, "%1")
+ bNum = 1
+ Do While bNum <= Len(Param)
+ If InStr(bNum, Param, "%") Then
+ bNum = InStr(bNum, Param, "%")
+ If InStr(bNum + 1, Param, "%") Then
+ bNum2 = InStr(bNum + 1, Param, "%")
+ EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1)
+ If Environ(EnvName) <> "" Then
+ Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1)
+ End If
+ End If
+ End If
+ bNum = bNum + 1
+ Loop
+ On Error GoTo NoProgram
+ Shell Param, 1
+ On Error GoTo 0
+End If
+Exit Sub
+NoProgram:
+If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
+End Sub
+Sub RunMpq2kCommand(CmdLine As String)
+Dim sLine As String, pNum As Long, Param() As String, EndParam As Long, CurPath As String, cType As Integer, Rswitch As Boolean, fCount As Long, Files As String, fEndLine As Long, fLine As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String, TItem As Menu, fLine2 As String, fLineTitle As String, hMPQ As Long, FileShortNames() As String
+CurPath = CurDir
+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
+ Mpq.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
+ Mpq.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 = ""
+ For pNum = 3 To UBound(Param)
+ If LCase(Param(pNum)) = "/wav" Then
+ cType = 2
+ ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
+ cType = 1
+ 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 = Mpq.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
+ Mpq.mAddWavFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 0
+ ElseIf cType = -1 Then
+ mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
+ ElseIf cType = 1 Then
+ Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 1
+ Else
+ Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 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
+ Mpq.mAddWavFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ ElseIf cType = -1 Then
+ mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
+ ElseIf cType = 1 Then
+ Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3), 1
+ Else
+ Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3), 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
+ Mpq.mCloseMpq hMPQ
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ If UBound(FileShortNames) > 1 Then
+ If Mpq.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
+ Mpq.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 Mpq.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 + "..."
+ Mpq.sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
+ StatBar.SimpleText = StatBar.SimpleText + " Done"
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ Mpq.SFileCloseArchive hMPQ
+ If fCount > 1 Then
+ StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " extracted"
+ End If
+ Else
+ Mpq.GetFile CD.FileName, Param(2), FullPath(CurPath, Param(3)), cType
+ 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) + "..."
+ 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))
+ 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 Mpq.FileExists(CD.FileName, fLine2) Then
+ Mpq.DelFile CD.FileName, fLine2
+ Mpq.RenFile CD.FileName, fLine, fLine2
+ Else
+ Mpq.RenFile CD.FileName, 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
+ 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
+ If Mpq.FileExists(CD.FileName, Param(3)) Then
+ Mpq.DelFile CD.FileName, Param(3)
+ Mpq.RenFile CD.FileName, Param(2), Param(3)
+ Else
+ Mpq.RenFile CD.FileName, Param(2), Param(3)
+ 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))
+ 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 Mpq.FileExists(CD.FileName, fLine2) Then
+ Mpq.DelFile CD.FileName, fLine2
+ Mpq.RenFile CD.FileName, fLine, fLine2
+ Else
+ Mpq.RenFile CD.FileName, 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
+ If fCount > 1 Then
+ StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " moved"
+ End If
+ Else
+ If Mpq.FileExists(CD.FileName, Param(3)) Then
+ Mpq.DelFile CD.FileName, Param(3)
+ Mpq.RenFile CD.FileName, Param(2), Param(3)
+ Else
+ Mpq.RenFile CD.FileName, Param(2), Param(3)
+ 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))
+ For pNum = 1 To Len(Files)
+ fEndLine = InStr(pNum, Files, vbCrLf)
+ fLine = Mid(Files, pNum, fEndLine - pNum)
+ StatBar.SimpleText = "Deleting " + fLine + "..."
+ Mpq.DelFile CD.FileName, 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
+ If fCount > 1 Then
+ StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " deleted"
+ End If
+ Else
+ Mpq.DelFile CD.FileName, Param(2)
+ 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 + "..."
+ Mpq.CompactMpq CD.FileName
+ 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 = ListFiles(CD.FileName, ListFile)
+ 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
+mnuTItem(0).Caption = "(Empty)"
+mnuTItem(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)
+ On Error GoTo 0
+ mnuTItem(tNum).Tag = ToolCommand
+ 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
+ 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, LoadExtraInfo As Integer, MpqFileName As String, FileFilter As String, TItem As Menu, hMPQ As Long, hFile As Long
+On Error Resume Next
+If FileExists(CD.FileName) And FileLen(CD.FileName) = 0 Then
+ ReDim FileList(0) As String
+ List.ListItems.Clear
+ ShowSelected
+ ShowTotal
+ NewFile = True
+ On Error GoTo 0
+ GoTo FileOpened
+End If
+On Error GoTo 0
+If IsMPQ(CD.FileName) = False Then
+ CD.FileName = ""
+ MsgBox "This file does not contain an MPQ archive.", vbExclamation, "WinMPQ"
+ Exit Sub
+End If
+If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
+ CD.FileName = ""
+ MsgBox "The MPQ archive could not be opened.", vbExclamation, "WinMPQ"
+ Exit Sub
+End If
+StatBar.Style = 1
+StatBar.SimpleText = "Loading list..."
+MousePointer = 11
+Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
+ReDim FileList(0) As String
+#If InternalListing Then
+FileList(0) = "(listfile)"
+If Mpq.FileExists(CD.FileName, "(listfile)") Then
+ FileCont = Mpq.GetFileEx(CD.FileName, "(listfile)", 0, -1)
+#Else
+ FileCont = sListFiles(CD.FileName, hMPQ, ListFile)
+#End If
+ For bNum = 1 To Len(FileCont)
+ If InStr(bNum, FileCont, vbCrLf) > 0 Then
+ ReDim Preserve FileList(UBound(FileList) + 1) As String
+ FileList(UBound(FileList)) = Mid(FileCont, bNum, InStr(bNum, FileCont, vbCrLf) - bNum)
+ bNum = InStr(bNum, FileCont, vbCrLf) + 1
+ Else
+ ReDim Preserve FileList(UBound(FileList) + 1) As String
+ FileList(UBound(FileList)) = Mid(FileCont, bNum)
+ Exit For
+ End If
+ Next bNum
+#If InternalListing Then
+End If
+nFiles = UBound(FileList)
+ReDim Preserve FileList(UBound(FileList) + UBound(GlobalFileList)) As String
+For bNum = nFiles + 1 To UBound(FileList)
+ FileList(bNum) = GlobalFileList(bNum - nFiles)
+Next bNum
+#End If
+Dim fNum As Long, lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long
+SendMessageA List.hWnd, WM_SETREDRAW, 0, ByVal 0&
+List.ListItems.Clear
+List.Sorted = False
+LoadExtraInfo = GetReg(AppKey + "LoadExtraInfo", 1)
+FileFilter = mFilter
+StatBar.SimpleText = "Building list... 0% complete"
+For fNum = 1 To UBound(FileList)
+#If InternalListing Then
+ If Mpq.FileExists(CD.FileName, FileList(fNum)) Then
+#End If
+ MpqFileName = FileList(fNum)
+ mFilter.AddItem "*" + GetExtension(MpqFileName)
+ For bNum = 1 To mFilter.ListCount - 1
+ If LCase(mFilter.List(bNum)) = LCase(mFilter.List(bNum - 1)) Then
+ mFilter.RemoveItem bNum
+ Exit For
+ End If
+ Next bNum
+ If MatchesFilter(MpqFileName, FileFilter) Then
+ L1 = FileList(fNum)
+ If LoadExtraInfo > 0 And FileList(fNum) <> "" Then
+ If Mpq.SFileOpenFileEx(hMPQ, FileList(fNum), 0, hFile) <> 0 Then
+ fSize = Mpq.SFileGetFileSize(hFile, 0)
+ cSize = Mpq.SFileGetFileInfo(hFile, 6)
+ If fSize / 1024 > 0 And fSize / 1024 < 1 Then
+ L2 = "<1KB"
+ ElseIf fSize = 0 Then
+ L2 = "0KB"
+ Else
+ L2 = CStr(Int(fSize / 1024)) + "KB"
+ End If
+ If cSize / 1024 > 0 And cSize / 1024 < 1 Then
+ L4 = "<1KB"
+ ElseIf cSize = 0 Then
+ L4 = "0KB"
+ Else
+ L4 = CStr(Int(cSize / 1024)) + "KB"
+ End If
+ If fSize <> 0 Then
+ L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"
+ Else
+ L3 = "0%"
+ End If
+ fFlags = Mpq.SFileGetFileInfo(hFile, 7)
+ If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"
+ If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"
+ If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"
+ Mpq.SFileCloseFile hFile
+ End If
+ End If
+ lIndex = 0
+ On Error Resume Next
+ lIndex = List.ListItems.Add(, L1, L1).Index
+ On Error GoTo 0
+ If lIndex = 0 Then
+ lIndex = List.ListItems.Item(L1).Index
+ List.ListItems.Item(L1).ListSubItems.Clear
+ End If
+ List.ListItems.Item(lIndex).Tag = L1
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize
+ If LoadExtraInfo > 0 Then
+ If fSize <> 0 Then
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)
+ Else
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0
+ End If
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
+ End If
+ End If
+#If InternalListing Then
+ End If
+#End If
+ On Error Resume Next
+ StatBar.SimpleText = "Building list... " + CStr(Int((fNum / UBound(FileList)) * 100)) + "% complete"
+ On Error GoTo 0
+Next fNum
+Mpq.SFileCloseArchive hMPQ
+List.Sorted = True
+#If InternalListing Then
+RemoveDuplicates
+#End If
+On Error Resume Next
+List.SelectedItem.Selected = False
+On Error GoTo 0
+SendMessageA List.hWnd, WM_SETREDRAW, 1, ByVal 0&
+ShowSelected
+ShowTotal
+NewFile = False
+mFilter = FileFilter
+FileOpened:
+ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
+If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+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
+StatBar.Style = 0
+StatBar.SimpleText = ""
+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)
+AddRecentFile CD.FileName
+MousePointer = 0
+End Sub
+Sub RemoveDuplicates()
+Dim fNum As Long
+fNum = 1
+Do While fNum <= List.ListItems.Count - 1
+ If LCase(List.ListItems.Item(fNum).Tag) = LCase(List.ListItems.Item(fNum + 1).Tag) Then
+ List.ListItems.Remove (fNum)
+ fNum = fNum - 1
+ End If
+ fNum = fNum + 1
+Loop
+End Sub
+Sub ShowSelected()
+Dim fNum As Long, nSelect As Long, sSize As Long, fSize As Long, L2 As String
+On Error GoTo NotSelected
+List.SelectedItem.Tag = List.SelectedItem.Tag
+On Error GoTo 0
+For fNum = 1 To List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ nSelect = nSelect + 1
+ If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
+ sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
+ Else
+ fSize = Mpq.FileSize(CD.FileName, List.ListItems.Item(fNum).Tag)
+ If fSize / 1024 > 0 And fSize / 1024 < 1 Then
+ L2 = "<1KB"
+ ElseIf fSize = 0 Then
+ L2 = "0KB"
+ Else
+ L2 = CStr(Int(fSize / 1024)) + "KB"
+ End If
+ List.ListItems.Item(fNum).ListSubItems(1).Text = L2
+ List.ListItems.Item(fNum).ListSubItems(1).Tag = fSize
+ sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
+ End If
+ End If
+Next fNum
+If sSize / 1024 > 0 And sSize / 1024 < 1 Then
+ StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, <1KB"
+ElseIf sSize = 0 Then
+ StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, 0KB"
+Else
+ StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, " + CStr(Int(sSize / 1024)) + "KB"
+End If
+Exit Sub
+NotSelected:
+StatBar.Panels.Item(1).Text = "Selected 0 files, 0KB"
+End Sub
+Sub ShowTotal()
+Dim fNum As Long, nFiles As Long, tSize As Long
+For fNum = 1 To List.ListItems.Count
+ nFiles = nFiles + 1
+ If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
+ tSize = tSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
+ End If
+Next fNum
+If tSize / 1024 > 0 And tSize / 1024 < 1 Then
+ StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, <1KB"
+Else
+ StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, " + CStr(Int(tSize / 1024)) + "KB"
+End If
+End Sub
+Private Sub cmdGo_Click()
+StatBar.Style = 1
+RunMpq2kCommand txtCommand
+txtCommand = ""
+If StatBar.SimpleText = "" Then txtCommand_GotFocus
+End Sub
+Private Sub Form_Load()
+Dim FileName As String, bNum As Long, CurPath As String, CurPath2 As String, CurPathType As Integer, sLine As String, Param() As String, pNum As Long, EndParam As Long, ParamCutout As String, OldStartPath As String, NewStartPath As String, ErrorText As String
+FixIcon hWnd, 1
+InitFileDialog CD
+CD.hwndOwner = hWnd
+CD.DefaultExt = "mpq"
+CD.MaxFileSize = 5120
+InitFolderDialog PathInput
+PathInput.hwndOwner = hWnd
+PathInput.Flags = BIF_RETURNONLYFSDIRS
+ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
+Dim Path
+Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
+ChDir App.Path
+If Mpq.MpqInitialize = False Then
+ ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason: "
+ Select Case Mpq.LastError
+ Case MPQ_ERROR_NO_STAREDIT
+ ErrorText = ErrorText + "Can't find StarEdit.exe"
+ Case MPQ_ERROR_BAD_STAREDIT
+ ErrorText = ErrorText + "Wrong version of StarEdit.exe. Need SC/BW 1.07"
+ Case MPQ_ERROR_STAREDIT_RUNNING
+ ErrorText = ErrorText + "StarEdit.exe is running. It must be closed before running this"
+ Case Else
+ ErrorText = ErrorText + "Unknown"
+ End Select
+ MsgBox ErrorText
+ End
+End If
+ExtractPathNum = -1
+CopyPathNum = -1
+OldStartPath = CurDir
+CurPath = GetReg(AppKey + "StartupPath", CurDir)
+CurPathType = GetReg(AppKey + "StartupPathType", 0)
+If CurPathType < 0 Then CurPathType = 0
+If CurPathType > 2 Then CurPathType = 2
+If CurPathType = 1 Then
+ CurPath = App.Path
+End If
+CurPath2 = CurPath
+If Right(CurPath2, 1) <> "\" Then CurPath2 = CurPath2 + "\"
+If IsDir(CurPath2) Then
+ If Mid(CurPath, 2, 1) = ":" Then ChDrive Left(CurPath, 1)
+ ChDir CurPath
+End If
+NewStartPath = CurDir
+On Error Resume Next
+Height = GetReg(AppKey + "Status\WindowHeight", Height)
+Left = GetReg(AppKey + "Status\WindowLeft", Left)
+Top = GetReg(AppKey + "Status\WindowTop", Top)
+Width = GetReg(AppKey + "Status\WindowWidth", Width)
+If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0
+ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
+Mpq.DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)
+LocaleID = GetReg(AppKey + "LocaleID", 0)
+BuildRecentFileList
+BuildToolsList
+On Error GoTo 0
+Mpq.SetLocale LocaleID
+ReDim GlobalFileList(0) As String
+#If InternalListing Then
+If FileExists(ListFile) Then
+ Open ListFile For Input As #1
+ Do While Not EOF(1)
+ ReDim Preserve GlobalFileList(UBound(GlobalFileList) + 1) As String
+ Line Input #1, GlobalFileList(UBound(GlobalFileList))
+ Loop
+ Close #1
+End If
+#End If
+FileName = Trim(Command)
+If Left(FileName, 1) = Chr(34) Then FileName = Mid(FileName, 2)
+If Right(FileName, 1) = Chr(34) Then FileName = Left(FileName, Len(FileName) - 1)
+FileName = Trim(FileName)
+If FileExists(FileName) Then
+ CD.FileName = FileName
+ Show
+ OpenMpq
+ Exit Sub
+End If
+ReDim FileList(0) As String
+If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
+sLine = Command
+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))
+ If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum - 1, (EndParam + 1) - (pNum - 1))
+ Else
+ EndParam = InStr(pNum, sLine, " ")
+ If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum, EndParam - pNum)
+ 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", "n", "new"
+ Show
+ If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
+ ChDir OldStartPath
+ RunMpq2kCommand sLine
+ Case "a", "add", "e", "extract", "r", "ren", "rename", "m", "move", "d", "del", "delete", "f", "flush", "compact", "l", "list"
+ If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
+ ChDir OldStartPath
+ CD.FileName = FullPath(CurDir, Param(2))
+ sLine = Left(sLine, InStr(sLine, ParamCutout) - 1) + Mid(sLine, InStr(sLine, ParamCutout) + Len(ParamCutout))
+ RunMpq2kCommand sLine
+ If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
+ ChDir NewStartPath
+ Unload Me
+ Case "s", "script"
+ Show
+ If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
+ ChDir OldStartPath
+ RunMpq2kCommand sLine
+ If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
+ ChDir NewStartPath
+ End Select
+End If
+End Sub
+
+
+Private Sub Form_Resize()
+On Error Resume Next
+If WindowState <> 1 Then
+ List.Top = Toolbar.Height
+ List.Width = ScaleWidth
+ List.Height = ScaleHeight - List.Top - StatBar.Height - txtCommand.Height
+ Label1.Top = List.Top + List.Height + (txtCommand.Height - Label1.Height) / 2
+ txtCommand.Top = List.Top + List.Height
+ txtCommand.Left = Label1.Width
+ txtCommand.Width = ScaleWidth - cmdGo.Width - Label1.Width
+ cmdGo.Top = txtCommand.Top
+ cmdGo.Left = txtCommand.Left + txtCommand.Width
+ mFilter.Width = ScaleWidth - mFilter.Left - Toolbar.Buttons.Item("List").Width
+ Toolbar.Buttons.Item("filterspace").Width = mFilter.Width
+End If
+End Sub
+Private Sub Form_Unload(Cancel As Integer)
+Dim Path As String
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+On Error Resume Next
+If ExtractPathNum > -1 Then
+ KillEx Path + "Temp_extract\" + CStr(ExtractPathNum) + "\", "*", 6, True
+ RmDir Path + "Temp_extract\" + CStr(ExtractPathNum) + "\"
+End If
+If DirEx(Path + "Temp_extract\", "*", 6, True) = "" Or App.PrevInstance = False Then
+ KillEx Path + "Temp_extract\", "*", 6, True
+ RmDir Path + "Temp_extract\"
+End If
+If CopyPathNum > -1 Then
+ KillEx Path + "Temp_copy\" + CStr(CopyPathNum) + "\", "*", 6, True
+ RmDir Path + "Temp_copy\" + CStr(CopyPathNum) + "\"
+End If
+If DirEx(Path + "Temp_copy\", "*", 6, True) = "" Or App.PrevInstance = False Then
+ KillEx Path + "Temp_copy\", "*", 6, True
+ RmDir Path + "Temp_copy\"
+End If
+If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then
+ NewKey AppKey
+ NewKey AppKey + "Status\"
+ If WindowState = 1 Then WindowState = 0
+ SetReg AppKey + "Status\WindowState", WindowState, REG_DWORD
+ WindowState = 0
+ SetReg AppKey + "Status\WindowHeight", Height, REG_DWORD
+ SetReg AppKey + "Status\WindowLeft", Left, REG_DWORD
+ SetReg AppKey + "Status\WindowTop", Top, REG_DWORD
+ SetReg AppKey + "Status\WindowWidth", Width, REG_DWORD
+End If
+If GetReg(AppKey + "StartupPathType", 0) <= 0 Then
+ SetReg AppKey + "StartupPath", CurDir
+End If
+End
+End Sub
+Private Sub Label1_Click()
+txtCommand.SetFocus
+End Sub
+Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)
+Dim Result As Long
+If List.SelectedItem.Text <> NewString Then
+ If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
+ Result = vbYes
+ Else
+ Result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
+ End If
+ If Result = vbYes Then
+ List.SelectedItem.Tag = NewString
+ If Mpq.FileExists(CD.FileName, NewString) Then
+ Mpq.DelFile CD.FileName, NewString
+ Mpq.RenFile CD.FileName, List.SelectedItem.Text, NewString
+ RemoveDuplicates
+ Else
+ Mpq.RenFile CD.FileName, List.SelectedItem.Text, NewString
+ End If
+ On Error Resume Next
+ List.SelectedItem.Key = NewString
+ On Error GoTo 0
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ Else
+ Cancel = True
+ End If
+End If
+ShowSelected
+End Sub
+Private Sub List_Click()
+On Error GoTo NotSelected
+List.SelectedItem.Tag = List.SelectedItem.Tag
+On Error GoTo NotClick
+List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
+On Error GoTo 0
+ShowSelected
+Exit Sub
+NotClick:
+List.SelectedItem.Selected = False
+NotSelected:
+ShowSelected
+End Sub
+Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)
+If List.SortKey = ColumnHeader.Index - 1 Then
+ If List.SortOrder = 0 Then
+ List.SortOrder = 1
+ Else
+ List.SortOrder = 0
+ End If
+Else
+ List.SortOrder = 0
+ List.SortKey = ColumnHeader.Index - 1
+End If
+End Sub
+Private Sub List_DblClick()
+Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
+On Error GoTo NotSelected
+List.SelectedItem.Tag = List.SelectedItem.Tag
+On Error GoTo NotClick
+List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
+On Error GoTo 0
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+Path = Path + "Temp_extract\"
+If ExtractPathNum = -1 Then
+ fNum = 0
+ Do
+ If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
+ fNum = fNum + 1
+ Loop
+ ExtractPathNum = fNum
+End If
+Path = Path + CStr(ExtractPathNum) + "\"
+If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+For fNum = 1 To List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ StatBar.Style = 1
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
+ MousePointer = 11
+ Mpq.sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
+ For bNum = 1 To UBound(OpenFiles)
+ If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
+ AlreadyInList = True
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
+ Exit For
+ End If
+ Next bNum
+ If AlreadyInList = False Then
+ ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
+ OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
+ End If
+ End If
+ StatBar.Style = 1
+ StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
+ fName = List.ListItems.Item(fNum).Tag
+ BuildPopup Path + fName, 0
+ ExecuteFile Path + fName, 0
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
+ End If
+Next fNum
+Mpq.SFileCloseArchive hMPQ
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+Exit Sub
+NotClick:
+List.SelectedItem.Selected = False
+NotSelected:
+End Sub
+Private Sub List_KeyPress(KeyAscii As Integer)
+If KeyAscii = 13 Then List_DblClick
+End Sub
+Private Sub List_KeyUp(KeyCode As Integer, Shift As Integer)
+If KeyCode = vbKeyDelete Then
+ mnuMDelete_Click
+ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then
+ On Error GoTo NotSelected
+ List.SelectedItem.Tag = List.SelectedItem.Tag
+ On Error GoTo 0
+ If List.SelectedItem.Selected = True Then
+ BuildPopup List.SelectedItem.Tag, Shift
+ PopupMenu mnuPopup, vbPopupMenuRightButton, List.Left + List.SelectedItem.Left + 12 * Screen.TwipsPerPixelX, List.Top + List.SelectedItem.Top + 16 * Screen.TwipsPerPixelY, mnuPItem(0)
+ End If
+End If
+NotSelected:
+End Sub
+Private Sub List_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
+CX = x
+CY = y
+If Button And vbRightButton Then
+ On Error GoTo NotSelected
+ List.SelectedItem.Tag = List.SelectedItem.Tag
+ On Error GoTo NotClick
+ List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
+ On Error GoTo 0
+ BuildPopup List.SelectedItem.Tag, Shift
+ PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)
+End If
+NotClick:
+NotSelected:
+End Sub
+Private Sub List_OLECompleteDrag(Effect As Long)
+List.Tag = ""
+End Sub
+Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
+Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, Path2 As String, cNum As Long, FileFilter As String
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long
+If Data.GetFormat(ccCFFiles) <> True Then Exit Sub
+For fNum = 1 To Data.Files.Count
+ Path = Data.Files.Item(fNum)
+ If Right(Path, 1) <> "\" Then Path = Path + "\"
+ If IsDir(Path) Then
+ Path = Path + "*"
+ Data.Files.Remove fNum
+ Data.Files.Add Path, fNum
+ End If
+Next fNum
+Path = Data.Files.Item(1)
+For bNum = 1 To Len(Path)
+ If InStr(bNum, Path, "\") > 0 Then
+ For fNum = 1 To Data.Files.Count
+ If Left(Data.Files.Item(fNum), InStr(bNum, Path, "\")) <> Left(Path, InStr(bNum, Path, "\")) Then GoTo PathFound
+ Next fNum
+ bNum = InStr(bNum, Path, "\")
+ Else
+ Exit For
+ End If
+Next bNum
+PathFound:
+Path = Left(Path, bNum - 1)
+ReDim Files(0) As String
+Files(0) = Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+ReDim Preserve Files(Data.Files.Count) As String
+For bNum = 1 To Data.Files.Count
+ Files(bNum) = Mid(Data.Files.Item(bNum), 1 + Len(Path))
+ For fNum = 1 To Len(Files(bNum))
+ If InStr(fNum, Files(bNum), "\") > 0 Then
+ fNum = InStr(fNum, Files(bNum), "\")
+ Else
+ Exit For
+ End If
+ Next fNum
+ FolderFiles = FolderFiles + DirEx(Path + Left(Files(bNum), fNum - 1), Mid(Files(bNum), fNum), 6, True)
+Next bNum
+If FolderFiles = "" Then Exit Sub
+ReDim Preserve Files(0) As String
+For bNum = 1 To Len(FolderFiles)
+ ReDim Preserve Files(UBound(Files) + 1) As String
+ If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
+ Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
+ bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
+ Else
+ Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
+ Exit For
+ End If
+Next bNum
+FoldName.Show 1
+If UBound(Files) > 1 Then
+ ReDim ShortFiles(UBound(Files)) As String
+ For bNum = 0 To UBound(Files)
+ ShortFiles(bNum) = AddFolderName + Files(bNum)
+ Next bNum
+ If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
+ For bNum = 1 To UBound(Files)
+ Files(bNum) = FullPath(Files(0), Files(bNum))
+ Next bNum
+Else
+ For bNum = 1 To Len(Files(1))
+ If InStr(bNum, Files(1), "\") > 0 Then
+ bNum = InStr(bNum, Files(1), "\")
+ Else
+ Exit For
+ End If
+ Next bNum
+ ReDim ShortFiles(UBound(Files)) As String
+ ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
+ Files(1) = FullPath(Files(0), Files(1))
+End If
+If NewFile = True Then
+ If FileExists(CD.FileName) Then Kill CD.FileName
+ NewFile = False
+End If
+List.Sorted = False
+FileFilter = mFilter
+hMPQ = Mpq.mOpenMpq(CD.FileName)
+If hMPQ = 0 Then
+ StatBar.SimpleText = "Can't create archive " + CD.FileName
+ Exit Sub
+End If
+For bNum = 1 To UBound(Files)
+ StatBar.Style = 1
+ StatBar.SimpleText = "Adding " + Files(bNum) + "..."
+ MousePointer = 11
+ If mnuMCNone.Checked Then
+ Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ ElseIf mnuMCStandard.Checked Then
+ Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ ElseIf mnuMCAMedium.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ ElseIf mnuMCAHighest.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ ElseIf mnuMCALowest.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 2
+ ElseIf mnuMCAuto.Checked Then
+ mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
+ End If
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
+ 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
+Next bNum
+Mpq.mCloseMpq hMPQ
+If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+ StatBar.SimpleText = "Adding files to listing... 0% complete"
+ For bNum = 1 To UBound(Files)
+ If MatchesFilter(ShortFiles(bNum), FileFilter) Then
+ MpqAddToListing hMPQ, ShortFiles(bNum)
+ End If
+ On Error Resume Next
+ StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
+ On Error GoTo 0
+ Next bNum
+ Mpq.SFileCloseArchive hMPQ
+End If
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+If MatchesFilter("(listfile)", FileFilter) Then
+ AddToListing "(listfile)"
+End If
+mFilter = FileFilter
+List.Sorted = True
+RemoveDuplicates
+ShowTotal
+Cancel:
+End Sub
+Private Sub List_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
+If CD.FileName = "" Or Data.GetFormat(ccCFFiles) <> True Or List.Tag = "WinMPQ" Then
+ Effect = ccOLEDropEffectNone
+Else
+ Effect = ccOLEDropEffectCopy
+End If
+End Sub
+Private Sub List_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
+Dim fNum As Long, Path As String, fCount As Long, FirstFile As String, hMPQ As Long
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+Path = Path + "Temp_copy\"
+If CopyPathNum = -1 Then
+ fNum = 0
+ Do
+ If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
+ fNum = fNum + 1
+ Loop
+ CopyPathNum = fNum
+End If
+Path = Path + CStr(CopyPathNum) + "\"
+KillEx Path, "*", 6, True
+fCount = 0
+If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+For fNum = 1 To List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ StatBar.Style = 1
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
+ MousePointer = 11
+ Mpq.sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then
+ Data.Files.Add Path + List.ListItems.Item(fNum).Tag
+ End If
+ fCount = fCount + 1
+ If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag
+ End If
+Next fNum
+Mpq.SFileCloseArchive hMPQ
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+If GetReg(AppKey + "UseDragDropWildcards", 1) <> 0 And fCount > 1 Then
+ Data.Files.Add Path + "*"
+ElseIf fCount = 1 Then
+ Data.Files.Add FirstFile
+End If
+End Sub
+Private Sub List_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
+Data.SetData , ccCFFiles
+AllowedEffects = ccOLEDropEffectCopy
+List.Tag = "WinMPQ"
+End Sub
+Private Sub mFilter_KeyPress(KeyAscii As Integer)
+If KeyAscii = 13 And Toolbar.Buttons.Item("List").Enabled Then
+ If NewFile = False Then OpenMpq
+End If
+End Sub
+Private Sub mnuFExit_Click()
+Unload Me
+End Sub
+Private Sub mnuFile_Click()
+If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False
+End Sub
+
+Private Sub mnuFRecent_Click(Index As Integer)
+Dim OldFileName As String
+OldFileName = CD.FileName
+CD.FileName = mnuFRecent(Index).Tag
+If FileExists(CD.FileName) = False Then
+ CD.FileName = OldFileName
+ MsgBox "The file " + Chr(34) + mnuFRecent(Index).Tag + Chr(34) + " does not exist.", vbExclamation, "WinMPQ"
+ DelRecentFile mnuFRecent(Index).Tag
+ Exit Sub
+End If
+OpenMpq
+If CD.FileName = "" Then
+ CD.FileName = OldFileName
+ DelRecentFile mnuFRecent(Index).Tag
+End If
+End Sub
+Private Sub mnuFReopen_Click()
+OpenMpq
+End Sub
+
+Private Sub mnuFScript_Click()
+Dim OldFileName As String, OldPath As String
+CD.Flags = &H1000 Or &H4 Or &H2
+CD.Filter = "All Files (*.*)|*.*"
+OldFileName = CD.FileName
+OldPath = CurDir
+If ShowOpen(CD) = False Then GoTo Cancel
+StatBar.Style = 1
+StatBar.SimpleText = "Running script " + CD.FileName + "..."
+MousePointer = 11
+RunScript CD.FileName
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+CD.FileName = OldFileName
+Cancel:
+If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
+ChDir OldPath
+End Sub
+Private Sub mnuHAbout_Click()
+About.Show 1
+End Sub
+Private Sub mnuHReadme_Click()
+Dim Path As String
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+If FileExists(Path + "WinMPQ.rtf") Then
+ ShellExecute hWnd, vbNullString, Path + "WinMPQ.rtf", vbNullString, vbNullString, 1
+Else
+ MsgBox "Could not find WinMPQ.rtf!", vbCritical, "WinMPQ"
+End If
+End Sub
+Private Sub mnuMAdd_Click()
+Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long
+CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2
+CD.Filter = "All Files (*.*)|*.*"
+OldFileName = CD.FileName
+If ShowOpen(CD) = False Then GoTo Cancel
+ReDim Files(0) As String
+bNum = 1
+If InStr(1, CD.FileName, Chr(0)) > 0 Then
+ Files(0) = Mid(CD.FileName, 1, InStr(1, CD.FileName, Chr(0)) - 1)
+ bNum = InStr(1, CD.FileName, Chr(0)) + 1
+Else
+ Files(0) = Mid(CD.FileName, 1)
+End If
+For bNum = bNum To Len(CD.FileName)
+ ReDim Preserve Files(UBound(Files) + 1) As String
+ If InStr(bNum, CD.FileName, Chr(0)) > 0 Then
+ Files(UBound(Files)) = Mid(CD.FileName, bNum, InStr(bNum, CD.FileName, Chr(0)) - bNum)
+ bNum = InStr(bNum, CD.FileName, Chr(0))
+ Else
+ Files(UBound(Files)) = Mid(CD.FileName, bNum)
+ Exit For
+ End If
+Next bNum
+CD.FileName = OldFileName
+FoldName.Show 1
+If UBound(Files) > 1 Then
+ ReDim ShortFiles(UBound(Files)) As String
+ For bNum = 0 To UBound(Files)
+ ShortFiles(bNum) = AddFolderName + Files(bNum)
+ Next bNum
+ If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
+ For bNum = 1 To UBound(Files)
+ Files(bNum) = FullPath(Files(0), Files(bNum))
+ Next bNum
+Else
+ For bNum = 1 To Len(Files(1))
+ If InStr(bNum, Files(1), "\") > 0 Then
+ bNum = InStr(bNum, Files(1), "\")
+ Else
+ Exit For
+ End If
+ Next bNum
+ ReDim ShortFiles(UBound(Files)) As String
+ ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
+ Files(1) = FullPath(Files(0), Files(1))
+End If
+If NewFile = True Then
+ If FileExists(CD.FileName) Then Kill CD.FileName
+ NewFile = False
+End If
+List.Sorted = False
+FileFilter = mFilter
+hMPQ = Mpq.mOpenMpq(CD.FileName)
+If hMPQ = 0 Then
+ StatBar.SimpleText = "Can't create archive " + CD.FileName
+ Exit Sub
+End If
+For bNum = 1 To UBound(Files)
+ StatBar.Style = 1
+ StatBar.SimpleText = "Adding " + Files(bNum) + "..."
+ MousePointer = 11
+ If mnuMCNone.Checked Then
+ Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ ElseIf mnuMCStandard.Checked Then
+ Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ ElseIf mnuMCAMedium.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ ElseIf mnuMCAHighest.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ ElseIf mnuMCALowest.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 2
+ ElseIf mnuMCAuto.Checked Then
+ mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
+ End If
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
+ 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
+Next bNum
+Mpq.mCloseMpq hMPQ
+If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+ StatBar.SimpleText = "Adding files to listing... 0% complete"
+ For bNum = 1 To UBound(Files)
+ If MatchesFilter(ShortFiles(bNum), FileFilter) Then
+ MpqAddToListing hMPQ, ShortFiles(bNum)
+ End If
+ On Error Resume Next
+ StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
+ On Error GoTo 0
+ Next bNum
+ Mpq.SFileCloseArchive hMPQ
+End If
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+If MatchesFilter("(listfile)", FileFilter) Then
+ AddToListing "(listfile)"
+End If
+mFilter = FileFilter
+List.Sorted = True
+RemoveDuplicates
+ShowTotal
+Cancel:
+End Sub
+Private Sub mnuMAddFolder_Click()
+Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, cNum As Long, FileFilter As String, hMPQ As Long
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long
+Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)
+If Path = "" Then GoTo Cancel
+FolderFiles = DirEx(Path, "*", 6, True)
+If FolderFiles = "" Then Exit Sub
+ReDim Files(0) As String
+Files(0) = Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+For bNum = 1 To Len(FolderFiles)
+ ReDim Preserve Files(UBound(Files) + 1) As String
+ If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
+ Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
+ bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
+ Else
+ Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
+ Exit For
+ End If
+Next bNum
+FoldName.Show 1
+If UBound(Files) > 1 Then
+ ReDim ShortFiles(UBound(Files)) As String
+ For bNum = 0 To UBound(Files)
+ ShortFiles(bNum) = AddFolderName + Files(bNum)
+ Next bNum
+ If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
+ For bNum = 1 To UBound(Files)
+ Files(bNum) = FullPath(Files(0), Files(bNum))
+ Next bNum
+Else
+ For bNum = 1 To Len(Files(1))
+ If InStr(bNum, Files(1), "\") > 0 Then
+ bNum = InStr(bNum, Files(1), "\")
+ Else
+ Exit For
+ End If
+ Next bNum
+ ReDim ShortFiles(UBound(Files)) As String
+ ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
+ Files(1) = FullPath(Files(0), Files(1))
+End If
+If NewFile = True Then
+ If FileExists(CD.FileName) Then Kill CD.FileName
+ NewFile = False
+End If
+List.Sorted = False
+FileFilter = mFilter
+hMPQ = Mpq.mOpenMpq(CD.FileName)
+If hMPQ = 0 Then
+ StatBar.SimpleText = "Can't create archive " + CD.FileName
+ Exit Sub
+End If
+For bNum = 1 To UBound(Files)
+ StatBar.Style = 1
+ StatBar.SimpleText = "Adding " + Files(bNum) + "..."
+ MousePointer = 11
+ If mnuMCNone.Checked Then
+ Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ ElseIf mnuMCStandard.Checked Then
+ Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ ElseIf mnuMCAMedium.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ ElseIf mnuMCAHighest.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ ElseIf mnuMCALowest.Checked Then
+ Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 2
+ ElseIf mnuMCAuto.Checked Then
+ mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
+ End If
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
+ 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
+Next bNum
+Mpq.mCloseMpq hMPQ
+If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+ StatBar.SimpleText = "Adding files to listing... 0% complete"
+ For bNum = 1 To UBound(Files)
+ If MatchesFilter(ShortFiles(bNum), FileFilter) Then
+ MpqAddToListing hMPQ, ShortFiles(bNum)
+ End If
+ On Error Resume Next
+ StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
+ On Error GoTo 0
+ Next bNum
+ Mpq.SFileCloseArchive hMPQ
+End If
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+If MatchesFilter("(listfile)", FileFilter) Then
+ AddToListing "(listfile)"
+End If
+mFilter = FileFilter
+List.Sorted = True
+RemoveDuplicates
+ShowTotal
+Cancel:
+End Sub
+Private Sub mnuMCAHighest_Click()
+mnuMCNone.Checked = False
+mnuMCStandard.Checked = False
+mnuMCALowest.Checked = False
+mnuMCAMedium.Checked = False
+mnuMCAHighest.Checked = True
+mnuMCAuto.Checked = False
+End Sub
+Private Sub mnuMCALowest_Click()
+mnuMCNone.Checked = False
+mnuMCStandard.Checked = False
+mnuMCALowest.Checked = True
+mnuMCAMedium.Checked = False
+mnuMCAHighest.Checked = False
+mnuMCAuto.Checked = False
+End Sub
+
+
+Private Sub mnuMCAMedium_Click()
+mnuMCNone.Checked = False
+mnuMCStandard.Checked = False
+mnuMCALowest.Checked = False
+mnuMCAMedium.Checked = True
+mnuMCAHighest.Checked = False
+mnuMCAuto.Checked = False
+End Sub
+
+Private Sub mnuMCAuto_Click()
+mnuMCNone.Checked = False
+mnuMCStandard.Checked = False
+mnuMCALowest.Checked = False
+mnuMCAMedium.Checked = False
+mnuMCAHighest.Checked = False
+mnuMCAuto.Checked = True
+End Sub
+
+Private Sub mnuMCNone_Click()
+mnuMCNone.Checked = True
+mnuMCStandard.Checked = False
+mnuMCALowest.Checked = False
+mnuMCAMedium.Checked = False
+mnuMCAHighest.Checked = False
+mnuMCAuto.Checked = False
+End Sub
+
+Private Sub mnuMCompact_Click()
+Dim fNum As Long, Result As Long
+If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
+ Result = vbYes
+Else
+ Result = MsgBox("Uncompressed files with an 'X' in the attributes column and are not" + vbCrLf + "listed in (listfile) may be corrupted or deleted by the compacting process." + vbCrLf + "(Note: These files are fairly rare) Continue with compact?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
+End If
+If Result = vbYes Then
+ StatBar.Style = 1
+ StatBar.SimpleText = "Compacting " + CD.FileName + "..."
+ MousePointer = 11
+ Mpq.CompactMpq CD.FileName
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ StatBar.Style = 0
+ StatBar.SimpleText = ""
+ MousePointer = 0
+ OpenMpq
+End If
+End Sub
+Private Sub mnuMCStandard_Click()
+mnuMCNone.Checked = False
+mnuMCStandard.Checked = True
+mnuMCALowest.Checked = False
+mnuMCAMedium.Checked = False
+mnuMCAHighest.Checked = False
+End Sub
+Private Sub mnuMDelete_Click()
+Dim fNum As Long, Result As Long
+On Error GoTo NotSelected
+List.SelectedItem.Tag = List.SelectedItem.Tag
+On Error GoTo 0
+For fNum = 1 To List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ GoTo FileSelected
+ End If
+Next fNum
+GoTo NotSelected
+FileSelected:
+ If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
+ Result = vbYes
+ Else
+ Result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
+ End If
+ If Result = vbYes Then
+ fNum = 1
+ Do While fNum <= List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ StatBar.Style = 1
+ StatBar.SimpleText = "Deleting " + List.ListItems.Item(fNum).Tag + "..."
+ MousePointer = 11
+ Mpq.DelFile CD.FileName, List.ListItems.Item(fNum).Tag
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ List.ListItems.Remove (fNum)
+ fNum = fNum - 1
+ End If
+ fNum = fNum + 1
+ Loop
+ End If
+ StatBar.Style = 0
+ StatBar.SimpleText = ""
+ MousePointer = 0
+ ShowSelected
+ ShowTotal
+Exit Sub
+NotSelected:
+MsgBox "No files are selected.", , "WinMPQ"
+End Sub
+Private Sub mnuMExtract_Click()
+Dim fNum As Long, Path As String, Result As Long, hMPQ As Long
+On Error GoTo NotSelected
+List.SelectedItem.Tag = List.SelectedItem.Tag
+On Error GoTo 0
+For fNum = 1 To List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ GoTo FileSelected
+ End If
+Next fNum
+GoTo NotSelected
+FileSelected:
+Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
+If Path = "" Then Exit Sub
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+For fNum = 1 To List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ StatBar.Style = 1
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
+ MousePointer = 11
+ Mpq.sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ End If
+Next fNum
+Mpq.SFileCloseArchive hMPQ
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+Exit Sub
+NotSelected:
+If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
+ Result = vbYes
+Else
+ Result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
+End If
+If Result = vbYes Then
+ Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
+ If Path = "" Then Exit Sub
+ If Right(Path, 1) <> "\" Then Path = Path + "\"
+ If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+ For fNum = 1 To List.ListItems.Count
+ StatBar.Style = 1
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
+ MousePointer = 11
+ Mpq.sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ Next fNum
+ Mpq.SFileCloseArchive hMPQ
+ StatBar.Style = 0
+ StatBar.SimpleText = ""
+ MousePointer = 0
+End If
+End Sub
+Private Sub mnuFNew_Click()
+Dim TItem As Menu
+CD.Flags = &H1000 Or &H4 Or &H2
+CD.DefaultExt = "mpq"
+CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
+If ShowSave(CD) = False Then GoTo Cancel
+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
+Caption = "WinMPQ - " + CD.FileTitle
+AddRecentFile CD.FileName
+Cancel:
+End Sub
+Private Sub mnuFOpen_Click()
+Dim OldFileName As String
+CD.Flags = &H1000 Or &H4 Or &H2
+CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
+OldFileName = CD.FileName
+If ShowOpen(CD) = False Then GoTo Cancel
+OpenMpq
+If CD.FileName = "" Then CD.FileName = OldFileName
+Cancel:
+End Sub
+Private Sub mnuMRename_Click()
+List.StartLabelEdit
+End Sub
+Private Sub mnuMSaveList_Click()
+Dim fNum As Long, fList As String, OldFileName As String
+CD.Flags = &H1000 Or &H4 Or &H2
+CD.DefaultExt = "txt"
+CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"
+OldFileName = CD.FileName
+CD.FileName = CD.FileName + ".txt"
+If ShowSave(CD) = False Then GoTo Cancel
+StatBar.Style = 1
+StatBar.SimpleText = "Creating list..."
+MousePointer = 11
+For fNum = 1 To List.ListItems.Count
+ fList = fList + List.ListItems.Item(fNum).Tag + vbCrLf
+Next fNum
+fNum = FreeFile
+Open CD.FileName For Binary As #fNum
+Put #fNum, 1, fList
+Close #fNum
+Cancel:
+CD.FileName = OldFileName
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+End Sub
+Private Sub mnuOptions_Click()
+Options.Show 1
+End Sub
+Private Sub mnuPDelete_Click()
+mnuMDelete_Click
+End Sub
+Private Sub mnuPExtract_Click()
+mnuMExtract_Click
+End Sub
+Private Sub mnuPItem_Click(Index As Integer)
+Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+Path = Path + "Temp_extract\"
+If ExtractPathNum = -1 Then
+ fNum = 0
+ Do
+ If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
+ fNum = fNum + 1
+ Loop
+ ExtractPathNum = fNum
+End If
+Path = Path + CStr(ExtractPathNum) + "\"
+If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+For fNum = 1 To List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ StatBar.Style = 1
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
+ MousePointer = 11
+ Mpq.sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
+ For bNum = 1 To UBound(OpenFiles)
+ If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
+ AlreadyInList = True
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
+ Exit For
+ End If
+ Next bNum
+ If AlreadyInList = False Then
+ ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
+ OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
+ End If
+ End If
+ StatBar.Style = 1
+ StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
+ fName = List.ListItems.Item(fNum).Tag
+ ExecuteFile Path + fName, Index
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
+ End If
+Next fNum
+Mpq.SFileCloseArchive hMPQ
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+End Sub
+Private Sub mnuPRename_Click()
+mnuMRename_Click
+End Sub
+
+Private Sub mnuTAdd_Click()
+ToolList.Show 1
+BuildToolsList
+End Sub
+Private Sub mnuTItem_Click(Index As Integer)
+Dim Param As String, bNum As Long, FileName As String, Path As String, fNum As Long, AlreadyInList As Boolean, UseFile As Boolean, NewParam As String, FileNameList As String, hMPQ As Long
+Param = mnuTItem(Index).Tag
+On Error GoTo NoProgram
+If Param = "" Then Err.Raise 53
+On Error GoTo 0
+Do
+ If InStr(1, Param, "%mpq", 1) Then
+ bNum = InStr(1, Param, "%mpq", 1)
+ Param = Left(Param, bNum - 1) + CD.FileName + Mid(Param, bNum + 4)
+ End If
+Loop While InStr(1, Param, "%mpq", 1)
+NewParam = Param
+On Error GoTo NotSelected
+List.SelectedItem.Tag = List.SelectedItem.Tag
+On Error GoTo 0
+If List.SelectedItem.Selected Then FileName = List.SelectedItem.Tag
+NotSelected:
+If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0)) Then
+ Path = App.Path
+ If Right(Path, 1) <> "\" Then Path = Path + "\"
+ Path = Path + "Temp_extract\"
+ If ExtractPathNum = -1 Then
+ fNum = 0
+ Do
+ If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
+ fNum = fNum + 1
+ Loop
+ ExtractPathNum = fNum
+ End If
+ Path = Path + CStr(ExtractPathNum) + "\"
+ If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+ For fNum = 1 To List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ StatBar.Style = 1
+ StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
+ MousePointer = 11
+ Mpq.sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
+ For bNum = 1 To UBound(OpenFiles)
+ If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
+ AlreadyInList = True
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
+ Exit For
+ End If
+ Next bNum
+ If AlreadyInList = False Then
+ ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
+ OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
+ If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
+ End If
+ End If
+ StatBar.Style = 1
+ StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
+ FileName = FullPath(Path, List.ListItems.Item(fNum).Tag)
+ UseFile = True
+ Param = NewParam
+ Do
+ If InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0 Then
+ If FileName <> "" Then
+ Param = Param + " " + FileName
+ End If
+ ElseIf InStr(Param, Chr(34) + "%1" + Chr(34)) Then
+ bNum = InStr(Param, Chr(34) + "%1" + Chr(34))
+ If FileName <> "" Then
+ Param = Left(Param, bNum - 1) + Chr(34) + FileName + Chr(34) + Mid(Param, bNum + 4)
+ Else
+ Param = Left(Param, bNum - 1) + Mid(Param, bNum + 4)
+ End If
+ ElseIf InStr(Param, "%1") Then
+ bNum = InStr(Param, "%1")
+ If FileName <> "" Then
+ Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
+ Else
+ Param = Left(Param, bNum - 1) + Mid(Param, bNum + 2)
+ End If
+ End If
+ Loop While InStr(Param, "%1")
+ On Error GoTo NoProgram
+ Shell Param, 1
+ On Error GoTo 0
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
+ End If
+ Next fNum
+ Mpq.SFileCloseArchive hMPQ
+ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ On Error GoTo NoProgram
+ Shell Param, 1
+ On Error GoTo 0
+ Timer1.Enabled = True
+Else
+ MsgBox "No files are selected.", , "WinMPQ"
+End If
+If FileName <> "" Then
+ StatBar.Style = 0
+ StatBar.SimpleText = ""
+ MousePointer = 0
+End If
+Exit Sub
+NoProgram:
+If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
+End Sub
+Private Sub Timer1_Timer()
+Dim fNum As Long, Path As String, Result As Long, bNum As Long
+If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+Path = Path + "Temp_extract\"
+Path = Path + CStr(ExtractPathNum) + "\"
+For fNum = 1 To UBound(OpenFiles)
+ If FileExists(FullPath(Path, OpenFiles(fNum))) Then
+ If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then
+ If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
+ Result = vbYes
+ Else
+ Result = MsgBox("File " + OpenFiles(fNum) + " has been changed since it was extracted." + vbCrLf + vbCrLf + "Update archive with this file?", vbYesNo Or vbInformation, "WinMPQ")
+ End If
+ OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))
+ If Result = vbYes Then
+ List.Sorted = False
+ StatBar.Style = 1
+ StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."
+ MousePointer = 11
+ If mnuMCNone.Checked Then
+ Mpq.AddFile CD.FileName, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), 0
+ ElseIf mnuMCStandard.Checked Then
+ Mpq.AddFile CD.FileName, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), 1
+ ElseIf mnuMCAMedium.Checked Then
+ Mpq.AddWavFile CD.FileName, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), 0
+ ElseIf mnuMCAHighest.Checked Then
+ Mpq.AddWavFile CD.FileName, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), 1
+ ElseIf mnuMCALowest.Checked Then
+ Mpq.AddWavFile CD.FileName, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), 2
+ ElseIf mnuMCAuto.Checked Then
+ AddAutoFile CD.FileName, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)
+ End If
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ AddToListing OpenFiles(fNum)
+ StatBar.Style = 0
+ StatBar.SimpleText = ""
+ MousePointer = 0
+ List.Sorted = True
+ RemoveDuplicates
+ ShowTotal
+ End If
+ End If
+ Else
+ For bNum = fNum To UBound(OpenFiles) - 1
+ OpenFiles(bNum) = OpenFiles(bNum + 1)
+ OpenFileDates(bNum) = OpenFileDates(bNum + 1)
+ Next bNum
+ ReDim Preserve OpenFiles(UBound(OpenFiles) - 1) As String, OpenFileDates(UBound(OpenFileDates) - 1) As Date
+ fNum = fNum - 1
+ If UBound(OpenFiles) = 0 Then Timer1.Enabled = False
+ End If
+ If fNum >= UBound(OpenFiles) Then Exit For
+Next fNum
+If FileExists(CD.FileName) Then
+ If FileDateTime(CD.FileName) <> MpqDate And NewFile = False Then OpenMpq
+Else
+ OpenMpq
+End If
+End Sub
+Private Sub Toolbar_ButtonClick(ByVal Button As Button)
+Select Case Button.Key
+Case "New"
+ mnuFNew_Click
+Case "Open"
+ mnuFOpen_Click
+Case "Add"
+ mnuMAdd_Click
+Case "Add Folder"
+ mnuMAddFolder_Click
+Case "Extract"
+ mnuMExtract_Click
+Case "Compact"
+ mnuMCompact_Click
+Case "List"
+ If NewFile = False Then OpenMpq
+End Select
+End Sub
+Private Sub txtCommand_GotFocus()
+cmdGo.Default = True
+txtCommandHasFocus = True
+StatBar.Style = 1
+StatBar.SimpleText = "Current directory: " + Chr(34) + CurDir + Chr(34)
+End Sub
+Private Sub txtCommand_LostFocus()
+cmdGo.Default = False
+txtCommandHasFocus = False
+StatBar.Style = 0
+StatBar.SimpleText = ""
+End Sub
diff --git a/listing.frx b/listing.frx
diff --git a/minus.gif b/minus.gif
diff --git a/minusa.gif b/minusa.gif
diff --git a/minusg.gif b/minusg.gif
diff --git a/plus.gif b/plus.gif
diff --git a/plusa.gif b/plusa.gif
diff --git a/uparrow.gif b/uparrow.gif
diff --git a/uparrowa.gif b/uparrowa.gif
diff --git a/uparrowg.gif b/uparrowg.gif