Current News Archived News Search News Discussion Forum Old Forum Install Programs More Downloads... Troubleshooting Source Code Format Specs. Misc. Information Non-SF Stuff Links Small banner for links to this site: |
a3ec874c53fc86ac5ccb64e13cd873e9d6ec20a6
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
|