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