Main
Current News
Archived News
Search News
Forums
Discussion Forum


Old Forum
Programs
Install Programs
Downloads
More Downloads...
Troubleshooting
Other Sections
Source Code
Format Specs.
Misc. Information
Non-SF Stuff
Links



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