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