Rem EnCode_4.0 By baomaboy
'reg2vbs.vbs by baomaboy
Dim WshSHell,FSO
on Error Resume Next
Set WshSHell
= WScript.
CreateObject("
WScript.Shell"
)
Set FSO
= CreateObject("
Scripting.FileSystemObject"
)
Set WinVer
= WshSHell.Environment
("
Process"
)
Set Args
= WScript.Arguments
CloseTime
= 5
FileName
= WScript.ScriptName
FileFullName
= WScript.ScriptFullName
FilePath
= FSO.GetParentFolderName
(FileFullName
)
InsPath
= FSO.GetSpecialFolder
(1
)
InsFullName
= FSO.BuildPath
(InsPathFileName
)
LnkPathNT
= WshSHell.SpecialFolders
(2
)
LnkPath9X
= WshSHell.SpecialFolders
(14
)
LnkPathAll
= WshSHell.SpecialFolders
("
SendTo"
)
OtherFileName
= "
Manage_New.txt"
OtherFilePath
= FSO.GetSpecialFolder
(2
)
TemFileName
= "
无标题":TemFilePath
= FSO.GetSpecialFolder
(2
)
Copyright
= "
玲珑科技"
Email
= "
Email:fty1995@163.com"
InsTitle
= "
Reg2Vbsbybaomaboy"
RegPath1
= "
HKEY_CLASSES_ROOT\regfile\shell\RegToVbs\"
RegValue1
= "
转换为VBS脚本文件"
RegForm1
= "
REG_SZ"
RegPath2
= "
HKEY_CLASSES_ROOT\regfile\shell\RegToVbs\command\"
RegValue2
= "
wscript.exe""""%L"""
RegForm2
= "
REG_SZ"
If FileFullName
<> InsFullName
Then
intAnswer
= MsgBox("
【是】将“"
+ InsAnswer
+ "
”加入到右键菜单,"
& Chr(10
) & Chr(10
) & "
【否】将“"
+ InsAnswer
+ "
”从右键菜单删除。",vbQuestion
+ vbYesNoCancel,"
安装-"
+ InsTitle
+ "
-"
+ Copyright
)
If intAnswer
= vbYes
Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWriteRegPath2,RegValue2,RegForm2
FSO.GetFile
(FileFullName
).Copy
(InsFullName
)
WshSHell.popup "
添加脚本文件:"
+ vbLf + InsFullName
+ vbLf + "
添加注册表项:"
+ _
Chr(34
) + RegPath1
+ Chr(34
) + vbLf & CloseTime
& "
秒钟后本窗口将自动关闭!"
+ vbLf + vbLf + _
"
Copyright(C)"
+ Copyright
+ "
"
& QQ
& "
"
+ Email,CloseTime,"
安装成功 - "
+ InsTitle
+ "
- "
+ Copyright, 0
+ 64
End If
If IntAnswer
= vbNo
Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
WshSHell.popup "
删除脚本文件:"
+ vbLf + InsFullName
+ vbLf + "
删除注册表项:"
+ _
Chr(34
) + RegPath1
+ Chr(34
) + vbLf & CloseTime
& "
秒钟后本窗口将自动关闭!"
+ vbLf + vbLf + _
"
Copyright(C)"
+ Copyright
+ "
"
& QQ
& "
"
+ Email,CloseTime,"
卸载成功 - "
+ InsTitle
+ "
- "
+ Copyright, 0
+ 64
End If
If intAnswer
= vbCancel
Then
End If
Else
If Args.count
= 0
Then wscript.quit
Set ReadFile
= FSO.
OpenTextFile(Args
(0
),1,
False,
- 1
)
ReadAllText
= ReadFile.
ReadAll
ReadFile.
Close
If Mid(ReadAllText,1,3
) <> "
Win"
And Mid(ReadAllText,1,3
) <> "
REG"
Then
Set ReadFile
= FSO.
OpenTextFile(Args
(0
),1
)
ReadAllText
= ReadFile.
ReadAll
ReadFile.
Close
End If
For i
= 1
To Len(ReadAllText
)
TempNum
= Asc(Mid(ReadAllText,i,1
))
If TempNum
= 34
Then
TempNum
= 18
ElseIf TempNum
= 13
Then
TempNum
= 28
ElseIf TempNum
= 10
Then
TempNum
= 29
End If
ThisText1
= ThisText1
& Chr(TempNum
)
Next
Set WriteFile
= FSO.
OpenTextFile(Args
(0
) & "
.VBS",2,
True)
WriteFile.WriteLine
("
On Error Resume Next:Dim WshSHell,FSO,Reg2Vbs:Set WshSHell = WScript.CreateObject(""WScript.Shell""):Set FSO = CreateObject(""Scripting.FileSystemObject""):Reg2Vbs="""
& ThisText1
& "
"""
)
WriteFile.WriteLine
("
Execute(""For i=1 To Len(Reg2Vbs)""&vbCrLf&""TempNum = Asc(Mid(Reg2Vbs,i,1))""&vbCrLf&""If TempNum = 28 Then""&vbCrLf&""TempNum = 13""&vbCrLf&""ElseIf TempNum = 29 Then""&vbCrLf&""TempNum = 10""&vbCrLf&""elseif TempNum=18 Then""&vbCrLf&""TempNum = 34""&vbCrLf&""End If""&vbCrLf&""ThisText2 = ThisText2 & chr(TempNum)""&vbCrLf&""Next"")"
)
WriteFile.WriteLine
("
Set RegFile = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg""),2,True):RegFile.WriteLine(ThisText2):RegFile.Close:WshSHell.Run(""regedit /s ""&FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg"")):WScript.Sleep 500:FSO.DeleteFile FSO.BuildPath(FSO.GetSpecialFolder(2),""Temp.reg"")"
)
WriteFile.
Close
End If
Set WshSHell
= Nothing:SetFSO
= Nothing:
Set Args
= Nothing:WScript.Quit
(0
)
[
Last edited by slore on 2007-6-2 at 06:43 PM ]