MpqStuff.bas

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