From: ShadowFlare Date: Fri, 10 Jul 2009 05:37:14 +0000 (-0600) Subject: 1.62 X-Git-Url: https://sfsrealm.hopto.org/projects/?a=commitdiff_plain;h=62046253535cb1df0280f7e331d2f76b0fbf2d17;p=WinMPQ.git 1.62 ---- - 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. --- diff --git a/About.frm b/About.frm index 3a500b8..b74fc14 100644 --- a/About.frm +++ b/About.frm @@ -1,30 +1,22 @@ 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 @@ -34,6 +26,15 @@ Begin VB.Form About 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 @@ -50,7 +51,7 @@ Begin VB.Form About ForeColor = &H00FF0000& Height = 210 Left = 120 - TabIndex = 5 + TabIndex = 4 Top = 1080 Width = 2280 End @@ -77,12 +78,12 @@ Begin VB.Form About 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 @@ -116,82 +117,94 @@ End Function Private Sub Command1_Click() Unload Me End Sub - -Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) -Label3.ForeColor = &HFF0000 -Label3.Font.underline = False -Label4.ForeColor = &HFF0000 -Label4.Font.underline = False -End Sub -Private Sub Command2_Click() -MpqEx.Mpq.AboutBox -End Sub - - -Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) +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 new file mode 100644 index 0000000..e940916 --- /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 new file mode 100644 index 0000000..b20c2b6 Binary files /dev/null and b/ChLCID.frx differ diff --git a/EditTItem.frm b/EditTItem.frm index 7df3812..44c06fe 100644 --- a/EditTItem.frm +++ b/EditTItem.frm @@ -113,6 +113,7 @@ If Mid(App.Path, 2, 1) = ":" Then 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 index 7701ef9..d097eaf 100644 --- a/FileDialog.bas +++ b/FileDialog.bas @@ -107,6 +107,13 @@ For cNum = 1 To Len(TextStr) 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)) @@ -165,8 +172,13 @@ If Len(lpFileDialog.FileTitle) <= lpFileDialog.MaxFileTitleSize Then _ 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 index a395a36..d9c3660 100644 --- a/FixIcon.bas +++ b/FixIcon.bas @@ -38,5 +38,5 @@ ElseIf VarType(lpszName) = vbByte Or VarType(lpszName) = vbInteger Or VarType(lp 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 index 414ab77..76711d4 100644 --- a/FoldName.frm +++ b/FoldName.frm @@ -65,13 +65,12 @@ Attribute VB_Name = "FoldName" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit - Private Sub Command1_Click() AddFolderName = Text1 Unload Me End Sub Private Sub Command2_Click() -AddFolderName = "" +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 index 4250465..2e83bae 100644 --- a/MpqStuff.bas +++ b/MpqStuff.bas @@ -15,7 +15,7 @@ Public Declare Sub SHChangeNotify Lib _ 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, _ @@ -28,7 +28,7 @@ Private Declare Sub CopyMemory Lib "Kernel32.dll" _ 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 @@ -39,12 +39,31 @@ Public Const SHCNF_IDLIST As Long = &H0 Public Const WM_SETREDRAW As Long = &HB Public Const WM_PAINT As Long = &HF Const gintMAX_SIZE% = 255 +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 @@ -57,40 +76,6 @@ Function GetLongPath(Path As String) As String 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 @@ -107,95 +92,54 @@ If InStr(FileName, "\") > 0 Then 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) @@ -207,7 +151,7 @@ Else 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 @@ -216,29 +160,47 @@ Else 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 @@ -254,29 +216,38 @@ Else 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, ".") @@ -291,22 +262,35 @@ Else 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 @@ -392,35 +376,11 @@ NoFile: FileExists = False End Function Function IsMPQ(MpqFile As String) As Boolean -Dim fNum As Long, Text As String, bNum As Long, MpqHead As Long -If FileExists(MpqFile) = False Then +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 @@ -592,23 +552,32 @@ Loop RenameWithFilter = NewFileName End Function Function MpqDir(MpqFile As String, Filters As String) -Dim Files As String, bNum As Long, EndLine As Long, fName As String -Files = ListFiles(MpqFile, ListFile) -bNum = 1 -Do Until bNum > Len(Files) - EndLine = InStr(bNum, Files, vbCrLf) - If EndLine = 0 Then EndLine = Len(Files) + 1 - fName = Mid(Files, bNum, EndLine - bNum) - If MatchesFilter(fName, Filters) Then - bNum = EndLine + 2 +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 @@ -634,7 +603,7 @@ CurPath = CurDir 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) @@ -665,7 +634,7 @@ For bNum = 1 To Len(Script) 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 @@ -680,7 +649,7 @@ For bNum = 1 To Len(Script) 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 @@ -706,11 +675,15 @@ For bNum = 1 To Len(Script) 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 @@ -738,7 +711,7 @@ For bNum = 1 To Len(Script) 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 @@ -761,23 +734,23 @@ For bNum = 1 To Len(Script) 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 @@ -785,7 +758,7 @@ For bNum = 1 To Len(Script) 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 @@ -810,7 +783,7 @@ For bNum = 1 To Len(Script) 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 @@ -821,18 +794,23 @@ For bNum = 1 To Len(Script) 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 @@ -848,24 +826,29 @@ For bNum = 1 To Len(Script) 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 @@ -873,11 +856,16 @@ For bNum = 1 To Len(Script) 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 @@ -903,33 +891,43 @@ For bNum = 1 To Len(Script) 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 @@ -945,23 +943,31 @@ For bNum = 1 To Len(Script) 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 @@ -973,7 +979,11 @@ For bNum = 1 To Len(Script) 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 @@ -986,7 +996,7 @@ For bNum = 1 To Len(Script) 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 @@ -1049,7 +1059,7 @@ CommandError: 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 @@ -1064,35 +1074,37 @@ On Error GoTo 0 SBytes = Mid(StrConv(buffer, vbUnicode), Start + 1, Length) End Function Function FindMpqHeader(MpqFile As String) As Long -Dim fNum As Long, Text As String, bNum As Long, MpqHead As Long -If FileExists(MpqFile) = False Then - FindMpqHeader = -1 - Exit Function -End If -fNum = FreeFile -Open MpqFile For Binary As #fNum -For bNum = 1 To LOF(fNum) Step 2 ^ 20 - Text = String(2 ^ 20 + 32, Chr(0)) - If LOF(fNum) - bNum + 1 >= 2 ^ 20 + 32 Then - Get #fNum, bNum, Text - Else - Text = String(LOF(fNum) - bNum + 1, Chr(0)) - Get #fNum, bNum, Text + 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 index 03f6dd6..a5ee29a 100644 --- a/Options.frm +++ b/Options.frm @@ -41,14 +41,15 @@ Begin VB.Form Options 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 @@ -56,7 +57,7 @@ Begin VB.Form Options Begin VB.TextBox Text2 Height = 285 Left = 0 - TabIndex = 8 + TabIndex = 4 Text = "0" Top = 1200 Width = 1215 @@ -65,7 +66,7 @@ Begin VB.Form Options Caption = "&Associate WinMPQ with MPQ Archives" Height = 255 Left = 0 - TabIndex = 7 + TabIndex = 5 Top = 1680 Value = 2 'Grayed Width = 3375 @@ -74,7 +75,7 @@ Begin VB.Form Options Caption = "Use &wildcards in filenames for drag and drop" Height = 255 Left = 0 - TabIndex = 6 + TabIndex = 7 Top = 2400 Value = 2 'Grayed Width = 3735 @@ -83,44 +84,35 @@ Begin VB.Form Options 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 @@ -132,15 +124,24 @@ Begin VB.Form Options 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 @@ -149,7 +150,7 @@ Begin VB.Form Options Caption = "Use file lists for similarly named archives" Height = 195 Left = 0 - TabIndex = 48 + TabIndex = 12 Top = 2640 Width = 3375 End @@ -157,14 +158,14 @@ Begin VB.Form Options 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 @@ -172,15 +173,15 @@ Begin VB.Form Options 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 @@ -189,7 +190,7 @@ Begin VB.Form Options Caption = "File Lists:" Height = 195 Left = 0 - TabIndex = 46 + TabIndex = 50 Top = 120 Width = 645 End @@ -201,7 +202,8 @@ Begin VB.Form Options Left = 240 ScaleHeight = 3495 ScaleWidth = 4935 - TabIndex = 13 + TabIndex = 38 + TabStop = 0 'False Top = 480 Visible = 0 'False Width = 4935 @@ -209,7 +211,7 @@ Begin VB.Form Options Caption = "&Reset size/position" Height = 375 Left = 360 - TabIndex = 22 + TabIndex = 16 Top = 840 Width = 1695 End @@ -217,7 +219,7 @@ Begin VB.Form Options Caption = "Display &confirmation boxes" Height = 255 Left = 0 - TabIndex = 21 + TabIndex = 14 Top = 120 Value = 2 'Grayed Width = 2415 @@ -226,7 +228,7 @@ Begin VB.Form Options Caption = "&Save last window size and position" Height = 255 Left = 0 - TabIndex = 20 + TabIndex = 15 Top = 480 Value = 2 'Grayed Width = 3015 @@ -235,7 +237,7 @@ Begin VB.Form Options Caption = "Startup Path" Height = 1215 Left = 0 - TabIndex = 14 + TabIndex = 39 Top = 2280 Width = 4935 Begin VB.OptionButton Option1 @@ -243,7 +245,7 @@ Begin VB.Form Options Height = 255 Index = 0 Left = 120 - TabIndex = 19 + TabIndex = 17 Top = 240 Value = -1 'True Width = 1575 @@ -262,7 +264,7 @@ Begin VB.Form Options Height = 255 Index = 2 Left = 120 - TabIndex = 17 + TabIndex = 19 Top = 480 Width = 1695 End @@ -270,7 +272,7 @@ Begin VB.Form Options Enabled = 0 'False Height = 285 Left = 120 - TabIndex = 16 + TabIndex = 20 Top = 840 Width = 3615 End @@ -279,7 +281,7 @@ Begin VB.Form Options Enabled = 0 'False Height = 285 Left = 3840 - TabIndex = 15 + TabIndex = 21 Top = 840 Width = 975 End @@ -292,7 +294,8 @@ Begin VB.Form Options Left = 240 ScaleHeight = 3495 ScaleWidth = 4935 - TabIndex = 26 + TabIndex = 42 + TabStop = 0 'False Top = 480 Visible = 0 'False Width = 4935 @@ -300,14 +303,14 @@ Begin VB.Form Options 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 @@ -334,7 +337,7 @@ Begin VB.Form Options Caption = "File extensions:" Height = 195 Left = 3120 - TabIndex = 42 + TabIndex = 49 Top = 960 Width = 1080 End @@ -343,14 +346,14 @@ Begin VB.Form Options 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 @@ -359,7 +362,7 @@ Begin VB.Form Options Caption = $"Options.frx":00F6 Height = 855 Left = 0 - TabIndex = 39 + TabIndex = 46 Top = 120 Width = 4935 WordWrap = -1 'True @@ -372,24 +375,45 @@ Begin VB.Form Options 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 @@ -397,7 +421,7 @@ Begin VB.Form Options Caption = "&Add" Height = 285 Left = 960 - TabIndex = 33 + TabIndex = 25 Top = 360 Width = 615 End @@ -405,18 +429,18 @@ Begin VB.Form Options 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 @@ -424,7 +448,7 @@ Begin VB.Form Options Caption = "Audio Compression" Height = 1335 Left = 1800 - TabIndex = 27 + TabIndex = 43 Top = 1200 Visible = 0 'False Width = 2535 @@ -443,7 +467,7 @@ Begin VB.Form Options Height = 255 Index = 1 Left = 120 - TabIndex = 29 + TabIndex = 31 Top = 960 Width = 2175 End @@ -452,16 +476,34 @@ Begin VB.Form Options 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 @@ -469,7 +511,7 @@ Begin VB.Form Options Caption = "File Extension" Height = 255 Left = 0 - TabIndex = 36 + TabIndex = 44 Top = 120 Width = 1215 End @@ -522,12 +564,12 @@ Private Sub Check8_Click() 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 @@ -536,10 +578,29 @@ If Text4 <> "" Then 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 @@ -567,26 +628,30 @@ If FileLists.ListIndex > -1 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 @@ -607,21 +672,17 @@ End Sub Private Sub Check5_Click() If Check5.Value = 1 Then Check5.Value = 2 End Sub - -Private Sub Check6_Click() -If Check6.Value = 1 Then Check6.Value = 2 -End Sub Private Sub Command1_Click() Dim Path As String, BatKey As String -Dim eNum As Integer, ExtList As String +Dim 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 @@ -646,11 +707,6 @@ Else SetReg AppKey + "CheckModDateTime", 0, REG_DWORD MpqEx.Timer1.Enabled = False End If -If Check6.Value > 0 Then - SetReg AppKey + "LoadExtraInfo", 1, REG_DWORD -Else - SetReg AppKey + "LoadExtraInfo", 0, REG_DWORD -End If If Check7.Value > 0 Then SetReg AppKey + "AutofindFileLists", 1, REG_DWORD Else @@ -709,12 +765,23 @@ If IsDir(Path) Then SetReg AppKey + "StartupPath", Text3 ChDir Text3 End If +Select Case Combo2.ListIndex +Case 0 +DefaultCompressID = -1 +DefaultCompress = MAFA_COMPRESS_STANDARD +Case 1 +DefaultCompressID = -3 +DefaultCompress = MAFA_COMPRESS_DEFLATE +End Select +DefaultCompressLevel = Combo3.ListIndex - 1 +SetReg AppKey + "DefaultCompress", DefaultCompressID, REG_DWORD +SetReg AppKey + "DefaultZlibLevel", DefaultCompressLevel, REG_DWORD DelKey AppKey + "Compression\" NewKey AppKey + "Compression\" -For 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 @@ -745,24 +812,23 @@ DelReg AppKey + "Status\WindowTop" DelReg AppKey + "Status\WindowWidth" Check1.Value = 0 End Sub - Private Sub Command5_Click() Dim Path As String +PathInput.hwndOwner = hWnd Path = PathInputBox(PathInput, "WinMPQ Startup Path", Text3) If Path <> "" Then Text3 = Path End Sub - Private Sub Command6_Click() -Dim 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 @@ -773,7 +839,8 @@ End Sub Private Sub Form_Load() Dim Path As String, PathType As Integer, NewFileListNames As String Dim ExtList As String -Dim aExt As String, aName As String, aNum As Long +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 @@ -782,7 +849,7 @@ If Top < 0 Then Top = 0 If Top + Height > Screen.Height Then Top = Screen.Height - Height Path = App.Path If Right(Path, 1) <> "\" Then Path = Path + "\" -Text1 = MpqEx.Mpq.DefaultMaxFiles +Text1 = DefaultMaxFiles Text2 = LocaleID OldFileName = CD.FileName CD.FileName = "" @@ -790,14 +857,14 @@ NewListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt") For aNum = 1 To Len(NewListFile) If InStr(aNum, NewListFile, vbCrLf) Then aName = Mid(NewListFile, aNum, InStr(aNum, NewListFile, vbCrLf) - aNum) - If FileExists(aName) Then + 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 @@ -827,7 +893,15 @@ End If 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 @@ -843,6 +917,12 @@ Do 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 @@ -857,7 +937,7 @@ Do 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 = "" @@ -879,22 +959,25 @@ CD.FileName = OldFileName 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 @@ -927,8 +1010,8 @@ If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0 End Sub Private Sub Text1_LostFocus() If Text1 = "" Then Text1 = 0 -If Text1 < 16 Then Text1 = 16 -If Text1 > 262144 Then Text1 = 262144 +'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 @@ -943,11 +1026,9 @@ End Sub Private Sub Text2_LostFocus() If Text2 = "" Then Text2 = 0 End Sub - Private Sub Text4_GotFocus() cmdAdd.Default = True End Sub - Private Sub Text4_LostFocus() Command1.Default = True End Sub diff --git a/Options.frx b/Options.frx index 3bb0d84..ea0726e 100644 Binary files a/Options.frx and b/Options.frx differ diff --git a/SFmpqapi.bas b/SFmpqapi.bas new file mode 100644 index 0000000..75ec087 --- /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 index 2f31502..b80d853 100644 --- a/WINMPQ.VBP +++ b/WINMPQ.VBP @@ -3,13 +3,16 @@ Module=MpqStuff; MpqStuff.bas 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 @@ -23,11 +26,11 @@ HelpContextID="0" 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 index 0000000..f66ac93 Binary files /dev/null and b/WMpqEmbed.rtf differ diff --git a/WinMPQ.rtf b/WinMPQ.rtf index 6ba328d..416f852 100644 --- a/WinMPQ.rtf +++ b/WinMPQ.rtf @@ -1,14 +1,14 @@ {\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fprq2 Arial;}{\f1\fswiss\fprq2\fcharset0 Arial;}{\f2\fmodern\fprq1 Courier New;}{\f3\fnil\fcharset2 Symbol;}} {\colortbl ;\red0\green0\blue0;} -\viewkind4\uc1\pard\b\f0\fs36 WinMPQ v1.\f1 54\b0\f0\fs20\par +\viewkind4\uc1\pard\b\f0\fs36 WinMPQ v1.\f1 62\b0\f0\fs20\par \par -\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 +\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 \pard\par \ul\b\fs24 Required Files (all may be downloaded from my page)\ulnone\b0\fs20\par \par \pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720 Visual Basic 4 runtime libraries\par {\pntext\f3\'B7\tab}Microsoft Windows Common Controls\par -{\pntext\f3\'B7\tab}Mpq Control and its required files\par +\f1{\pntext\f3\'B7\tab}SFmpq (included)\f0\par \pard\par \ul\b\fs24 Mo'PaQ 2000 parameters and scripts in WinMPQ\ulnone\b0\fs20\par \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 @@ -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 \par \pard\cf0\ul\b\fs24 Locale ID\ulnone\b0\fs20\par -\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 +\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 \pard\par \pard\li720\tx3600 0\tab Language Neutral/English\par 1031 (407 in hex)\tab German\par @@ -152,6 +152,26 @@ NOTE: Each file that a MoPaQ can hold (the FileLimit) takes up 16 bytes in the M \pard\par \ul\b\fs24 Version history\ulnone\b0\fs20\par \par +\ul\b 1.\f1 62\f0 __________\par +\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 +\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 +\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 +\pard\par +\ul\b 1.\f1 61\f0 __________\par +\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 +\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 +\f1{\pntext\f3\'B7\tab}Mpq Embedder is now included with WinMPQ. Access it from the "Tools" menu.\f0\par +\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 +\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 +\f1{\pntext\f3\'B7\tab}The default compression type can be changed now, and the compression level for deflate compression can set.\f0\par +\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 +\f1{\pntext\f3\'B7\tab}Added a menu command to change the locale ID of an existing file.\f0\par +\pard\par +\ul\b 1.\f1 60\f0 __________\par +\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 +\f1{\pntext\f3\'B7\tab}Added support for adding files with Warcraft III's new compression method.\f0\par +\f1{\pntext\f3\'B7\tab}File encryption can now be enabled or disabled through the "Mpq" menu.\f0\par +\pard\par \ul\b 1.\f1 54\f0 __________\par \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 \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 diff --git a/frmAddToList.frm b/frmAddToList.frm new file mode 100644 index 0000000..6741c90 --- /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 index 0000000..b20c2b6 Binary files /dev/null and b/frmAddToList.frx differ diff --git a/frmMpq.frm b/frmMpq.frm new file mode 100644 index 0000000..95384d5 --- /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 new file mode 100644 index 0000000..d36606e Binary files /dev/null and b/frmMpq.frx differ diff --git a/listing.frm b/listing.frm index fe9f43d..9b51f3f 100644 --- a/listing.frm +++ b/listing.frm @@ -7,6 +7,7 @@ Begin VB.Form MpqEx ClientWidth = 6690 Height = 4200 Icon = "listing.frx":0000 + KeyPreview = -1 'True Left = 1185 LinkTopic = "Form1" ScaleHeight = 3510 @@ -15,7 +16,7 @@ Begin VB.Form MpqEx Width = 6810 Begin VB.Timer Timer1 Enabled = 0 'False - Interval = 5000 + Interval = 2500 Left = 6120 Top = 2160 End @@ -204,7 +205,7 @@ Begin VB.Form MpqEx EndProperty OLEDragMode = 1 OLEDropMode = 1 - NumItems = 5 + NumItems = 6 BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} Key = "N" Text = "Name" @@ -233,20 +234,17 @@ Begin VB.Form MpqEx 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 @@ -280,6 +278,34 @@ Begin VB.Form MpqEx 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 @@ -306,6 +332,10 @@ Begin VB.Form MpqEx Caption = "&Standard" Shortcut = {F3} End + Begin VB.Menu mnuMCDeflate + Caption = "&Deflate" + Shortcut = {F9} + End Begin VB.Menu mnuMCAudio Caption = "&Audio" Begin VB.Menu mnuMCALowest @@ -322,22 +352,17 @@ Begin VB.Form MpqEx 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 @@ -353,6 +378,12 @@ Begin VB.Form MpqEx 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 @@ -380,7 +411,17 @@ Begin VB.Form MpqEx 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 @@ -392,6 +433,9 @@ Begin VB.Form MpqEx Begin VB.Menu mnuPRename Caption = "Rena&me" End + Begin VB.Menu mnuPChLCID + Caption = "Change Locale &ID..." + End End End Attribute VB_Name = "MpqEx" @@ -399,7 +443,7 @@ Attribute VB_Creatable = False 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 @@ -432,10 +476,33 @@ If fNum = 0 Then 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 @@ -458,12 +525,12 @@ Else 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 @@ -474,12 +541,12 @@ 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 @@ -492,15 +559,15 @@ 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 @@ -511,18 +578,18 @@ End If 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 @@ -531,14 +598,14 @@ AddUnknown: 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 @@ -546,6 +613,31 @@ AddUnknown: 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 @@ -560,58 +652,113 @@ Next bNum BuildRecentFileList End Sub Sub AddToListing(AddedFile As String) -Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long -If Mpq.FileExists(CD.FileName, AddedFile) Then - L1 = AddedFile - fSize = Mpq.FileSize(CD.FileName, AddedFile) - cSize = Mpq.GetFileInfo(CD.FileName, AddedFile, 6) - If fSize / 1024 > 0 And fSize / 1024 < 1 Then - L2 = "<1KB" - ElseIf fSize = 0 Then - L2 = "0KB" - Else - L2 = CStr(Int(fSize / 1024)) + "KB" - End If - If cSize / 1024 > 0 And cSize / 1024 < 1 Then - L4 = "<1KB" - ElseIf cSize = 0 Then - L4 = "0KB" - Else - L4 = CStr(Int(cSize / 1024)) + "KB" - End If - If fSize <> 0 Then - L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%" - Else - L3 = "0%" - End If - fFlags = Mpq.GetFileInfo(CD.FileName, AddedFile, 7) - If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-" - If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-" - If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-" - On Error Resume Next - lIndex = List.ListItems.Add(, L1, L1).Index - On Error GoTo 0 - If lIndex = 0 Then - lIndex = List.ListItems.Item(L1).Index - List.ListItems.Item(L1).ListSubItems.Clear - End If - List.ListItems.Item(lIndex).Tag = L1 - List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize - If fSize <> 0 Then - List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100) - Else - List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0 +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 @@ -631,7 +778,8 @@ If Mpq.SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) 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 + "-" @@ -650,8 +798,9 @@ If Mpq.SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then 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) @@ -694,12 +843,11 @@ For lIndex = 1 To List.ListItems.Count 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 @@ -731,7 +879,7 @@ NoProgram: If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ" End Sub Sub RunMpq2kCommand(CmdLine As String) -Dim sLine As String, pNum As Long, Param() As String, EndParam As Long, CurPath As String, cType As Integer, Rswitch As Boolean, fCount As Long, Files As String, fEndLine As Long, fLine As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String, TItem As Menu, fLine2 As String, fLineTitle As String, hMPQ As Long, FileShortNames() As String +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 @@ -764,7 +912,7 @@ If sLine <> "" Then CD.FileName = FullPath(CurPath, Param(2)) End If If Param(3) <> "" And FileExists(CD.FileName) = False And CD.FileName <> "" Then - Mpq.DefaultMaxFiles = Param(3) + DefaultMaxFiles = Param(3) End If If FileExists(CD.FileName) Then OpenMpq @@ -810,7 +958,7 @@ If sLine <> "" Then 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 @@ -857,11 +1005,15 @@ If sLine <> "" Then 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 @@ -892,7 +1044,7 @@ If sLine <> "" 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 @@ -912,13 +1064,13 @@ If sLine <> "" Then 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) @@ -934,13 +1086,13 @@ If sLine <> "" Then 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)) @@ -959,10 +1111,10 @@ If sLine <> "" Then 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 @@ -972,7 +1124,7 @@ If sLine <> "" 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) @@ -1010,7 +1162,7 @@ If sLine <> "" Then MousePointer = 11 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then Files = MpqDir(CD.FileName, Param(2)) - If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then + If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then StatBar.SimpleText = "Can't open archive " + CD.FileName Exit Sub End If @@ -1018,17 +1170,22 @@ If sLine <> "" Then 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 @@ -1045,23 +1202,29 @@ If sLine <> "" Then If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then Files = MpqDir(CD.FileName, Param(2)) - For pNum = 1 To Len(Files) - fEndLine = InStr(pNum, Files, vbCrLf) - fLine = Mid(Files, pNum, fEndLine - pNum) - fLine2 = RenameWithFilter(fLine, Param(2), Param(3)) - StatBar.SimpleText = "Renaming " + fLine + " => " + fLine2 + "..." - If Mpq.FileExists(CD.FileName, fLine2) Then - Mpq.DelFile CD.FileName, fLine2 - Mpq.RenFile CD.FileName, fLine, fLine2 - Else - Mpq.RenFile CD.FileName, fLine, fLine2 - End If + 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 @@ -1069,11 +1232,16 @@ If sLine <> "" Then 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) @@ -1101,32 +1269,43 @@ If sLine <> "" Then 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) @@ -1144,22 +1323,31 @@ If sLine <> "" Then 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" @@ -1174,7 +1362,11 @@ If sLine <> "" Then 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 @@ -1191,7 +1383,7 @@ If sLine <> "" Then 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 @@ -1284,8 +1476,13 @@ Dim tNum As Long, ToolName As String, ToolCommand, TItem As Menu For Each TItem In mnuTItem If TItem.Index <> 0 Then Unload TItem Next TItem +For Each TItem In mnuPTItem + If TItem.Index <> 0 Then Unload TItem +Next TItem mnuTItem(0).Caption = "(Empty)" +mnuPTItem(0).Caption = mnuTItem(0).Caption mnuTItem(0).Tag = "" +mnuPTItem(0).Tag = "" Do ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum)) ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum)) @@ -1293,8 +1490,10 @@ Do 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 @@ -1302,12 +1501,13 @@ Do 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 @@ -1324,7 +1524,7 @@ If IsMPQ(CD.FileName) = False Then 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 @@ -1339,7 +1539,7 @@ FileList(0) = "(listfile)" If Mpq.FileExists(CD.FileName, "(listfile)") Then FileCont = Mpq.GetFileEx(CD.FileName, "(listfile)", 0, -1) #Else - FileCont = sListFiles(CD.FileName, hMPQ, ListFile) + sListFiles CD.FileName, hMPQ, ListFile, FileEntries #End If For bNum = 1 To Len(FileCont) If InStr(bNum, FileCont, vbCrLf) > 0 Then @@ -1360,18 +1560,19 @@ For bNum = nFiles + 1 To UBound(FileList) FileList(bNum) = GlobalFileList(bNum - nFiles) Next bNum #End If -Dim fNum As Long, lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long +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 @@ -1380,11 +1581,9 @@ For fNum = 1 To UBound(FileList) 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 @@ -1404,16 +1603,14 @@ For fNum = 1 To UBound(FileList) 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 @@ -1421,28 +1618,28 @@ For fNum = 1 To UBound(FileList) 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 @@ -1482,7 +1679,7 @@ Sub RemoveDuplicates() Dim fNum As Long fNum = 1 Do While fNum <= List.ListItems.Count - 1 - If LCase(List.ListItems.Item(fNum).Tag) = LCase(List.ListItems.Item(fNum + 1).Tag) Then + 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 @@ -1490,7 +1687,7 @@ Do While fNum <= List.ListItems.Count - 1 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 @@ -1500,7 +1697,13 @@ For fNum = 1 To List.ListItems.Count 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 @@ -1545,8 +1748,26 @@ RunMpq2kCommand txtCommand 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 @@ -1556,24 +1777,22 @@ InitFolderDialog PathInput PathInput.hwndOwner = hWnd PathInput.Flags = BIF_RETURNONLYFSDIRS ReDim OpenFiles(0) As String, OpenFileDates(0) As Date -Dim Path -Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\" ChDir App.Path -If Mpq.MpqInitialize = False Then - ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason: " - Select Case Mpq.LastError - Case MPQ_ERROR_NO_STAREDIT - ErrorText = ErrorText + "Can't find StarEdit.exe" - Case MPQ_ERROR_BAD_STAREDIT - ErrorText = ErrorText + "Wrong version of StarEdit.exe. Need SC/BW 1.07" - Case MPQ_ERROR_STAREDIT_RUNNING - ErrorText = ErrorText + "StarEdit.exe is running. It must be closed before running this" - Case Else - ErrorText = ErrorText + "Unknown" - End Select - MsgBox ErrorText - End -End If +'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 @@ -1598,12 +1817,21 @@ Top = GetReg(AppKey + "Status\WindowTop", Top) Width = GetReg(AppKey + "Status\WindowWidth", Width) If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0 ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt") -Mpq.DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024) +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 @@ -1675,8 +1903,6 @@ If sLine <> "" Then End Select End If End Sub - - Private Sub Form_Resize() On Error Resume Next If WindowState <> 1 Then @@ -1734,26 +1960,35 @@ Private Sub Label1_Click() 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 @@ -1772,6 +2007,7 @@ NotClick: List.SelectedItem.Selected = False NotSelected: ShowSelected +BuildMpqActionList End Sub Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader) If List.SortKey = ColumnHeader.Index - 1 Then @@ -1804,13 +2040,15 @@ If ExtractPathNum = -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 @@ -1828,12 +2066,12 @@ For fNum = 1 To List.ListItems.Count 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 @@ -1842,6 +2080,9 @@ NotClick: 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: @@ -1877,9 +2118,9 @@ End Sub Private Sub List_OLECompleteDrag(Effect As Long) List.Tag = "" End Sub -Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single) +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) @@ -1931,6 +2172,7 @@ For bNum = 1 To Len(FolderFiles) 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) @@ -1958,25 +2200,29 @@ If NewFile = True Then 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 @@ -1989,9 +2235,9 @@ For bNum = 1 To UBound(Files) 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 @@ -2001,7 +2247,7 @@ If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) 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 = "" @@ -2015,7 +2261,7 @@ RemoveDuplicates ShowTotal Cancel: End Sub -Private Sub List_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer) +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 @@ -2038,13 +2284,15 @@ End If 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 @@ -2052,7 +2300,7 @@ For fNum = 1 To List.ListItems.Count 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 @@ -2078,7 +2326,6 @@ End Sub Private Sub mnuFile_Click() If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False End Sub - Private Sub mnuFRecent_Click(Index As Integer) Dim OldFileName As String OldFileName = CD.FileName @@ -2105,6 +2352,7 @@ CD.Flags = &H1000 Or &H4 Or &H2 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 + "..." @@ -2133,10 +2381,11 @@ End If End Sub Private Sub mnuMAdd_Click() Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String -Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long +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 @@ -2158,6 +2407,7 @@ For bNum = bNum To Len(CD.FileName) 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) @@ -2185,25 +2435,29 @@ If NewFile = True Then 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 @@ -2216,9 +2470,9 @@ For bNum = 1 To UBound(Files) 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 @@ -2228,7 +2482,7 @@ If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) 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 = "" @@ -2244,7 +2498,8 @@ Cancel: End Sub Private Sub mnuMAddFolder_Click() Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, cNum As Long, FileFilter As String, hMPQ As Long -Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long +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) @@ -2263,6 +2518,7 @@ For bNum = 1 To Len(FolderFiles) 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) @@ -2290,25 +2546,29 @@ If NewFile = True Then 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 @@ -2321,9 +2581,9 @@ For bNum = 1 To UBound(Files) 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 @@ -2333,7 +2593,7 @@ If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) 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 = "" @@ -2347,9 +2607,14 @@ RemoveDuplicates 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 @@ -2358,6 +2623,7 @@ End Sub Private Sub mnuMCALowest_Click() mnuMCNone.Checked = False mnuMCStandard.Checked = False +mnuMCDeflate.Checked = False mnuMCALowest.Checked = True mnuMCAMedium.Checked = False mnuMCAHighest.Checked = False @@ -2368,42 +2634,75 @@ End Sub 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 = "" @@ -2414,12 +2713,14 @@ End Sub 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 @@ -2431,24 +2732,30 @@ Next fNum 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 = "" @@ -2459,8 +2766,17 @@ Exit Sub 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 @@ -2471,41 +2787,47 @@ For fNum = 1 To List.ListItems.Count 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 @@ -2516,6 +2838,7 @@ Dim TItem As Menu CD.Flags = &H1000 Or &H4 Or &H2 CD.DefaultExt = "mpq" CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*" +CD.hwndOwner = hWnd If ShowSave(CD) = False Then GoTo Cancel ReDim FileList(0) As String List.ListItems.Clear @@ -2541,11 +2864,15 @@ Dim OldFileName As String CD.Flags = &H1000 Or &H4 Or &H2 CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*" OldFileName = CD.FileName +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 @@ -2556,6 +2883,7 @@ CD.DefaultExt = "txt" 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..." @@ -2576,6 +2904,10 @@ End Sub 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 @@ -2583,56 +2915,14 @@ Private Sub mnuPExtract_Click() mnuMExtract_Click End Sub Private Sub mnuPItem_Click(Index As Integer) -Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long -Path = App.Path -If Right(Path, 1) <> "\" Then Path = Path + "\" -Path = Path + "Temp_extract\" -If ExtractPathNum = -1 Then - fNum = 0 - Do - If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do - fNum = fNum + 1 - Loop - ExtractPathNum = fNum -End If -Path = Path + CStr(ExtractPathNum) + "\" -If Mpq.SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub -For fNum = 1 To List.ListItems.Count - If List.ListItems.Item(fNum).Selected Then - StatBar.Style = 1 - StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..." - MousePointer = 11 - Mpq.sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True - If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then - For bNum = 1 To UBound(OpenFiles) - If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then - AlreadyInList = True - If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag)) - Exit For - End If - Next bNum - If AlreadyInList = False Then - ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date - OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag - If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag)) - End If - End If - StatBar.Style = 1 - StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..." - fName = List.ListItems.Item(fNum).Tag - ExecuteFile Path + fName, Index - If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True - End If -Next fNum -Mpq.SFileCloseArchive hMPQ -StatBar.Style = 0 -StatBar.SimpleText = "" -MousePointer = 0 +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 @@ -2740,8 +3032,12 @@ Exit Sub 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 + "\" @@ -2751,37 +3047,47 @@ For fNum = 1 To UBound(OpenFiles) If FileExists(FullPath(Path, OpenFiles(fNum))) Then If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then - Result = vbYes + 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