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