设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 4788|回复: 1
打印 上一主题 下一主题

[其它] I Love You 病毒清除源程序

[复制链接]

点击这里给我发消息

跳转到指定楼层
1#
发表于 2003-6-2 18:25:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
作者: 不详
该源程序用于清除“I Love You”病毒。编制时间为2000年5月5日。该程序不需要你输入,也不返回什么。你可以将源代码编译成.exe/.dll/.ocx格式的文件,并且可以免费散发出去。



'**************************************

' Name: I Love You Virus Cleanup

' Description:This script cleans up the

'   effects of the "I Love You" Virus!

' By: VirusKiller

'

'

' Inputs:None

'

' Returns:None

'

'Assumes:None

'

'Side Effects:None

'

'Warranty:

'code provided by Planet Source Code(tm)

'   (http://www.Planet-Source-Code.com) 'as

'   is', without warranties as to performanc

'   e, fitness, merchantability,and any othe

'   r warranty (whether expressed or implied

'   ).

'Terms of Agreement:

'By using this source code, you agree to

'   the following terms...

' 1) You may use this source code in per

'   sonal projects and may compile it into a

'   n .exe/.dll/.ocx and distribute it in bi

'   nary format freely and with no charge.

' 2) You MAY NOT redistribute this sourc

'   e code (for example to a web site) witho

'   ut written permission from the original

'   author.Failure to do so is a violation o

'   f copyright laws.

' 3) You may link to this code from anot

'   her website, provided it is not wrapped

'   in a frame.

' 4) The author of this code may have re

'   tained certain additional copyright righ

'   ts.If so, this is indicated in the autho

'   r's description.

'**************************************



On Error Resume Next

Dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow

eq=""

ctr=0

Set fso = CreateObject("Scripting.FileSystemObject")

Set file = fso.OpenTextFile(WScript.ScriptFullname,1)

main()





Sub main()

  MsgBox "Virus Removal Started!"

  On Error Resume Next

  Dim wscr,rr

  Set wscr=CreateObject("WScript.Shell")

  Set dirwin = fso.GetSpecialFolder(0)

  Set dirsystem = fso.GetSpecialFolder(1)

  Set dirtemp = fso.GetSpecialFolder(2)

  Set c = fso.GetFile(WScript.ScriptFullName)

  fso.DeleteFile(dirsystem & "\MSKernel32.vbs")

  fso.DeleteFile(dirwin & "\Win32DLL.vbs")

  fso.DeleteFile(dirsystem & "\LOVE-LETTER-FOR-YOU.TXT.vbs")

  fso.DeleteFile(dirsystem + "\LOVE-LETTER-FOR-YOU.HTM")

  regruns()

  listadriv()

  MsgBox "I Love You Fix has Completed!"

End Sub





Sub regruns()

  On Error Resume Next

  Dim num,downread

  regdelete "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32"

  regdelete "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Win32DLL"





  downread=""





    downread=regget("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory")





      If (downread="") Then

         downread="c:\"

      End If





      If (fileexist(downread&"\WIN-BUGSFIX.exe")=0) Then

         regdelete "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFIX"

      End If

      regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.msn.com"

    End Sub





Sub listadriv

  On Error Resume Next

  Dim d,dc,s

  Set dc = fso.Drives





  For Each d In dc





    If d.DriveType = 2 or d.DriveType=3 Then

      folderlist(d.path&"\")

    End If

  Next

  listadriv = s

End Sub





Sub killfiles(folderspec)

  On Error Resume Next

  Dim f,f1,fc,ext,ap,mircfname,s,bname,mp3,size

  Set f = fso.GetFolder(folderspec)

  Set fc = f.Files





  For Each f1 In fc

    ext=fso.GetExtensionName(f1.path)

    size=f1.size

    ext=lcase(ext)

    s=lcase(f1.name)





    If lcase(right(f1
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2003-6-2 18:39:00 | 只看该作者
好,就是别将有用的东东全给喀嚓了:)
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-25 08:33 , Processed in 0.105099 second(s), 26 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表