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 Function mOpenMpq(FileName As String) As Long
  75 Dim hMPQ As Long
  76 mOpenMpq = 0
  77 hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_OPEN_EXISTING Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize)
  78 If hMPQ = 0 Or hMPQ = INVALID_HANDLE_VALUE Then
  79     hMPQ = MpqOpenArchiveForUpdateEx(FileName, MOAU_CREATE_NEW Or MOAU_MAINTAIN_LISTFILE, DefaultMaxFiles, DefaultBlockSize)
  80 End If
  81 If hMPQ <> 0 And hMPQ <> INVALID_HANDLE_VALUE Then
  82     mOpenMpq = hMPQ
  83 End If
  84 End Function
  85 Function PathInputBox(lpFolderDialog As BROWSEINFO, pCaption As String, StartFolder As String) As String
  86 lpFolderDialog.Title = pCaption
  87 Dim result As Long
  88 result = ShowFolder(lpFolderDialog)
  89 If result = 0 Then Exit Function
  90 PathInputBox = GetPathFromID(result)
  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
 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
 119     GetFileTitle = Mid(FileName, bNum)
 120 Else
 121     GetFileTitle = FileName
 122 End If
 123 End Function
 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)
 130     Else
 131         ReDim buffer(0)
 132     End If
 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
 144         End If
 145     Next cNum
 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
 154 End If
 155 Exit Function
 156 WriteError:
 157 MsgBox "Error writing file.  File may be in use.", vbCritical, "WinMPQ"
 158 Close #cNum
 159 End Function
 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
 165 If GetReg(AppKey + "AutofindFileLists", 0) = 0 Then
 166     NewFileLists = FileLists
 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
 178         FileLists = Path + App.EXEName + ".exe" + vbCrLf + MpqName
 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
 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)
 193                 End If
 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
 210                     ReDim Preserve nFileLists(UBound(nFileLists) + 1) As String
 211                     nFileLists(UBound(nFileLists)) = GetLongPath(ListName)
 212                 End If
 213             Else
 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
 227             End If
 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)
 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) = ""
 247                 End If
 248             Next cNum2
 249         End If
 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
 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)
 265 End If
 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)
 270 End Function
 271 Sub mAddAutoFile(hMPQ As Long, File As String, MpqPath As String)
 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
 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"))
 289     dwFlags = dwFlags And (-1& Xor MAFA_ENCRYPT)
 290 ElseIf LCase(fExt) = ".smk" Then
 291     cType = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
 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)
 302 ElseIf LCase(fExt) = ".wav" Then
 303     cType = CInt(GetReg(AppKey + "Compression\.wav", "0"))
 304 Else
 305     cType = CInt(GetReg(AppKey + "Compression\" + fExt, CStr(DefaultCompressID)))
 306 End If
 307 Select Case cType
 308 Case -2
 309 MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags, 0, 0
 310 Case -1
 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
 314 Case 0, 1, 2
 315 MpqAddWaveToArchive hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, cType
 316 Case Else
 317 MpqAddFileToArchiveEx hMPQ, File, MpqPath, dwFlags Or MAFA_COMPRESS, DefaultCompress, DefaultCompressLevel
 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
 403 If FindMpqHeader(MpqFile) <> -1 Then
 404     IsMPQ = True
 405 Else
 406     IsMPQ = False
 407 End If
 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)
 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
 598     Else
 599         SFileCloseArchive hMPQ
 600     End If
 601 End If
 602 End Function
 603 Sub RunScript(ScriptName As String)
 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
 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
 630 OldDefaultMaxFiles = DefaultMaxFiles
 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
 661                     DefaultMaxFiles = Param(3)
 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
 676                     DefaultMaxFiles = Param(3)
 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 = ""
 702                 dwFlags = MAFA_REPLACE_EXISTING
 703                 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
 704                 For pNum = 3 To UBound(Param)
 705                     If LCase(Param(pNum)) = "/wav" Then
 706                         cType = 2
 707                         dwFlags = dwFlags Or MAFA_COMPRESS
 708                     ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then
 709                         cType = 1
 710                         dwFlags = dwFlags Or MAFA_COMPRESS
 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)
 738                     hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
 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
 761                                 MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0
 762                             ElseIf cType = -1 Then
 763                                 mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine
 764                             ElseIf cType = 1 Then
 765                                 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel
 766                             Else
 767                                 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0
 768                             End If
 769                         Else
 770                             If cType = 2 Then
 771                                 MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0
 772                             ElseIf cType = -1 Then
 773                                 mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)
 774                             ElseIf cType = 1 Then
 775                                 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel
 776                             Else
 777                                 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0
 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
 785                     MpqCloseUpdatedArchive hMPQ, 0
 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))
 810                         If SFileOpenArchive(FullPath(NewPath, MpqFile), 0, 0, hMPQ) = 0 Then
 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 + "..."
 821                             sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType
 822                             AddScriptOutput " Done" + vbCrLf
 823
 824                             fCount = fCount + 1
 825                             pNum = fEndLine + 1
 826                         Next pNum
 827                         SFileCloseArchive hMPQ
 828                         If fCount > 1 Then
 829                             AddScriptOutput "Line " + CStr(lNum) + ":  " + CStr(fCount) + " files of " + Param(2) + " extracted" + vbCrLf
 830                         End If
 831                     Else
 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
 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))
 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
 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
 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
 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))
 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
 941                         If fCount > 1 Then
 942                             AddScriptOutput "Line " + CStr(lNum) + ":  " + CStr(fCount) + " files of " + Param(2) + " moved" + vbCrLf
 943                         End If
 944                     Else
 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
 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))
 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
 986                         If fCount > 1 Then
 987                             AddScriptOutput "Line " + CStr(lNum) + ":  " + CStr(fCount) + " files of " + Param(2) + " deleted" + vbCrLf
 988                         End If
 989                     Else
 990                         hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
 991                         If hMPQ Then
 992                             MpqDeleteFile hMPQ, Param(2)
 993                             MpqCloseUpdatedArchive hMPQ, 0
 994                         End If
 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 + "..."
1006                 hMPQ = mOpenMpq(FullPath(NewPath, MpqFile))
1007                 If hMPQ Then
1008                     MpqCompactArchive hMPQ
1009                     MpqCloseUpdatedArchive hMPQ, 0
1010                 End If
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
1023                         Files = MpqDir(FullPath(NewPath, MpqFile), "*")
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
1086 DefaultMaxFiles = OldDefaultMaxFiles
1087 If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
1088 ChDir OldPath
1089 End Sub
1090 Function FindMpqHeader(MpqFile As String) As Long
1091     If FileExists(MpqFile) = False Then
1092         FindMpqHeader = -1
1093         Exit Function
1094     End If
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
1118         End If
1119     Next i
1120     FindMpqHeader = -1
1121     Close #hFile
1122 End Function
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
1130     Get #fNum, MpqHeader + 29, GetNumMpqFiles
1131     Close #fNum
1132 End If
1133 End Function