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:
----
- Fixed a bug that prevented extracting empty files.
- Added an option that would allow one to have WinMPQ search a specified folder and all of its subfolders for file lists with names similar to the open archive.
- When you add a file, you are prompted for what path to add to the beginning of the filenames, and click cancel, WinMPQ no longer adds the files with no path added but instead it cancels adding the files.
1.61
----
- WinMPQ was not closing the archive handle properly after adding files that have been modified after being opened from WinMPQ. This was causing WinMPQ to be unable to open the archive to add files, extract files, etc. This bug has been fixed in this version.
- Fixed a bug that caused WinMPQ to be unable to update a file in the archive that has been modified.
- Mpq Embedder is now included with WinMPQ. Access it from the "Tools" menu.
- All options that were available by right-clicking a file are now also available from the "Mpq" menu.
- The "Tools" menu is now also shown on the right-click context menu shown when right-clicking on a file.
- The default compression type can be changed now, and the compression level for deflate compression can set.
- Added a menu command to add a file to the listing if it is not listed and you know the name of the file.
- Added a menu command to change the locale ID of an existing file.
1.60
----
- Switched to using SFmpq instead of Mpq Control.
- Added support for adding files with Warcraft III's new compression method.
- File encryption can now be enabled or disabled through the "Mpq" menu.
- Fixed a bug that prevented extracting empty files.
- Added an option that would allow one to have WinMPQ search a specified folder and all of its subfolders for file lists with names similar to the open archive.
- When you add a file, you are prompted for what path to add to the beginning of the filenames, and click cancel, WinMPQ no longer adds the files with no path added but instead it cancels adding the files.
1.61
----
- WinMPQ was not closing the archive handle properly after adding files that have been modified after being opened from WinMPQ. This was causing WinMPQ to be unable to open the archive to add files, extract files, etc. This bug has been fixed in this version.
- Fixed a bug that caused WinMPQ to be unable to update a file in the archive that has been modified.
- Mpq Embedder is now included with WinMPQ. Access it from the "Tools" menu.
- All options that were available by right-clicking a file are now also available from the "Mpq" menu.
- The "Tools" menu is now also shown on the right-click context menu shown when right-clicking on a file.
- The default compression type can be changed now, and the compression level for deflate compression can set.
- Added a menu command to add a file to the listing if it is not listed and you know the name of the file.
- Added a menu command to change the locale ID of an existing file.
1.60
----
- Switched to using SFmpq instead of Mpq Control.
- Added support for adding files with Warcraft III's new compression method.
- File encryption can now be enabled or disabled through the "Mpq" menu.
19 files changed:
| About.frm | patch | blob | blame | history | |
| ChLCID.frm | [new file with mode: 0644] | patch | blob |
| ChLCID.frx | [new file with mode: 0644] | patch | blob |
| EditTItem.frm | patch | blob | blame | history | |
| FileDialog.bas | patch | blob | blame | history | |
| FixIcon.bas | patch | blob | blame | history | |
| FoldName.frm | patch | blob | blame | history | |
| MpqStuff.bas | patch | blob | blame | history | |
| Options.frm | patch | blob | blame | history | |
| Options.frx | patch | blob | blame | history | |
| SFmpqapi.bas | [new file with mode: 0644] | patch | blob |
| WINMPQ.VBP | patch | blob | blame | history | |
| WMpqEmbed.rtf | [new file with mode: 0644] | patch | blob |
| WinMPQ.rtf | patch | blob | blame | history | |
| frmAddToList.frm | [new file with mode: 0644] | patch | blob |
| frmAddToList.frx | [new file with mode: 0644] | patch | blob |
| frmMpq.frm | [new file with mode: 0644] | patch | blob |
| frmMpq.frx | [new file with mode: 0644] | patch | blob |
| listing.frm | patch | blob | blame | history |
diff --git a/About.frm b/About.frm
--- a/About.frm
+++ b/About.frm
VERSION 4.00
Begin VB.Form About
BorderStyle = 3 'Fixed Dialog
- Caption = "About WinMPQ"
- ClientHeight = 1305
+ Caption = "About"
+ ClientHeight = 1575
ClientLeft = 1890
ClientTop = 2265
ClientWidth = 5820
- Height = 1710
+ Height = 1980
Icon = "About.frx":0000
Left = 1830
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
- ScaleHeight = 1305
+ ScaleHeight = 1575
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
Top = 120
Width = 735
End
+ Begin VB.Label Label5
+ BackStyle = 0 'Transparent
+ Caption = "This program uses "
+ Height = 255
+ Left = 120
+ TabIndex = 5
+ Top = 1320
+ Width = 5535
+ End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
ForeColor = &H00FF0000&
Height = 210
Left = 120
- TabIndex = 5
+ TabIndex = 4
Top = 1080
Width = 2280
End
End
Begin VB.Label Label2
AutoSize = -1 'True
- Caption = "Copyright © ShadowFlare Software 2001-2002"
+ Caption = "Copyright © ShadowFlare Software"
Height = 195
Left = 120
TabIndex = 1
Top = 360
- Width = 3300
+ Width = 2490
End
Begin VB.Label Label1
AutoSize = -1 'True
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)
+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
+Label5.Font.underline = False
End Sub
Private Sub Form_Load()
+Dim SFmpqString As String
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
+Caption = "About " + App.Title
+Label1 = App.Title + " v"
Label1 = Label1 + GetAppVersionString
+Label2 = App.LegalCopyright
+SFmpqString = String(SFMpqGetVersionString2(NullPtr, 0) - 1, Chr(0))
+SFMpqGetVersionString2 SFmpqString, SFMpqGetVersionString2(NullPtr, 0)
+Label5 = Label5 + SFmpqString
End Sub
-Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+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
+Label5.Font.underline = False
End Sub
-Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+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
+Label5.Font.underline = False
End Sub
-Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+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
+Label5.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)
+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)
+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
+Label5.Font.underline = False
End Sub
-Private Sub Label3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
+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)
+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)
+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
+Label5.Font.underline = False
End Sub
-
-Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
+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
+Private Sub Label5_Click()
+AboutSFMpq
+End Sub
+Private Sub Label5_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
+Label5.Font.underline = True
+End Sub
+Private Sub Label5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
+Label5.Font.underline = False
+End Sub
diff --git a/ChLCID.frm b/ChLCID.frm
--- /dev/null
+++ b/ChLCID.frm
@@ -0,0 +1,87 @@
+VERSION 4.00
+Begin VB.Form ChLCID
+ BorderStyle = 3 'Fixed Dialog
+ Caption = "Changing Locale ID..."
+ ClientHeight = 1335
+ ClientLeft = 2670
+ ClientTop = 3180
+ ClientWidth = 3615
+ Height = 1740
+ Icon = "ChLCID.frx":0000
+ Left = 2610
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 1335
+ ScaleWidth = 3615
+ ShowInTaskbar = 0 'False
+ Top = 2835
+ Width = 3735
+ Begin VB.CommandButton Command2
+ Cancel = -1 'True
+ Caption = "&Cancel"
+ Height = 375
+ Left = 1920
+ TabIndex = 3
+ Top = 840
+ Width = 1335
+ End
+ Begin VB.CommandButton Command1
+ Caption = "O&K"
+ Default = -1 'True
+ Height = 375
+ Left = 360
+ TabIndex = 2
+ Top = 840
+ Width = 1335
+ End
+ Begin VB.TextBox Text1
+ Height = 285
+ Left = 120
+ TabIndex = 1
+ Text = "0"
+ Top = 480
+ Width = 1215
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "Type in the new locale ID for the file(s) below."
+ Height = 195
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ Width = 3225
+ End
+End
+Attribute VB_Name = "ChLCID"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+Private Sub Command1_Click()
+MpqEx.ChangeLCID Text1
+Unload Me
+End Sub
+Private Sub Command2_Click()
+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
+End Sub
+Private Sub Text1_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(Text1 + Chr(KeyAscii))
+On Error GoTo 0
+Exit Sub
+TooBig:
+KeyAscii = 0
+End Sub
+Private Sub Text1_LostFocus()
+If Text1 = "" Then Text1 = 0
+End Sub
diff --git a/ChLCID.frx b/ChLCID.frx
diff --git a/EditTItem.frm b/EditTItem.frm
--- a/EditTItem.frm
+++ b/EditTItem.frm
ChDir Left(App.Path, 2) + "\"
End If
CD.FileName = ""
+CD.hwndOwner = hWnd
If ShowOpen(CD) = False Then GoTo Cancel
txtCommand = Chr(34) + CD.FileName + Chr(34)
Cancel:
diff --git a/FileDialog.bas b/FileDialog.bas
--- a/FileDialog.bas
+++ b/FileDialog.bas
Next cNum
End Sub
Sub StripNull(ByRef TextStr As String)
+Dim cNum As Long
+cNum = InStr(1, TextStr, Chr$(0))
+If cNum Then
+ TextStr = Left(TextStr, cNum - 1)
+End If
+End Sub
+Sub StripNullMulti(ByRef TextStr As String)
Dim cNum As Long, cNum2 As Long
For cNum = 1 To Len(TextStr)
cNum2 = InStr(cNum, TextStr, 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
+If lpFileDialog.Flags And (OFN_ALLOWMULTISELECT Or OFN_EXPLORER) Then
+ StripNullMulti lpFileDialog.FileName
+ StripNullMulti lpFileDialog.FileTitle
+Else
+ StripNull lpFileDialog.FileName
+ StripNull lpFileDialog.FileTitle
+End If
End Function
Function ShowSave(ByRef lpFileDialog As OPENFILENAME) As Boolean
lpFileDialog.lStructSize = Len(lpFileDialog)
diff --git a/FixIcon.bas b/FixIcon.bas
--- a/FixIcon.bas
+++ b/FixIcon.bas
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
+SendMessageA hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon
End Sub
diff --git a/FoldName.frm b/FoldName.frm
--- a/FoldName.frm
+++ b/FoldName.frm
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 = ""
+AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128)
Unload Me
End Sub
Private Sub Form_Load()
diff --git a/MpqStuff.bas b/MpqStuff.bas
--- a/MpqStuff.bas
+++ b/MpqStuff.bas
ByVal dwItem1 As Any, _
ByVal dwItem2 As Any)
Public Declare Function SendMessageA Lib _
- "user32.dll" _
+ "User32.dll" _
(ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal Wp As Long, _
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 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, GlobalEncrypt As Boolean, DefaultCompress As Long, DefaultCompressID As Long, DefaultCompressLevel As Long, DefaultMaxFiles 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 WM_SETREDRAW As Long = &HB
Public Const WM_PAINT As Long = &HF
Const gintMAX_SIZE% = 255
+Sub AboutSFMpq()
+Dim AboutPage As String, Path As String
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+AboutPage = Path + "sfmpq.dll"
+If Not FileExists(AboutPage) Then AboutPage = "sfmpq.dll"
+ShellExecute 0, vbNullString, "res://" + AboutPage + "/about", vbNullString, vbNullString, 1
+End Sub
+Function mOpenMpq(FileName As String) As Long
+Dim hMPQ As Long
+mOpenMpq = 0
+hMPQ = MpqOpenArchiveForUpdate(FileName, MOAU_OPEN_EXISTING Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles)
+If hMPQ = 0 Or hMPQ = INVALID_HANDLE_VALUE Then
+ hMPQ = MpqOpenArchiveForUpdate(FileName, MOAU_CREATE_NEW Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles)
+End If
+If hMPQ <> 0 And hMPQ <> INVALID_HANDLE_VALUE Then
+ mOpenMpq = hMPQ
+End If
+End Function
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)
+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
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
Exit For
End If
Next bNum
+ GetFileTitle = Mid(FileName, bNum)
+Else
+ GetFileTitle = FileName
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
+Function sGetFile(hMPQ As Long, ByVal FileName As String, OutPath As String, ByVal UseFullPath As Long)
+Dim hFile As Long, buffer() As Byte, fLen As Long, cNum As Long
+If SFileOpenFileEx(hMPQ, FileName, 0, hFile) Then
+ fLen = SFileGetFileSize(hFile, 0)
+ If fLen > 0 Then
+ ReDim buffer(fLen - 1)
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
+ ReDim buffer(0)
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
+ SFileReadFile hFile, buffer(0), fLen, ByVal 0, ByVal 0
+ SFileCloseFile hFile
+ If UseFullPath = 0 Then FileName = GetFileTitle(FileName)
+ FileName = FullPath(OutPath, FileName)
+ On Error Resume Next
+ For cNum = 1 To Len(FileName)
+ cNum = InStr(cNum, FileName, "\")
+ If cNum > 0 Then
+ MkDir Left(FileName, cNum)
+ Else
+ Exit For
End If
Next cNum
- If Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2)
- ListFiles = MpqEx.Mpq.ListFiles(MpqName, NewFileLists)
+ If FileExists(FileName) Then Kill FileName
+ On Error GoTo 0
+ cNum = FreeFile
+ On Error GoTo WriteError
+ Open FileName For Binary As #cNum
+ If fLen > 0 Then Put #cNum, 1, buffer
+ Close #cNum
+ On Error GoTo 0
End If
+Exit Function
+WriteError:
+MsgBox "Error writing file. File may be in use.", vbCritical, "WinMPQ"
+Resume Next
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
+Function sListFiles(MpqName As String, hMPQ As Long, ByVal FileLists As String, ByRef ListedFiles() As FILELISTENTRY) As Boolean
+Dim NewFileLists As String, nFileLists() As String, ListName As String, cNum As Long, cNum2 As Long, cNum3 As Long, cNum4 As Long, MpqList1 As String, MpqList2 As String, Path As String, ListLen As Long, OldLists() As String, UseOnlyAutoList As Boolean, nHash As Long, nHashEntries As Long
+sListFiles = False
+ReDim ListedFiles(0)
+ListedFiles(0).dwFileExists = 0
If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then
- sListFiles = MpqEx.Mpq.sListFiles(hMPQ, FileLists)
+ NewFileLists = FileLists
Else
UseOnlyAutoList = GetReg(AppKey + "UseOnlyAutofindLists", 1)
MpqList2 = GetExtension(MpqName)
If FileLists <> "" Then
FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
Else
- FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
+ FileLists = Path + App.EXEName + ".exe" + vbCrLf + MpqName
End If
ReDim nFileLists(0) As String
If UseOnlyAutoList Then ReDim OldLists(0) As String
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)
+ If cNum2 - cNum > 0 Then
+ ListName = Mid(FileLists, cNum, cNum2 - cNum)
+ If Not IsDir(ListName) Then
+ If UseOnlyAutoList And cNum < ListLen Then
+ ReDim Preserve OldLists(UBound(OldLists) + 1) As String
+ OldLists(UBound(OldLists)) = GetLongPath(ListName)
End If
- If FileExists(Left(ListName, cNum3) + MpqList2) Then
+ 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(Left(ListName, cNum3) + MpqList2)
+ nFileLists(UBound(nFileLists)) = GetLongPath(ListName)
End If
Else
- Exit For
+ ListName = DirEx(ListName, MpqList1, 6, True) _
+ + DirEx(ListName, MpqList2, 6, True)
+ For cNum3 = 1 To Len(ListName)
+ cNum4 = InStr(cNum3, ListName, vbCrLf)
+ If cNum4 = 0 Then
+ cNum4 = Len(ListName) + 1
+ End If
+ If cNum4 - cNum3 > 0 Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(Mid(ListName, cNum3, cNum4 - cNum3))
+ End If
+ cNum3 = cNum4 + 1
+ Next cNum3
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
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
+ If nFileLists(cNum) <> "" Then
+ For cNum2 = 1 To UBound(nFileLists)
+ If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then
+ nFileLists(cNum2) = ""
End If
Next cNum2
End If
+ If UseOnlyAutoList Then
+ If nFileLists(cNum) <> "" Then
+ For cNum2 = 1 To UBound(OldLists)
+ If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList1) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList2) Then
+ nFileLists(cNum) = ""
+ Exit For
+ End If
+ Next cNum2
+ End If
+ 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
+nHashEntries = SFileGetFileInfo(hMPQ, SFILE_INFO_HASH_TABLE_SIZE)
+If nHashEntries - 1 < 1 Then Exit Function
+ReDim ListedFiles(nHashEntries - 1)
+sListFiles = SFileListFiles(hMPQ, NewFileLists, ListedFiles(0), 0)
End Function
Sub mAddAutoFile(hMPQ As Long, File As String, MpqPath As String)
-Dim cType As Integer, bNum As Long, fExt As String
+Dim cType As Integer, bNum As Long, fExt As String, dwFlags As Long
+dwFlags = MAFA_REPLACE_EXISTING
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
For bNum = 1 To Len(File)
If InStr(bNum, File, ".") > 0 Then
bNum = InStr(bNum, File, ".")
End If
If LCase(fExt) = ".bik" Then
cType = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
ElseIf LCase(fExt) = ".smk" Then
cType = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
+ElseIf LCase(fExt) = ".mp3" Then
+ cType = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
+ElseIf LCase(fExt) = ".mpq" Then
+ cType = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
+ElseIf LCase(fExt) = ".w3m" Then
+ cType = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
ElseIf LCase(fExt) = ".wav" Then
cType = CInt(GetReg(AppKey + "Compression\.wav", "0"))
Else
- cType = CInt(GetReg(AppKey + "Compression\" + fExt, "-1"))
+ cType = CInt(GetReg(AppKey + "Compression\" + fExt, CStr(DefaultCompressID)))
End If
Select Case cType
Case -2
-MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 0
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags, 0, 0
Case -1
-MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 1
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
+Case -3
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
Case 0, 1, 2
-MpqEx.Mpq.mAddWavFile hMPQ, File, MpqPath, cType
+MpqAddWaveToArchive hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, cType
Case Else
-MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 1
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel
End Select
End Sub
Function DirEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean) As String
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
+If FindMpqHeader(MpqFile) <> -1 Then
+ IsMPQ = True
+Else
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
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
+Dim Files() As FILELISTENTRY, fNum As Long, szFileList As String, NamePos As Long, CurFileName As String
+Dim hMPQ As Long
+If SFileOpenArchive(MpqFile, 0, 0, hMPQ) Then
+ If sListFiles(MpqFile, hMPQ, ListFile, Files) Then
+ SFileCloseArchive hMPQ
+ For fNum = 0 To UBound(Files)
+ If Files(fNum).dwFileExists Then
+ CurFileName = StrConv(Files(fNum).szFileName, vbUnicode)
+ If MatchesFilter(CurFileName, Filters) Then
+ NamePos = InStr(1, szFileList, CurFileName + vbCrLf, 1)
+ If NamePos > 1 Then
+ NamePos = InStr(1, szFileList, vbCrLf + CurFileName + vbCrLf, 1)
+ End If
+ If NamePos > 0 Then _
+ szFileList = szFileList + CurFileName
+ End If
+ End If
+ Next fNum
+ MpqDir = MpqDir + CurFileName + vbCrLf
Else
- Files = Left(Files, bNum - 1) + Mid(Files, EndLine + 2)
+ SFileCloseArchive hMPQ
End If
-Loop
-MpqDir = Files
+End If
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
+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, hFile As Long, dwFlags
If FileExists(ScriptName) = False Then
ScriptOut.Show
AddScriptOutput "Could not find script " + ScriptName + vbCrLf
If Right(Script, 2) <> vbCrLf Then Script = Script + vbCrLf
ScriptOut.Show
AddScriptOutput "Script: " + ScriptName + vbCrLf + vbCrLf
-OldDefaultMaxFiles = MpqEx.Mpq.DefaultMaxFiles
+OldDefaultMaxFiles = DefaultMaxFiles
lNum = 1
For bNum = 1 To Len(Script)
EndLine = InStr(bNum, Script, vbCrLf)
If Param(2) <> "" Then
MpqFile = Param(2)
If Param(3) <> "" And FileExists(MpqFile) = False Then
- MpqEx.Mpq.DefaultMaxFiles = Param(3)
+ DefaultMaxFiles = Param(3)
End If
If FileExists(MpqFile) Then
AddScriptOutput "Opened " + MpqFile + vbCrLf
If Param(2) <> "" Then
MpqFile = Param(2)
If Param(3) <> "" Then
- MpqEx.Mpq.DefaultMaxFiles = Param(3)
+ DefaultMaxFiles = Param(3)
End If
ScriptNewFile = True
AddScriptOutput "Created new " + MpqFile + vbCrLf
Files = ""
fEndLine = 0
fLine = ""
+ dwFlags = MAFA_REPLACE_EXISTING
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
For pNum = 3 To UBound(Param)
If LCase(Param(pNum)) = "/wav" Then
cType = 2
+ dwFlags = dwFlags Or MAFA_COMPRESS
ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
cType = 1
+ dwFlags = dwFlags Or MAFA_COMPRESS
ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then
cType = -1
ElseIf LCase(Param(pNum)) = "/r" Then
ScriptNewFile = False
End If
Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
- hMPQ = MpqEx.Mpq.mOpenMpq(FullPath(NewPath, MpqFile))
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ = 0 Then
AddScriptOutput "Can't create archive " + MpqFile + vbCrLf
GoTo CommandError
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
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
ElseIf cType = -1 Then
mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
ElseIf cType = 1 Then
- MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 1
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
Else
- MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 0
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
End If
Else
If cType = 2 Then
- MpqEx.Mpq.mAddWavFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 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
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
Else
- MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
End If
End If
AddScriptOutput " Done" + vbCrLf
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
- MpqEx.Mpq.mCloseMpq hMPQ
+ MpqCloseUpdatedArchive hMPQ, 0
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " added" + vbCrLf
End If
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
+ If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf
GoTo CommandError
End If
AddScriptOutput "Line " + CStr(lNum) + ": "
End If
AddScriptOutput "Extracting " + fLine + "..."
- MpqEx.Mpq.sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
+ sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
AddScriptOutput " Done" + vbCrLf
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
- MpqEx.Mpq.SFileCloseArchive hMPQ
+ 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
+ If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
+ AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf
+ GoTo CommandError
+ End If
+ sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
+ SFileCloseArchive hMPQ
AddScriptOutput " Done" + vbCrLf
End If
Else
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
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ 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 SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, fLine2
+ MpqRenameFile hMPQ, fLine, fLine2
+ Else
+ MpqRenameFile hMPQ, fLine, fLine2
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " renamed" + vbCrLf
End If
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)
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, Param(3)
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ Else
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ End If
+ MpqCloseUpdatedArchive hMPQ, 0
End If
AddScriptOutput " Done" + vbCrLf
End If
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
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ 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 SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, fLine2
+ MpqRenameFile hMPQ, fLine, fLine2
+ Else
+ MpqRenameFile hMPQ, fLine, fLine2
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
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)
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, Param(3)
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ Else
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ End If
+ MpqCloseUpdatedArchive hMPQ, 0
End If
AddScriptOutput " Done" + vbCrLf
End If
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
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ 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 + "..."
+ MpqDeleteFile hMPQ, fLine
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
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)
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ MpqDeleteFile hMPQ, Param(2)
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
AddScriptOutput " Done" + vbCrLf
End If
Else
Case "f", "flush", "compact"
If MpqFile <> "" Then
AddScriptOutput "Flushing " + MpqFile + "..."
- MpqEx.Mpq.CompactMpq FullPath(NewPath, MpqFile)
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ MpqCompactArchive hMPQ
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
AddScriptOutput " Done" + vbCrLf
Else
AddScriptOutput "No archive open" + vbCrLf
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
Param(2) = Param(3)
Else
- Files = ListFiles(FullPath(NewPath, MpqFile), ListFile)
+ Files = MpqDir(FullPath(NewPath, MpqFile), "*")
End If
fNum = FreeFile
Open FullPath(CurPath, Param(2)) For Binary As #fNum
lNum = lNum + 1
bNum = EndLine + 1
Next bNum
-MpqEx.Mpq.DefaultMaxFiles = OldDefaultMaxFiles
+DefaultMaxFiles = OldDefaultMaxFiles
If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
ChDir OldPath
End Sub
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
+ If FileExists(MpqFile) = False Then
+ FindMpqHeader = -1
+ Exit Function
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
+ Dim hFile
+ hFile = FreeFile
+ Open MpqFile For Binary As #hFile
+ Dim FileLen As Long
+ FileLen = LOF(hFile)
+ Dim pbuf As String
+ pbuf = String(32, Chr(0))
+ Dim i As Long
+ For i = 0 To FileLen - 1 Step 512
+ Get #hFile, 1 + i, pbuf
+ If Left(pbuf, 4) = "MPQ" + Chr(26) Or Left(pbuf, 4) = "BN3" + Chr(26) Then
+ ' Storm no longer does this, so this shouldn't either
+ 'FileLen = FileLen - i
+ 'If JBytes(pbuf, 9, 4) = FileLen
+ ' FileMpqHeader = i
+ ' Close #hFile
+ ' Exit Function
+ 'Else
+ ' FileLen = FileLen + i
+ 'End If
+ FindMpqHeader = i
+ Close #hFile
+ Exit Function
End If
- End If
-Next bNum
-Close #fNum
-FindMpqHeader = bNum + MpqHead - 2
-If MpqHead = 0 Then FindMpqHeader = -1
+ Next i
+ FindMpqHeader = -1
+ Close #hFile
End Function
Function JBytes(Text As String, Start As Long, Length As Long)
Dim buffer() As Byte, NumData As Currency
diff --git a/Options.frm b/Options.frm
--- a/Options.frm
+++ b/Options.frm
Left = 240
ScaleHeight = 3495
ScaleWidth = 4995
- TabIndex = 3
+ TabIndex = 34
+ TabStop = 0 'False
Top = 480
Width = 4995
Begin VB.TextBox Text1
Height = 285
Left = 0
MaxLength = 6
- TabIndex = 9
+ TabIndex = 3
Text = "1024"
Top = 600
Width = 1215
Begin VB.TextBox Text2
Height = 285
Left = 0
- TabIndex = 8
+ TabIndex = 4
Text = "0"
Top = 1200
Width = 1215
Caption = "&Associate WinMPQ with MPQ Archives"
Height = 255
Left = 0
- TabIndex = 7
+ TabIndex = 5
Top = 1680
Value = 2 'Grayed
Width = 3375
Caption = "Use &wildcards in filenames for drag and drop"
Height = 255
Left = 0
- TabIndex = 6
+ TabIndex = 7
Top = 2400
Value = 2 'Grayed
Width = 3735
Caption = "Automatically update &modified files"
Height = 255
Left = 0
- TabIndex = 5
+ TabIndex = 6
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
+ TabIndex = 37
Top = 120
Width = 4335
WordWrap = -1 'True
End
Begin VB.Label Label2
AutoSize = -1 'True
- Caption = "Locale ID for extracting"
+ Caption = "Locale ID for adding files"
Height = 195
Left = 0
- TabIndex = 11
+ TabIndex = 36
Top = 960
- Width = 1650
+ Width = 1755
End
Begin VB.Label Label3
Caption = $"Options.frx":000C
Height = 855
Left = 0
- TabIndex = 10
+ TabIndex = 35
Top = 2640
Width = 4935
End
Left = 240
ScaleHeight = 3495
ScaleWidth = 4935
- TabIndex = 23
+ TabIndex = 40
+ TabStop = 0 'False
Top = 480
Visible = 0 'False
Width = 4935
+ Begin VB.CommandButton cmdAddFolder
+ Caption = "Add &Folder..."
+ Height = 375
+ Left = 3480
+ TabIndex = 10
+ Top = 1320
+ Width = 1335
+ End
Begin VB.CheckBox Check8
Caption = "Do not use above lists when one is found by above option"
Height = 375
Left = 0
- TabIndex = 49
+ TabIndex = 13
Top = 2880
Value = 2 'Grayed
Width = 3375
Caption = "Use file lists for similarly named archives"
Height = 195
Left = 0
- TabIndex = 48
+ TabIndex = 12
Top = 2640
Width = 3375
End
Caption = "&Remove"
Height = 375
Left = 3480
- TabIndex = 45
- Top = 1440
+ TabIndex = 11
+ Top = 1920
Width = 1335
End
Begin VB.ListBox FileLists
Height = 2205
Left = 0
- TabIndex = 44
+ TabIndex = 8
Top = 360
Width = 3375
End
Caption = "&Add List File..."
Height = 375
Left = 3480
- TabIndex = 24
- Top = 840
+ TabIndex = 9
+ Top = 720
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
+ TabIndex = 51
Top = 3240
Width = 4815
End
Caption = "File Lists:"
Height = 195
Left = 0
- TabIndex = 46
+ TabIndex = 50
Top = 120
Width = 645
End
Left = 240
ScaleHeight = 3495
ScaleWidth = 4935
- TabIndex = 13
+ TabIndex = 38
+ TabStop = 0 'False
Top = 480
Visible = 0 'False
Width = 4935
Caption = "&Reset size/position"
Height = 375
Left = 360
- TabIndex = 22
+ TabIndex = 16
Top = 840
Width = 1695
End
Caption = "Display &confirmation boxes"
Height = 255
Left = 0
- TabIndex = 21
+ TabIndex = 14
Top = 120
Value = 2 'Grayed
Width = 2415
Caption = "&Save last window size and position"
Height = 255
Left = 0
- TabIndex = 20
+ TabIndex = 15
Top = 480
Value = 2 'Grayed
Width = 3015
Caption = "Startup Path"
Height = 1215
Left = 0
- TabIndex = 14
+ TabIndex = 39
Top = 2280
Width = 4935
Begin VB.OptionButton Option1
Height = 255
Index = 0
Left = 120
- TabIndex = 19
+ TabIndex = 17
Top = 240
Value = -1 'True
Width = 1575
Height = 255
Index = 2
Left = 120
- TabIndex = 17
+ TabIndex = 19
Top = 480
Width = 1695
End
Enabled = 0 'False
Height = 285
Left = 120
- TabIndex = 16
+ TabIndex = 20
Top = 840
Width = 3615
End
Enabled = 0 'False
Height = 285
Left = 3840
- TabIndex = 15
+ TabIndex = 21
Top = 840
Width = 975
End
Left = 240
ScaleHeight = 3495
ScaleWidth = 4935
- TabIndex = 26
+ TabIndex = 42
+ TabStop = 0 'False
Top = 480
Visible = 0 'False
Width = 4935
Height = 1215
IntegralHeight = 0 'False
Left = 3120
- TabIndex = 38
+ TabIndex = 23
Top = 2280
Width = 1815
End
Begin MSComctlLib.ListView FileTypes
Height = 2535
Left = 0
- TabIndex = 43
+ TabIndex = 22
Top = 960
Width = 3015
_ExtentX = 5318
Caption = "File extensions:"
Height = 195
Left = 3120
- TabIndex = 42
+ TabIndex = 49
Top = 960
Width = 1080
End
Caption = "Default action:"
Height = 195
Left = 3120
- TabIndex = 40
+ TabIndex = 47
Top = 2040
Width = 1035
End
Begin VB.Label Label8
Height = 855
Left = 3120
- TabIndex = 41
+ TabIndex = 48
Top = 1200
Width = 1755
End
Caption = $"Options.frx":00F6
Height = 855
Left = 0
- TabIndex = 39
+ TabIndex = 46
Top = 120
Width = 4935
WordWrap = -1 'True
Left = 240
ScaleHeight = 3495
ScaleWidth = 4935
- TabIndex = 25
+ TabIndex = 41
+ TabStop = 0 'False
Top = 480
Visible = 0 'False
Width = 4935
+ Begin VB.ComboBox Combo3
+ Height = 315
+ ItemData = "Options.frx":01CE
+ Left = 2880
+ List = "Options.frx":01F3
+ Style = 2 'Dropdown List
+ TabIndex = 33
+ Top = 3120
+ Width = 1815
+ End
+ Begin VB.ComboBox Combo2
+ Height = 315
+ ItemData = "Options.frx":0245
+ Left = 1200
+ List = "Options.frx":024F
+ Style = 2 'Dropdown List
+ TabIndex = 32
+ Top = 3120
+ Width = 1455
+ End
Begin VB.ListBox List1
Height = 1815
- ItemData = "Options.frx":01CE
+ ItemData = "Options.frx":0266
Left = 0
- List = "Options.frx":01D0
+ List = "Options.frx":0268
Sorted = -1 'True
- TabIndex = 35
+ TabIndex = 26
Top = 720
Width = 1575
End
Begin VB.TextBox Text4
Height = 285
Left = 0
- TabIndex = 34
+ TabIndex = 24
Top = 360
Width = 855
End
Caption = "&Add"
Height = 285
Left = 960
- TabIndex = 33
+ TabIndex = 25
Top = 360
Width = 615
End
Caption = "&Remove"
Height = 255
Left = 0
- TabIndex = 32
+ TabIndex = 27
Top = 2640
Width = 1095
End
Begin VB.ComboBox Combo1
Enabled = 0 'False
Height = 315
- ItemData = "Options.frx":01D2
+ ItemData = "Options.frx":026A
Left = 1800
- List = "Options.frx":01DF
+ List = "Options.frx":027A
Style = 2 'Dropdown List
- TabIndex = 31
+ TabIndex = 28
Top = 720
Width = 2535
End
Caption = "Audio Compression"
Height = 1335
Left = 1800
- TabIndex = 27
+ TabIndex = 43
Top = 1200
Visible = 0 'False
Width = 2535
Height = 255
Index = 1
Left = 120
- TabIndex = 29
+ TabIndex = 31
Top = 960
Width = 2175
End
Height = 255
Index = 2
Left = 120
- TabIndex = 28
+ TabIndex = 29
Top = 240
Width = 2175
End
End
+ Begin VB.Label ZLibLabel
+ AutoSize = -1 'True
+ Caption = "Deflate Compression Level"
+ Height = 195
+ Left = 2880
+ TabIndex = 53
+ Top = 2880
+ Width = 1890
+ End
+ Begin VB.Label Label12
+ AutoSize = -1 'True
+ Caption = "Default Compression"
+ Height = 195
+ Left = 1200
+ TabIndex = 52
+ Top = 2880
+ Width = 1455
+ End
Begin VB.Label Label5
Caption = "Compression type"
Height = 255
Left = 1800
- TabIndex = 37
+ TabIndex = 45
Top = 480
Width = 1935
End
Caption = "File Extension"
Height = 255
Left = 0
- TabIndex = 36
+ TabIndex = 44
Top = 120
Width = 1215
End
If Check8.Value = 1 Then Check8.Value = 2
End Sub
Private Sub cmdAdd_Click()
-Dim eNum As Integer
+Dim xNum 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
+ For xNum = 1 To UBound(NewExtNames)
+ If Text4 = NewExtNames(xNum) Then Exit Sub
+ Next xNum
List1.AddItem Text4
ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
NewExtNames(UBound(NewExtNames)) = Text4
Text4 = ""
End If
End Sub
+
+Private Sub cmdAddFolder_Click()
+Dim lNum As Long
+Dim Path As String
+PathInput.hwndOwner = hWnd
+Path = PathInputBox(PathInput, "Add Listfile Folder", "")
+If Path = "" Then GoTo Cancel
+FileLists.AddItem Path
+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 cmdAddList_Click()
Dim lNum As Long
CD.Flags = &H1000 Or &H4 Or &H2
CD.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
+CD.hwndOwner = hWnd
If ShowOpen(CD) = False Then GoTo Cancel
FileLists.AddItem CD.FileName
If FileLists.ListCount > 0 Then
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
+Dim xNum As Integer
+For xNum = 1 To UBound(NewExtNames)
+ If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
+Next xNum
+If UBound(NewExtNames) = 0 Then xNum = 0
+If Combo1.ListIndex = 3 Then
Frame2.Visible = True
- NewExtComp(eNum) = Combo1.ListIndex - 2
+ NewExtComp(xNum) = Combo1.ListIndex - 3
Else
Frame2.Visible = False
- NewExtComp(eNum) = Combo1.ListIndex - 2
+ If Combo1.ListIndex < 2 Then
+ NewExtComp(xNum) = Combo1.ListIndex - 2
+ Else
+ NewExtComp(xNum) = -3
+ End If
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
+Dim xNum As Integer
+For xNum = 1 To UBound(NewExtNames)
+ If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
+Next xNum
+If UBound(NewExtNames) = 0 Then xNum = 0
+NewExtComp(xNum) = Index
End Sub
Private Sub Check1_Click()
If Check1.Value = 1 Then Check1.Value = 2
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 xNum 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
+DefaultMaxFiles = Text1
LocaleID = Text2
-MpqEx.Mpq.SetLocale (LocaleID)
+SFileSetLocale (LocaleID)
NewKey AppKey
SetReg AppKey + "DefaultMaxFiles", Text1, REG_DWORD
SetReg AppKey + "LocaleID", Text2, REG_DWORD
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 + "StartupPath", Text3
ChDir Text3
End If
+Select Case Combo2.ListIndex
+Case 0
+DefaultCompressID = -1
+DefaultCompress = MAFA_COMPRESS_STANDARD
+Case 1
+DefaultCompressID = -3
+DefaultCompress = MAFA_COMPRESS_DEFLATE
+End Select
+DefaultCompressLevel = Combo3.ListIndex - 1
+SetReg AppKey + "DefaultCompress", DefaultCompressID, REG_DWORD
+SetReg AppKey + "DefaultZlibLevel", DefaultCompressLevel, REG_DWORD
DelKey AppKey + "Compression\"
NewKey AppKey + "Compression\"
-For eNum = 1 To UBound(NewExtNames)
- ExtList = ExtList + NewExtNames(eNum)
- SetReg AppKey + "Compression\" + NewExtNames(eNum), CStr(NewExtComp(eNum))
-Next eNum
+For xNum = 1 To UBound(NewExtNames)
+ ExtList = ExtList + NewExtNames(xNum)
+ SetReg AppKey + "Compression\" + NewExtNames(xNum), CStr(NewExtComp(xNum))
+Next xNum
SetReg AppKey + "Compression\List", ExtList
NewKey SharedAppKey + "FileDefaultActions\"
For aNum = 1 To FileTypes.ListItems.Count
DelReg AppKey + "Status\WindowWidth"
Check1.Value = 0
End Sub
-
Private Sub Command5_Click()
Dim Path As String
+PathInput.hwndOwner = hWnd
Path = PathInputBox(PathInput, "WinMPQ Startup Path", Text3)
If Path <> "" Then Text3 = Path
End Sub
-
Private Sub Command6_Click()
-Dim eNum As Integer
+Dim xNum 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
+ For xNum = 1 To UBound(NewExtNames)
+ If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
+ Next xNum
+ If xNum < UBound(NewExtNames) Then
+ For xNum = xNum To UBound(NewExtNames) - 1
+ NewExtNames(xNum) = NewExtNames(xNum + 1)
+ NewExtComp(xNum) = NewExtComp(xNum + 1)
+ Next xNum
End If
ReDim Preserve NewExtNames(UBound(NewExtNames) - 1) As String
ReDim Preserve NewExtComp(UBound(NewExtComp) - 1) As Integer
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
+Dim aExt As String, aName As String, aNum As Long, DCompType As Long
+On Error Resume Next
Left = MpqEx.Left + 330
If Left < 0 Then Left = 0
If Left + Width > Screen.Width Then Left = Screen.Width - Width
If Top + Height > Screen.Height Then Top = Screen.Height - Height
Path = App.Path
If Right(Path, 1) <> "\" Then Path = Path + "\"
-Text1 = MpqEx.Mpq.DefaultMaxFiles
+Text1 = DefaultMaxFiles
Text2 = LocaleID
OldFileName = CD.FileName
CD.FileName = ""
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
+ If FileExists(aName) Or IsDir(aName) Then
FileLists.AddItem aName
NewFileListNames = NewFileListNames + aName + vbCrLf
End If
aNum = InStr(aNum, NewListFile, vbCrLf) + 1
Else
aName = Mid(NewListFile, aNum)
- If FileExists(aName) Then
+ If FileExists(aName) Or IsDir(aName) Then
FileLists.AddItem aName
NewFileListNames = NewFileListNames + aName
End If
@@ -810,7 +877,6 @@ If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then Check1.Value = 1 Else Check1.
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
ReDim NewExtNames(0) As String
ReDim NewExtComp(0) As Integer
Combo1.ListIndex = 1
-ExtList = GetReg(AppKey + "Compression\List", ".bik.smk.wav")
+DCompType = GetReg(AppKey + "DefaultCompress", -1)
+Select Case DCompType
+Case -3
+Combo2.ListIndex = 1
+Case Else
+Combo2.ListIndex = 0
+End Select
+Combo3.ListIndex = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION) + 1
+ExtList = GetReg(AppKey + "Compression\List", ".bik.smk.mp3.mpq.w3m.wav")
If InStr(1, ExtList, ".") > 0 And Len(ExtList) > 1 Then
Do
ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".smk" Then
NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mp3" Then
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mpq" Then
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))
+ ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3m" Then
+ NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))
ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".wav" Then
NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.wav", "0"))
Else
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
+ On Error Resume Next
End If
ElseIf LCase(aExt) = "unknown" Then
FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
End Sub
Private Sub List1_Click()
-Dim eNum As Integer, OldExtComp As Integer
+Dim xNum 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)
+ For xNum = 1 To UBound(NewExtNames)
+ If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
+ Next xNum
+ Select Case NewExtComp(xNum)
Case -2
AudioC(0).Value = True
Combo1.ListIndex = 0
Case -1
AudioC(0).Value = True
Combo1.ListIndex = 1
- Case 0, 1, 2
- OldExtComp = NewExtComp(eNum)
+ Case -3
+ AudioC(0).Value = True
Combo1.ListIndex = 2
+ Case 0, 1, 2
+ OldExtComp = NewExtComp(xNum)
+ Combo1.ListIndex = 3
AudioC(OldExtComp).Value = True
Case Else
AudioC(0).Value = True
End Sub
Private Sub Text1_LostFocus()
If Text1 = "" Then Text1 = 0
-If Text1 < 16 Then Text1 = 16
-If Text1 > 262144 Then Text1 = 262144
+'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
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
diff --git a/Options.frx b/Options.frx
diff --git a/SFmpqapi.bas b/SFmpqapi.bas
--- /dev/null
+++ b/SFmpqapi.bas
@@ -0,0 +1,315 @@
+Attribute VB_Name = "SFmpqapi"
+Option Explicit
+
+' ShadowFlare MPQ API Library. (c) ShadowFlare Software 2002
+
+' All functions below are actual functions that are part of this
+' library and do not need any additional dll files. It does not
+' even require Storm to be able to decompress or compress files.
+
+' This library emulates the interface of Lmpqapi and Storm MPQ
+' functions, so it may be used as a replacement for them in
+' MPQ extractors/archivers without even needing to recompile
+' the program that uses Lmpqapi or Storm. It has a few features
+' not included in Lmpqapi and Storm, such as extra flags for some
+' functions, setting the locale ID of existing files, and adding
+' files without having to write them somewhere else first. Also,
+' MPQ handles used by functions prefixed with "SFile" and "Mpq"
+' can be used interchangably; all functions use the same type
+' of MPQ handles. You cannot, however, use handles from this
+' library with storm or lmpqapi or vice-versa. Doing so will
+' most likely result in a crash.
+
+' Revision History:
+' 20/10/2002 1.07 (ShadowFlare)
+' - No longer requires Storm.dll to compress or decompress
+' Warcraft III files
+' - Added SFileListFiles for getting names and information
+' about all of the files in an archive
+' - Fixed a bug with renaming and deleting files
+
+' 05/09/2002 1.06 (ShadowFlare)
+' - Compresses files without Storm.dll!
+' - If Warcraft III is installed, this library will be able to
+' find Storm.dll on its own. (Storm.dll is needed to
+' decompress Warcraft III files)
+' - Fixed a bug where an embedded archive and the file that
+' contains it would be corrupted if the archive was modified
+' - Able to open all .w3m maps now
+
+' 29/06/2002 1.05 (ShadowFlare)
+' - Supports decompressing files from Warcraft III MPQ archives
+' if using Storm.dll from Warcraft III
+' - Added MpqAddFileToArchiveEx and MpqAddFileFromBufferEx for
+' using extra compression types
+
+' 29/05/2002 1.04 (ShadowFlare)
+' - Files can be compressed now!
+' - Fixed a bug in SFileReadFile when reading data not aligned
+' to the block size
+' - Optimized some of SFileReadFile's code. It can read files
+' faster now
+' - SFile functions may now be used to access files not in mpq
+' archives as you can with the real storm functions
+' - MpqCompactArchive will no longer corrupt files with the
+' MODCRYPTKEY flag as long as the file is either compressed,
+' listed in "(listfile)", is "(listfile)", or is located in
+' the same place in the compacted archive; so it is safe
+' enough to use it on almost any archive
+' - Added MpqAddWaveFromBuffer
+' - Better handling of archives with no files
+' - Fixed compression with COMPRESS2 flag
+
+' 15/05/2002 1.03 (ShadowFlare)
+' - Supports adding files with the compression attribute (does
+' not actually compress files). Now archives created with
+' this dll can have files added to them through lmpqapi
+' without causing staredit to crash
+' - SFileGetBasePath and SFileSetBasePath work more like their
+' Storm equivalents now
+' - Implemented MpqCompactArchive, but it is not finished yet.
+' In its current state, I would recommend against using it
+' on archives that contain files with the MODCRYPTKEY flag,
+' since it will corrupt any files with that flag
+' - Added SFMpqGetVersionString2 which may be used in Visual
+' Basic to get the version string
+
+' 07/05/2002 1.02 (ShadowFlare)
+' - SFileReadFile no longer passes the lpOverlapped parameter it
+' receives to ReadFile. This is what was causing the function
+' to fail when used in Visual Basic
+' - Added support for more Storm MPQ functions
+' - GetLastError may now be used to get information about why a
+' function failed
+
+' 01/05/2002 1.01 (ShadowFlare)
+' - Added ordinals for Storm MPQ functions
+' - Fixed MPQ searching functionality of SFileOpenFileEx
+' - Added a check for whether a valid handle is given when
+' SFileCloseArchive is called
+' - Fixed functionality of SFileSetArchivePriority when multiple
+' files are open
+' - File renaming works for all filenames now
+' - SFileReadFile no longer reallocates the buffer for each block
+' that is decompressed. This should make SFileReadFile at least
+' a little faster
+
+' 30/04/2002 1.00 (ShadowFlare)
+' - First version.
+' - Compression not yet supported
+' - Does not use SetLastError yet, so GetLastError will not return any
+' errors that have to do with this library
+' - MpqCompactArchive not implemented
+
+' This library is freeware, you can do anything you want with it but with
+' one exception. If you use it in your program, you must specify this fact
+' in Help|About box or in similar way. You can obtain version string using
+' SFMpqGetVersionString call.
+
+' THIS LIBRARY IS DISTRIBUTED "AS IS". NO WARRANTY OF ANY KIND IS EXPRESSED
+' OR IMPLIED. YOU USE AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR
+' DATA LOSS, DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING
+' OR MISUSING THIS SOFTWARE.
+
+' Any comments or suggestions are accepted at blakflare@hotmail.com (ShadowFlare)
+
+Type SFMPQVERSION
+ Major As Integer
+ Minor As Integer
+ Revision As Integer
+ Subrevision As Integer
+End Type
+
+' MpqInitialize does nothing. It is only provided for
+' compatibility with MPQ archivers that use lmpqapi.
+Declare Function MpqInitialize Lib "SFmpq.dll" () As Boolean
+
+Declare Function MpqGetVersionString Lib "SFmpq.dll" () As String
+Declare Function MpqGetVersion Lib "SFmpq.dll" () As Single
+
+Declare Sub SFMpqDestroy Lib "SFmpq.dll" () ' This no longer needs to be called. It is only provided for compatibility with older versions
+
+' SFMpqGetVersionString2's return value is the required length of the buffer plus
+' the terminating null, so use SFMpqGetVersionString2(ByVal 0&, 0) to get the length.
+Declare Function SFMpqGetVersionString Lib "SFmpq.dll" () As String
+Declare Function SFMpqGetVersionString2 Lib "SFmpq.dll" (ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Long
+Declare Function SFMpqGetVersion Lib "SFmpq.dll" () As SFMPQVERSION
+
+' General error codes
+Public Const MPQ_ERROR_MPQ_INVALID As Long = &H85200065
+Public Const MPQ_ERROR_FILE_NOT_FOUND As Long = &H85200066
+Public Const MPQ_ERROR_DISK_FULL As Long = &H85200068 'Physical write file to MPQ failed. Not sure of exact meaning
+Public Const MPQ_ERROR_HASH_TABLE_FULL As Long = &H85200069
+Public Const MPQ_ERROR_ALREADY_EXISTS As Long = &H8520006A
+Public Const MPQ_ERROR_BAD_OPEN_MODE As Long = &H8520006C 'When MOAU_READ_ONLY is used without MOAU_OPEN_EXISTING
+
+Public Const MPQ_ERROR_COMPACT_ERROR As Long = &H85300001
+
+' MpqOpenArchiveForUpdate flags
+Public Const MOAU_CREATE_NEW As Long = &H0
+Public Const MOAU_CREATE_ALWAYS As Long = &H8 'Was wrongly named MOAU_CREATE_NEW
+Public Const MOAU_OPEN_EXISTING As Long = &H4
+Public Const MOAU_OPEN_ALWAYS As Long = &H20
+Public Const MOAU_READ_ONLY As Long = &H10 'Must be used with MOAU_OPEN_EXISTING
+Public Const MOAU_MAINTAIN_LISTFILE As Long = &H1
+
+' MpqAddFileToArchive flags
+Public Const MAFA_EXISTS As Long = &H80000000 'Will be added if not present
+Public Const MAFA_UNKNOWN40000000 As Long = &H40000000
+Public Const MAFA_MODCRYPTKEY As Long = &H20000
+Public Const MAFA_ENCRYPT As Long = &H10000
+Public Const MAFA_COMPRESS As Long = &H200
+Public Const MAFA_COMPRESS2 As Long = &H100
+Public Const MAFA_REPLACE_EXISTING As Long = &H1
+
+' MpqAddFileToArchiveEx compression flags
+Public Const MAFA_COMPRESS_STANDARD As Long = &H8 'Standard PKWare DCL compression
+Public Const MAFA_COMPRESS_DEFLATE As Long = &H2 'ZLib's deflate compression
+Public Const MAFA_COMPRESS_WAVE As Long = &H81 'Standard wave compression
+Public Const MAFA_COMPRESS_WAVE2 As Long = &H41 'Unused wave compression
+
+' Flags for individual compression types used for wave compression
+Public Const MAFA_COMPRESS_WAVECOMP1 As Long = &H80 'Main compressor for standard wave compression
+Public Const MAFA_COMPRESS_WAVECOMP2 As Long = &H40 'Main compressor for unused wave compression
+Public Const MAFA_COMPRESS_WAVECOMP3 As Long = &H1 'Secondary compressor for wave compression
+
+' ZLib deflate compression level constants (used with MpqAddFileToArchiveEx and MpqAddFileFromBufferEx)
+Public Const Z_NO_COMPRESSION As Long = 0
+Public Const Z_BEST_SPEED As Long = 1
+Public Const Z_BEST_COMPRESSION As Long = 9
+Public Const Z_DEFAULT_COMPRESSION As Long = (-1)
+
+' MpqAddWAVToArchive quality flags
+Public Const MAWA_QUALITY_HIGH As Long = 1
+Public Const MAWA_QUALITY_MEDIUM As Long = 0
+Public Const MAWA_QUALITY_LOW As Long = 2
+
+' SFileGetFileInfo flags
+Public Const SFILE_INFO_BLOCK_SIZE As Long = &H1 'Block size in MPQ
+Public Const SFILE_INFO_HASH_TABLE_SIZE As Long = &H2 'Hash table size in MPQ
+Public Const SFILE_INFO_NUM_FILES As Long = &H3 'Number of files in MPQ
+Public Const SFILE_INFO_TYPE As Long = &H4 'Is Long a file or an MPQ?
+Public Const SFILE_INFO_SIZE As Long = &H5 'Size of MPQ or uncompressed file
+Public Const SFILE_INFO_COMPRESSED_SIZE As Long = &H6 'Size of compressed file
+Public Const SFILE_INFO_FLAGS As Long = &H7 'File flags (compressed, etc.), file attributes if a file not in an archive
+Public Const SFILE_INFO_PARENT As Long = &H8 'Handle of MPQ that file is in
+Public Const SFILE_INFO_POSITION As Long = &H9 'Position of file pointer in files
+Public Const SFILE_INFO_LOCALEID As Long = &HA 'Locale ID of file in MPQ
+Public Const SFILE_INFO_PRIORITY As Long = &HB 'Priority of open MPQ
+Public Const SFILE_INFO_HASH_INDEX As Long = &HC 'Hash index of file in MPQ
+
+' SFileListFiles flags
+Public Const SFILE_LIST_MEMORY_LIST As Long = &H1 ' Specifies that lpFilelists is a file list from memory, rather than being a list of file lists
+Public Const SFILE_LIST_ONLY_KNOWN As Long = &H2 ' Only list files that the function finds a name for
+Public Const SFILE_LIST_ONLY_UNKNOWN As Long = &H4 ' Only list files that the function does not find a name for
+
+Public Const SFILE_TYPE_MPQ As Long = &H1
+Public Const SFILE_TYPE_FILE As Long = &H2
+
+Public Const INVALID_HANDLE_VALUE As Long = -1
+
+Public Const FILE_BEGIN As Long = 0
+Public Const FILE_CURRENT As Long = 1
+Public Const FILE_END As Long = 2
+
+Public Const SFILE_OPEN_HARD_DISK_FILE As Long = &H0 'Open archive without regard to the drive type it resides on
+Public Const SFILE_OPEN_CD_ROM_FILE As Long = &H1 'Open the archive only if it is on a CD-ROM
+Public Const SFILE_OPEN_ALLOW_WRITE As Long = &H8000 'Open file with write access
+
+Public Const SFILE_SEARCH_CURRENT_ONLY As Long = &H0 'Used with SFileOpenFileEx; only the archive with the handle specified will be searched for the file
+Public Const SFILE_SEARCH_ALL_OPEN As Long = &H1 'SFileOpenFileEx will look through all open archives for the file
+
+Type FILELISTENTRY
+ dwFileExists As Long ' Nonzero if this entry is used
+ lcLocale As Long ' Locale ID of file
+ dwCompressedSize As Long ' Compressed size of file
+ dwFullSize As Long ' Uncompressed size of file
+ dwFlags As Long ' Flags for file
+ szFileName(259) As Byte
+End Type
+
+' Storm functions implemented by this library
+Declare Function SFileOpenArchive Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwPriority As Long, ByVal dwFlags As Long, ByRef hMPQ As Long) As Boolean
+Declare Function SFileCloseArchive Lib "SFmpq.dll" (ByVal hMPQ As Long) As Boolean
+Declare Function SFileGetArchiveName Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean
+Declare Function SFileOpenFile Lib "SFmpq.dll" (ByVal lpFileName As String, ByRef hFile As Long) As Boolean
+Declare Function SFileOpenFileEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String, ByVal dwSearchScope As Long, ByRef hFile As Long) As Boolean
+Declare Function SFileCloseFile Lib "SFmpq.dll" (ByVal hFile As Long) As Boolean
+Declare Function SFileGetFileSize Lib "SFmpq.dll" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
+Declare Function SFileGetFileArchive Lib "SFmpq.dll" (ByVal hFile As Long, ByRef hMPQ As Long) As Boolean
+Declare Function SFileGetFileName Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean
+Declare Function SFileSetFilePointer Lib "SFmpq.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lplDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
+Declare Function SFileReadFile Lib "SFmpq.dll" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Boolean
+Declare Function SFileSetLocale Lib "SFmpq.dll" (ByVal nNewLocale As Long) As Long
+Declare Function SFileGetBasePath Lib "SFmpq.dll" (ByVal lpBuffer As String, ByVal dwBufferLength As Long) As Boolean
+Declare Function SFileSetBasePath Lib "SFmpq.dll" (ByVal lpNewBasePath As String) As Boolean
+
+' Extra storm-related functions
+Declare Function SFileGetFileInfo Lib "SFmpq.dll" (ByVal hFile As Long, ByVal dwInfoType As Long) As Long
+Declare Function SFileSetArchivePriority Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal dwPriority As Long) As Boolean
+Declare Function SFileFindMpqHeader Lib "SFmpq.dll" (ByVal hFile As Long) As Long
+Declare Function SFileListFiles Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileLists As String, ByRef lpListBuffer As FILELISTENTRY, ByVal dwFlags As Long) As Boolean
+
+' Archive editing functions implemented by this library
+Declare Function MpqOpenArchiveForUpdate Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwMaximumFilesInArchive As Long) As Long
+Declare Function MpqCloseUpdatedArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal dwUnknown2 As Long) As Long
+Declare Function MpqAddFileToArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long) As Boolean
+Declare Function MpqAddWaveToArchive Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long, ByVal dwQuality As Long) As Boolean
+Declare Function MpqRenameFile Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpcOldFileName As String, ByVal lpcNewFileName As String) As Boolean
+Declare Function MpqDeleteFile Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String) As Boolean
+Declare Function MpqCompactArchive Lib "SFmpq.dll" (ByVal hMPQ As Long) As Boolean
+
+' Extra archive editing functions
+Declare Function MpqAddFileToArchiveEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpSourceFileName As String, ByVal lpDestFileName As String, ByVal dwFlags As Long, ByVal dwCompressionType As Long, ByVal dwCompressLevel As Long) As Boolean
+Declare Function MpqAddFileFromBufferEx Lib "SFmpq.dll" (ByVal hMPQ As Long, lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwCompressionType As Long, ByVal dwCompressLevel As Long) As Boolean
+Declare Function MpqAddFileFromBuffer Lib "SFmpq.dll" (ByVal hMPQ As Long, lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long) As Boolean
+Declare Function MpqAddWaveFromBuffer Lib "SFmpq.dll" (ByVal hMPQ As Long, lpBuffer As Any, ByVal dwLength As Long, ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwQuality As Long) As Boolean
+Declare Function MpqSetFileLocale Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFileName As String, ByVal nOldLocale As Long, ByVal nNewLocale As Long) As Boolean
+
+' These functions do nothing. They are only provided for
+' compatibility with MPQ extractors that use storm.
+Declare Function SFileDestroy Lib "SFmpq.dll" () As Boolean
+Declare Sub StormDestroy Lib "SFmpq.dll" ()
+
+' Returns 0 if the dll version is equal to the version your program was compiled
+' with, 1 if the dll is newer, -1 if the dll is older.
+Function SFMpqCompareVersion() As Long
+ Dim ExeVersion As SFMPQVERSION, DllVersion As SFMPQVERSION
+ With ExeVersion
+ .Major = 1
+ .Minor = 0
+ .Revision = 7
+ .Subrevision = 3
+ End With
+ DllVersion = SFMpqGetVersion()
+ If DllVersion.Major > ExeVersion.Major Then
+ SFMpqCompareVersion = 1
+ Exit Function
+ ElseIf DllVersion.Major < ExeVersion.Major Then
+ SFMpqCompareVersion = -1
+ Exit Function
+ End If
+ If DllVersion.Minor > ExeVersion.Minor Then
+ SFMpqCompareVersion = 1
+ Exit Function
+ ElseIf DllVersion.Minor < ExeVersion.Minor Then
+ SFMpqCompareVersion = -1
+ Exit Function
+ End If
+ If DllVersion.Revision > ExeVersion.Revision Then
+ SFMpqCompareVersion = 1
+ Exit Function
+ ElseIf DllVersion.Revision < ExeVersion.Revision Then
+ SFMpqCompareVersion = -1
+ Exit Function
+ End If
+ If DllVersion.Subrevision > ExeVersion.Subrevision Then
+ SFMpqCompareVersion = 1
+ Exit Function
+ ElseIf DllVersion.Subrevision < ExeVersion.Subrevision Then
+ SFMpqCompareVersion = -1
+ Exit Function
+ End If
+ SFMpqCompareVersion = 0
+End Function
+
diff --git a/WINMPQ.VBP b/WINMPQ.VBP
--- a/WINMPQ.VBP
+++ b/WINMPQ.VBP
Module=RegistryFunctions; Registry.bas
Module=FileDialog; FileDialog.bas
Module=FixWindowIcon; FixIcon.bas
+Module=SFmpqapi; SFmpqapi.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
+Form=frmMpq.frm
+Form=frmAddToList.frm
+Form=ChLCID.frm
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
ProjWinSize=82,446,212,163
ProjWinShow=2
StartMode=0
VersionCompatible32="0"
MajorVer=1
-MinorVer=54
+MinorVer=62
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="ShadowFlare Software"
VersionFileDescription="ShadowFlare MPQ Archiver"
-VersionLegalCopyright="Copyright © ShadowFlare Software 2001-2002"
+VersionLegalCopyright="Copyright © ShadowFlare Software 2001-2003"
VersionProductName="WinMPQ"
diff --git a/WMpqEmbed.rtf b/WMpqEmbed.rtf
new file mode 100644 (file)
index 0000000..f66ac93
Binary files /dev/null and b/WMpqEmbed.rtf differ
index 0000000..f66ac93
Binary files /dev/null and b/WMpqEmbed.rtf differ
diff --git a/WinMPQ.rtf b/WinMPQ.rtf
--- a/WinMPQ.rtf
+++ b/WinMPQ.rtf
{\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
+\viewkind4\uc1\pard\b\f0\fs36 WinMPQ v1.\f1 62\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\li360 This program is an mpq archiver I \f1 started\f0 as an example of a program using the Mpq Control\f1 , but it now uses SFmpq directly\f0 . 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
+\f1{\pntext\f3\'B7\tab}SFmpq (included)\f0\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
@@ -137,7 +137,7 @@ NOTE: Each file that a MoPaQ can hold (the FileLimit) takes up 16 bytes in the M
\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\li360 The locale ID determines what language\f1 version of the software\f0 a file is\f1 intended for\f0 . Here is a list of some of the ID numbers you can use \f1 for\f0 files.\par\r
\pard\par\r
\pard\li720\tx3600 0\tab Language Neutral/English\par\r
1031 (407 in hex)\tab German\par\r
@@ -152,6 +152,26 @@ NOTE: Each file that a MoPaQ can hold (the FileLimit) takes up 16 bytes in the M
\pard\par\r
\ul\b\fs24 Version history\ulnone\b0\fs20\par\r
\par\r
+\ul\b 1.\f1 62\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Fixed a bug that prevented extracting empty files.\f0\par\r
+\f1{\pntext\f3\'B7\tab}Added an option that would allow one to have WinMPQ search a specified folder and all of its subfolders for file lists with names similar to the open archive.\f0\par\r
+\f1{\pntext\f3\'B7\tab}When you add a file, you are prompted for what path to add to the beginning of the filenames, and click cancel, WinMPQ no longer adds the files with no path added but instead it cancels adding the files.\f0\par\r
+\pard\par\r
+\ul\b 1.\f1 61\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 WinMPQ was not closing the archive handle properly after adding files that have been modified after being opened from WinMPQ. This was causing WinMPQ to be unable to open the archive to add files, extract files, etc. This bug has been fixed in this version.\f0\par\r
+\f1{\pntext\f3\'B7\tab}Fixed a bug that caused WinMPQ to be unable to update a file in the archive that has been modified.\f0\par\r
+\f1{\pntext\f3\'B7\tab}Mpq Embedder is now included with WinMPQ. Access it from the "Tools" menu.\f0\par\r
+\f1{\pntext\f3\'B7\tab}All options that were available by right-clicking a file are now also available from the "Mpq" menu.\f0\par\r
+\f1{\pntext\f3\'B7\tab}The "Tools" menu is now also shown on the right-click context menu shown when right-clicking on a file.\f0\par\r
+\f1{\pntext\f3\'B7\tab}The default compression type can be changed now, and the compression level for deflate compression can set.\f0\par\r
+\f1{\pntext\f3\'B7\tab}Added a menu command to add a file to the listing if it is not listed and you know the name of the file.\f0\par\r
+\f1{\pntext\f3\'B7\tab}Added a menu command to change the locale ID of an existing file.\f0\par\r
+\pard\par\r
+\ul\b 1.\f1 60\f0 __________\par\r
+\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Switched to using SFmpq instead of Mpq Control.\f0\par\r
+\f1{\pntext\f3\'B7\tab}Added support for adding files with Warcraft III's new compression method.\f0\par\r
+\f1{\pntext\f3\'B7\tab}File encryption can now be enabled or disabled through the "Mpq" menu.\f0\par\r
+\pard\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
diff --git a/frmAddToList.frm b/frmAddToList.frm
--- /dev/null
+++ b/frmAddToList.frm
@@ -0,0 +1,78 @@
+VERSION 4.00
+Begin VB.Form frmAddToList
+ BorderStyle = 3 'Fixed Dialog
+ Caption = "Add file to listing..."
+ ClientHeight = 1695
+ ClientLeft = 2190
+ ClientTop = 2610
+ ClientWidth = 4335
+ Height = 2100
+ Icon = "frmAddToList.frx":0000
+ Left = 2130
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 1695
+ ScaleWidth = 4335
+ ShowInTaskbar = 0 'False
+ Top = 2265
+ Width = 4455
+ Begin VB.CommandButton Command2
+ Cancel = -1 'True
+ Caption = "&Cancel"
+ Height = 375
+ Left = 2400
+ TabIndex = 3
+ Top = 1200
+ Width = 1335
+ End
+ Begin VB.CommandButton Command1
+ Caption = "O&K"
+ Default = -1 'True
+ Height = 375
+ Left = 600
+ TabIndex = 2
+ Top = 1200
+ Width = 1335
+ End
+ Begin VB.TextBox Text1
+ Height = 285
+ Left = 120
+ TabIndex = 1
+ Top = 840
+ Width = 4095
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "If you know the name of a file, but it is not listed, type in the name here and it will be added to the list of files shown."
+ Height = 585
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ Width = 4095
+ WordWrap = -1 'True
+ End
+End
+Attribute VB_Name = "frmAddToList"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub Command1_Click()
+MpqEx.List.Sorted = False
+MpqEx.AddToListing Text1
+MpqEx.List.Sorted = True
+MpqEx.RemoveDuplicates
+Unload Me
+End Sub
+Private Sub Command2_Click()
+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
+End Sub
diff --git a/frmAddToList.frx b/frmAddToList.frx
new file mode 100644 (file)
index 0000000..b20c2b6
Binary files /dev/null and b/frmAddToList.frx differ
index 0000000..b20c2b6
Binary files /dev/null and b/frmAddToList.frx differ
diff --git a/frmMpq.frm b/frmMpq.frm
--- /dev/null
+++ b/frmMpq.frm
@@ -0,0 +1,308 @@
+VERSION 4.00
+Begin VB.Form frmMpq
+ BorderStyle = 1 'Fixed Single
+ Caption = "MPQ Embedder"
+ ClientHeight = 1695
+ ClientLeft = 3045
+ ClientTop = 2730
+ ClientWidth = 2775
+ Height = 2385
+ Icon = "frmMpq.frx":0000
+ Left = 2985
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ ScaleHeight = 1695
+ ScaleWidth = 2775
+ Top = 2100
+ Width = 2895
+ Begin VB.CommandButton cmdSaveEXE
+ Caption = "Save &EXE"
+ Enabled = 0 'False
+ Height = 375
+ Left = 1440
+ TabIndex = 3
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdRemove
+ Caption = "&Remove"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 2
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdSaveMPQ
+ Caption = "Save &MPQ"
+ Enabled = 0 'False
+ Height = 375
+ Left = 1440
+ TabIndex = 1
+ Top = 720
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdAdd
+ Caption = "&Add"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 0
+ Top = 720
+ Width = 1215
+ End
+ Begin VB.Label Label1
+ Height = 615
+ Left = 120
+ TabIndex = 4
+ Top = 120
+ Width = 2565
+ WordWrap = -1 'True
+ End
+ Begin VB.Menu mnuFile
+ Caption = "&File"
+ Begin VB.Menu mnuFOpen
+ Caption = "&Open..."
+ End
+ Begin VB.Menu mnuFSep
+ Caption = "-"
+ End
+ Begin VB.Menu mnuFExit
+ Caption = "E&xit"
+ End
+ End
+ Begin VB.Menu mnuRun
+ Caption = "&Run EXE"
+ Enabled = 0 'False
+ End
+ Begin VB.Menu mnuHelp
+ Caption = "&Help"
+ Begin VB.Menu mnuHReadme
+ Caption = "View &Readme..."
+ End
+ Begin VB.Menu mnuHSep
+ Caption = "-"
+ End
+ Begin VB.Menu mnuHAbout
+ Caption = "&About..."
+ End
+ End
+End
+Attribute VB_Name = "frmMpq"
+Attribute VB_Creatable = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Dim MpqHeader As Long, IsEXE As Boolean, FileDialog As OPENFILENAME
+Private Sub cmdAdd_Click()
+Dim OldFileName As String, NewMpqHeader As Long, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
+FileDialog.Flags = &H1000 Or &H4 Or &H2
+FileDialog.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx)|*.mpq;*.exe;*.snp;*.scm;*.scx|All Files (*.*)|*.*"
+OldFileName = FileDialog.FileName
+FileDialog.hwndOwner = hWnd
+If ShowOpen(FileDialog) = False Then GoTo Cancel
+NewMpqHeader = FindMpqHeader(FileDialog.FileName)
+If NewMpqHeader = -1 Then
+ MsgBox "This file does not contain an MPQ archive.", , "MPQ Embedder"
+ GoTo Cancel
+End If
+fNum = FreeFile
+Open FileDialog.FileName For Binary As #fNum
+fNum2 = FreeFile
+Open OldFileName For Binary As #fNum2
+If MpqHeader / 512 <> Int(MpqHeader / 512) Then
+ bNum = MsgBox("The file you are adding the MPQ archive to" + vbCrLf + "is not the proper size; therefore, most MPQ" + vbCrLf + "archive readers will not be able to read it." + vbCrLf + "Do you want to increase the size of the file," + vbCrLf + "so other programs can read it?", vbQuestion Or vbYesNo Or vbDefaultButton1, "MPQ Embedder")
+ If bNum = vbYes Then
+ Text = String(512 - (MpqHeader - Int(MpqHeader / 512) * 512), Chr(0))
+ Put #fNum2, MpqHeader + 1, Text
+ MpqHeader = MpqHeader + Len(Text)
+ End If
+End If
+For bNum = NewMpqHeader + 1 To LOF(fNum) Step 2 ^ 20
+ Text = String(2 ^ 20, Chr(0))
+ If LOF(fNum) - bNum + 1 >= 2 ^ 20 Then
+ Get #fNum, bNum, Text
+ Put #fNum2, MpqHeader + bNum - NewMpqHeader, Text
+ Else
+ Text = String(LOF(fNum) - bNum + 1, Chr(0))
+ Get #fNum, bNum, Text
+ Put #fNum2, MpqHeader + bNum - NewMpqHeader, Text
+ End If
+Next bNum
+Close #fNum2
+Close #fNum
+cmdAdd.Enabled = False
+cmdRemove.Enabled = True
+cmdSaveMPQ.Enabled = True
+cmdSaveEXE.Enabled = True
+If MpqHeader / 512 = Int(MpqHeader / 512) Then
+ Label1.Caption = "This file contains an MPQ archive."
+Else
+ Label1.Caption = "This file contains an MPQ archive, but other programs may not be able to read it."
+End If
+Cancel:
+FileDialog.FileName = OldFileName
+End Sub
+Private Sub cmdRemove_Click()
+Dim fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
+bNum = MsgBox("Are you sure you want to permanently" + vbCrLf + "remove the MPQ archive from this file?", vbQuestion Or vbYesNo Or vbDefaultButton2, "MPQ Embedder")
+If bNum = vbNo Then Exit Sub
+fNum = FreeFile
+Open FileDialog.FileName For Binary As #fNum
+fNum2 = FreeFile
+If Dir(FileDialog.FileName + ".remove") <> "" Then Kill FileDialog.FileName + ".remove"
+Open FileDialog.FileName + ".remove" For Binary As #fNum2
+For bNum = 1 To MpqHeader Step 2 ^ 20
+ Text = String(2 ^ 20, Chr(0))
+ If MpqHeader - bNum + 1 >= 2 ^ 20 Then
+ Get #fNum, bNum, Text
+ Put #fNum2, bNum, Text
+ Else
+ Text = String(MpqHeader - bNum + 1, Chr(0))
+ Get #fNum, bNum, Text
+ Put #fNum2, bNum, Text
+ End If
+Next bNum
+Close #fNum2
+Close #fNum
+Kill FileDialog.FileName
+Name FileDialog.FileName + ".remove" As FileDialog.FileName
+cmdAdd.Enabled = True
+cmdRemove.Enabled = False
+cmdSaveMPQ.Enabled = False
+cmdSaveEXE.Enabled = True
+Label1.Caption = "This file does not contain an MPQ archive."
+End Sub
+Private Sub cmdSaveEXE_Click()
+Dim OldFileName As String, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
+FileDialog.Flags = &H1000 Or &H4 Or &H2
+FileDialog.Filter = "File (*.*)|*.*"
+FileDialog.DefaultExt = ""
+OldFileName = FileDialog.FileName
+FileDialog.FileName = FileDialog.FileName
+FileDialog.hwndOwner = hWnd
+If ShowSave(FileDialog) = False Then GoTo Cancel
+fNum = FreeFile
+Open OldFileName For Binary As #fNum
+fNum2 = FreeFile
+If Dir(FileDialog.FileName) <> "" Then Kill FileDialog.FileName
+Open FileDialog.FileName For Binary As #fNum2
+For bNum = 1 To MpqHeader Step 2 ^ 20
+ Text = String(2 ^ 20, Chr(0))
+ If MpqHeader - bNum + 1 >= 2 ^ 20 Then
+ Get #fNum, bNum, Text
+ Put #fNum2, bNum, Text
+ Else
+ Text = String(MpqHeader - bNum + 1, Chr(0))
+ Get #fNum, bNum, Text
+ Put #fNum2, bNum, Text
+ End If
+Next bNum
+Close #fNum2
+Close #fNum
+Cancel:
+FileDialog.FileName = OldFileName
+End Sub
+Private Sub cmdSaveMPQ_Click()
+Dim OldFileName As String, fNum As Long, Text As String, fNum2 As Long, Text2 As String, bNum As Long
+FileDialog.Flags = &H1000 Or &H4 Or &H2
+FileDialog.Filter = "MPQ Archive (*.mpq)|*.mpq"
+FileDialog.DefaultExt = "mpq"
+OldFileName = FileDialog.FileName
+FileDialog.FileName = FileDialog.FileName + ".mpq"
+FileDialog.hwndOwner = hWnd
+If ShowSave(FileDialog) = False Then GoTo Cancel
+fNum = FreeFile
+Open OldFileName For Binary As #fNum
+fNum2 = FreeFile
+If Dir(FileDialog.FileName) <> "" Then Kill FileDialog.FileName
+Open FileDialog.FileName For Binary As #fNum2
+For bNum = MpqHeader + 1 To LOF(fNum) Step 2 ^ 20
+ Text = String(2 ^ 20, Chr(0))
+ If LOF(fNum) - bNum + 1 >= 2 ^ 20 Then
+ Get #fNum, bNum, Text
+ Put #fNum2, bNum - MpqHeader, Text
+ Else
+ Text = String(LOF(fNum) - bNum + 1, Chr(0))
+ Get #fNum, bNum, Text
+ Put #fNum2, bNum - MpqHeader, Text
+ End If
+Next bNum
+Close #fNum2
+Close #fNum
+Cancel:
+FileDialog.FileName = OldFileName
+End Sub
+
+Private Sub Form_Load()
+FileDialog = CD
+End Sub
+Private Sub mnuFExit_Click()
+Unload Me
+End Sub
+Private Sub mnuFOpen_Click()
+Dim OldFileName As String, OldMpqHeader As Long, fNum As Long, Text As String
+FileDialog.Flags = &H1000 Or &H4 Or &H2
+FileDialog.Filter = "All Files (*.*)|*.*"
+OldFileName = FileDialog.FileName
+OldMpqHeader = MpqHeader
+FileDialog.hwndOwner = hWnd
+If ShowOpen(FileDialog) = False Then GoTo Cancel
+If FileLen(FileDialog.FileName) = 0 Then
+ MsgBox "This is an empty file.", vbExclamation, "MPQ Embedder"
+ GoTo Cancel
+End If
+fNum = FreeFile
+Open FileDialog.FileName For Binary As #fNum
+Text = String(2, Chr(0))
+If LOF(fNum) >= 2 Then Get #fNum, 1, Text
+Close #fNum
+If Text = "MZ" Then IsEXE = True Else IsEXE = False
+If IsEXE Then mnuRun.Enabled = True Else mnuRun.Enabled = False
+MpqHeader = FindMpqHeader(FileDialog.FileName)
+If MpqHeader <= -1 Then
+ cmdAdd.Enabled = True
+ cmdRemove.Enabled = False
+ cmdSaveMPQ.Enabled = False
+ cmdSaveEXE.Enabled = True
+ MpqHeader = FileLen(FileDialog.FileName)
+ Label1.Caption = "This file does not contain an MPQ archive."
+ElseIf MpqHeader = 0 Then
+ cmdAdd.Enabled = False
+ cmdRemove.Enabled = False
+ cmdSaveMPQ.Enabled = True
+ cmdSaveEXE.Enabled = False
+ Label1.Caption = "This file is an MPQ archive."
+ElseIf MpqHeader > 0 Then
+ cmdAdd.Enabled = False
+ cmdRemove.Enabled = True
+ cmdSaveMPQ.Enabled = True
+ cmdSaveEXE.Enabled = True
+ If MpqHeader / 512 = Int(MpqHeader / 512) Then
+ Label1.Caption = "This file contains an MPQ archive."
+ Else
+ Label1.Caption = "This file contains an MPQ archive, but other programs may be unable to read it."
+ End If
+End If
+Exit Sub
+Cancel:
+FileDialog.FileName = OldFileName
+MpqHeader = OldMpqHeader
+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 Dir(Path + "WMpqEmbed.rtf") = "" Then MsgBox "Could not find WMpqEmbed.rtf!", vbCritical, "MPQ Embedder"
+ShellExecute hWnd, vbNullString, Path + "WMpqEmbed.rtf", vbNullString, vbNullString, 1
+End Sub
+Private Sub mnuRun_Click()
+On Error GoTo NotExecutable
+Shell FileDialog.FileName, 1
+Exit Sub
+NotExecutable:
+MsgBox "This file is not a .exe file.", vbInformation, "MPQ Embedder"
+End Sub
diff --git a/frmMpq.frx b/frmMpq.frx
diff --git a/listing.frm b/listing.frm
--- a/listing.frm
+++ b/listing.frm
ClientWidth = 6690
Height = 4200
Icon = "listing.frx":0000
+ KeyPreview = -1 'True
Left = 1185
LinkTopic = "Form1"
ScaleHeight = 3510
Width = 6810
Begin VB.Timer Timer1
Enabled = 0 'False
- Interval = 5000
+ Interval = 2500
Left = 6120
Top = 2160
End
EndProperty
OLEDragMode = 1
OLEDropMode = 1
- NumItems = 5
+ NumItems = 6
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Key = "N"
Text = "Name"
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
+ Key = "LCID"
+ Text = "Locale ID"
+ Object.Width = 1129
+ EndProperty
+ BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ SubItemIndex = 5
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
Begin VB.Menu mnuMpq
Caption = "&Mpq"
Enabled = 0 'False
+ Begin VB.Menu mnuMItem
+ Caption = "&Open"
+ Index = 0
+ Visible = 0 'False
+ End
+ Begin VB.Menu mnuMSep1
+ Caption = "-"
+ Visible = 0 'False
+ 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 mnuMChLCID
+ Caption = "Change Locale &ID..."
+ Shortcut = ^I
+ End
+ Begin VB.Menu mnuMSep2
+ Caption = "-"
+ End
Begin VB.Menu mnuMAdd
Caption = "&Add..."
Shortcut = ^A
Caption = "&Standard"
Shortcut = {F3}
End
+ Begin VB.Menu mnuMCDeflate
+ Caption = "&Deflate"
+ Shortcut = {F9}
+ End
Begin VB.Menu mnuMCAudio
Caption = "&Audio"
Begin VB.Menu mnuMCALowest
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
+ Begin VB.Menu mnuMEncrypt
+ Caption = "Encr&ypt Files"
End
Begin VB.Menu mnuMCompact
Caption = "Com&pact"
Shortcut = ^P
End
+ Begin VB.Menu mnuMAddToList
+ Caption = "Add File to Li&sting..."
+ Shortcut = ^K
+ End
Begin VB.Menu mnuMSaveList
Caption = "Save File &List..."
Shortcut = ^L
Begin VB.Menu mnuTSep
Caption = "-"
End
+ Begin VB.Menu mnuTMpqEmbed
+ Caption = "MPQ Embedder"
+ End
+ Begin VB.Menu mnuTSep2
+ Caption = "-"
+ End
Begin VB.Menu mnuTAdd
Caption = "&Add/Remove..."
End
Caption = "&Open"
Index = 0
End
- Begin VB.Menu mnuPSep
+ Begin VB.Menu mnuPSep1
+ Caption = "-"
+ End
+ Begin VB.Menu mnuPTools
+ Caption = "&Tools"
+ Begin VB.Menu mnuPTItem
+ Caption = "(Empty)"
+ Index = 0
+ End
+ End
+ Begin VB.Menu mnuPSep2
Caption = "-"
End
Begin VB.Menu mnuPExtract
Begin VB.Menu mnuPRename
Caption = "Rena&me"
End
+ Begin VB.Menu mnuPChLCID
+ Caption = "Change Locale &ID..."
+ End
End
End
Attribute VB_Name = "MpqEx"
Attribute VB_Exposed = False
Option Explicit
-Dim txtCommandHasFocus As Boolean
+Dim txtCommandHasFocus As Boolean, ShiftState As Boolean
Dim OpenFiles() As String, OpenFileDates() As Date, MpqDate As Date
Sub AddRecentFile(rFileName As String)
Dim bNum As Long, fNum As Long
End If
BuildRecentFileList
End Sub
-Sub BuildPopup(FileName As String, Shift As Integer)
+Sub BuildMpqActionList()
+Dim Shift As Integer
+On Error GoTo NotSelected
+List.SelectedItem.Tag = List.SelectedItem.Tag
+On Error GoTo 0
+If List.SelectedItem.Selected = True Then
+ Shift = 0
+ If ShiftState = True Then Shift = vbShiftMask
+ mnuMItem(0).Visible = True
+ mnuMSep1.Visible = True
+ BuildPopup List.SelectedItem.Tag, Shift, mnuMpq, mnuMItem
+Else
+ GoTo NotSelected
+End If
+Exit Sub
+NotSelected:
+Dim PItem As Menu
+For Each PItem In mnuMItem
+ If PItem.Index <> 0 Then Unload PItem
+Next PItem
+mnuMItem(0).Visible = False
+mnuMSep1.Visible = False
+End Sub
+Sub BuildPopup(FileName As String, Shift As Integer, mnuRoot As Menu, mnuItem)
Dim aNum As Long, aItem As String, aName As String, bNum As Long, PItem As Menu, dItem As String
-mnuPopup.Tag = 0
-For Each PItem In mnuPItem
+mnuRoot.Tag = 0
+For Each PItem In mnuItem
If PItem.Index <> 0 Then Unload PItem
Next PItem
If InStr(FileName, ".") = 0 Then
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..."
+ mnuItem(0).Caption = "Op&en with..."
Else
- mnuPItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
+ mnuItem(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
+ mnuItem(0).Tag = dItem
+ mnuRoot.Tag = 1
aNum = 0
bNum = 1
Else
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..."
+ mnuItem(0).Caption = "Op&en with..."
Else
- mnuPItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
+ mnuItem(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
+ mnuItem(0).Tag = aItem
+ mnuRoot.Tag = 1
aNum = 1
bNum = 1
Else
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)
+ Load mnuItem(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..."
+ mnuItem(bNum).Caption = "Op&en with..."
Else
- mnuPItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
+ mnuItem(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
+ mnuItem(bNum).Tag = aItem
+ mnuRoot.Tag = mnuRoot.Tag + 1
bNum = bNum + 1
End If
aNum = aNum + 1
Exit Sub
AddUnknown:
aNum = 0
- bNum = mnuPopup.Tag
+ bNum = mnuRoot.Tag
dItem = ""
If bNum = 0 Then
dItem = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\", "open")
dItem = GetReg(SharedAppKey + "FileDefaultActions\Unknown", dItem)
If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\command\")) Then
If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\")) Then
- mnuPItem(bNum).Caption = "Op&en with..."
+ mnuItem(bNum).Caption = "Op&en with..."
Else
- mnuPItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))
End If
- mnuPItem(bNum).Tag = dItem
+ mnuItem(bNum).Tag = dItem
bNum = bNum + 1
End If
End If
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)
+ Load mnuItem(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..."
+ mnuItem(bNum).Caption = "Op&en with..."
Else
- mnuPItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
+ mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))
End If
- mnuPItem(bNum).Tag = aItem
+ mnuItem(bNum).Tag = aItem
bNum = bNum + 1
End If
aNum = aNum + 1
Loop Until aItem = ""
Return
End Sub
+Sub ChangeLCID(NewLCID As Long)
+Dim fNum As Long, hMPQ As Long
+fNum = 1
+hMPQ = mOpenMpq(CD.FileName)
+If hMPQ Then
+ Do While fNum <= List.ListItems.Count
+ If List.ListItems.Item(fNum).Selected Then
+ StatBar.Style = 1
+ StatBar.SimpleText = "Changing locale ID of " + List.ListItems.Item(fNum).Tag + " to " + CStr(NewLCID) + "..."
+ MousePointer = 11
+ MpqSetFileLocale hMPQ, List.ListItems.Item(fNum).Tag, List.ListItems.Item(fNum).ListSubItems(4).Tag, NewLCID
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ List.ListItems.Item(fNum).ListSubItems(4).Tag = NewLCID
+ List.ListItems.Item(fNum).ListSubItems(4).Text = NewLCID
+ End If
+ fNum = fNum + 1
+ Loop
+ MpqCloseUpdatedArchive hMPQ, 0
+End If
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+ShowSelected
+ShowTotal
+End Sub
Sub DelRecentFile(rFileName As String)
Dim bNum As Long, fNum As Long
For bNum = 1 To 8
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
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, hFile As Long
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+ If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
+ L1 = AddedFile
+ fSize = SFileGetFileSize(hFile, 0)
+ cSize = 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 = SFileGetFileInfo(hFile, 7)
+ L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)
+ 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(, , L6).Tag = L6
+ List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
+ SFileCloseFile hFile
End If
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize
- List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
+ SFileCloseArchive hMPQ
End If
End Sub
+Sub FileActionClick(mnuRoot As Menu, mnuItem, 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 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
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ SFileSetLocale LocaleID
+ 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, mnuRoot, mnuItem
+ If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
+ End If
+Next fNum
+SFileCloseArchive hMPQ
+StatBar.Style = 0
+StatBar.SimpleText = ""
+MousePointer = 0
+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
+Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long, hFile As Long
+If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then
L1 = AddedFile
- fSize = Mpq.SFileGetFileSize(hFile, 0)
- cSize = Mpq.SFileGetFileInfo(hFile, 6)
+ fSize = SFileGetFileSize(hFile, 0)
+ cSize = SFileGetFileInfo(hFile, 6)
If fSize / 1024 > 0 And fSize / 1024 < 1 Then
L2 = "<1KB"
ElseIf fSize = 0 Then
Else
L3 = "0%"
End If
- fFlags = Mpq.SFileGetFileInfo(hFile, 7)
+ fFlags = SFileGetFileInfo(hFile, 7)
+ L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)
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 + "-"
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(, , L6).Tag = L6
List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
- Mpq.SFileCloseFile hFile
+ SFileCloseFile hFile
End If
End Sub
Sub RemoveFromListing(RemovedFile As String)
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\")
+Sub ExecuteFile(FileName As String, Index As Integer, mnuRoot As Menu, mnuItem)
+Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String, RetVal As Long
+RetVal = ShellExecute(hWnd, mnuItem(Index).Tag, FileName, vbNullString, vbNullString, 1)
+If RetVal >= 0 And RetVal <= 32 And Index >= mnuRoot.Tag Then
+ Param = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + mnuItem(Index).Tag + "\command\")
Do
If InStr(Param, "%1") = 0 Then
Param = Param + " " + FileName
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
+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, hFile As Long, FileShortNames() As String, dwFlags As Long
CurPath = CurDir
If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
sLine = CmdLine
CD.FileName = FullPath(CurPath, Param(2))
End If
If Param(3) <> "" And FileExists(CD.FileName) = False And CD.FileName <> "" Then
- Mpq.DefaultMaxFiles = Param(3)
+ DefaultMaxFiles = Param(3)
End If
If FileExists(CD.FileName) Then
OpenMpq
If Param(2) <> "" Then
CD.FileName = FullPath(CurPath, Param(2))
If Param(3) <> "" Then
- Mpq.DefaultMaxFiles = Param(3)
+ DefaultMaxFiles = Param(3)
End If
If CD.FileName <> "" Then
ReDim FileList(0) As String
Files = ""
fEndLine = 0
fLine = ""
+ dwFlags = MAFA_REPLACE_EXISTING
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
For pNum = 3 To UBound(Param)
If LCase(Param(pNum)) = "/wav" Then
cType = 2
+ dwFlags = dwFlags Or MAFA_COMPRESS
ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
cType = 1
+ dwFlags = dwFlags Or MAFA_COMPRESS
ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then
cType = -1
ElseIf LCase(Param(pNum)) = "/r" Then
Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
List.Sorted = False
FileFilter = mFilter
- hMPQ = Mpq.mOpenMpq(CD.FileName)
+ hMPQ = mOpenMpq(CD.FileName)
If hMPQ = 0 Then
StatBar.SimpleText = "Can't create archive " + CD.FileName
Exit Sub
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
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
ElseIf cType = -1 Then
mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
ElseIf cType = 1 Then
- Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 1
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
Else
- Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 0
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
End If
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
mFilter.AddItem "*" + GetExtension(Param(3) + fLine)
End If
Else
If cType = 2 Then
- Mpq.mAddWavFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 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
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
Else
- Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
End If
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
mFilter.AddItem "*" + GetExtension(Param(3))
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
- Mpq.mCloseMpq hMPQ
+ MpqCloseUpdatedArchive hMPQ, 0
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
If UBound(FileShortNames) > 1 Then
- If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
StatBar.SimpleText = "Adding files to listing... 0% complete"
For pNum = 1 To UBound(FileShortNames)
If MatchesFilter(FileShortNames(pNum), FileFilter) Then
StatBar.SimpleText = "Adding files to listing... " + CStr(Int((pNum / UBound(FileShortNames)) * 100)) + "% complete"
On Error GoTo 0
Next pNum
- Mpq.SFileCloseArchive hMPQ
+ SFileCloseArchive hMPQ
End If
ElseIf UBound(FileShortNames) = 1 Then
AddToListing FileShortNames(1)
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
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
StatBar.SimpleText = "Can't open archive " + CD.FileName
Exit Sub
End If
fEndLine = InStr(pNum, Files, vbCrLf)
fLine = Mid(Files, pNum, fEndLine - pNum)
StatBar.SimpleText = "Extracting " + fLine + "..."
- Mpq.sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
+ sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
StatBar.SimpleText = StatBar.SimpleText + " Done"
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
- Mpq.SFileCloseArchive hMPQ
+ 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
+ If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
+ StatBar.SimpleText = "Can't open archive " + CD.FileName
+ Exit Sub
+ End If
+ sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
+ SFileCloseArchive hMPQ
StatBar.SimpleText = StatBar.SimpleText + " Done"
End If
MousePointer = 0
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
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ For pNum = 1 To Len(Files)
+ fEndLine = InStr(pNum, Files, vbCrLf)
+ fLine = Mid(Files, pNum, fEndLine - pNum)
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
+ StatBar.SimpleText = "Renaming " + fLine + " => " + fLine2 + "..."
+ If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, fLine2
+ MpqRenameFile hMPQ, fLine, fLine2
+ Else
+ MpqRenameFile hMPQ, fLine, fLine2
+ End If
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ RenameInListing fLine, fLine2
+ StatBar.SimpleText = StatBar.SimpleText + " Done"
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RenameInListing fLine, fLine2
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
+ End If
If fCount > 1 Then
StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " renamed"
End If
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)
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, Param(3)
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ Else
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ End If
+ MpqCloseUpdatedArchive hMPQ, 0
End If
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
RenameInListing Param(2), Param(3)
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
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ For pNum = 1 To Len(Files)
+ fEndLine = InStr(pNum, Files, vbCrLf)
+ fLine = Mid(Files, pNum, fEndLine - pNum)
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
+ StatBar.SimpleText = "Moving " + fLine + " => " + fLine2 + "..."
+ If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, fLine2
+ MpqRenameFile hMPQ, fLine, fLine2
+ Else
+ MpqRenameFile hMPQ, fLine, fLine2
+ End If
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ RenameInListing fLine, fLine2
+ StatBar.SimpleText = StatBar.SimpleText + " Done"
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RenameInListing fLine, fLine2
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
+ End If
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)
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hFile, Param(3)
+ MpqRenameFile hFile, Param(2), Param(3)
+ Else
+ MpqRenameFile hFile, Param(2), Param(3)
+ End If
+ MpqCloseUpdatedArchive hMPQ, 0
End If
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
RenameInListing Param(2), Param(3)
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
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ For pNum = 1 To Len(Files)
+ fEndLine = InStr(pNum, Files, vbCrLf)
+ fLine = Mid(Files, pNum, fEndLine - pNum)
+ StatBar.SimpleText = "Deleting " + fLine + "..."
+ MpqDeleteFile hMPQ, fLine
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ RemoveFromListing fLine
+ StatBar.SimpleText = StatBar.SimpleText + " Done"
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
- RemoveFromListing fLine
- StatBar.SimpleText = StatBar.SimpleText + " Done"
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
+ End If
If fCount > 1 Then
StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " deleted"
End If
Else
- Mpq.DelFile CD.FileName, Param(2)
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ MpqDeleteFile hMPQ, Param(2)
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
RemoveFromListing Param(2)
StatBar.SimpleText = StatBar.SimpleText + " Done"
If CD.FileName <> "" Then
MousePointer = 11
StatBar.SimpleText = "Flushing " + CD.FileName + "..."
- Mpq.CompactMpq CD.FileName
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ MpqCompactArchive hMPQ
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
StatBar.SimpleText = StatBar.SimpleText + " Done"
MousePointer = 0
Files = MpqDir(CD.FileName, Param(2))
Param(2) = Param(3)
Else
- Files = ListFiles(CD.FileName, ListFile)
+ Files = MpqDir(CD.FileName, "*")
End If
fNum = FreeFile
Open FullPath(CurPath, Param(2)) For Binary As #fNum
For Each TItem In mnuTItem
If TItem.Index <> 0 Then Unload TItem
Next TItem
+For Each TItem In mnuPTItem
+ If TItem.Index <> 0 Then Unload TItem
+Next TItem
mnuTItem(0).Caption = "(Empty)"
+mnuPTItem(0).Caption = mnuTItem(0).Caption
mnuTItem(0).Tag = ""
+mnuPTItem(0).Tag = ""
Do
ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))
ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))
If ToolName <> "" Then
On Error Resume Next
Load mnuTItem(tNum)
+ Load mnuPTItem(tNum)
On Error GoTo 0
mnuTItem(tNum).Tag = ToolCommand
+ mnuPTItem(tNum).Tag = mnuTItem(tNum).Tag
If InStr(ToolName, "&") = 0 And tNum < 9 Then
mnuTItem(tNum).Caption = "&" + CStr(tNum + 1) + " " + ToolName
ElseIf InStr(ToolName, "&") = 0 And tNum = 9 Then
Else
mnuTItem(tNum).Caption = ToolName
End If
+ mnuPTItem(tNum).Caption = mnuTItem(tNum).Caption
End If
tNum = tNum + 1
Loop Until ToolName = ""
End Sub
Sub OpenMpq()
-Dim Path, FileCont As String, bNum As Long, FileLine As String, nFiles As Long, LoadExtraInfo As Integer, MpqFileName As String, FileFilter As String, TItem As Menu, hMPQ As Long, hFile As Long
+Dim Path, FileCont As String, bNum As Long, FileLine As String, nFiles As Long, MpqFileName As String, FileFilter As String, TItem As Menu, hMPQ As Long, hFile As Long, FileEntries() As FILELISTENTRY
On Error Resume Next
If FileExists(CD.FileName) And FileLen(CD.FileName) = 0 Then
ReDim FileList(0) As String
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
+If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then
CD.FileName = ""
MsgBox "The MPQ archive could not be opened.", vbExclamation, "WinMPQ"
Exit Sub
If Mpq.FileExists(CD.FileName, "(listfile)") Then
FileCont = Mpq.GetFileEx(CD.FileName, "(listfile)", 0, -1)
#Else
- FileCont = sListFiles(CD.FileName, hMPQ, ListFile)
+ sListFiles CD.FileName, hMPQ, ListFile, FileEntries
#End If
For bNum = 1 To Len(FileCont)
If InStr(bNum, FileCont, vbCrLf) > 0 Then
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
+Dim fNum As Long, lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 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)
+For fNum = 0 To UBound(FileEntries)
#If InternalListing Then
If Mpq.FileExists(CD.FileName, FileList(fNum)) Then
#End If
- MpqFileName = FileList(fNum)
+ If FileEntries(fNum).dwFileExists Then
+ MpqFileName = StrConv(FileEntries(fNum).szFileName, vbUnicode)
+ StripNull MpqFileName
mFilter.AddItem "*" + GetExtension(MpqFileName)
For bNum = 1 To mFilter.ListCount - 1
If LCase(mFilter.List(bNum)) = LCase(mFilter.List(bNum - 1)) Then
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)
+ L1 = MpqFileName
+ fSize = FileEntries(fNum).dwFullSize
+ cSize = FileEntries(fNum).dwCompressedSize
If fSize / 1024 > 0 And fSize / 1024 < 1 Then
L2 = "<1KB"
ElseIf fSize = 0 Then
Else
L3 = "0%"
End If
- fFlags = Mpq.SFileGetFileInfo(hFile, 7)
+ fFlags = FileEntries(fNum).dwFlags
+ L6 = CStr(FileEntries(fNum).lcLocale)
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
+ lIndex = List.ListItems.Add(, , L1).Index
On Error GoTo 0
If lIndex = 0 Then
lIndex = List.ListItems.Item(L1).Index
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(, , L6).Tag = L6
List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5
- End If
+ 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"
+ StatBar.SimpleText = "Building list... " + CStr(Int((fNum / UBound(FileEntries)) * 100)) + "% complete"
On Error GoTo 0
Next fNum
-Mpq.SFileCloseArchive hMPQ
+SFileCloseArchive hMPQ
List.Sorted = True
-#If InternalListing Then
+'#If InternalListing Then
RemoveDuplicates
-#End If
+'#End If
On Error Resume Next
List.SelectedItem.Selected = False
On Error GoTo 0
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
+ If LCase(List.ListItems.Item(fNum).Tag) = LCase(List.ListItems.Item(fNum + 1).Tag) And List.ListItems.Item(fNum).ListSubItems(4).Tag = List.ListItems.Item(fNum + 1).ListSubItems(4).Tag Then
List.ListItems.Remove (fNum)
fNum = fNum - 1
End If
Loop
End Sub
Sub ShowSelected()
-Dim fNum As Long, nSelect As Long, sSize As Long, fSize As Long, L2 As String
+Dim fNum As Long, nSelect As Long, sSize As Long, fSize As Long, L2 As String, hMPQ As Long, hFile As Long
On Error GoTo NotSelected
List.SelectedItem.Tag = List.SelectedItem.Tag
On Error GoTo 0
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 SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+ If SFileOpenFileEx(hMPQ, List.ListItems.Item(fNum).Tag, 0, hFile) Then
+ fSize = SFileGetFileSize(hFile, 0)
+ SFileCloseFile hFile
+ End If
+ SFileCloseArchive hMPQ
+ End If
If fSize / 1024 > 0 And fSize / 1024 < 1 Then
L2 = "<1KB"
ElseIf fSize = 0 Then
txtCommand = ""
If StatBar.SimpleText = "" Then txtCommand_GotFocus
End Sub
+
+Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
+If KeyCode = vbKeyShift Then
+ ShiftState = True
+ BuildMpqActionList
+End If
+End Sub
+Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
+If KeyCode = vbKeyShift Then
+ ShiftState = False
+ BuildMpqActionList
+End If
+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
+Dim Path
+Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
+NewKey AppKey
+SetReg AppKey + "InstallPath", GetLongPath(App.Path), REG_SZ
+SetReg AppKey + "ProgramFilename", GetLongPath(Path + App.EXEName + ".exe"), REG_SZ
FixIcon hWnd, 1
InitFileDialog CD
CD.hwndOwner = hWnd
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
+'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
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)
+DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)
LocaleID = GetReg(AppKey + "LocaleID", 0)
+GlobalEncrypt = False
+DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)
+Select Case DefaultCompressID
+Case -3
+DefaultCompress = MAFA_COMPRESS_DEFLATE
+Case Else
+DefaultCompress = MAFA_COMPRESS_STANDARD
+End Select
+DefaultCompressLevel = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION)
BuildRecentFileList
BuildToolsList
On Error GoTo 0
-Mpq.SetLocale LocaleID
+SFileSetLocale LocaleID
ReDim GlobalFileList(0) As String
#If InternalListing Then
If FileExists(ListFile) Then
End Select
End If
End Sub
-
-
Private Sub Form_Resize()
On Error Resume Next
If WindowState <> 1 Then
txtCommand.SetFocus
End Sub
Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)
-Dim Result As Long
+Dim result As Long, hMPQ As Long, hFile As Long
If List.SelectedItem.Text <> NewString Then
If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- Result = vbYes
+ result = vbYes
Else
- Result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
+ result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
End If
- If Result = vbYes Then
+ 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
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ If SFileOpenFileEx(hMPQ, NewString, 0, hFile) Then
+ SFileCloseFile hFile
+ SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
+ MpqDeleteFile hMPQ, NewString
+ MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
+ SFileSetLocale LocaleID
+ RemoveDuplicates
+ Else
+ SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
+ MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
+ SFileSetLocale LocaleID
+ End If
+ MpqCloseUpdatedArchive hMPQ, 0
+ On Error Resume Next
+ List.SelectedItem.Key = NewString
+ On Error GoTo 0
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
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
List.SelectedItem.Selected = False
NotSelected:
ShowSelected
+BuildMpqActionList
End Sub
Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)
If List.SortKey = ColumnHeader.Index - 1 Then
ExtractPathNum = fNum
End If
Path = Path + CStr(ExtractPathNum) + "\"
-If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+If 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
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ SFileSetLocale LocaleID
If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
For bNum = 1 To UBound(OpenFiles)
If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
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
+ BuildPopup Path + fName, 0, mnuPopup, mnuPItem
+ ExecuteFile Path + fName, 0, mnuPopup, mnuPItem
If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
End If
Next fNum
-Mpq.SFileCloseArchive hMPQ
+SFileCloseArchive hMPQ
StatBar.Style = 0
StatBar.SimpleText = ""
MousePointer = 0
List.SelectedItem.Selected = False
NotSelected:
End Sub
+Private Sub List_ItemClick(ByVal Item As ListItem)
+BuildMpqActionList
+End Sub
Private Sub List_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then List_DblClick
End Sub
@@ -1853,22 +2094,22 @@ ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then
List.SelectedItem.Tag = List.SelectedItem.Tag
On Error GoTo 0
If List.SelectedItem.Selected = True Then
- BuildPopup List.SelectedItem.Tag, Shift
+ BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
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
+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
+ BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)
End If
NotClick:
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)
+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
+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, dwFlags As Long
If Data.GetFormat(ccCFFiles) <> True Then Exit Sub
For fNum = 1 To Data.Files.Count
Path = Data.Files.Item(fNum)
End If
Next bNum
FoldName.Show 1
+If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
If UBound(Files) > 1 Then
ReDim ShortFiles(UBound(Files)) As String
For bNum = 0 To UBound(Files)
End If
List.Sorted = False
FileFilter = mFilter
-hMPQ = Mpq.mOpenMpq(CD.FileName)
+hMPQ = mOpenMpq(CD.FileName)
If hMPQ = 0 Then
StatBar.SimpleText = "Can't create archive " + CD.FileName
Exit Sub
End If
+dwFlags = MAFA_REPLACE_EXISTING
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
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
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
ElseIf mnuMCStandard.Checked Then
- Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
+ ElseIf mnuMCDeflate.Checked Then
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
ElseIf mnuMCAMedium.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
ElseIf mnuMCAHighest.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
ElseIf mnuMCALowest.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 2
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
ElseIf mnuMCAuto.Checked Then
mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
End If
End If
Next cNum
Next bNum
-Mpq.mCloseMpq hMPQ
+MpqCloseUpdatedArchive hMPQ, 0
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
-If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+If 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
StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
On Error GoTo 0
Next bNum
- Mpq.SFileCloseArchive hMPQ
+ SFileCloseArchive hMPQ
End If
StatBar.Style = 0
StatBar.SimpleText = ""
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)
+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
Path = Path + CStr(CopyPathNum) + "\"
KillEx Path, "*", 6, True
fCount = 0
-If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+If 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
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ SFileSetLocale LocaleID
If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then
Data.Files.Add Path + List.ListItems.Item(fNum).Tag
End If
If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag
End If
Next fNum
-Mpq.SFileCloseArchive hMPQ
+SFileCloseArchive hMPQ
StatBar.Style = 0
StatBar.SimpleText = ""
MousePointer = 0
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.Filter = "All Files (*.*)|*.*"
OldFileName = CD.FileName
OldPath = CurDir
+CD.hwndOwner = hWnd
If ShowOpen(CD) = False Then GoTo Cancel
StatBar.Style = 1
StatBar.SimpleText = "Running script " + CD.FileName + "..."
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
+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, dwFlags As Long
CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2
CD.Filter = "All Files (*.*)|*.*"
OldFileName = CD.FileName
+CD.hwndOwner = hWnd
If ShowOpen(CD) = False Then GoTo Cancel
ReDim Files(0) As String
bNum = 1
Next bNum
CD.FileName = OldFileName
FoldName.Show 1
+If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
If UBound(Files) > 1 Then
ReDim ShortFiles(UBound(Files)) As String
For bNum = 0 To UBound(Files)
End If
List.Sorted = False
FileFilter = mFilter
-hMPQ = Mpq.mOpenMpq(CD.FileName)
+hMPQ = mOpenMpq(CD.FileName)
If hMPQ = 0 Then
StatBar.SimpleText = "Can't create archive " + CD.FileName
Exit Sub
End If
+dwFlags = MAFA_REPLACE_EXISTING
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
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
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
ElseIf mnuMCStandard.Checked Then
- Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
+ ElseIf mnuMCDeflate.Checked Then
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
ElseIf mnuMCAMedium.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
ElseIf mnuMCAHighest.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
ElseIf mnuMCALowest.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 2
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
ElseIf mnuMCAuto.Checked Then
mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
End If
End If
Next cNum
Next bNum
-Mpq.mCloseMpq hMPQ
+MpqCloseUpdatedArchive hMPQ, 0
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
-If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+If 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
StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
On Error GoTo 0
Next bNum
- Mpq.SFileCloseArchive hMPQ
+ SFileCloseArchive hMPQ
End If
StatBar.Style = 0
StatBar.SimpleText = ""
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
+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, dwFlags As Long
+PathInput.hwndOwner = hWnd
Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)
If Path = "" Then GoTo Cancel
FolderFiles = DirEx(Path, "*", 6, True)
End If
Next bNum
FoldName.Show 1
+If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
If UBound(Files) > 1 Then
ReDim ShortFiles(UBound(Files)) As String
For bNum = 0 To UBound(Files)
End If
List.Sorted = False
FileFilter = mFilter
-hMPQ = Mpq.mOpenMpq(CD.FileName)
+hMPQ = mOpenMpq(CD.FileName)
If hMPQ = 0 Then
StatBar.SimpleText = "Can't create archive " + CD.FileName
Exit Sub
End If
+dwFlags = MAFA_REPLACE_EXISTING
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
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
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
ElseIf mnuMCStandard.Checked Then
- Mpq.mAddFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
+ ElseIf mnuMCDeflate.Checked Then
+ MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
ElseIf mnuMCAMedium.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 0
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
ElseIf mnuMCAHighest.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 1
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
ElseIf mnuMCALowest.Checked Then
- Mpq.mAddWavFile hMPQ, Files(bNum), ShortFiles(bNum), 2
+ MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
ElseIf mnuMCAuto.Checked Then
mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
End If
End If
Next cNum
Next bNum
-Mpq.mCloseMpq hMPQ
+MpqCloseUpdatedArchive hMPQ, 0
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
-If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
+If 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
StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
On Error GoTo 0
Next bNum
- Mpq.SFileCloseArchive hMPQ
+ SFileCloseArchive hMPQ
End If
StatBar.Style = 0
StatBar.SimpleText = ""
ShowTotal
Cancel:
End Sub
+
+Private Sub mnuMAddToList_Click()
+frmAddToList.Show 1
+End Sub
Private Sub mnuMCAHighest_Click()
mnuMCNone.Checked = False
mnuMCStandard.Checked = False
+mnuMCDeflate.Checked = False
mnuMCALowest.Checked = False
mnuMCAMedium.Checked = False
mnuMCAHighest.Checked = True
Private Sub mnuMCALowest_Click()
mnuMCNone.Checked = False
mnuMCStandard.Checked = False
+mnuMCDeflate.Checked = False
mnuMCALowest.Checked = True
mnuMCAMedium.Checked = False
mnuMCAHighest.Checked = False
Private Sub mnuMCAMedium_Click()
mnuMCNone.Checked = False
mnuMCStandard.Checked = False
+mnuMCDeflate.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
+mnuMCDeflate.Checked = False
mnuMCALowest.Checked = False
mnuMCAMedium.Checked = False
mnuMCAHighest.Checked = False
mnuMCAuto.Checked = True
End Sub
+Private Sub mnuMCDeflate_Click()
+mnuMCNone.Checked = False
+mnuMCStandard.Checked = False
+mnuMCDeflate.Checked = True
+mnuMCALowest.Checked = False
+mnuMCAMedium.Checked = False
+mnuMCAHighest.Checked = False
+mnuMCAuto.Checked = False
+End Sub
+
+
+Private Sub mnuMChLCID_Click()
+Dim fNum 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:
+ChLCID.Show 1
+Exit Sub
+NotSelected:
+MsgBox "No files are selected.", , "WinMPQ"
+End Sub
Private Sub mnuMCNone_Click()
mnuMCNone.Checked = True
mnuMCStandard.Checked = False
+mnuMCDeflate.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
+Dim fNum As Long, result As Long, hMPQ As Long
If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- Result = vbYes
+ 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")
+ 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
+If result = vbYes Then
StatBar.Style = 1
StatBar.SimpleText = "Compacting " + CD.FileName + "..."
MousePointer = 11
- Mpq.CompactMpq CD.FileName
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ MpqCompactArchive hMPQ
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
StatBar.Style = 0
StatBar.SimpleText = ""
Private Sub mnuMCStandard_Click()
mnuMCNone.Checked = False
mnuMCStandard.Checked = True
+mnuMCDeflate.Checked = False
mnuMCALowest.Checked = False
mnuMCAMedium.Checked = False
mnuMCAHighest.Checked = False
+mnuMCAuto.Checked = False
End Sub
Private Sub mnuMDelete_Click()
-Dim fNum As Long, Result As Long
+Dim fNum As Long, result As Long, hMPQ As Long
On Error GoTo NotSelected
List.SelectedItem.Tag = List.SelectedItem.Tag
On Error GoTo 0
GoTo NotSelected
FileSelected:
If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- Result = vbYes
+ result = vbYes
Else
- Result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
+ result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
End If
- If Result = vbYes Then
+ 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
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ 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
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
+ MpqDeleteFile hMPQ, List.ListItems.Item(fNum).Tag
+ SFileSetLocale LocaleID
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ List.ListItems.Remove (fNum)
+ fNum = fNum - 1
+ End If
+ fNum = fNum + 1
+ Loop
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
End If
StatBar.Style = 0
StatBar.SimpleText = ""
NotSelected:
MsgBox "No files are selected.", , "WinMPQ"
End Sub
+Private Sub mnuMEncrypt_Click()
+If mnuMEncrypt.Checked = False Then
+ mnuMEncrypt.Checked = True
+ GlobalEncrypt = True
+Else
+ mnuMEncrypt.Checked = False
+ GlobalEncrypt = False
+End If
+End Sub
Private Sub mnuMExtract_Click()
-Dim fNum As Long, Path As String, Result As Long, hMPQ As Long
+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
Next fNum
GoTo NotSelected
FileSelected:
+PathInput.hwndOwner = hWnd
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
+If 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
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ SFileSetLocale LocaleID
End If
Next fNum
-Mpq.SFileCloseArchive hMPQ
+SFileCloseArchive hMPQ
StatBar.Style = 0
StatBar.SimpleText = ""
MousePointer = 0
Exit Sub
NotSelected:
If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
- Result = vbYes
+ result = vbYes
Else
- Result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
+ result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
End If
-If Result = vbYes Then
+If result = vbYes Then
+ PathInput.hwndOwner = hWnd
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
+ If 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
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ SFileSetLocale LocaleID
Next fNum
- Mpq.SFileCloseArchive hMPQ
+ SFileCloseArchive hMPQ
StatBar.Style = 0
StatBar.SimpleText = ""
MousePointer = 0
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 (*.*)|*.*"
+CD.hwndOwner = hWnd
If ShowSave(CD) = False Then GoTo Cancel
ReDim FileList(0) As String
List.ListItems.Clear
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
+CD.hwndOwner = hWnd
If ShowOpen(CD) = False Then GoTo Cancel
OpenMpq
If CD.FileName = "" Then CD.FileName = OldFileName
Cancel:
End Sub
+Private Sub mnuMItem_Click(Index As Integer)
+FileActionClick mnuMpq, mnuMItem, Index
+End Sub
Private Sub mnuMRename_Click()
List.StartLabelEdit
End Sub
CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"
OldFileName = CD.FileName
CD.FileName = CD.FileName + ".txt"
+CD.hwndOwner = hWnd
If ShowSave(CD) = False Then GoTo Cancel
StatBar.Style = 1
StatBar.SimpleText = "Creating list..."
Private Sub mnuOptions_Click()
Options.Show 1
End Sub
+
+Private Sub mnuPChLCID_Click()
+mnuMChLCID_Click
+End Sub
Private Sub mnuPDelete_Click()
mnuMDelete_Click
End Sub
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
+FileActionClick mnuPopup, mnuPItem, Index
End Sub
Private Sub mnuPRename_Click()
mnuMRename_Click
End Sub
-
+Private Sub mnuPTItem_Click(Index As Integer)
+mnuTItem_Click Index
+End Sub
Private Sub mnuTAdd_Click()
ToolList.Show 1
BuildToolsList
@@ -2668,13 +2958,15 @@ If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1
ExtractPathNum = fNum
End If
Path = Path + CStr(ExtractPathNum) + "\"
- If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
+ If 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
+ SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
+ sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
+ SFileSetLocale LocaleID
If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
For bNum = 1 To UBound(OpenFiles)
If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
@@ -2721,7 +3013,7 @@ If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1
If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
End If
Next fNum
- Mpq.SFileCloseArchive hMPQ
+ SFileCloseArchive hMPQ
ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then
If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
On Error GoTo NoProgram
NoProgram:
If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
End Sub
+
+Private Sub mnuTMpqEmbed_Click()
+frmMpq.Show
+End Sub
Private Sub Timer1_Timer()
-Dim fNum As Long, Path As String, Result As Long, bNum As Long
+Dim fNum As Long, Path As String, result As Long, bNum As Long, hMPQ As Long, dwFlags As Long
If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub
Path = App.Path
If Right(Path, 1) <> "\" Then Path = Path + "\"
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
+ 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")
+ 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)
+ If FileExists(FullPath(Path, OpenFiles(fNum))) Then
+ OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))
+ If result = vbYes Then
+ List.Sorted = False
+ StatBar.Style = 1
+ StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."
+ MousePointer = 11
+ dwFlags = MAFA_REPLACE_EXISTING
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
+ hMPQ = mOpenMpq(CD.FileName)
+ If hMPQ Then
+ If mnuMCNone.Checked Then
+ MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags, 0, 0
+ ElseIf mnuMCStandard.Checked Then
+ MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
+ ElseIf mnuMCDeflate.Checked Then
+ MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
+ ElseIf mnuMCAMedium.Checked Then
+ MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 0
+ ElseIf mnuMCAHighest.Checked Then
+ MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 1
+ ElseIf mnuMCALowest.Checked Then
+ MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 2
+ ElseIf mnuMCAuto.Checked Then
+ mAddAutoFile hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)
+ End If
+ End If
+ MpqAddToListing hMPQ, OpenFiles(fNum)
+ MpqCloseUpdatedArchive hMPQ, 0
+ If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
+ StatBar.Style = 0
+ StatBar.SimpleText = ""
+ MousePointer = 0
+ List.Sorted = True
+ RemoveDuplicates
+ ShowTotal
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