MpqStuff.bas

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