Current News 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: |
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
If Not FileExists(AboutPage) Then AboutPage = "sfmpq.dll"
ShellExecute 0, vbNullString, "res://" + AboutPage + "/about", vbNullString, vbNullString, 1
End Sub
+Sub GetCompressFlags(File As String, ByRef cType As Integer, ByRef dwFlags As Long)
+Dim bNum As Long, fExt As String
+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, ".")
+ 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"))
+ 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) = ".scm" Then
+ cType = CInt(GetReg(AppKey + "Compression\.scm", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
+ElseIf LCase(fExt) = ".scx" Then
+ cType = CInt(GetReg(AppKey + "Compression\.scx", "-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) = ".w3x" Then
+ cType = CInt(GetReg(AppKey + "Compression\.w3x", "-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, CStr(DefaultCompressID)))
+End If
+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
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 Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2)
End If
nHashEntries = SFileGetFileInfo(hMPQ, SFILE_INFO_HASH_TABLE_SIZE)
-If nHashEntries - 1 < 1 Then Exit Function
+If nHashEntries - 1 < 0 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, 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, ".")
- 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"))
- 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, CStr(DefaultCompressID)))
-End If
+Dim cType As Integer, dwFlags As Long
+
+GetCompressFlags File, cType, dwFlags
+
Select Case cType
Case -2
MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags, 0, 0
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 -4
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
Case 0, 1, 2
MpqAddWaveToArchive hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, cType
Case Else
-MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel
+If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
+ MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel
+Else
+ MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, 0
+End If
+End Select
+End Sub
+Sub mAddAutoFromBuffer(hMPQ As Long, ByRef buffer As Byte, BufSize As Long, MpqPath As String)
+Dim cType As Integer, dwFlags As Long
+
+GetCompressFlags MpqPath, cType, dwFlags
+
+Select Case cType
+Case -2
+MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags, 0, 0
+Case -1
+MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
+Case -3
+MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
+Case -4
+MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0
+Case 0, 1, 2
+MpqAddWaveFromBuffer hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, cType
+Case Else
+If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
+ MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel
+Else
+ MpqAddFileFromBufferEx hMPQ, buffer, BufSize, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, 0
+End If
End Select
End Sub
+
Function DirEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean) As String
Dim Files() As String, lNum As Long, Folders() As String
If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\"
ElseIf cType = -1 Then
mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
ElseIf cType = 1 Then
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
+ If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
+ Else
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, 0
+ End If
Else
MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
End If
ElseIf cType = -1 Then
mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
ElseIf cType = 1 Then
- MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
+ If DefaultCompress = MAFA_COMPRESS_DEFLATE Then
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
+ Else
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, 0
+ End If
Else
MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
End If
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
|