function.asp

BS在线文件管理系统,采用asp编程,实现了对文件的简单管理,并且有比较方便的各种功能的实现.-BS online document management system, using asp prog

<%
Server.ScriptTimeout="600"
'-----------------------------------------------------------------文件改名
Function RenameFile(file1, file2)
On Error Resume Next
    file1=Cstr(file1)
    file2=Cstr(file2)
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(file1)=false then
	response.write("文件" & redFont & file1 &"</font>不存在！")
	exit function
  end if
  if fs.FileExists(file2)=true then
	response.write("文件" & redFont & file2 &"</font>已经存在！")
	exit function
  end if
    fs.MoveFile file1,file2
if fs.FileExists(file2)=true then
	response.write("文件"&redFont & file1 &"</font>已更名为" & redFont & file2 &"</font>！")
else
	response.write( redFont & "出现错误！操作未完成！</font>")
	Err.Clear
end if
    Set fs = nothing
End Function

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

'-------------------------------------------------------------读取文件内容
Function ReadFile(filespec)
On Error Resume Next
    filespec=Cstr(filespec)
    Const ForReading = 1
    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( redFont & "出现错误！操作未完成！</font>")
	Err.Clear
end if
End Function

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

'-------------------------------------------------------------显示文件信息
Function ShowFileInfo(filespec)
On Error Resume Next
    filespec=Cstr(filespec)
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FileExists(filespec)=false then
	ShowFileInfo = "文件"& filespec &"不存在！"
	exit function
  end if
    Set f = fs.GetFile(filespec)
    s = f.DateCreated
    modify = f.DateLastModified
    access = f.DateLastAccessed
    theType = f.type
    Set f = nothing
    Set fs = nothing
    ShowFileInfo = "创建时间为："&s&"&#13;&#10;最后修改时间为："
    ShowFileInfo = ShowFileInfo &modify&"&#13;&#10;最后访问日期为："
    ShowFileInfo = ShowFileInfo &access&"&#13;&#10;文件类型为：" & theType
End Function

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

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

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

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

'---------------------------------------------------------显示目录信息
Function ShowFolderInfo(folderspec_1)
On Error Resume Next
    folderspec = Cstr(folderspec_1)
    If right(folderspec,1) = "\" Then folderspec = Left(folderspec, Len(folderspec)-1)
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FolderExists(folderspec) then
    Set f = fs.GetFolder(folderspec)
    s = f.DateCreated
    modify = f.DateLastModified
    access = f.DateLastAccessed
    ShowFolderInfo = "创建时间为："&s&"&#13;&#10;最后修改时间为："
    ShowFolderInfo = ShowFolderInfo & modify &"&#13;&#10;最后访问日期为："&access
  else
    ShowFolderInfo="目录"&folderpec&"不存在！"
  end if
    Set f = nothing
    Set fs = nothing
End Function

'---------------------------------------------------拷贝目录到另一目录
Function CopyFolder(folder1,folder2)
'On Error Resume Next
    folder1 = Cstr(folder1)
    folder2 = Cstr(folder2)
    If right(folder1,1) = "\" Then folder1 = Left(folder1, Len(folder1)-1)
    If right(folder2,1) <> "\" Then folder2 = folder2 & "\"
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FolderExists(folder1) and fs.FolderExists(folder2) then
    fs.CopyFolder folder1,folder2	'-----是否覆盖原有文件，缺省为true
    if Err.Description = "" then
      response.write("目录" & redFont &folder1&"</font>已成功复制到"&redFont&folder2&"</font>")
    else
      response.write( redFont & "出现错误！操作未完成！目标目录可能已存在！</font>")
      Err.Clear
    end if
  else
	if fs.FolderExists(folder1)=false then
	    response.write("目录"& redFont & folder1 &"</font>不存在！")
	end if
	if fs.FolderExists(folder2)=false then
	    response.write("目录"& redFont & folder2 &"</font>不存在！")
	end if
  end if
    Set fs = nothing
End Function

'------------------------------------------------------------删除目录
Function DelFolder(folderspec_1)
On Error Resume Next
    folderspec = Cstr(folderspec_1)
    If right(folderspec,1) = "\" Then folderspec = Left(folderspec, Len(folderspec)-1)
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FolderExists(folderspec) then
    Set f = fs.GetFolder(folderspec)
    f.delete true	'-----------可选参数是否强制删除 true
    if fs.FolderExists(folderspec)=false then
	response.write("目录" & redFont & folderspec &"</font>删除成功！")
    else
	response.write( redFont & "出现错误！操作未完成！</font>")
	Err.Clear
    end if
  else
    response.write("目录" & redFont & folderspec &"不存在！</font>")
  end if
    Set f = nothing
    Set fs = nothing
End Function

'--------------------------------------------------移动目录到另一目录
Function MoveFolder(folder1,folder2)
On Error Resume Next
    folder1 = Cstr(folder1)
    folder2 = Cstr(folder2)
    If right(folder1,1) = "\" Then folder1 = Left(folder1, Len(folder1)-1)
    If right(folder2,1) <> "\" Then folder2 = folder2 & "\"
    Set fs = CreateObject("Scripting.FileSystemObject")
  if fs.FolderExists(folder1) and fs.FolderExists(folder2) then
    fs.MoveFolder folder1,folder2		'-----是否覆盖原有目录，缺省为true
if Err.Description = "" then
   response.write("目录" & redFont & folder1 &"</font>已成功移动到" & redFont&folder2&"</font>")
else
   response.write( redFont & "出现错误！操作未完成！目标目录可能已存在！</font>")
   Err.Clear
end if
  else
	if fs.FolderExists(folder1)=false then
	    response.write("目录"& redFont & folder1 &"</font>不存在！")
	end if
	if fs.FolderExists(folder2)=false then
	    response.write("目录"& redFont & folder2 &"</font>不存在！")
	end if
  end if
    Set fs = nothing