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