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 = 1665
7 ClientTop = 2085
8 ClientWidth = 5415
9 Height = 5100
10 Icon = "Options.frx":0000
11 KeyPreview = -1 'True
12 Left = 1605
13 LinkTopic = "Form1"
14 MaxButton = 0 'False
15 MinButton = 0 'False
16 ScaleHeight = 4695
17 ScaleWidth = 5415
18 ShowInTaskbar = 0 'False
19 Top = 1740
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":0252
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":0270
433 Left = 0
434 List = "Options.frx":0272
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":0274
467 Left = 1800
468 List = "Options.frx":0287
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 If Combo1.ListIndex = 2 Then
672 NewExtComp(xNum) = -3
673 Else
674 NewExtComp(xNum) = -4
675 End If
676 End If
677 End If
678 End Sub
679 Private Sub AudioC_Click(Index As Integer)
680 Dim xNum As Integer
681 For xNum = 1 To UBound(NewExtNames)
682 If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
683 Next xNum
684 If UBound(NewExtNames) = 0 Then xNum = 0
685 NewExtComp(xNum) = Index
686 End Sub
687 Private Sub Check1_Click()
688 If Check1.Value = 1 Then Check1.Value = 2
689 End Sub
691 Private Sub Check2_Click()
692 If Check2.Value = 1 Then Check2.Value = 2
693 End Sub
695 Private Sub Check3_Click()
696 If Check3.Value = 1 Then Check3.Value = 2
697 End Sub
699 Private Sub Check4_Click()
700 If Check4.Value = 1 Then Check4.Value = 2
701 End Sub
703 Private Sub Check5_Click()
704 If Check5.Value = 1 Then Check5.Value = 2
705 End Sub
706 Private Sub Command1_Click()
707 Dim Path As String, BatKey As String
708 Dim xNum As Integer, ExtList As String
709 Dim dItem As String, ndItem As String, aNum As Long
710 Path = App.Path
711 If Right(Path, 1) <> "\" Then Path = Path + "\"
712 Text1_LostFocus
713 Text2_LostFocus
714 DefaultMaxFiles = Text1
715 DefaultBlockSize = Text5
716 LocaleID = Text2
717 SFileSetLocale (LocaleID)
718 NewKey AppKey
719 SetReg AppKey + "DefaultMaxFiles", Text1, REG_DWORD
720 SetReg AppKey + "DefaultBlockSize", Text5, REG_DWORD
721 SetReg AppKey + "LocaleID", Text2, REG_DWORD
722 If Check1.Value > 0 Then
723 SetReg AppKey + "SaveWindowStatus", 1, REG_DWORD
724 Else
725 SetReg AppKey + "SaveWindowStatus", 0, REG_DWORD
726 End If
727 If Check3.Value > 0 Then
728 SetReg AppKey + "ShowConfirmation", 1, REG_DWORD
729 Else
730 SetReg AppKey + "ShowConfirmation", 0, REG_DWORD
731 End If
732 If Check4.Value > 0 Then
733 SetReg AppKey + "UseDragDropWildcards", 1, REG_DWORD
734 Else
735 SetReg AppKey + "UseDragDropWildcards", 0, REG_DWORD
736 End If
737 If Check5.Value > 0 Then
738 SetReg AppKey + "CheckModDateTime", 1, REG_DWORD
739 Else
740 SetReg AppKey + "CheckModDateTime", 0, REG_DWORD
741 MpqEx.Timer1.Enabled = False
742 End If
743 If Check7.Value > 0 Then
744 SetReg AppKey + "AutofindFileLists", 1, REG_DWORD
745 Else
746 SetReg AppKey + "AutofindFileLists", 0, REG_DWORD
747 End If
748 If Check8.Value > 0 Then
749 SetReg AppKey + "UseOnlyAutofindLists", 1, REG_DWORD
750 Else
751 SetReg AppKey + "UseOnlyAutofindLists", 0, REG_DWORD
752 End If
753 If Check2.Value > 0 Then
754 NewKey "HKEY_CLASSES_ROOT\.mpq\", "Mpq.Archive"
755 NewKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"
756 SetReg "HKEY_CLASSES_ROOT\.mpq\ShellNew\NullFile", ""
757 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\", "MPQ Archive"
758 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\DefaultIcon\", Path + App.EXEName + ".exe,1"
759 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\"
760 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\"
761 NewKey "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " " + Chr(34) + "%1" + Chr(34)
762 BatKey = "HKEY_CLASSES_ROOT\" + GetReg("HKEY_CLASSES_ROOT\.bat\", "batfile") + "\"
763 NewKey "HKEY_CLASSES_ROOT\.mscript\", "Mpq.Script"
764 NewKey "HKEY_CLASSES_ROOT\.mbat\", "Mpq.Script"
765 NewKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"
766 SetReg "HKEY_CLASSES_ROOT\.mscript\ShellNew\NullFile", ""
767 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\", "Mo'PaQ 2000 Script"
768 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\DefaultIcon\", GetReg(BatKey + "DefaultIcon\", "C:\WINDOWS\SYSTEM\shell32.dll,-153")
769 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"
770 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\"
771 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\open\command\", GetReg(BatKey + "shell\edit\command\", "C:\WINDOWS\NOTEPAD.EXE %1")
772 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\"
773 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\", "&Run"
774 NewKey "HKEY_CLASSES_ROOT\Mpq.Script\shell\run\command\", Chr(34) + Path + App.EXEName + ".exe" + Chr(34) + " script " + Chr(34) + "%1" + Chr(34)
775 Else
776 If GetReg("HKEY_CLASSES_ROOT\.mpq\") = "Mpq.Archive" Then
777 DelKey "HKEY_CLASSES_ROOT\.mpq\ShellNew\"
778 DelKey "HKEY_CLASSES_ROOT\.mpq\"
779 SetReg "HKEY_CLASSES_ROOT\Mpq.Archive\shell\open\command\", "not used"
780 DelKey "HKEY_CLASSES_ROOT\.mscript\ShellNew\"
781 DelKey "HKEY_CLASSES_ROOT\.mscript\"
782 DelKey "HKEY_CLASSES_ROOT\.mbat\"
783 End If
784 End If
785 SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, vbNullString, vbNullString
786 If Option1(0).Value = True Then
787 SetReg AppKey + "StartupPathType", 0, REG_DWORD
788 Text3 = CurDir
789 ElseIf Option1(1).Value = True Then
790 SetReg AppKey + "StartupPathType", 1, REG_DWORD
791 Text3 = App.Path
792 ElseIf Option1(2).Value = True Then
793 SetReg AppKey + "StartupPathType", 2, REG_DWORD
794 End If
795 Path = Text3
796 If Right(Path, 1) <> "\" Then Path = Path + "\"
797 If IsDir(Path) Then
798 SetReg AppKey + "StartupPath", Text3
799 ChDir Text3
800 End If
801 Select Case Combo2.ListIndex
802 Case 0
803 DefaultCompressID = -1
804 DefaultCompress = MAFA_COMPRESS_STANDARD
805 Case 1
806 DefaultCompressID = -3
807 DefaultCompress = MAFA_COMPRESS_DEFLATE
808 Case 2
809 DefaultCompressID = -4
810 DefaultCompress = MAFA_COMPRESS_BZIP2
811 End Select
812 DefaultCompressLevel = Combo3.ListIndex - 1
813 SetReg AppKey + "DefaultCompress", DefaultCompressID, REG_DWORD
814 SetReg AppKey + "DefaultZlibLevel", DefaultCompressLevel, REG_DWORD
815 DelKey AppKey + "Compression\"
816 NewKey AppKey + "Compression\"
817 For xNum = 1 To UBound(NewExtNames)
818 ExtList = ExtList + NewExtNames(xNum)
819 SetReg AppKey + "Compression\" + NewExtNames(xNum), CStr(NewExtComp(xNum))
820 Next xNum
821 SetReg AppKey + "Compression\List", ExtList
822 NewKey SharedAppKey + "FileDefaultActions\"
823 For aNum = 1 To FileTypes.ListItems.Count
824 dItem = GetReg("HKEY_CLASSES_ROOT\" + FileTypes.ListItems.Item(aNum).Key + "\shell\", "open")
825 dItem = GetReg(SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, dItem)
826 ndItem = FileTypes.ListItems.Item(aNum).Tag
827 If LCase(dItem) <> LCase(ndItem) And ndItem <> "" Then
828 SetReg SharedAppKey + "FileDefaultActions\" + FileTypes.ListItems.Item(aNum).Key, ndItem
829 End If
830 Next aNum
831 Hide
832 If LCase(ListFile) <> LCase(NewListFile) Then
833 ListFile = NewListFile
834 SetReg AppKey + "ListFile", ListFile
835 CD.FileName = OldFileName
836 If FileExists(OldFileName) Then MpqEx.OpenMpq
837 End If
838 Unload Me
839 End Sub
840 Private Sub Command2_Click()
841 Unload Me
842 End Sub
843 Private Sub Command4_Click()
844 DelReg AppKey + "Status\WindowState"
845 DelReg AppKey + "Status\WindowHeight"
846 DelReg AppKey + "Status\WindowLeft"
847 DelReg AppKey + "Status\WindowTop"
848 DelReg AppKey + "Status\WindowWidth"
849 Check1.Value = 0
850 End Sub
851 Private Sub Command5_Click()
852 Dim Path As String
853 PathInput.hwndOwner = hWnd
854 Path = PathInputBox(PathInput, "WinMPQ Startup Path", Text3)
855 If Path <> "" Then Text3 = Path
856 End Sub
857 Private Sub Command6_Click()
858 Dim xNum As Integer
859 If List1.ListIndex > -1 Then
860 For xNum = 1 To UBound(NewExtNames)
861 If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
862 Next xNum
863 If xNum < UBound(NewExtNames) Then
864 For xNum = xNum To UBound(NewExtNames) - 1
865 NewExtNames(xNum) = NewExtNames(xNum + 1)
866 NewExtComp(xNum) = NewExtComp(xNum + 1)
867 Next xNum
868 End If
869 ReDim Preserve NewExtNames(UBound(NewExtNames) - 1) As String
870 ReDim Preserve NewExtComp(UBound(NewExtComp) - 1) As Integer
871 On Error Resume Next
872 List1.RemoveItem List1.ListIndex
873 End If
874 End Sub
875 Private Sub Form_Load()
876 Dim Path As String, PathType As Integer, NewFileListNames As String
877 Dim ExtList As String
878 Dim aExt As String, aName As String, aNum As Long, DCompType As Long
879 On Error Resume Next
880 Left = MpqEx.Left + 330
881 If Left < 0 Then Left = 0
882 If Left + Width > Screen.Width Then Left = Screen.Width - Width
883 Top = MpqEx.Top + 315
884 If Top < 0 Then Top = 0
885 If Top + Height > Screen.Height Then Top = Screen.Height - Height
886 Path = App.Path
887 If Right(Path, 1) <> "\" Then Path = Path + "\"
888 Text1 = DefaultMaxFiles
889 Text5 = DefaultBlockSize
890 Text2 = LocaleID
891 OldFileName = CD.FileName
892 CD.FileName = ""
893 NewListFile = GetReg(AppKey + "ListFile", Path + "mpq_data.txt")
894 For aNum = 1 To Len(NewListFile)
895 If InStr(aNum, NewListFile, vbCrLf) Then
896 aName = Mid(NewListFile, aNum, InStr(aNum, NewListFile, vbCrLf) - aNum)
897 If FileExists(aName) Or IsDir(aName) Then
898 FileLists.AddItem aName
899 NewFileListNames = NewFileListNames + aName + vbCrLf
900 End If
901 aNum = InStr(aNum, NewListFile, vbCrLf) + 1
902 Else
903 aName = Mid(NewListFile, aNum)
904 If FileExists(aName) Or IsDir(aName) Then
905 FileLists.AddItem aName
906 NewFileListNames = NewFileListNames + aName
907 End If
908 Exit For
909 End If
910 Next aNum
911 NewListFile = NewFileListNames
912 If Right(NewListFile, 2) = vbCrLf Then NewListFile = Left(NewListFile, Len(NewListFile) - 2)
913 If GetReg(AppKey + "SaveWindowStatus", 1) > 0 Then Check1.Value = 1 Else Check1.Value = 0
914 If GetReg(AppKey + "ShowConfirmation", 1) > 0 Then Check3.Value = 1 Else Check3.Value = 0
915 If GetReg(AppKey + "UseDragDropWildcards", 1) > 0 Then Check4.Value = 1 Else Check4.Value = 0
916 If GetReg(AppKey + "CheckModDateTime", 1) > 0 Then Check5.Value = 1 Else Check5.Value = 0
917 If GetReg(AppKey + "AutofindFileLists", 0) > 0 Then Check7.Value = 1 Else Check7.Value = 0
918 If GetReg(AppKey + "UseOnlyAutofindLists", 1) > 0 Then Check8.Value = 1 Else Check8.Value = 0
919 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
920 Text3 = GetReg(AppKey + "StartupPath", CurDir)
921 PathType = GetReg(AppKey + "StartupPathType", 0)
922 If PathType < 0 Then PathType = 0
923 If PathType > 2 Then PathType = 2
924 Option1(PathType).Value = True
925 If PathType = 0 Then
926 Text3 = CurDir
927 ElseIf PathType = 1 Then
928 Text3 = App.Path
929 End If
930 ReDim NewExtNames(0) As String
931 ReDim NewExtComp(0) As Integer
932 Combo1.ListIndex = 1
933 DCompType = GetReg(AppKey + "DefaultCompress", -1)
934 Select Case DCompType
935 Case -3
936 Combo2.ListIndex = 1
937 Case -4
938 Combo2.ListIndex = 2
939 Case Else
940 Combo2.ListIndex = 0
941 End Select
942 Combo3.ListIndex = GetReg(AppKey + "DefaultZlibLevel", Z_DEFAULT_COMPRESSION) + 1
943 ExtList = GetReg(AppKey + "Compression\List", ".bik.smk.mp3.mpq.scm.scx.w3m.w3x.wav")
944 If InStr(1, ExtList, ".") > 0 And Len(ExtList) > 1 Then
945 Do
946 ReDim Preserve NewExtNames(UBound(NewExtNames) + 1) As String
947 ReDim Preserve NewExtComp(UBound(NewExtComp) + 1) As Integer
948 If InStr(2, ExtList, ".") > 0 Then
949 NewExtNames(UBound(NewExtNames)) = Left(ExtList, InStr(2, ExtList, ".") - 1)
950 Else
951 NewExtNames(UBound(NewExtNames)) = ExtList
952 End If
953 ExtList = Mid(ExtList, Len(NewExtNames(UBound(NewExtNames))) + 1)
954 List1.AddItem NewExtNames(UBound(NewExtNames))
955 If LCase(NewExtNames(UBound(NewExtNames))) = ".bik" Then
956 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.bik", "-2"))
957 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".smk" Then
958 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.smk", "-2"))
959 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mp3" Then
960 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mp3", "-2"))
961 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".mpq" Then
962 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.mpq", "-2"))
963 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".scm" Then
964 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.scm", "-2"))
965 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".scx" Then
966 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.scx", "-2"))
967 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3m" Then
968 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3m", "-2"))
969 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".w3x" Then
970 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.w3x", "-2"))
971 ElseIf LCase(NewExtNames(UBound(NewExtNames))) = ".wav" Then
972 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\.wav", "0"))
973 Else
974 NewExtComp(UBound(NewExtComp)) = CInt(GetReg(AppKey + "Compression\" + NewExtNames(UBound(NewExtNames)), "-1"))
975 End If
976 Loop Until ExtList = ""
977 End If
978 Do
979 aExt = EnumKey("HKEY_CLASSES_ROOT\", aNum)
980 If Left(aExt, 1) = "." Then
981 aName = GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")
982 If aName <> "" Then
983 On Error GoTo AlreadyExists
984 FileTypes.ListItems.Add(, aName, GetReg("HKEY_CLASSES_ROOT\" + aName + "\", UCase(Mid(aExt, 2)) + " File")).ToolTipText = UCase(aExt)
985 On Error Resume Next
986 End If
987 ElseIf LCase(aExt) = "*" Then
988 FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
989 If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " All Files"
990 ElseIf LCase(aExt) = "unknown" Then
991 FileTypes.ListItems.Add(, aExt, GetReg("HKEY_CLASSES_ROOT\" + aExt + "\")).ToolTipText = ""
992 If FileTypes.ListItems.Item(aExt).Text = "" Then FileTypes.ListItems.Item(aExt).Text = " Unknown File"
993 End If
994 aNum = aNum + 1
995 Loop Until aExt = ""
996 Exit Sub
997 AlreadyExists:
998 FileTypes.ListItems.Item(aName).ToolTipText = FileTypes.ListItems.Item(aName).ToolTipText + " " + UCase(aExt)
999 Resume Next
1000 End Sub
1001 Private Sub Form_Resize()
1002 FileTypes.ColumnHeaders.Item(1).Width = FileTypes.Width - 30 * Screen.TwipsPerPixelX
1003 End Sub
1005 Private Sub Form_Unload(Cancel As Integer)
1006 CD.FileName = OldFileName
1007 End Sub
1008 Private Sub List1_Click()
1009 Dim xNum As Integer, OldExtComp As Integer
1010 If List1.ListIndex > -1 Then
1011 Combo1.Enabled = True
1012 For xNum = 1 To UBound(NewExtNames)
1013 If List1.List(List1.ListIndex) = NewExtNames(xNum) Then Exit For
1014 Next xNum
1015 Select Case NewExtComp(xNum)
1016 Case -2
1017 AudioC(0).Value = True
1018 Combo1.ListIndex = 0
1019 Case -1
1020 AudioC(0).Value = True
1021 Combo1.ListIndex = 1
1022 Case -3
1023 AudioC(0).Value = True
1024 Combo1.ListIndex = 2
1025 Case -4
1026 AudioC(0).Value = True
1027 Combo1.ListIndex = 4
1028 Case 0, 1, 2
1029 OldExtComp = NewExtComp(xNum)
1030 Combo1.ListIndex = 3
1031 AudioC(OldExtComp).Value = True
1032 Case Else
1033 AudioC(0).Value = True
1034 Combo1.ListIndex = 1
1035 End Select
1036 Else
1037 Combo1.ListIndex = 1
1038 Combo1.Enabled = False
1039 End If
1040 End Sub
1041 Private Sub Option1_Click(Index As Integer)
1042 If Index = 2 Then
1043 Text3.Enabled = True
1044 Command5.Enabled = True
1045 Else
1046 Text3.Enabled = False
1047 Command5.Enabled = False
1048 End If
1049 End Sub
1050 Private Sub Tabs_Click()
1051 Dim TabDisp As PictureBox
1052 For Each TabDisp In TabDisps
1053 TabDisp.Visible = False
1054 Next TabDisp
1055 TabDisps(Tabs.SelectedItem.Index).Visible = True
1056 End Sub
1057 Private Sub Text1_KeyPress(KeyAscii As Integer)
1058 If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
1059 End Sub
1061 Private Sub Text5_Change()
1062 On Error Resume Next
1063 If Text5 <> "" Then
1064 If Text5 > 23 Then Text5 = 23
1065 If Text5 <= 23 Then _
1066 ActualBlockSize = CStr((512 * 2 ^ Text5) / 1024) + " KB"
1067 Else
1068 ActualBlockSize = ""
1069 End If
1070 On Error GoTo 0
1071 End Sub
1072 Private Sub Text5_KeyPress(KeyAscii As Integer)
1073 If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
1074 End Sub
1075 Private Sub Text1_LostFocus()
1076 If Text1 = "" Then Text1 = 0
1077 'If Text1 < 16 Then Text1 = 16
1078 'If Text1 > 262144 Then Text1 = 262144
1079 End Sub
1080 Private Sub Text5_LostFocus()
1081 If Text5 = "" Then Text5 = DEFAULT_BLOCK_SIZE
1082 If Text5 > 23 Then Text5 = 23
1083 End Sub
1084 Private Sub Text2_KeyPress(KeyAscii As Integer)
1085 Dim NewValue As Long
1086 If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> Asc("-") Then KeyAscii = 0
1087 On Error GoTo TooBig
1088 If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = Asc("-") Then NewValue = CLng(Text2 + Chr(KeyAscii))
1089 On Error GoTo 0
1090 Exit Sub
1091 TooBig:
1092 KeyAscii = 0
1093 End Sub
1094 Private Sub Text2_LostFocus()
1095 If Text2 = "" Then Text2 = 0
1096 End Sub
1097 Private Sub Text4_GotFocus()
1098 cmdAdd.Default = True
1099 End Sub
1100 Private Sub Text4_LostFocus()
1101 Command1.Default = True
1102 End Sub
1103 Private Sub Actions_Click()
1104 On Error GoTo NotSelected
1105 FileTypes.SelectedItem.Tag = FileTypes.SelectedItem.Tag
1106 On Error GoTo 0
1107 If FileTypes.SelectedItem.Selected = True Then
1108 FileTypes.SelectedItem.Tag = ActID(Actions.ListIndex + 1)
1109 End If
1110 NotSelected:
1111 End Sub
1112 Private Sub FileTypes_ItemClick(ByVal Item As ListItem)
1113 Dim aNum As Long, aItem As String, aName As String, bNum As Long, dItem As String
1114 Label8 = Item.ToolTipText
1115 Actions.Clear
1116 ReDim ActID(0) As String
1117 aName = Item.Key
1118 Do
1119 aItem = EnumKey("HKEY_CLASSES_ROOT\" + aName + "\shell\", aNum)
1120 If aItem <> "" Then
1121 If LCase(aItem) = "openas" And IsEmpty(GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\")) Then
1122 Actions.AddItem "Open with..."
1123 Else
1124 Actions.AddItem GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\" + aItem + "\", UCase(Left(aItem, 1)) + Mid(aItem, 2))
1125 End If
1126 ReDim Preserve ActID(UBound(ActID) + 1) As String
1127 ActID(UBound(ActID)) = aItem
1128 aNum = aNum + 1
1129 End If
1130 Loop Until aItem = ""
1131 If Item.Tag = "" Then
1132 dItem = GetReg("HKEY_CLASSES_ROOT\" + aName + "\shell\", "open")
1133 dItem = GetReg(SharedAppKey + "FileDefaultActions\" + aName, dItem)
1134 Else
1135 dItem = Item.Tag
1136 End If
1137 If Actions.ListCount > 0 Then Actions.ListIndex = 0
1138 For bNum = 0 To Actions.ListCount - 1
1139 If LCase(ActID(bNum + 1)) = LCase(dItem) Then
1140 Actions.ListIndex = bNum
1141 End If
1142 Next bNum
1143 Item.Tag = dItem
1144 End Sub
|