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




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