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