MpqStuff.bas

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