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