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