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