Current News Archived News Search News Discussion Forum Old Forum Install Programs More Downloads... Troubleshooting Source Code Format Specs. Misc. Information Non-SF Stuff Links Small banner for links to this site: |
1 VERSION 4.00
2 Begin VB.Form Options
3 BorderStyle = 3 'Fixed Dialog
4 Caption = "Options"
5 ClientHeight = 4695
6 ClientLeft = 1575
7 ClientTop = 1815
8 ClientWidth = 5415
9 Height = 5100
10 Icon = "Options.frx":0000
11 KeyPreview = -1 'True
12 Left = 1515
13 LinkTopic = "Form1"
14 MaxButton = 0 'False
15 MinButton = 0 'False
16 ScaleHeight = 4695
17 ScaleWidth = 5415
18 ShowInTaskbar = 0 'False
19 Top = 1470
20 Width = 5535
21 Begin VB.CommandButton Command2
22 Caption = "&Cancel"
23 Height = 375
24 Left = 3120
25 TabIndex = 1
26 Top = 4200
27 Width = 1335
28 End
29 Begin VB.CommandButton Command1
30 Caption = "O&k"
31 Height = 375
32 Left = 960
33 TabIndex = 0
34 Top = 4200
35 Width = 1335
36 End
37 Begin VB.PictureBox TabDisps
38 BorderStyle = 0 'None
39 Height = 3495
40 Index = 1
41 Left = 240
42 ScaleHeight = 3495
43 ScaleWidth = 4995
44 TabIndex = 35
45 TabStop = 0 'False
46 Top = 480
47 Width = 4995
48 Begin VB.TextBox Text5
49 Height = 285
50 Left = 2280
51 MaxLength = 2
52 TabIndex = 5
53 Text = "3"
54 Top = 1200
55 Width = 1215
56 End
57 Begin VB.TextBox Text1
58 Height = 285
59 Left = 0
60 MaxLength = 6
61 TabIndex = 3
62 Text = "1024"
63 Top = 600
64 Width = 1215
65 End
66 Begin VB.TextBox Text2
67 Height = 285
68 Left = 0
69 TabIndex = 4
70 Text = "0"
71 Top = 1200
72 Width = 1215
73 End
74 Begin VB.CheckBox Check2
75 Caption = "&Associate WinMPQ with MPQ Archives"
76 Height = 255
77 Left = 0
78 TabIndex = 6
79 Top = 1680
80 Value = 2 'Grayed
81 Width = 3375
82 End
83 Begin VB.CheckBox Check4
84 Caption = "Use &wildcards in filenames for drag and drop"
85 Height = 255
86 Left = 0
87 TabIndex = 8
88 Top = 2400
89 Value = 2 'Grayed
90 Width = 3735
91 End
92 Begin VB.CheckBox Check5
93 Caption = "Automatically update &modified files"
94 Height = 255
95 Left = 0
96 TabIndex = 7
97 Top = 2160
98 Value = 2 'Grayed
99 Width = 3015
100 End
101 Begin VB.Label ActualBlockSize
102 Caption = "4 KB"
103 Height = 255
104 Left = 3600
105 TabIndex = 56
106 Top = 1200
107 Width = 1215
108 End
109 Begin VB.Label Label13
110 AutoSize = -1 'True
111 Caption = "Block size for new archives (default is 3)"
112 Height = 390
113 Left = 2280
114 TabIndex = 55
115 Top = 720
116 Width = 2055
117 WordWrap = -1 'True
118 End
119 Begin VB.Label Label1
120 AutoSize = -1 'True
121 Caption = "Maximum files for new archives: (this cannot be changed for an existing archive)"
122 Height = 495
123 Left = 0
124 TabIndex = 38
125 Top = 120
126 Width = 4335
127 WordWrap = -1 'True
128 End
129 Begin VB.Label Label2
130 AutoSize = -1 'True
131 Caption = "Locale ID for adding files"
132 Height = 195
133 Left = 0
134 TabIndex = 37
135 Top = 960
136 Width = 1755
137 End
138 Begin VB.Label Label3
139 Caption = $"Options.frx":000C
140 Height = 855
141 Left = 0
142 TabIndex = 36
143 Top = 2640
144 Width = 4935
145 End
146 End
147 Begin VB.PictureBox TabDisps
148 BorderStyle = 0 'None
149 Height = 3495
150 Index = 2
151 Left = 240
152 ScaleHeight = 3495
153 ScaleWidth = 4935
154 TabIndex = 41
155 TabStop = 0 'False
156 Top = 480
157 Visible = 0 'False
158 Width = 4935
159 Begin VB.CommandButton cmdAddFolder
160 Caption = "Add &Folder..."
161 Height = 375
162 Left = 3480
163 TabIndex = 11
164 Top = 1320
165 Width = 1335
166 End
167 Begin VB.CheckBox Check8
168 Caption = "Do not use above lists when one is found by above option"
169 Height = 375
170 Left = 0
171 TabIndex = 14
172 Top = 2880
173 Value = 2 'Grayed
174 Width = 3375
175 End
176 Begin VB.CheckBox Check7
177 Caption = "Use file lists for similarly named archives"
178 Height = 195
179 Left = 0
180 TabIndex = 13
181 Top = 2640
182 Width = 3375
183 End
184 Begin VB.CommandButton cmdDelList
185 Caption = "&Remove"
186 Height = 375
187 Left = 3480
188 TabIndex = 12
189 Top = 1920
190 Width = 1335
191 End
192 Begin VB.ListBox FileLists
193 Height = 2205
194 Left = 0
195 TabIndex = 9
196 Top = 360
197 Width = 3375
198 End
199 Begin VB.CommandButton cmdAddList
200 Caption = "&Add List File..."
201 Height = 375
202 Left = 3480
203 TabIndex = 10
204 Top = 720
205 Width = 1335
206 End
207 Begin VB.Label Label11
208 Caption = "Note: Each file list added will increase the load time for archives."
209 Height = 255
210 Left = 0
211 TabIndex = 52
212 Top = 3240
213 Width = 4815
214 End
215 Begin VB.Label Label10
216 AutoSize = -1 'True
217 Caption = "File Lists:"
218 Height = 195
219 Left = 0
220 TabIndex = 51
221 Top = 120
222 Width = 645
223 End
224 End
225 Begin VB.PictureBox TabDisps
226 BorderStyle = 0 'None
227 Height = 3495
228 Index = 5
229 Left = 240
230 ScaleHeight = 3495
231 ScaleWidth = 4935
232 TabIndex = 39
233 TabStop = 0 'False
234 Top = 480
235 Visible = 0 'False
236 Width = 4935
237 Begin VB.CommandButton Command4
238 Caption = "&Reset size/position"
239 Height = 375
240 Left = 360
241 TabIndex = 17
242 Top = 840
243 Width = 1695
244 End
245 Begin VB.CheckBox Check3
246 Caption = "Display &confirmation boxes"
247 Height = 255
248 Left = 0
249 TabIndex = 15
250 Top = 120
251 Value = 2 'Grayed
252 Width = 2415
253 End
254 Begin VB.CheckBox Check1
255 Caption = "&Save last window size and position"
256 Height = 255
257 Left = 0
258 TabIndex = 16
259 Top = 480
260 Value = 2 'Grayed
261 Width = 3015
262 End
263 Begin VB.Frame Frame1
264 Caption = "Startup Path"
265 Height = 1215
266 Left = 0
267 TabIndex = 40
268 Top = 2280
269 Width = 4935
270 Begin VB.OptionButton Option1
271 Caption = "Last &open folder"
272 Height = 255
273 Index = 0
274 Left = 120
275 TabIndex = 18
276 Top = 240
277 Value = -1 'True
278 Width = 1575
279 End
280 Begin VB.OptionButton Option1
281 Caption = "A&pplication folder"
282 Height = 255
283 Index = 1
284 Left = 1680
285 TabIndex = 19
286 Top = 240
287 Width = 1695
288 End
289 Begin VB.OptionButton Option1
290 Caption = "&User-defined folder"
291 Height = 255
292 Index = 2
293 Left = 120
294 TabIndex = 20
295 Top = 480
296 Width = 1695
297 End
298 Begin VB.TextBox Text3
299 Enabled = 0 'False
300 Height = 285
301 Left = 120
302 TabIndex = 21
303 Top = 840
304 Width = 3615
305 End
306 Begin VB.CommandButton Command5
307 Caption = "&Folder..."
308 Enabled = 0 'False
309 Height = 285
310 Left = 3840
311 TabIndex = 22
312 Top = 840
313 Width = 975
314 End
315 End
316 End
317 Begin VB.PictureBox TabDisps
318 BorderStyle = 0 'None
319 Height = 3495
320 Index = 4
321 Left = 240
322 ScaleHeight = 3495
323 ScaleWidth = 4935
324 TabIndex = 43
325 TabStop = 0 'False
326 Top = 480
327 Visible = 0 'False
328 Width = 4935
329 Begin VB.ListBox Actions
330 Height = 1215
331 IntegralHeight = 0 'False
332 Left = 3120
333 TabIndex = 24
334 Top = 2280
335 Width = 1815
336 End
337 Begin MSComctlLib.ListView FileTypes
338 Height = 2535
339 Left = 0
340 TabIndex = 23
341 Top = 960
342 Width = 3015
343 _ExtentX = 5318
344 _ExtentY = 4471
345 View = 3
346 LabelEdit = 1
347 Sorted = -1 'True
348 MultiSelect = -1 'True
349 LabelWrap = -1 'True
350 HideSelection = -1 'True
351 _Version = 393217
352 ForeColor = -2147483640
353 BackColor = -2147483643
354 BorderStyle = 1
355 Appearance = 1
356 NumItems = 1
357 BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
358 Text = "Registered file types:"
359 Object.Width = 2540
360 EndProperty
361 End
362 Begin VB.Label Label9
363 AutoSize = -1 'True
364 Caption = "File extensions:"
365 Height = 195
366 Left = 3120
367 TabIndex = 50
368 Top = 960
369 Width = 1080
370 End
371 Begin VB.Label Label7
372 AutoSize = -1 'True
373 Caption = "Default action:"
374 Height = 195
375 Left = 3120
376 TabIndex = 48
377 Top = 2040
378 Width = 1035
379 End
380 Begin VB.Label Label8
381 Height = 855
382 Left = 3120
383 TabIndex = 49
384 Top = 1200
385 Width = 1755
386 End
387 Begin VB.Label Label6
388 AutoSize = -1 'True
389 Caption = $"Options.frx":00F6
390 Height = 855
391 Left = 0
392 TabIndex = 47
393 Top = 120
394 Width = 4935
395 WordWrap = -1 'True
396 End
397 End
398 Begin VB.PictureBox TabDisps
399 BorderStyle = 0 'None
400 Height = 3495
401 Index = 3
402 Left = 240
403 ScaleHeight = 3495
404 ScaleWidth = 4935
405 TabIndex = 42
406 TabStop = 0 'False
407 Top = 480
408 Visible = 0 'False
409 Width = 4935
410 Begin VB.ComboBox Combo3
411 Height = 315
412 ItemData = "Options.frx":01CE
413 Left = 2880
414 List = "Options.frx":01F3
415 Style = 2 'Dropdown List
416 TabIndex = 34
417 Top = 3120
418 Width = 1815
419 End
420 Begin VB.ComboBox Combo2
421 Height = 315
422 ItemData = "Options.frx":0245
423 Left = 1200
424 List = "Options.frx":024F
425 Style = 2 'Dropdown List
426 TabIndex = 33
427 Top = 3120
428 Width = 1455
429 End
430 Begin VB.ListBox List1
431 Height = 1815
432 ItemData = "Options.frx":0266
433 Left = 0
434 List = "Options.frx":0268
435 Sorted = -1 'True
436 TabIndex = 27
437 Top = 720
438 Width = 1575
439 End
440 Begin VB.TextBox Text4
441 Height = 285
442 Left = 0
443 TabIndex = 25
444 Top = 360
445 Width = 855
446 End
447 Begin VB.CommandButton cmdAdd
448 Caption = "&Add"
449 Height = 285
450 Left = 960
451 TabIndex = 26
452 Top = 360
453 Width = 615
454 End
455 Begin VB.CommandButton Command6
456 Caption = "&Remove"
457 Height = 255
458 Left = 0
459 TabIndex = 28
460 Top = 2640
461 Width = 1095
462 End
463 Begin VB.ComboBox Combo1
464 Enabled = 0 'False
465 Height = 315
466 ItemData = "Options.frx":026A
467 Left = 1800
468 List = "Options.frx":027A
469 Style = 2 'Dropdown List
470 TabIndex = 29
471 Top = 720
472 Width = 2535
473 End
474 Begin VB.Frame Frame2
475 Caption = "Audio Compression"
476 Height = 1335
477 Left = 1800
478 TabIndex = 44
479 Top = 1200
480 Visible = 0 'False
481 Width = 2535
482 Begin VB.OptionButton AudioC
483 Caption = "Medium"
484 Height = 255
485 Index = 0
486 Left = 120
487 TabIndex = 31
488 Top = 600
489 Value = -1 'True
490 Width = 2175
491 End
492 Begin VB.OptionButton AudioC
493 Caption = "Highest (Least space)"
494 Height = 255
495 Index = 1
496 Left = 120
497 TabIndex = 32
498 Top = 960
499 Width = 2175
500 End
501 Begin VB.OptionButton AudioC
502 Caption = "Lowest (Best quality)"
503 Height = 255
504 Index = 2
505 Left = 120
506 TabIndex = 30
507 Top = 240
508 Width = 2175
509 End
510 End
511 Begin VB.Label ZLibLabel
512 AutoSize = -1 'True
513 Caption = "Deflate Compression Level"
514 Height = 195
515 Left = 2880
516 TabIndex = 54
517 Top = 2880
518 Width = 1890
519 End
520 Begin VB.Label Label12
521 AutoSize = -1 'True
522 Caption = "Default Compression"
523 Height = 195
524 Left = 1200
525 TabIndex = 53
526 Top = 2880
527 Width = 1455
528 End
529 Begin VB.Label Label5
530 Caption = "Compression type"
531 Height = 255
532 Left = 1800
533 TabIndex = 46
534 Top = 480
535 Width = 1935
536 End
537 Begin VB.Label Label4
538 Caption = "File Extension"
539 Height = 255
540 Left = 0
541 TabIndex = 45
542 Top = 120
543 Width = 1215
544 End
545 End
546 Begin MSComctlLib.TabStrip Tabs
547 Height = 3975
548 Left = 120
549 TabIndex = 2
550 Top = 120
551 Width = 5175
552 _ExtentX = 9128
553 _ExtentY = 7011
554 HotTracking = -1 'True
555 _Version = 393216
556 BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
557 NumTabs = 5
558 BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
559 Caption = "General"
560 ImageVarType = 2
561 EndProperty
562 BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
563 Caption = "File Lists"
564 ImageVarType = 2
565 EndProperty
566 BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628}
567 Caption = "Compression Auto-Selection"
568 ImageVarType = 2
569 EndProperty
570 BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628}
571 Caption = "File Associations"
572 ImageVarType = 2
573 EndProperty
574 BeginProperty Tab5 {1EFB659A-857C-11D1-B16A-00C0F0283628}
575 Caption = "Other"
576 ImageVarType = 2
577 EndProperty
578 EndProperty
579 End
580 End
581 Attribute VB_Name = "Options"
582 Attribute VB_Creatable = False
583 Attribute VB_Exposed = False
584 Option Explicit
586 Dim OldFileName As String, NewListFile As String
587 Dim NewExtNames() As String, NewExtComp() As Integer
588 Dim ActID() As String
590 Private Sub Check8_Click()
591 If Check8.Value = 1 Then Check8.Value = 2
592 End Sub
593 Private Sub cmdAdd_Click()
594 Dim xNum As Integer
595 If Text4 <> "" Then
596 If Left(Text4, 1) <> "." Then Text4 = "." + Text4
597 For xNum = 1 To UBound(NewExtNames)
598 If Text4 = NewExtNames(xNum) Then Exit Sub
599 Next xNum
600 List1.AddItem Text4
601 ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
602 NewExtNames(UBound(NewExtNames)) = Text4
603 ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer
604 NewExtComp(UBound(NewExtComp)) = -1
605 Text4 = ""
606 End If
607 End Sub
609 Private Sub cmdAddFolder_Click()
610 Dim lNum As Long
611 Dim Path As String
612 PathInput.hwndOwner = hWnd
613 Path = PathInputBox(PathInput, "Add Listfile Folder", "")
614 If Path = "" Then GoTo Cancel
615 FileLists.AddItem Path
616 If FileLists.ListCount > 0 Then
617 NewListFile = FileLists.List(0)
618 Else
619 NewListFile = ""
620 End If
621 For lNum = 1 To FileLists.ListCount - 1
622 NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)
623 Next lNum
624 Cancel:
625 End Sub
626 Private Sub cmdAddList_Click()
627 Dim lNum As Long
628 CD.Flags = &H1000 Or &H4 Or &H2
629 CD.Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
630 CD.hwndOwner = hWnd
631 If ShowOpen(CD) = False Then GoTo Cancel
632 FileLists.AddItem CD.FileName
633 If FileLists.ListCount > 0 Then
634 NewListFile = FileLists.List(0)
635 Else
636 NewListFile = ""
637 End If
638 For lNum = 1 To FileLists.ListCount - 1
639 NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)
640 Next lNum
641 Cancel:
642 End Sub
643 Private Sub cmdDelList_Click()
644 Dim lNum As Long
645 If FileLists.ListIndex > -1 Then
646 FileLists.RemoveItem FileLists.ListIndex
647 If FileLists.ListCount > 0 Then
648 NewListFile = FileLists.List(0)
649 Else
650 NewListFile = ""
651 End If
652 For lNum = 1 To FileLists.ListCount - 1
653 NewListFile = NewListFile + vbCrLf + FileLists.List(lNum)
654 Next lNum
655 End If
656 End Sub
657 Private Sub Combo1_Click()
658 Dim xNum As Integer
659 For xNum = 1 To UBound(NewExtNames)
660 If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
661 Next xNum
662 If UBound(NewExtNames) = 0 Then xNum = 0
663 If Combo1.ListIndex = 3 Then
664 Frame2.Visible = True
665 NewExtComp(xNum) = Combo1.ListIndex - 3
666 Else
667 Frame2.Visible = False
668 If Combo1.ListIndex < 2 Then
669 NewExtComp(xNum) = Combo1.ListIndex - 2
670 Else
671 NewExtComp(xNum) = -3
672 End If
673 End If
674 End Sub
675 Private Sub AudioC_Click(Index As Integer)
676 Dim xNum As Integer
677 For xNum = 1 To UBound(NewExtNames)
678 If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
679 Next xNum
680 If UBound(NewExtNames) = 0 Then xNum = 0
681 NewExtComp(xNum) = Index
682 End Sub
683 Private Sub Check1_Click()
684 If Check1.Value = 1 Then Check1.Value = 2
685 End Sub
687 Private Sub Check2_Click()
688 If Check2.Value = 1 Then Check2.Value = 2
689 End Sub
691 Private Sub Check3_Click()
692 If Check3.Value = 1 Then Check3.Value = 2
693 End Sub
695 Private Sub Check4_Click()
696 If Check4.Value = 1 Then Check4.Value = 2
697 End Sub
699 Private Sub Check5_Click()
700 If Check5.Value = 1 Then Check5.Value = 2
701 End Sub
702 Private Sub Command1_Click()
703 Dim Path As String, BatKey As String
704 Dim xNum As Integer, ExtList As String
705 Dim dItem As String, ndItem As String, aNum As Long
706 Path = App.Path
707 If Right(Path, 1) <> "\" Then Path = Path + "\"
708 Text1_LostFocus
709 Text2_LostFocus
710 DefaultMaxFiles = Text1
711 DefaultBlockSize = Text5
712 LocaleID = Text2
713 SFileSetLocale (LocaleID)
714 NewKey AppKey
715 SetReg AppKey + "DefaultMaxFiles", Text1, REG_DWORD
716 SetReg AppKey + "DefaultBlockSize", Text5, REG_DWORD
717 SetReg AppKey + "LocaleID", Text2, REG_DWORD
718 If Check1.Value > 0 Then
719 SetReg AppKey + "SaveWindowStatus", 1, REG_DWORD
720 Else
721 SetReg AppKey + "SaveWindowStatus", 0, REG_DWORD
722 End If
723 If Check3.Value > 0 Then
724 SetReg AppKey + "ShowConfirmation", 1, REG_DWORD
725 Else
726 SetReg AppKey + "ShowConfirmation", 0, REG_DWORD
727 End If
728 If Check4.Value > 0 Then
729 SetReg AppKey + "UseDragDropWildcards", 1, REG_DWORD
730 Else
731 SetReg AppKey + "UseDragDropWildcards", 0, REG_DWORD
732 End If
733 If Check5.Value > 0 Then
734 SetReg AppKey + "CheckModDateTime", 1, REG_DWORD
735 Else
736 SetReg AppKey + "CheckModDateTime", 0, REG_DWORD
737 MpqEx.Timer1.Enabled = False
738 End If
739 If Check7.Value > 0 Then
740 SetReg AppKey + "AutofindFileLists", 1, REG_DWORD
741 Else
742 SetReg AppKey + "AutofindFileLists", 0, REG_DWORD
743 End If
744 If Check8.Value > 0 Then
745 SetReg AppKey + "UseOnlyAutofindLists", 1, REG_DWORD
746 Else
747 SetReg AppKey + "UseOnlyAutofindLists", 0, REG_DWORD
748 End If
749 If Check2.Value > 0 Then
750 NewKey "HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive"
751 NewKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"
752 SetReg "HKEY_CLASSES_ROOT\.mpq\ShellNew\NullFile", ""
753 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\", "MPQ Archive"
754 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\DefaultIcon\", Path + App.EXEName + ".exe,1"
755 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\"
756 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\"
757 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)
758 BatKey = "HKEY_CLASSES_ROOT\" + GetReg("HKEY_CLASSES_ROOT\.bat\", "batfile") + "\"
759 NewKey "HKEY_CLASSES_ROOT\.mscript\", "Mpq.Script"
760 NewKey "HKEY_CLASSES_ROOT\.mbat\", "Mpq.Script"
761 NewKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"
762 SetReg "HKEY_CLASSES_ROOT\.mscript\ShellNew\NullFile", ""
763 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\", "Mo'PaQ 2000 Script"
764 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\DefaultIcon\", GetReg(BatKey + "DefaultIcon\", "C:\WINDOWS\SYSTEM\shell32.dll,-153")
765 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"
766 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\"
767 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\command\", GetReg(BatKey + "shell\edit\command\", "C:\WINDOWS\NOTEPAD.EXE %1")
768 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"
769 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\", "&Run"
770 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " script " + Chr(34) + "%1" + Chr(34)
771 Else
772 If GetReg("HKEY_CLASSES_ROOT\.mpq\") = "Mpq.Archive" Then
773 DelKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"
774 DelKey "HKEY_CLASSES_ROOT\.mpq\"
775 SetReg "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", "not used"
776 DelKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"
777 DelKey "HKEY_CLASSES_ROOT\.mscript\"
778 DelKey "HKEY_CLASSES_ROOT\.mbat\"
779 End If
780 End If
781 SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, vbNullString, vbNullString
782 If Option1(0).Value = True Then
783 SetReg AppKey + "StartupPathType", 0, REG_DWORD
784 Text3 = CurDir
785 ElseIf Option1(1).Value = True Then
786 SetReg AppKey + "StartupPathType", 1, REG_DWORD
787 Text3 = App.Path
788 ElseIf Option1(2).Value = True Then
789 SetReg AppKey + "StartupPathType", 2, REG_DWORD
790 End If
791 Path = Text3
792 If Right(Path, 1) <> "\" Then Path = Path + "\"
793 If IsDir(Path) Then
794 SetReg AppKey + "StartupPath", Text3
795 ChDir Text3
796 End If
797 Select Case Combo2.ListIndex
798 Case 0
799 DefaultCompressID = -1
800 DefaultCompress = MAFA_COMPRESS_STANDARD
801 Case 1
802 DefaultCompressID = -3
803 DefaultCompress = MAFA_COMPRESS_DEFLATE
804 End Select
805 DefaultCompressLevel = Combo3.ListIndex - 1
806 SetReg AppKey + "DefaultCompress", DefaultCompressID, REG_DWORD
807 SetReg AppKey + "DefaultZlibLevel", DefaultCompressLevel, REG_DWORD
808 DelKey AppKey + "Compression\"
809 NewKey AppKey + "Compression\"
810 For xNum = 1 To UBound(NewExtNames)
811 ExtList = ExtList + NewExtNames(xNum)
812 SetReg AppKey + "Compression\" + NewExtNames(xNum), CStr(NewExtComp(xNum))
813 Next xNum
814 SetReg AppKey + "Compression\List", ExtList
815 NewKey SharedAppKey + "FileDefaultActions\"
816 For aNum = 1 To FileTypes.ListItems.Count
817 dItem = GetReg("HKEY_CLASSES_ROOT\" + FileTypes.ListItems.Item(aNum).Key + "\shell\", "open")
818 dItem = GetReg(SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, dItem)
819 ndItem = FileTypes.ListItems.Item(aNum).Tag
820 If LCase(dItem) <> LCase(ndItem) And ndItem <> "" Then
821 SetReg SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, ndItem
822 End If
823 Next aNum
824 Hide
825 If LCase(ListFile) <> LCase(NewListFile) Then
826 ListFile = NewListFile
827 SetReg AppKey + "ListFile", ListFile
828 CD.FileName = OldFileName
829 If FileExists(OldFileName) Then MpqEx.OpenMpq
830 End If
831 Unload Me
832 End Sub
833 Private Sub Command2_Click()
834 Unload Me
835 End Sub
836 Private Sub Command4_Click()
837 DelReg AppKey + "Status\WindowState"
838 DelReg AppKey + "Status\WindowHeight"
839 DelReg AppKey + "Status\WindowLeft"
840 DelReg AppKey + "Status\WindowTop"
841 DelReg AppKey + "Status\WindowWidth"
842 Check1.Value = 0
843 End Sub
844 Private Sub Command5_Click()
845 Dim Path As String
846 PathInput.hwndOwner = hWnd
847 Path = PathInputBox(PathInput, "WinMPQ Startup Path", Text3)
848 If Path <> "" Then Text3 = Path
849 End Sub
850 Private Sub Command6_Click()
851 Dim xNum As Integer
852 If List1.ListIndex > -1 Then
853 For xNum = 1 To UBound(NewExtNames)
854 If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
855 Next xNum
856 If xNum < UBound(NewExtNames) Then
857 For xNum = xNum To UBound(NewExtNames) - 1
858 NewExtNames(xNum) = NewExtNames(xNum + 1)
859 NewExtComp(xNum) = NewExtComp(xNum + 1)
860 Next xNum
861 End If
862 ReDim Preserve NewExtNames(UBound(NewExtNames) - 1) As String
863 ReDim Preserve NewExtComp(UBound(NewExtComp) - 1) As Integer
864 On Error Resume Next
865 List1.RemoveItem List1.ListIndex
866 End If
867 End Sub
868 Private Sub Form_Load()
869 Dim Path As String, PathType As Integer, NewFileListNames As String
870 Dim ExtList As String
871 Dim aExt As String, aName As String, aNum As Long, DCompType As Long
872 On Error Resume Next
873 Left = MpqEx.Left + 330
874 If Left < 0 Then Left = 0
875 If Left + Width > Screen.Width Then Left = Screen.Width - Width
876 Top = MpqEx.Top + 315
877 If Top < 0 Then Top = 0
878 If Top + Height > Screen.Height Then Top = Screen.Height - Height
879 Path = App.Path
880 If Right(Path, 1) <> "\" Then Path = Path + "\"
881 Text1 = DefaultMaxFiles
882 Text5 = DefaultBlockSize
883 Text2 = LocaleID
884 OldFileName = CD.FileName
885 CD.FileName = ""
886 NewListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
887 For aNum = 1 To Len(NewListFile)
888 If InStr(aNum, NewListFile, vbCrLf) Then
889 aName = Mid(NewListFile, aNum, InStr(aNum, NewListFile, vbCrLf) - aNum)
890 If FileExists(aName) Or IsDir(aName) Then
891 FileLists.AddItem aName
892 NewFileListNames = NewFileListNames + aName + vbCrLf
893 End If
894 aNum = InStr(aNum, NewListFile, vbCrLf) + 1
895 Else
896 aName = Mid(NewListFile, aNum)
897 If FileExists(aName) Or IsDir(aName) Then
898 FileLists.AddItem aName
899 NewFileListNames = NewFileListNames + aName
900 End If
901 Exit For
902 End If
903 Next aNum
904 NewListFile = NewFileListNames
905 If Right(NewListFile, 2) = vbCrLf Then NewListFile = Left(NewListFile, Len(NewListFile) - 2)
906 If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then Check1.Value = 1 Else Check1.Value = 0
907 If GetReg(AppKey + "ShowConfirmation", 1) > 0 Then Check3.Value = 1 Else Check3.Value = 0
908 If GetReg(AppKey + "UseDragDropWildcards", 1) > 0 Then Check4.Value = 1 Else Check4.Value = 0
909 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Check5.Value = 1 Else Check5.Value = 0
910 If GetReg(AppKey + "AutofindFileLists", 0) > 0 Then Check7.Value = 1 Else Check7.Value = 0
911 If GetReg(AppKey + "UseOnlyAutofindLists", 1) > 0 Then Check8.Value = 1 Else Check8.Value = 0
912 If GetReg("HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive") = "Mpq.Archive" And InStr(1, GetReg("HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)), App.EXEName + ".exe", 1) > 0 Then Check2.Value = 1 Else Check2.Value = 0
913 Text3 = GetReg(AppKey + "StartupPath", CurDir)
914 PathType = GetReg(AppKey + "StartupPathType", 0)
915 If PathType < 0 Then PathType = 0
916 If PathType > 2 Then PathType = 2
917 Option1(PathType).Value = True
918 If PathType = 0 Then
919 Text3 = CurDir
920 ElseIf PathType = 1 Then
921 Text3 = App.Path
922 End If
923 ReDim NewExtNames(0) As String
924 ReDim NewExtComp(0) As Integer
925 Combo1.ListIndex = 1
926 DCompType = GetReg(AppKey + "DefaultCompress", -1)
927 Select Case DCompType
928 Case -3
929 Combo2.ListIndex = 1
930 Case Else
931 Combo2.ListIndex = 0
932 End Select
933 Combo3.ListIndex = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION) + 1
934 ExtList = GetReg(AppKey + "Compression\List", ".bik.smk.mp3.mpq.w3m.wav")
935 If InStr(1, ExtList, ".") > 0 And Len(ExtList) > 1 Then
936 Do
937 ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
938 ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer
939 If InStr(2, ExtList, ".") > 0 Then
940 NewExtNames(UBound(NewExtNames)) = Left(ExtList, InStr(2, ExtList, ".") - 1)
941 Else
942 NewExtNames(UBound(NewExtNames)) = ExtList
943 End If
944 ExtList = Mid(ExtList, Len(NewExtNames(UBound(NewExtNames))) + 1)
945 List1.AddItem NewExtNames(UBound(NewExtNames))
946 If LCase(NewExtNames(UBound(NewExtNames))) = ".bik" Then
947 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
948 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".smk" Then
949 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
950 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mp3" Then
951 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))
952 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mpq" Then
953 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))
954 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3m" Then
955 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))
956 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".wav" Then
957 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.wav", "0"))
958 Else
959 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\" + NewExtNames(UBound(NewExtNames)), "-1"))
960 End If
961 Loop Until ExtList = ""
962 End If
963 Do
964 aExt = EnumKey("HKEY_CLASSES_ROOT\", aNum)
965 If Left(aExt, 1) = "." Then
966 aName = GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")
967 If aName <> "" Then
968 On Error GoTo AlreadyExists
969 FileTypes.ListItems.Add(, aName, GetReg("HKEY_CLASSES_ROOT\" + aName + "\", UCase(Mid(aExt, 2)) + " File")).ToolTipText = UCase(aExt)
970 On Error Resume Next
971 End If
972 ElseIf LCase(aExt) = "*" Then
973 FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
974 If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " All Files"
975 ElseIf LCase(aExt) = "unknown" Then
976 FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
977 If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " Unknown File"
978 End If
979 aNum = aNum + 1
980 Loop Until aExt = ""
981 Exit Sub
982 AlreadyExists:
983 FileTypes.ListItems.Item(aName).ToolTipText = FileTypes.ListItems.Item(aName).ToolTipText + " " + UCase(aExt)
984 Resume Next
985 End Sub
986 Private Sub Form_Resize()
987 FileTypes.ColumnHeaders.Item(1).Width = FileTypes.Width - 30 * Screen.TwipsPerPixelX
988 End Sub
990 Private Sub Form_Unload(Cancel As Integer)
991 CD.FileName = OldFileName
992 End Sub
993 Private Sub List1_Click()
994 Dim xNum As Integer, OldExtComp As Integer
995 If List1.ListIndex > -1 Then
996 Combo1.Enabled = True
997 For xNum = 1 To UBound(NewExtNames)
998 If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
999 Next xNum
1000 Select Case NewExtComp(xNum)
1001 Case -2
1002 AudioC(0).Value = True
1003 Combo1.ListIndex = 0
1004 Case -1
1005 AudioC(0).Value = True
1006 Combo1.ListIndex = 1
1007 Case -3
1008 AudioC(0).Value = True
1009 Combo1.ListIndex = 2
1010 Case 0, 1, 2
1011 OldExtComp = NewExtComp(xNum)
1012 Combo1.ListIndex = 3
1013 AudioC(OldExtComp).Value = True
1014 Case Else
1015 AudioC(0).Value = True
1016 Combo1.ListIndex = 1
1017 End Select
1018 Else
1019 Combo1.ListIndex = 1
1020 Combo1.Enabled = False
1021 End If
1022 End Sub
1023 Private Sub Option1_Click(Index As Integer)
1024 If Index = 2 Then
1025 Text3.Enabled = True
1026 Command5.Enabled = True
1027 Else
1028 Text3.Enabled = False
1029 Command5.Enabled = False
1030 End If
1031 End Sub
1032 Private Sub Tabs_Click()
1033 Dim TabDisp As PictureBox
1034 For Each TabDisp In TabDisps
1035 TabDisp.Visible = False
1036 Next TabDisp
1037 TabDisps(Tabs.SelectedItem.Index).Visible = True
1038 End Sub
1039 Private Sub Text1_KeyPress(KeyAscii As Integer)
1040 If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
1041 End Sub
1043 Private Sub Text5_Change()
1044 On Error Resume Next
1045 If Text5 <> "" Then
1046 If Text5 > 23 Then Text5 = 23
1047 If Text5 <= 23 Then _
1048 ActualBlockSize = CStr((512 * 2 ^ Text5) / 1024) + " KB"
1049 Else
1050 ActualBlockSize = ""
1051 End If
1052 On Error GoTo 0
1053 End Sub
1054 Private Sub Text5_KeyPress(KeyAscii As Integer)
1055 If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
1056 End Sub
1057 Private Sub Text1_LostFocus()
1058 If Text1 = "" Then Text1 = 0
1059 'If Text1 < 16 Then Text1 = 16
1060 'If Text1 > 262144 Then Text1 = 262144
1061 End Sub
1062 Private Sub Text5_LostFocus()
1063 If Text5 = "" Then Text5 = DEFAULT_BLOCK_SIZE
1064 If Text5 > 23 Then Text5 = 23
1065 End Sub
1066 Private Sub Text2_KeyPress(KeyAscii As Integer)
1067 Dim NewValue As Long
1068 If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> Asc("-") Then KeyAscii = 0
1069 On Error GoTo TooBig
1070 If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = Asc("-") Then NewValue = CLng(Text2 + Chr(KeyAscii))
1071 On Error GoTo 0
1072 Exit Sub
1073 TooBig:
1074 KeyAscii = 0
1075 End Sub
1076 Private Sub Text2_LostFocus()
1077 If Text2 = "" Then Text2 = 0
1078 End Sub
1079 Private Sub Text4_GotFocus()
1080 cmdAdd.Default = True
1081 End Sub
1082 Private Sub Text4_LostFocus()
1083 Command1.Default = True
1084 End Sub
1085 Private Sub Actions_Click()
1086 On Error GoTo NotSelected
1087 FileTypes.SelectedItem.Tag = FileTypes.SelectedItem.Tag
1088 On Error GoTo 0
1089 If FileTypes.SelectedItem.Selected = True Then
1090 FileTypes.SelectedItem.Tag = ActID(Actions.ListIndex + 1)
1091 End If
1092 NotSelected:
1093 End Sub
1094 Private Sub FileTypes_ItemClick(ByVal Item As ListItem)
1095 Dim aNum As Long, aItem As String, aName As String, bNum As Long, dItem As String
1096 Label8 = Item.ToolTipText
1097 Actions.Clear
1098 ReDim ActID(0) As String
1099 aName = Item.Key
1100 Do
1101 aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)
1102 If aItem <> "" Then
1103 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
1104 Actions.AddItem "Open with..."
1105 Else
1106 Actions.AddItem GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", UCase(Left(aItem, 1)) + Mid(aItem, 2))
1107 End If
1108 ReDim Preserve ActID(UBound(ActID) + 1) As String
1109 ActID(UBound(ActID)) = aItem
1110 aNum = aNum + 1
1111 End If
1112 Loop Until aItem = ""
1113 If Item.Tag = "" Then
1114 dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")
1115 dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)
1116 Else
1117 dItem = Item.Tag
1118 End If
1119 If Actions.ListCount > 0 Then Actions.ListIndex = 0
1120 For bNum = 0 To Actions.ListCount - 1
1121 If LCase(ActID(bNum + 1)) = LCase(dItem) Then
1122 Actions.ListIndex = bNum
1123 End If
1124 Next bNum
1125 Item.Tag = dItem
1126 End Sub
|