From: ShadowFlare Date: Fri, 10 Jul 2009 05:55:14 +0000 (-0600) Subject: 1.63 X-Git-Url: https://sfsrealm.hopto.org/projects/gitweb.cgi?p=WinMPQ.git;a=commitdiff_plain;h=5f007675b9bc6441679fe729de15e2658c49aad3 1.63 ---- - Fixed a bug that caused an overflow error message when opening an archive containing certain numbers of files; especially on Chinese, Japanese, and Korean Windows versions. - Added an option to set the block size for new archives. --- diff --git a/About.frm b/About.frm index b74fc14..e6abbab 100644 --- a/About.frm +++ b/About.frm @@ -58,7 +58,7 @@ Begin VB.Form About Begin VB.Label Label3 AutoSize = -1 'True BackStyle = 0 'Transparent - Caption = "ShadowFlare's Realm - http://shadowflare.ancillaediting.net/" + Caption = "ShadowFlare's Realm - http://shadowflare.gameproc.com/" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Times New Roman" Size = 9.75 @@ -78,7 +78,7 @@ Begin VB.Form About End Begin VB.Label Label2 AutoSize = -1 'True - Caption = "Copyright © ShadowFlare Software" + Caption = "Copyright ?ShadowFlare Software" Height = 195 Left = 120 TabIndex = 1 @@ -162,7 +162,7 @@ Label4.Font.underline = False Label5.Font.underline = False End Sub Private Sub Label3_Click() -ShellExecute hWnd, vbNullString, "http://shadowflare.ancillaediting.net/", vbNullString, vbNullString, 1 +ShellExecute hWnd, vbNullString, "http://shadowflare.gameproc.com/", vbNullString, vbNullString, 1 End Sub Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Label3.ForeColor = &HFF00& diff --git a/MpqStuff.bas b/MpqStuff.bas index 2e83bae..3a918d3 100644 --- a/MpqStuff.bas +++ b/MpqStuff.bas @@ -1,6 +1,26 @@ Attribute VB_Name = "MpqStuff" Option Explicit +Type SHELLEXECUTEINFO + cbSize As Long + fMask As Long + hWnd As Long + lpVerb As String + lpFile As String + lpParameters As String + lpDirectory As String + nShow As Long + hInstApp As Long + + ' Optional members + lpIDList As Long + lpClass As String + hkeyClass As Long + dwHotKey As Long + hIcon As Long + hProcess As Long +End Type + Public Declare Function ShellExecute Lib _ "Shell32.dll" Alias "ShellExecuteA" _ (ByVal hWnd As Long, _ @@ -9,6 +29,9 @@ Public Declare Function ShellExecute Lib _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long +Public Declare Function ShellExecuteEx Lib _ + "Shell32.dll" Alias "ShellExecuteExA" _ + (sei As SHELLEXECUTEINFO) As Long Public Declare Sub SHChangeNotify Lib _ "Shell32.dll" (ByVal wEventId As Long, _ ByVal uFlags As Integer, _ @@ -28,7 +51,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, GlobalEncrypt As Boolean, DefaultCompress As Long, DefaultCompressID As Long, DefaultCompressLevel As Long, DefaultMaxFiles 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, DefaultBlockSize 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,6 +62,7 @@ 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 +Public Const SEE_MASK_CLASSNAME As Long = &H1 Sub AboutSFMpq() Dim AboutPage As String, Path As String Path = App.Path @@ -50,9 +74,9 @@ 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) +hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_OPEN_EXISTING Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize) If hMPQ = 0 Or hMPQ = INVALID_HANDLE_VALUE Then - hMPQ = MpqOpenArchiveForUpdate(FileName, MOAU_CREATE_NEW Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles) + hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_CREATE_NEW Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize) End If If hMPQ <> 0 And hMPQ <> INVALID_HANDLE_VALUE Then mOpenMpq = hMPQ @@ -131,7 +155,7 @@ End If Exit Function WriteError: MsgBox "Error writing file. File may be in use.", vbCritical, "WinMPQ" -Resume Next +Close #cNum End Function 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 @@ -1063,16 +1087,6 @@ DefaultMaxFiles = OldDefaultMaxFiles If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1) ChDir OldPath End Sub -Function SBytes(Num, Start As Long, Length As Long) As String -Dim buffer() As Byte, NumData As Currency -If Start + Length > 8 Then Length = 8 - Start -On Error Resume Next -NumData = Num / 10000 -ReDim buffer(7) -CopyMemory buffer(0), NumData, 8 -On Error GoTo 0 -SBytes = Mid(StrConv(buffer, vbUnicode), Start + 1, Length) -End Function Function FindMpqHeader(MpqFile As String) As Long If FileExists(MpqFile) = False Then FindMpqHeader = -1 @@ -1106,16 +1120,6 @@ Function FindMpqHeader(MpqFile As String) As Long FindMpqHeader = -1 Close #hFile End Function -Function JBytes(Text As String, Start As Long, Length As Long) -Dim buffer() As Byte, NumData As Currency -If Start + Length - 1 > Len(Text) Then Length = Len(Text) - (Start - 1) -On Error Resume Next -ReDim buffer(Length - 1) -buffer = StrConv(Mid(Text, Start, Length), vbFromUnicode) -CopyMemory NumData, buffer(0), Length -On Error GoTo 0 -JBytes = NumData * 10000 -End Function Function GetNumMpqFiles(MpqFile As String) As Long Dim fNum As Long, Text As String, MpqHeader As Long fNum = FreeFile @@ -1123,8 +1127,7 @@ Text = String(4, Chr(0)) MpqHeader = FindMpqHeader(MpqFile) If MpqHeader > -1 Then Open MpqFile For Binary As #fNum - Get #fNum, MpqHeader + 29, Text + Get #fNum, MpqHeader + 29, GetNumMpqFiles Close #fNum - GetNumMpqFiles = JBytes(Text, 1, 4) End If End Function diff --git a/Options.frm b/Options.frm index a5ee29a..9dccb7c 100644 --- a/Options.frm +++ b/Options.frm @@ -41,10 +41,19 @@ Begin VB.Form Options Left = 240 ScaleHeight = 3495 ScaleWidth = 4995 - TabIndex = 34 + TabIndex = 35 TabStop = 0 'False Top = 480 Width = 4995 + Begin VB.TextBox Text5 + Height = 285 + Left = 2280 + MaxLength = 2 + TabIndex = 5 + Text = "3" + Top = 1200 + Width = 1215 + End Begin VB.TextBox Text1 Height = 285 Left = 0 @@ -66,7 +75,7 @@ Begin VB.Form Options Caption = "&Associate WinMPQ with MPQ Archives" Height = 255 Left = 0 - TabIndex = 5 + TabIndex = 6 Top = 1680 Value = 2 'Grayed Width = 3375 @@ -75,7 +84,7 @@ Begin VB.Form Options Caption = "Use &wildcards in filenames for drag and drop" Height = 255 Left = 0 - TabIndex = 7 + TabIndex = 8 Top = 2400 Value = 2 'Grayed Width = 3735 @@ -84,17 +93,35 @@ Begin VB.Form Options Caption = "Automatically update &modified files" Height = 255 Left = 0 - TabIndex = 6 + TabIndex = 7 Top = 2160 Value = 2 'Grayed Width = 3015 End + Begin VB.Label ActualBlockSize + Caption = "4 KB" + Height = 255 + Left = 3600 + TabIndex = 56 + Top = 1200 + Width = 1215 + End + Begin VB.Label Label13 + AutoSize = -1 'True + Caption = "Block size for new archives (default is 3)" + Height = 390 + Left = 2280 + TabIndex = 55 + Top = 720 + Width = 2055 + WordWrap = -1 'True + 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 = 37 + TabIndex = 38 Top = 120 Width = 4335 WordWrap = -1 'True @@ -104,7 +131,7 @@ Begin VB.Form Options Caption = "Locale ID for adding files" Height = 195 Left = 0 - TabIndex = 36 + TabIndex = 37 Top = 960 Width = 1755 End @@ -112,7 +139,7 @@ Begin VB.Form Options Caption = $"Options.frx":000C Height = 855 Left = 0 - TabIndex = 35 + TabIndex = 36 Top = 2640 Width = 4935 End @@ -124,7 +151,7 @@ Begin VB.Form Options Left = 240 ScaleHeight = 3495 ScaleWidth = 4935 - TabIndex = 40 + TabIndex = 41 TabStop = 0 'False Top = 480 Visible = 0 'False @@ -133,7 +160,7 @@ Begin VB.Form Options Caption = "Add &Folder..." Height = 375 Left = 3480 - TabIndex = 10 + TabIndex = 11 Top = 1320 Width = 1335 End @@ -141,7 +168,7 @@ Begin VB.Form Options Caption = "Do not use above lists when one is found by above option" Height = 375 Left = 0 - TabIndex = 13 + TabIndex = 14 Top = 2880 Value = 2 'Grayed Width = 3375 @@ -150,7 +177,7 @@ Begin VB.Form Options Caption = "Use file lists for similarly named archives" Height = 195 Left = 0 - TabIndex = 12 + TabIndex = 13 Top = 2640 Width = 3375 End @@ -158,14 +185,14 @@ Begin VB.Form Options Caption = "&Remove" Height = 375 Left = 3480 - TabIndex = 11 + TabIndex = 12 Top = 1920 Width = 1335 End Begin VB.ListBox FileLists Height = 2205 Left = 0 - TabIndex = 8 + TabIndex = 9 Top = 360 Width = 3375 End @@ -173,7 +200,7 @@ Begin VB.Form Options Caption = "&Add List File..." Height = 375 Left = 3480 - TabIndex = 9 + TabIndex = 10 Top = 720 Width = 1335 End @@ -181,7 +208,7 @@ Begin VB.Form Options Caption = "Note: Each file list added will increase the load time for archives." Height = 255 Left = 0 - TabIndex = 51 + TabIndex = 52 Top = 3240 Width = 4815 End @@ -190,7 +217,7 @@ Begin VB.Form Options Caption = "File Lists:" Height = 195 Left = 0 - TabIndex = 50 + TabIndex = 51 Top = 120 Width = 645 End @@ -202,7 +229,7 @@ Begin VB.Form Options Left = 240 ScaleHeight = 3495 ScaleWidth = 4935 - TabIndex = 38 + TabIndex = 39 TabStop = 0 'False Top = 480 Visible = 0 'False @@ -211,7 +238,7 @@ Begin VB.Form Options Caption = "&Reset size/position" Height = 375 Left = 360 - TabIndex = 16 + TabIndex = 17 Top = 840 Width = 1695 End @@ -219,7 +246,7 @@ Begin VB.Form Options Caption = "Display &confirmation boxes" Height = 255 Left = 0 - TabIndex = 14 + TabIndex = 15 Top = 120 Value = 2 'Grayed Width = 2415 @@ -228,7 +255,7 @@ Begin VB.Form Options Caption = "&Save last window size and position" Height = 255 Left = 0 - TabIndex = 15 + TabIndex = 16 Top = 480 Value = 2 'Grayed Width = 3015 @@ -237,7 +264,7 @@ Begin VB.Form Options Caption = "Startup Path" Height = 1215 Left = 0 - TabIndex = 39 + TabIndex = 40 Top = 2280 Width = 4935 Begin VB.OptionButton Option1 @@ -245,7 +272,7 @@ Begin VB.Form Options Height = 255 Index = 0 Left = 120 - TabIndex = 17 + TabIndex = 18 Top = 240 Value = -1 'True Width = 1575 @@ -255,7 +282,7 @@ Begin VB.Form Options Height = 255 Index = 1 Left = 1680 - TabIndex = 18 + TabIndex = 19 Top = 240 Width = 1695 End @@ -264,7 +291,7 @@ Begin VB.Form Options Height = 255 Index = 2 Left = 120 - TabIndex = 19 + TabIndex = 20 Top = 480 Width = 1695 End @@ -272,7 +299,7 @@ Begin VB.Form Options Enabled = 0 'False Height = 285 Left = 120 - TabIndex = 20 + TabIndex = 21 Top = 840 Width = 3615 End @@ -281,7 +308,7 @@ Begin VB.Form Options Enabled = 0 'False Height = 285 Left = 3840 - TabIndex = 21 + TabIndex = 22 Top = 840 Width = 975 End @@ -294,7 +321,7 @@ Begin VB.Form Options Left = 240 ScaleHeight = 3495 ScaleWidth = 4935 - TabIndex = 42 + TabIndex = 43 TabStop = 0 'False Top = 480 Visible = 0 'False @@ -303,14 +330,14 @@ Begin VB.Form Options Height = 1215 IntegralHeight = 0 'False Left = 3120 - TabIndex = 23 + TabIndex = 24 Top = 2280 Width = 1815 End Begin MSComctlLib.ListView FileTypes Height = 2535 Left = 0 - TabIndex = 22 + TabIndex = 23 Top = 960 Width = 3015 _ExtentX = 5318 @@ -337,7 +364,7 @@ Begin VB.Form Options Caption = "File extensions:" Height = 195 Left = 3120 - TabIndex = 49 + TabIndex = 50 Top = 960 Width = 1080 End @@ -346,14 +373,14 @@ Begin VB.Form Options Caption = "Default action:" Height = 195 Left = 3120 - TabIndex = 47 + TabIndex = 48 Top = 2040 Width = 1035 End Begin VB.Label Label8 Height = 855 Left = 3120 - TabIndex = 48 + TabIndex = 49 Top = 1200 Width = 1755 End @@ -362,7 +389,7 @@ Begin VB.Form Options Caption = $"Options.frx":00F6 Height = 855 Left = 0 - TabIndex = 46 + TabIndex = 47 Top = 120 Width = 4935 WordWrap = -1 'True @@ -375,7 +402,7 @@ Begin VB.Form Options Left = 240 ScaleHeight = 3495 ScaleWidth = 4935 - TabIndex = 41 + TabIndex = 42 TabStop = 0 'False Top = 480 Visible = 0 'False @@ -386,7 +413,7 @@ Begin VB.Form Options Left = 2880 List = "Options.frx":01F3 Style = 2 'Dropdown List - TabIndex = 33 + TabIndex = 34 Top = 3120 Width = 1815 End @@ -396,7 +423,7 @@ Begin VB.Form Options Left = 1200 List = "Options.frx":024F Style = 2 'Dropdown List - TabIndex = 32 + TabIndex = 33 Top = 3120 Width = 1455 End @@ -406,14 +433,14 @@ Begin VB.Form Options Left = 0 List = "Options.frx":0268 Sorted = -1 'True - TabIndex = 26 + TabIndex = 27 Top = 720 Width = 1575 End Begin VB.TextBox Text4 Height = 285 Left = 0 - TabIndex = 24 + TabIndex = 25 Top = 360 Width = 855 End @@ -421,7 +448,7 @@ Begin VB.Form Options Caption = "&Add" Height = 285 Left = 960 - TabIndex = 25 + TabIndex = 26 Top = 360 Width = 615 End @@ -429,7 +456,7 @@ Begin VB.Form Options Caption = "&Remove" Height = 255 Left = 0 - TabIndex = 27 + TabIndex = 28 Top = 2640 Width = 1095 End @@ -440,7 +467,7 @@ Begin VB.Form Options Left = 1800 List = "Options.frx":027A Style = 2 'Dropdown List - TabIndex = 28 + TabIndex = 29 Top = 720 Width = 2535 End @@ -448,7 +475,7 @@ Begin VB.Form Options Caption = "Audio Compression" Height = 1335 Left = 1800 - TabIndex = 43 + TabIndex = 44 Top = 1200 Visible = 0 'False Width = 2535 @@ -457,7 +484,7 @@ Begin VB.Form Options Height = 255 Index = 0 Left = 120 - TabIndex = 30 + TabIndex = 31 Top = 600 Value = -1 'True Width = 2175 @@ -467,7 +494,7 @@ Begin VB.Form Options Height = 255 Index = 1 Left = 120 - TabIndex = 31 + TabIndex = 32 Top = 960 Width = 2175 End @@ -476,7 +503,7 @@ Begin VB.Form Options Height = 255 Index = 2 Left = 120 - TabIndex = 29 + TabIndex = 30 Top = 240 Width = 2175 End @@ -486,7 +513,7 @@ Begin VB.Form Options Caption = "Deflate Compression Level" Height = 195 Left = 2880 - TabIndex = 53 + TabIndex = 54 Top = 2880 Width = 1890 End @@ -495,7 +522,7 @@ Begin VB.Form Options Caption = "Default Compression" Height = 195 Left = 1200 - TabIndex = 52 + TabIndex = 53 Top = 2880 Width = 1455 End @@ -503,7 +530,7 @@ Begin VB.Form Options Caption = "Compression type" Height = 255 Left = 1800 - TabIndex = 45 + TabIndex = 46 Top = 480 Width = 1935 End @@ -511,7 +538,7 @@ Begin VB.Form Options Caption = "File Extension" Height = 255 Left = 0 - TabIndex = 44 + TabIndex = 45 Top = 120 Width = 1215 End @@ -681,10 +708,12 @@ If Right(Path, 1) <> "\" Then Path = Path + "\" Text1_LostFocus Text2_LostFocus DefaultMaxFiles = Text1 +DefaultBlockSize = Text5 LocaleID = Text2 SFileSetLocale (LocaleID) NewKey AppKey SetReg AppKey + "DefaultMaxFiles", Text1, REG_DWORD +SetReg AppKey + "DefaultBlockSize", Text5, REG_DWORD SetReg AppKey + "LocaleID", Text2, REG_DWORD If Check1.Value > 0 Then SetReg AppKey + "SaveWindowStatus", 1, REG_DWORD @@ -850,6 +879,7 @@ If Top + Height > Screen.Height Then Top = Screen.Height - Height Path = App.Path If Right(Path, 1) <> "\" Then Path = Path + "\" Text1 = DefaultMaxFiles +Text5 = DefaultBlockSize Text2 = LocaleID OldFileName = CD.FileName CD.FileName = "" @@ -939,6 +969,9 @@ Do FileTypes.ListItems.Add(, aName, GetReg("HKEY_CLASSES_ROOT\" + aName + "\", UCase(Mid(aExt, 2)) + " File")).ToolTipText = UCase(aExt) On Error Resume Next End If + ElseIf LCase(aExt) = "*" Then + FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = "" + If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " All Files" ElseIf LCase(aExt) = "unknown" Then FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = "" If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " Unknown File" @@ -957,7 +990,6 @@ End Sub Private Sub Form_Unload(Cancel As Integer) CD.FileName = OldFileName End Sub - Private Sub List1_Click() Dim xNum As Integer, OldExtComp As Integer If List1.ListIndex > -1 Then @@ -997,7 +1029,6 @@ Else Command5.Enabled = False End If End Sub - Private Sub Tabs_Click() Dim TabDisp As PictureBox For Each TabDisp In TabDisps @@ -1008,11 +1039,30 @@ End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0 End Sub + +Private Sub Text5_Change() +On Error Resume Next +If Text5 <> "" Then + If Text5 > 23 Then Text5 = 23 + If Text5 <= 23 Then _ + ActualBlockSize = CStr((512 * 2 ^ Text5) / 1024) + " KB" +Else + ActualBlockSize = "" +End If +On Error GoTo 0 +End Sub +Private Sub Text5_KeyPress(KeyAscii As Integer) +If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0 +End Sub Private Sub Text1_LostFocus() If Text1 = "" Then Text1 = 0 'If Text1 < 16 Then Text1 = 16 'If Text1 > 262144 Then Text1 = 262144 End Sub +Private Sub Text5_LostFocus() +If Text5 = "" Then Text5 = DEFAULT_BLOCK_SIZE +If Text5 > 23 Then Text5 = 23 +End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) Dim NewValue As Long If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> Asc("-") Then KeyAscii = 0 diff --git a/SFmpqapi.bas b/SFmpqapi.bas index 75ec087..48b0c6f 100644 --- a/SFmpqapi.bas +++ b/SFmpqapi.bas @@ -21,12 +21,18 @@ Option Explicit ' most likely result in a crash. ' Revision History: -' 20/10/2002 1.07 (ShadowFlare) +' 06/12/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 +' - Fixed a bug with adding wave compressed files with +' low compression setting +' - Added a check in MpqOpenArchiveForUpdate for proper +' dwMaximumFilesInArchive values (should be a number that +' is a power of 2). If it is not a proper value, it will +' be rounded up to the next higher power of 2 ' 05/09/2002 1.06 (ShadowFlare) ' - Compresses files without Storm.dll! @@ -153,6 +159,10 @@ 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 +' MpqOpenArchiveForUpdateEx constants +Public Const DEFAULT_BLOCK_SIZE As Long = 3 ' 512 << number = block size +Public Const USE_DEFAULT_BLOCK_SIZE As Long = &HFFFF ' Use default block size that is defined internally + ' MpqAddFileToArchive flags Public Const MAFA_EXISTS As Long = &H80000000 'Will be added if not present Public Const MAFA_UNKNOWN40000000 As Long = &H40000000 @@ -239,7 +249,7 @@ Declare Function SFileGetFileSize Lib "SFmpq.dll" (ByVal hFile As Long, lpFileSi 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 SFileReadFile Lib "SFmpq.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByRef 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 @@ -260,10 +270,11 @@ Declare Function MpqDeleteFile Lib "SFmpq.dll" (ByVal hMPQ As Long, ByVal lpFile Declare Function MpqCompactArchive Lib "SFmpq.dll" (ByVal hMPQ As Long) As Boolean ' Extra archive editing functions +Declare Function MpqOpenArchiveForUpdateEx Lib "SFmpq.dll" (ByVal lpFileName As String, ByVal dwFlags As Long, ByVal dwMaximumFilesInArchive As Long, ByVal dwBlockSize As Long) As Long 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 MpqAddFileFromBufferEx Lib "SFmpq.dll" (ByVal hMPQ As Long, ByRef 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, ByRef 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, ByRef 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 @@ -279,7 +290,7 @@ Function SFMpqCompareVersion() As Long .Major = 1 .Minor = 0 .Revision = 7 - .Subrevision = 3 + .Subrevision = 4 End With DllVersion = SFMpqGetVersion() If DllVersion.Major > ExeVersion.Major Then diff --git a/WINMPQ.VBP b/WINMPQ.VBP index b80d853..89dafdb 100644 --- a/WINMPQ.VBP +++ b/WINMPQ.VBP @@ -13,7 +13,7 @@ Form=EditTItem.frm Form=frmMpq.frm Form=frmAddToList.frm Form=ChLCID.frm -Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX +Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx ProjWinSize=82,446,212,163 ProjWinShow=2 IconForm="MpqEx" @@ -26,11 +26,11 @@ HelpContextID="0" StartMode=0 VersionCompatible32="0" MajorVer=1 -MinorVer=62 +MinorVer=63 RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 VersionCompanyName="ShadowFlare Software" VersionFileDescription="ShadowFlare MPQ Archiver" -VersionLegalCopyright="Copyright © ShadowFlare Software 2001-2003" +VersionLegalCopyright="Copyright © ShadowFlare Software 2001-2005" VersionProductName="WinMPQ" diff --git a/WMpqEmbed.rtf b/WMpqEmbed.rtf index f66ac93..1ca72b0 100644 Binary files a/WMpqEmbed.rtf and b/WMpqEmbed.rtf differ diff --git a/WinMPQ.rtf b/WinMPQ.rtf index 416f852..3afbf24 100644 --- a/WinMPQ.rtf +++ b/WinMPQ.rtf @@ -1,6 +1,6 @@ {\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 62\b0\f0\fs20\par +\viewkind4\uc1\pard\b\f0\fs36 WinMPQ v1.\f1 63\b0\f0\fs20\par \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 @@ -152,6 +152,10 @@ 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 63\f0 __________\par +\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Fixed a bug that caused an overflow error message when opening an archive containing certain numbers of files; especially on Chinese, Japanese, and Korean Windows versions.\f0\par +\f1{\pntext\f3\'B7\tab}Added an option to set the block size for new archives.\f0\par +\pard\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 @@ -292,6 +296,6 @@ NOTE: Each file that a MoPaQ can hold (the FileLimit) takes up 16 bytes in the M \pard\par -ShadowFlare\par \pard\li360 email:\tab blakflare@hotmail.com\par -web page:\tab http://shadowflare.ancillaediting.net/\par +web page:\tab http://shadowflare.\f1 gameproc.com\f0 /\par } \ No newline at end of file diff --git a/listing.frm b/listing.frm index 9b51f3f..5ed59c2 100644 --- a/listing.frm +++ b/listing.frm @@ -506,7 +506,7 @@ For Each PItem In mnuItem If PItem.Index <> 0 Then Unload PItem Next PItem If InStr(FileName, ".") = 0 Then - GoSub AddUnknown + GoSub AddGlobal Else For bNum = 1 To Len(FileName) If InStr(bNum, FileName, ".") > 0 Then @@ -518,7 +518,7 @@ Else aName = Mid(FileName, bNum - 1) aName = GetReg("HKEY_CLASSES_ROOT\" + aName + "\") If aName = "" Then - GoSub AddUnknown + GoSub AddGlobal Exit Sub End If dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open") @@ -536,7 +536,7 @@ Else Else aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", 0) If aItem = "" Then - GoSub AddUnknown + GoSub AddGlobal Exit Sub End If If Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then @@ -573,9 +573,52 @@ Else aNum = aNum + 1 End If Loop Until aItem = "" + GoSub AddGlobal If Shift And vbShiftMask Then GoSub AddUnknown End If Exit Sub +AddGlobal: + aNum = 0 + bNum = mnuRoot.Tag + dItem = "" + If bNum = 0 Then + dItem = GetReg("HKEY_CLASSES_ROOT\*\shell\", "open") + dItem = GetReg(SharedAppKey + "FileDefaultActions\*", dItem) + If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\command\")) Then + If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\")) Then + mnuItem(bNum).Caption = "Op&en with..." + Else + mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2)) + End If + mnuItem(bNum).Tag = dItem + mnuRoot.Tag = mnuRoot.Tag + 1 + bNum = bNum + 1 + End If + End If + Do + aItem = EnumKey("HKEY_CLASSES_ROOT\*\shell\", aNum) + If aItem <> "" Then + If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\command\")) Then + On Error Resume Next + Load mnuItem(bNum) + On Error GoTo 0 + If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\")) Then + mnuItem(bNum).Caption = "Op&en with..." + Else + mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2)) + End If + mnuItem(bNum).Tag = aItem + mnuRoot.Tag = mnuRoot.Tag + 1 + bNum = bNum + 1 + End If + aNum = aNum + 1 + End If + Loop Until aItem = "" + If bNum = 0 Then + GoSub AddUnknown + Exit Sub + End If +Return AddUnknown: aNum = 0 bNum = mnuRoot.Tag @@ -844,39 +887,64 @@ For lIndex = 1 To List.ListItems.Count Next lIndex End Sub 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 - Else - bNum = InStr(Param, "%1") - Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2) - End If - Loop While InStr(Param, "%1") - bNum = 1 - Do While bNum <= Len(Param) - If InStr(bNum, Param, "%") Then - bNum = InStr(bNum, Param, "%") - If InStr(bNum + 1, Param, "%") Then - bNum2 = InStr(bNum + 1, Param, "%") - EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1) - If Environ(EnvName) <> "" Then - Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1) - End If - End If - End If - bNum = bNum + 1 - Loop - On Error GoTo NoProgram - Shell Param, 1 - On Error GoTo 0 -End If -Exit Sub -NoProgram: -If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ" +Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String, RetVal As Long, sei As SHELLEXECUTEINFO +If Index < mnuRoot.Tag Then + With sei + .cbSize = Len(sei) + .fMask = 0 + .hWnd = hWnd + .lpVerb = mnuItem(Index).Tag + .lpFile = FileName + .lpParameters = vbNullString + .lpDirectory = vbNullString + .nShow = 1 + End With + RetVal = ShellExecuteEx(sei) +Else + With sei + .cbSize = Len(sei) + .fMask = SEE_MASK_CLASSNAME + .hWnd = hWnd + .lpVerb = mnuItem(Index).Tag + .lpFile = FileName + .lpParameters = vbNullString + .lpDirectory = vbNullString + .nShow = 1 + .lpClass = "Unknown" + End With + RetVal = ShellExecuteEx(sei) +End If +'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 +' Else +' bNum = InStr(Param, "%1") +' Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2) +' End If +' Loop While InStr(Param, "%1") +' bNum = 1 +' Do While bNum <= Len(Param) +' If InStr(bNum, Param, "%") Then +' bNum = InStr(bNum, Param, "%") +' If InStr(bNum + 1, Param, "%") Then +' bNum2 = InStr(bNum + 1, Param, "%") +' EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1) +' If Environ(EnvName) <> "" Then +' Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1) +' End If +' End If +' End If +' bNum = bNum + 1 +' Loop +' On Error GoTo NoProgram +' Shell Param, 1 +' On Error GoTo 0 +'End If +'Exit Sub +'NoProgram: +'If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ" End Sub Sub RunMpq2kCommand(CmdLine As String) Dim sLine As String, pNum As Long, Param() As String, EndParam As Long, CurPath As String, cType As Integer, Rswitch As Boolean, fCount As Long, Files As String, fEndLine As Long, fLine As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String, TItem As Menu, fLine2 As String, fLineTitle As String, hMPQ As Long, hFile As Long, FileShortNames() As String, dwFlags As Long @@ -1818,6 +1886,7 @@ 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") DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024) +DefaultBlockSize = GetReg(AppKey + "DefaultBlockSize", DEFAULT_BLOCK_SIZE) LocaleID = GetReg(AppKey + "LocaleID", 0) GlobalEncrypt = False DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)