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:
| Commit | Line | Data |
|---|---|---|
| 0d212c7b | 1 | Attribute VB_Name = "MpqStuff" |
| 2 | Option Explicit | |
| 3 | ||
| 5f007675 | 4 | Type SHELLEXECUTEINFO |
| 5 | cbSize As Long | |
| 6 | fMask As Long | |
| 7 | hWnd As Long | |
| 8 | lpVerb As String | |
| 9 | lpFile As String | |
| 10 | lpParameters As String | |
| 11 | lpDirectory As String | |
| 12 | nShow As Long | |
| 13 | hInstApp As Long | |
| 14 | ||
| 15 | ' Optional members | |
| 16 | lpIDList As Long | |
| 17 | lpClass As String | |
| 18 | hkeyClass As Long | |
| 19 | dwHotKey As Long | |
| 20 | hIcon As Long | |
| 21 | hProcess As Long | |
| 22 | End Type | |
| 23 | ||
| 0d212c7b | 24 | Public Declare Function ShellExecute Lib _ |
| 25 | "Shell32.dll" Alias "ShellExecuteA" _ | |
| 26 | (ByVal hWnd As Long, _ | |
| 27 | ByVal lpOperation As String, _ | |
| 28 | ByVal lpFile As String, _ | |
| 29 | ByVal lpParameters As String, _ | |
| 30 | ByVal lpDirectory As String, _ | |
| 31 | ByVal nShowCmd As Long) As Long | |
| 5f007675 | 32 | Public Declare Function ShellExecuteEx Lib _ |
| 33 | "Shell32.dll" Alias "ShellExecuteExA" _ | |
| 34 | (sei As SHELLEXECUTEINFO) As Long | |
| 0d212c7b | 35 | Public Declare Sub SHChangeNotify Lib _ |
| 36 | "Shell32.dll" (ByVal wEventId As Long, _ | |
| 37 | ByVal uFlags As Integer, _ | |
| 38 | ByVal dwItem1 As Any, _ | |
| 39 | ByVal dwItem2 As Any) | |
| 40 | Public Declare Function SendMessageA Lib _ | |
| 62046253 | 41 | "User32.dll" _ |
| 0d212c7b | 42 | (ByVal hWnd As Long, _ |
| 43 | ByVal Msg As Long, _ | |
| 44 | ByVal Wp As Long, _ | |
| 45 | Lp As Any) As Long | |
| 46 | Declare Function GetLongPathName Lib "Kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long | |
| 47 | Private Declare Sub CopyMemory Lib "Kernel32.dll" _ | |
| 48 | Alias "RtlMoveMemory" ( _ | |
| 49 | ByRef Destination As Any, _ | |
| 50 | ByRef Source As Any, _ | |
| 51 | ByVal Length As Long) | |
| 52 | ||
| 53 | Public CD As OPENFILENAME, PathInput As BROWSEINFO | |
| 5f007675 | 54 | 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 |
| 0d212c7b | 55 | Public Const AppKey As String = "HKEY_CURRENT_USER\Software\ShadowFlare\WinMPQ\", SharedAppKey As String = "HKEY_LOCAL_MACHINE\Software\ShadowFlare\WinMPQ\" |
| 56 | Public Const MPQ_ERROR_INIT_FAILED As Long = &H85000001 'Unspecified error | |
| 57 | Public Const MPQ_ERROR_NO_STAREDIT As Long = &H85000002 'Can't find StarEdit.exe | |
| 58 | Public Const MPQ_ERROR_BAD_STAREDIT As Long = &H85000003 'Bad version of StarEdit.exe. Need SC/BW 1.07 | |
| 59 | Public Const MPQ_ERROR_STAREDIT_RUNNING As Long = &H85000004 'StarEdit.exe is running. Must be closed | |
| 60 | Public Const SHCNE_ASSOCCHANGED As Long = &H8000000 | |
| 61 | Public Const SHCNF_IDLIST As Long = &H0 | |
| 62 | Public Const WM_SETREDRAW As Long = &HB | |
| 63 | Public Const WM_PAINT As Long = &HF | |
| 64 | Const gintMAX_SIZE% = 255 | |
| 5f007675 | 65 | Public Const SEE_MASK_CLASSNAME As Long = &H1 |
| 62046253 | 66 | Sub AboutSFMpq() |
| 67 | Dim AboutPage As String, Path As String | |
| 68 | Path = App.Path | |
| 69 | If Right(Path, 1) <> "\" Then Path = Path + "\" | |
| 70 | AboutPage = Path + "sfmpq.dll" | |
| 71 | If Not FileExists(AboutPage) Then AboutPage = "sfmpq.dll" | |
| 72 | ShellExecute 0, vbNullString, "res://" + AboutPage + "/about", vbNullString, vbNullString, 1 | |
| 73 | End Sub | |
| 74 | Function mOpenMpq(FileName As String) As Long | |
| 75 | Dim hMPQ As Long | |
| 76 | mOpenMpq = 0 | |
| 5f007675 | 77 | hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_OPEN_EXISTING Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize) |
| 62046253 | 78 | If hMPQ = 0 Or hMPQ = INVALID_HANDLE_VALUE Then |
| 5f007675 | 79 | hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_CREATE_NEW Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize) |
| 62046253 | 80 | End If |
| 81 | If hMPQ <> 0 And hMPQ <> INVALID_HANDLE_VALUE Then | |
| 82 | mOpenMpq = hMPQ | |
| 83 | End If | |
| 84 | End Function | |
| 0d212c7b | 85 | Function PathInputBox(lpFolderDialog As BROWSEINFO, pCaption As String, StartFolder As String) As String |
| 86 | lpFolderDialog.Title = pCaption | |
| 62046253 | 87 | Dim result As Long |
| 88 | result = ShowFolder(lpFolderDialog) | |
| 89 | If result = 0 Then Exit Function | |
| 90 | PathInputBox = GetPathFromID(result) | |
| 0d212c7b | 91 | End Function |
| 92 | Function GetLongPath(Path As String) As String | |
| 93 | Dim strBuf As String, StrLength As Long | |
| 94 | strBuf = Space$(gintMAX_SIZE) | |
| 95 | StrLength = GetLongPathName(Path, strBuf, gintMAX_SIZE) | |
| 96 | strBuf = Left(strBuf, StrLength) | |
| 97 | If strBuf <> "" Then | |
| 98 | GetLongPath = strBuf | |
| 99 | Else | |
| 100 | GetLongPath = Path | |
| 101 | End If | |
| 102 | End Function | |
| 0d212c7b | 103 | Sub AddScriptOutput(sOutput As String) |
| 104 | SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 0, ByVal 0& | |
| 105 | ScriptOut.oText = ScriptOut.oText + sOutput | |
| 106 | SendMessageA ScriptOut.oText.hWnd, WM_SETREDRAW, 1, ByVal 0& | |
| 107 | ScriptOut.oText.SelStart = Len(ScriptOut.oText) | |
| 108 | End Sub | |
| 109 | Function GetFileTitle(FileName As String) As String | |
| 110 | Dim bNum As Long | |
| 111 | If InStr(FileName, "\") > 0 Then | |
| 112 | For bNum = 1 To Len(FileName) | |
| 113 | If InStr(bNum, FileName, "\") > 0 Then | |
| 114 | bNum = InStr(bNum, FileName, "\") | |
| 115 | Else | |
| 116 | Exit For | |
| 117 | End If | |
| 118 | Next bNum | |
| 62046253 | 119 | GetFileTitle = Mid(FileName, bNum) |
| 120 | Else | |
| 121 | GetFileTitle = FileName | |
| 0d212c7b | 122 | End If |
| 0d212c7b | 123 | End Function |
| 62046253 | 124 | Function sGetFile(hMPQ As Long, ByVal FileName As String, OutPath As String, ByVal UseFullPath As Long) |
| 125 | Dim hFile As Long, buffer() As Byte, fLen As Long, cNum As Long | |
| 126 | If SFileOpenFileEx(hMPQ, FileName, 0, hFile) Then | |
| 127 | fLen = SFileGetFileSize(hFile, 0) | |
| 128 | If fLen > 0 Then | |
| 129 | ReDim buffer(fLen - 1) | |
| 0d212c7b | 130 | Else |
| 62046253 | 131 | ReDim buffer(0) |
| 0d212c7b | 132 | End If |
| 62046253 | 133 | SFileReadFile hFile, buffer(0), fLen, ByVal 0, ByVal 0 |
| 134 | SFileCloseFile hFile | |
| 135 | If UseFullPath = 0 Then FileName = GetFileTitle(FileName) | |
| 136 | FileName = FullPath(OutPath, FileName) | |
| 137 | On Error Resume Next | |
| 138 | For cNum = 1 To Len(FileName) | |
| 139 | cNum = InStr(cNum, FileName, "\") | |
| 140 | If cNum > 0 Then | |
| 141 | MkDir Left(FileName, cNum) | |
| 142 | Else | |
| 143 | Exit For | |
| 0d212c7b | 144 | End If |
| 145 | Next cNum | |
| 62046253 | 146 | If FileExists(FileName) Then Kill FileName |
| 147 | On Error GoTo 0 | |
| 148 | cNum = FreeFile | |
| 149 | On Error GoTo WriteError | |
| 150 | Open FileName For Binary As #cNum | |
| 151 | If fLen > 0 Then Put #cNum, 1, buffer | |
| 152 | Close #cNum | |
| 153 | On Error GoTo 0 | |
| 0d212c7b | 154 | End If |
| 62046253 | 155 | Exit Function |
| 156 | WriteError: | |
| 157 | MsgBox "Error writing file. File may be in use.", vbCritical, "WinMPQ" | |
| 5f007675 | 158 | Close #cNum |
| 0d212c7b | 159 | End Function |
| 62046253 | 160 | Function sListFiles(MpqName As String, hMPQ As Long, ByVal FileLists As String, ByRef ListedFiles() As FILELISTENTRY) As Boolean |
| 161 | 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 | |
| 162 | sListFiles = False | |
| 163 | ReDim ListedFiles(0) | |
| 164 | ListedFiles(0).dwFileExists = 0 | |
| 0d212c7b | 165 | If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then |
| 62046253 | 166 | NewFileLists = FileLists |
| 0d212c7b | 167 | Else |
| 168 | UseOnlyAutoList = GetReg(AppKey + "UseOnlyAutofindLists", 1) | |
| 169 | MpqList2 = GetExtension(MpqName) | |
| 170 | MpqList1 = GetFileTitle(Left(MpqName, Len(MpqName) - Len(MpqList2))) + ".txt" | |
| 171 | MpqList2 = GetFileTitle(MpqName) + ".txt" | |
| 172 | Path = GetLongPath(App.Path) | |
| 173 | If Right(Path, 1) <> "\" Then Path = Path + "\" | |
| 174 | If UseOnlyAutoList Then ListLen = Len(FileLists) | |
| 175 | If FileLists <> "" Then | |
| 176 | FileLists = FileLists + vbCrLf + Path + App.EXEName + ".exe" + vbCrLf + MpqName | |
| 177 | Else | |
| 62046253 | 178 | FileLists = Path + App.EXEName + ".exe" + vbCrLf + MpqName |
| 0d212c7b | 179 | End If |
| 180 | ReDim nFileLists(0) As String | |
| 181 | If UseOnlyAutoList Then ReDim OldLists(0) As String | |
| 182 | For cNum = 1 To Len(FileLists) | |
| 183 | cNum2 = InStr(cNum, FileLists, vbCrLf) | |
| 184 | If cNum2 = 0 Then | |
| 185 | cNum2 = Len(FileLists) + 1 | |
| 186 | End If | |
| 62046253 | 187 | If cNum2 - cNum > 0 Then |
| 188 | ListName = Mid(FileLists, cNum, cNum2 - cNum) | |
| 189 | If Not IsDir(ListName) Then | |
| 190 | If UseOnlyAutoList And cNum < ListLen Then | |
| 191 | ReDim Preserve OldLists(UBound(OldLists) + 1) As String | |
| 192 | OldLists(UBound(OldLists)) = GetLongPath(ListName) | |
| 0d212c7b | 193 | End If |
| 62046253 | 194 | For cNum3 = 1 To Len(ListName) |
| 195 | If InStr(cNum3, ListName, "\") Then | |
| 196 | cNum3 = InStr(cNum3, ListName, "\") | |
| 197 | If FileExists(Left(ListName, cNum3) + MpqList1) Then | |
| 198 | ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String | |
| 199 | nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList1) | |
| 200 | End If | |
| 201 | If FileExists(Left(ListName, cNum3) + MpqList2) Then | |
| 202 | ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String | |
| 203 | nFileLists(UBound(nFileLists)) = GetLongPath(Left(ListName, cNum3) + MpqList2) | |
| 204 | End If | |
| 205 | Else | |
| 206 | Exit For | |
| 207 | End If | |
| 208 | Next cNum3 | |
| 209 | If FileExists(ListName) And ListName <> Path + App.EXEName + ".exe" And ListName <> MpqName Then | |
| 0d212c7b | 210 | ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String |
| 62046253 | 211 | nFileLists(UBound(nFileLists)) = GetLongPath(ListName) |
| 0d212c7b | 212 | End If |
| 213 | Else | |
| 62046253 | 214 | ListName = DirEx(ListName, MpqList1, 6, True) _ |
| 215 | + DirEx(ListName, MpqList2, 6, True) | |
| 216 | For cNum3 = 1 To Len(ListName) | |
| 217 | cNum4 = InStr(cNum3, ListName, vbCrLf) | |
| 218 | If cNum4 = 0 Then | |
| 219 | cNum4 = Len(ListName) + 1 | |
| 220 | End If | |
| 221 | If cNum4 - cNum3 > 0 Then | |
| 222 | ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String | |
| 223 | nFileLists(UBound(nFileLists)) = GetLongPath(Mid(ListName, cNum3, cNum4 - cNum3)) | |
| 224 | End If | |
| 225 | cNum3 = cNum4 + 1 | |
| 226 | Next cNum3 | |
| 0d212c7b | 227 | End If |
| 0d212c7b | 228 | End If |
| 229 | cNum = cNum2 + 1 | |
| 230 | Next cNum | |
| 231 | If UseOnlyAutoList Then | |
| 232 | For cNum = 1 To UBound(nFileLists) | |
| 233 | For cNum2 = 1 To UBound(OldLists) | |
| 234 | If LCase(nFileLists(cNum)) <> LCase(OldLists(cNum2)) Then | |
| 235 | GoTo StartSearch | |
| 236 | End If | |
| 237 | Next cNum2 | |
| 238 | Next cNum | |
| 239 | UseOnlyAutoList = False | |
| 240 | End If | |
| 241 | StartSearch: | |
| 242 | For cNum = 1 To UBound(nFileLists) | |
| 62046253 | 243 | If nFileLists(cNum) <> "" Then |
| 244 | For cNum2 = 1 To UBound(nFileLists) | |
| 245 | If LCase(nFileLists(cNum)) = LCase(nFileLists(cNum2)) And cNum <> cNum2 Then | |
| 246 | nFileLists(cNum2) = "" | |
| 0d212c7b | 247 | End If |
| 248 | Next cNum2 | |
| 249 | End If | |
| 62046253 | 250 | If UseOnlyAutoList Then |
| 251 | If nFileLists(cNum) <> "" Then | |
| 252 | For cNum2 = 1 To UBound(OldLists) | |
| 253 | If LCase(nFileLists(cNum)) = LCase(OldLists(cNum2)) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList1) And LCase(GetFileTitle(nFileLists(cNum))) <> LCase(MpqList2) Then | |
| 254 | nFileLists(cNum) = "" | |
| 255 | Exit For | |
| 256 | End If | |
| 257 | Next cNum2 | |
| 258 | End If | |
| 259 | End If | |
| 0d212c7b | 260 | If nFileLists(cNum) <> "" Then |
| 261 | NewFileLists = NewFileLists + nFileLists(cNum) + vbCrLf | |
| 262 | End If | |
| 263 | Next cNum | |
| 264 | If Right(NewFileLists, 2) = vbCrLf Then NewFileLists = Left(NewFileLists, Len(NewFileLists) - 2) | |
| 0d212c7b | 265 | End If |
| 62046253 | 266 | nHashEntries = SFileGetFileInfo(hMPQ, SFILE_INFO_HASH_TABLE_SIZE) |
| 267 | If nHashEntries - 1 < 1 Then Exit Function | |
| 268 | ReDim ListedFiles(nHashEntries - 1) | |
| 269 | sListFiles = SFileListFiles(hMPQ, NewFileLists, ListedFiles(0), 0) | |
| 0d212c7b | 270 | End Function |
| 271 | Sub mAddAutoFile(hMPQ As Long, File As String, MpqPath As String) | |
| 62046253 | 272 | Dim cType As Integer, bNum As Long, fExt As String, dwFlags As Long |
| 273 | dwFlags = MAFA_REPLACE_EXISTING | |
| 274 | If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT | |
| 0d212c7b | 275 | For bNum = 1 To Len(File) |
| 276 | If InStr(bNum, File, ".") > 0 Then | |
| 277 | bNum = InStr(bNum, File, ".") | |
| 278 | Else | |
| 279 | Exit For | |
| 280 | End If | |
| 281 | Next bNum | |
| 282 | If bNum > 1 Then | |
| 283 | fExt = Mid(File, bNum - 1) | |
| 284 | Else | |
| 285 | fExt = File | |
| 286 | End If | |
| 287 | If LCase(fExt) = ".bik" Then | |
| 288 | cType = CInt(GetReg(AppKey + "Compression\.bik", "-2")) | |
| 62046253 | 289 | dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT) |
| 0d212c7b | 290 | ElseIf LCase(fExt) = ".smk" Then |
| 291 | cType = CInt(GetReg(AppKey + "Compression\.smk", "-2")) | |
| 62046253 | 292 | dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT) |
| 293 | ElseIf LCase(fExt) = ".mp3" Then | |
| 294 | cType = CInt(GetReg(AppKey + "Compression\.mp3", "-2")) | |
| 295 | dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT) | |
| 296 | ElseIf LCase(fExt) = ".mpq" Then | |
| 297 | cType = CInt(GetReg(AppKey + "Compression\.mpq", "-2")) | |
| 298 | dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT) | |
| 299 | ElseIf LCase(fExt) = ".w3m" Then | |
| 300 | cType = CInt(GetReg(AppKey + "Compression\.w3m", "-2")) | |
| 301 | dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT) | |
| 0d212c7b | 302 | ElseIf LCase(fExt) = ".wav" Then |
| 303 | cType = CInt(GetReg(AppKey + "Compression\.wav", "0")) | |
| 304 | Else | |
| 62046253 | 305 | cType = CInt(GetReg(AppKey + "Compression\" + fExt, CStr(DefaultCompressID))) |
| 0d212c7b | 306 | End If |
| 307 | Select Case cType | |
| 308 | Case -2 | |
| 62046253 | 309 | MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags, 0, 0 |
| 0d212c7b | 310 | Case -1 |
| 62046253 | 311 | MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0 |
| 312 | Case -3 | |
| 313 | MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel | |
| 0d212c7b | 314 | Case 0, 1, 2 |
| 62046253 | 315 | MpqAddWaveToArchive hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, cType |
| 0d212c7b | 316 | Case Else |
| 62046253 | 317 | MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel |
| 0d212c7b | 318 | End Select |
| 319 | End Sub | |
| 320 | Function DirEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean) As String | |
| 321 | Dim Files() As String, lNum As Long, Folders() As String | |
| 322 | If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\" | |
| 323 | ReDim Files(0) As String | |
| 324 | Files(0) = Dir(Path + Filter, Attributes) | |
| 325 | If Files(0) <> "" Then | |
| 326 | Do | |
| 327 | ReDim Preserve Files(UBound(Files) + 1) As String | |
| 328 | Files(UBound(Files)) = Dir | |
| 329 | Loop Until Files(UBound(Files)) = "" | |
| 330 | ReDim Preserve Files(UBound(Files) - 1) As String | |
| 331 | End If | |
| 332 | For lNum = 0 To UBound(Files) | |
| 333 | If Files(lNum) <> "" Then | |
| 334 | If IsDir(Path + Files(lNum)) = False And (Attributes And vbDirectory) <> vbDirectory Then | |
| 335 | DirEx = DirEx + Path + Files(lNum) + vbCrLf | |
| 336 | ElseIf IsDir(Path + Files(lNum)) = True And (Attributes And vbDirectory) Then | |
| 337 | DirEx = DirEx + Path + Files(lNum) + vbCrLf | |
| 338 | End If | |
| 339 | End If | |
| 340 | Next lNum | |
| 341 | If Recurse = True And (InStr(Filter, "?") > 0 Or InStr(Filter, "*") > 0) Then | |
| 342 | ReDim Folders(0) As String | |
| 343 | Folders(0) = Dir(Path, vbDirectory) | |
| 344 | If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir | |
| 345 | If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir | |
| 346 | If Folders(0) <> "" Then | |
| 347 | Do | |
| 348 | ReDim Preserve Folders(UBound(Folders) + 1) As String | |
| 349 | Folders(UBound(Folders)) = Dir | |
| 350 | If Folders(UBound(Folders)) = "." Or Folders(UBound(Folders)) = ".." Then | |
| 351 | ReDim Preserve Folders(UBound(Folders) - 1) As String | |
| 352 | End If | |
| 353 | Loop Until Folders(UBound(Folders)) = "" | |
| 354 | ReDim Preserve Folders(UBound(Folders) - 1) As String | |
| 355 | End If | |
| 356 | For lNum = 0 To UBound(Folders) | |
| 357 | If Folders(lNum) <> "" Then | |
| 358 | If IsDir(Path + Folders(lNum)) Then | |
| 359 | DirEx = DirEx + DirEx(Path + Folders(lNum), Filter, Attributes, Recurse) | |
| 360 | End If | |
| 361 | End If | |
| 362 | Next lNum | |
| 363 | End If | |
| 364 | End Function | |
| 365 | Function GetExtension(FileName As String) As String | |
| 366 | Dim bNum As Long | |
| 367 | If InStr(FileName, ".") > 0 Then | |
| 368 | For bNum = 1 To Len(FileName) | |
| 369 | If InStr(bNum, FileName, ".") > 0 Then | |
| 370 | bNum = InStr(bNum, FileName, ".") | |
| 371 | Else | |
| 372 | Exit For | |
| 373 | End If | |
| 374 | Next bNum | |
| 375 | GetExtension = Mid(FileName, bNum - 1) | |
| 376 | Else | |
| 377 | GetExtension = "" | |
| 378 | End If | |
| 379 | End Function | |
| 380 | Function IsDir(DirPath As String) As Boolean | |
| 381 | On Error GoTo IsNotDir | |
| 382 | If GetAttr(DirPath) And vbDirectory Then | |
| 383 | IsDir = True | |
| 384 | Else | |
| 385 | IsDir = False | |
| 386 | End If | |
| 387 | Exit Function | |
| 388 | IsNotDir: | |
| 389 | IsDir = False | |
| 390 | End Function | |
| 391 | Function FileExists(FileName As String) As Boolean | |
| 392 | On Error GoTo NoFile | |
| 393 | If (GetAttr(FileName) And vbDirectory) <> vbDirectory Then | |
| 394 | FileExists = True | |
| 395 | Else | |
| 396 | FileExists = False | |
| 397 | End If | |
| 398 | Exit Function | |
| 399 | NoFile: | |
| 400 | FileExists = False | |
| 401 | End Function | |
| 402 | Function IsMPQ(MpqFile As String) As Boolean | |
| 62046253 | 403 | If FindMpqHeader(MpqFile) <> -1 Then |
| 404 | IsMPQ = True | |
| 405 | Else | |
| 0d212c7b | 406 | IsMPQ = False |
| 0d212c7b | 407 | End If |
| 0d212c7b | 408 | End Function |
| 409 | Sub KillEx(ByVal Path As String, Filter As String, Attributes, Recurse As Boolean) | |
| 410 | Dim Files() As String, lNum As Long, Folders() As String | |
| 411 | If Right(Path, 1) <> "\" And Path <> "" Then Path = Path + "\" | |
| 412 | ReDim Files(0) As String | |
| 413 | Files(0) = Dir(Path + Filter, Attributes) | |
| 414 | If Files(0) <> "" Then | |
| 415 | Do | |
| 416 | ReDim Preserve Files(UBound(Files) + 1) As String | |
| 417 | Files(UBound(Files)) = Dir | |
| 418 | Loop Until Files(UBound(Files)) = "" | |
| 419 | ReDim Preserve Files(UBound(Files) - 1) As String | |
| 420 | End If | |
| 421 | For lNum = 0 To UBound(Files) | |
| 422 | If Files(lNum) <> "" Then | |
| 423 | If IsDir(Path + Files(lNum)) = False Then | |
| 424 | On Error Resume Next | |
| 425 | Kill Path + Files(lNum) | |
| 426 | On Error GoTo 0 | |
| 427 | End If | |
| 428 | End If | |
| 429 | Next lNum | |
| 430 | If Recurse = True And (InStr(Filter, "?") > 0 Or InStr(Filter, "*") > 0) Then | |
| 431 | ReDim Folders(0) As String | |
| 432 | Folders(0) = Dir(Path, vbDirectory) | |
| 433 | If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir | |
| 434 | If Folders(0) = "." Or Folders(0) = ".." Then Folders(0) = Dir | |
| 435 | If Folders(0) <> "" Then | |
| 436 | Do | |
| 437 | ReDim Preserve Folders(UBound(Folders) + 1) As String | |
| 438 | Folders(UBound(Folders)) = Dir | |
| 439 | If Folders(UBound(Folders)) = "." Or Folders(UBound(Folders)) = ".." Then | |
| 440 | ReDim Preserve Folders(UBound(Folders) - 1) As String | |
| 441 | End If | |
| 442 | Loop Until Folders(UBound(Folders)) = "" | |
| 443 | ReDim Preserve Folders(UBound(Folders) - 1) As String | |
| 444 | End If | |
| 445 | For lNum = 0 To UBound(Folders) | |
| 446 | If Folders(lNum) <> "" Then | |
| 447 | If IsDir(Path + Folders(lNum)) Then | |
| 448 | KillEx Path + Folders(lNum), Filter, Attributes, Recurse | |
| 449 | On Error Resume Next | |
| 450 | RmDir Path + Folders(lNum) | |
| 451 | End If | |
| 452 | On Error GoTo 0 | |
| 453 | End If | |
| 454 | Next lNum | |
| 455 | End If | |
| 456 | End Sub | |
| 457 | Function FullPath(ByVal BasePath As String, File As String) As String | |
| 458 | If Right(BasePath, 1) <> "\" Then BasePath = BasePath + "\" | |
| 459 | If Mid(File, 2, 1) = ":" Or Left(File, 2) = "\\" Then | |
| 460 | FullPath = File | |
| 461 | ElseIf Left(File, 1) = "\" Then | |
| 462 | FullPath = Left(BasePath, 2) + File | |
| 463 | Else | |
| 464 | FullPath = BasePath + File | |
| 465 | End If | |
| 466 | End Function | |
| 467 | Function MatchesFilter(FileName As String, ByVal Filters As String) As Boolean | |
| 468 | Dim bNum As Long, Filter As String | |
| 469 | If InStr(Filters, ";") Then | |
| 470 | If Right(Filters, 1) <> ";" Then Filters = Filters + ";" | |
| 471 | For bNum = 1 To Len(Filters) | |
| 472 | Filter = Mid(Filters, bNum, InStr(bNum, Filters, ";") - bNum) | |
| 473 | If Right(Filter, 3) = "*.*" Then Filter = Left(Filter, Len(Filter) - 2) | |
| 474 | If LCase(FileName) Like LCase(Filter) Then | |
| 475 | MatchesFilter = True | |
| 476 | Exit Function | |
| 477 | End If | |
| 478 | bNum = InStr(bNum, Filters, ";") | |
| 479 | Next bNum | |
| 480 | Else | |
| 481 | If Right(Filters, 3) = "*.*" Then Filters = Left(Filters, Len(Filters) - 2) | |
| 482 | If LCase(FileName) Like LCase(Filters) Then MatchesFilter = True | |
| 483 | End If | |
| 484 | End Function | |
| 485 | Function RenameWithFilter(FileName As String, OldFilter As String, NewFilter As String) As String | |
| 486 | Dim bNum As Long, Filters() As String, NewFileName As String, bNum2 As Long, bNum3 As Long, bNum4 As Long, bNum5 As Long | |
| 487 | If Right(OldFilter, 3) = "*.*" Then OldFilter = Left(OldFilter, Len(OldFilter) - 2) | |
| 488 | If Right(NewFilter, 3) = "*.*" Then NewFilter = Left(NewFilter, Len(NewFilter) - 2) | |
| 489 | ReDim Filters(0) As String | |
| 490 | bNum4 = 1 | |
| 491 | For bNum = 1 To Len(OldFilter) | |
| 492 | Select Case Mid(OldFilter, bNum, 1) | |
| 493 | Case "*" | |
| 494 | bNum2 = InStr(bNum + 1, OldFilter, "*") | |
| 495 | bNum3 = InStr(bNum + 1, OldFilter, "?") | |
| 496 | If bNum2 = 0 And bNum3 = 0 Then | |
| 497 | bNum2 = Len(OldFilter) + 1 | |
| 498 | ElseIf (bNum3 < bNum2 Or bNum2 = 0) And bNum3 > 0 Then | |
| 499 | bNum2 = bNum3 | |
| 500 | End If | |
| 501 | bNum5 = InStr(bNum4, FileName, Mid(OldFilter, bNum + 1, bNum2 - bNum - 1), 1) | |
| 502 | If bNum = Len(OldFilter) Then | |
| 503 | bNum5 = Len(FileName) + 1 | |
| 504 | End If | |
| 505 | If bNum5 = 0 Then | |
| 506 | RenameWithFilter = FileName | |
| 507 | Exit Function | |
| 508 | End If | |
| 509 | If bNum > 1 Then | |
| 510 | If Mid(OldFilter, bNum - 1, 1) <> "*" And Mid(OldFilter, bNum - 1, 1) <> "?" Then | |
| 511 | ReDim Preserve Filters(UBound(Filters) + 1) As String | |
| 512 | End If | |
| 513 | Else | |
| 514 | ReDim Preserve Filters(UBound(Filters) + 1) As String | |
| 515 | End If | |
| 516 | Filters(UBound(Filters)) = Filters(UBound(Filters)) + Mid(FileName, bNum4, bNum5 - bNum4) | |
| 517 | bNum4 = bNum5 | |
| 518 | Case "?" | |
| 519 | bNum2 = bNum + 1 | |
| 520 | bNum5 = bNum4 + 1 | |
| 521 | If bNum > 1 Then | |
| 522 | If Mid(OldFilter, bNum - 1, 1) <> "*" And Mid(OldFilter, bNum - 1, 1) <> "?" Then | |
| 523 | ReDim Preserve Filters(UBound(Filters) + 1) As String | |
| 524 | End If | |
| 525 | Else | |
| 526 | ReDim Preserve Filters(UBound(Filters) + 1) As String | |
| 527 | End If | |
| 528 | Filters(UBound(Filters)) = Filters(UBound(Filters)) + Mid(FileName, bNum4, 1) | |
| 529 | bNum4 = bNum5 | |
| 530 | Case Else | |
| 531 | bNum4 = bNum4 + 1 | |
| 532 | End Select | |
| 533 | If bNum4 > Len(FileName) Then | |
| 534 | If (Right(OldFilter, 1) <> "*" Or bNum + 1 < Len(OldFilter)) And bNum < Len(OldFilter) Then | |
| 535 | RenameWithFilter = FileName | |
| 536 | Exit Function | |
| 537 | Else | |
| 538 | Exit For | |
| 539 | End If | |
| 540 | End If | |
| 541 | Next bNum | |
| 542 | NewFileName = NewFilter | |
| 543 | For bNum = 1 To UBound(Filters) | |
| 544 | bNum2 = InStr(bNum, NewFileName, "*") | |
| 545 | bNum3 = InStr(bNum, NewFileName, "?") | |
| 546 | If bNum2 = 0 And bNum3 = 0 Then | |
| 547 | bNum2 = Len(NewFileName) + 1 | |
| 548 | ElseIf (bNum3 < bNum2 Or bNum2 = 0) And bNum3 > 0 Then | |
| 549 | bNum2 = bNum3 | |
| 550 | End If | |
| 551 | If bNum2 > Len(NewFileName) Then | |
| 552 | RenameWithFilter = NewFileName | |
| 553 | Exit Function | |
| 554 | End If | |
| 555 | bNum4 = 0 | |
| 556 | For bNum3 = bNum2 To Len(NewFileName) | |
| 557 | Select Case Mid(NewFileName, bNum3, 1) | |
| 558 | Case "*" | |
| 559 | bNum4 = Len(Filters(bNum)) | |
| 560 | bNum3 = bNum3 + 1 | |
| 561 | Exit For | |
| 562 | Case "?" | |
| 563 | bNum4 = bNum4 + 1 | |
| 564 | Case Else | |
| 565 | Exit For | |
| 566 | End Select | |
| 567 | Next bNum3 | |
| 568 | NewFileName = Left(NewFileName, bNum2 - 1) + Left(Filters(bNum), bNum4) + Mid(NewFileName, bNum3) | |
| 569 | Next bNum | |
| 570 | Do Until InStr(NewFileName, "*") = 0 | |
| 571 | NewFileName = Left(NewFileName, InStr(NewFileName, "*") - 1) + Mid(NewFileName, InStr(NewFileName, "*") + 1) | |
| 572 | Loop | |
| 573 | Do Until InStr(NewFileName, "?") = 0 | |
| 574 | NewFileName = Left(NewFileName, InStr(NewFileName, "?") - 1) + Mid(NewFileName, InStr(NewFileName, "?") + 1) | |
| 575 | Loop | |
| 576 | RenameWithFilter = NewFileName | |
| 577 | End Function | |
| 578 | Function MpqDir(MpqFile As String, Filters As String) | |
| 62046253 | 579 | Dim Files() As FILELISTENTRY, fNum As Long, szFileList As String, NamePos As Long, CurFileName As String |
| 580 | Dim hMPQ As Long | |
| 581 | If SFileOpenArchive(MpqFile, 0, 0, hMPQ) Then | |
| 582 | If sListFiles(MpqFile, hMPQ, ListFile, Files) Then | |
| 583 | SFileCloseArchive hMPQ | |
| 584 | For fNum = 0 To UBound(Files) | |
| 585 | If Files(fNum).dwFileExists Then | |
| 586 | CurFileName = StrConv(Files(fNum).szFileName, vbUnicode) | |
| 587 | If MatchesFilter(CurFileName, Filters) Then | |
| 588 | NamePos = InStr(1, szFileList, CurFileName + vbCrLf, 1) | |
| 589 | If NamePos > 1 Then | |
| 590 | NamePos = InStr(1, szFileList, vbCrLf + CurFileName + vbCrLf, 1) | |
| 591 | End If | |
| 592 | If NamePos > 0 Then _ | |
| 593 | szFileList = szFileList + CurFileName | |
| 594 | End If | |
| 595 | End If | |
| 596 | Next fNum | |
| 597 | MpqDir = MpqDir + CurFileName + vbCrLf | |
| 0d212c7b | 598 | Else |
| 62046253 | 599 | SFileCloseArchive hMPQ |
| 0d212c7b | 600 | End If |
| 62046253 | 601 | End If |
| 0d212c7b | 602 | End Function |
| 603 | Sub RunScript(ScriptName As String) | |
| 62046253 | 604 | 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 |
| 0d212c7b | 605 | If FileExists(ScriptName) = False Then |
| 606 | ScriptOut.Show | |
| 607 | AddScriptOutput "Could not find script " + ScriptName + vbCrLf | |
| 608 | Exit Sub | |
| 609 | End If | |
| 610 | fNum = FreeFile | |
| 611 | Open ScriptName For Binary As #fNum | |
| 612 | Script = String(LOF(fNum), Chr(0)) | |
| 613 | Get #fNum, 1, Script | |
| 614 | Close #fNum | |
| 615 | OldPath = CurDir | |
| 616 | If InStr(ScriptName, "\") > 0 Then | |
| 617 | For bNum = 1 To Len(ScriptName) | |
| 618 | If InStr(bNum, ScriptName, "\") > 0 Then | |
| 619 | bNum = InStr(bNum, ScriptName, "\") | |
| 620 | NewPath = Left(ScriptName, bNum) | |
| 621 | End If | |
| 622 | Next bNum | |
| 623 | If Mid(NewPath, 2, 1) = ":" Then ChDrive Left(NewPath, 1) | |
| 624 | ChDir NewPath | |
| 625 | End If | |
| 626 | CurPath = CurDir | |
| 627 | If Right(Script, 2) <> vbCrLf Then Script = Script + vbCrLf | |
| 628 | ScriptOut.Show | |
| 629 | AddScriptOutput "Script: " + ScriptName + vbCrLf + vbCrLf | |
| 62046253 | 630 | OldDefaultMaxFiles = DefaultMaxFiles |
| 0d212c7b | 631 | lNum = 1 |
| 632 | For bNum = 1 To Len(Script) | |
| 633 | EndLine = InStr(bNum, Script, vbCrLf) | |
| 634 | sLine = Mid(Script, bNum, EndLine - bNum) | |
| 635 | If Right(sLine, 1) <> " " Then sLine = sLine + " " | |
| 636 | If sLine <> "" Then | |
| 637 | AddScriptOutput "Line " + CStr(lNum) + ": " | |
| 638 | ReDim Param(0) As String | |
| 639 | For pNum = 1 To Len(sLine) | |
| 640 | If Mid(sLine, pNum, 1) = Chr(34) Then | |
| 641 | pNum = pNum + 1 | |
| 642 | EndParam = InStr(pNum, sLine, Chr(34)) | |
| 643 | Else | |
| 644 | EndParam = InStr(pNum, sLine, " ") | |
| 645 | End If | |
| 646 | If EndParam = 0 Then EndParam = Len(sLine) + 1 | |
| 647 | If pNum <> EndParam Then | |
| 648 | If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then | |
| 649 | ReDim Preserve Param(UBound(Param) + 1) As String | |
| 650 | Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum)) | |
| 651 | End If | |
| 652 | End If | |
| 653 | pNum = EndParam | |
| 654 | Next pNum | |
| 655 | If UBound(Param) < 3 Then ReDim Preserve Param(3) As String | |
| 656 | Select Case LCase(Param(1)) | |
| 657 | Case "o", "open" | |
| 658 | If Param(2) <> "" Then | |
| 659 | MpqFile = Param(2) | |
| 660 | If Param(3) <> "" And FileExists(MpqFile) = False Then | |
| 62046253 | 661 | DefaultMaxFiles = Param(3) |
| 0d212c7b | 662 | End If |
| 663 | If FileExists(MpqFile) Then | |
| 664 | AddScriptOutput "Opened " + MpqFile + vbCrLf | |
| 665 | Else | |
| 666 | AddScriptOutput "Created new " + MpqFile + vbCrLf | |
| 667 | End If | |
| 668 | NewPath = CurPath | |
| 669 | Else | |
| 670 | AddScriptOutput "Required parameter missing" + vbCrLf | |
| 671 | End If | |
| 672 | Case "n", "new" | |
| 673 | If Param(2) <> "" Then | |
| 674 | MpqFile = Param(2) | |
| 675 | If Param(3) <> "" Then | |
| 62046253 | 676 | DefaultMaxFiles = Param(3) |
| 0d212c7b | 677 | End If |
| 678 | ScriptNewFile = True | |
| 679 | AddScriptOutput "Created new " + MpqFile + vbCrLf | |
| 680 | NewPath = CurPath | |
| 681 | Else | |
| 682 | AddScriptOutput "Required parameter missing" + vbCrLf | |
| 683 | End If | |
| 684 | Case "c", "close" | |
| 685 | If MpqFile <> "" Then | |
| 686 | If LCase(CD.FileName) = LCase(FullPath(NewPath, MpqFile)) Then MpqEx.Timer1.Enabled = True | |
| 687 | AddScriptOutput "Closed " + MpqFile + vbCrLf | |
| 688 | MpqFile = "" | |
| 689 | Else | |
| 690 | AddScriptOutput "No archive open" + vbCrLf | |
| 691 | End If | |
| 692 | Case "p", "pause" | |
| 693 | AddScriptOutput "Pause not supported" + vbCrLf | |
| 694 | Case "a", "add" | |
| 695 | If MpqFile <> "" Then | |
| 696 | cType = 0 | |
| 697 | Rswitch = False | |
| 698 | fCount = 0 | |
| 699 | Files = "" | |
| 700 | fEndLine = 0 | |
| 701 | fLine = "" | |
| 62046253 | 702 | dwFlags = MAFA_REPLACE_EXISTING |
| 703 | If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT | |
| 0d212c7b | 704 | For pNum = 3 To UBound(Param) |
| 705 | If LCase(Param(pNum)) = "/wav" Then | |
| 706 | cType = 2 | |
| 62046253 | 707 | dwFlags = dwFlags Or MAFA_COMPRESS |
| 0d212c7b | 708 | ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then |
| 709 | cType = 1 | |
| 62046253 | 710 | dwFlags = dwFlags Or MAFA_COMPRESS |
| 0d212c7b | 711 | ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then |
| 712 | cType = -1 | |
| 713 | ElseIf LCase(Param(pNum)) = "/r" Then | |
| 714 | Rswitch = True | |
| 715 | End If | |
| 716 | Next pNum | |
| 717 | If Left(Param(3), 1) = "/" Or Param(3) = "" Then | |
| 718 | If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then | |
| 719 | Param(3) = "" | |
| 720 | Else | |
| 721 | Param(3) = Param(2) | |
| 722 | End If | |
| 723 | End If | |
| 724 | If Left(Param(2), 1) <> "/" And Param(2) <> "" Then | |
| 725 | If InStr(Param(2), "\") > 0 Then | |
| 726 | For pNum = 1 To Len(Param(2)) | |
| 727 | If InStr(pNum, Param(2), "\") > 0 Then | |
| 728 | pNum = InStr(pNum, Param(2), "\") | |
| 729 | Files = Left(Param(2), pNum) | |
| 730 | End If | |
| 731 | Next pNum | |
| 732 | End If | |
| 733 | If ScriptNewFile = True Then | |
| 734 | If FileExists(FullPath(NewPath, MpqFile)) Then Kill FullPath(NewPath, MpqFile) | |
| 735 | ScriptNewFile = False | |
| 736 | End If | |
| 737 | Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch) | |
| 62046253 | 738 | hMPQ = mOpenMpq(FullPath(NewPath, MpqFile)) |
| 0d212c7b | 739 | If hMPQ = 0 Then |
| 740 | AddScriptOutput "Can't create archive " + MpqFile + vbCrLf | |
| 741 | GoTo CommandError | |
| 742 | End If | |
| 743 | For pNum = 1 To Len(Files) | |
| 744 | fEndLine = InStr(pNum, Files, vbCrLf) | |
| 745 | fLine = Mid(Files, pNum, fEndLine - pNum) | |
| 746 | If pNum > 1 Then | |
| 747 | AddScriptOutput "Line " + CStr(lNum) + ": " | |
| 748 | End If | |
| 749 | If cType = 0 Then | |
| 750 | AddScriptOutput "Adding " + fLine + "..." | |
| 751 | ElseIf cType = 1 Then | |
| 752 | AddScriptOutput "Adding compressed " + fLine + "..." | |
| 753 | ElseIf cType = 2 Then | |
| 754 | AddScriptOutput "Adding compressed WAV " + fLine + "..." | |
| 755 | ElseIf cType = -1 Then | |
| 756 | AddScriptOutput "Adding " + fLine + " (compression auto-select)..." | |
| 757 | End If | |
| 758 | If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then | |
| 759 | If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\" | |
| 760 | If cType = 2 Then | |
| 62046253 | 761 | MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0 |
| 0d212c7b | 762 | ElseIf cType = -1 Then |
| 763 | mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine | |
| 764 | ElseIf cType = 1 Then | |
| 62046253 | 765 | MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel |
| 0d212c7b | 766 | Else |
| 62046253 | 767 | MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0 |
| 0d212c7b | 768 | End If |
| 769 | Else | |
| 770 | If cType = 2 Then | |
| 62046253 | 771 | MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0 |
| 0d212c7b | 772 | ElseIf cType = -1 Then |
| 773 | mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) | |
| 774 | ElseIf cType = 1 Then | |
| 62046253 | 775 | MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel |
| 0d212c7b | 776 | Else |
| 62046253 | 777 | MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0 |
| 0d212c7b | 778 | End If |
| 779 | End If | |
| 780 | AddScriptOutput " Done" + vbCrLf | |
| 781 | SendMessageA ScriptOut.oText.hWnd, WM_PAINT, 0, &O0 | |
| 782 | fCount = fCount + 1 | |
| 783 | pNum = fEndLine + 1 | |
| 784 | Next pNum | |
| 62046253 | 785 | MpqCloseUpdatedArchive hMPQ, 0 |
| 0d212c7b | 786 | If fCount > 1 Then |
| 787 | AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " added" + vbCrLf | |
| 788 | End If | |
| 789 | Else | |
| 790 | AddScriptOutput " Required parameter missing" + vbCrLf | |
| 791 | End If | |
| 792 | Else | |
| 793 | AddScriptOutput "No archive open" + vbCrLf | |
| 794 | End If | |
| 795 | Case "e", "extract" | |
| 796 | If MpqFile <> "" Then | |
| 797 | If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Extracting " + Param(2) + "..." | |
| 798 | cType = 0 | |
| 799 | For pNum = 3 To UBound(Param) | |
| 800 | If LCase(Param(pNum)) = "/fp" Then | |
| 801 | cType = 1 | |
| 802 | Exit For | |
| 803 | End If | |
| 804 | Next pNum | |
| 805 | If Left(Param(3), 1) = "/" Then Param(3) = "" | |
| 806 | If Param(3) = "" Then Param(3) = "." | |
| 807 | If Left(Param(2), 1) <> "/" And Param(2) <> "" Then | |
| 808 | If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then | |
| 809 | Files = MpqDir(FullPath(NewPath, MpqFile), Param(2)) | |
| 62046253 | 810 | If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then |
| 0d212c7b | 811 | AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf |
| 812 | GoTo CommandError | |
| 813 | End If | |
| 814 | For pNum = 1 To Len(Files) | |
| 815 | fEndLine = InStr(pNum, Files, vbCrLf) | |
| 816 | fLine = Mid(Files, pNum, fEndLine - pNum) | |
| 817 | If pNum > 1 Then | |
| 818 | AddScriptOutput "Line " + CStr(lNum) + ": " | |
| 819 | End If | |
| 820 | AddScriptOutput "Extracting " + fLine + "..." | |
| 62046253 | 821 | sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType |
| 0d212c7b | 822 | AddScriptOutput " Done" + vbCrLf |
| 823 | ||
| 824 | fCount = fCount + 1 | |
| 825 | pNum = fEndLine + 1 | |
| 826 | Next pNum | |
| 62046253 | 827 | SFileCloseArchive hMPQ |
| 0d212c7b | 828 | If fCount > 1 Then |
| 829 | AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " extracted" + vbCrLf | |
| 830 | End If | |
| 831 | Else | |
| 62046253 | 832 | If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then |
| 833 | AddScriptOutput "Can't open archive " + FullPath(NewPath, MpqFile) + vbCrLf | |
| 834 | GoTo CommandError | |
| 835 | End If | |
| 836 | sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType | |
| 837 | SFileCloseArchive hMPQ | |
| 0d212c7b | 838 | AddScriptOutput " Done" + vbCrLf |
| 839 | End If | |
| 840 | Else | |
| 841 | AddScriptOutput " Required parameter missing" + vbCrLf | |
| 842 | End If | |
| 843 | Else | |
| 844 | AddScriptOutput "No archive open" + vbCrLf | |
| 845 | End If | |
| 846 | Case "r", "ren", "rename" | |
| 847 | If MpqFile <> "" Then | |
| 848 | If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Renaming " + Param(2) + " => " + Param(3) + "..." | |
| 849 | If Param(2) <> "" And Param(3) <> "" Then | |
| 850 | If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then | |
| 851 | If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then | |
| 852 | Files = MpqDir(FullPath(NewPath, MpqFile), Param(2)) | |
| 62046253 | 853 | hMPQ = mOpenMpq(FullPath(NewPath, MpqFile)) |
| 854 | If hMPQ Then | |
| 855 | For pNum = 1 To Len(Files) | |
| 856 | fEndLine = InStr(pNum, Files, vbCrLf) | |
| 857 | fLine = Mid(Files, pNum, fEndLine - pNum) | |
| 858 | If pNum > 1 Then | |
| 859 | AddScriptOutput "Line " + CStr(lNum) + ": " | |
| 860 | End If | |
| 861 | fLine2 = RenameWithFilter(fLine, Param(2), Param(3)) | |
| 862 | AddScriptOutput "Renaming " + fLine + " => " + fLine2 + "..." | |
| 863 | If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then | |
| 864 | SFileCloseFile hFile | |
| 865 | MpqDeleteFile hMPQ, fLine2 | |
| 866 | MpqRenameFile hMPQ, fLine, fLine2 | |
| 867 | Else | |
| 868 | MpqRenameFile hMPQ, fLine, fLine2 | |
| 869 | End If | |
| 870 | AddScriptOutput " Done" + vbCrLf | |
| 871 | fCount = fCount + 1 | |
| 872 | pNum = fEndLine + 1 | |
| 873 | Next pNum | |
| 874 | MpqCloseUpdatedArchive hMPQ, 0 | |
| 875 | End If | |
| 0d212c7b | 876 | If fCount > 1 Then |
| 877 | AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " renamed" + vbCrLf | |
| 878 | End If | |
| 879 | Else | |
| 880 | AddScriptOutput "You must use wildcards with new name" + vbCrLf | |
| 881 | End If | |
| 882 | Else | |
| 62046253 | 883 | hMPQ = mOpenMpq(FullPath(NewPath, MpqFile)) |
| 884 | If hMPQ Then | |
| 885 | If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then | |
| 886 | SFileCloseFile hFile | |
| 887 | MpqDeleteFile hMPQ, Param(3) | |
| 888 | MpqRenameFile hMPQ, Param(2), Param(3) | |
| 889 | Else | |
| 890 | MpqRenameFile hMPQ, Param(2), Param(3) | |
| 891 | End If | |
| 892 | MpqCloseUpdatedArchive hMPQ, 0 | |
| 0d212c7b | 893 | End If |
| 894 | AddScriptOutput " Done" + vbCrLf | |
| 895 | End If | |
| 896 | Else | |
| 897 | AddScriptOutput " Required parameter missing" + vbCrLf | |
| 898 | End If | |
| 899 | Else | |
| 900 | AddScriptOutput "No archive open" + vbCrLf | |
| 901 | End If | |
| 902 | Case "m", "move" | |
| 903 | If MpqFile <> "" Then | |
| 904 | For pNum = 1 To Len(Param(2)) | |
| 905 | If InStr(bNum, Param(2), "\") Then | |
| 906 | bNum = InStr(bNum, Param(2), "\") | |
| 907 | Else | |
| 908 | Exit For | |
| 909 | End If | |
| 910 | Next pNum | |
| 911 | fLineTitle = Mid(Param(2), bNum) | |
| 912 | If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\" | |
| 913 | Param(3) = Param(3) + fLineTitle | |
| 914 | If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Moving " + Param(2) + " => " + Param(3) + "..." | |
| 915 | If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then | |
| 916 | If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then | |
| 917 | Files = MpqDir(FullPath(NewPath, MpqFile), Param(2)) | |
| 62046253 | 918 | hMPQ = mOpenMpq(FullPath(NewPath, MpqFile)) |
| 919 | If hMPQ Then | |
| 920 | For pNum = 1 To Len(Files) | |
| 921 | fEndLine = InStr(pNum, Files, vbCrLf) | |
| 922 | fLine = Mid(Files, pNum, fEndLine - pNum) | |
| 923 | If pNum > 1 Then | |
| 924 | AddScriptOutput "Line " + CStr(lNum) + ": " | |
| 925 | End If | |
| 926 | fLine2 = RenameWithFilter(fLine, Param(2), Param(3)) | |
| 927 | AddScriptOutput "Moving " + fLine + " => " + fLine2 + "..." | |
| 928 | If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then | |
| 929 | SFileCloseFile hFile | |
| 930 | MpqDeleteFile hMPQ, fLine2 | |
| 931 | MpqRenameFile hMPQ, fLine, fLine2 | |
| 932 | Else | |
| 933 | MpqRenameFile hMPQ, fLine, fLine2 | |
| 934 | End If | |
| 935 | AddScriptOutput " Done" + vbCrLf | |
| 936 | fCount = fCount + 1 | |
| 937 | pNum = fEndLine + 1 | |
| 938 | Next pNum | |
| 939 | MpqCloseUpdatedArchive hMPQ, 0 | |
| 940 | End If | |
| 0d212c7b | 941 | If fCount > 1 Then |
| 942 | AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " moved" + vbCrLf | |
| 943 | End If | |
| 944 | Else | |
| 62046253 | 945 | hMPQ = mOpenMpq(FullPath(NewPath, MpqFile)) |
| 946 | If hMPQ Then | |
| 947 | If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then | |
| 948 | SFileCloseFile hFile | |
| 949 | MpqDeleteFile hMPQ, Param(3) | |
| 950 | MpqRenameFile hMPQ, Param(2), Param(3) | |
| 951 | Else | |
| 952 | MpqRenameFile hMPQ, Param(2), Param(3) | |
| 953 | End If | |
| 954 | MpqCloseUpdatedArchive hMPQ, 0 | |
| 0d212c7b | 955 | End If |
| 956 | AddScriptOutput " Done" + vbCrLf | |
| 957 | End If | |
| 958 | Else | |
| 959 | AddScriptOutput " Required parameter missing" + vbCrLf | |
| 960 | End If | |
| 961 | Else | |
| 962 | AddScriptOutput "No archive open" + vbCrLf | |
| 963 | End If | |
| 964 | Case "d", "del", "delete" | |
| 965 | If MpqFile <> "" Then | |
| 966 | If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then AddScriptOutput "Deleting " + Param(2) + "..." | |
| 967 | If Left(Param(2), 1) <> "/" And Param(2) <> "" Then | |
| 968 | If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then | |
| 969 | Files = MpqDir(FullPath(NewPath, MpqFile), Param(2)) | |
| 62046253 | 970 | hMPQ = mOpenMpq(FullPath(NewPath, MpqFile)) |
| 971 | If hMPQ Then | |
| 972 | For pNum = 1 To Len(Files) | |
| 973 | fEndLine = InStr(pNum, Files, vbCrLf) | |
| 974 | fLine = Mid(Files, pNum, fEndLine - pNum) | |
| 975 | If pNum > 1 Then | |
| 976 | AddScriptOutput "Line " + CStr(lNum) + ": " | |
| 977 | End If | |
| 978 | AddScriptOutput "Deleting " + fLine + "..." | |
| 979 | MpqDeleteFile hMPQ, fLine | |
| 980 | AddScriptOutput " Done" + vbCrLf | |
| 981 | fCount = fCount + 1 | |
| 982 | pNum = fEndLine + 1 | |
| 983 | Next pNum | |
| 984 | MpqCloseUpdatedArchive hMPQ, 0 | |
| 985 | End If | |
| 0d212c7b | 986 | If fCount > 1 Then |
| 987 | AddScriptOutput "Line " + CStr(lNum) + ": " + CStr(fCount) + " files of " + Param(2) + " deleted" + vbCrLf | |
| 988 | End If | |
| 989 | Else | |
| 62046253 | 990 | hMPQ = mOpenMpq(FullPath(NewPath, MpqFile)) |
| 991 | If hMPQ Then | |
| 992 | MpqDeleteFile hMPQ, Param(2) | |
| 993 | MpqCloseUpdatedArchive hMPQ, 0 | |
| 994 | End If | |
| 0d212c7b | 995 | AddScriptOutput " Done" + vbCrLf |
| 996 | End If | |
| 997 | Else | |
| 998 | AddScriptOutput " Required parameter missing" + vbCrLf | |
| 999 | End If | |
| 1000 | Else | |
| 1001 | AddScriptOutput "No archive open" + vbCrLf | |
| 1002 | End If | |
| 1003 | Case "f", "flush", "compact" | |
| 1004 | If MpqFile <> "" Then | |
| 1005 | AddScriptOutput "Flushing " + MpqFile + "..." | |
| 62046253 | 1006 | hMPQ = mOpenMpq(FullPath(NewPath, MpqFile)) |
| 1007 | If hMPQ Then | |
| 1008 | MpqCompactArchive hMPQ | |
| 1009 | MpqCloseUpdatedArchive hMPQ, 0 | |
| 1010 | End If | |
| 0d212c7b | 1011 | AddScriptOutput " Done" + vbCrLf |
| 1012 | Else | |
| 1013 | AddScriptOutput "No archive open" + vbCrLf | |
| 1014 | End If | |
| 1015 | Case "l", "list" | |
| 1016 | If MpqFile <> "" Then | |
| 1017 | If Param(2) <> "" Then | |
| 1018 | AddScriptOutput "Creating list..." | |
| 1019 | If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then | |
| 1020 | Files = MpqDir(FullPath(NewPath, MpqFile), Param(2)) | |
| 1021 | Param(2) = Param(3) | |
| 1022 | Else | |
| 62046253 | 1023 | Files = MpqDir(FullPath(NewPath, MpqFile), "*") |
| 0d212c7b | 1024 | End If |
| 1025 | fNum = FreeFile | |
| 1026 | Open FullPath(CurPath, Param(2)) For Binary As #fNum | |
| 1027 | Put #fNum, 1, Files | |
| 1028 | Close #fNum | |
| 1029 | AddScriptOutput " Done" + vbCrLf | |
| 1030 | Else | |
| 1031 | AddScriptOutput " Required parameter missing" + vbCrLf | |
| 1032 | End If | |
| 1033 | Else | |
| 1034 | AddScriptOutput "No archive open" + vbCrLf | |
| 1035 | End If | |
| 1036 | Case "s", "script" | |
| 1037 | AddScriptOutput "Running script " + Param(2) + "..." + vbCrLf + vbCrLf | |
| 1038 | If Param(2) <> "" Then | |
| 1039 | RunScript FullPath(CurPath, Param(2)) | |
| 1040 | Else | |
| 1041 | AddScriptOutput " Required parameter missing" + vbCrLf | |
| 1042 | End If | |
| 1043 | AddScriptOutput vbCrLf + "Continuing with previous script..." + vbCrLf | |
| 1044 | Case "x", "exit", "quit" | |
| 1045 | Unload MpqEx | |
| 1046 | Case Else | |
| 1047 | If Left(Param(1), 1) <> ";" Then | |
| 1048 | If LCase(Param(1)) = "cd" Or LCase(Param(1)) = "chdir" Then | |
| 1049 | On Error Resume Next | |
| 1050 | ChDir Param(2) | |
| 1051 | On Error GoTo 0 | |
| 1052 | CurPath = CurDir | |
| 1053 | AddScriptOutput "Current directory is " + CurPath + vbCrLf | |
| 1054 | ElseIf Left(LCase(Param(1)), 3) = "cd." Or Left(LCase(Param(1)), 3) = "cd\" Then | |
| 1055 | On Error Resume Next | |
| 1056 | ChDir Mid(Param(1), 3) | |
| 1057 | On Error GoTo 0 | |
| 1058 | CurPath = CurDir | |
| 1059 | AddScriptOutput "Current directory is " + CurPath + vbCrLf | |
| 1060 | ElseIf Left(LCase(Param(1)), 6) = "chdir." Or Left(LCase(Param(1)), 6) = "chdir\" Then | |
| 1061 | On Error Resume Next | |
| 1062 | ChDir Mid(Param(1), 6) | |
| 1063 | On Error GoTo 0 | |
| 1064 | CurPath = CurDir | |
| 1065 | AddScriptOutput "Current directory is " + CurPath + vbCrLf | |
| 1066 | ElseIf Mid(Param(1), 2, 1) = ":" And (Len(Param(1)) = 2 Or Right(Param(1), 1) = "\") Then | |
| 1067 | On Error Resume Next | |
| 1068 | ChDrive Left(Param(1), 2) | |
| 1069 | On Error GoTo 0 | |
| 1070 | CurPath = CurDir | |
| 1071 | AddScriptOutput "Current directory is " + CurPath + vbCrLf | |
| 1072 | Else | |
| 1073 | AddScriptOutput "Running command " + sLine + "..." | |
| 1074 | Shell "command.com /c " + sLine, 1 | |
| 1075 | AddScriptOutput " Done" + vbCrLf | |
| 1076 | End If | |
| 1077 | Else | |
| 1078 | AddScriptOutput "Comment " + sLine + vbCrLf | |
| 1079 | End If | |
| 1080 | End Select | |
| 1081 | End If | |
| 1082 | CommandError: | |
| 1083 | lNum = lNum + 1 | |
| 1084 | bNum = EndLine + 1 | |
| 1085 | Next bNum | |
| 62046253 | 1086 | DefaultMaxFiles = OldDefaultMaxFiles |
| 0d212c7b | 1087 | If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1) |
| 1088 | ChDir OldPath | |
| 1089 | End Sub | |
| 0d212c7b | 1090 | Function FindMpqHeader(MpqFile As String) As Long |
| 62046253 | 1091 | If FileExists(MpqFile) = False Then |
| 1092 | FindMpqHeader = -1 | |
| 1093 | Exit Function | |
| 0d212c7b | 1094 | End If |
| 62046253 | 1095 | Dim hFile |
| 1096 | hFile = FreeFile | |
| 1097 | Open MpqFile For Binary As #hFile | |
| 1098 | Dim FileLen As Long | |
| 1099 | FileLen = LOF(hFile) | |
| 1100 | Dim pbuf As String | |
| 1101 | pbuf = String(32, Chr(0)) | |
| 1102 | Dim i As Long | |
| 1103 | For i = 0 To FileLen - 1 Step 512 | |
| 1104 | Get #hFile, 1 + i, pbuf | |
| 1105 | If Left(pbuf, 4) = "MPQ" + Chr(26) Or Left(pbuf, 4) = "BN3" + Chr(26) Then | |
| 1106 | ' Storm no longer does this, so this shouldn't either | |
| 1107 | 'FileLen = FileLen - i | |
| 1108 | 'If JBytes(pbuf, 9, 4) = FileLen | |
| 1109 | ' FileMpqHeader = i | |
| 1110 | ' Close #hFile | |
| 1111 | ' Exit Function | |
| 1112 | 'Else | |
| 1113 | ' FileLen = FileLen + i | |
| 1114 | 'End If | |
| 1115 | FindMpqHeader = i | |
| 1116 | Close #hFile | |
| 1117 | Exit Function | |
| 0d212c7b | 1118 | End If |
| 62046253 | 1119 | Next i |
| 1120 | FindMpqHeader = -1 | |
| 1121 | Close #hFile | |
| 0d212c7b | 1122 | End Function |
| 0d212c7b | 1123 | Function GetNumMpqFiles(MpqFile As String) As Long |
| 1124 | Dim fNum As Long, Text As String, MpqHeader As Long | |
| 1125 | fNum = FreeFile | |
| 1126 | Text = String(4, Chr(0)) | |
| 1127 | MpqHeader = FindMpqHeader(MpqFile) | |
| 1128 | If MpqHeader > -1 Then | |
| 1129 | Open MpqFile For Binary As #fNum | |
| 5f007675 | 1130 | Get #fNum, MpqHeader + 29, GetNumMpqFiles |
| 0d212c7b | 1131 | Close #fNum |
| 0d212c7b | 1132 | End If |
| 1133 | End Function |