Archived News
Search News Discussion Forum
Old Forum Install Programs More Downloads...
Troubleshooting Source Code
Format Specs.
Misc. Information
Non-SF Stuff
Links
Small banner for links to this site:
----
- Fixed a bug that 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.
- 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.
| About.frm | patch | blob | blame | history | |
| MpqStuff.bas | patch | blob | blame | history | |
| Options.frm | patch | blob | blame | history | |
| SFmpqapi.bas | patch | blob | blame | history | |
| WINMPQ.VBP | patch | blob | blame | history | |
| WMpqEmbed.rtf | patch | blob | blame | history | |
| WinMPQ.rtf | patch | blob | blame | history | |
| listing.frm | patch | blob | blame | history |
diff --git a/About.frm b/About.frm
--- a/About.frm
+++ b/About.frm
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
End
Begin VB.Label Label2
AutoSize = -1 'True
- Caption = "Copyright © ShadowFlare Software"
+ Caption = "Copyright ?ShadowFlare Software"
Height = 195
Left = 120
TabIndex = 1
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
--- a/MpqStuff.bas
+++ b/MpqStuff.bas
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, _
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, _
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
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
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
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
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
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
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
--- a/Options.frm
+++ b/Options.frm
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
Caption = "&Associate WinMPQ with MPQ Archives"
Height = 255
Left = 0
- TabIndex = 5
+ TabIndex = 6
Top = 1680
Value = 2 'Grayed
Width = 3375
Caption = "Use &wildcards in filenames for drag and drop"
Height = 255
Left = 0
- TabIndex = 7
+ TabIndex = 8
Top = 2400
Value = 2 'Grayed
Width = 3735
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
Caption = "Locale ID for adding files"
Height = 195
Left = 0
- TabIndex = 36
+ TabIndex = 37
Top = 960
Width = 1755
End
Caption = $"Options.frx":000C
Height = 855
Left = 0
- TabIndex = 35
+ TabIndex = 36
Top = 2640
Width = 4935
End
Left = 240
ScaleHeight = 3495
ScaleWidth = 4935
- TabIndex = 40
+ TabIndex = 41
TabStop = 0 'False
Top = 480
Visible = 0 'False
Caption = "Add &Folder..."
Height = 375
Left = 3480
- TabIndex = 10
+ TabIndex = 11
Top = 1320
Width = 1335
End
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
Caption = "Use file lists for similarly named archives"
Height = 195
Left = 0
- TabIndex = 12
+ TabIndex = 13
Top = 2640
Width = 3375
End
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
Caption = "&Add List File..."
Height = 375
Left = 3480
- TabIndex = 9
+ TabIndex = 10
Top = 720
Width = 1335
End
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
Caption = "File Lists:"
Height = 195
Left = 0
- TabIndex = 50
+ TabIndex = 51
Top = 120
Width = 645
End
Left = 240
ScaleHeight = 3495
ScaleWidth = 4935
- TabIndex = 38
+ TabIndex = 39
TabStop = 0 'False
Top = 480
Visible = 0 'False
Caption = "&Reset size/position"
Height = 375
Left = 360
- TabIndex = 16
+ TabIndex = 17
Top = 840
Width = 1695
End
Caption = "Display &confirmation boxes"
Height = 255
Left = 0
- TabIndex = 14
+ TabIndex = 15
Top = 120
Value = 2 'Grayed
Width = 2415
Caption = "&Save last window size and position"
Height = 255
Left = 0
- TabIndex = 15
+ TabIndex = 16
Top = 480
Value = 2 'Grayed
Width = 3015
Caption = "Startup Path"
Height = 1215
Left = 0
- TabIndex = 39
+ TabIndex = 40
Top = 2280
Width = 4935
Begin VB.OptionButton Option1
Height = 255
Index = 0
Left = 120
- TabIndex = 17
+ TabIndex = 18
Top = 240
Value = -1 'True
Width = 1575
Height = 255
Index = 1
Left = 1680
- TabIndex = 18
+ TabIndex = 19
Top = 240
Width = 1695
End
Height = 255
Index = 2
Left = 120
- TabIndex = 19
+ TabIndex = 20
Top = 480
Width = 1695
End
Enabled = 0 'False
Height = 285
Left = 120
- TabIndex = 20
+ TabIndex = 21
Top = 840
Width = 3615
End
Enabled = 0 'False
Height = 285
Left = 3840
- TabIndex = 21
+ TabIndex = 22
Top = 840
Width = 975
End
Left = 240
ScaleHeight = 3495
ScaleWidth = 4935
- TabIndex = 42
+ TabIndex = 43
TabStop = 0 'False
Top = 480
Visible = 0 'False
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
Caption = "File extensions:"
Height = 195
Left = 3120
- TabIndex = 49
+ TabIndex = 50
Top = 960
Width = 1080
End
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
Caption = $"Options.frx":00F6
Height = 855
Left = 0
- TabIndex = 46
+ TabIndex = 47
Top = 120
Width = 4935
WordWrap = -1 'True
Left = 240
ScaleHeight = 3495
ScaleWidth = 4935
- TabIndex = 41
+ TabIndex = 42
TabStop = 0 'False
Top = 480
Visible = 0 'False
Left = 2880
List = "Options.frx":01F3
Style = 2 'Dropdown List
- TabIndex = 33
+ TabIndex = 34
Top = 3120
Width = 1815
End
Left = 1200
List = "Options.frx":024F
Style = 2 'Dropdown List
- TabIndex = 32
+ TabIndex = 33
Top = 3120
Width = 1455
End
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
Caption = "&Add"
Height = 285
Left = 960
- TabIndex = 25
+ TabIndex = 26
Top = 360
Width = 615
End
Caption = "&Remove"
Height = 255
Left = 0
- TabIndex = 27
+ TabIndex = 28
Top = 2640
Width = 1095
End
Left = 1800
List = "Options.frx":027A
Style = 2 'Dropdown List
- TabIndex = 28
+ TabIndex = 29
Top = 720
Width = 2535
End
Caption = "Audio Compression"
Height = 1335
Left = 1800
- TabIndex = 43
+ TabIndex = 44
Top = 1200
Visible = 0 'False
Width = 2535
Height = 255
Index = 0
Left = 120
- TabIndex = 30
+ TabIndex = 31
Top = 600
Value = -1 'True
Width = 2175
Height = 255
Index = 1
Left = 120
- TabIndex = 31
+ TabIndex = 32
Top = 960
Width = 2175
End
Height = 255
Index = 2
Left = 120
- TabIndex = 29
+ TabIndex = 30
Top = 240
Width = 2175
End
Caption = "Deflate Compression Level"
Height = 195
Left = 2880
- TabIndex = 53
+ TabIndex = 54
Top = 2880
Width = 1890
End
Caption = "Default Compression"
Height = 195
Left = 1200
- TabIndex = 52
+ TabIndex = 53
Top = 2880
Width = 1455
End
Caption = "Compression type"
Height = 255
Left = 1800
- TabIndex = 45
+ TabIndex = 46
Top = 480
Width = 1935
End
Caption = "File Extension"
Height = 255
Left = 0
- TabIndex = 44
+ TabIndex = 45
Top = 120
Width = 1215
End
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
Path = App.Path
If Right(Path, 1) <> "\" Then Path = Path + "\"
Text1 = DefaultMaxFiles
+Text5 = DefaultBlockSize
Text2 = LocaleID
OldFileName = CD.FileName
CD.FileName = ""
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"
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
Command5.Enabled = False
End If
End Sub
-
Private Sub Tabs_Click()
Dim TabDisp As PictureBox
For Each TabDisp In TabDisps
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
--- a/SFmpqapi.bas
+++ b/SFmpqapi.bas
' 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!
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
.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
--- a/WINMPQ.VBP
+++ b/WINMPQ.VBP
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"
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
diff --git a/WinMPQ.rtf b/WinMPQ.rtf
--- a/WinMPQ.rtf
+++ b/WinMPQ.rtf
{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fprq2 Arial;}{\f1\fswiss\fprq2\fcharset0 Arial;}{\f2\fmodern\fprq1 Courier New;}{\f3\fnil\fcharset2 Symbol;}}\r
{\colortbl ;\red0\green0\blue0;}\r
-\viewkind4\uc1\pard\b\f0\fs36 WinMPQ v1.\f1 62\b0\f0\fs20\par\r
+\viewkind4\uc1\pard\b\f0\fs36 WinMPQ v1.\f1 63\b0\f0\fs20\par\r
\par\r
\pard\li360 This program is an mpq archiver I \f1 started\f0 as an example of a program using the Mpq Control\f1 , but it now uses SFmpq directly\f0 . It currently has many features and is one of the best mpq archivers around.\par\r
\pard\par\r
@@ -152,6 +152,10 @@ NOTE: Each file that a MoPaQ can hold (the FileLimit) takes up 16 bytes in the M
\pard\par\r
\ul\b\fs24 Version history\ulnone\b0\fs20\par\r
\par\r
+\ul\b 1.\f1 63\f0 __________\par\r
+\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\r
+\f1{\pntext\f3\'B7\tab}Added an option to set the block size for new archives.\f0\par\r
+\pard\par\r
\ul\b 1.\f1 62\f0 __________\par\r
\pard{\pntext\f3\'B7\tab}{\*\pn\pnlvlblt\pnf3\pnindent720{\pntxtb\'B7}}\fi-720\li720\ulnone\b0\f1 Fixed a bug that prevented extracting empty files.\f0\par\r
\f1{\pntext\f3\'B7\tab}Added an option that would allow one to have WinMPQ search a specified folder and all of its subfolders for file lists with names similar to the open archive.\f0\par\r
@@ -292,6 +296,6 @@ NOTE: Each file that a MoPaQ can hold (the FileLimit) takes up 16 bytes in the M
\pard\par\r
-ShadowFlare\par\r
\pard\li360 email:\tab blakflare@hotmail.com\par\r
-web page:\tab http://shadowflare.ancillaediting.net/\par\r
+web page:\tab http://shadowflare.\f1 gameproc.com\f0 /\par\r
}\r
\0
\ No newline at end of file
diff --git a/listing.frm b/listing.frm
--- a/listing.frm
+++ b/listing.frm
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
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")
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
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
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
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)