源码如下:
<%@ Language=VBscript %>
<%
Response.Buffer=true
On Error Resume Next
Server.ScriptTimeOut = 1000
Response.Expires=0
Dim StartTime,IsReplace
IsReplace = true '是否过滤编辑时文件的标记,如不过滤遇到有
'*******************************************
'过程作用:判断服务器是否支持FSO
'*******************************************
Sub IsErr()
If Err = -2147221005 Then
Response.write "这台服务器不支持FSO,故本程序无法运行"
Response.end
End If
End Sub
'*******************************************
'函数作用:取得文件的后缀名
'*******************************************
Function UpDir(ByVal D)
Dim UDir
If Len(D) = 0 then Exit Function
UDir=Left(D,InStrRev(D,"\")-1)
UpDir=UDir
End Function
'*******************************************
'函数作用:取得当前页的URL,
' 为文件添加正确的链接
'*******************************************
Function FileUrl(url,D)
Dim PageUrl,PUrl
PageUrl="http://"& Request.ServerVariables("SERVER_NAME")
PUrl=Left(Request.ServerVariables("URL"),InStrRev(Request.ServerVariables("Url"),"/"))
PUrl=Left(Request.ServerVariables("URL"),InStrRev(Request.ServerVariables("Url"),"/"))
PageUrl=PageUrl & Purl & Mid(D,2,Len(D)) & "/" & url
FileUrl=PageUrl
End Function
'*******************************************
'函数作用:格式化文件的大小
'*******************************************
Function GetFileSize(size)
Dim FileSize
FileSize=size / 1024
FileSize=FormatNumber(FileSize,2)
If FileSize < 1024 and FileSize > 1 then
GetFileSize=""& FileSize & " KB"
ElseIf FileSize >1024 then
GetFileSize=""& FormatNumber(FileSize / 1024,2) & " MB"
Else
GetFileSize=""& Size & " Bytes"
End If
End Function
'*******************************************
'函数作用:取得文件的后缀名
'*******************************************
Function GetExtensionName(name)
Dim FileName
FileName=Split(name,".")
GetExtensionName=FileName(Ubound(FileName))
End Function
'*******************************************
'函数作用:返回文件类型
'*******************************************
Function GetFileIcon(name)
Dim FileName,Icon
FileName=Lcase(GetExtensionName(name))
Select Case FileName
Case "asp"
Icon = "asp"
Case "bmp"
Icon = "bmp"
Case "doc"
Icon = "doc"
Case "exe"
Icon = "exe"
Case "gif"
Icon = "gif"
Case "jpg"
Icon = "jpg"
Case "chm"
Icon = "chm"
Case "htm","html"
Icon = "htm"
Case "log"
Icon = "log"
Case "mdb"
Icon = "mdb"
Case "swf"
Icon = "swf"
Case "txt"
Icon = "txt"
Case "wav"
Icon = "wav"
Case "xls"
Icon = "xls"
Case "rar","zip"
Icon = "zip"
Case "css"
Icon = "css"
Case Else
Icon = "none"
End Select
GetFileIcon=Icon
End Function
'*******************************************
'过程作用:删除选定的文件或文件夹
'*******************************************
Sub DelAll()
Dim FolderId,FileId,ThisDir,FileNum,FolderNum,FilePath,FolderPath
FolderId = Split(Request.Form("FolderId"),",")
FileId = Split(Request.Form("FileId"),",")
ThisDir = trim(Request.Form("ThisDir"))
FileNum=0
FolderNum=0
If Ubound(FolderId) <> -1 then '删除文件夹
For i = 0 to Ubound(FolderId)
FolderPath = Server.MapPath(".") & ThisDir & "\" & trim(FolderId(i))
If Fso.FolderExists(FolderPath) then
Fso.DeleteFolder FolderPath,true
FolderNum = FolderNum + 1
End If
Next
End If
If Ubound(FileId) <> -1 then '删除文件
For j = 0 to Ubound(FileId)
FilePath = Server.MapPath(".") & ThisDir & "\" & trim(FileId(j))
If Fso.FileExists(FilePath) then
Fso.DeleteFile FilePath,true
FileNum = FileNum + 1
End If
Next
End If
Response.write ""
End Sub
'*******************************************
'过程作用:使选定的文件或文件夹改名
'*******************************************
Sub Rname()
Dim ThisDir,FolderName,NewName,OldName
ThisDir = Trim(Request.Form("ThisDir"))
FolderName = Trim(Request.Form("FolderId"))
FileName = Trim(Request.Form("FileId"))
NewName = Trim(Request.QueryString("NewName"))
If len(FolderName) <> 0 then '文件夹改名
NewName1 = Server.MapPath(".") & ThisDir & "\" & NewName
OldName = Server.MapPath(".") & ThisDir & "\" & FolderName
If not Fso.FolderExists(NewName1) then
Fso.MoveFolder OldName,NewName1
Response.write ""
Else
Response.write ""
End If
End If
If len(FileName) <> 0 then '文件改名
NewName1 = Server.MapPath(".") & ThisDir & "\" & NewName
OldName = Server.MapPath(".") & ThisDir & "\" & FileName
If not Fso.FileExists(NewName1) then
Fso.MoveFile OldName,NewName1
Response.write ""
Else
Response.write ""
End If
End If
End Sub
'*******************************************
'过程作用:新建文件
'*******************************************
Sub NewFile()
Dim NewFile,NewFilePath
NewFilePath = Trim(Request.Form("ThisDir"))
NewFile = Trim(Request.Form("NewFileName"))
NewFilePath = Server.MapPath(".") & NewFilePath & "\" & NewFile
If not Fso.FileExists(NewFilePath) and not Fso.FolderExists(NewFilePath) then
Set FsoFile = Fso.CreateTextFile(NewFilePath)
FsoFile.Writeline
FsoFile.close
Set FsoFile = nothing
Response.write ""
Else
Response.write ""
End if
End Sub
'*******************************************
'过程作用:新建文件夹
'*******************************************
Sub NewFolder()
Dim NewFolder,NewFolderPath
NewFolderPath = Trim(Request.Form("ThisDir"))
NewFolder = Trim(Request.Form("NewFolderName"))
NewFolderPath = Server.MapPath(".") & NewFolderPath & "\" & NewFolder
If not Fso.FolderExists(NewFolderPath) then
Fso.CreateFolder(NewFolderPath)
Response.write ""
Else
Response.write ""
End if
End Sub
'*******************************************
'过程作用:css 样式
'*******************************************
Sub Css()
%>
<%
End Sub
'*******************************************
'过程作用:编辑文件
'*******************************************
Sub Edit()
Dim FilePath,FileName,action
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
IsErr
action=Trim(Request.QueryString("action"))
If action = ("Save") then '保存文件
Dim FileSave
FilePath = trim(Request.QueryString("FilePath"))
FileAll = trim(Request.Form("FileAll"))
If IsReplace then FileAll = Replace(FileAll,"")
If Fso.FileExists(FilePath) then
Set FileSave = Fso.OpenTextFile(FilePath,2)
FileSave.Write(FileAll)
FileSave.Close
Response.write ""
Else
Response.write ""
End If
ElseIf action = ("Edit") then '读取文件
Dim FileAll
FilePath = Trim(Request.Form("ThisDir"))
FileName = Trim(Request.Form("FileId"))
FilePath1 = Server.MapPath(".") & FilePath & "\" & FileName
If Fso.FileExists(FilePath1) then
Set FileOpen = Fso.OpenTextFile (FilePath1,1)
FileAll = FileOpen.ReadAll
FileOpen.close
If IsReplace then FileAll = Replace(FileAll,"textarea","")
Else
Response.write ""
End If
%>
FSO在线编辑——阿赛特别版
<% Call Css %>
<%
End If
Set Fso = nothing
End Sub
'****************************************
'函数定义部分结束
'****************************************
%>
<%
Dim Fso,FsoFile,FileType,FileSize,FileTime,Path
Dim Dir
action=Trim(Request.QueryString("action"))
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
IsErr
If action = "Del" then
Call DelAll
ElseIf action = "NewFile" then
Call NewFile
ElseIf action = "NewFolder" then
Call NewFolder
ElseIf action = "Rname" then
Call Rname
ElseIf action = "Edit" then
Call Edit
ElseIf action = "Save" then
Call Edit
Else
Dir=Trim(Request.QueryString("Dir"))
Path = Server.MapPath(".") & Dir
Set FsoFile = Fso.GetFolder(Server.MapPath("."))
FsoFileSize = FsoFile.size '空间大小统计
Set FsoFile = nothing
Set FsoFile = Fso.GetFolder(Path)
%>
FSO在线编辑——阿赛特别版<% Call Css %>
<%
End If
Set FsoFile = nothing
Set Fso = nothing
%>
阅读(3226) | 评论(0) | 转发(0) |