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
ByVal dwItem1 As Any, _
ByVal dwItem2 As Any)
Public Declare Function SendMessageA Lib _
- "user32.dll" _
+ "User32.dll" _
(ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal Wp As Long, _
ByVal Length As Long)
Public CD As OPENFILENAME, PathInput As BROWSEINFO
-Public GlobalFileList() As String, FileList() As String, CX As Single, CY As Single, NewFile As Boolean, LocaleID As Long, ListFile As String, AddFolderName As String, ExtractPathNum As Long, CopyPathNum As Long
+Public GlobalFileList() As String, FileList() As String, CX As Single, CY As Single, NewFile As Boolean, LocaleID As Long, ListFile As String, AddFolderName As String, ExtractPathNum As Long, CopyPathNum As Long, GlobalEncrypt As Boolean, DefaultCompress As Long, DefaultCompressID As Long, DefaultCompressLevel As Long, DefaultMaxFiles As Long
Public Const AppKey As String = "HKEY_CURRENT_USER\Software\ShadowFlare\WinMPQ\", SharedAppKey As String = "HKEY_LOCAL_MACHINE\Software\ShadowFlare\WinMPQ\"
Public Const MPQ_ERROR_INIT_FAILED As Long = &H85000001 'Unspecified error
Public Const MPQ_ERROR_NO_STAREDIT As Long = &H85000002 'Can't find StarEdit.exe
Public Const WM_SETREDRAW As Long = &HB
Public Const WM_PAINT As Long = &HF
Const gintMAX_SIZE% = 255
+Sub AboutSFMpq()
+Dim AboutPage As String, Path As String
+Path = App.Path
+If Right(Path, 1) <> "\" Then Path = Path + "\"
+AboutPage = Path + "sfmpq.dll"
+If Not FileExists(AboutPage) Then AboutPage = "sfmpq.dll"
+ShellExecute 0, vbNullString, "res://" + AboutPage + "/about", vbNullString, vbNullString, 1
+End Sub
+Function mOpenMpq(FileName As String) As Long
+Dim hMPQ As Long
+mOpenMpq = 0
+hMPQ = MpqOpenArchiveForUpdate(FileName, MOAU_OPEN_EXISTING Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles)
+If hMPQ = 0 Or hMPQ = INVALID_HANDLE_VALUE Then
+ hMPQ = MpqOpenArchiveForUpdate(FileName, MOAU_CREATE_NEW Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles)
+End If
+If hMPQ <> 0 And hMPQ <> INVALID_HANDLE_VALUE Then
+ mOpenMpq = hMPQ
+End If
+End Function
Function PathInputBox(lpFolderDialog As BROWSEINFO, pCaption As String, StartFolder As String) As String
lpFolderDialog.Title = pCaption
-Dim Result As Long
-Result = ShowFolder(lpFolderDialog)
-If Result = 0 Then Exit Function
-PathInputBox = GetPathFromID(Result)
+Dim result As Long
+result = ShowFolder(lpFolderDialog)
+If result = 0 Then Exit Function
+PathInputBox = GetPathFromID(result)
End Function
Function GetLongPath(Path As String) As String
Dim strBuf As String, StrLength As Long
GetLongPath = Path
End If
End Function
-Sub AddAutoFile(Mpq As String, File As String, MpqPath As String)
-Dim cType As Integer, bNum As Long, fExt As String
-For bNum = 1 To Len(File)
- If InStr(bNum, File, ".") > 0 Then
- bNum = InStr(bNum, File, ".")
- Else
- Exit For
- End If
-Next bNum
-If bNum > 1 Then
- fExt = Mid(File, bNum - 1)
-Else
- fExt = File
-End If
-If LCase(fExt) = ".bik" Then
- cType = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
-ElseIf LCase(fExt) = ".smk" Then
- cType = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
-ElseIf LCase(fExt) = ".wav" Then
- cType = CInt(GetReg(AppKey + "Compression\.wav", "0"))
-Else
- cType = CInt(GetReg(AppKey + "Compression\" + fExt, "-1"))
-End If
-Select Case cType
-Case -2
-MpqEx.Mpq.AddFile Mpq, File, MpqPath, 0
-Case -1
-MpqEx.Mpq.AddFile Mpq, File, MpqPath, 1
-Case 0, 1, 2
-MpqEx.Mpq.AddWavFile Mpq, File, MpqPath, cType
-Case Else
-MpqEx.Mpq.AddFile Mpq, File, MpqPath, 1
-End Select
-End Sub
Sub AddScriptOutput(sOutput As String)
SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 0, ByVal 0&
ScriptOut.oText = ScriptOut.oText + sOutput
Exit For
End If
Next bNum
+ GetFileTitle = Mid(FileName, bNum)
+Else
+ GetFileTitle = FileName
End If
-GetFileTitle = Mid(FileName, bNum)
End Function
-Function ListFiles(MpqName As String, ByVal FileLists As String) As String
-Dim NewFileLists As String, nFileLists() As String, ListName As String, cNum As Long, cNum2 As Long, cNum3 As Long, MpqList1 As String, MpqList2 As String, Path As String, ListLen As Long, OldLists() As String, UseOnlyAutoList As Boolean
-If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then
- ListFiles = MpqEx.Mpq.ListFiles(MpqName, FileLists)
-Else
- UseOnlyAutoList = GetReg(AppKey + "UseOnlyAutofindLists", 1)
- MpqList2 = GetExtension(MpqName)
- MpqList1 = GetFileTitle(Left(MpqName, Len(MpqName) - Len(MpqList2))) + ".txt"
- MpqList2 = GetFileTitle(MpqName) + ".txt"
- Path = GetLongPath(App.Path)
- If Right(Path, 1) <> "\" Then Path = Path + "\"
- If UseOnlyAutoList Then ListLen = Len(FileLists)
- If FileLists <> "" Then
- FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
+Function sGetFile(hMPQ As Long, ByVal FileName As String, OutPath As String, ByVal UseFullPath As Long)
+Dim hFile As Long, buffer() As Byte, fLen As Long, cNum As Long
+If SFileOpenFileEx(hMPQ, FileName, 0, hFile) Then
+ fLen = SFileGetFileSize(hFile, 0)
+ If fLen > 0 Then
+ ReDim buffer(fLen - 1)
Else
- FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
- End If
- ReDim nFileLists(0) As String
- If UseOnlyAutoList Then ReDim OldLists(0) As String
- For cNum = 1 To Len(FileLists)
- cNum2 = InStr(cNum, FileLists, vbCrLf)
- If cNum2 = 0 Then
- cNum2 = Len(FileLists) + 1
- End If
- ListName = Mid(FileLists, cNum, cNum2 - cNum)
- If UseOnlyAutoList Then
- ReDim Preserve OldLists(UBound(OldLists) + 1) As String
- OldLists(UBound(OldLists)) = GetLongPath(ListName)
- End If
- For cNum3 = 1 To Len(ListName)
- If InStr(cNum3, ListName, "\") Then
- cNum3 = InStr(cNum3, ListName, "\")
- If FileExists(Left(ListName, cNum3) + MpqList1) Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList1)
- End If
- If FileExists(Left(ListName, cNum3) + MpqList2) Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList2)
- End If
- Else
- Exit For
- End If
- Next cNum3
- If FileExists(ListName) And ListName <> Path + App.EXEName + ".exe" And ListName <> MpqName Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(ListName)
- End If
- cNum = cNum2 + 1
- Next cNum
- If UseOnlyAutoList Then
- For cNum = 1 To UBound(nFileLists)
- For cNum2 = 1 To UBound(OldLists)
- If LCase(nFileLists(cNum)) <> LCase(OldLists(cNum2)) Then
- GoTo StartSearch
- End If
- Next cNum2
- Next cNum
- UseOnlyAutoList = False
+ ReDim buffer(0)
End If
-StartSearch:
- For cNum = 1 To UBound(nFileLists)
- For cNum2 = 1 To UBound(nFileLists)
- If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then
- nFileLists(cNum2) = ""
- End If
- Next cNum2
- If UseOnlyAutoList Then
- For cNum2 = 1 To UBound(OldLists)
- If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) Then
- nFileLists(cNum) = ""
- End If
- Next cNum2
- End If
- If nFileLists(cNum) <> "" Then
- NewFileLists = NewFileLists + nFileLists(cNum) + vbCrLf
+ SFileReadFile hFile, buffer(0), fLen, ByVal 0, ByVal 0
+ SFileCloseFile hFile
+ If UseFullPath = 0 Then FileName = GetFileTitle(FileName)
+ FileName = FullPath(OutPath, FileName)
+ On Error Resume Next
+ For cNum = 1 To Len(FileName)
+ cNum = InStr(cNum, FileName, "\")
+ If cNum > 0 Then
+ MkDir Left(FileName, cNum)
+ Else
+ Exit For
End If
Next cNum
- If Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2)
- ListFiles = MpqEx.Mpq.ListFiles(MpqName, NewFileLists)
+ If FileExists(FileName) Then Kill FileName
+ On Error GoTo 0
+ cNum = FreeFile
+ On Error GoTo WriteError
+ Open FileName For Binary As #cNum
+ If fLen > 0 Then Put #cNum, 1, buffer
+ Close #cNum
+ On Error GoTo 0
End If
+Exit Function
+WriteError:
+MsgBox "Error writing file. File may be in use.", vbCritical, "WinMPQ"
+Resume Next
End Function
-Function sListFiles(MpqName As String, hMPQ As Long, ByVal FileLists As String) As String
-Dim NewFileLists As String, nFileLists() As String, ListName As String, cNum As Long, cNum2 As Long, cNum3 As Long, MpqList1 As String, MpqList2 As String, Path As String, ListLen As Long, OldLists() As String, UseOnlyAutoList As Boolean
+Function sListFiles(MpqName As String, hMPQ As Long, ByVal FileLists As String, ByRef ListedFiles() As FILELISTENTRY) As Boolean
+Dim NewFileLists As String, nFileLists() As String, ListName As String, cNum As Long, cNum2 As Long, cNum3 As Long, cNum4 As Long, MpqList1 As String, MpqList2 As String, Path As String, ListLen As Long, OldLists() As String, UseOnlyAutoList As Boolean, nHash As Long, nHashEntries As Long
+sListFiles = False
+ReDim ListedFiles(0)
+ListedFiles(0).dwFileExists = 0
If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then
- sListFiles = MpqEx.Mpq.sListFiles(hMPQ, FileLists)
+ NewFileLists = FileLists
Else
UseOnlyAutoList = GetReg(AppKey + "UseOnlyAutofindLists", 1)
MpqList2 = GetExtension(MpqName)
If FileLists <> "" Then
FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
Else
- FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName
+ FileLists = Path + App.EXEName + ".exe" + vbCrLf + MpqName
End If
ReDim nFileLists(0) As String
If UseOnlyAutoList Then ReDim OldLists(0) As String
If cNum2 = 0 Then
cNum2 = Len(FileLists) + 1
End If
- ListName = Mid(FileLists, cNum, cNum2 - cNum)
- If UseOnlyAutoList And cNum < ListLen Then
- ReDim Preserve OldLists(UBound(OldLists) + 1) As String
- OldLists(UBound(OldLists)) = GetLongPath(ListName)
- End If
- For cNum3 = 1 To Len(ListName)
- If InStr(cNum3, ListName, "\") Then
- cNum3 = InStr(cNum3, ListName, "\")
- If FileExists(Left(ListName, cNum3) + MpqList1) Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList1)
+ If cNum2 - cNum > 0 Then
+ ListName = Mid(FileLists, cNum, cNum2 - cNum)
+ If Not IsDir(ListName) Then
+ If UseOnlyAutoList And cNum < ListLen Then
+ ReDim Preserve OldLists(UBound(OldLists) + 1) As String
+ OldLists(UBound(OldLists)) = GetLongPath(ListName)
End If
- If FileExists(Left(ListName, cNum3) + MpqList2) Then
+ For cNum3 = 1 To Len(ListName)
+ If InStr(cNum3, ListName, "\") Then
+ cNum3 = InStr(cNum3, ListName, "\")
+ If FileExists(Left(ListName, cNum3) + MpqList1) Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList1)
+ End If
+ If FileExists(Left(ListName, cNum3) + MpqList2) Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList2)
+ End If
+ Else
+ Exit For
+ End If
+ Next cNum3
+ If FileExists(ListName) And ListName <> Path + App.EXEName + ".exe" And ListName <> MpqName Then
ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList2)
+ nFileLists(UBound(nFileLists)) = GetLongPath(ListName)
End If
Else
- Exit For
+ ListName = DirEx(ListName, MpqList1, 6, True) _
+ + DirEx(ListName, MpqList2, 6, True)
+ For cNum3 = 1 To Len(ListName)
+ cNum4 = InStr(cNum3, ListName, vbCrLf)
+ If cNum4 = 0 Then
+ cNum4 = Len(ListName) + 1
+ End If
+ If cNum4 - cNum3 > 0 Then
+ ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
+ nFileLists(UBound(nFileLists)) = GetLongPath(Mid(ListName, cNum3, cNum4 - cNum3))
+ End If
+ cNum3 = cNum4 + 1
+ Next cNum3
End If
- Next cNum3
- If FileExists(ListName) And ListName <> Path + App.EXEName + ".exe" And ListName <> MpqName Then
- ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
- nFileLists(UBound(nFileLists)) = GetLongPath(ListName)
End If
cNum = cNum2 + 1
Next cNum
End If
StartSearch:
For cNum = 1 To UBound(nFileLists)
- For cNum2 = 1 To UBound(nFileLists)
- If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then
- nFileLists(cNum2) = ""
- End If
- Next cNum2
- If UseOnlyAutoList Then
- For cNum2 = 1 To UBound(OldLists)
- If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) Then
- nFileLists(cNum) = ""
- Exit For
+ If nFileLists(cNum) <> "" Then
+ For cNum2 = 1 To UBound(nFileLists)
+ If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then
+ nFileLists(cNum2) = ""
End If
Next cNum2
End If
+ If UseOnlyAutoList Then
+ If nFileLists(cNum) <> "" Then
+ For cNum2 = 1 To UBound(OldLists)
+ If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList1) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList2) Then
+ nFileLists(cNum) = ""
+ Exit For
+ End If
+ Next cNum2
+ End If
+ End If
If nFileLists(cNum) <> "" Then
NewFileLists = NewFileLists + nFileLists(cNum) + vbCrLf
End If
Next cNum
If Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2)
- sListFiles = MpqEx.Mpq.sListFiles(hMPQ, NewFileLists)
End If
+nHashEntries = SFileGetFileInfo(hMPQ, SFILE_INFO_HASH_TABLE_SIZE)
+If nHashEntries - 1 < 1 Then Exit Function
+ReDim ListedFiles(nHashEntries - 1)
+sListFiles = SFileListFiles(hMPQ, NewFileLists, ListedFiles(0), 0)
End Function
Sub mAddAutoFile(hMPQ As Long, File As String, MpqPath As String)
-Dim cType As Integer, bNum As Long, fExt As String
+Dim cType As Integer, bNum As Long, fExt As String, dwFlags As Long
+dwFlags = MAFA_REPLACE_EXISTING
+If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
For bNum = 1 To Len(File)
If InStr(bNum, File, ".") > 0 Then
bNum = InStr(bNum, File, ".")
End If
If LCase(fExt) = ".bik" Then
cType = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
ElseIf LCase(fExt) = ".smk" Then
cType = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
+ElseIf LCase(fExt) = ".mp3" Then
+ cType = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
+ElseIf LCase(fExt) = ".mpq" Then
+ cType = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
+ElseIf LCase(fExt) = ".w3m" Then
+ cType = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))
+ dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
ElseIf LCase(fExt) = ".wav" Then
cType = CInt(GetReg(AppKey + "Compression\.wav", "0"))
Else
- cType = CInt(GetReg(AppKey + "Compression\" + fExt, "-1"))
+ cType = CInt(GetReg(AppKey + "Compression\" + fExt, CStr(DefaultCompressID)))
End If
Select Case cType
Case -2
-MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 0
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags, 0, 0
Case -1
-MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 1
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
+Case -3
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
Case 0, 1, 2
-MpqEx.Mpq.mAddWavFile hMPQ, File, MpqPath, cType
+MpqAddWaveToArchive hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, cType
Case Else
-MpqEx.Mpq.mAddFile hMPQ, File, MpqPath, 1
+MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel
End Select
End Sub
Function DirEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean) As String
FileExists = False
End Function
Function IsMPQ(MpqFile As String) As Boolean
-Dim fNum As Long, Text As String, bNum As Long, MpqHead As Long
-If FileExists(MpqFile) = False Then
+If FindMpqHeader(MpqFile) <> -1 Then
+ IsMPQ = True
+Else
IsMPQ = False
- Exit Function
End If
-fNum = FreeFile
-Open MpqFile For Binary As #fNum
-For bNum = 1 To LOF(fNum) Step 2 ^ 20
- Text = String(2 ^ 20 + 32, Chr(0))
- If LOF(fNum) - bNum + 1 >= 2 ^ 20 + 32 Then
- Get #fNum, bNum, Text
- Else
- Text = String(LOF(fNum) - bNum + 1, Chr(0))
- Get #fNum, bNum, Text
- End If
- MpqHead = InStr(Text, "MPQ" + Chr(26))
-CheckAgain:
- If MpqHead > 0 Then
- If JBytes(Text, MpqHead + 4, 4) >= 32 And JBytes(Text, MpqHead + 12, 2) = 0 Then
- Exit For
- Else
- MpqHead = InStr(MpqHead + 4, Text, "MPQ" + Chr(26))
- GoTo CheckAgain
- End If
- End If
-Next bNum
-Close #fNum
-IsMPQ = True
-If MpqHead = 0 Then IsMPQ = False
End Function
Sub KillEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean)
Dim Files() As String, lNum As Long, Folders() As String
RenameWithFilter = NewFileName
End Function
Function MpqDir(MpqFile As String, Filters As String)
-Dim Files As String, bNum As Long, EndLine As Long, fName As String
-Files = ListFiles(MpqFile, ListFile)
-bNum = 1
-Do Until bNum > Len(Files)
- EndLine = InStr(bNum, Files, vbCrLf)
- If EndLine = 0 Then EndLine = Len(Files) + 1
- fName = Mid(Files, bNum, EndLine - bNum)
- If MatchesFilter(fName, Filters) Then
- bNum = EndLine + 2
+Dim Files() As FILELISTENTRY, fNum As Long, szFileList As String, NamePos As Long, CurFileName As String
+Dim hMPQ As Long
+If SFileOpenArchive(MpqFile, 0, 0, hMPQ) Then
+ If sListFiles(MpqFile, hMPQ, ListFile, Files) Then
+ SFileCloseArchive hMPQ
+ For fNum = 0 To UBound(Files)
+ If Files(fNum).dwFileExists Then
+ CurFileName = StrConv(Files(fNum).szFileName, vbUnicode)
+ If MatchesFilter(CurFileName, Filters) Then
+ NamePos = InStr(1, szFileList, CurFileName + vbCrLf, 1)
+ If NamePos > 1 Then
+ NamePos = InStr(1, szFileList, vbCrLf + CurFileName + vbCrLf, 1)
+ End If
+ If NamePos > 0 Then _
+ szFileList = szFileList + CurFileName
+ End If
+ End If
+ Next fNum
+ MpqDir = MpqDir + CurFileName + vbCrLf
Else
- Files = Left(Files, bNum - 1) + Mid(Files, EndLine + 2)
+ SFileCloseArchive hMPQ
End If
-Loop
-MpqDir = Files
+End If
End Function
Sub RunScript(ScriptName As String)
-Dim fNum As Long, Script As String, sLine As String, Param() As String, bNum As Long, EndLine As Long, pNum As Long, EndParam As Long, MpqFile As String, OldDefaultMaxFiles As Long, cType As Integer, lNum As Long, OldPath As String, NewPath As String, Rswitch As Boolean, Files As String, fCount As Long, fEndLine As Long, fLine As String, ScriptNewFile As Boolean, CurPath As String, fLine2 As String, fLineTitle As String, hMPQ As Long
+Dim fNum As Long, Script As String, sLine As String, Param() As String, bNum As Long, EndLine As Long, pNum As Long, EndParam As Long, MpqFile As String, OldDefaultMaxFiles As Long, cType As Integer, lNum As Long, OldPath As String, NewPath As String, Rswitch As Boolean, Files As String, fCount As Long, fEndLine As Long, fLine As String, ScriptNewFile As Boolean, CurPath As String, fLine2 As String, fLineTitle As String, hMPQ As Long, hFile As Long, dwFlags
If FileExists(ScriptName) = False Then
ScriptOut.Show
AddScriptOutput "Could not find script " + ScriptName + vbCrLf
If Right(Script, 2) <> vbCrLf Then Script = Script + vbCrLf
ScriptOut.Show
AddScriptOutput "Script: " + ScriptName + vbCrLf + vbCrLf
-OldDefaultMaxFiles = MpqEx.Mpq.DefaultMaxFiles
+OldDefaultMaxFiles = DefaultMaxFiles
lNum = 1
For bNum = 1 To Len(Script)
EndLine = InStr(bNum, Script, vbCrLf)
If Param(2) <> "" Then
MpqFile = Param(2)
If Param(3) <> "" And FileExists(MpqFile) = False Then
- MpqEx.Mpq.DefaultMaxFiles = Param(3)
+ DefaultMaxFiles = Param(3)
End If
If FileExists(MpqFile) Then
AddScriptOutput "Opened " + MpqFile + vbCrLf
If Param(2) <> "" Then
MpqFile = Param(2)
If Param(3) <> "" Then
- MpqEx.Mpq.DefaultMaxFiles = Param(3)
+ DefaultMaxFiles = Param(3)
End If
ScriptNewFile = True
AddScriptOutput "Created new " + MpqFile + vbCrLf
Files = ""
fEndLine = 0
fLine = ""
+ dwFlags = MAFA_REPLACE_EXISTING
+ If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
For pNum = 3 To UBound(Param)
If LCase(Param(pNum)) = "/wav" Then
cType = 2
+ dwFlags = dwFlags Or MAFA_COMPRESS
ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
cType = 1
+ dwFlags = dwFlags Or MAFA_COMPRESS
ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then
cType = -1
ElseIf LCase(Param(pNum)) = "/r" Then
ScriptNewFile = False
End If
Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)
- hMPQ = MpqEx.Mpq.mOpenMpq(FullPath(NewPath, MpqFile))
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
If hMPQ = 0 Then
AddScriptOutput "Can't create archive " + MpqFile + vbCrLf
GoTo CommandError
If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"
If cType = 2 Then
- MpqEx.Mpq.mAddWavFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 0
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
ElseIf cType = -1 Then
mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
ElseIf cType = 1 Then
- MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 1
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
Else
- MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, 0
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
End If
Else
If cType = 2 Then
- MpqEx.Mpq.mAddWavFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0
ElseIf cType = -1 Then
mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
ElseIf cType = 1 Then
- MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3), 1
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
Else
- MpqEx.Mpq.mAddFile hMPQ, FullPath(CurPath, fLine), Param(3), 0
+ MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
End If
End If
AddScriptOutput " Done" + vbCrLf
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
- MpqEx.Mpq.mCloseMpq hMPQ
+ MpqCloseUpdatedArchive hMPQ, 0
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " added" + vbCrLf
End If
If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
- If MpqEx.Mpq.SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
+ If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf
GoTo CommandError
End If
AddScriptOutput "Line " + CStr(lNum) + ": "
End If
AddScriptOutput "Extracting " + fLine + "..."
- MpqEx.Mpq.sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
+ sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
AddScriptOutput " Done" + vbCrLf
fCount = fCount + 1
pNum = fEndLine + 1
Next pNum
- MpqEx.Mpq.SFileCloseArchive hMPQ
+ SFileCloseArchive hMPQ
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " extracted" + vbCrLf
End If
Else
- MpqEx.Mpq.GetFile FullPath(NewPath, MpqFile), Param(2), FullPath(CurPath, Param(3)), cType
+ If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
+ AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf
+ GoTo CommandError
+ End If
+ sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType
+ SFileCloseArchive hMPQ
AddScriptOutput " Done" + vbCrLf
End If
Else
If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
- For pNum = 1 To Len(Files)
- fEndLine = InStr(pNum, Files, vbCrLf)
- fLine = Mid(Files, pNum, fEndLine - pNum)
- If pNum > 1 Then
- AddScriptOutput "Line " + CStr(lNum) + ": "
- End If
- fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
- AddScriptOutput "Renaming " + fLine + " => " + fLine2 + "..."
- If MpqEx.Mpq.FileExists(FullPath(NewPath, MpqFile), fLine2) Then
- MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), fLine2
- MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), fLine, fLine2
- Else
- MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), fLine, fLine2
- End If
- AddScriptOutput " Done" + vbCrLf
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ For pNum = 1 To Len(Files)
+ fEndLine = InStr(pNum, Files, vbCrLf)
+ fLine = Mid(Files, pNum, fEndLine - pNum)
+ If pNum > 1 Then
+ AddScriptOutput "Line " + CStr(lNum) + ": "
+ End If
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
+ AddScriptOutput "Renaming " + fLine + " => " + fLine2 + "..."
+ If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, fLine2
+ MpqRenameFile hMPQ, fLine, fLine2
+ Else
+ MpqRenameFile hMPQ, fLine, fLine2
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " renamed" + vbCrLf
End If
AddScriptOutput "You must use wildcards with new name" + vbCrLf
End If
Else
- If MpqEx.Mpq.FileExists(FullPath(NewPath, MpqFile), Param(3)) Then
- MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), Param(3)
- MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), Param(2), Param(3)
- Else
- MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), Param(2), Param(3)
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, Param(3)
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ Else
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ End If
+ MpqCloseUpdatedArchive hMPQ, 0
End If
AddScriptOutput " Done" + vbCrLf
End If
If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then
If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
- For pNum = 1 To Len(Files)
- fEndLine = InStr(pNum, Files, vbCrLf)
- fLine = Mid(Files, pNum, fEndLine - pNum)
- If pNum > 1 Then
- AddScriptOutput "Line " + CStr(lNum) + ": "
- End If
- fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
- AddScriptOutput "Moving " + fLine + " => " + fLine2 + "..."
- If MpqEx.Mpq.FileExists(FullPath(NewPath, MpqFile), fLine2) Then
- MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), fLine2
- MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), fLine, fLine2
- Else
- MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), fLine, fLine2
- End If
- AddScriptOutput " Done" + vbCrLf
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ For pNum = 1 To Len(Files)
+ fEndLine = InStr(pNum, Files, vbCrLf)
+ fLine = Mid(Files, pNum, fEndLine - pNum)
+ If pNum > 1 Then
+ AddScriptOutput "Line " + CStr(lNum) + ": "
+ End If
+ fLine2 = RenameWithFilter(fLine, Param(2), Param(3))
+ AddScriptOutput "Moving " + fLine + " => " + fLine2 + "..."
+ If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, fLine2
+ MpqRenameFile hMPQ, fLine, fLine2
+ Else
+ MpqRenameFile hMPQ, fLine, fLine2
+ End If
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " moved" + vbCrLf
End If
Else
- If MpqEx.Mpq.FileExists(FullPath(NewPath, MpqFile), Param(3)) Then
- MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), Param(3)
- MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), Param(2), Param(3)
- Else
- MpqEx.Mpq.RenFile FullPath(NewPath, MpqFile), Param(2), Param(3)
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then
+ SFileCloseFile hFile
+ MpqDeleteFile hMPQ, Param(3)
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ Else
+ MpqRenameFile hMPQ, Param(2), Param(3)
+ End If
+ MpqCloseUpdatedArchive hMPQ, 0
End If
AddScriptOutput " Done" + vbCrLf
End If
If Left(Param(2), 1) <> "/" And Param(2) <> "" Then
If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
- For pNum = 1 To Len(Files)
- fEndLine = InStr(pNum, Files, vbCrLf)
- fLine = Mid(Files, pNum, fEndLine - pNum)
- If pNum > 1 Then
- AddScriptOutput "Line " + CStr(lNum) + ": "
- End If
- AddScriptOutput "Deleting " + fLine + "..."
- MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), fLine
- AddScriptOutput " Done" + vbCrLf
- fCount = fCount + 1
- pNum = fEndLine + 1
- Next pNum
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ For pNum = 1 To Len(Files)
+ fEndLine = InStr(pNum, Files, vbCrLf)
+ fLine = Mid(Files, pNum, fEndLine - pNum)
+ If pNum > 1 Then
+ AddScriptOutput "Line " + CStr(lNum) + ": "
+ End If
+ AddScriptOutput "Deleting " + fLine + "..."
+ MpqDeleteFile hMPQ, fLine
+ AddScriptOutput " Done" + vbCrLf
+ fCount = fCount + 1
+ pNum = fEndLine + 1
+ Next pNum
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
If fCount > 1 Then
AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " deleted" + vbCrLf
End If
Else
- MpqEx.Mpq.DelFile FullPath(NewPath, MpqFile), Param(2)
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ MpqDeleteFile hMPQ, Param(2)
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
AddScriptOutput " Done" + vbCrLf
End If
Else
Case "f", "flush", "compact"
If MpqFile <> "" Then
AddScriptOutput "Flushing " + MpqFile + "..."
- MpqEx.Mpq.CompactMpq FullPath(NewPath, MpqFile)
+ hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
+ If hMPQ Then
+ MpqCompactArchive hMPQ
+ MpqCloseUpdatedArchive hMPQ, 0
+ End If
AddScriptOutput " Done" + vbCrLf
Else
AddScriptOutput "No archive open" + vbCrLf
Files = MpqDir(FullPath(NewPath, MpqFile), Param(2))
Param(2) = Param(3)
Else
- Files = ListFiles(FullPath(NewPath, MpqFile), ListFile)
+ Files = MpqDir(FullPath(NewPath, MpqFile), "*")
End If
fNum = FreeFile
Open FullPath(CurPath, Param(2)) For Binary As #fNum
lNum = lNum + 1
bNum = EndLine + 1
Next bNum
-MpqEx.Mpq.DefaultMaxFiles = OldDefaultMaxFiles
+DefaultMaxFiles = OldDefaultMaxFiles
If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
ChDir OldPath
End Sub
SBytes = Mid(StrConv(buffer, vbUnicode), Start + 1, Length)
End Function
Function FindMpqHeader(MpqFile As String) As Long
-Dim fNum As Long, Text As String, bNum As Long, MpqHead As Long
-If FileExists(MpqFile) = False Then
- FindMpqHeader = -1
- Exit Function
-End If
-fNum = FreeFile
-Open MpqFile For Binary As #fNum
-For bNum = 1 To LOF(fNum) Step 2 ^ 20
- Text = String(2 ^ 20 + 32, Chr(0))
- If LOF(fNum) - bNum + 1 >= 2 ^ 20 + 32 Then
- Get #fNum, bNum, Text
- Else
- Text = String(LOF(fNum) - bNum + 1, Chr(0))
- Get #fNum, bNum, Text
+ If FileExists(MpqFile) = False Then
+ FindMpqHeader = -1
+ Exit Function
End If
- MpqHead = InStr(Text, "MPQ" + Chr(26))
-CheckAgain:
- If MpqHead > 0 Then
- If JBytes(Text, MpqHead + 4, 4) >= 32 And JBytes(Text, MpqHead + 12, 2) = 0 Then
- Exit For
- Else
- MpqHead = InStr(MpqHead + 4, Text, "MPQ" + Chr(26))
- GoTo CheckAgain
+ Dim hFile
+ hFile = FreeFile
+ Open MpqFile For Binary As #hFile
+ Dim FileLen As Long
+ FileLen = LOF(hFile)
+ Dim pbuf As String
+ pbuf = String(32, Chr(0))
+ Dim i As Long
+ For i = 0 To FileLen - 1 Step 512
+ Get #hFile, 1 + i, pbuf
+ If Left(pbuf, 4) = "MPQ" + Chr(26) Or Left(pbuf, 4) = "BN3" + Chr(26) Then
+ ' Storm no longer does this, so this shouldn't either
+ 'FileLen = FileLen - i
+ 'If JBytes(pbuf, 9, 4) = FileLen
+ ' FileMpqHeader = i
+ ' Close #hFile
+ ' Exit Function
+ 'Else
+ ' FileLen = FileLen + i
+ 'End If
+ FindMpqHeader = i
+ Close #hFile
+ Exit Function
End If
- End If
-Next bNum
-Close #fNum
-FindMpqHeader = bNum + MpqHead - 2
-If MpqHead = 0 Then FindMpqHeader = -1
+ Next i
+ FindMpqHeader = -1
+ Close #hFile
End Function
Function JBytes(Text As String, Start As Long, Length As Long)
Dim buffer() As Byte, NumData As Currency