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.64
[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()
5a1d5f7f 1758Dim fNum As Long, nSelect As Long, sSize As Currency, 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
5a1d5f7f 1762On Error Resume Next
0d212c7b 1763For fNum = 1 To List.ListItems.Count
1764 If List.ListItems.Item(fNum).Selected Then
1765 nSelect = nSelect + 1
1766 If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
1767 sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1768 Else
62046253 1769 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
1770 If SFileOpenFileEx(hMPQ, List.ListItems.Item(fNum).Tag, 0, hFile) Then
1771 fSize = SFileGetFileSize(hFile, 0)
1772 SFileCloseFile hFile
1773 End If
1774 SFileCloseArchive hMPQ
1775 End If
0d212c7b 1776 If fSize / 1024 > 0 And fSize / 1024 < 1 Then
1777 L2 = "<1KB"
1778 ElseIf fSize = 0 Then
1779 L2 = "0KB"
1780 Else
1781 L2 = CStr(Int(fSize / 1024)) + "KB"
1782 End If
1783 List.ListItems.Item(fNum).ListSubItems(1).Text = L2
1784 List.ListItems.Item(fNum).ListSubItems(1).Tag = fSize
1785 sSize = sSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1786 End If
1787 End If
1788Next fNum
1789If sSize / 1024 > 0 And sSize / 1024 < 1 Then
1790 StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, <1KB"
1791ElseIf sSize = 0 Then
1792 StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, 0KB"
1793Else
1794 StatBar.Panels.Item(1).Text = "Selected " + CStr(nSelect) + " files, " + CStr(Int(sSize / 1024)) + "KB"
1795End If
5a1d5f7f 1796On Error GoTo 0
0d212c7b 1797Exit Sub
1798NotSelected:
1799StatBar.Panels.Item(1).Text = "Selected 0 files, 0KB"
1800End Sub
1801Sub ShowTotal()
5a1d5f7f 1802Dim fNum As Long, nFiles As Long, tSize As Currency
1803On Error Resume Next
0d212c7b 1804For fNum = 1 To List.ListItems.Count
1805 nFiles = nFiles + 1
1806 If List.ListItems.Item(fNum).ListSubItems(1).Text <> "" Then
1807 tSize = tSize + List.ListItems.Item(fNum).ListSubItems(1).Tag
1808 End If
1809Next fNum
1810If tSize / 1024 > 0 And tSize / 1024 < 1 Then
1811 StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, <1KB"
1812Else
1813 StatBar.Panels.Item(2).Text = "Total " + CStr(nFiles) + "/" + CStr(GetNumMpqFiles(CD.FileName)) + " files, " + CStr(Int(tSize / 1024)) + "KB"
1814End If
5a1d5f7f 1815On Error GoTo 0
0d212c7b 1816End Sub
1817Private Sub cmdGo_Click()
1818StatBar.Style = 1
1819RunMpq2kCommand txtCommand
1820txtCommand = ""
1821If StatBar.SimpleText = "" Then txtCommand_GotFocus
1822End Sub
62046253 1823
1824Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
1825If KeyCode = vbKeyShift Then
1826 ShiftState = True
1827 BuildMpqActionList
1828End If
1829End Sub
1830Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
1831If KeyCode = vbKeyShift Then
1832 ShiftState = False
1833 BuildMpqActionList
1834End If
1835End Sub
0d212c7b 1836Private Sub Form_Load()
1837Dim 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 1838Dim Path
1839Path = App.Path: If Right(Path, 1) <> "\" Then Path = Path + "\"
1840NewKey AppKey
1841SetReg AppKey + "InstallPath", GetLongPath(App.Path), REG_SZ
1842SetReg AppKey + "ProgramFilename", GetLongPath(Path + App.EXEName + ".exe"), REG_SZ
0d212c7b 1843FixIcon hWnd, 1
1844InitFileDialog CD
1845CD.hwndOwner = hWnd
1846CD.DefaultExt = "mpq"
1847CD.MaxFileSize = 5120
1848InitFolderDialog PathInput
1849PathInput.hwndOwner = hWnd
1850PathInput.Flags = BIF_RETURNONLYFSDIRS
1851ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
0d212c7b 1852ChDir App.Path
62046253 1853'If Mpq.MpqInitialize = False Then
1854' ErrorText = "Mpq Control did not initialize properly!" + vbCrLf + "Reason: "
1855' Select Case Mpq.LastError
1856' Case MPQ_ERROR_NO_STAREDIT
1857' ErrorText = ErrorText + "Can't find StarEdit.exe"
1858' Case MPQ_ERROR_BAD_STAREDIT
1859' ErrorText = ErrorText + "Wrong version of StarEdit.exe. Need SC/BW 1.07"
1860' Case MPQ_ERROR_STAREDIT_RUNNING
1861' ErrorText = ErrorText + "StarEdit.exe is running. It must be closed before running this"
1862' Case Else
1863' ErrorText = ErrorText + "Unknown"
1864' End Select
1865' MsgBox ErrorText
1866' End
1867'End If
0d212c7b 1868ExtractPathNum = -1
1869CopyPathNum = -1
1870OldStartPath = CurDir
1871CurPath = GetReg(AppKey + "StartupPath", CurDir)
1872CurPathType = GetReg(AppKey + "StartupPathType", 0)
1873If CurPathType < 0 Then CurPathType = 0
1874If CurPathType > 2 Then CurPathType = 2
1875If CurPathType = 1 Then
1876 CurPath = App.Path
1877End If
1878CurPath2 = CurPath
1879If Right(CurPath2, 1) <> "\" Then CurPath2 = CurPath2 + "\"
1880If IsDir(CurPath2) Then
1881 If Mid(CurPath, 2, 1) = ":" Then ChDrive Left(CurPath, 1)
1882 ChDir CurPath
1883End If
1884NewStartPath = CurDir
1885On Error Resume Next
1886Height = GetReg(AppKey + "Status\WindowHeight", Height)
1887Left = GetReg(AppKey + "Status\WindowLeft", Left)
1888Top = GetReg(AppKey + "Status\WindowTop", Top)
1889Width = GetReg(AppKey + "Status\WindowWidth", Width)
1890If GetReg(AppKey + "Status\WindowState", WindowState) = 2 Then WindowState = 2 Else WindowState = 0
1891ListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
62046253 1892DefaultMaxFiles = GetReg(AppKey + "DefaultMaxFiles", 1024)
5f007675 1893DefaultBlockSize = GetReg(AppKey + "DefaultBlockSize", DEFAULT_BLOCK_SIZE)
0d212c7b 1894LocaleID = GetReg(AppKey + "LocaleID", 0)
62046253 1895GlobalEncrypt = False
1896DefaultCompressID = GetReg(AppKey + "DefaultCompress", -1)
1897Select Case DefaultCompressID
1898Case -3
1899DefaultCompress = MAFA_COMPRESS_DEFLATE
1900Case Else
1901DefaultCompress = MAFA_COMPRESS_STANDARD
1902End Select
1903DefaultCompressLevel = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION)
0d212c7b 1904BuildRecentFileList
1905BuildToolsList
1906On Error GoTo 0
62046253 1907SFileSetLocale LocaleID
0d212c7b 1908ReDim GlobalFileList(0) As String
1909#If InternalListing Then
1910If FileExists(ListFile) Then
1911 Open ListFile For Input As #1
1912 Do While Not EOF(1)
1913 ReDim Preserve GlobalFileList(UBound(GlobalFileList) + 1) As String
1914 Line Input #1, GlobalFileList(UBound(GlobalFileList))
1915 Loop
1916 Close #1
1917End If
1918#End If
1919FileName = Trim(Command)
1920If Left(FileName, 1) = Chr(34) Then FileName = Mid(FileName, 2)
1921If Right(FileName, 1) = Chr(34) Then FileName = Left(FileName, Len(FileName) - 1)
1922FileName = Trim(FileName)
1923If FileExists(FileName) Then
1924 CD.FileName = FileName
1925 Show
1926 OpenMpq
1927 Exit Sub
1928End If
1929ReDim FileList(0) As String
1930If Right(CurPath, 1) <> "\" Then CurPath = CurPath + "\"
1931sLine = Command
1932If Right(sLine, 1) <> " " Then sLine = sLine + " "
1933If sLine <> "" Then
1934 ReDim Param(0) As String
1935 For pNum = 1 To Len(sLine)
1936 If Mid(sLine, pNum, 1) = Chr(34) Then
1937 pNum = pNum + 1
1938 EndParam = InStr(pNum, sLine, Chr(34))
1939 If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum - 1, (EndParam + 1) - (pNum - 1))
1940 Else
1941 EndParam = InStr(pNum, sLine, " ")
1942 If UBound(Param) = 1 Then ParamCutout = Mid(sLine, pNum, EndParam - pNum)
1943 End If
1944 If EndParam = 0 Then EndParam = Len(sLine) + 1
1945 If pNum <> EndParam Then
1946 If Trim(Mid(sLine, pNum, EndParam - pNum)) <> "" Then
1947 ReDim Preserve Param(UBound(Param) + 1) As String
1948 Param(UBound(Param)) = Trim(Mid(sLine, pNum, EndParam - pNum))
1949 End If
1950 End If
1951 pNum = EndParam
1952 Next pNum
1953 If UBound(Param) < 3 Then ReDim Preserve Param(3) As String
1954 Select Case LCase(Param(1))
1955 Case "o", "open", "n", "new"
1956 Show
1957 If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1958 ChDir OldStartPath
1959 RunMpq2kCommand sLine
1960 Case "a", "add", "e", "extract", "r", "ren", "rename", "m", "move", "d", "del", "delete", "f", "flush", "compact", "l", "list"
1961 If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1962 ChDir OldStartPath
1963 CD.FileName = FullPath(CurDir, Param(2))
1964 sLine = Left(sLine, InStr(sLine, ParamCutout) - 1) + Mid(sLine, InStr(sLine, ParamCutout) + Len(ParamCutout))
1965 RunMpq2kCommand sLine
1966 If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
1967 ChDir NewStartPath
1968 Unload Me
1969 Case "s", "script"
1970 Show
1971 If Mid(OldStartPath, 2, 1) = ":" Then ChDrive Left(OldStartPath, 1)
1972 ChDir OldStartPath
1973 RunMpq2kCommand sLine
1974 If Mid(NewStartPath, 2, 1) = ":" Then ChDrive Left(NewStartPath, 1)
1975 ChDir NewStartPath
1976 End Select
1977End If
1978End Sub
0d212c7b 1979Private Sub Form_Resize()
1980On Error Resume Next
1981If WindowState <> 1 Then
1982 List.Top = Toolbar.Height
1983 List.Width = ScaleWidth
1984 List.Height = ScaleHeight - List.Top - StatBar.Height - txtCommand.Height
1985 Label1.Top = List.Top + List.Height + (txtCommand.Height - Label1.Height) / 2
1986 txtCommand.Top = List.Top + List.Height
1987 txtCommand.Left = Label1.Width
1988 txtCommand.Width = ScaleWidth - cmdGo.Width - Label1.Width
1989 cmdGo.Top = txtCommand.Top
1990 cmdGo.Left = txtCommand.Left + txtCommand.Width
1991 mFilter.Width = ScaleWidth - mFilter.Left - Toolbar.Buttons.Item("List").Width
1992 Toolbar.Buttons.Item("filterspace").Width = mFilter.Width
1993End If
1994End Sub
1995Private Sub Form_Unload(Cancel As Integer)
1996Dim Path As String
1997Path = App.Path
1998If Right(Path, 1) <> "\" Then Path = Path + "\"
1999On Error Resume Next
2000If ExtractPathNum > -1 Then
2001 KillEx Path + "Temp_extract\" + CStr(ExtractPathNum) + "\", "*", 6, True
2002 RmDir Path + "Temp_extract\" + CStr(ExtractPathNum) + "\"
2003End If
2004If DirEx(Path + "Temp_extract\", "*", 6, True) = "" Or App.PrevInstance = False Then
2005 KillEx Path + "Temp_extract\", "*", 6, True
2006 RmDir Path + "Temp_extract\"
2007End If
2008If CopyPathNum > -1 Then
2009 KillEx Path + "Temp_copy\" + CStr(CopyPathNum) + "\", "*", 6, True
2010 RmDir Path + "Temp_copy\" + CStr(CopyPathNum) + "\"
2011End If
2012If DirEx(Path + "Temp_copy\", "*", 6, True) = "" Or App.PrevInstance = False Then
2013 KillEx Path + "Temp_copy\", "*", 6, True
2014 RmDir Path + "Temp_copy\"
2015End If
2016If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then
2017 NewKey AppKey
2018 NewKey AppKey + "Status\"
2019 If WindowState = 1 Then WindowState = 0
2020 SetReg AppKey + "Status\WindowState", WindowState, REG_DWORD
2021 WindowState = 0
2022 SetReg AppKey + "Status\WindowHeight", Height, REG_DWORD
2023 SetReg AppKey + "Status\WindowLeft", Left, REG_DWORD
2024 SetReg AppKey + "Status\WindowTop", Top, REG_DWORD
2025 SetReg AppKey + "Status\WindowWidth", Width, REG_DWORD
2026End If
2027If GetReg(AppKey + "StartupPathType", 0) <= 0 Then
2028 SetReg AppKey + "StartupPath", CurDir
2029End If
2030End
2031End Sub
2032Private Sub Label1_Click()
2033txtCommand.SetFocus
2034End Sub
2035Private Sub List_AfterLabelEdit(Cancel As Integer, NewString As String)
62046253 2036Dim result As Long, hMPQ As Long, hFile As Long
0d212c7b 2037If List.SelectedItem.Text <> NewString Then
2038 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
62046253 2039 result = vbYes
0d212c7b 2040 Else
62046253 2041 result = MsgBox("Rename file?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
0d212c7b 2042 End If
62046253 2043 If result = vbYes Then
0d212c7b 2044 List.SelectedItem.Tag = NewString
62046253 2045 hMPQ = mOpenMpq(CD.FileName)
2046 If hMPQ Then
2047 If SFileOpenFileEx(hMPQ, NewString, 0, hFile) Then
2048 SFileCloseFile hFile
2049 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
2050 MpqDeleteFile hMPQ, NewString
2051 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
2052 SFileSetLocale LocaleID
2053 RemoveDuplicates
2054 Else
2055 SFileSetLocale List.SelectedItem.ListSubItems(4).Tag
2056 MpqRenameFile hMPQ, List.SelectedItem.Text, NewString
2057 SFileSetLocale LocaleID
2058 End If
2059 MpqCloseUpdatedArchive hMPQ, 0
2060 On Error Resume Next
2061 List.SelectedItem.Key = NewString
2062 On Error GoTo 0
2063 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
0d212c7b 2064 End If
0d212c7b 2065 Else
2066 Cancel = True
2067 End If
2068End If
2069ShowSelected
2070End Sub
2071Private Sub List_Click()
2072On Error GoTo NotSelected
2073List.SelectedItem.Tag = List.SelectedItem.Tag
2074On Error GoTo NotClick
2075List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2076On Error GoTo 0
2077ShowSelected
2078Exit Sub
2079NotClick:
2080List.SelectedItem.Selected = False
2081NotSelected:
2082ShowSelected
62046253 2083BuildMpqActionList
0d212c7b 2084End Sub
2085Private Sub List_ColumnClick(ByVal ColumnHeader As ColumnHeader)
2086If List.SortKey = ColumnHeader.Index - 1 Then
2087 If List.SortOrder = 0 Then
2088 List.SortOrder = 1
2089 Else
2090 List.SortOrder = 0
2091 End If
2092Else
2093 List.SortOrder = 0
2094 List.SortKey = ColumnHeader.Index - 1
2095End If
2096End Sub
2097Private Sub List_DblClick()
2098Dim fNum As Long, Path As String, fName As String, fName2 As String, bNum As Long, AlreadyInList As Boolean, hMPQ As Long
2099On Error GoTo NotSelected
2100List.SelectedItem.Tag = List.SelectedItem.Tag
2101On Error GoTo NotClick
2102List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2103On Error GoTo 0
2104Path = App.Path
2105If Right(Path, 1) <> "\" Then Path = Path + "\"
2106Path = Path + "Temp_extract\"
2107If ExtractPathNum = -1 Then
2108 fNum = 0
2109 Do
2110 If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
2111 fNum = fNum + 1
2112 Loop
2113 ExtractPathNum = fNum
2114End If
2115Path = Path + CStr(ExtractPathNum) + "\"
62046253 2116If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
0d212c7b 2117For fNum = 1 To List.ListItems.Count
2118 If List.ListItems.Item(fNum).Selected Then
2119 StatBar.Style = 1
2120 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2121 MousePointer = 11
62046253 2122 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2123 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2124 SFileSetLocale LocaleID
0d212c7b 2125 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
2126 For bNum = 1 To UBound(OpenFiles)
2127 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
2128 AlreadyInList = True
2129 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
2130 Exit For
2131 End If
2132 Next bNum
2133 If AlreadyInList = False Then
2134 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
2135 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
2136 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
2137 End If
2138 End If
2139 StatBar.Style = 1
2140 StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
2141 fName = List.ListItems.Item(fNum).Tag
62046253 2142 BuildPopup Path + fName, 0, mnuPopup, mnuPItem
2143 ExecuteFile Path + fName, 0, mnuPopup, mnuPItem
0d212c7b 2144 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
2145 End If
2146Next fNum
62046253 2147SFileCloseArchive hMPQ
0d212c7b 2148StatBar.Style = 0
2149StatBar.SimpleText = ""
2150MousePointer = 0
2151Exit Sub
2152NotClick:
2153List.SelectedItem.Selected = False
2154NotSelected:
2155End Sub
62046253 2156Private Sub List_ItemClick(ByVal Item As ListItem)
2157BuildMpqActionList
2158End Sub
0d212c7b 2159Private Sub List_KeyPress(KeyAscii As Integer)
2160If KeyAscii = 13 Then List_DblClick
2161End Sub
2162Private Sub List_KeyUp(KeyCode As Integer, Shift As Integer)
2163If KeyCode = vbKeyDelete Then
2164 mnuMDelete_Click
2165ElseIf KeyCode = 93 Or ((Shift And vbShiftMask) And KeyCode = vbKeyF10) Then
2166 On Error GoTo NotSelected
2167 List.SelectedItem.Tag = List.SelectedItem.Tag
2168 On Error GoTo 0
2169 If List.SelectedItem.Selected = True Then
62046253 2170 BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
0d212c7b 2171 PopupMenu mnuPopup, vbPopupMenuRightButton, List.Left + List.SelectedItem.Left + 12 * Screen.TwipsPerPixelX, List.Top + List.SelectedItem.Top + 16 * Screen.TwipsPerPixelY, mnuPItem(0)
2172 End If
2173End If
2174NotSelected:
2175End Sub
62046253 2176Private Sub List_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
2177CX = X
2178CY = Y
0d212c7b 2179If Button And vbRightButton Then
2180 On Error GoTo NotSelected
2181 List.SelectedItem.Tag = List.SelectedItem.Tag
2182 On Error GoTo NotClick
2183 List.HitTest(CX, CY).Tag = List.HitTest(CX, CY).Tag
2184 On Error GoTo 0
62046253 2185 BuildPopup List.SelectedItem.Tag, Shift, mnuPopup, mnuPItem
0d212c7b 2186 PopupMenu mnuPopup, vbPopupMenuRightButton, , , mnuPItem(0)
2187End If
2188NotClick:
2189NotSelected:
2190End Sub
2191Private Sub List_OLECompleteDrag(Effect As Long)
2192List.Tag = ""
2193End Sub
62046253 2194Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
0d212c7b 2195Dim 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 2196Dim 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 2197If Data.GetFormat(ccCFFiles) <> True Then Exit Sub
2198For fNum = 1 To Data.Files.Count
2199 Path = Data.Files.Item(fNum)
2200 If Right(Path, 1) <> "\" Then Path = Path + "\"
2201 If IsDir(Path) Then
2202 Path = Path + "*"
2203 Data.Files.Remove fNum
2204 Data.Files.Add Path, fNum
2205 End If
2206Next fNum
2207Path = Data.Files.Item(1)
2208For bNum = 1 To Len(Path)
2209 If InStr(bNum, Path, "\") > 0 Then
2210 For fNum = 1 To Data.Files.Count
2211 If Left(Data.Files.Item(fNum), InStr(bNum, Path, "\")) <> Left(Path, InStr(bNum, Path, "\")) Then GoTo PathFound
2212 Next fNum
2213 bNum = InStr(bNum, Path, "\")
2214 Else
2215 Exit For
2216 End If
2217Next bNum
2218PathFound:
2219Path = Left(Path, bNum - 1)
2220ReDim Files(0) As String
2221Files(0) = Path
2222If Right(Path, 1) <> "\" Then Path = Path + "\"
2223ReDim Preserve Files(Data.Files.Count) As String
2224For bNum = 1 To Data.Files.Count
2225 Files(bNum) = Mid(Data.Files.Item(bNum), 1 + Len(Path))
2226 For fNum = 1 To Len(Files(bNum))
2227 If InStr(fNum, Files(bNum), "\") > 0 Then
2228 fNum = InStr(fNum, Files(bNum), "\")
2229 Else
2230 Exit For
2231 End If
2232 Next fNum
2233 FolderFiles = FolderFiles + DirEx(Path + Left(Files(bNum), fNum - 1), Mid(Files(bNum), fNum), 6, True)
2234Next bNum
2235If FolderFiles = "" Then Exit Sub
2236ReDim Preserve Files(0) As String
2237For bNum = 1 To Len(FolderFiles)
2238 ReDim Preserve Files(UBound(Files) + 1) As String
2239 If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
2240 Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
2241 bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
2242 Else
2243 Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
2244 Exit For
2245 End If
2246Next bNum
2247FoldName.Show 1
62046253 2248If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
0d212c7b 2249If UBound(Files) > 1 Then
2250 ReDim ShortFiles(UBound(Files)) As String
2251 For bNum = 0 To UBound(Files)
2252 ShortFiles(bNum) = AddFolderName + Files(bNum)
2253 Next bNum
2254 If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2255 For bNum = 1 To UBound(Files)
2256 Files(bNum) = FullPath(Files(0), Files(bNum))
2257 Next bNum
2258Else
2259 For bNum = 1 To Len(Files(1))
2260 If InStr(bNum, Files(1), "\") > 0 Then
2261 bNum = InStr(bNum, Files(1), "\")
2262 Else
2263 Exit For
2264 End If
2265 Next bNum
2266 ReDim ShortFiles(UBound(Files)) As String
2267 ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2268 Files(1) = FullPath(Files(0), Files(1))
2269End If
2270If NewFile = True Then
2271 If FileExists(CD.FileName) Then Kill CD.FileName
2272 NewFile = False
2273End If
2274List.Sorted = False
2275FileFilter = mFilter
62046253 2276hMPQ = mOpenMpq(CD.FileName)
0d212c7b 2277If hMPQ = 0 Then
2278 StatBar.SimpleText = "Can't create archive " + CD.FileName
2279 Exit Sub
2280End If
62046253 2281dwFlags = MAFA_REPLACE_EXISTING
2282If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
0d212c7b 2283For bNum = 1 To UBound(Files)
2284 StatBar.Style = 1
2285 StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2286 MousePointer = 11
2287 If mnuMCNone.Checked Then
62046253 2288 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
0d212c7b 2289 ElseIf mnuMCStandard.Checked Then
62046253 2290 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2291 ElseIf mnuMCDeflate.Checked Then
2292 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
0d212c7b 2293 ElseIf mnuMCAMedium.Checked Then
62046253 2294 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
0d212c7b 2295 ElseIf mnuMCAHighest.Checked Then
62046253 2296 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
0d212c7b 2297 ElseIf mnuMCALowest.Checked Then
62046253 2298 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
0d212c7b 2299 ElseIf mnuMCAuto.Checked Then
2300 mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2301 End If
2302 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2303 mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2304 For cNum = 1 To mFilter.ListCount - 1
2305 If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2306 mFilter.RemoveItem cNum
2307 Exit For
2308 End If
2309 Next cNum
2310Next bNum
62046253 2311MpqCloseUpdatedArchive hMPQ, 0
0d212c7b 2312If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
62046253 2313If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
0d212c7b 2314 StatBar.SimpleText = "Adding files to listing... 0% complete"
2315 For bNum = 1 To UBound(Files)
2316 If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2317 MpqAddToListing hMPQ, ShortFiles(bNum)
2318 End If
2319 On Error Resume Next
2320 StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2321 On Error GoTo 0
2322 Next bNum
62046253 2323 SFileCloseArchive hMPQ
0d212c7b 2324End If
2325StatBar.Style = 0
2326StatBar.SimpleText = ""
2327MousePointer = 0
2328If MatchesFilter("(listfile)", FileFilter) Then
2329 AddToListing "(listfile)"
2330End If
2331mFilter = FileFilter
2332List.Sorted = True
2333RemoveDuplicates
2334ShowTotal
2335Cancel:
2336End Sub
62046253 2337Private 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 2338If CD.FileName = "" Or Data.GetFormat(ccCFFiles) <> True Or List.Tag = "WinMPQ" Then
2339 Effect = ccOLEDropEffectNone
2340Else
2341 Effect = ccOLEDropEffectCopy
2342End If
2343End Sub
2344Private Sub List_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
2345Dim fNum As Long, Path As String, fCount As Long, FirstFile As String, hMPQ As Long
2346Path = App.Path
2347If Right(Path, 1) <> "\" Then Path = Path + "\"
2348Path = Path + "Temp_copy\"
2349If CopyPathNum = -1 Then
2350 fNum = 0
2351 Do
2352 If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
2353 fNum = fNum + 1
2354 Loop
2355 CopyPathNum = fNum
2356End If
2357Path = Path + CStr(CopyPathNum) + "\"
2358KillEx Path, "*", 6, True
2359fCount = 0
62046253 2360If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
0d212c7b 2361For fNum = 1 To List.ListItems.Count
2362 If List.ListItems.Item(fNum).Selected Then
2363 StatBar.Style = 1
2364 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2365 MousePointer = 11
62046253 2366 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2367 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2368 SFileSetLocale LocaleID
0d212c7b 2369 If GetReg(AppKey + "UseDragDropWildcards", 1) = 0 Then
2370 Data.Files.Add Path + List.ListItems.Item(fNum).Tag
2371 End If
2372 fCount = fCount + 1
2373 If fCount = 1 Then FirstFile = Path + List.ListItems.Item(fNum).Tag
2374 End If
2375Next fNum
62046253 2376SFileCloseArchive hMPQ
0d212c7b 2377StatBar.Style = 0
2378StatBar.SimpleText = ""
2379MousePointer = 0
2380If GetReg(AppKey + "UseDragDropWildcards", 1) <> 0 And fCount > 1 Then
2381 Data.Files.Add Path + "*"
2382ElseIf fCount = 1 Then
2383 Data.Files.Add FirstFile
2384End If
2385End Sub
2386Private Sub List_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
2387Data.SetData , ccCFFiles
2388AllowedEffects = ccOLEDropEffectCopy
2389List.Tag = "WinMPQ"
2390End Sub
2391Private Sub mFilter_KeyPress(KeyAscii As Integer)
2392If KeyAscii = 13 And Toolbar.Buttons.Item("List").Enabled Then
2393 If NewFile = False Then OpenMpq
2394End If
2395End Sub
2396Private Sub mnuFExit_Click()
2397Unload Me
2398End Sub
2399Private Sub mnuFile_Click()
2400If FileExists(CD.FileName) Then mnuFReopen.Enabled = True Else mnuFReopen.Enabled = False
2401End Sub
0d212c7b 2402Private Sub mnuFRecent_Click(Index As Integer)
2403Dim OldFileName As String
2404OldFileName = CD.FileName
2405CD.FileName = mnuFRecent(Index).Tag
2406If FileExists(CD.FileName) = False Then
2407 CD.FileName = OldFileName
2408 MsgBox "The file " + Chr(34) + mnuFRecent(Index).Tag + Chr(34) + " does not exist.", vbExclamation, "WinMPQ"
2409 DelRecentFile mnuFRecent(Index).Tag
2410 Exit Sub
2411End If
2412OpenMpq
2413If CD.FileName = "" Then
2414 CD.FileName = OldFileName
2415 DelRecentFile mnuFRecent(Index).Tag
2416End If
2417End Sub
2418Private Sub mnuFReopen_Click()
2419OpenMpq
2420End Sub
2421
2422Private Sub mnuFScript_Click()
2423Dim OldFileName As String, OldPath As String
2424CD.Flags = &H1000 Or &H4 Or &H2
2425CD.Filter = "All Files (*.*)|*.*"
2426OldFileName = CD.FileName
2427OldPath = CurDir
62046253 2428CD.hwndOwner = hWnd
0d212c7b 2429If ShowOpen(CD) = False Then GoTo Cancel
2430StatBar.Style = 1
2431StatBar.SimpleText = "Running script " + CD.FileName + "..."
2432MousePointer = 11
2433RunScript CD.FileName
2434StatBar.Style = 0
2435StatBar.SimpleText = ""
2436MousePointer = 0
2437CD.FileName = OldFileName
2438Cancel:
2439If Mid(OldPath, 2, 1) = ":" Then ChDrive Left(OldPath, 1)
2440ChDir OldPath
2441End Sub
2442Private Sub mnuHAbout_Click()
2443About.Show 1
2444End Sub
2445Private Sub mnuHReadme_Click()
2446Dim Path As String
2447Path = App.Path
2448If Right(Path, 1) <> "\" Then Path = Path + "\"
2449If FileExists(Path + "WinMPQ.rtf") Then
2450 ShellExecute hWnd, vbNullString, Path + "WinMPQ.rtf", vbNullString, vbNullString, 1
2451Else
2452 MsgBox "Could not find WinMPQ.rtf!", vbCritical, "WinMPQ"
2453End If
2454End Sub
2455Private Sub mnuMAdd_Click()
2456Dim Files() As String, ShortFiles() As String, bNum As Long, OldFileName As String, fNum As Long, cNum As Long, FileFilter As String
62046253 2457Dim 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 2458CD.Flags = OFN_EXPLORER Or &H1000 Or &H200 Or &H4 Or &H2
2459CD.Filter = "All Files (*.*)|*.*"
2460OldFileName = CD.FileName
62046253 2461CD.hwndOwner = hWnd
0d212c7b 2462If ShowOpen(CD) = False Then GoTo Cancel
2463ReDim Files(0) As String
2464bNum = 1
2465If InStr(1, CD.FileName, Chr(0)) > 0 Then
2466 Files(0) = Mid(CD.FileName, 1, InStr(1, CD.FileName, Chr(0)) - 1)
2467 bNum = InStr(1, CD.FileName, Chr(0)) + 1
2468Else
2469 Files(0) = Mid(CD.FileName, 1)
2470End If
2471For bNum = bNum To Len(CD.FileName)
2472 ReDim Preserve Files(UBound(Files) + 1) As String
2473 If InStr(bNum, CD.FileName, Chr(0)) > 0 Then
2474 Files(UBound(Files)) = Mid(CD.FileName, bNum, InStr(bNum, CD.FileName, Chr(0)) - bNum)
2475 bNum = InStr(bNum, CD.FileName, Chr(0))
2476 Else
2477 Files(UBound(Files)) = Mid(CD.FileName, bNum)
2478 Exit For
2479 End If
2480Next bNum
2481CD.FileName = OldFileName
2482FoldName.Show 1
62046253 2483If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
0d212c7b 2484If UBound(Files) > 1 Then
2485 ReDim ShortFiles(UBound(Files)) As String
2486 For bNum = 0 To UBound(Files)
2487 ShortFiles(bNum) = AddFolderName + Files(bNum)
2488 Next bNum
2489 If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2490 For bNum = 1 To UBound(Files)
2491 Files(bNum) = FullPath(Files(0), Files(bNum))
2492 Next bNum
2493Else
2494 For bNum = 1 To Len(Files(1))
2495 If InStr(bNum, Files(1), "\") > 0 Then
2496 bNum = InStr(bNum, Files(1), "\")
2497 Else
2498 Exit For
2499 End If
2500 Next bNum
2501 ReDim ShortFiles(UBound(Files)) As String
2502 ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2503 Files(1) = FullPath(Files(0), Files(1))
2504End If
2505If NewFile = True Then
2506 If FileExists(CD.FileName) Then Kill CD.FileName
2507 NewFile = False
2508End If
2509List.Sorted = False
2510FileFilter = mFilter
62046253 2511hMPQ = mOpenMpq(CD.FileName)
0d212c7b 2512If hMPQ = 0 Then
2513 StatBar.SimpleText = "Can't create archive " + CD.FileName
2514 Exit Sub
2515End If
62046253 2516dwFlags = MAFA_REPLACE_EXISTING
2517If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
0d212c7b 2518For bNum = 1 To UBound(Files)
2519 StatBar.Style = 1
2520 StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2521 MousePointer = 11
2522 If mnuMCNone.Checked Then
62046253 2523 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
0d212c7b 2524 ElseIf mnuMCStandard.Checked Then
62046253 2525 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2526 ElseIf mnuMCDeflate.Checked Then
2527 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
0d212c7b 2528 ElseIf mnuMCAMedium.Checked Then
62046253 2529 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
0d212c7b 2530 ElseIf mnuMCAHighest.Checked Then
62046253 2531 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
0d212c7b 2532 ElseIf mnuMCALowest.Checked Then
62046253 2533 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
0d212c7b 2534 ElseIf mnuMCAuto.Checked Then
2535 mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2536 End If
2537 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2538 mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2539 For cNum = 1 To mFilter.ListCount - 1
2540 If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2541 mFilter.RemoveItem cNum
2542 Exit For
2543 End If
2544 Next cNum
2545Next bNum
62046253 2546MpqCloseUpdatedArchive hMPQ, 0
0d212c7b 2547If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
62046253 2548If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
0d212c7b 2549 StatBar.SimpleText = "Adding files to listing... 0% complete"
2550 For bNum = 1 To UBound(Files)
2551 If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2552 MpqAddToListing hMPQ, ShortFiles(bNum)
2553 End If
2554 On Error Resume Next
2555 StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2556 On Error GoTo 0
2557 Next bNum
62046253 2558 SFileCloseArchive hMPQ
0d212c7b 2559End If
2560StatBar.Style = 0
2561StatBar.SimpleText = ""
2562MousePointer = 0
2563If MatchesFilter("(listfile)", FileFilter) Then
2564 AddToListing "(listfile)"
2565End If
2566mFilter = FileFilter
2567List.Sorted = True
2568RemoveDuplicates
2569ShowTotal
2570Cancel:
2571End Sub
2572Private Sub mnuMAddFolder_Click()
2573Dim 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 2574Dim 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
2575PathInput.hwndOwner = hWnd
0d212c7b 2576Path = PathInputBox(PathInput, "Folder to add files from...", CurDir)
2577If Path = "" Then GoTo Cancel
2578FolderFiles = DirEx(Path, "*", 6, True)
2579If FolderFiles = "" Then Exit Sub
2580ReDim Files(0) As String
2581Files(0) = Path
2582If Right(Path, 1) <> "\" Then Path = Path + "\"
2583For bNum = 1 To Len(FolderFiles)
2584 ReDim Preserve Files(UBound(Files) + 1) As String
2585 If InStr(bNum, FolderFiles, vbCrLf) > 0 Then
2586 Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path), InStr(bNum, FolderFiles, vbCrLf) - bNum - Len(Path))
2587 bNum = InStr(bNum, FolderFiles, vbCrLf) + 1
2588 Else
2589 Files(UBound(Files)) = Mid(FolderFiles, bNum + Len(Path))
2590 Exit For
2591 End If
2592Next bNum
2593FoldName.Show 1
62046253 2594If AddFolderName = Chr(0) + Chr(255) + Chr(127) + Chr(128) Then GoTo Cancel
0d212c7b 2595If UBound(Files) > 1 Then
2596 ReDim ShortFiles(UBound(Files)) As String
2597 For bNum = 0 To UBound(Files)
2598 ShortFiles(bNum) = AddFolderName + Files(bNum)
2599 Next bNum
2600 If Right(Files(0), 1) <> "\" Then Files(0) = Files(0) + "\"
2601 For bNum = 1 To UBound(Files)
2602 Files(bNum) = FullPath(Files(0), Files(bNum))
2603 Next bNum
2604Else
2605 For bNum = 1 To Len(Files(1))
2606 If InStr(bNum, Files(1), "\") > 0 Then
2607 bNum = InStr(bNum, Files(1), "\")
2608 Else
2609 Exit For
2610 End If
2611 Next bNum
2612 ReDim ShortFiles(UBound(Files)) As String
2613 ShortFiles(1) = AddFolderName + Mid(Files(1), bNum)
2614 Files(1) = FullPath(Files(0), Files(1))
2615End If
2616If NewFile = True Then
2617 If FileExists(CD.FileName) Then Kill CD.FileName
2618 NewFile = False
2619End If
2620List.Sorted = False
2621FileFilter = mFilter
62046253 2622hMPQ = mOpenMpq(CD.FileName)
0d212c7b 2623If hMPQ = 0 Then
2624 StatBar.SimpleText = "Can't create archive " + CD.FileName
2625 Exit Sub
2626End If
62046253 2627dwFlags = MAFA_REPLACE_EXISTING
2628If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
0d212c7b 2629For bNum = 1 To UBound(Files)
2630 StatBar.Style = 1
2631 StatBar.SimpleText = "Adding " + Files(bNum) + "..."
2632 MousePointer = 11
2633 If mnuMCNone.Checked Then
62046253 2634 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags, 0, 0
0d212c7b 2635 ElseIf mnuMCStandard.Checked Then
62046253 2636 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
2637 ElseIf mnuMCDeflate.Checked Then
2638 MpqAddFileToArchiveEx hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
0d212c7b 2639 ElseIf mnuMCAMedium.Checked Then
62046253 2640 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 0
0d212c7b 2641 ElseIf mnuMCAHighest.Checked Then
62046253 2642 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 1
0d212c7b 2643 ElseIf mnuMCALowest.Checked Then
62046253 2644 MpqAddWaveToArchive hMPQ, Files(bNum), ShortFiles(bNum), dwFlags Or MAFA_COMPRESS, 2
0d212c7b 2645 ElseIf mnuMCAuto.Checked Then
2646 mAddAutoFile hMPQ, Files(bNum), ShortFiles(bNum)
2647 End If
2648 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2649 mFilter.AddItem "*" + GetExtension(ShortFiles(bNum))
2650 For cNum = 1 To mFilter.ListCount - 1
2651 If LCase(mFilter.List(cNum)) = LCase(mFilter.List(cNum - 1)) Then
2652 mFilter.RemoveItem cNum
2653 Exit For
2654 End If
2655 Next cNum
2656Next bNum
62046253 2657MpqCloseUpdatedArchive hMPQ, 0
0d212c7b 2658If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
62046253 2659If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) Then
0d212c7b 2660 StatBar.SimpleText = "Adding files to listing... 0% complete"
2661 For bNum = 1 To UBound(Files)
2662 If MatchesFilter(ShortFiles(bNum), FileFilter) Then
2663 MpqAddToListing hMPQ, ShortFiles(bNum)
2664 End If
2665 On Error Resume Next
2666 StatBar.SimpleText = "Adding files to listing... " + CStr(Int((bNum / UBound(Files)) * 100)) + "% complete"
2667 On Error GoTo 0
2668 Next bNum
62046253 2669 SFileCloseArchive hMPQ
0d212c7b 2670End If
2671StatBar.Style = 0
2672StatBar.SimpleText = ""
2673MousePointer = 0
2674If MatchesFilter("(listfile)", FileFilter) Then
2675 AddToListing "(listfile)"
2676End If
2677mFilter = FileFilter
2678List.Sorted = True
2679RemoveDuplicates
2680ShowTotal
2681Cancel:
2682End Sub
62046253 2683
2684Private Sub mnuMAddToList_Click()
2685frmAddToList.Show 1
2686End Sub
0d212c7b 2687Private Sub mnuMCAHighest_Click()
2688mnuMCNone.Checked = False
2689mnuMCStandard.Checked = False
62046253 2690mnuMCDeflate.Checked = False
0d212c7b 2691mnuMCALowest.Checked = False
2692mnuMCAMedium.Checked = False
2693mnuMCAHighest.Checked = True
2694mnuMCAuto.Checked = False
2695End Sub
2696Private Sub mnuMCALowest_Click()
2697mnuMCNone.Checked = False
2698mnuMCStandard.Checked = False
62046253 2699mnuMCDeflate.Checked = False
0d212c7b 2700mnuMCALowest.Checked = True
2701mnuMCAMedium.Checked = False
2702mnuMCAHighest.Checked = False
2703mnuMCAuto.Checked = False
2704End Sub
2705
2706
2707Private Sub mnuMCAMedium_Click()
2708mnuMCNone.Checked = False
2709mnuMCStandard.Checked = False
62046253 2710mnuMCDeflate.Checked = False
0d212c7b 2711mnuMCALowest.Checked = False
2712mnuMCAMedium.Checked = True
2713mnuMCAHighest.Checked = False
2714mnuMCAuto.Checked = False
2715End Sub
0d212c7b 2716Private Sub mnuMCAuto_Click()
2717mnuMCNone.Checked = False
2718mnuMCStandard.Checked = False
62046253 2719mnuMCDeflate.Checked = False
0d212c7b 2720mnuMCALowest.Checked = False
2721mnuMCAMedium.Checked = False
2722mnuMCAHighest.Checked = False
2723mnuMCAuto.Checked = True
2724End Sub
2725
62046253 2726Private Sub mnuMCDeflate_Click()
2727mnuMCNone.Checked = False
2728mnuMCStandard.Checked = False
2729mnuMCDeflate.Checked = True
2730mnuMCALowest.Checked = False
2731mnuMCAMedium.Checked = False
2732mnuMCAHighest.Checked = False
2733mnuMCAuto.Checked = False
2734End Sub
2735
2736
2737Private Sub mnuMChLCID_Click()
2738Dim fNum As Long
2739On Error GoTo NotSelected
2740List.SelectedItem.Tag = List.SelectedItem.Tag
2741On Error GoTo 0
2742For fNum = 1 To List.ListItems.Count
2743 If List.ListItems.Item(fNum).Selected Then
2744 GoTo FileSelected
2745 End If
2746Next fNum
2747GoTo NotSelected
2748FileSelected:
2749ChLCID.Show 1
2750Exit Sub
2751NotSelected:
2752MsgBox "No files are selected.", , "WinMPQ"
2753End Sub
0d212c7b 2754Private Sub mnuMCNone_Click()
2755mnuMCNone.Checked = True
2756mnuMCStandard.Checked = False
62046253 2757mnuMCDeflate.Checked = False
0d212c7b 2758mnuMCALowest.Checked = False
2759mnuMCAMedium.Checked = False
2760mnuMCAHighest.Checked = False
2761mnuMCAuto.Checked = False
2762End Sub
0d212c7b 2763Private Sub mnuMCompact_Click()
62046253 2764Dim fNum As Long, result As Long, hMPQ As Long
0d212c7b 2765If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
62046253 2766 result = vbYes
0d212c7b 2767Else
62046253 2768 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 2769End If
62046253 2770If result = vbYes Then
0d212c7b 2771 StatBar.Style = 1
2772 StatBar.SimpleText = "Compacting " + CD.FileName + "..."
2773 MousePointer = 11
62046253 2774 hMPQ = mOpenMpq(CD.FileName)
2775 If hMPQ Then
2776 MpqCompactArchive hMPQ
2777 MpqCloseUpdatedArchive hMPQ, 0
2778 End If
0d212c7b 2779 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2780 StatBar.Style = 0
2781 StatBar.SimpleText = ""
2782 MousePointer = 0
2783 OpenMpq
2784End If
2785End Sub
2786Private Sub mnuMCStandard_Click()
2787mnuMCNone.Checked = False
2788mnuMCStandard.Checked = True
62046253 2789mnuMCDeflate.Checked = False
0d212c7b 2790mnuMCALowest.Checked = False
2791mnuMCAMedium.Checked = False
2792mnuMCAHighest.Checked = False
62046253 2793mnuMCAuto.Checked = False
0d212c7b 2794End Sub
2795Private Sub mnuMDelete_Click()
62046253 2796Dim fNum As Long, result As Long, hMPQ As Long
0d212c7b 2797On Error GoTo NotSelected
2798List.SelectedItem.Tag = List.SelectedItem.Tag
2799On Error GoTo 0
2800For fNum = 1 To List.ListItems.Count
2801 If List.ListItems.Item(fNum).Selected Then
2802 GoTo FileSelected
2803 End If
2804Next fNum
2805GoTo NotSelected
2806FileSelected:
2807 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
62046253 2808 result = vbYes
0d212c7b 2809 Else
62046253 2810 result = MsgBox("Delete file(s)?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
0d212c7b 2811 End If
62046253 2812 If result = vbYes Then
0d212c7b 2813 fNum = 1
62046253 2814 hMPQ = mOpenMpq(CD.FileName)
2815 If hMPQ Then
2816 Do While fNum <= List.ListItems.Count
2817 If List.ListItems.Item(fNum).Selected Then
2818 StatBar.Style = 1
2819 StatBar.SimpleText = "Deleting " + List.ListItems.Item(fNum).Tag + "..."
2820 MousePointer = 11
2821 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2822 MpqDeleteFile hMPQ, List.ListItems.Item(fNum).Tag
2823 SFileSetLocale LocaleID
2824 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
2825 List.ListItems.Remove (fNum)
2826 fNum = fNum - 1
2827 End If
2828 fNum = fNum + 1
2829 Loop
2830 MpqCloseUpdatedArchive hMPQ, 0
2831 End If
0d212c7b 2832 End If
2833 StatBar.Style = 0
2834 StatBar.SimpleText = ""
2835 MousePointer = 0
2836 ShowSelected
2837 ShowTotal
2838Exit Sub
2839NotSelected:
2840MsgBox "No files are selected.", , "WinMPQ"
2841End Sub
62046253 2842Private Sub mnuMEncrypt_Click()
2843If mnuMEncrypt.Checked = False Then
2844 mnuMEncrypt.Checked = True
2845 GlobalEncrypt = True
2846Else
2847 mnuMEncrypt.Checked = False
2848 GlobalEncrypt = False
2849End If
2850End Sub
0d212c7b 2851Private Sub mnuMExtract_Click()
62046253 2852Dim fNum As Long, Path As String, result As Long, hMPQ As Long
0d212c7b 2853On Error GoTo NotSelected
2854List.SelectedItem.Tag = List.SelectedItem.Tag
2855On Error GoTo 0
2856For fNum = 1 To List.ListItems.Count
2857 If List.ListItems.Item(fNum).Selected Then
2858 GoTo FileSelected
2859 End If
2860Next fNum
2861GoTo NotSelected
2862FileSelected:
62046253 2863PathInput.hwndOwner = hWnd
0d212c7b 2864Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
2865If Path = "" Then Exit Sub
2866If Right(Path, 1) <> "\" Then Path = Path + "\"
62046253 2867If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
0d212c7b 2868For fNum = 1 To List.ListItems.Count
2869 If List.ListItems.Item(fNum).Selected Then
2870 StatBar.Style = 1
2871 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2872 MousePointer = 11
62046253 2873 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2874 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2875 SFileSetLocale LocaleID
0d212c7b 2876 End If
2877Next fNum
62046253 2878SFileCloseArchive hMPQ
0d212c7b 2879StatBar.Style = 0
2880StatBar.SimpleText = ""
2881MousePointer = 0
2882Exit Sub
2883NotSelected:
2884If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
62046253 2885 result = vbYes
0d212c7b 2886Else
62046253 2887 result = MsgBox("No files are selected." + vbCrLf + "Extract all listed files?", vbYesNo Or vbQuestion Or vbDefaultButton2, "WinMPQ")
0d212c7b 2888End If
62046253 2889If result = vbYes Then
2890 PathInput.hwndOwner = hWnd
0d212c7b 2891 Path = PathInputBox(PathInput, "Extract file(s) to...", CurDir)
2892 If Path = "" Then Exit Sub
2893 If Right(Path, 1) <> "\" Then Path = Path + "\"
62046253 2894 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
0d212c7b 2895 For fNum = 1 To List.ListItems.Count
2896 StatBar.Style = 1
2897 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
2898 MousePointer = 11
62046253 2899 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
2900 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
2901 SFileSetLocale LocaleID
0d212c7b 2902 Next fNum
62046253 2903 SFileCloseArchive hMPQ
0d212c7b 2904 StatBar.Style = 0
2905 StatBar.SimpleText = ""
2906 MousePointer = 0
2907End If
2908End Sub
2909Private Sub mnuFNew_Click()
2910Dim TItem As Menu
2911CD.Flags = &H1000 Or &H4 Or &H2
2912CD.DefaultExt = "mpq"
2913CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
62046253 2914CD.hwndOwner = hWnd
0d212c7b 2915If ShowSave(CD) = False Then GoTo Cancel
2916ReDim FileList(0) As String
2917List.ListItems.Clear
2918ShowSelected
2919ShowTotal
2920NewFile = True
2921ReDim OpenFiles(0) As String, OpenFileDates(0) As Date
2922mnuMpq.Enabled = True
2923For Each TItem In mnuTItem
2924 TItem.Enabled = True
2925Next TItem
2926Toolbar.Buttons.Item("Add").Enabled = True
2927Toolbar.Buttons.Item("Add Folder").Enabled = True
2928Toolbar.Buttons.Item("Extract").Enabled = True
2929Toolbar.Buttons.Item("Compact").Enabled = True
2930Toolbar.Buttons.Item("List").Enabled = True
2931Caption = "WinMPQ - " + CD.FileTitle
2932AddRecentFile CD.FileName
2933Cancel:
2934End Sub
2935Private Sub mnuFOpen_Click()
2936Dim OldFileName As String
2937CD.Flags = &H1000 Or &H4 Or &H2
2938CD.Filter = "Mpq Archives (*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m)|*.mpq;*.exe;*.snp;*.scm;*.scx;*.w3m|All Files (*.*)|*.*"
2939OldFileName = CD.FileName
62046253 2940CD.hwndOwner = hWnd
0d212c7b 2941If ShowOpen(CD) = False Then GoTo Cancel
2942OpenMpq
2943If CD.FileName = "" Then CD.FileName = OldFileName
2944Cancel:
2945End Sub
62046253 2946Private Sub mnuMItem_Click(Index As Integer)
2947FileActionClick mnuMpq, mnuMItem, Index
2948End Sub
0d212c7b 2949Private Sub mnuMRename_Click()
2950List.StartLabelEdit
2951End Sub
2952Private Sub mnuMSaveList_Click()
2953Dim fNum As Long, fList As String, OldFileName As String
2954CD.Flags = &H1000 Or &H4 Or &H2
2955CD.DefaultExt = "txt"
2956CD.Filter = "Text File (*.txt)|*.txt|All Files (*.*)|*.*"
2957OldFileName = CD.FileName
2958CD.FileName = CD.FileName + ".txt"
62046253 2959CD.hwndOwner = hWnd
0d212c7b 2960If ShowSave(CD) = False Then GoTo Cancel
2961StatBar.Style = 1
2962StatBar.SimpleText = "Creating list..."
2963MousePointer = 11
2964For fNum = 1 To List.ListItems.Count
2965 fList = fList + List.ListItems.Item(fNum).Tag + vbCrLf
2966Next fNum
2967fNum = FreeFile
2968Open CD.FileName For Binary As #fNum
2969Put #fNum, 1, fList
2970Close #fNum
2971Cancel:
2972CD.FileName = OldFileName
2973StatBar.Style = 0
2974StatBar.SimpleText = ""
2975MousePointer = 0
2976End Sub
2977Private Sub mnuOptions_Click()
2978Options.Show 1
2979End Sub
62046253 2980
2981Private Sub mnuPChLCID_Click()
2982mnuMChLCID_Click
2983End Sub
0d212c7b 2984Private Sub mnuPDelete_Click()
2985mnuMDelete_Click
2986End Sub
2987Private Sub mnuPExtract_Click()
2988mnuMExtract_Click
2989End Sub
2990Private Sub mnuPItem_Click(Index As Integer)
62046253 2991FileActionClick mnuPopup, mnuPItem, Index
0d212c7b 2992End Sub
2993Private Sub mnuPRename_Click()
2994mnuMRename_Click
2995End Sub
62046253 2996Private Sub mnuPTItem_Click(Index As Integer)
2997mnuTItem_Click Index
2998End Sub
0d212c7b 2999Private Sub mnuTAdd_Click()
3000ToolList.Show 1
3001BuildToolsList
3002End Sub
3003Private Sub mnuTItem_Click(Index As Integer)
3004Dim 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
3005Param = mnuTItem(Index).Tag
3006On Error GoTo NoProgram
3007If Param = "" Then Err.Raise 53
3008On Error GoTo 0
3009Do
3010 If InStr(1, Param, "%mpq", 1) Then
3011 bNum = InStr(1, Param, "%mpq", 1)
3012 Param = Left(Param, bNum - 1) + CD.FileName + Mid(Param, bNum + 4)
3013 End If
3014Loop While InStr(1, Param, "%mpq", 1)
3015NewParam = Param
3016On Error GoTo NotSelected
3017List.SelectedItem.Tag = List.SelectedItem.Tag
3018On Error GoTo 0
3019If List.SelectedItem.Selected Then FileName = List.SelectedItem.Tag
3020NotSelected:
3021If FileName <> "" And (InStr(Param, "%1") Or (InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0)) Then
3022 Path = App.Path
3023 If Right(Path, 1) <> "\" Then Path = Path + "\"
3024 Path = Path + "Temp_extract\"
3025 If ExtractPathNum = -1 Then
3026 fNum = 0
3027 Do
3028 If DirEx(Path + CStr(fNum), "*", 6, True) = "" Then Exit Do
3029 fNum = fNum + 1
3030 Loop
3031 ExtractPathNum = fNum
3032 End If
3033 Path = Path + CStr(ExtractPathNum) + "\"
62046253 3034 If SFileOpenArchive(CD.FileName, 0, 0, hMPQ) = 0 Then Exit Sub
0d212c7b 3035 For fNum = 1 To List.ListItems.Count
3036 If List.ListItems.Item(fNum).Selected Then
3037 StatBar.Style = 1
3038 StatBar.SimpleText = "Extracting " + List.ListItems.Item(fNum).Tag + "..."
3039 MousePointer = 11
62046253 3040 SFileSetLocale List.ListItems.Item(fNum).ListSubItems(4).Tag
3041 sGetFile hMPQ, List.ListItems.Item(fNum).Tag, Path, True
3042 SFileSetLocale LocaleID
0d212c7b 3043 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then
3044 For bNum = 1 To UBound(OpenFiles)
3045 If LCase(OpenFiles(bNum)) = LCase(List.ListItems.Item(fNum).Tag) Then
3046 AlreadyInList = True
3047 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(bNum) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
3048 Exit For
3049 End If
3050 Next bNum
3051 If AlreadyInList = False Then
3052 ReDim Preserve OpenFiles(UBound(OpenFiles) + 1) As String, OpenFileDates(UBound(OpenFileDates) + 1) As Date
3053 OpenFiles(UBound(OpenFiles)) = List.ListItems.Item(fNum).Tag
3054 If FileExists(FullPath(Path, List.ListItems.Item(fNum).Tag)) Then OpenFileDates(UBound(OpenFileDates)) = FileDateTime(FullPath(Path, List.ListItems.Item(fNum).Tag))
3055 End If
3056 End If
3057 StatBar.Style = 1
3058 StatBar.SimpleText = "Opening " + List.ListItems.Item(fNum).Tag + "..."
3059 FileName = FullPath(Path, List.ListItems.Item(fNum).Tag)
3060 UseFile = True
3061 Param = NewParam
3062 Do
3063 If InStr(Param, "%1") = 0 And InStr(1, mnuTItem(Index).Tag, "%mpq", 1) = 0 Then
3064 If FileName <> "" Then
3065 Param = Param + " " + FileName
3066 End If
3067 ElseIf InStr(Param, Chr(34) + "%1" + Chr(34)) Then
3068 bNum = InStr(Param, Chr(34) + "%1" + Chr(34))
3069 If FileName <> "" Then
3070 Param = Left(Param, bNum - 1) + Chr(34) + FileName + Chr(34) + Mid(Param, bNum + 4)
3071 Else
3072 Param = Left(Param, bNum - 1) + Mid(Param, bNum + 4)
3073 End If
3074 ElseIf InStr(Param, "%1") Then
3075 bNum = InStr(Param, "%1")
3076 If FileName <> "" Then
3077 Param = Left(Param, bNum - 1) + FileName + Mid(Param, bNum + 2)
3078 Else
3079 Param = Left(Param, bNum - 1) + Mid(Param, bNum + 2)
3080 End If
3081 End If
3082 Loop While InStr(Param, "%1")
3083 On Error GoTo NoProgram
3084 Shell Param, 1
3085 On Error GoTo 0
3086 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Timer1.Enabled = True
3087 End If
3088 Next fNum
62046253 3089 SFileCloseArchive hMPQ
0d212c7b 3090ElseIf InStr(1, mnuTItem(Index).Tag, "%mpq", 1) Then
3091 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
3092 On Error GoTo NoProgram
3093 Shell Param, 1
3094 On Error GoTo 0
3095 Timer1.Enabled = True
3096Else
3097 MsgBox "No files are selected.", , "WinMPQ"
3098End If
3099If FileName <> "" Then
3100 StatBar.Style = 0
3101 StatBar.SimpleText = ""
3102 MousePointer = 0
3103End If
3104Exit Sub
3105NoProgram:
3106If Err.Number = 53 Then MsgBox "No program is assigned for this action.", , "WinMPQ"
3107End Sub
62046253 3108
3109Private Sub mnuTMpqEmbed_Click()
3110frmMpq.Show
3111End Sub
0d212c7b 3112Private Sub Timer1_Timer()
62046253 3113Dim fNum As Long, Path As String, result As Long, bNum As Long, hMPQ As Long, dwFlags As Long
0d212c7b 3114If Screen.ActiveForm.Name <> "MpqEx" Then Exit Sub
3115Path = App.Path
3116If Right(Path, 1) <> "\" Then Path = Path + "\"
3117Path = Path + "Temp_extract\"
3118Path = Path + CStr(ExtractPathNum) + "\"
3119For fNum = 1 To UBound(OpenFiles)
3120 If FileExists(FullPath(Path, OpenFiles(fNum))) Then
3121 If FileDateTime(FullPath(Path, OpenFiles(fNum))) > OpenFileDates(fNum) Then
3122 If GetReg(AppKey + "ShowConfirmation", 1) = 0 Then
62046253 3123 result = vbYes
0d212c7b 3124 Else
62046253 3125 result = MsgBox("File " + OpenFiles(fNum) + " has been changed since it was extracted." + vbCrLf + vbCrLf + "Update archive with this file?", vbYesNo Or vbInformation, "WinMPQ")
0d212c7b 3126 End If
62046253 3127 If FileExists(FullPath(Path, OpenFiles(fNum))) Then
3128 OpenFileDates(fNum) = FileDateTime(FullPath(Path, OpenFiles(fNum)))
3129 If result = vbYes Then
3130 List.Sorted = False
3131 StatBar.Style = 1
3132 StatBar.SimpleText = "Adding " + OpenFiles(fNum) + "..."
3133 MousePointer = 11
3134 dwFlags = MAFA_REPLACE_EXISTING
3135 If GlobalEncrypt Then dwFlags = dwFlags Or MAFA_ENCRYPT
3136 hMPQ = mOpenMpq(CD.FileName)
3137 If hMPQ Then
3138 If mnuMCNone.Checked Then
3139 MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags, 0, 0
3140 ElseIf mnuMCStandard.Checked Then
3141 MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_STANDARD, 0
3142 ElseIf mnuMCDeflate.Checked Then
3143 MpqAddFileToArchiveEx hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, MAFA_COMPRESS_DEFLATE, DefaultCompressLevel
3144 ElseIf mnuMCAMedium.Checked Then
3145 MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 0
3146 ElseIf mnuMCAHighest.Checked Then
3147 MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 1
3148 ElseIf mnuMCALowest.Checked Then
3149 MpqAddWaveToArchive hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum), dwFlags Or MAFA_COMPRESS, 2
3150 ElseIf mnuMCAuto.Checked Then
3151 mAddAutoFile hMPQ, FullPath(Path, OpenFiles(fNum)), OpenFiles(fNum)
3152 End If
3153 End If
3154 MpqAddToListing hMPQ, OpenFiles(fNum)
3155 MpqCloseUpdatedArchive hMPQ, 0
3156 If FileExists(CD.FileName) Then MpqDate = FileDateTime(CD.FileName)
3157 StatBar.Style = 0
3158 StatBar.SimpleText = ""
3159 MousePointer = 0
3160 List.Sorted = True
3161 RemoveDuplicates
3162 ShowTotal
0d212c7b 3163 End If
0d212c7b 3164 End If
3165 End If
3166 Else
3167 For bNum = fNum To UBound(OpenFiles) - 1
3168 OpenFiles(bNum) = OpenFiles(bNum + 1)
3169 OpenFileDates(bNum) = OpenFileDates(bNum + 1)
3170 Next bNum
3171 ReDim Preserve OpenFiles(UBound(OpenFiles) - 1) As String, OpenFileDates(UBound(OpenFileDates) - 1) As Date
3172 fNum = fNum - 1
3173 If UBound(OpenFiles) = 0 Then Timer1.Enabled = False
3174 End If
3175 If fNum >= UBound(OpenFiles) Then Exit For
3176Next fNum
3177If FileExists(CD.FileName) Then
3178 If FileDateTime(CD.FileName) <> MpqDate And NewFile = False Then OpenMpq
3179Else
3180 OpenMpq
3181End If
3182End Sub
3183Private Sub Toolbar_ButtonClick(ByVal Button As Button)
3184Select Case Button.Key
3185Case "New"
3186 mnuFNew_Click
3187Case "Open"
3188 mnuFOpen_Click
3189Case "Add"
3190 mnuMAdd_Click
3191Case "Add Folder"
3192 mnuMAddFolder_Click
3193Case "Extract"
3194 mnuMExtract_Click
3195Case "Compact"
3196 mnuMCompact_Click
3197Case "List"
3198 If NewFile = False Then OpenMpq
3199End Select
3200End Sub
3201Private Sub txtCommand_GotFocus()
3202cmdGo.Default = True
3203txtCommandHasFocus = True
3204StatBar.Style = 1
3205StatBar.SimpleText = "Current directory: " + Chr(34) + CurDir + Chr(34)
3206End Sub
3207Private Sub txtCommand_LostFocus()
3208cmdGo.Default = False
3209txtCommandHasFocus = False
3210StatBar.Style = 0
3211StatBar.SimpleText = ""
3212End Sub
MPQ editor for Windows