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: |
1 VERSION 4.00\r
2 Begin VB.Form MpqEx \r
3 Caption = "WinMPQ"\r
4 ClientHeight = 3510\r
5 ClientLeft = 1245\r
6 ClientTop = 1785\r
7 ClientWidth = 6690\r
8 Height = 4200\r
9 Icon = "listing.frx":0000\r
10 KeyPreview = -1 'True\r
11 Left = 1185\r
12 LinkTopic = "Form1"\r
13 ScaleHeight = 3510\r
14 ScaleWidth = 6690\r
15 Top = 1155\r
16 Width = 6810\r
17 Begin VB.Timer Timer1 \r
18 Enabled = 0 'False\r
19 Interval = 2500\r
20 Left = 6120\r
21 Top = 2160\r
22 End\r
23 Begin VB.TextBox txtCommand \r
24 BackColor = &H8000000F&\r
25 Height = 285\r
26 Left = 1440\r
27 TabIndex = 1\r
28 Top = 2880\r
29 Width = 4695\r
30 End\r
31 Begin VB.CommandButton cmdGo \r
32 Caption = "Go"\r
33 Height = 285\r
34 Left = 6120\r
35 TabIndex = 2\r
36 Top = 2880\r
37 Width = 495\r
38 End\r
39 Begin VB.ComboBox mFilter \r
40 Height = 315\r
41 ItemData = "listing.frx":27A2\r
42 Left = 5220\r
43 List = "listing.frx":27A9\r
44 Sorted = -1 'True\r
45 TabIndex = 3\r
46 Text = "*"\r
47 Top = 30\r
48 Width = 675\r
49 End\r
50 Begin MSComctlLib.Toolbar Toolbar \r
51 Align = 1 'Align Top\r
52 Height = 345\r
53 Left = 0\r
54 TabIndex = 5\r
55 Top = 0\r
56 Width = 6690\r
57 _ExtentX = 11800\r
58 _ExtentY = 609\r
59 ButtonWidth = 1561\r
60 ButtonHeight = 556\r
61 Wrappable = 0 'False\r
62 Appearance = 1\r
63 Style = 1\r
64 ImageList = "ImageList1"\r
65 _Version = 393216\r
66 BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} \r
67 NumButtons = 8\r
68 BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
69 Caption = "New"\r
70 Key = "New"\r
71 Description = "Create a new archive"\r
72 ToolTipText = "Create a new archive"\r
73 ImageIndex = 1\r
74 EndProperty\r
75 BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
76 Caption = "Open"\r
77 Key = "Open"\r
78 Description = "Open an existing archive"\r
79 ToolTipText = "Open an existing archive"\r
80 EndProperty\r
81 BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
82 Enabled = 0 'False\r
83 Caption = "Add"\r
84 Key = "Add"\r
85 Description = "Add files to the archive"\r
86 ToolTipText = "Add files to the archive"\r
87 EndProperty\r
88 BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
89 Enabled = 0 'False\r
90 Caption = "Add Folder"\r
91 Key = "Add Folder"\r
92 Description = "Add files from a folder and its subfolders"\r
93 ToolTipText = "Add files from a folder and its subfolders"\r
94 EndProperty\r
95 BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
96 Enabled = 0 'False\r
97 Caption = "Extract"\r
98 Key = "Extract"\r
99 Description = "Extract files from the archive"\r
100 ToolTipText = "Extract files from the archive"\r
101 EndProperty\r
102 BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
103 Enabled = 0 'False\r
104 Caption = "Compact"\r
105 Key = "Compact"\r
106 Description = "Clear deleted files from the archive"\r
107 ToolTipText = "Clear deleted files from the archive"\r
108 EndProperty\r
109 BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
110 Enabled = 0 'False\r
111 Key = "filterspace"\r
112 Style = 4\r
113 Object.Width = 675\r
114 EndProperty\r
115 BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} \r
116 Enabled = 0 'False\r
117 Caption = "List"\r
118 Key = "List"\r
119 EndProperty\r
120 EndProperty\r
121 End\r
122 Begin VB.Label Label1 \r
123 AutoSize = -1 'True\r
124 Caption = " MPQ2k &Command "\r
125 Height = 195\r
126 Left = 0\r
127 TabIndex = 6\r
128 Top = 2880\r
129 Width = 1425\r
130 End\r
131 Begin MSComctlLib.ImageList ImageList1 \r
132 Left = 6120\r
133 Top = 1560\r
134 _ExtentX = 1005\r
135 _ExtentY = 1005\r
136 BackColor = -2147483643\r
137 ImageWidth = 1\r
138 ImageHeight = 1\r
139 MaskColor = 12632256\r
140 _Version = 393216\r
141 BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} \r
142 NumListImages = 1\r
143 BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} \r
144 Picture = "listing.frx":27B0\r
145 Key = ""\r
146 EndProperty\r
147 EndProperty\r
148 End\r
149 Begin MSComctlLib.StatusBar StatBar \r
150 Align = 2 'Align Bottom\r
151 Height = 300\r
152 Left = 0\r
153 TabIndex = 4\r
154 Top = 3210\r
155 Width = 6690\r
156 _ExtentX = 11800\r
157 _ExtentY = 529\r
158 _Version = 393216\r
159 BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} \r
160 NumPanels = 2\r
161 BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} \r
162 AutoSize = 1\r
163 Object.Width = 5664\r
164 MinWidth = 2\r
165 Key = "FileInfo"\r
166 EndProperty\r
167 BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} \r
168 AutoSize = 1\r
169 Object.Width = 5664\r
170 MinWidth = 2\r
171 Key = "MpqInfo"\r
172 EndProperty\r
173 EndProperty\r
174 End\r
175 Begin MSComctlLib.ListView List \r
176 Height = 2295\r
177 Left = 0\r
178 TabIndex = 0\r
179 Top = 360\r
180 Width = 6015\r
181 _ExtentX = 10610\r
182 _ExtentY = 4048\r
183 View = 3\r
184 Arrange = 2\r
185 Sorted = -1 'True\r
186 MultiSelect = -1 'True\r
187 LabelWrap = -1 'True\r
188 HideSelection = -1 'True\r
189 OLEDragMode = 1\r
190 OLEDropMode = 1\r
191 AllowReorder = -1 'True\r
192 _Version = 393217\r
193 ForeColor = -2147483640\r
194 BackColor = -2147483643\r
195 BorderStyle = 1\r
196 Appearance = 1\r
197 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} \r
198 Name = "MS Sans Serif"\r
199 Size = 8.25\r
200 Charset = 0\r
201 Weight = 400\r
202 Underline = 0 'False\r
203 Italic = 0 'False\r
204 Strikethrough = 0 'False\r
205 EndProperty\r
206 OLEDragMode = 1\r
207 OLEDropMode = 1\r
208 NumItems = 6\r
209 BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
210 Key = "N"\r
211 Text = "Name"\r
212 Object.Width = 5080\r
213 EndProperty\r
214 BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
215 Alignment = 1\r
216 SubItemIndex = 1\r
217 Key = "S"\r
218 Text = "Size"\r
219 Object.Width = 1905\r
220 EndProperty\r
221 BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
222 Alignment = 1\r
223 SubItemIndex = 2\r
224 Key = "R"\r
225 Text = "Ratio"\r
226 Object.Width = 1129\r
227 EndProperty\r
228 BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
229 Alignment = 1\r
230 SubItemIndex = 3\r
231 Key = "PK"\r
232 Text = "Packed"\r
233 Object.Width = 1905\r
234 EndProperty\r
235 BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
236 SubItemIndex = 4\r
237 Key = "LCID"\r
238 Text = "Locale ID"\r
239 Object.Width = 1129\r
240 EndProperty\r
241 BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} \r
242 SubItemIndex = 5\r
243 Key = "A"\r
244 Text = "Attributes"\r
245 Object.Width = 1129\r
246 EndProperty\r
247 End\r
248 Begin VB.Menu mnuFile \r
249 Caption = "&File"\r
250 Begin VB.Menu mnuFNew \r
251 Caption = "&New..."\r
252 Shortcut = ^N\r
253 End\r
254 Begin VB.Menu mnuFOpen \r
255 Caption = "&Open..."\r
256 Shortcut = ^O\r
257 End\r
258 Begin VB.Menu mnuFReopen \r
259 Caption = "&Reopen Mpq"\r
260 Shortcut = {F5}\r
261 End\r
262 Begin VB.Menu mnuFScript \r
263 Caption = "Run Mo'PaQ 2000 &Script..."\r
264 Shortcut = ^S\r
265 End\r
266 Begin VB.Menu mnuFSep \r
267 Caption = "-"\r
268 End\r
269 Begin VB.Menu mnuFExit \r
270 Caption = "E&xit"\r
271 End\r
272 Begin VB.Menu mnuFRecent \r
273 Caption = "-"\r
274 Index = 0\r
275 Visible = 0 'False\r
276 End\r
277 End\r
278 Begin VB.Menu mnuMpq \r
279 Caption = "&Mpq"\r
280 Enabled = 0 'False\r
281 Begin VB.Menu mnuMItem \r
282 Caption = "&Open"\r
283 Index = 0\r
284 Visible = 0 'False\r
285 End\r
286 Begin VB.Menu mnuMSep1 \r
287 Caption = "-"\r
288 Visible = 0 'False\r
289 End\r
290 Begin VB.Menu mnuMExtract \r
291 Caption = "&Extract"\r
292 Shortcut = ^E\r
293 End\r
294 Begin VB.Menu mnuMDelete \r
295 Caption = "&Delete Del or"\r
296 Shortcut = ^D\r
297 End\r
298 Begin VB.Menu mnuMRename \r
299 Caption = "Rena&me"\r
300 Shortcut = ^R\r
301 End\r
302 Begin VB.Menu mnuMChLCID \r
303 Caption = "Change Locale &ID..."\r
304 Shortcut = ^I\r
305 End\r
306 Begin VB.Menu mnuMSep2 \r
307 Caption = "-"\r
308 End\r
309 Begin VB.Menu mnuMAdd \r
310 Caption = "&Add..."\r
311 Shortcut = ^{INSERT}\r
312 End\r
313 Begin VB.Menu mnuMAddFolder \r
314 Caption = "Add &Folder..."\r
315 Shortcut = ^F\r
316 End\r
317 Begin VB.Menu mnuMCompression \r
318 Caption = "&Compression"\r
319 Begin VB.Menu mnuMCAuto \r
320 Caption = "Auto-Select"\r
321 Checked = -1 'True\r
322 Shortcut = {F4}\r
323 End\r
324 Begin VB.Menu mnuMCSep \r
325 Caption = "-"\r
326 End\r
327 Begin VB.Menu mnuMCNone \r
328 Caption = "&None"\r
329 Shortcut = {F2}\r
330 End\r
331 Begin VB.Menu mnuMCStandard \r
332 Caption = "&Standard"\r
333 Shortcut = {F3}\r
334 End\r
335 Begin VB.Menu mnuMCDeflate \r
336 Caption = "&Deflate"\r
337 Shortcut = {F9}\r
338 End\r
339 Begin VB.Menu mnuMCBzip2 \r
340 Caption = "&Bzip2"\r
341 Shortcut = ^{F11}\r
342 End\r
343 Begin VB.Menu mnuMCAudio \r
344 Caption = "&Audio"\r
345 Begin VB.Menu mnuMCALowest \r
346 Caption = "&Lowest (Best quality)"\r
347 Shortcut = {F6}\r
348 End\r
349 Begin VB.Menu mnuMCAMedium \r
350 Caption = "&Medium"\r
351 Shortcut = {F7}\r
352 End\r
353 Begin VB.Menu mnuMCAHighest \r
354 Caption = "&Highest (Least space)"\r
355 Shortcut = {F8}\r
356 End\r
357 End\r
358 End\r
359 Begin VB.Menu mnuMEncrypt \r
360 Caption = "Encr&ypt Files"\r
361 End\r
362 Begin VB.Menu mnuMCompact \r
363 Caption = "Com&pact"\r
364 Shortcut = ^P\r
365 End\r
366 Begin VB.Menu mnuMAddToList \r
367 Caption = "Add File to Li&sting..."\r
368 Shortcut = ^K\r
369 End\r
370 Begin VB.Menu mnuMSaveList \r
371 Caption = "Save File &List..."\r
372 Shortcut = ^L\r
373 End\r
374 End\r
375 Begin VB.Menu mnuTools \r
376 Caption = "&Tools"\r
377 Begin VB.Menu mnuTItem \r
378 Caption = "(Empty)"\r
379 Enabled = 0 'False\r
380 Index = 0\r
381 End\r
382 Begin VB.Menu mnuTSep \r
383 Caption = "-"\r
384 End\r
385 Begin VB.Menu mnuTMpqEmbed \r
386 Caption = "MPQ Embedder"\r
387 End\r
388 Begin VB.Menu mnuTSep2 \r
389 Caption = "-"\r
390 End\r
391 Begin VB.Menu mnuTAdd \r
392 Caption = "&Add/Remove..."\r
393 End\r
394 End\r
395 Begin VB.Menu mnuOptions \r
396 Caption = "&Options..."\r
397 End\r
398 Begin VB.Menu mnuHelp \r
399 Caption = "&Help"\r
400 Begin VB.Menu mnuHReadme \r
401 Caption = "View &Readme..."\r
402 Shortcut = {F1}\r
403 End\r
404 Begin VB.Menu mnuHSep \r
405 Caption = "-"\r
406 End\r
407 Begin VB.Menu mnuHAbout \r
408 Caption = "&About..."\r
409 End\r
410 End\r
411 Begin VB.Menu mnuPopup \r
412 Caption = "Popup Menu"\r
413 Visible = 0 'False\r
414 Begin VB.Menu mnuPItem \r
415 Caption = "&Open"\r
416 Index = 0\r
417 End\r
418 Begin VB.Menu mnuPSep1 \r
419 Caption = "-"\r
420 End\r
421 Begin VB.Menu mnuPTools \r
422 Caption = "&Tools"\r
423 Begin VB.Menu mnuPTItem \r
424 Caption = "(Empty)"\r
425 Index = 0\r
426 End\r
427 End\r
428 Begin VB.Menu mnuPSep2 \r
429 Caption = "-"\r
430 End\r
431 Begin VB.Menu mnuPExtract \r
432 Caption = "&Extract"\r
433 End\r
434 Begin VB.Menu mnuPDelete \r
435 Caption = "&Delete"\r
436 End\r
437 Begin VB.Menu mnuPRename \r
438 Caption = "Rena&me"\r
439 End\r
440 Begin VB.Menu mnuPChLCID \r
441 Caption = "Change Locale &ID..."\r
442 End\r
443 End\r
444 End\r
445 Attribute VB_Name = "MpqEx"\r
446 Attribute VB_Creatable = False\r
447 Attribute VB_Exposed = False\r
448 Option Explicit\r
449 \r
450 Dim txtCommandHasFocus As Boolean, ShiftState As Boolean\r
451 Dim OpenFiles() As String, OpenFileDates() As Date, MpqDate As Date\r
452 Sub AddRecentFile(rFileName As String)\r
453 Dim bNum As Long, fNum As Long\r
454 NewKey AppKey + "Recent\"\r
455 For bNum = 1 To 8\r
456 If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then\r
457 For fNum = bNum To 7\r
458 If Not IsEmpty(GetReg(AppKey + "Recent\File" + CStr(fNum + 1))) Then\r
459 SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))\r
460 Else\r
461 Exit For\r
462 End If\r
463 Next fNum\r
464 SetReg AppKey + "Recent\File" + CStr(fNum), rFileName\r
465 Exit For\r
466 End If\r
467 Next bNum\r
468 If fNum = 0 Then\r
469 For bNum = 1 To 8\r
470 If IsEmpty(GetReg(AppKey + "Recent\File" + CStr(bNum))) Then\r
471 SetReg AppKey + "Recent\File" + CStr(bNum), rFileName\r
472 Exit For\r
473 ElseIf bNum = 8 Then\r
474 For fNum = 1 To 7\r
475 SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))\r
476 Next fNum\r
477 SetReg AppKey + "Recent\File" + CStr(bNum), rFileName\r
478 End If\r
479 Next bNum\r
480 End If\r
481 BuildRecentFileList\r
482 End Sub\r
483 Sub BuildMpqActionList()\r
484 Dim Shift As Integer\r
485 On Error GoTo NotSelected\r
486 List.SelectedItem.Tag = List.SelectedItem.Tag\r
487 On Error GoTo 0\r
488 If List.SelectedItem.Selected = True Then\r
489 Shift = 0\r
490 If ShiftState = True Then Shift = vbShiftMask\r
491 mnuMItem(0).Visible = True\r
492 mnuMSep1.Visible = True\r
493 BuildPopup List.SelectedItem.Tag, Shift, mnuMpq, mnuMItem\r
494 Else\r
495 GoTo NotSelected\r
496 End If\r
497 Exit Sub\r
498 NotSelected:\r
499 Dim PItem As Menu\r
500 For Each PItem In mnuMItem\r
501 If PItem.Index <> 0 Then Unload PItem\r
502 Next PItem\r
503 mnuMItem(0).Visible = False\r
504 mnuMSep1.Visible = False\r
505 End Sub\r
506 Sub BuildPopup(FileName As String, Shift As Integer, mnuRoot As Menu, mnuItem)\r
507 Dim aNum As Long, aItem As String, aName As String, bNum As Long, PItem As Menu, dItem As String\r
508 mnuRoot.Tag = 0\r
509 For Each PItem In mnuItem\r
510 If PItem.Index <> 0 Then Unload PItem\r
511 Next PItem\r
512 If InStr(FileName, ".") = 0 Then\r
513 GoSub AddGlobal\r
514 Else\r
515 For bNum = 1 To Len(FileName)\r
516 If InStr(bNum, FileName, ".") > 0 Then\r
517 bNum = InStr(bNum, FileName, ".")\r
518 Else\r
519 Exit For\r
520 End If\r
521 Next bNum\r
522 aName = Mid(FileName, bNum - 1)\r
523 aName = GetReg("HKEY_CLASSES_ROOT\" + aName + "\")\r
524 If aName = "" Then\r
525 GoSub AddGlobal\r
526 Exit Sub\r
527 End If\r
528 dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")\r
529 dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)\r
530 If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\command\")) Then\r
531 If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\")) Then\r
532 mnuItem(0).Caption = "Op&en with..."\r
533 Else\r
534 mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))\r
535 End If\r
536 mnuItem(0).Tag = dItem\r
537 mnuRoot.Tag = 1\r
538 aNum = 0\r
539 bNum = 1\r
540 Else\r
541 aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", 0)\r
542 If aItem = "" Then\r
543 GoSub AddGlobal\r
544 Exit Sub\r
545 End If\r
546 If Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then\r
547 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then\r
548 mnuItem(0).Caption = "Op&en with..."\r
549 Else\r
550 mnuItem(0).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
551 End If\r
552 mnuItem(0).Tag = aItem\r
553 mnuRoot.Tag = 1\r
554 aNum = 1\r
555 bNum = 1\r
556 Else\r
557 aNum = 1\r
558 bNum = 0\r
559 End If\r
560 End If\r
561 Do\r
562 aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)\r
563 If aItem <> "" Then\r
564 If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\command\")) Then\r
565 On Error Resume Next\r
566 Load mnuItem(bNum)\r
567 On Error GoTo 0\r
568 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then\r
569 mnuItem(bNum).Caption = "Op&en with..."\r
570 Else\r
571 mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
572 End If\r
573 mnuItem(bNum).Tag = aItem\r
574 mnuRoot.Tag = mnuRoot.Tag + 1\r
575 bNum = bNum + 1\r
576 End If\r
577 aNum = aNum + 1\r
578 End If\r
579 Loop Until aItem = ""\r
580 GoSub AddGlobal\r
581 If Shift And vbShiftMask Then GoSub AddUnknown\r
582 End If\r
583 Exit Sub\r
584 AddGlobal:\r
585 aNum = 0\r
586 bNum = mnuRoot.Tag\r
587 dItem = ""\r
588 If bNum = 0 Then\r
589 dItem = GetReg("HKEY_CLASSES_ROOT\*\shell\", "open")\r
590 dItem = GetReg(SharedAppKey + "FileDefaultActions\*", dItem)\r
591 If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\command\")) Then\r
592 If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\")) Then\r
593 mnuItem(bNum).Caption = "Op&en with..."\r
594 Else\r
595 mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))\r
596 End If\r
597 mnuItem(bNum).Tag = dItem\r
598 mnuRoot.Tag = mnuRoot.Tag + 1\r
599 bNum = bNum + 1\r
600 End If\r
601 End If\r
602 Do\r
603 aItem = EnumKey("HKEY_CLASSES_ROOT\*\shell\", aNum)\r
604 If aItem <> "" Then\r
605 If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\command\")) Then\r
606 On Error Resume Next\r
607 Load mnuItem(bNum)\r
608 On Error GoTo 0\r
609 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\")) Then\r
610 mnuItem(bNum).Caption = "Op&en with..."\r
611 Else\r
612 mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\*\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
613 End If\r
614 mnuItem(bNum).Tag = aItem\r
615 mnuRoot.Tag = mnuRoot.Tag + 1\r
616 bNum = bNum + 1\r
617 End If\r
618 aNum = aNum + 1\r
619 End If\r
620 Loop Until aItem = ""\r
621 If bNum = 0 Then\r
622 GoSub AddUnknown\r
623 Exit Sub\r
624 End If\r
625 Return\r
626 AddUnknown:\r
627 aNum = 0\r
628 bNum = mnuRoot.Tag\r
629 dItem = ""\r
630 If bNum = 0 Then\r
631 dItem = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\", "open")\r
632 dItem = GetReg(SharedAppKey + "FileDefaultActions\Unknown", dItem)\r
633 If dItem <> "" And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\command\")) Then\r
634 If LCase(dItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\")) Then\r
635 mnuItem(bNum).Caption = "Op&en with..."\r
636 Else\r
637 mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + dItem + "\", "&" + UCase(Left(dItem, 1)) + Mid(dItem, 2))\r
638 End If\r
639 mnuItem(bNum).Tag = dItem\r
640 bNum = bNum + 1\r
641 End If\r
642 End If\r
643 Do\r
644 aItem = EnumKey("HKEY_CLASSES_ROOT\Unknown\shell\", aNum)\r
645 If aItem <> "" Then\r
646 If LCase(aItem) <> LCase(dItem) And Not IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\command\")) Then\r
647 On Error Resume Next\r
648 Load mnuItem(bNum)\r
649 On Error GoTo 0\r
650 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\")) Then\r
651 mnuItem(bNum).Caption = "Op&en with..."\r
652 Else\r
653 mnuItem(bNum).Caption = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + aItem + "\", "&" + UCase(Left(aItem, 1)) + Mid(aItem, 2))\r
654 End If\r
655 mnuItem(bNum).Tag = aItem\r
656 bNum = bNum + 1\r
657 End If\r
658 aNum = aNum + 1\r
659 End If\r
660 Loop Until aItem = ""\r
661 Return\r
662 End Sub\r
663 Sub ChangeLCID(NewLCID As Long)\r
664 Dim fNum As Long, hMPQ As Long\r
665 fNum = 1\r
666 hMPQ = mOpenMpq(CD.FileName)\r
667 If hMPQ Then\r
668 Do While fNum <= List.ListItems.Count\r
669 If List.ListItems.Item(fNum).Selected Then\r
670 StatBar.Style = 1\r
671 StatBar.SimpleText = "Changing locale ID of " + List.ListItems.Item(fNum).Tag + " to " + CStr(NewLCID) + "..."\r
672 MousePointer = 11\r
673 MpqSetFileLocale hMPQ, List.ListItems.Item(fNum).Tag, List.ListItems.Item(fNum).ListSubItems(4).Tag, NewLCID\r
674 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
675 List.ListItems.Item(fNum).ListSubItems(4).Tag = NewLCID\r
676 List.ListItems.Item(fNum).ListSubItems(4).Text = NewLCID\r
677 End If\r
678 fNum = fNum + 1\r
679 Loop\r
680 MpqCloseUpdatedArchive hMPQ, 0\r
681 End If\r
682 StatBar.Style = 0\r
683 StatBar.SimpleText = ""\r
684 MousePointer = 0\r
685 ShowSelected\r
686 ShowTotal\r
687 End Sub\r
688 Sub ConvertCwad()\r
689 Dim hCwad As Long, hMPQ As Long, hFile As Long, ListBuffer As String, BufSize As Long, Files() As String, buffer() As Byte, fLen As Long, nFile As Long, CwadName As String, dwFlags As Long\r
690 \r
691 If CWadOpenArchive(CD.FileName, 0, hCwad) Then\r
692 MsgBox "This archive must be converted to MPQ format to open it." + vbCrLf + "Enter a name for the converted archive or cancel if you do not want to perform the conversion.", vbInformation, "WinMPQ"\r
693 CwadName = CD.FileName\r
694 CD.Flags = &H1000 Or &H4 Or &H2\r
695 CD.DefaultExt = "mpq"\r
696 CD.Filter = "Mpq Archive (*.mpq)|*.mpq"\r
697 CD.hwndOwner = hWnd\r
698 CD.FileName = CwadName + ".mpq"\r
699 If ShowSave(CD) Then\r
700 If CD.FileName = CwadName Then\r
701 MsgBox "Cannot overwrite source archive.", vbExclamation, "WinMPQ"\r
702 CWadCloseArchive hCwad\r
703 Exit Sub\r
704 End If\r
705 \r
706 BufSize = CWadListFiles(hCwad, ListBuffer, 0)\r
707 If BufSize > 0 Then ListBuffer = String$(BufSize - 1, Chr$(0))\r
708 CWadListFiles hCwad, ListBuffer, BufSize\r
709 MultiStringToArray ListBuffer, Files\r
710 \r
711 If FileExists(CD.FileName) Then Kill CD.FileName\r
712 hMPQ = mOpenMpq(CD.FileName)\r
713 If hMPQ = 0 Then\r
714 StatBar.SimpleText = "Can't create archive " + CD.FileName\r
715 Else\r
716 dwFlags = MAFA_REPLACE_EXISTING\r
717 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
718 \r
719 For nFile = 1 To UBound(Files)\r
720 If CWadOpenFile(hCwad, Files(nFile), 0, hFile) Then\r
721 fLen = CWadGetFileSize(hFile)\r
722 \r
723 If fLen > 0 Then\r
724 ReDim buffer(fLen - 1)\r
725 Else\r
726 ReDim buffer(0)\r
727 End If\r
728 \r
729 CWadSetFilePointer hFile, 0, FILE_BEGIN\r
730 CWadReadFile hFile, buffer(0), fLen, fLen\r
731 CWadCloseFile hFile\r
732 \r
733 StatBar.SimpleText = "Adding " + Files(nFile) + "..."\r
734 MousePointer = 11\r
735 If mnuMCNone.Checked Then\r
736 MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags, 0, 0\r
737 ElseIf mnuMCStandard.Checked Then\r
738 MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
739 ElseIf mnuMCDeflate.Checked Then\r
740 MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
741 ElseIf mnuMCBzip2.Checked Then\r
742 MpqAddFileFromBufferEx hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
743 ElseIf mnuMCAMedium.Checked Then\r
744 MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 0\r
745 ElseIf mnuMCAHighest.Checked Then\r
746 MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 1\r
747 ElseIf mnuMCALowest.Checked Then\r
748 MpqAddWaveFromBuffer hMPQ, buffer(0), fLen, Files(nFile), dwFlags Or MAFA_COMPRESS, 2\r
749 ElseIf mnuMCAuto.Checked Then\r
750 mAddAutoFromBuffer hMPQ, buffer(0), fLen, Files(nFile)\r
751 End If\r
752 End If\r
753 Next nFile\r
754 \r
755 MpqCloseUpdatedArchive hMPQ, 0\r
756 End If\r
757 Else\r
758 CD.FileName = CwadName\r
759 End If\r
760 \r
761 CWadCloseArchive hCwad\r
762 End If\r
763 End Sub\r
764 \r
765 Sub DelRecentFile(rFileName As String)\r
766 Dim bNum As Long, fNum As Long\r
767 For bNum = 1 To 8\r
768 If LCase(GetReg(AppKey + "Recent\File" + CStr(bNum))) = LCase(rFileName) Then\r
769 For fNum = bNum To 7\r
770 SetReg AppKey + "Recent\File" + CStr(fNum), GetReg(AppKey + "Recent\File" + CStr(fNum + 1))\r
771 Next fNum\r
772 DelReg AppKey + "Recent\File" + CStr(8)\r
773 Exit For\r
774 End If\r
775 Next bNum\r
776 BuildRecentFileList\r
777 End Sub\r
778 Sub AddToListing(AddedFile As String)\r
779 Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, hFile As Long\r
780 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
781 If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then\r
782 L1 = AddedFile\r
783 fSize = SFileGetFileSize(hFile, 0)\r
784 cSize = SFileGetFileInfo(hFile, 6)\r
785 If fSize / 1024 > 0 And fSize / 1024 < 1 Then\r
786 L2 = "<1KB"\r
787 ElseIf fSize = 0 Then\r
788 L2 = "0KB"\r
789 Else\r
790 L2 = CStr(Int(fSize / 1024)) + "KB"\r
791 End If\r
792 If cSize / 1024 > 0 And cSize / 1024 < 1 Then\r
793 L4 = "<1KB"\r
794 ElseIf cSize = 0 Then\r
795 L4 = "0KB"\r
796 Else\r
797 L4 = CStr(Int(cSize / 1024)) + "KB"\r
798 End If\r
799 If fSize <> 0 Then\r
800 L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"\r
801 Else\r
802 L3 = "0%"\r
803 End If\r
804 fFlags = SFileGetFileInfo(hFile, 7)\r
805 L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)\r
806 If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"\r
807 If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"\r
808 If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"\r
809 On Error Resume Next\r
810 lIndex = List.ListItems.Add(, L1, L1).Index\r
811 On Error GoTo 0\r
812 If lIndex = 0 Then\r
813 lIndex = List.ListItems.Item(L1).Index\r
814 List.ListItems.Item(L1).ListSubItems.Clear\r
815 End If\r
816 List.ListItems.Item(lIndex).Tag = L1\r
817 List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize\r
818 If fSize <> 0 Then\r
819 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)\r
820 Else\r
821 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0\r
822 End If\r
823 List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize\r
824 List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6\r
825 List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5\r
826 SFileCloseFile hFile\r
827 End If\r
828 SFileCloseArchive hMPQ\r
829 End If\r
830 End Sub\r
831 Sub FileActionClick(mnuRoot As Menu, mnuItem, Index As Integer)\r
832 Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long\r
833 Path = App.Path\r
834 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
835 Path = Path + "Temp_extract\"\r
836 If ExtractPathNum = -1 Then\r
837 fNum = 0\r
838 Do\r
839 If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do\r
840 fNum = fNum + 1\r
841 Loop\r
842 ExtractPathNum = fNum\r
843 End If\r
844 Path = Path + CStr(ExtractPathNum) + "\"\r
845 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
846 For fNum = 1 To List.ListItems.Count\r
847 If List.ListItems.Item(fNum).Selected Then\r
848 StatBar.Style = 1\r
849 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
850 MousePointer = 11\r
851 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
852 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
853 SFileSetLocale LocaleID\r
854 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then\r
855 For bNum = 1 To UBound(OpenFiles)\r
856 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then\r
857 AlreadyInList = True\r
858 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
859 Exit For\r
860 End If\r
861 Next bNum\r
862 If AlreadyInList = False Then\r
863 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date\r
864 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag\r
865 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
866 End If\r
867 End If\r
868 StatBar.Style = 1\r
869 StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."\r
870 fName = List.ListItems.Item(fNum).Tag\r
871 ExecuteFile Path + fName, Index, mnuRoot, mnuItem\r
872 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True\r
873 End If\r
874 Next fNum\r
875 SFileCloseArchive hMPQ\r
876 StatBar.Style = 0\r
877 StatBar.SimpleText = ""\r
878 MousePointer = 0\r
879 End Sub\r
880 Sub MpqAddToListing(hMPQ As Long, AddedFile As String)\r
881 Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long, hFile As Long\r
882 If SFileOpenFileEx(hMPQ, AddedFile, 0, hFile) Then\r
883 L1 = AddedFile\r
884 fSize = SFileGetFileSize(hFile, 0)\r
885 cSize = SFileGetFileInfo(hFile, 6)\r
886 If fSize / 1024 > 0 And fSize / 1024 < 1 Then\r
887 L2 = "<1KB"\r
888 ElseIf fSize = 0 Then\r
889 L2 = "0KB"\r
890 Else\r
891 L2 = CStr(Int(fSize / 1024)) + "KB"\r
892 End If\r
893 If cSize / 1024 > 0 And cSize / 1024 < 1 Then\r
894 L4 = "<1KB"\r
895 ElseIf cSize = 0 Then\r
896 L4 = "0KB"\r
897 Else\r
898 L4 = CStr(Int(cSize / 1024)) + "KB"\r
899 End If\r
900 If fSize <> 0 Then\r
901 L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"\r
902 Else\r
903 L3 = "0%"\r
904 End If\r
905 fFlags = SFileGetFileInfo(hFile, 7)\r
906 L6 = SFileGetFileInfo(hFile, SFILE_INFO_LOCALEID)\r
907 If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"\r
908 If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"\r
909 If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"\r
910 On Error Resume Next\r
911 lIndex = List.ListItems.Add(, L1, L1).Index\r
912 On Error GoTo 0\r
913 If lIndex = 0 Then\r
914 lIndex = List.ListItems.Item(L1).Index\r
915 List.ListItems.Item(L1).ListSubItems.Clear\r
916 End If\r
917 List.ListItems.Item(lIndex).Tag = L1\r
918 List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize\r
919 If fSize <> 0 Then\r
920 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)\r
921 Else\r
922 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0\r
923 End If\r
924 List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize\r
925 List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6\r
926 List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5\r
927 SFileCloseFile hFile\r
928 End If\r
929 End Sub\r
930 Sub RemoveFromListing(RemovedFile As String)\r
931 Dim FileCount As Long\r
932 On Error GoTo FileRemoved\r
933 Do\r
934 List.ListItems.Remove RemovedFile\r
935 FileCount = FileCount + 1\r
936 Loop\r
937 FileRemoved:\r
938 If FileCount = 0 Then\r
939 For FileCount = 1 To List.ListItems.Count\r
940 If LCase(RemovedFile) = LCase(List.ListItems.Item(FileCount).Key) Then\r
941 List.ListItems.Remove FileCount\r
942 Exit Sub\r
943 End If\r
944 Next FileCount\r
945 End If\r
946 End Sub\r
947 Sub RenameInListing(OldName As String, NewName As String)\r
948 Dim lIndex As Long\r
949 If LCase(OldName) <> LCase(NewName) Then RemoveFromListing NewName\r
950 On Error GoTo RenameError\r
951 lIndex = List.ListItems.Item(OldName).Index\r
952 List.ListItems.Item(lIndex).Text = NewName\r
953 List.ListItems.Item(lIndex).Tag = NewName\r
954 On Error Resume Next\r
955 List.ListItems.Item(lIndex).Key = NewName\r
956 On Error GoTo 0\r
957 Exit Sub\r
958 RenameError:\r
959 For lIndex = 1 To List.ListItems.Count\r
960 If LCase(OldName) = LCase(List.ListItems.Item(lIndex).Key) Then\r
961 List.ListItems.Item(lIndex).Text = NewName\r
962 List.ListItems.Item(lIndex).Tag = NewName\r
963 On Error Resume Next\r
964 List.ListItems.Item(lIndex).Key = NewName\r
965 On Error GoTo 0\r
966 Exit Sub\r
967 End If\r
968 Next lIndex\r
969 End Sub\r
970 Sub ExecuteFile(FileName As String, Index As Integer, mnuRoot As Menu, mnuItem)\r
971 Dim Param As String, bNum As Long, bNum2 As Long, EnvName As String, RetVal As Long, sei As SHELLEXECUTEINFO\r
972 If Index < mnuRoot.Tag Then\r
973 With sei\r
974 .cbSize = Len(sei)\r
975 .fMask = 0\r
976 .hWnd = hWnd\r
977 .lpVerb = mnuItem(Index).Tag\r
978 .lpFile = FileName\r
979 .lpParameters = vbNullString\r
980 .lpDirectory = vbNullString\r
981 .nShow = 1\r
982 End With\r
983 RetVal = ShellExecuteEx(sei)\r
984 Else\r
985 With sei\r
986 .cbSize = Len(sei)\r
987 .fMask = SEE_MASK_CLASSNAME\r
988 .hWnd = hWnd\r
989 .lpVerb = mnuItem(Index).Tag\r
990 .lpFile = FileName\r
991 .lpParameters = vbNullString\r
992 .lpDirectory = vbNullString\r
993 .nShow = 1\r
994 .lpClass = "Unknown"\r
995 End With\r
996 RetVal = ShellExecuteEx(sei)\r
997 End If\r
998 'If RetVal >= 0 And RetVal <= 32 And Index >= mnuRoot.Tag Then\r
999 ' Param = GetReg("HKEY_CLASSES_ROOT\Unknown\shell\" + mnuItem(Index).Tag + "\command\")\r
1000 ' Do\r
1001 ' If InStr(Param, "%1") = 0 Then\r
1002 ' Param = Param + " " + FileName\r
1003 ' Else\r
1004 ' bNum = InStr(Param, "%1")\r
1005 ' Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)\r
1006 ' End If\r
1007 ' Loop While InStr(Param, "%1")\r
1008 ' bNum = 1\r
1009 ' Do While bNum <= Len(Param)\r
1010 ' If InStr(bNum, Param, "%") Then\r
1011 ' bNum = InStr(bNum, Param, "%")\r
1012 ' If InStr(bNum + 1, Param, "%") Then\r
1013 ' bNum2 = InStr(bNum + 1, Param, "%")\r
1014 ' EnvName = Mid(Param, bNum + 1, bNum2 - bNum - 1)\r
1015 ' If Environ(EnvName) <> "" Then\r
1016 ' Param = Left(Param, bNum - 1) + Environ(EnvName) + Mid(Param, bNum2 + 1)\r
1017 ' End If\r
1018 ' End If\r
1019 ' End If\r
1020 ' bNum = bNum + 1\r
1021 ' Loop\r
1022 ' On Error GoTo NoProgram\r
1023 ' Shell Param, 1\r
1024 ' On Error GoTo 0\r
1025 'End If\r
1026 'Exit Sub\r
1027 'NoProgram:\r
1028 'If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"\r
1029 End Sub\r
1030 Sub RunMpq2kCommand(CmdLine As String)\r
1031 Dim sLine As String, pNum As Long, Param() As String, EndParam As Long, CurPath As String, cType As Integer, Rswitch As Boolean, fCount As Long, Files As String, fEndLine As Long, fLine As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String, TItem As Menu, fLine2 As String, fLineTitle As String, hMPQ As Long, hFile As Long, FileShortNames() As String, dwFlags As Long\r
1032 CurPath = CurDir\r
1033 If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"\r
1034 sLine = CmdLine\r
1035 If Right(sLine, 1) <> " " Then sLine = sLine + " "\r
1036 If sLine <> "" Then\r
1037 ReDim Param(0) As String\r
1038 For pNum = 1 To Len(sLine)\r
1039 If Mid(sLine, pNum, 1) = Chr(34) Then\r
1040 pNum = pNum + 1\r
1041 EndParam = InStr(pNum, sLine, Chr(34))\r
1042 Else\r
1043 EndParam = InStr(pNum, sLine, " ")\r
1044 End If\r
1045 If EndParam = 0 Then EndParam = Len(sLine) + 1\r
1046 If pNum <> EndParam Then\r
1047 If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then\r
1048 ReDim Preserve Param(UBound(Param) + 1) As String\r
1049 Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))\r
1050 End If\r
1051 End If\r
1052 pNum = EndParam\r
1053 Next pNum\r
1054 If UBound(Param) < 3 Then ReDim Preserve Param(3) As String\r
1055 Select Case LCase(Param(1))\r
1056 Case "?", "h", "help"\r
1057 mnuHReadme_Click\r
1058 Case "o", "open"\r
1059 OldFileName = CD.FileName\r
1060 If Param(2) <> "" Then\r
1061 CD.FileName = FullPath(CurPath, Param(2))\r
1062 End If\r
1063 If Param(3) <> "" And FileExists(CD.FileName) = False And CD.FileName <> "" Then\r
1064 DefaultMaxFiles = Param(3)\r
1065 End If\r
1066 If FileExists(CD.FileName) Then\r
1067 OpenMpq\r
1068 If CD.FileName = "" Then\r
1069 CD.FileName = OldFileName\r
1070 StatBar.SimpleText = "The file does not contain an MPQ archive."\r
1071 Else\r
1072 StatBar.SimpleText = "Opened " + CD.FileName\r
1073 AddRecentFile CD.FileName\r
1074 End If\r
1075 ElseIf FileExists(CD.FileName) = False And CD.FileName <> "" Then\r
1076 ReDim FileList(0) As String\r
1077 List.ListItems.Clear\r
1078 ShowSelected\r
1079 ShowTotal\r
1080 NewFile = True\r
1081 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
1082 mnuMpq.Enabled = True\r
1083 For Each TItem In mnuTItem\r
1084 TItem.Enabled = True\r
1085 Next TItem\r
1086 Toolbar.Buttons.Item("Add").Enabled = True\r
1087 Toolbar.Buttons.Item("Add Folder").Enabled = True\r
1088 Toolbar.Buttons.Item("Extract").Enabled = True\r
1089 Toolbar.Buttons.Item("Compact").Enabled = True\r
1090 Toolbar.Buttons.Item("List").Enabled = True\r
1091 If InStr(CD.FileName, "\") > 0 Then\r
1092 For bNum = 1 To Len(CD.FileName)\r
1093 If InStr(bNum, CD.FileName, "\") > 0 Then\r
1094 bNum = InStr(bNum, CD.FileName, "\")\r
1095 Else\r
1096 Exit For\r
1097 End If\r
1098 Next bNum\r
1099 End If\r
1100 Caption = "WinMPQ - " + Mid(CD.FileName, bNum)\r
1101 StatBar.SimpleText = "Created new " + CD.FileName\r
1102 AddRecentFile CD.FileName\r
1103 ElseIf CD.FileName = "" Then\r
1104 StatBar.SimpleText = "Required parameter missing"\r
1105 End If\r
1106 Case "n", "new"\r
1107 If Param(2) <> "" Then\r
1108 CD.FileName = FullPath(CurPath, Param(2))\r
1109 If Param(3) <> "" Then\r
1110 DefaultMaxFiles = Param(3)\r
1111 End If\r
1112 If CD.FileName <> "" Then\r
1113 ReDim FileList(0) As String\r
1114 List.ListItems.Clear\r
1115 ShowSelected\r
1116 ShowTotal\r
1117 NewFile = True\r
1118 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
1119 mnuMpq.Enabled = True\r
1120 For Each TItem In mnuTItem\r
1121 TItem.Enabled = True\r
1122 Next TItem\r
1123 Toolbar.Buttons.Item("Add").Enabled = True\r
1124 Toolbar.Buttons.Item("Add Folder").Enabled = True\r
1125 Toolbar.Buttons.Item("Extract").Enabled = True\r
1126 Toolbar.Buttons.Item("Compact").Enabled = True\r
1127 Toolbar.Buttons.Item("List").Enabled = True\r
1128 If InStr(CD.FileName, "\") > 0 Then\r
1129 For bNum = 1 To Len(CD.FileName)\r
1130 If InStr(bNum, CD.FileName, "\") > 0 Then\r
1131 bNum = InStr(bNum, CD.FileName, "\")\r
1132 Else\r
1133 Exit For\r
1134 End If\r
1135 Next bNum\r
1136 End If\r
1137 Caption = "WinMPQ - " + Mid(CD.FileName, bNum)\r
1138 StatBar.SimpleText = "Created new " + CD.FileName\r
1139 AddRecentFile CD.FileName\r
1140 End If\r
1141 Else\r
1142 StatBar.SimpleText = "Required parameter missing"\r
1143 End If\r
1144 Case "c", "close"\r
1145 StatBar.SimpleText = "Close is for scripts only"\r
1146 Case "p", "pause"\r
1147 StatBar.SimpleText = "Pause not supported"\r
1148 Case "a", "add"\r
1149 If CD.FileName <> "" Then\r
1150 ReDim FileShortNames(0) As String\r
1151 cType = 0\r
1152 Rswitch = False\r
1153 fCount = 0\r
1154 Files = ""\r
1155 fEndLine = 0\r
1156 fLine = ""\r
1157 dwFlags = MAFA_REPLACE_EXISTING\r
1158 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
1159 For pNum = 3 To UBound(Param)\r
1160 If LCase(Param(pNum)) = "/wav" Then\r
1161 cType = 2\r
1162 dwFlags = dwFlags Or MAFA_COMPRESS\r
1163 ElseIf LCase(Param(pNum)) = "/c" And cType < 2 Then\r
1164 cType = 1\r
1165 dwFlags = dwFlags Or MAFA_COMPRESS\r
1166 ElseIf LCase(Param(pNum)) = "/auto" And cType < 1 Then\r
1167 cType = -1\r
1168 ElseIf LCase(Param(pNum)) = "/r" Then\r
1169 Rswitch = True\r
1170 End If\r
1171 Next pNum\r
1172 If Left(Param(3), 1) = "/" Or Param(3) = "" Then\r
1173 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
1174 Param(3) = ""\r
1175 Else\r
1176 Param(3) = Param(2)\r
1177 End If\r
1178 End If\r
1179 If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
1180 If InStr(Param(2), "\") > 0 Then\r
1181 For pNum = 1 To Len(Param(2))\r
1182 If InStr(pNum, Param(2), "\") > 0 Then\r
1183 pNum = InStr(pNum, Param(2), "\")\r
1184 Files = Left(Param(2), pNum)\r
1185 End If\r
1186 Next pNum\r
1187 End If\r
1188 MousePointer = 11\r
1189 If NewFile = True Then\r
1190 If FileExists(CD.FileName) Then Kill CD.FileName\r
1191 NewFile = False\r
1192 End If\r
1193 Files = DirEx(Files, Mid(Param(2), Len(Files) + 1), 6, Rswitch)\r
1194 List.Sorted = False\r
1195 FileFilter = mFilter\r
1196 hMPQ = mOpenMpq(CD.FileName)\r
1197 If hMPQ = 0 Then\r
1198 StatBar.SimpleText = "Can't create archive " + CD.FileName\r
1199 Exit Sub\r
1200 End If\r
1201 For pNum = 1 To Len(Files)\r
1202 fEndLine = InStr(pNum, Files, vbCrLf)\r
1203 fLine = Mid(Files, pNum, fEndLine - pNum)\r
1204 If cType = 0 Then\r
1205 StatBar.SimpleText = "Adding " + fLine + "..."\r
1206 ElseIf cType = 1 Then\r
1207 StatBar.SimpleText = "Adding compressed " + fLine + "..."\r
1208 ElseIf cType = 2 Then\r
1209 StatBar.SimpleText = "Adding compressed WAV " + fLine + "..."\r
1210 ElseIf cType = -1 Then\r
1211 StatBar.SimpleText = "Adding " + fLine + " (compression auto-select)..."\r
1212 End If\r
1213 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
1214 If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"\r
1215 If cType = 2 Then\r
1216 MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0\r
1217 ElseIf cType = -1 Then\r
1218 mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3) + fLine\r
1219 ElseIf cType = 1 Then\r
1220 If DefaultCompress = MAFA_COMPRESS_DEFLATE Then\r
1221 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, DefaultCompressLevel\r
1222 Else\r
1223 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, DefaultCompress, 0\r
1224 End If\r
1225 Else\r
1226 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3) + fLine, dwFlags, 0, 0\r
1227 End If\r
1228 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1229 mFilter.AddItem "*" + GetExtension(Param(3) + fLine)\r
1230 For cNum = 1 To mFilter.ListCount - 1\r
1231 If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
1232 mFilter.RemoveItem cNum\r
1233 Exit For\r
1234 End If\r
1235 Next cNum\r
1236 If MatchesFilter(Param(3) + fLine, FileFilter) Then\r
1237 ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String\r
1238 FileShortNames(UBound(FileShortNames)) = Param(3) + fLine\r
1239 End If\r
1240 Else\r
1241 If cType = 2 Then\r
1242 MpqAddWaveToArchive hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0\r
1243 ElseIf cType = -1 Then\r
1244 mAddAutoFile hMPQ, FullPath(CurPath, fLine), Param(3)\r
1245 ElseIf cType = 1 Then\r
1246 If DefaultCompress = MAFA_COMPRESS_DEFLATE Then\r
1247 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, DefaultCompressLevel\r
1248 Else\r
1249 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, DefaultCompress, 0\r
1250 End If\r
1251 Else\r
1252 MpqAddFileToArchiveEx hMPQ, FullPath(CurPath, fLine), Param(3), dwFlags, 0, 0\r
1253 End If\r
1254 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1255 mFilter.AddItem "*" + GetExtension(Param(3))\r
1256 For cNum = 1 To mFilter.ListCount - 1\r
1257 If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
1258 mFilter.RemoveItem cNum\r
1259 Exit For\r
1260 End If\r
1261 Next cNum\r
1262 If MatchesFilter(Param(3), FileFilter) Then\r
1263 ReDim Preserve FileShortNames(UBound(FileShortNames) + 1) As String\r
1264 FileShortNames(UBound(FileShortNames)) = Param(3)\r
1265 End If\r
1266 End If\r
1267 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1268 fCount = fCount + 1\r
1269 pNum = fEndLine + 1\r
1270 Next pNum\r
1271 MpqCloseUpdatedArchive hMPQ, 0\r
1272 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1273 If UBound(FileShortNames) > 1 Then\r
1274 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
1275 StatBar.SimpleText = "Adding files to listing... 0% complete"\r
1276 For pNum = 1 To UBound(FileShortNames)\r
1277 If MatchesFilter(FileShortNames(pNum), FileFilter) Then\r
1278 MpqAddToListing hMPQ, FileShortNames(pNum)\r
1279 End If\r
1280 On Error Resume Next\r
1281 StatBar.SimpleText = "Adding files to listing... " + CStr(Int((pNum / UBound(FileShortNames)) * 100)) + "% complete"\r
1282 On Error GoTo 0\r
1283 Next pNum\r
1284 SFileCloseArchive hMPQ\r
1285 End If\r
1286 ElseIf UBound(FileShortNames) = 1 Then\r
1287 AddToListing FileShortNames(1)\r
1288 End If\r
1289 MousePointer = 0\r
1290 If MatchesFilter("(listfile)", FileFilter) Then\r
1291 AddToListing "(listfile)"\r
1292 End If\r
1293 mFilter = FileFilter\r
1294 List.Sorted = True\r
1295 RemoveDuplicates\r
1296 ShowTotal\r
1297 If fCount > 1 Then\r
1298 StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " added"\r
1299 End If\r
1300 Else\r
1301 StatBar.SimpleText = "Required parameter missing"\r
1302 End If\r
1303 Else\r
1304 StatBar.SimpleText = "No archive open"\r
1305 End If\r
1306 Case "e", "extract"\r
1307 If CD.FileName <> "" Then\r
1308 If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Extracting " + Param(2) + "..."\r
1309 cType = 0\r
1310 For pNum = 3 To UBound(Param)\r
1311 If LCase(Param(pNum)) = "/fp" Then\r
1312 cType = 1\r
1313 Exit For\r
1314 End If\r
1315 Next pNum\r
1316 If Left(Param(3), 1) = "/" Then Param(3) = ""\r
1317 If Param(3) = "" Then Param(3) = "."\r
1318 If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
1319 MousePointer = 11\r
1320 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
1321 Files = MpqDir(CD.FileName, Param(2))\r
1322 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then\r
1323 StatBar.SimpleText = "Can't open archive " + CD.FileName\r
1324 Exit Sub\r
1325 End If\r
1326 For pNum = 1 To Len(Files)\r
1327 fEndLine = InStr(pNum, Files, vbCrLf)\r
1328 fLine = Mid(Files, pNum, fEndLine - pNum)\r
1329 StatBar.SimpleText = "Extracting " + fLine + "..."\r
1330 sGetFile hMPQ, fLine, FullPath(CurPath, Param(3)), cType\r
1331 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1332 fCount = fCount + 1\r
1333 pNum = fEndLine + 1\r
1334 Next pNum\r
1335 SFileCloseArchive hMPQ\r
1336 If fCount > 1 Then\r
1337 StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " extracted"\r
1338 End If\r
1339 Else\r
1340 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then\r
1341 StatBar.SimpleText = "Can't open archive " + CD.FileName\r
1342 Exit Sub\r
1343 End If\r
1344 sGetFile hMPQ, Param(2), FullPath(CurPath, Param(3)), cType\r
1345 SFileCloseArchive hMPQ\r
1346 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1347 End If\r
1348 MousePointer = 0\r
1349 Else\r
1350 StatBar.SimpleText = "Required parameter missing"\r
1351 End If\r
1352 Else\r
1353 StatBar.SimpleText = "No archive open"\r
1354 End If\r
1355 Case "r", "ren", "rename"\r
1356 If CD.FileName <> "" Then\r
1357 If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Renaming " + Param(2) + " => " + Param(3) + "..."\r
1358 If Param(2) <> "" And Param(3) <> "" Then\r
1359 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
1360 If InStr(Param(3), "*") <> 0 Or InStr(Param(3), "?") <> 0 Then\r
1361 Files = MpqDir(CD.FileName, Param(2))\r
1362 hMPQ = mOpenMpq(CD.FileName)\r
1363 If hMPQ Then\r
1364 For pNum = 1 To Len(Files)\r
1365 fEndLine = InStr(pNum, Files, vbCrLf)\r
1366 fLine = Mid(Files, pNum, fEndLine - pNum)\r
1367 fLine2 = RenameWithFilter(fLine, Param(2), Param(3))\r
1368 StatBar.SimpleText = "Renaming " + fLine + " => " + fLine2 + "..."\r
1369 If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then\r
1370 SFileCloseFile hFile\r
1371 MpqDeleteFile hMPQ, fLine2\r
1372 MpqRenameFile hMPQ, fLine, fLine2\r
1373 Else\r
1374 MpqRenameFile hMPQ, fLine, fLine2\r
1375 End If\r
1376 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1377 RenameInListing fLine, fLine2\r
1378 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1379 fCount = fCount + 1\r
1380 pNum = fEndLine + 1\r
1381 Next pNum\r
1382 MpqCloseUpdatedArchive hMPQ, 0\r
1383 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1384 End If\r
1385 If fCount > 1 Then\r
1386 StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " renamed"\r
1387 End If\r
1388 Else\r
1389 StatBar.SimpleText = "You must use wildcards with new name"\r
1390 End If\r
1391 Else\r
1392 hMPQ = mOpenMpq(CD.FileName)\r
1393 If hMPQ Then\r
1394 If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then\r
1395 SFileCloseFile hFile\r
1396 MpqDeleteFile hMPQ, Param(3)\r
1397 MpqRenameFile hMPQ, Param(2), Param(3)\r
1398 Else\r
1399 MpqRenameFile hMPQ, Param(2), Param(3)\r
1400 End If\r
1401 MpqCloseUpdatedArchive hMPQ, 0\r
1402 End If\r
1403 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1404 RenameInListing Param(2), Param(3)\r
1405 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1406 End If\r
1407 Else\r
1408 StatBar.SimpleText = "Required parameter missing"\r
1409 End If\r
1410 Else\r
1411 StatBar.SimpleText = "No archive open"\r
1412 End If\r
1413 Case "m", "move"\r
1414 If CD.FileName <> "" Then\r
1415 For pNum = 1 To Len(Param(2))\r
1416 If InStr(pNum, Param(2), "\") Then\r
1417 pNum = InStr(pNum, Param(2), "\")\r
1418 Else\r
1419 Exit For\r
1420 End If\r
1421 Next pNum\r
1422 fLineTitle = Mid(Param(2), pNum)\r
1423 If Right(Param(3), 1) <> "\" And Param(3) <> "" Then Param(3) = Param(3) + "\"\r
1424 Param(3) = Param(3) + fLineTitle\r
1425 If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Moving " + Param(2) + " => " + Param(3) + "..."\r
1426 If (Left(Param(2), 1) <> "/" And Param(2) <> "") And (Left(Param(3), 1) <> "/") Then\r
1427 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
1428 Files = MpqDir(CD.FileName, Param(2))\r
1429 hMPQ = mOpenMpq(CD.FileName)\r
1430 If hMPQ Then\r
1431 For pNum = 1 To Len(Files)\r
1432 fEndLine = InStr(pNum, Files, vbCrLf)\r
1433 fLine = Mid(Files, pNum, fEndLine - pNum)\r
1434 fLine2 = RenameWithFilter(fLine, Param(2), Param(3))\r
1435 StatBar.SimpleText = "Moving " + fLine + " => " + fLine2 + "..."\r
1436 If SFileOpenFileEx(hMPQ, fLine2, 0, hFile) Then\r
1437 SFileCloseFile hFile\r
1438 MpqDeleteFile hMPQ, fLine2\r
1439 MpqRenameFile hMPQ, fLine, fLine2\r
1440 Else\r
1441 MpqRenameFile hMPQ, fLine, fLine2\r
1442 End If\r
1443 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1444 RenameInListing fLine, fLine2\r
1445 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1446 fCount = fCount + 1\r
1447 pNum = fEndLine + 1\r
1448 Next pNum\r
1449 MpqCloseUpdatedArchive hMPQ, 0\r
1450 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1451 End If\r
1452 If fCount > 1 Then\r
1453 StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " moved"\r
1454 End If\r
1455 Else\r
1456 hMPQ = mOpenMpq(CD.FileName)\r
1457 If hMPQ Then\r
1458 If SFileOpenFileEx(hMPQ, Param(3), 0, hFile) Then\r
1459 SFileCloseFile hFile\r
1460 MpqDeleteFile hFile, Param(3)\r
1461 MpqRenameFile hFile, Param(2), Param(3)\r
1462 Else\r
1463 MpqRenameFile hFile, Param(2), Param(3)\r
1464 End If\r
1465 MpqCloseUpdatedArchive hMPQ, 0\r
1466 End If\r
1467 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1468 RenameInListing Param(2), Param(3)\r
1469 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1470 End If\r
1471 Else\r
1472 StatBar.SimpleText = "Required parameter missing"\r
1473 End If\r
1474 Else\r
1475 StatBar.SimpleText = "No archive open"\r
1476 End If\r
1477 Case "d", "del", "delete"\r
1478 If CD.FileName <> "" Then\r
1479 If InStr(Param(2), "*") = 0 And InStr(Param(2), "?") = 0 Then StatBar.SimpleText = "Deleting " + Param(2) + "..."\r
1480 If Left(Param(2), 1) <> "/" And Param(2) <> "" Then\r
1481 If InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0 Then\r
1482 Files = MpqDir(CD.FileName, Param(2))\r
1483 hMPQ = mOpenMpq(CD.FileName)\r
1484 If hMPQ Then\r
1485 For pNum = 1 To Len(Files)\r
1486 fEndLine = InStr(pNum, Files, vbCrLf)\r
1487 fLine = Mid(Files, pNum, fEndLine - pNum)\r
1488 StatBar.SimpleText = "Deleting " + fLine + "..."\r
1489 MpqDeleteFile hMPQ, fLine\r
1490 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1491 RemoveFromListing fLine\r
1492 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1493 fCount = fCount + 1\r
1494 pNum = fEndLine + 1\r
1495 Next pNum\r
1496 MpqCloseUpdatedArchive hMPQ, 0\r
1497 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1498 End If\r
1499 If fCount > 1 Then\r
1500 StatBar.SimpleText = CStr(fCount) + " files of " + Param(2) + " deleted"\r
1501 End If\r
1502 Else\r
1503 hMPQ = mOpenMpq(CD.FileName)\r
1504 If hMPQ Then\r
1505 MpqDeleteFile hMPQ, Param(2)\r
1506 MpqCloseUpdatedArchive hMPQ, 0\r
1507 End If\r
1508 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1509 RemoveFromListing Param(2)\r
1510 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1511 End If\r
1512 Else\r
1513 StatBar.SimpleText = "Required parameter missing"\r
1514 End If\r
1515 Else\r
1516 StatBar.SimpleText = "No archive open"\r
1517 End If\r
1518 Case "f", "flush", "compact"\r
1519 If CD.FileName <> "" Then\r
1520 MousePointer = 11\r
1521 StatBar.SimpleText = "Flushing " + CD.FileName + "..."\r
1522 hMPQ = mOpenMpq(CD.FileName)\r
1523 If hMPQ Then\r
1524 MpqCompactArchive hMPQ\r
1525 MpqCloseUpdatedArchive hMPQ, 0\r
1526 End If\r
1527 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1528 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1529 MousePointer = 0\r
1530 OpenMpq\r
1531 Else\r
1532 StatBar.SimpleText = "No archive open"\r
1533 End If\r
1534 Case "l", "list"\r
1535 If CD.FileName <> "" Then\r
1536 If Param(2) <> "" Then\r
1537 StatBar.SimpleText = "Creating list..."\r
1538 MousePointer = 11\r
1539 If (InStr(Param(2), "*") <> 0 Or InStr(Param(2), "?") <> 0) And Param(3) <> "" Then\r
1540 Files = MpqDir(CD.FileName, Param(2))\r
1541 Param(2) = Param(3)\r
1542 Else\r
1543 Files = MpqDir(CD.FileName, "*")\r
1544 End If\r
1545 fNum = FreeFile\r
1546 Open FullPath(CurPath, Param(2)) For Binary As #fNum\r
1547 Put #fNum, 1, Files\r
1548 Close #fNum\r
1549 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1550 MousePointer = 0\r
1551 Else\r
1552 StatBar.SimpleText = "Required parameter missing"\r
1553 End If\r
1554 Else\r
1555 StatBar.SimpleText = "No archive open"\r
1556 End If\r
1557 Case "s", "script"\r
1558 StatBar.SimpleText = "Running script " + Param(2) + "..."\r
1559 If Param(2) <> "" Then\r
1560 MousePointer = 11\r
1561 RunScript FullPath(CurPath, Param(2))\r
1562 MousePointer = 0\r
1563 StatBar.SimpleText = StatBar.SimpleText + " Done"\r
1564 Else\r
1565 StatBar.SimpleText = "Required parameter missing"\r
1566 End If\r
1567 Case "x", "exit", "quit"\r
1568 Unload Me\r
1569 Case Else\r
1570 If Left(Param(1), 1) <> ";" Then\r
1571 If LCase(Param(1)) = "cd" Or LCase(Param(1)) = "chdir" Then\r
1572 On Error Resume Next\r
1573 ChDir Param(2)\r
1574 On Error GoTo 0\r
1575 txtCommand_GotFocus\r
1576 ElseIf Left(LCase(Param(1)), 3) = "cd." Or Left(LCase(Param(1)), 3) = "cd\" Then\r
1577 On Error Resume Next\r
1578 ChDir Mid(Param(1), 3)\r
1579 On Error GoTo 0\r
1580 txtCommand_GotFocus\r
1581 ElseIf Left(LCase(Param(1)), 6) = "chdir." Or Left(LCase(Param(1)), 6) = "chdir\" Then\r
1582 On Error Resume Next\r
1583 ChDir Mid(Param(1), 6)\r
1584 On Error GoTo 0\r
1585 txtCommand_GotFocus\r
1586 ElseIf Mid(Param(1), 2, 1) = ":" And (Len(Param(1)) = 2 Or Right(Param(1), 1) = "\") Then\r
1587 On Error Resume Next\r
1588 ChDrive Left(Param(1), 2)\r
1589 On Error GoTo 0\r
1590 txtCommand_GotFocus\r
1591 Else\r
1592 Shell "command.com /k " + sLine, 1\r
1593 End If\r
1594 End If\r
1595 End Select\r
1596 End If\r
1597 End Sub\r
1598 Sub BuildRecentFileList()\r
1599 Dim rNum As Long, rNum2 As Long, RecentFile As String, FirstSep As Long, LastSep As Long, RItem As Menu\r
1600 For Each RItem In mnuFRecent\r
1601 If RItem.Index <> 0 Then Unload RItem\r
1602 Next RItem\r
1603 rNum2 = 1\r
1604 For rNum = 8 To 1 Step -1\r
1605 RecentFile = GetReg(AppKey + "Recent\File" + CStr(rNum))\r
1606 If FileExists(RecentFile) Then\r
1607 mnuFRecent(0).Visible = True\r
1608 On Error Resume Next\r
1609 Load mnuFRecent(rNum2)\r
1610 On Error GoTo 0\r
1611 mnuFRecent(rNum2).Tag = RecentFile\r
1612 If TextWidth(RecentFile) > TextWidth("________________________________") Then\r
1613 FirstSep = InStr(RecentFile, "\")\r
1614 If FirstSep > 0 Then\r
1615 For LastSep = FirstSep + 1 To Len(RecentFile)\r
1616 If InStr(LastSep, RecentFile, "\") > 0 Then\r
1617 LastSep = InStr(LastSep, RecentFile, "\")\r
1618 Else\r
1619 Exit For\r
1620 End If\r
1621 Next LastSep\r
1622 RecentFile = Left(RecentFile, FirstSep) + "..." + Mid(RecentFile, LastSep - 1)\r
1623 End If\r
1624 End If\r
1625 mnuFRecent(rNum2).Caption = "&" + CStr(rNum2) + " " + RecentFile\r
1626 rNum2 = rNum2 + 1\r
1627 End If\r
1628 If rNum2 > 4 Then Exit For\r
1629 Next rNum\r
1630 End Sub\r
1631 Sub BuildToolsList()\r
1632 Dim tNum As Long, ToolName As String, ToolCommand, TItem As Menu\r
1633 For Each TItem In mnuTItem\r
1634 If TItem.Index <> 0 Then Unload TItem\r
1635 Next TItem\r
1636 For Each TItem In mnuPTItem\r
1637 If TItem.Index <> 0 Then Unload TItem\r
1638 Next TItem\r
1639 mnuTItem(0).Caption = "(Empty)"\r
1640 mnuPTItem(0).Caption = mnuTItem(0).Caption\r
1641 mnuTItem(0).Tag = ""\r
1642 mnuPTItem(0).Tag = ""\r
1643 Do\r
1644 ToolName = GetReg(AppKey + "Tools\Name" + CStr(tNum))\r
1645 ToolCommand = GetReg(AppKey + "Tools\Command" + CStr(tNum))\r
1646 If ToolName = "" Then ToolName = ToolCommand\r
1647 If ToolName <> "" Then\r
1648 On Error Resume Next\r
1649 Load mnuTItem(tNum)\r
1650 Load mnuPTItem(tNum)\r
1651 On Error GoTo 0\r
1652 mnuTItem(tNum).Tag = ToolCommand\r
1653 mnuPTItem(tNum).Tag = mnuTItem(tNum).Tag\r
1654 If InStr(ToolName, "&") = 0 And tNum < 9 Then\r
1655 mnuTItem(tNum).Caption = "&" + CStr(tNum + 1) + " " + ToolName\r
1656 ElseIf InStr(ToolName, "&") = 0 And tNum = 9 Then\r
1657 mnuTItem(tNum).Caption = "&0 " + ToolName\r
1658 Else\r
1659 mnuTItem(tNum).Caption = ToolName\r
1660 End If\r
1661 mnuPTItem(tNum).Caption = mnuTItem(tNum).Caption\r
1662 End If\r
1663 tNum = tNum + 1\r
1664 Loop Until ToolName = ""\r
1665 End Sub\r
1666 Sub OpenMpq()\r
1667 Dim Path, FileCont As String, bNum As Long, FileLine As String, nFiles As Long, MpqFileName As String, FileFilter As String, TItem As Menu, hMPQ As Long, hFile As Long, FileEntries() As FILELISTENTRY\r
1668 On Error Resume Next\r
1669 If FileExists(CD.FileName) And FileLen(CD.FileName) = 0 Then\r
1670 ReDim FileList(0) As String\r
1671 List.ListItems.Clear\r
1672 ShowSelected\r
1673 ShowTotal\r
1674 NewFile = True\r
1675 On Error GoTo 0\r
1676 GoTo FileOpened\r
1677 End If\r
1678 On Error GoTo 0\r
1679 \r
1680 If IsMPQ(CD.FileName) = False Then\r
1681 ConvertCwad\r
1682 End If\r
1683 \r
1684 If IsMPQ(CD.FileName) = False Then\r
1685 CD.FileName = ""\r
1686 MsgBox "This file does not contain an MPQ archive.", vbExclamation, "WinMPQ"\r
1687 Exit Sub\r
1688 End If\r
1689 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then\r
1690 CD.FileName = ""\r
1691 MsgBox "The MPQ archive could not be opened.", vbExclamation, "WinMPQ"\r
1692 Exit Sub\r
1693 End If\r
1694 StatBar.Style = 1\r
1695 StatBar.SimpleText = "Loading list..."\r
1696 MousePointer = 11\r
1697 Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"\r
1698 ReDim FileList(0) As String\r
1699 #If InternalListing Then\r
1700 FileList(0) = "(listfile)"\r
1701 If Mpq.FileExists(CD.FileName, "(listfile)") Then\r
1702 FileCont = Mpq.GetFileEx(CD.FileName, "(listfile)", 0, -1)\r
1703 #Else\r
1704 sListFiles CD.FileName, hMPQ, ListFile, FileEntries\r
1705 #End If\r
1706 For bNum = 1 To Len(FileCont)\r
1707 If InStr(bNum, FileCont, vbCrLf) > 0 Then\r
1708 ReDim Preserve FileList(UBound(FileList) + 1) As String\r
1709 FileList(UBound(FileList)) = Mid(FileCont, bNum, InStr(bNum, FileCont, vbCrLf) - bNum)\r
1710 bNum = InStr(bNum, FileCont, vbCrLf) + 1\r
1711 Else\r
1712 ReDim Preserve FileList(UBound(FileList) + 1) As String\r
1713 FileList(UBound(FileList)) = Mid(FileCont, bNum)\r
1714 Exit For\r
1715 End If\r
1716 Next bNum\r
1717 #If InternalListing Then\r
1718 End If\r
1719 nFiles = UBound(FileList)\r
1720 ReDim Preserve FileList(UBound(FileList) + UBound(GlobalFileList)) As String\r
1721 For bNum = nFiles + 1 To UBound(FileList)\r
1722 FileList(bNum) = GlobalFileList(bNum - nFiles)\r
1723 Next bNum\r
1724 #End If\r
1725 Dim fNum As Long, lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, L6 As String, fSize As Long, cSize As Long, fFlags As Long\r
1726 SendMessageA List.hWnd, WM_SETREDRAW, 0, ByVal 0&\r
1727 List.ListItems.Clear\r
1728 List.Sorted = False\r
1729 FileFilter = mFilter\r
1730 StatBar.SimpleText = "Building list... 0% complete"\r
1731 mFilter.Clear\r
1732 For fNum = 0 To UBound(FileEntries)\r
1733 #If InternalListing Then\r
1734 If Mpq.FileExists(CD.FileName, FileList(fNum)) Then\r
1735 #End If\r
1736 If FileEntries(fNum).dwFileExists Then\r
1737 MpqFileName = StrConv(FileEntries(fNum).szFileName, vbUnicode)\r
1738 StripNull MpqFileName\r
1739 mFilter.AddItem "*" + GetExtension(MpqFileName)\r
1740 For bNum = 1 To mFilter.ListCount - 1\r
1741 If LCase(mFilter.List(bNum)) = LCase(mFilter.List(bNum - 1)) Then\r
1742 mFilter.RemoveItem bNum\r
1743 Exit For\r
1744 End If\r
1745 Next bNum\r
1746 If MatchesFilter(MpqFileName, FileFilter) Then\r
1747 L1 = MpqFileName\r
1748 fSize = FileEntries(fNum).dwFullSize\r
1749 cSize = FileEntries(fNum).dwCompressedSize\r
1750 If fSize / 1024 > 0 And fSize / 1024 < 1 Then\r
1751 L2 = "<1KB"\r
1752 ElseIf fSize = 0 Then\r
1753 L2 = "0KB"\r
1754 Else\r
1755 L2 = CStr(Int(fSize / 1024)) + "KB"\r
1756 End If\r
1757 If cSize / 1024 > 0 And cSize / 1024 < 1 Then\r
1758 L4 = "<1KB"\r
1759 ElseIf cSize = 0 Then\r
1760 L4 = "0KB"\r
1761 Else\r
1762 L4 = CStr(Int(cSize / 1024)) + "KB"\r
1763 End If\r
1764 If fSize <> 0 Then\r
1765 L3 = CStr(Int((1 - cSize / fSize) * 100)) + "%"\r
1766 Else\r
1767 L3 = "0%"\r
1768 End If\r
1769 fFlags = FileEntries(fNum).dwFlags\r
1770 L6 = CStr(FileEntries(fNum).lcLocale)\r
1771 If (fFlags And &H200) Or (fFlags And &H100) Then L5 = "C" Else L5 = "-"\r
1772 If fFlags And &H10000 Then L5 = L5 + "E" Else L5 = L5 + "-"\r
1773 If fFlags And &H20000 Then L5 = L5 + "X" Else L5 = L5 + "-"\r
1774 lIndex = 0\r
1775 On Error Resume Next\r
1776 lIndex = List.ListItems.Add(, , L1).Index\r
1777 On Error GoTo 0\r
1778 If lIndex = 0 Then\r
1779 lIndex = List.ListItems.Item(L1).Index\r
1780 List.ListItems.Item(L1).ListSubItems.Clear\r
1781 End If\r
1782 List.ListItems.Item(lIndex).Tag = L1\r
1783 List.ListItems.Item(lIndex).ListSubItems.Add(, , L2).Tag = fSize\r
1784 If fSize <> 0 Then\r
1785 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = Int((1 - cSize / fSize) * 100)\r
1786 Else\r
1787 List.ListItems.Item(lIndex).ListSubItems.Add(, , L3).Tag = 0\r
1788 End If\r
1789 List.ListItems.Item(lIndex).ListSubItems.Add(, , L4).Tag = cSize\r
1790 List.ListItems.Item(lIndex).ListSubItems.Add(, , L6).Tag = L6\r
1791 List.ListItems.Item(lIndex).ListSubItems.Add(, , L5).Tag = L5\r
1792 End If\r
1793 End If\r
1794 #If InternalListing Then\r
1795 End If\r
1796 #End If\r
1797 On Error Resume Next\r
1798 StatBar.SimpleText = "Building list... " + CStr(Int((fNum / UBound(FileEntries)) * 100)) + "% complete"\r
1799 On Error GoTo 0\r
1800 Next fNum\r
1801 SFileCloseArchive hMPQ\r
1802 List.Sorted = True\r
1803 '#If InternalListing Then\r
1804 RemoveDuplicates\r
1805 '#End If\r
1806 On Error Resume Next\r
1807 List.SelectedItem.Selected = False\r
1808 On Error GoTo 0\r
1809 SendMessageA List.hWnd, WM_SETREDRAW, 1, ByVal 0&\r
1810 ShowSelected\r
1811 ShowTotal\r
1812 NewFile = False\r
1813 mFilter = FileFilter\r
1814 FileOpened:\r
1815 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
1816 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
1817 mnuMpq.Enabled = True\r
1818 For Each TItem In mnuTItem\r
1819 TItem.Enabled = True\r
1820 Next TItem\r
1821 Toolbar.Buttons.Item("Add").Enabled = True\r
1822 Toolbar.Buttons.Item("Add Folder").Enabled = True\r
1823 Toolbar.Buttons.Item("Extract").Enabled = True\r
1824 Toolbar.Buttons.Item("Compact").Enabled = True\r
1825 Toolbar.Buttons.Item("List").Enabled = True\r
1826 StatBar.Style = 0\r
1827 StatBar.SimpleText = ""\r
1828 If InStr(CD.FileName, "\") > 0 Then\r
1829 For bNum = 1 To Len(CD.FileName)\r
1830 If InStr(bNum, CD.FileName, "\") > 0 Then\r
1831 bNum = InStr(bNum, CD.FileName, "\")\r
1832 Else\r
1833 Exit For\r
1834 End If\r
1835 Next bNum\r
1836 End If\r
1837 Caption = "WinMPQ - " + Mid(CD.FileName, bNum)\r
1838 AddRecentFile CD.FileName\r
1839 MousePointer = 0\r
1840 End Sub\r
1841 \r
1842 Sub RemoveDuplicates()\r
1843 Dim fNum As Long\r
1844 fNum = 1\r
1845 Do While fNum <= List.ListItems.Count - 1\r
1846 If LCase(List.ListItems.Item(fNum).Tag) = LCase(List.ListItems.Item(fNum + 1).Tag) And List.ListItems.Item(fNum).ListSubItems(4).Tag = List.ListItems.Item(fNum + 1).ListSubItems(4).Tag Then\r
1847 List.ListItems.Remove (fNum)\r
1848 fNum = fNum - 1\r
1849 End If\r
1850 fNum = fNum + 1\r
1851 Loop\r
1852 End Sub\r
1853 Sub ShowSelected()\r
1854 Dim fNum As Long, nSelect As Long, sSize As Currency, fSize As Long, L2 As String, hMPQ As Long, hFile As Long\r
1855 On Error GoTo NotSelected\r
1856 List.SelectedItem.Tag = List.SelectedItem.Tag\r
1857 On Error GoTo 0\r
1858 On Error Resume Next\r
1859 For fNum = 1 To List.ListItems.Count\r
1860 If List.ListItems.Item(fNum).Selected Then\r
1861 nSelect = nSelect + 1\r
1862 If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then\r
1863 sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag\r
1864 Else\r
1865 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
1866 If SFileOpenFileEx(hMPQ, List.ListItems.Item(fNum).Tag, 0, hFile) Then\r
1867 fSize = SFileGetFileSize(hFile, 0)\r
1868 SFileCloseFile hFile\r
1869 End If\r
1870 SFileCloseArchive hMPQ\r
1871 End If\r
1872 If fSize / 1024 > 0 And fSize / 1024 < 1 Then\r
1873 L2 = "<1KB"\r
1874 ElseIf fSize = 0 Then\r
1875 L2 = "0KB"\r
1876 Else\r
1877 L2 = CStr(Int(fSize / 1024)) + "KB"\r
1878 End If\r
1879 List.ListItems.Item(fNum).ListSubItems(1).Text = L2\r
1880 List.ListItems.Item(fNum).ListSubItems(1).Tag = fSize\r
1881 sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag\r
1882 End If\r
1883 End If\r
1884 Next fNum\r
1885 If sSize / 1024 > 0 And sSize / 1024 < 1 Then\r
1886 StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, <1KB"\r
1887 ElseIf sSize = 0 Then\r
1888 StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, 0KB"\r
1889 Else\r
1890 StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, " + CStr(Int(sSize / 1024)) + "KB"\r
1891 End If\r
1892 On Error GoTo 0\r
1893 Exit Sub\r
1894 NotSelected:\r
1895 StatBar.Panels.Item(1).Text = "Selected 0 files, 0KB"\r
1896 End Sub\r
1897 Sub ShowTotal()\r
1898 Dim fNum As Long, nFiles As Long, tSize As Currency\r
1899 On Error Resume Next\r
1900 For fNum = 1 To List.ListItems.Count\r
1901 nFiles = nFiles + 1\r
1902 If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then\r
1903 tSize = tSize + List.ListItems.Item(fNum).ListSubItems(1).Tag\r
1904 End If\r
1905 Next fNum\r
1906 If tSize / 1024 > 0 And tSize / 1024 < 1 Then\r
1907 StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, <1KB"\r
1908 Else\r
1909 StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, " + CStr(Int(tSize / 1024)) + "KB"\r
1910 End If\r
1911 On Error GoTo 0\r
1912 End Sub\r
1913 Private Sub cmdGo_Click()\r
1914 StatBar.Style = 1\r
1915 RunMpq2kCommand txtCommand\r
1916 txtCommand = ""\r
1917 If StatBar.SimpleText = "" Then txtCommand_GotFocus\r
1918 End Sub\r
1919 \r
1920 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)\r
1921 If KeyCode = vbKeyShift Then\r
1922 ShiftState = True\r
1923 BuildMpqActionList\r
1924 End If\r
1925 End Sub\r
1926 Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)\r
1927 If KeyCode = vbKeyShift Then\r
1928 ShiftState = False\r
1929 BuildMpqActionList\r
1930 End If\r
1931 End Sub\r
1932 Private Sub Form_Load()\r
1933 Dim FileName As String, bNum As Long, CurPath As String, CurPath2 As String, CurPathType As Integer, sLine As String, Param() As String, pNum As Long, EndParam As Long, ParamCutout As String, OldStartPath As String, NewStartPath As String, ErrorText As String\r
1934 Dim Path\r
1935 Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"\r
1936 NewKey AppKey\r
1937 SetReg AppKey + "InstallPath", GetLongPath(App.Path), REG_SZ\r
1938 SetReg AppKey + "ProgramFilename", GetLongPath(Path + App.EXEName + ".exe"), REG_SZ\r
1939 FixIcon hWnd, 1\r
1940 InitFileDialog CD\r
1941 CD.hwndOwner = hWnd\r
1942 CD.DefaultExt = "mpq"\r
1943 CD.MaxFileSize = 5120\r
1944 InitFolderDialog PathInput\r
1945 PathInput.hwndOwner = hWnd\r
1946 PathInput.Flags = BIF_RETURNONLYFSDIRS\r
1947 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
1948 ChDir App.Path\r
1949 'If Mpq.MpqInitialize = False Then\r
1950 ' ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason: "\r
1951 ' Select Case Mpq.LastError\r
1952 ' Case MPQ_ERROR_NO_STAREDIT\r
1953 ' ErrorText = ErrorText + "Can't find StarEdit.exe"\r
1954 ' Case MPQ_ERROR_BAD_STAREDIT\r
1955 ' ErrorText = ErrorText + "Wrong version of StarEdit.exe. Need SC/BW 1.07"\r
1956 ' Case MPQ_ERROR_STAREDIT_RUNNING\r
1957 ' ErrorText = ErrorText + "StarEdit.exe is running. It must be closed before running this"\r
1958 ' Case Else\r
1959 ' ErrorText = ErrorText + "Unknown"\r
1960 ' End Select\r
1961 ' MsgBox ErrorText\r
1962 ' End\r
1963 'End If\r
1964 ExtractPathNum = -1\r
1965 CopyPathNum = -1\r
1966 OldStartPath = CurDir\r
1967 CurPath = GetReg(AppKey + "StartupPath", CurDir)\r
1968 CurPathType = GetReg(AppKey + "StartupPathType", 0)\r
1969 If CurPathType < 0 Then CurPathType = 0\r
1970 If CurPathType > 2 Then CurPathType = 2\r
1971 If CurPathType = 1 Then\r
1972 CurPath = App.Path\r
1973 End If\r
1974 CurPath2 = CurPath\r
1975 If Right(CurPath2, 1) <> "\" Then CurPath2 = CurPath2 + "\"\r
1976 If IsDir(CurPath2) Then\r
1977 If Mid(CurPath, 2, 1) = ":" Then ChDrive Left(CurPath, 1)\r
1978 ChDir CurPath\r
1979 End If\r
1980 NewStartPath = CurDir\r
1981 On Error Resume Next\r
1982 Height = GetReg(AppKey + "Status\WindowHeight", Height)\r
1983 Left = GetReg(AppKey + "Status\WindowLeft", Left)\r
1984 Top = GetReg(AppKey + "Status\WindowTop", Top)\r
1985 Width = GetReg(AppKey + "Status\WindowWidth", Width)\r
1986 If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0\r
1987 ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")\r
1988 DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)\r
1989 DefaultBlockSize = GetReg(AppKey + "DefaultBlockSize", DEFAULT_BLOCK_SIZE)\r
1990 LocaleID = GetReg(AppKey + "LocaleID", 0)\r
1991 GlobalEncrypt = False\r
1992 DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)\r
1993 Select Case DefaultCompressID\r
1994 Case -3\r
1995 DefaultCompress = MAFA_COMPRESS_DEFLATE\r
1996 Case Else\r
1997 DefaultCompress = MAFA_COMPRESS_STANDARD\r
1998 End Select\r
1999 DefaultCompressLevel = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION)\r
2000 BuildRecentFileList\r
2001 BuildToolsList\r
2002 On Error GoTo 0\r
2003 SFileSetLocale LocaleID\r
2004 ReDim GlobalFileList(0) As String\r
2005 #If InternalListing Then\r
2006 If FileExists(ListFile) Then\r
2007 Open ListFile For Input As #1\r
2008 Do While Not EOF(1)\r
2009 ReDim Preserve GlobalFileList(UBound(GlobalFileList) + 1) As String\r
2010 Line Input #1, GlobalFileList(UBound(GlobalFileList))\r
2011 Loop\r
2012 Close #1\r
2013 End If\r
2014 #End If\r
2015 FileName = Trim(Command)\r
2016 If Left(FileName, 1) = Chr(34) Then FileName = Mid(FileName, 2)\r
2017 If Right(FileName, 1) = Chr(34) Then FileName = Left(FileName, Len(FileName) - 1)\r
2018 FileName = Trim(FileName)\r
2019 If FileExists(FileName) Then\r
2020 CD.FileName = FileName\r
2021 Show\r
2022 OpenMpq\r
2023 Exit Sub\r
2024 End If\r
2025 ReDim FileList(0) As String\r
2026 If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"\r
2027 sLine = Command\r
2028 If Right(sLine, 1) <> " " Then sLine = sLine + " "\r
2029 If sLine <> "" Then\r
2030 ReDim Param(0) As String\r
2031 For pNum = 1 To Len(sLine)\r
2032 If Mid(sLine, pNum, 1) = Chr(34) Then\r
2033 pNum = pNum + 1\r
2034 EndParam = InStr(pNum, sLine, Chr(34))\r
2035 If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum - 1, (EndParam + 1) - (pNum - 1))\r
2036 Else\r
2037 EndParam = InStr(pNum, sLine, " ")\r
2038 If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum, EndParam - pNum)\r
2039 End If\r
2040 If EndParam = 0 Then EndParam = Len(sLine) + 1\r
2041 If pNum <> EndParam Then\r
2042 If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then\r
2043 ReDim Preserve Param(UBound(Param) + 1) As String\r
2044 Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))\r
2045 End If\r
2046 End If\r
2047 pNum = EndParam\r
2048 Next pNum\r
2049 If UBound(Param) < 3 Then ReDim Preserve Param(3) As String\r
2050 Select Case LCase(Param(1))\r
2051 Case "o", "open", "n", "new"\r
2052 Show\r
2053 If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)\r
2054 ChDir OldStartPath\r
2055 RunMpq2kCommand sLine\r
2056 Case "a", "add", "e", "extract", "r", "ren", "rename", "m", "move", "d", "del", "delete", "f", "flush", "compact", "l", "list"\r
2057 If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)\r
2058 ChDir OldStartPath\r
2059 CD.FileName = FullPath(CurDir, Param(2))\r
2060 sLine = Left(sLine, InStr(sLine, ParamCutout) - 1) + Mid(sLine, InStr(sLine, ParamCutout) + Len(ParamCutout))\r
2061 RunMpq2kCommand sLine\r
2062 If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)\r
2063 ChDir NewStartPath\r
2064 Unload Me\r
2065 Case "s", "script"\r
2066 Show\r
2067 If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)\r
2068 ChDir OldStartPath\r
2069 RunMpq2kCommand sLine\r
2070 If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)\r
2071 ChDir NewStartPath\r
2072 End Select\r
2073 End If\r
2074 End Sub\r
2075 Private Sub Form_Resize()\r
2076 On Error Resume Next\r
2077 If WindowState <> 1 Then\r
2078 List.Top = Toolbar.Height\r
2079 List.Width = ScaleWidth\r
2080 List.Height = ScaleHeight - List.Top - StatBar.Height - txtCommand.Height\r
2081 Label1.Top = List.Top + List.Height + (txtCommand.Height - Label1.Height) / 2\r
2082 txtCommand.Top = List.Top + List.Height\r
2083 txtCommand.Left = Label1.Width\r
2084 txtCommand.Width = ScaleWidth - cmdGo.Width - Label1.Width\r
2085 cmdGo.Top = txtCommand.Top\r
2086 cmdGo.Left = txtCommand.Left + txtCommand.Width\r
2087 mFilter.Left = Toolbar.Buttons.Item("filterspace").Left\r
2088 mFilter.Width = ScaleWidth - mFilter.Left - Toolbar.Buttons.Item("List").Width\r
2089 Toolbar.Buttons.Item("filterspace").Width = mFilter.Width\r
2090 End If\r
2091 End Sub\r
2092 Private Sub Form_Unload(Cancel As Integer)\r
2093 Dim Path As String\r
2094 Path = App.Path\r
2095 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
2096 On Error Resume Next\r
2097 If ExtractPathNum > -1 Then\r
2098 KillEx Path + "Temp_extract\" + CStr(ExtractPathNum) + "\", "*", 6, True\r
2099 RmDir Path + "Temp_extract\" + CStr(ExtractPathNum) + "\"\r
2100 End If\r
2101 If DirEx(Path + "Temp_extract\", "*", 6, True) = "" Or App.PrevInstance = False Then\r
2102 KillEx Path + "Temp_extract\", "*", 6, True\r
2103 RmDir Path + "Temp_extract\"\r
2104 End If\r
2105 If CopyPathNum > -1 Then\r
2106 KillEx Path + "Temp_copy\" + CStr(CopyPathNum) + "\", "*", 6, True\r
2107 RmDir Path + "Temp_copy\" + CStr(CopyPathNum) + "\"\r
2108 End If\r
2109 If DirEx(Path + "Temp_copy\", "*", 6, True) = "" Or App.PrevInstance = False Then\r
2110 KillEx Path + "Temp_copy\", "*", 6, True\r
2111 RmDir Path + "Temp_copy\"\r
2112 End If\r
2113 If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then\r
2114 NewKey AppKey\r
2115 NewKey AppKey + "Status\"\r
2116 If WindowState = 1 Then WindowState = 0\r
2117 SetReg AppKey + "Status\WindowState", WindowState, REG_DWORD\r
2118 WindowState = 0\r
2119 SetReg AppKey + "Status\WindowHeight", Height, REG_DWORD\r
2120 SetReg AppKey + "Status\WindowLeft", Left, REG_DWORD\r
2121 SetReg AppKey + "Status\WindowTop", Top, REG_DWORD\r
2122 SetReg AppKey + "Status\WindowWidth", Width, REG_DWORD\r
2123 End If\r
2124 If GetReg(AppKey + "StartupPathType", 0) <= 0 Then\r
2125 SetReg AppKey + "StartupPath", CurDir\r
2126 End If\r
2127 End\r
2128 End Sub\r
2129 Private Sub Label1_Click()\r
2130 txtCommand.SetFocus\r
2131 End Sub\r
2132 Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)\r
2133 Dim result As Long, hMPQ As Long, hFile As Long\r
2134 If List.SelectedItem.Text <> NewString Then\r
2135 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
2136 result = vbYes\r
2137 Else\r
2138 result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")\r
2139 End If\r
2140 If result = vbYes Then\r
2141 List.SelectedItem.Tag = NewString\r
2142 hMPQ = mOpenMpq(CD.FileName)\r
2143 If hMPQ Then\r
2144 If SFileOpenFileEx(hMPQ, NewString, 0, hFile) Then\r
2145 SFileCloseFile hFile\r
2146 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag\r
2147 MpqDeleteFile hMPQ, NewString\r
2148 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString\r
2149 SFileSetLocale LocaleID\r
2150 RemoveDuplicates\r
2151 Else\r
2152 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag\r
2153 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString\r
2154 SFileSetLocale LocaleID\r
2155 End If\r
2156 MpqCloseUpdatedArchive hMPQ, 0\r
2157 On Error Resume Next\r
2158 List.SelectedItem.Key = NewString\r
2159 On Error GoTo 0\r
2160 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2161 End If\r
2162 Else\r
2163 Cancel = True\r
2164 End If\r
2165 End If\r
2166 ShowSelected\r
2167 End Sub\r
2168 Private Sub List_Click()\r
2169 On Error GoTo NotSelected\r
2170 List.SelectedItem.Tag = List.SelectedItem.Tag\r
2171 On Error GoTo NotClick\r
2172 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag\r
2173 On Error GoTo 0\r
2174 ShowSelected\r
2175 Exit Sub\r
2176 NotClick:\r
2177 List.SelectedItem.Selected = False\r
2178 NotSelected:\r
2179 ShowSelected\r
2180 BuildMpqActionList\r
2181 End Sub\r
2182 Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)\r
2183 If List.SortKey = ColumnHeader.Index - 1 Then\r
2184 If List.SortOrder = 0 Then\r
2185 List.SortOrder = 1\r
2186 Else\r
2187 List.SortOrder = 0\r
2188 End If\r
2189 Else\r
2190 List.SortOrder = 0\r
2191 List.SortKey = ColumnHeader.Index - 1\r
2192 End If\r
2193 End Sub\r
2194 Private Sub List_DblClick()\r
2195 Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long\r
2196 On Error GoTo NotSelected\r
2197 List.SelectedItem.Tag = List.SelectedItem.Tag\r
2198 On Error GoTo NotClick\r
2199 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag\r
2200 On Error GoTo 0\r
2201 Path = App.Path\r
2202 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
2203 Path = Path + "Temp_extract\"\r
2204 If ExtractPathNum = -1 Then\r
2205 fNum = 0\r
2206 Do\r
2207 If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do\r
2208 fNum = fNum + 1\r
2209 Loop\r
2210 ExtractPathNum = fNum\r
2211 End If\r
2212 Path = Path + CStr(ExtractPathNum) + "\"\r
2213 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
2214 For fNum = 1 To List.ListItems.Count\r
2215 If List.ListItems.Item(fNum).Selected Then\r
2216 StatBar.Style = 1\r
2217 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
2218 MousePointer = 11\r
2219 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
2220 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
2221 SFileSetLocale LocaleID\r
2222 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then\r
2223 For bNum = 1 To UBound(OpenFiles)\r
2224 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then\r
2225 AlreadyInList = True\r
2226 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
2227 Exit For\r
2228 End If\r
2229 Next bNum\r
2230 If AlreadyInList = False Then\r
2231 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date\r
2232 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag\r
2233 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
2234 End If\r
2235 End If\r
2236 StatBar.Style = 1\r
2237 StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."\r
2238 fName = List.ListItems.Item(fNum).Tag\r
2239 BuildPopup Path + fName, 0, mnuPopup, mnuPItem\r
2240 ExecuteFile Path + fName, 0, mnuPopup, mnuPItem\r
2241 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True\r
2242 End If\r
2243 Next fNum\r
2244 SFileCloseArchive hMPQ\r
2245 StatBar.Style = 0\r
2246 StatBar.SimpleText = ""\r
2247 MousePointer = 0\r
2248 Exit Sub\r
2249 NotClick:\r
2250 List.SelectedItem.Selected = False\r
2251 NotSelected:\r
2252 End Sub\r
2253 Private Sub List_ItemClick(ByVal Item As ListItem)\r
2254 BuildMpqActionList\r
2255 End Sub\r
2256 Private Sub List_KeyPress(KeyAscii As Integer)\r
2257 If KeyAscii = 13 Then List_DblClick\r
2258 End Sub\r
2259 Private Sub List_KeyUp(KeyCode As Integer, Shift As Integer)\r
2260 Dim fNum As Long, fSelect As Long\r
2261 If KeyCode = vbKeyDelete Then\r
2262 mnuMDelete_Click\r
2263 ElseIf (Shift And vbCtrlMask) And KeyCode = vbKeyA Then\r
2264 fSelect = List.SelectedItem.Index\r
2265 For fNum = 1 To List.ListItems.Count\r
2266 List.ListItems.Item(fNum).Selected = True\r
2267 Next fNum\r
2268 List.ListItems.Item(fSelect).Selected = True\r
2269 ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then\r
2270 On Error GoTo NotSelected\r
2271 List.SelectedItem.Tag = List.SelectedItem.Tag\r
2272 On Error GoTo 0\r
2273 If List.SelectedItem.Selected = True Then\r
2274 BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem\r
2275 PopupMenu mnuPopup, vbPopupMenuRightButton, List.Left + List.SelectedItem.Left + 12 * Screen.TwipsPerPixelX, List.Top + List.SelectedItem.Top + 16 * Screen.TwipsPerPixelY, mnuPItem(0)\r
2276 End If\r
2277 End If\r
2278 NotSelected:\r
2279 End Sub\r
2280 Private Sub List_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)\r
2281 CX = X\r
2282 CY = Y\r
2283 If Button And vbRightButton Then\r
2284 On Error GoTo NotSelected\r
2285 List.SelectedItem.Tag = List.SelectedItem.Tag\r
2286 On Error GoTo NotClick\r
2287 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag\r
2288 On Error GoTo 0\r
2289 BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem\r
2290 PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)\r
2291 End If\r
2292 NotClick:\r
2293 NotSelected:\r
2294 End Sub\r
2295 Private Sub List_OLECompleteDrag(Effect As Long)\r
2296 List.Tag = ""\r
2297 End Sub\r
2298 Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)\r
2299 Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, Path2 As String, cNum As Long, FileFilter As String\r
2300 Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, dwFlags As Long\r
2301 If Data.GetFormat(ccCFFiles) <> True Then Exit Sub\r
2302 For fNum = 1 To Data.Files.Count\r
2303 Path = Data.Files.Item(fNum)\r
2304 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
2305 If IsDir(Path) Then\r
2306 Path = Path + "*"\r
2307 Data.Files.Remove fNum\r
2308 Data.Files.Add Path, fNum\r
2309 End If\r
2310 Next fNum\r
2311 Path = Data.Files.Item(1)\r
2312 For bNum = 1 To Len(Path)\r
2313 If InStr(bNum, Path, "\") > 0 Then\r
2314 For fNum = 1 To Data.Files.Count\r
2315 If Left(Data.Files.Item(fNum), InStr(bNum, Path, "\")) <> Left(Path, InStr(bNum, Path, "\")) Then GoTo PathFound\r
2316 Next fNum\r
2317 bNum = InStr(bNum, Path, "\")\r
2318 Else\r
2319 Exit For\r
2320 End If\r
2321 Next bNum\r
2322 PathFound:\r
2323 Path = Left(Path, bNum - 1)\r
2324 ReDim Files(0) As String\r
2325 Files(0) = Path\r
2326 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
2327 ReDim Preserve Files(Data.Files.Count) As String\r
2328 For bNum = 1 To Data.Files.Count\r
2329 Files(bNum) = Mid(Data.Files.Item(bNum), 1 + Len(Path))\r
2330 For fNum = 1 To Len(Files(bNum))\r
2331 If InStr(fNum, Files(bNum), "\") > 0 Then\r
2332 fNum = InStr(fNum, Files(bNum), "\")\r
2333 Else\r
2334 Exit For\r
2335 End If\r
2336 Next fNum\r
2337 FolderFiles = FolderFiles + DirEx(Path + Left(Files(bNum), fNum - 1), Mid(Files(bNum), fNum), 6, True)\r
2338 Next bNum\r
2339 If FolderFiles = "" Then Exit Sub\r
2340 ReDim Preserve Files(0) As String\r
2341 For bNum = 1 To Len(FolderFiles)\r
2342 ReDim Preserve Files(UBound(Files) + 1) As String\r
2343 If InStr(bNum, FolderFiles, vbCrLf) > 0 Then\r
2344 Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))\r
2345 bNum = InStr(bNum, FolderFiles, vbCrLf) + 1\r
2346 Else\r
2347 Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))\r
2348 Exit For\r
2349 End If\r
2350 Next bNum\r
2351 FoldName.Show 1\r
2352 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel\r
2353 If UBound(Files) > 1 Then\r
2354 ReDim ShortFiles(UBound(Files)) As String\r
2355 For bNum = 0 To UBound(Files)\r
2356 ShortFiles(bNum) = AddFolderName + Files(bNum)\r
2357 Next bNum\r
2358 If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"\r
2359 For bNum = 1 To UBound(Files)\r
2360 Files(bNum) = FullPath(Files(0), Files(bNum))\r
2361 Next bNum\r
2362 Else\r
2363 For bNum = 1 To Len(Files(1))\r
2364 If InStr(bNum, Files(1), "\") > 0 Then\r
2365 bNum = InStr(bNum, Files(1), "\")\r
2366 Else\r
2367 Exit For\r
2368 End If\r
2369 Next bNum\r
2370 ReDim ShortFiles(UBound(Files)) As String\r
2371 ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)\r
2372 Files(1) = FullPath(Files(0), Files(1))\r
2373 End If\r
2374 If NewFile = True Then\r
2375 If FileExists(CD.FileName) Then Kill CD.FileName\r
2376 NewFile = False\r
2377 End If\r
2378 List.Sorted = False\r
2379 FileFilter = mFilter\r
2380 hMPQ = mOpenMpq(CD.FileName)\r
2381 If hMPQ = 0 Then\r
2382 StatBar.SimpleText = "Can't create archive " + CD.FileName\r
2383 Exit Sub\r
2384 End If\r
2385 dwFlags = MAFA_REPLACE_EXISTING\r
2386 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
2387 For bNum = 1 To UBound(Files)\r
2388 StatBar.Style = 1\r
2389 StatBar.SimpleText = "Adding " + Files(bNum) + "..."\r
2390 MousePointer = 11\r
2391 If mnuMCNone.Checked Then\r
2392 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0\r
2393 ElseIf mnuMCStandard.Checked Then\r
2394 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
2395 ElseIf mnuMCDeflate.Checked Then\r
2396 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
2397 ElseIf mnuMCBzip2.Checked Then\r
2398 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
2399 ElseIf mnuMCAMedium.Checked Then\r
2400 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0\r
2401 ElseIf mnuMCAHighest.Checked Then\r
2402 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1\r
2403 ElseIf mnuMCALowest.Checked Then\r
2404 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2\r
2405 ElseIf mnuMCAuto.Checked Then\r
2406 mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)\r
2407 End If\r
2408 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2409 mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))\r
2410 For cNum = 1 To mFilter.ListCount - 1\r
2411 If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
2412 mFilter.RemoveItem cNum\r
2413 Exit For\r
2414 End If\r
2415 Next cNum\r
2416 Next bNum\r
2417 MpqCloseUpdatedArchive hMPQ, 0\r
2418 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2419 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
2420 StatBar.SimpleText = "Adding files to listing... 0% complete"\r
2421 For bNum = 1 To UBound(Files)\r
2422 If MatchesFilter(ShortFiles(bNum), FileFilter) Then\r
2423 MpqAddToListing hMPQ, ShortFiles(bNum)\r
2424 End If\r
2425 On Error Resume Next\r
2426 StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"\r
2427 On Error GoTo 0\r
2428 Next bNum\r
2429 SFileCloseArchive hMPQ\r
2430 End If\r
2431 StatBar.Style = 0\r
2432 StatBar.SimpleText = ""\r
2433 MousePointer = 0\r
2434 If MatchesFilter("(listfile)", FileFilter) Then\r
2435 AddToListing "(listfile)"\r
2436 End If\r
2437 mFilter = FileFilter\r
2438 List.Sorted = True\r
2439 RemoveDuplicates\r
2440 ShowTotal\r
2441 Cancel:\r
2442 End Sub\r
2443 Private Sub List_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)\r
2444 If CD.FileName = "" Or Data.GetFormat(ccCFFiles) <> True Or List.Tag = "WinMPQ" Then\r
2445 Effect = ccOLEDropEffectNone\r
2446 Else\r
2447 Effect = ccOLEDropEffectCopy\r
2448 End If\r
2449 End Sub\r
2450 Private Sub List_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)\r
2451 Dim fNum As Long, Path As String, fCount As Long, FirstFile As String, hMPQ As Long\r
2452 Path = App.Path\r
2453 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
2454 Path = Path + "Temp_copy\"\r
2455 If CopyPathNum = -1 Then\r
2456 fNum = 0\r
2457 Do\r
2458 If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do\r
2459 fNum = fNum + 1\r
2460 Loop\r
2461 CopyPathNum = fNum\r
2462 End If\r
2463 Path = Path + CStr(CopyPathNum) + "\"\r
2464 KillEx Path, "*", 6, True\r
2465 fCount = 0\r
2466 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
2467 For fNum = 1 To List.ListItems.Count\r
2468 If List.ListItems.Item(fNum).Selected Then\r
2469 StatBar.Style = 1\r
2470 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
2471 MousePointer = 11\r
2472 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
2473 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
2474 SFileSetLocale LocaleID\r
2475 If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then\r
2476 Data.Files.Add Path + List.ListItems.Item(fNum).Tag\r
2477 End If\r
2478 fCount = fCount + 1\r
2479 If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag\r
2480 End If\r
2481 Next fNum\r
2482 SFileCloseArchive hMPQ\r
2483 StatBar.Style = 0\r
2484 StatBar.SimpleText = ""\r
2485 MousePointer = 0\r
2486 If GetReg(AppKey + "UseDragDropWildcards", 1) <> 0 And fCount > 1 Then\r
2487 Data.Files.Add Path + "*"\r
2488 ElseIf fCount = 1 Then\r
2489 Data.Files.Add FirstFile\r
2490 End If\r
2491 End Sub\r
2492 Private Sub List_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)\r
2493 Data.SetData , ccCFFiles\r
2494 AllowedEffects = ccOLEDropEffectCopy\r
2495 List.Tag = "WinMPQ"\r
2496 End Sub\r
2497 Private Sub mFilter_KeyPress(KeyAscii As Integer)\r
2498 If KeyAscii = 13 And Toolbar.Buttons.Item("List").Enabled Then\r
2499 If NewFile = False Then OpenMpq\r
2500 End If\r
2501 End Sub\r
2502 Private Sub mnuFExit_Click()\r
2503 Unload Me\r
2504 End Sub\r
2505 Private Sub mnuFile_Click()\r
2506 If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False\r
2507 End Sub\r
2508 Private Sub mnuFRecent_Click(Index As Integer)\r
2509 Dim OldFileName As String\r
2510 OldFileName = CD.FileName\r
2511 CD.FileName = mnuFRecent(Index).Tag\r
2512 If FileExists(CD.FileName) = False Then\r
2513 CD.FileName = OldFileName\r
2514 MsgBox "The file " + Chr(34) + mnuFRecent(Index).Tag + Chr(34) + " does not exist.", vbExclamation, "WinMPQ"\r
2515 DelRecentFile mnuFRecent(Index).Tag\r
2516 Exit Sub\r
2517 End If\r
2518 OpenMpq\r
2519 If CD.FileName = "" Then\r
2520 CD.FileName = OldFileName\r
2521 DelRecentFile mnuFRecent(Index).Tag\r
2522 End If\r
2523 End Sub\r
2524 Private Sub mnuFReopen_Click()\r
2525 OpenMpq\r
2526 End Sub\r
2527 \r
2528 Private Sub mnuFScript_Click()\r
2529 Dim OldFileName As String, OldPath As String\r
2530 CD.Flags = &H1000 Or &H4 Or &H2\r
2531 CD.Filter = "All Files (*.*)|*.*"\r
2532 OldFileName = CD.FileName\r
2533 OldPath = CurDir\r
2534 CD.hwndOwner = hWnd\r
2535 If ShowOpen(CD) = False Then GoTo Cancel\r
2536 StatBar.Style = 1\r
2537 StatBar.SimpleText = "Running script " + CD.FileName + "..."\r
2538 MousePointer = 11\r
2539 RunScript CD.FileName\r
2540 StatBar.Style = 0\r
2541 StatBar.SimpleText = ""\r
2542 MousePointer = 0\r
2543 CD.FileName = OldFileName\r
2544 Cancel:\r
2545 If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)\r
2546 ChDir OldPath\r
2547 End Sub\r
2548 Private Sub mnuHAbout_Click()\r
2549 About.Show 1\r
2550 End Sub\r
2551 Private Sub mnuHReadme_Click()\r
2552 Dim Path As String\r
2553 Path = App.Path\r
2554 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
2555 If FileExists(Path + "WinMPQ.rtf") Then\r
2556 ShellExecute hWnd, vbNullString, Path + "WinMPQ.rtf", vbNullString, vbNullString, 1\r
2557 Else\r
2558 MsgBox "Could not find WinMPQ.rtf!", vbCritical, "WinMPQ"\r
2559 End If\r
2560 End Sub\r
2561 Private Sub mnuMAdd_Click()\r
2562 Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String\r
2563 Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, hMPQ As Long, dwFlags As Long\r
2564 CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2\r
2565 CD.Filter = "All Files (*.*)|*.*"\r
2566 OldFileName = CD.FileName\r
2567 CD.hwndOwner = hWnd\r
2568 If ShowOpen(CD) = False Then GoTo Cancel\r
2569 ReDim Files(0) As String\r
2570 bNum = 1\r
2571 If InStr(1, CD.FileName, Chr(0)) > 0 Then\r
2572 Files(0) = Mid(CD.FileName, 1, InStr(1, CD.FileName, Chr(0)) - 1)\r
2573 bNum = InStr(1, CD.FileName, Chr(0)) + 1\r
2574 Else\r
2575 Files(0) = Mid(CD.FileName, 1)\r
2576 End If\r
2577 For bNum = bNum To Len(CD.FileName)\r
2578 ReDim Preserve Files(UBound(Files) + 1) As String\r
2579 If InStr(bNum, CD.FileName, Chr(0)) > 0 Then\r
2580 Files(UBound(Files)) = Mid(CD.FileName, bNum, InStr(bNum, CD.FileName, Chr(0)) - bNum)\r
2581 bNum = InStr(bNum, CD.FileName, Chr(0))\r
2582 Else\r
2583 Files(UBound(Files)) = Mid(CD.FileName, bNum)\r
2584 Exit For\r
2585 End If\r
2586 Next bNum\r
2587 CD.FileName = OldFileName\r
2588 FoldName.Show 1\r
2589 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel\r
2590 If UBound(Files) > 1 Then\r
2591 ReDim ShortFiles(UBound(Files)) As String\r
2592 For bNum = 0 To UBound(Files)\r
2593 ShortFiles(bNum) = AddFolderName + Files(bNum)\r
2594 Next bNum\r
2595 If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"\r
2596 For bNum = 1 To UBound(Files)\r
2597 Files(bNum) = FullPath(Files(0), Files(bNum))\r
2598 Next bNum\r
2599 Else\r
2600 For bNum = 1 To Len(Files(1))\r
2601 If InStr(bNum, Files(1), "\") > 0 Then\r
2602 bNum = InStr(bNum, Files(1), "\")\r
2603 Else\r
2604 Exit For\r
2605 End If\r
2606 Next bNum\r
2607 ReDim ShortFiles(UBound(Files)) As String\r
2608 ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)\r
2609 Files(1) = FullPath(Files(0), Files(1))\r
2610 End If\r
2611 If NewFile = True Then\r
2612 If FileExists(CD.FileName) Then Kill CD.FileName\r
2613 NewFile = False\r
2614 End If\r
2615 List.Sorted = False\r
2616 FileFilter = mFilter\r
2617 hMPQ = mOpenMpq(CD.FileName)\r
2618 If hMPQ = 0 Then\r
2619 StatBar.SimpleText = "Can't create archive " + CD.FileName\r
2620 Exit Sub\r
2621 End If\r
2622 dwFlags = MAFA_REPLACE_EXISTING\r
2623 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
2624 For bNum = 1 To UBound(Files)\r
2625 StatBar.Style = 1\r
2626 StatBar.SimpleText = "Adding " + Files(bNum) + "..."\r
2627 MousePointer = 11\r
2628 If mnuMCNone.Checked Then\r
2629 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0\r
2630 ElseIf mnuMCStandard.Checked Then\r
2631 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
2632 ElseIf mnuMCDeflate.Checked Then\r
2633 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
2634 ElseIf mnuMCBzip2.Checked Then\r
2635 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
2636 ElseIf mnuMCAMedium.Checked Then\r
2637 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0\r
2638 ElseIf mnuMCAHighest.Checked Then\r
2639 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1\r
2640 ElseIf mnuMCALowest.Checked Then\r
2641 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2\r
2642 ElseIf mnuMCAuto.Checked Then\r
2643 mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)\r
2644 End If\r
2645 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2646 mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))\r
2647 For cNum = 1 To mFilter.ListCount - 1\r
2648 If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
2649 mFilter.RemoveItem cNum\r
2650 Exit For\r
2651 End If\r
2652 Next cNum\r
2653 Next bNum\r
2654 MpqCloseUpdatedArchive hMPQ, 0\r
2655 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2656 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
2657 StatBar.SimpleText = "Adding files to listing... 0% complete"\r
2658 For bNum = 1 To UBound(Files)\r
2659 If MatchesFilter(ShortFiles(bNum), FileFilter) Then\r
2660 MpqAddToListing hMPQ, ShortFiles(bNum)\r
2661 End If\r
2662 On Error Resume Next\r
2663 StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"\r
2664 On Error GoTo 0\r
2665 Next bNum\r
2666 SFileCloseArchive hMPQ\r
2667 End If\r
2668 StatBar.Style = 0\r
2669 StatBar.SimpleText = ""\r
2670 MousePointer = 0\r
2671 If MatchesFilter("(listfile)", FileFilter) Then\r
2672 AddToListing "(listfile)"\r
2673 End If\r
2674 mFilter = FileFilter\r
2675 List.Sorted = True\r
2676 RemoveDuplicates\r
2677 ShowTotal\r
2678 Cancel:\r
2679 End Sub\r
2680 Private Sub mnuMAddFolder_Click()\r
2681 Dim Files() As String, ShortFiles() As String, bNum As Long, fNum As Long, Path As String, FolderFiles As String, cNum As Long, FileFilter As String, hMPQ As Long\r
2682 Dim lIndex As Long, L1 As String, L2 As String, L3 As String, L4 As String, L5 As String, fSize As Long, cSize As Long, fFlags As Long, dwFlags As Long\r
2683 PathInput.hwndOwner = hWnd\r
2684 Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)\r
2685 If Path = "" Then GoTo Cancel\r
2686 FolderFiles = DirEx(Path, "*", 6, True)\r
2687 If FolderFiles = "" Then Exit Sub\r
2688 ReDim Files(0) As String\r
2689 Files(0) = Path\r
2690 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
2691 For bNum = 1 To Len(FolderFiles)\r
2692 ReDim Preserve Files(UBound(Files) + 1) As String\r
2693 If InStr(bNum, FolderFiles, vbCrLf) > 0 Then\r
2694 Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))\r
2695 bNum = InStr(bNum, FolderFiles, vbCrLf) + 1\r
2696 Else\r
2697 Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))\r
2698 Exit For\r
2699 End If\r
2700 Next bNum\r
2701 FoldName.Show 1\r
2702 If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel\r
2703 If UBound(Files) > 1 Then\r
2704 ReDim ShortFiles(UBound(Files)) As String\r
2705 For bNum = 0 To UBound(Files)\r
2706 ShortFiles(bNum) = AddFolderName + Files(bNum)\r
2707 Next bNum\r
2708 If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"\r
2709 For bNum = 1 To UBound(Files)\r
2710 Files(bNum) = FullPath(Files(0), Files(bNum))\r
2711 Next bNum\r
2712 Else\r
2713 For bNum = 1 To Len(Files(1))\r
2714 If InStr(bNum, Files(1), "\") > 0 Then\r
2715 bNum = InStr(bNum, Files(1), "\")\r
2716 Else\r
2717 Exit For\r
2718 End If\r
2719 Next bNum\r
2720 ReDim ShortFiles(UBound(Files)) As String\r
2721 ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)\r
2722 Files(1) = FullPath(Files(0), Files(1))\r
2723 End If\r
2724 If NewFile = True Then\r
2725 If FileExists(CD.FileName) Then Kill CD.FileName\r
2726 NewFile = False\r
2727 End If\r
2728 List.Sorted = False\r
2729 FileFilter = mFilter\r
2730 hMPQ = mOpenMpq(CD.FileName)\r
2731 If hMPQ = 0 Then\r
2732 StatBar.SimpleText = "Can't create archive " + CD.FileName\r
2733 Exit Sub\r
2734 End If\r
2735 dwFlags = MAFA_REPLACE_EXISTING\r
2736 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
2737 For bNum = 1 To UBound(Files)\r
2738 StatBar.Style = 1\r
2739 StatBar.SimpleText = "Adding " + Files(bNum) + "..."\r
2740 MousePointer = 11\r
2741 If mnuMCNone.Checked Then\r
2742 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0\r
2743 ElseIf mnuMCStandard.Checked Then\r
2744 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
2745 ElseIf mnuMCDeflate.Checked Then\r
2746 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
2747 ElseIf mnuMCBzip2.Checked Then\r
2748 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
2749 ElseIf mnuMCAMedium.Checked Then\r
2750 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0\r
2751 ElseIf mnuMCAHighest.Checked Then\r
2752 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1\r
2753 ElseIf mnuMCALowest.Checked Then\r
2754 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2\r
2755 ElseIf mnuMCAuto.Checked Then\r
2756 mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)\r
2757 End If\r
2758 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2759 mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))\r
2760 For cNum = 1 To mFilter.ListCount - 1\r
2761 If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then\r
2762 mFilter.RemoveItem cNum\r
2763 Exit For\r
2764 End If\r
2765 Next cNum\r
2766 Next bNum\r
2767 MpqCloseUpdatedArchive hMPQ, 0\r
2768 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2769 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then\r
2770 StatBar.SimpleText = "Adding files to listing... 0% complete"\r
2771 For bNum = 1 To UBound(Files)\r
2772 If MatchesFilter(ShortFiles(bNum), FileFilter) Then\r
2773 MpqAddToListing hMPQ, ShortFiles(bNum)\r
2774 End If\r
2775 On Error Resume Next\r
2776 StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"\r
2777 On Error GoTo 0\r
2778 Next bNum\r
2779 SFileCloseArchive hMPQ\r
2780 End If\r
2781 StatBar.Style = 0\r
2782 StatBar.SimpleText = ""\r
2783 MousePointer = 0\r
2784 If MatchesFilter("(listfile)", FileFilter) Then\r
2785 AddToListing "(listfile)"\r
2786 End If\r
2787 mFilter = FileFilter\r
2788 List.Sorted = True\r
2789 RemoveDuplicates\r
2790 ShowTotal\r
2791 Cancel:\r
2792 End Sub\r
2793 \r
2794 Private Sub mnuMAddToList_Click()\r
2795 frmAddToList.Show 1\r
2796 End Sub\r
2797 Private Sub mnuMCAHighest_Click()\r
2798 mnuMCNone.Checked = False\r
2799 mnuMCStandard.Checked = False\r
2800 mnuMCDeflate.Checked = False\r
2801 mnuMCBzip2.Checked = False\r
2802 mnuMCALowest.Checked = False\r
2803 mnuMCAMedium.Checked = False\r
2804 mnuMCAHighest.Checked = True\r
2805 mnuMCAuto.Checked = False\r
2806 End Sub\r
2807 Private Sub mnuMCALowest_Click()\r
2808 mnuMCNone.Checked = False\r
2809 mnuMCStandard.Checked = False\r
2810 mnuMCDeflate.Checked = False\r
2811 mnuMCBzip2.Checked = False\r
2812 mnuMCALowest.Checked = True\r
2813 mnuMCAMedium.Checked = False\r
2814 mnuMCAHighest.Checked = False\r
2815 mnuMCAuto.Checked = False\r
2816 End Sub\r
2817 \r
2818 \r
2819 Private Sub mnuMCAMedium_Click()\r
2820 mnuMCNone.Checked = False\r
2821 mnuMCStandard.Checked = False\r
2822 mnuMCDeflate.Checked = False\r
2823 mnuMCBzip2.Checked = False\r
2824 mnuMCALowest.Checked = False\r
2825 mnuMCAMedium.Checked = True\r
2826 mnuMCAHighest.Checked = False\r
2827 mnuMCAuto.Checked = False\r
2828 End Sub\r
2829 Private Sub mnuMCAuto_Click()\r
2830 mnuMCNone.Checked = False\r
2831 mnuMCStandard.Checked = False\r
2832 mnuMCDeflate.Checked = False\r
2833 mnuMCBzip2.Checked = False\r
2834 mnuMCALowest.Checked = False\r
2835 mnuMCAMedium.Checked = False\r
2836 mnuMCAHighest.Checked = False\r
2837 mnuMCAuto.Checked = True\r
2838 End Sub\r
2839 \r
2840 Private Sub mnuMCBzip2_Click()\r
2841 mnuMCNone.Checked = False\r
2842 mnuMCStandard.Checked = False\r
2843 mnuMCDeflate.Checked = False\r
2844 mnuMCBzip2.Checked = True\r
2845 mnuMCALowest.Checked = False\r
2846 mnuMCAMedium.Checked = False\r
2847 mnuMCAHighest.Checked = False\r
2848 mnuMCAuto.Checked = False\r
2849 End Sub\r
2850 \r
2851 Private Sub mnuMCDeflate_Click()\r
2852 mnuMCNone.Checked = False\r
2853 mnuMCStandard.Checked = False\r
2854 mnuMCDeflate.Checked = True\r
2855 mnuMCBzip2.Checked = False\r
2856 mnuMCALowest.Checked = False\r
2857 mnuMCAMedium.Checked = False\r
2858 mnuMCAHighest.Checked = False\r
2859 mnuMCAuto.Checked = False\r
2860 End Sub\r
2861 \r
2862 \r
2863 Private Sub mnuMChLCID_Click()\r
2864 Dim fNum As Long\r
2865 On Error GoTo NotSelected\r
2866 List.SelectedItem.Tag = List.SelectedItem.Tag\r
2867 On Error GoTo 0\r
2868 For fNum = 1 To List.ListItems.Count\r
2869 If List.ListItems.Item(fNum).Selected Then\r
2870 GoTo FileSelected\r
2871 End If\r
2872 Next fNum\r
2873 GoTo NotSelected\r
2874 FileSelected:\r
2875 ChLCID.Show 1\r
2876 Exit Sub\r
2877 NotSelected:\r
2878 MsgBox "No files are selected.", , "WinMPQ"\r
2879 End Sub\r
2880 Private Sub mnuMCNone_Click()\r
2881 mnuMCNone.Checked = True\r
2882 mnuMCStandard.Checked = False\r
2883 mnuMCDeflate.Checked = False\r
2884 mnuMCBzip2.Checked = False\r
2885 mnuMCALowest.Checked = False\r
2886 mnuMCAMedium.Checked = False\r
2887 mnuMCAHighest.Checked = False\r
2888 mnuMCAuto.Checked = False\r
2889 End Sub\r
2890 Private Sub mnuMCompact_Click()\r
2891 Dim fNum As Long, result As Long, hMPQ As Long\r
2892 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
2893 result = vbYes\r
2894 Else\r
2895 result = MsgBox("Uncompressed files with an 'X' in the attributes column and are not" + vbCrLf + "listed in (listfile) may be corrupted or deleted by the compacting process." + vbCrLf + "(Note: These files are fairly rare) Continue with compact?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")\r
2896 End If\r
2897 If result = vbYes Then\r
2898 StatBar.Style = 1\r
2899 StatBar.SimpleText = "Compacting " + CD.FileName + "..."\r
2900 MousePointer = 11\r
2901 hMPQ = mOpenMpq(CD.FileName)\r
2902 If hMPQ Then\r
2903 MpqCompactArchive hMPQ\r
2904 MpqCloseUpdatedArchive hMPQ, 0\r
2905 End If\r
2906 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2907 StatBar.Style = 0\r
2908 StatBar.SimpleText = ""\r
2909 MousePointer = 0\r
2910 OpenMpq\r
2911 End If\r
2912 End Sub\r
2913 Private Sub mnuMCStandard_Click()\r
2914 mnuMCNone.Checked = False\r
2915 mnuMCStandard.Checked = True\r
2916 mnuMCDeflate.Checked = False\r
2917 mnuMCBzip2.Checked = False\r
2918 mnuMCALowest.Checked = False\r
2919 mnuMCAMedium.Checked = False\r
2920 mnuMCAHighest.Checked = False\r
2921 mnuMCAuto.Checked = False\r
2922 End Sub\r
2923 Private Sub mnuMDelete_Click()\r
2924 Dim fNum As Long, result As Long, hMPQ As Long\r
2925 On Error GoTo NotSelected\r
2926 List.SelectedItem.Tag = List.SelectedItem.Tag\r
2927 On Error GoTo 0\r
2928 For fNum = 1 To List.ListItems.Count\r
2929 If List.ListItems.Item(fNum).Selected Then\r
2930 GoTo FileSelected\r
2931 End If\r
2932 Next fNum\r
2933 GoTo NotSelected\r
2934 FileSelected:\r
2935 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
2936 result = vbYes\r
2937 Else\r
2938 result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")\r
2939 End If\r
2940 If result = vbYes Then\r
2941 fNum = 1\r
2942 hMPQ = mOpenMpq(CD.FileName)\r
2943 If hMPQ Then\r
2944 Do While fNum <= List.ListItems.Count\r
2945 If List.ListItems.Item(fNum).Selected Then\r
2946 StatBar.Style = 1\r
2947 StatBar.SimpleText = "Deleting " + List.ListItems.Item(fNum).Tag + "..."\r
2948 MousePointer = 11\r
2949 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
2950 MpqDeleteFile hMPQ, List.ListItems.Item(fNum).Tag\r
2951 SFileSetLocale LocaleID\r
2952 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
2953 List.ListItems.Remove (fNum)\r
2954 fNum = fNum - 1\r
2955 End If\r
2956 fNum = fNum + 1\r
2957 Loop\r
2958 MpqCloseUpdatedArchive hMPQ, 0\r
2959 End If\r
2960 End If\r
2961 StatBar.Style = 0\r
2962 StatBar.SimpleText = ""\r
2963 MousePointer = 0\r
2964 ShowSelected\r
2965 ShowTotal\r
2966 Exit Sub\r
2967 NotSelected:\r
2968 MsgBox "No files are selected.", , "WinMPQ"\r
2969 End Sub\r
2970 Private Sub mnuMEncrypt_Click()\r
2971 If mnuMEncrypt.Checked = False Then\r
2972 mnuMEncrypt.Checked = True\r
2973 GlobalEncrypt = True\r
2974 Else\r
2975 mnuMEncrypt.Checked = False\r
2976 GlobalEncrypt = False\r
2977 End If\r
2978 End Sub\r
2979 Private Sub mnuMExtract_Click()\r
2980 Dim fNum As Long, Path As String, result As Long, hMPQ As Long\r
2981 On Error GoTo NotSelected\r
2982 List.SelectedItem.Tag = List.SelectedItem.Tag\r
2983 On Error GoTo 0\r
2984 For fNum = 1 To List.ListItems.Count\r
2985 If List.ListItems.Item(fNum).Selected Then\r
2986 GoTo FileSelected\r
2987 End If\r
2988 Next fNum\r
2989 GoTo NotSelected\r
2990 FileSelected:\r
2991 PathInput.hwndOwner = hWnd\r
2992 Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)\r
2993 If Path = "" Then Exit Sub\r
2994 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
2995 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
2996 For fNum = 1 To List.ListItems.Count\r
2997 If List.ListItems.Item(fNum).Selected Then\r
2998 StatBar.Style = 1\r
2999 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
3000 MousePointer = 11\r
3001 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
3002 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
3003 SFileSetLocale LocaleID\r
3004 End If\r
3005 Next fNum\r
3006 SFileCloseArchive hMPQ\r
3007 StatBar.Style = 0\r
3008 StatBar.SimpleText = ""\r
3009 MousePointer = 0\r
3010 Exit Sub\r
3011 NotSelected:\r
3012 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
3013 result = vbYes\r
3014 Else\r
3015 result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")\r
3016 End If\r
3017 If result = vbYes Then\r
3018 PathInput.hwndOwner = hWnd\r
3019 Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)\r
3020 If Path = "" Then Exit Sub\r
3021 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
3022 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
3023 For fNum = 1 To List.ListItems.Count\r
3024 StatBar.Style = 1\r
3025 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
3026 MousePointer = 11\r
3027 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
3028 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
3029 SFileSetLocale LocaleID\r
3030 Next fNum\r
3031 SFileCloseArchive hMPQ\r
3032 StatBar.Style = 0\r
3033 StatBar.SimpleText = ""\r
3034 MousePointer = 0\r
3035 End If\r
3036 End Sub\r
3037 Private Sub mnuFNew_Click()\r
3038 Dim TItem As Menu\r
3039 CD.Flags = &H1000 Or &H4 Or &H2\r
3040 CD.DefaultExt = "mpq"\r
3041 CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|All Files (*.*)|*.*"\r
3042 CD.hwndOwner = hWnd\r
3043 If ShowSave(CD) = False Then GoTo Cancel\r
3044 ReDim FileList(0) As String\r
3045 List.ListItems.Clear\r
3046 ShowSelected\r
3047 ShowTotal\r
3048 NewFile = True\r
3049 ReDim OpenFiles(0) As String, OpenFileDates(0) As Date\r
3050 mnuMpq.Enabled = True\r
3051 For Each TItem In mnuTItem\r
3052 TItem.Enabled = True\r
3053 Next TItem\r
3054 Toolbar.Buttons.Item("Add").Enabled = True\r
3055 Toolbar.Buttons.Item("Add Folder").Enabled = True\r
3056 Toolbar.Buttons.Item("Extract").Enabled = True\r
3057 Toolbar.Buttons.Item("Compact").Enabled = True\r
3058 Toolbar.Buttons.Item("List").Enabled = True\r
3059 Caption = "WinMPQ - " + CD.FileTitle\r
3060 AddRecentFile CD.FileName\r
3061 Cancel:\r
3062 End Sub\r
3063 Private Sub mnuFOpen_Click()\r
3064 Dim OldFileName As String\r
3065 CD.Flags = &H1000 Or &H4 Or &H2\r
3066 CD.Filter = "All Archives|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x;*.cwd|Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m;*.w3x|Cwad Archives (*.cwd;*.exe)|*.cwd;*.exe|All Files (*.*)|*.*"\r
3067 OldFileName = CD.FileName\r
3068 CD.hwndOwner = hWnd\r
3069 If ShowOpen(CD) = False Then GoTo Cancel\r
3070 OpenMpq\r
3071 If CD.FileName = "" Then CD.FileName = OldFileName\r
3072 Cancel:\r
3073 End Sub\r
3074 Private Sub mnuMItem_Click(Index As Integer)\r
3075 FileActionClick mnuMpq, mnuMItem, Index\r
3076 End Sub\r
3077 Private Sub mnuMRename_Click()\r
3078 List.StartLabelEdit\r
3079 End Sub\r
3080 Private Sub mnuMSaveList_Click()\r
3081 Dim fNum As Long, fList As String, OldFileName As String\r
3082 CD.Flags = &H1000 Or &H4 Or &H2\r
3083 CD.DefaultExt = "txt"\r
3084 CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"\r
3085 OldFileName = CD.FileName\r
3086 CD.FileName = CD.FileName + ".txt"\r
3087 CD.hwndOwner = hWnd\r
3088 If ShowSave(CD) = False Then GoTo Cancel\r
3089 StatBar.Style = 1\r
3090 StatBar.SimpleText = "Creating list..."\r
3091 MousePointer = 11\r
3092 For fNum = 1 To List.ListItems.Count\r
3093 fList = fList + List.ListItems.Item(fNum).Tag + vbCrLf\r
3094 Next fNum\r
3095 fNum = FreeFile\r
3096 Open CD.FileName For Binary As #fNum\r
3097 Put #fNum, 1, fList\r
3098 Close #fNum\r
3099 Cancel:\r
3100 CD.FileName = OldFileName\r
3101 StatBar.Style = 0\r
3102 StatBar.SimpleText = ""\r
3103 MousePointer = 0\r
3104 End Sub\r
3105 Private Sub mnuOptions_Click()\r
3106 Options.Show 1\r
3107 End Sub\r
3108 \r
3109 Private Sub mnuPChLCID_Click()\r
3110 mnuMChLCID_Click\r
3111 End Sub\r
3112 Private Sub mnuPDelete_Click()\r
3113 mnuMDelete_Click\r
3114 End Sub\r
3115 Private Sub mnuPExtract_Click()\r
3116 mnuMExtract_Click\r
3117 End Sub\r
3118 Private Sub mnuPItem_Click(Index As Integer)\r
3119 FileActionClick mnuPopup, mnuPItem, Index\r
3120 End Sub\r
3121 Private Sub mnuPRename_Click()\r
3122 mnuMRename_Click\r
3123 End Sub\r
3124 Private Sub mnuPTItem_Click(Index As Integer)\r
3125 mnuTItem_Click Index\r
3126 End Sub\r
3127 Private Sub mnuTAdd_Click()\r
3128 ToolList.Show 1\r
3129 BuildToolsList\r
3130 End Sub\r
3131 Private Sub mnuTItem_Click(Index As Integer)\r
3132 Dim Param As String, bNum As Long, FileName As String, Path As String, fNum As Long, AlreadyInList As Boolean, UseFile As Boolean, NewParam As String, FileNameList As String, hMPQ As Long\r
3133 Param = mnuTItem(Index).Tag\r
3134 On Error GoTo NoProgram\r
3135 If Param = "" Then Err.Raise 53\r
3136 On Error GoTo 0\r
3137 Do\r
3138 If InStr(1, Param, "%mpq", 1) Then\r
3139 bNum = InStr(1, Param, "%mpq", 1)\r
3140 Param = Left(Param, bNum - 1) + CD.FileName + Mid(Param, bNum + 4)\r
3141 End If\r
3142 Loop While InStr(1, Param, "%mpq", 1)\r
3143 NewParam = Param\r
3144 On Error GoTo NotSelected\r
3145 List.SelectedItem.Tag = List.SelectedItem.Tag\r
3146 On Error GoTo 0\r
3147 If List.SelectedItem.Selected Then FileName = List.SelectedItem.Tag\r
3148 NotSelected:\r
3149 If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0)) Then\r
3150 Path = App.Path\r
3151 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
3152 Path = Path + "Temp_extract\"\r
3153 If ExtractPathNum = -1 Then\r
3154 fNum = 0\r
3155 Do\r
3156 If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do\r
3157 fNum = fNum + 1\r
3158 Loop\r
3159 ExtractPathNum = fNum\r
3160 End If\r
3161 Path = Path + CStr(ExtractPathNum) + "\"\r
3162 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub\r
3163 For fNum = 1 To List.ListItems.Count\r
3164 If List.ListItems.Item(fNum).Selected Then\r
3165 StatBar.Style = 1\r
3166 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."\r
3167 MousePointer = 11\r
3168 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag\r
3169 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True\r
3170 SFileSetLocale LocaleID\r
3171 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then\r
3172 For bNum = 1 To UBound(OpenFiles)\r
3173 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then\r
3174 AlreadyInList = True\r
3175 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
3176 Exit For\r
3177 End If\r
3178 Next bNum\r
3179 If AlreadyInList = False Then\r
3180 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date\r
3181 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag\r
3182 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))\r
3183 End If\r
3184 End If\r
3185 StatBar.Style = 1\r
3186 StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."\r
3187 FileName = FullPath(Path, List.ListItems.Item(fNum).Tag)\r
3188 UseFile = True\r
3189 Param = NewParam\r
3190 Do\r
3191 If InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0 Then\r
3192 If FileName <> "" Then\r
3193 Param = Param + " " + FileName\r
3194 End If\r
3195 ElseIf InStr(Param, Chr(34) + "%1" + Chr(34)) Then\r
3196 bNum = InStr(Param, Chr(34) + "%1" + Chr(34))\r
3197 If FileName <> "" Then\r
3198 Param = Left(Param, bNum - 1) + Chr(34) + FileName + Chr(34) + Mid(Param, bNum + 4)\r
3199 Else\r
3200 Param = Left(Param, bNum - 1) + Mid(Param, bNum + 4)\r
3201 End If\r
3202 ElseIf InStr(Param, "%1") Then\r
3203 bNum = InStr(Param, "%1")\r
3204 If FileName <> "" Then\r
3205 Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)\r
3206 Else\r
3207 Param = Left(Param, bNum - 1) + Mid(Param, bNum + 2)\r
3208 End If\r
3209 End If\r
3210 Loop While InStr(Param, "%1")\r
3211 On Error GoTo NoProgram\r
3212 Shell Param, 1\r
3213 On Error GoTo 0\r
3214 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True\r
3215 End If\r
3216 Next fNum\r
3217 SFileCloseArchive hMPQ\r
3218 ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then\r
3219 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
3220 On Error GoTo NoProgram\r
3221 Shell Param, 1\r
3222 On Error GoTo 0\r
3223 Timer1.Enabled = True\r
3224 Else\r
3225 MsgBox "No files are selected.", , "WinMPQ"\r
3226 End If\r
3227 If FileName <> "" Then\r
3228 StatBar.Style = 0\r
3229 StatBar.SimpleText = ""\r
3230 MousePointer = 0\r
3231 End If\r
3232 Exit Sub\r
3233 NoProgram:\r
3234 If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"\r
3235 End Sub\r
3236 \r
3237 Private Sub mnuTMpqEmbed_Click()\r
3238 frmMpq.Show\r
3239 End Sub\r
3240 Private Sub Timer1_Timer()\r
3241 Dim fNum As Long, Path As String, result As Long, bNum As Long, hMPQ As Long, dwFlags As Long\r
3242 If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub\r
3243 Path = App.Path\r
3244 If Right(Path, 1) <> "\" Then Path = Path + "\"\r
3245 Path = Path + "Temp_extract\"\r
3246 Path = Path + CStr(ExtractPathNum) + "\"\r
3247 For fNum = 1 To UBound(OpenFiles)\r
3248 If FileExists(FullPath(Path, OpenFiles(fNum))) Then\r
3249 If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then\r
3250 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then\r
3251 result = vbYes\r
3252 Else\r
3253 result = MsgBox("File " + OpenFiles(fNum) + " has been changed since it was extracted." + vbCrLf + vbCrLf + "Update archive with this file?", vbYesNo Or vbInformation, "WinMPQ")\r
3254 End If\r
3255 If FileExists(FullPath(Path, OpenFiles(fNum))) Then\r
3256 OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))\r
3257 If result = vbYes Then\r
3258 List.Sorted = False\r
3259 StatBar.Style = 1\r
3260 StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."\r
3261 MousePointer = 11\r
3262 dwFlags = MAFA_REPLACE_EXISTING\r
3263 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT\r
3264 hMPQ = mOpenMpq(CD.FileName)\r
3265 If hMPQ Then\r
3266 If mnuMCNone.Checked Then\r
3267 MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags, 0, 0\r
3268 ElseIf mnuMCStandard.Checked Then\r
3269 MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0\r
3270 ElseIf mnuMCDeflate.Checked Then\r
3271 MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel\r
3272 ElseIf mnuMCBzip2.Checked Then\r
3273 MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_BZIP2, 0\r
3274 ElseIf mnuMCAMedium.Checked Then\r
3275 MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 0\r
3276 ElseIf mnuMCAHighest.Checked Then\r
3277 MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 1\r
3278 ElseIf mnuMCALowest.Checked Then\r
3279 MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 2\r
3280 ElseIf mnuMCAuto.Checked Then\r
3281 mAddAutoFile hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)\r
3282 End If\r
3283 End If\r
3284 MpqAddToListing hMPQ, OpenFiles(fNum)\r
3285 MpqCloseUpdatedArchive hMPQ, 0\r
3286 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)\r
3287 StatBar.Style = 0\r
3288 StatBar.SimpleText = ""\r
3289 MousePointer = 0\r
3290 List.Sorted = True\r
3291 RemoveDuplicates\r
3292 ShowTotal\r
3293 End If\r
3294 End If\r
3295 End If\r
3296 Else\r
3297 For bNum = fNum To UBound(OpenFiles) - 1\r
3298 OpenFiles(bNum) = OpenFiles(bNum + 1)\r
3299 OpenFileDates(bNum) = OpenFileDates(bNum + 1)\r
3300 Next bNum\r
3301 ReDim Preserve OpenFiles(UBound(OpenFiles) - 1) As String, OpenFileDates(UBound(OpenFileDates) - 1) As Date\r
3302 fNum = fNum - 1\r
3303 If UBound(OpenFiles) = 0 Then Timer1.Enabled = False\r
3304 End If\r
3305 If fNum >= UBound(OpenFiles) Then Exit For\r
3306 Next fNum\r
3307 If FileExists(CD.FileName) Then\r
3308 If FileDateTime(CD.FileName) <> MpqDate And NewFile = False Then OpenMpq\r
3309 Else\r
3310 OpenMpq\r
3311 End If\r
3312 End Sub\r
3313 Private Sub Toolbar_ButtonClick(ByVal Button As Button)\r
3314 Select Case Button.Key\r
3315 Case "New"\r
3316 mnuFNew_Click\r
3317 Case "Open"\r
3318 mnuFOpen_Click\r
3319 Case "Add"\r
3320 mnuMAdd_Click\r
3321 Case "Add Folder"\r
3322 mnuMAddFolder_Click\r
3323 Case "Extract"\r
3324 mnuMExtract_Click\r
3325 Case "Compact"\r
3326 mnuMCompact_Click\r
3327 Case "List"\r
3328 If NewFile = False Then OpenMpq\r
3329 End Select\r
3330 End Sub\r
3331 Private Sub txtCommand_GotFocus()\r
3332 cmdGo.Default = True\r
3333 txtCommandHasFocus = True\r
3334 StatBar.Style = 1\r
3335 StatBar.SimpleText = "Current directory: " + Chr(34) + CurDir + Chr(34)\r
3336 End Sub\r
3337 Private Sub txtCommand_LostFocus()\r
3338 cmdGo.Default = False\r
3339 txtCommandHasFocus = False\r
3340 StatBar.Style = 0\r
3341 StatBar.SimpleText = ""\r
3342 End Sub\r
|