function.asp

BS在线文件管理系统的源码和说明

<% Server.ScriptTimeout="600" %>
<Script RunAt=Server Language="VBScript">
'-----------------------------------------------------------------文件改名
Function RenameFile(file_1, file_2)
On Error Resume Next
    Const ForReading = 1, ForWriting = 2
    file1=Cstr(file_1)
    file2=Cstr(file_2)
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(file1)=false then
	response.write("文件<font color=red>"& file1 &"</font>不存在！")
	exit function
  end if
    fs.MoveFile file1,file2
    Set fs = nothing
if Err.Description = "" then
	response.write("文件<font color=red>"& file1 &"</font>已更名为<font color=red>"& file2 &"</font>！")
end if
if Err.Description<>"" then
	response.write("<font color=red>出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

'-----------------------------------------------------------------创建文件
Function CreateFile(filespec_1,content_1)
On Error Resume Next
    filespec=Cstr(filespec_1)
    content=Cstr(content_1)
    Set fs = CreateObject("Scripting.FileSystemObject")
	if fs.fileExists(filespec) then
		response.write("文件<font color=red>"& filespec &"</font>已经存在！")
		exit function
	end if
    Set a = fs.CreateTextFile(filespec, True)
    a.WriteLine content
    a.Close
if Err.Description = "" then
	response.write("新文件<font color=red>"& filespec &"</font>创建成功！")
end if
    Set a = nothing
    Set fs = nothing
if Err.Description<>"" then
	response.write("<font color=red>出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

'-------------------------------------------------------------读取文件内容
Function ReadFile(filespec_1)
On Error Resume Next
    filespec=Cstr(filespec_1)
    Const ForReading = 1, ForWriting = 2
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(filespec)=false then
if Err.Description = "" then
    response.write("文件" & filespec & "不存在！")
    exit function
end if
  End if
    Set f = fs.OpenTextFile(filespec, ForReading)
  	ReadAllTextFile =  f.ReadAll
	response.write(Server.HtmlEncode(ReadAllTextFile))
    Set f = nothing
    Set fs = nothing
if Err.Description<>"" then
	response.write("<font color=red>出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

'-----------------------------------------------------------------保存文件
Function SaveFile(filespec_1,content_1)
On Error Resume Next
    filespec = Cstr(filespec_1)
    content = Cstr(content_1)
    Const ForReading = 1, ForWriting = 2
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(filespec)=false then
    Set a = fs.CreateTextFile(filespec, True)
    a.WriteLine content
    a.Close
if Err.Description = "" then
	s = "alert(""文件" & replace(filespec, "\", "\\") &"不存在！已经另存为"& replace(filespec, "\", "\\") &"！"");"
	response.write(s)
	exit function
end if
  end if
    Set a = fs.OpenTextFile(filespec, ForWriting, True)
    a.WriteLine content
    a.Close
    Set a = nothing
    Set fs = nothing
if Err.Description = "" then
	s = "alert(""文件" & replace(filespec, "\", "\\") & "保存成功！"");"
	response.write(s)
end if
if Err.Description<>"" then
	s = "alert(""出现错误！操作未完成！"");"
	response.write(s)
	Err.Clear
end if
End Function

'-------------------------------------------------------------显示文件信息
Function ShowFileInfo(filespec_1)
On Error Resume Next
    filespec=Cstr(filespec_1)
    Dim fs, f, s, modify, access
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(filespec)=false then
if Err.Description = "" then
	ShowFileInfo = "文件"& file1 &"不存在！"
	exit function
end if
  end if
    Set f = fs.GetFile(filespec)
    s = f.DateCreated
    modify = f.DateLastModified
    access = f.DateLastAccessed
if Err.Description = "" then
    ShowFileInfo = "创建时间为："&s&"&#13;&#10;最后修改时间为："&modify&"&#13;&#10;最后访问日期为："&access&"&#13;&#10;文件类型为：" & f.Type
end if
    Set f = nothing
    Set fs = nothing
if Err.Description<>"" then
	ShowFileInfo = "出现错误！操作未完成！"
	Err.Clear
end if
End Function

'-------------------------------------------------------拷贝文件到另一目录
Function CopyFile(a_1, b_1)
On Error Resume Next
    a = Cstr(a_1)
    b = Cstr(b_1)
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(a) and fs.FolderExists(b) then
     fs.CopyFile a, b
if Err.Description = "" then
     response.write("<font color=red>"&a&"</font>已成功复制到<font color=red>"&b&"</font>")
end if
  else
	if fs.FileExists(a)=false then
if Err.Description = "" then
	    response.write("<font color=red>文件"& a &"不存在！</font>")
end if
	end if
	if fs.FolderExists(b)=false then
if Err.Description = "" then
	    response.write("<font color=red>目录"& b &"不存在！</font>")
end if
	end if
  end if
    Set fs = nothing
if Err.Description<>"" then
	response.write("<font color=red>出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

'-----------------------------------------------------------------删除文件
Function DelFile(filespec_1)
On Error Resume Next
    filespec = Cstr(filespec_1)
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(filespec)=false then
if Err.Description = "" then
	response.write("文件<font color=red>"& filespec &"</font>不存在！")
	exit function
end if
  end if
    Set f = fs.GetFile(filespec)
    f.delete true	'-----------可选参数是否强制删除
if Err.Description = "" then
    response.write("文件<font color=red>"&filespec&"</font>已经删除！")
end if
    Set f = nothing
    Set fs = nothing
if Err.Description<>"" then
	response.write("<font color=red>出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

'------------------------------------------------------移动文件到另一目录
Function MoveFile(a_1, b_1)
On Error Resume Next
    a = Cstr(a_1)
    b = Cstr(b_1)
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(a) and fs.FolderExists(b) then
     fs.MoveFile a,b	'-----是否覆盖原有文件，缺省为true
if Err.Description = "" then
     response.write("<font color=red>"&a&"</font>已成功移动到<font color=red>"&b&"</font>")
end if
  else
	if fs.FileExists(a)=false then
if Err.Description = "" then
	    response.write("<font color=red>文件"& a &"不存在！</font>")
end if
	end if
	if fs.FolderExists(b)=false then
if Err.Description = "" then
	    response.write("<font color=red>目录"& b &"不存在！</font>")
end if
	end if
  end if
    Set fs = nothing
if Err.Description<>"" then
	response.write("<font color=red>出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

'---------------------------------------------------------------新建目录
Function CreateFolder(folderspec_1)
On Error Resume Next
    folderspec = Cstr(folderspec_1)
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
  If fs.FolderExists(folderspec) then
if Err.Description = "" then
	response.write("<font color=red>"& folderspec & "</font>已经存在！")
    Exit Function
end if
  End if
    Set f = fs.CreateFolder(folderspec)
if Err.Description = "" then
    response.write("<font color=red>"& folderspec & "</font>创建成功！")
end if
if Err.Description<>"" then
	response.write("<font color=red>出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

'---------------------------------------------------------显示目录信息
Function ShowFolderInfo(folderspec_1)
On Error Resume Next
    folderspec = Cstr(folderspec_1)
    Dim fs, f, s, modify, access
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FolderExists(folderspec) then
    Set f = fs.GetFolder(folderspec)
    s = f.DateCreated
    modify = f.DateLastModified
    access = f.DateLastAccessed
if Err.Description = "" then
    ShowFolderInfo="创建时间为："&s&"&#13;&#10;最后修改时间为："& modify &"&#13;&#10;最后访问日期为："&access
end if
  else
if Err.Description = "" then
    ShowFolderInfo="目录"&folderpec&"不存在！"
end if
  end if
    Set f = nothing
    Set fs = nothing
if Err.Description<>"" then
	ShowFolderInfo="出现错误！操作未完成！"
	Err.Clear
end if
End Function

'---------------------------------------------------拷贝目录到另一目录
Function CopyFolder(a_1,b_1)
On Error Resume Next
    a = Cstr(a_1)
    b = Cstr(b_1)
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FolderExists(a) and fs.FolderExists(b) then
    fs.CopyFolder a,b	'-----是否覆盖原有文件，缺省为true
if Err.Description = "" then
    response.write("<font color=red>"&a&"</font>已成功复制到<font color=red>"&b&"</font>")
end if
  else
	if fs.FolderExists(a)=false then
if Err.Description = "" then
	    response.write("<font color=red>目录"& a &"不存在！</font>")
end if
	end if
	if fs.FolderExists(b)=false then
if Err.Description = "" then
	    response.write("<font color=red>目录"& b &"不存在！</font>")
end if
	end if
  end if
    Set fs = nothing
if Err.Description<>"" then
	response.write("<font color=red>出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

'------------------------------------------------------------删除目录
Function DelFolder(folderspec_1)
On Error Resume Next
    folderspec = Cstr(folderspec_1)
    Dim fs, f