-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathForm3.frm
284 lines (275 loc) · 11.4 KB
/
Form3.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
VERSION 5.00
Begin VB.Form Loader
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
ClientHeight = 6240
ClientLeft = 0
ClientTop = 0
ClientWidth = 10305
LinkTopic = "Form3"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "Form3.frx":0000
ScaleHeight = 6240
ScaleWidth = 10305
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Timer Timer1
Interval = 1000
Left = 5280
Top = 5280
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "WWW.TCVB.TK"
BeginProperty Font
Name = "Georgia"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5880
TabIndex = 3
Top = 3720
Width = 3255
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "CopyRight:NasserNiazy,2008 "
BeginProperty Font
Name = "Georgia"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5760
TabIndex = 2
Top = 3240
Width = 4335
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "IRAN Video Player v 5.3"
BeginProperty Font
Name = "Georgia"
Size = 20.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5640
TabIndex = 1
Top = 2760
Width = 4695
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "WellCome"
BeginProperty Font
Name = "Georgia"
Size = 36
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 4440
TabIndex = 0
Top = 1800
Width = 4335
End
End
Attribute VB_Name = "Loader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ASD As New FileSystemObject
Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Private Enum HKEY_Type
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
End Enum
'----------------------------
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
'Registry Entry Types
'------------------------------------------------------------------------
Public Enum Reg_Type
REG_NONE = 0 'No data type.
REG_SZ = 1 'A string terminated by a null character.
REG_EXPAND_SZ = 2 'A null-terminated string which contains unexpanded environment variables.
REG_BINARY = 3 'A non-text sequence of bytes.
REG_DWORD = 4 'Same as REG_DWORD_LITTLE_ENDIAN.
REG_DWORD_LITTLE_ENDIAN = 4 'A 32-bit integer stored in little-endian format. This is the way Intel-based computers normally store numbers.
REG_DWORD_BIG_ENDIAN = 5 'A 32-bit integer stored in big-endian format. This is the opposite of the way Intel-based computers normally store numbers -- the word order is reversed.
REG_LINK = 6 'A Unicode symbolic link.
REG_MULTI_SZ = 7 'A series of strings, each separated by a null character and the entire set terminated by a two null characters.
REG_RESOURCE_LIST = 8 'A list of resources in the resource map.
End Enum
'Secuirty Constants
'------------------------------------------------------------------------
Const KEY_ALL_ACCESS = &HF003F 'Permission for all types of access.
Const KEY_CREATE_LINK = &H20 'Permission to create symbolic links.
Const KEY_CREATE_SUB_KEY = &H4 'Permission to create subkeys.
Const KEY_ENUMERATE_SUB_KEYS = &H8 'Permission to enumerate subkeys.
Const KEY_EXECUTE = &H20019 'Same as KEY_READ.
Const KEY_NOTIFY = &H10 'Permission to give change notification.
Const KEY_QUERY_VALUE = &H1 'Permission to query subkey data.
Const KEY_READ = &H20019 'Permission for general read access.
Const KEY_SET_VALUE = &H2 'Permission to set subkey data.
Const KEY_WRITE = &H20006 'Permission for general write access.
'----------------------------------------------------------------------
'Error Numbers
'------------------------------------------------------------------------
Const REG_ERR_OK = 0 'No Problems
Const REG_ERR_NOT_EXIST = 1 'Key does not exist
Const REG_ERR_NOT_STRING = 2 'Value is not a string
Const REG_ERR_NOT_DWORD = 4 'Value not DWORD
'
Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_ARENA_TRASHED = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259
'--------------------------------------------------------------------------
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal cbData As Long) As Long
Private Declare Function RegCreatekey Lib "advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal lpClass As String, _
ByVal dwOptions As Long, _
ByVal samDesired As Long, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, _
phkResult As Long, _
lpdwDisposition As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Dim f%
Private Function CreateKey(Key As HKEY_Type, sSubKey As String) As Boolean
On Error GoTo 4
Dim hKey As Long
Dim retval As Long
retval = RegCreatekey(Key, sSubKey, hKey)
If retval <> ERROR_NONE Then
CreateKey = False
Else
retval = RegCloseKey(hKey)
CreateKey = True
End If
4
End Function
'------------------------------
Private Function WriteString(Key As HKEY_Type, SubKey As String, sName As String, sData As String) As Boolean
On Error GoTo 4
Dim hKey As Long
Dim retval As Long
Dim deposit As Long
Dim secattr As SECURITY_ATTRIBUTES
secattr.nLength = Len(secattr)
secattr.lpSecurityDescriptor = 0
secattr.bInheritHandle = 1
retval = RegCreateKeyEx(Key, SubKey, 0, "", 0, KEY_WRITE, secattr, hKey, deposit)
If retval <> ERROR_NONE Then
WriteString = False
Exit Function
End If
retval = RegSetValueEx(hKey, sName, 0, REG_SZ, ByVal sData, Len(sData))
If retval <> ERROR_NONE Then
WriteString = False
Exit Function
End If
retval = RegCloseKey(hKey)
WriteString = True
4 End Function
Private Sub Form_Load()
On Error GoTo 4
Dim FG As String
If App.PrevInstance = True Then Unload Me
FG = App.Path & "\iranvideo5.exe"
Call CreateKey(HKEY_CLASSES_ROOT, ".irp")
Call WriteString(HKEY_CLASSES_ROOT, ".irp", "", "Nasservb.irp")
Call WriteString(HKEY_CLASSES_ROOT, ".irp", "PerceivedType", "IR3Project")
Call CreateKey(HKEY_CLASSES_ROOT, ".ir3")
Call WriteString(HKEY_CLASSES_ROOT, ".ir3", "", "Nasservb.ir3")
Call WriteString(HKEY_CLASSES_ROOT, ".ir3", "PerceivedType", "IRAN Video File")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.ir3")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.irp")
Call WriteString(HKEY_CLASSES_ROOT, "Nasservb.irp", "", "IR3Project")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.irp\DefaultIcon")
Call WriteString(HKEY_CLASSES_ROOT, "Nasservb.irp\DefaultIcon", "", FG & ",0")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.irp\Shell")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.irp\Shell\Open")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.irp\Shell\Open\Command")
Call WriteString(HKEY_CLASSES_ROOT, "Nasservb.irp\Shell\Open\Command", "", FG & ",%1")
Call WriteString(HKEY_CURRENT_USER, "Softwar\Microsoft\Windows\CurrentVesion\Explorer\FileExts\.irp", "", FG & ",%1")
Call WriteString(HKEY_CLASSES_ROOT, "Nasservb.ir3", "", "IRAN Video File")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.ir3\DefaultIcon")
Call WriteString(HKEY_CLASSES_ROOT, "Nasservb.ir3\DefaultIcon", "", FG & ",0")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.ir3\Shell")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.ir3\Shell\Open")
Call CreateKey(HKEY_CLASSES_ROOT, "Nasservb.ir3\Shell\Open\Command")
Call WriteString(HKEY_CLASSES_ROOT, "Nasservb.ir3\Shell\Open\Command", "", FG & ",%1")
Call WriteString(HKEY_CURRENT_USER, "Softwar\Microsoft\Windows\CurrentVesion\Explorer\FileExts\.ir3", "", FG & ",%1")
4 Command1 = Command
If Command1 = "" Then Exit Sub
If LCase(Mid(Command1, Len(Command1) - 3, 3)) = "ir3" Then
Player.Show
gfAbort = True
Unload Me
ElseIf LCase(Mid(Command1, Len(Command1) - 3, 3)) = "irp" Then
Command1 = Mid(Command1, 2, Len(Command1) - 2)
End If
End Sub
Private Sub Timer1_Timer()
On Error GoTo 4
f = f + 1
If f > 2 Then
If Command1 <> "" Then Main.IrpFile = Command1
Main.Show
Unload Me
End If
4 End Sub