实现功能：
文件(夹)目录列表提供了查阅目录下面的文件和文件夹
文件写,创,删提供了编辑,删除文件(文件夹)的操作
创建文件夹/文件针对创建文件夹(文件)而设置.
上传文件您可以模拟FTP上传,文件大小,类型不受限制.
有兴趣的自己体验，出现任何问题我均不承担任何后果，在此说，我没多少时间上网，经常也顾不过来，是看到最近经常有人问这方面的问题，就发上来，希望有所帮助。
upfso.asp//控制上传的文件
复制代码 代码如下:
<>
<%'OnErrorResumeNext%>
<STYLEtype="text/css">@importurl("admin.css");</STYLE>
<%
Server.ScriptTimeOut=999
'up_filetype="RAR,ZIP,SWF,JPG,PNG,GIF,DOC,TXT,CHM,PDF,ACE,JPG,MP3,WMA,WMV,bmp"
IFRequest.QueryString("yes")="upload"Then
path=Trim(request("path"))
'response.write(path&"---")
'response.End
DimFSO,FSOIsOK,F_FileName,mode
F_FileName=Trim(request("nn"))
mode=killint(Trim(request("mode")),0,0,2)
FSOIsOK=1
SetFSO=Server.CreateObject("Scripting.FileSystemObject")
IfErr<>0Then
Err.Clear
FSOIsOK=0
EndIf
DimD_Name,F_Name
IfFSOIsOK=1Then
IfInStr(1,path,":")=0Then
path=Replace(Lcase(path),"","/")
path=server.mappath(path)
path=Replace(path&"/","//","/")
Else
path=Replace(Lcase(path),"/","")
path=Replace(path&"","","")
EndIf
ifnotfso.folderexists(path)Then
response.write"<ahref=""javascript:history.back()""><fontcolor='#000080'>基本路径查找失败,返回</font></a>"
response.End
EndIf
EndIf
SetFSO=Nothing
DimFileUP
SetFileUP=NewUpload_File
FileUP.GetDate(-1)
DimF_FileType,F_File
SetF_File=FileUP.File("File")
IfLen(F_FileName)<2ThenF_FileName=F_File.FileName
IfLen(F_FileName)<2Then
response.write("<ahref='javascript:history.go(-1);'><fontcolor='#000080'>空文件,请返回</font></a>")
response.End
EndIf
'F_FileType=Ucase(F_File.FileExt)
'IFF_File.FileSize>90000Then
'Response.Write("<ahref='javascript:history.go(-1);'>大小超过限制</a>")
'exitsub
IFIsvalidFileName(F_FileName)=FalseThen
Response.Write("<ahref='javascript:history.go(-1);'><fontcolor='#000080'>名称有误</font></a>")
Else
DimFileIsExists
SetFSO=Server.CreateObject("Scripting.FileSystemObject")
FileIsExists=FSO.FileExists(path&F_FileName)
IfFileIsExists=TrueAndmode<>1Then
fso.deletefile(path&F_FileName)
Response.Write("<fontcolor='#000080'>文件已经存在,已经被删除</b></a>;")
F_File.SaveToFilepath&F_FileName
Response.Write("<ahref='upfso.asp?action=fso&path="&path&"'><b><fontcolor='#000080'>点击这里继续上传:"&path&F_FileName&"</font></b></a>")
ElseIfFileIsExists=TrueAndmode=1Then
Response.Write("<fontcolor='#000080'>文件已经存在,您选择了不覆盖</font></b>")
Else
F_File.SaveToFilepath&F_FileName
Response.Write("<ahref='upfso.asp?action=fso&path="&path&"'><b><fontcolor='#000080'>点击这里继续上传:"&path&F_FileName&"</font></b></a>")
EndIf
EndIF
SetF_File=Nothing
SetFileUP=Nothing
Else
Dimpath,nn,mmode
nn=Trim(request("nn"))
mmode=Trim(request("mode"))
path=Replace(request("path"),"//","/")
Ifpath=""Thenpath="../newup/"
Response.Write("<formenctype=""multipart/form-data""method=""post""action=""upfso.asp?yes=upload&path="&path&"&nn="&nn&"&mode="&mmode&"""class=""admin_fso_up""onsubmit=""CheckForm()""name='form'><label>选择:<inputname=""File""type=""File""size=""20""/></label><label><inputtype=""Submit""name=""Submit""class=""submit""value=""上传""/></label></form>")
EndIF
'效验名称
FunctionIsvalidFileName(File_Name)
IsvalidFileName=False
Dimre,reStr
Setre=newRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern="[^_.a-zA-Zd]"
reStr=re.Replace(File_Name,"")
IfFile_Name=reStrThenIsvalidFileName=True
Setre=Nothing
EndFunction
%>
upload.asp//上传类
复制代码 代码如下:
<%
DimoUpFileStream
ClassUpload_File
DimForm,File,Err
PrivateSubClass_Initialize
Err=-1
EndSub
PrivateSubClass_Terminate
'ClearVariables&Objects
IfErr<0Then
oUpFileStream.Close
Form.RemoveAll
File.RemoveAll
SetForm=Nothing
SetFile=Nothing
SetoUpFileStream=Nothing
EndIf
EndSub
PublicSubGetDate(RetSize)
'DefineVariables
DimRequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
DimiFileSize,sFilePath,sFileType,sFormvalue,sFileName
DimiFindStart,iFindEnd
DimiFormStart,iFormEnd,sFormName
IfRequest.TotalBytes<1Then
Err=1
ExitSub
EndIf
IfRetSize>0Then
IfRequest.TotalBytes>RetSizeThen
Err=2
ExitSub
EndIf
EndIf
SetForm=Server.CreateObject("Scripting.Dictionary")
Form.CompareMode=1
SetFile=Server.CreateObject("Scripting.Dictionary")
File.CompareMode=1
SettStream=Server.CreateObject("Adodb.Stream")
SetoUpFileStream=Server.CreateObject("Adodb.Stream")
oUpFileStream.Type=1
oUpFileStream.Mode=3
oUpFileStream.Open
oUpFileStream.WriteRequest.BinaryRead(Request.TotalBytes)
oUpFileStream.Position=0
RequestBinDate=oUpFileStream.Read
iFormEnd=oUpFileStream.Size
bCrLf=chrB(13)&chrB(10)
'GetSeperators
sStart=MidB(RequestBinDate,1,InStrB(1,RequestBinDate,bCrLf)-1)
iStart=LenB(sStart)
iFormStart=iStart+2
'SplitItems
Do
iInfoEnd=InStrB(iFormStart,RequestBinDate,bCrLf&bCrLf)+3
tStream.Type=1
tStream.Mode=3
tStream.Open
oUpFileStream.Position=iFormStart
oUpFileStream.CopyTotStream,iInfoEnd-iFormStart
tStream.Position=0
tStream.Type=2
tStream.Charset="UTF-8"
sInfo=tStream.ReadText
'Getformitemname
iFormStart=InStrB(iInfoEnd,RequestBinDate,sStart)-1
iFindStart=InStr(22,sInfo,"name=""",1)+6
iFindEnd=InStr(iFindStart,sInfo,"""",1)
sFormName=Mid(sinfo,iFindStart,iFindEnd-iFindStart)
'Ifit'safile
IfInStr(45,sInfo,"filename=""",1)>0Then
SetoFileInfo=newFileInfo
'GetFileattributes
iFindStart=InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd=InStr(iFindStart,sInfo,"""",1)
sFileName=Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName=Mid(sFileName,InStrRev(sFileName,"")+1)
oFileInfo.FilePath=Left(sFileName,InStrRev(sFileName,""))
oFileInfo.FileExt=Mid(sFileName,InStrRev(sFileName,".")+1)
iFindStart=InStr(iFindEnd,sInfo,"Content-Type:",1)+14
iFindEnd=InStr(iFindStart,sInfo,vbCr)
oFileInfo.FileType=Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart=iInfoEnd
oFileInfo.FileSize=iFormStart-iInfoEnd-2
oFileInfo.FormName=sFormName
file.addsFormName,oFileInfo
Else
'Ifit'sformitem
tStream.Close
tStream.Type=1
tStream.Mode=3
tStream.Open
oUpFileStream.Position=iInfoEnd
oUpFileStream.CopyTotStream,iFormStart-iInfoEnd-2
tStream.Position=0
tStream.Type=2
tStream.Charset="UTF-8"
sFormvalue=tStream.ReadText
IfForm.Exists(sFormName)Then
Form(sFormName)=Form(sFormName)&","&sFormValue
Else
Form.AddsFormName,sFormvalue
EndIf
EndIf
tStream.Close
iFormStart=iFormStart+iStart+2
'Exitatendoffile
LoopUntil(iFormStart+2)=iFormEnd
RequestBinDate=""
SettStream=Nothing
EndSub
EndClass
'GetFileInfo
ClassFileInfo
DimFormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
PrivateSubClass_Initialize
FileName=""
FilePath=""
FileSize=0
FileStart=0
FormName=""
FileType=""
FileExt=""
EndSub
'SaveFileMethod
PublicFunctionSaveToFile(FullPath)
DimoFileStream,ErrorChar,i
OnErrorResumeNext
SetoFileStream=CreateObject("Adodb.Stream")
oFileStream.Type=1
oFileStream.Mode=3
oFileStream.Open
oUpFileStream.position=FileStart
oUpFileStream.copytooFileStream,FileSize
oFileStream.SaveToFileFullPath,2
oFileStream.Close
SetoFileStream=Nothing
EndFunction
'GetFileContent
PublicFunctionGetDate
oUpFileStream.Position=FileStart
GetDate=oUpFileStream.Read(FileSize)
EndFunction
EndClass
%>
核心函数
复制代码 代码如下:
DimtheInstalledObjects(17)
theInstalledObjects(0)="MSWC.AdRotator"
theInstalledObjects(1)="MSWC.BrowserType"
theInstalledObjects(2)="MSWC.NextLink"
theInstalledObjects(3)="MSWC.Tools"
theInstalledObjects(4)="MSWC.Status"
theInstalledObjects(5)="MSWC.Counters"
theInstalledObjects(6)="IISSample.ContentRotator"
theInstalledObjects(7)="IISSample.PageCounter"
theInstalledObjects(8)="MSWC.PermissionChecker"
theInstalledObjects(9)="Scripting.FileSystemObject"
theInstalledObjects(10)="adodb.connection"
theInstalledObjects(11)="SoftArtisans.FileUp"
theInstalledObjects(12)="SoftArtisans.FileManager"
theInstalledObjects(13)="JMail.SMTPMail"
theInstalledObjects(14)="CDONTS.NewMail"
theInstalledObjects(15)="Persits.MailSender"
theInstalledObjects(16)="LyfUpload.UploadFile"
theInstalledObjects(17)="Persits.Upload.1"
Dimfso
IfIsObjInstalled(theInstalledObjects(9))Then
Setfso=Server.CreateObject("Scripting.FileSystemObject")
EndIf
FunctionIsObjInstalled(strClassString)
OnErrorResumeNext
IsObjInstalled=False
Err=0
DimxTestObj
SetxTestObj=Server.CreateObject(strClassString)
If0=ErrThenIsObjInstalled=True
SetxTestObj=Nothing
Err=0
EndFunction
'检查组件版本
PublicFunctiongetver(Classstr)
OnErrorResumeNext
DimxTestObj
SetxTestObj=Server.CreateObject(Classstr)
IfErrThen
getver=""
else
getver=xTestObj.version
endif
SetxTestObj=Nothing
EndFunction
'效验名称
FunctionIsvalidFileName(File_Name)
IsvalidFileName=False
Dimre,reStr
Setre=newRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern="[^_.a-zA-Zd]"
reStr=re.Replace(File_Name,"")
IfFile_Name=reStrThenIsvalidFileName=True
Setre=Nothing
EndFunction
'文件写入
Functionwriteto(xmlfloder,xmlfile,content,mode)
writeto=false
IfNotIsObjInstalled(theInstalledObjects(9))ThenExitFunction
mode=killint(mode,0,0,2)
xmlfloder=server.mappath(xmlfloder)
Setfso=Server.CreateObject("Scripting.FileSystemObject")
ifnotfso.folderexists(xmlfloder)Then
fso.createfolder(xmlfloder)
EndIf
xmlfile=replace(xmlfloder&"","","")&xmlfile
'response.write(warn_red(xmlfile))
Dimfsoxml
Iffso.fileexists(xmlfile)Andmode=1Then'存在不写
ExitFunction
elseIffso.fileexists(xmlfile)Andmode=2Then'重写
Setfsoxml=fso.opentextfile(xmlfile,2)
fsoxml.writeline(content)
fsoxml.close
writeto=true
ElseIffso.fileexists(xmlfile)Andmode=8Then'追加
Setfsoxml=fso.opentextfile(xmlfile,8)
fsoxml.writeline(content)
fsoxml.close
writeto=true
ElseIffso.fileexists(xmlfile)Then
Setfsoxml=fso.opentextfile(xmlfile,2)'重写
fsoxml.writeline(content)
fsoxml.close
writeto=true
Else
Setfsoxml=fso.createtextfile(xmlfile)'创建
fsoxml.writeline(content)
fsoxml.close
writeto=true
EndIf
EndFunction
'删除文件
Functiondelaspfile(x)
OnErrorResumeNext
delaspfile=False
IfNotfileexitornot(x)Then
ExitFunction
Else
fso.deletefileserver.mappath(x)
delaspfile=True
Endif
EndFunction
'文件存在
Functionfileexitornot(file)
OnErrorResumeNext
Dimf_re_file
f_re_file=true
Ifnotfso.fileexists(server.MapPath(file))Thenf_re_file=False
Iferr<>0Thenf_re_file=False
fileexitornot=f_re_file
EndFunction
'错误抑制,打印错误
Functionshow_err(err)
OnErrorResumeNext
Iferr.Number<>0Then
Response.Clear
Dimerr_mess
err_mess="<b>发生错误:</b><br/>错误Number："&err.Number&"<br/>错误信息:"&err.Description&"<br/>出错文件："&err.Source&"<br/>出错行："&err.Line&"(不被支持)<br/>"&err
response.write(err_mess)
Endif
EndFunction
'警告:
Functionwarn_red(mess)
warn_red="<fontcolor=red><b>跟踪:"&mess&"</b></font><br/>"
EndFunction
'FSO文件目录
Functionshowallfile(path)
'OnErrorResumeNext
path=Replace(path,"//","/")
setfso=CreateObject("Scripting.FileSystemObject")
DimuploadPath,uploadfolder,objSubFolders,allfiles,fileitem,objSubFolder,
sFileName
IfInStr(1,path,":")=0Then
path=Replace(path,"","/")
uploadPath=server.mappath(path)
Else
path=Replace(path,"/","")
uploadPath=path
EndIf
response.write(warn_red(uploadPath))
ifnotfso.folderexists(uploadPath)Then
response.writewarn_red("路径查找失败")
ExitFunction
EndIf
Setuploadfolder=fso.GetFolder(uploadPath)
Ifuploadfolder.isrootfolderThen
response.write("<b>根目录</b><br/>")
Else
response.write("<b><fontcolor=""#00008b"">父目录:</font><ahref=""default.asp?action=fso&this=top&path="&uploadfolder.parentfolder&""">
"&uploadfolder.parentfolder&"</a></b><br/>")
EndIf
response.write("<b>目录大小:"&int(uploadfolder.size/1024)&"KB</b><br/>")
setobjSubFolders=uploadfolder.Subfolders
Dimfso_mes
fso_mes="<ol>"
foreachobjSubFolderinobjSubFolders
fso_mes=fso_mes&"<li><b><ahref=""default.asp?action=fso&this=top&path="&path&"/"&objSubFolder.name&"""><fontcolor=blue>"&objSubFolder.name&"</font></a></b></li>"
next
setallfiles=uploadfolder.Files
foreachfileiteminallfiles
fso_mes=fso_mes&"<li><ahref=""default.asp?action=fso&this=file&path="&path&"/"&fileitem.Name&""">"&fileitem.Name&"</a></li>"
Next
fso_mes=fso_mes&"</ol>"
response.write(fso_mes)
response.writedeltext(uploadPath,1)
EndFunction
'文件属性
Functionfilepro(name)
name=Replace(name,"//","/")
Dimwhichfile
IfInStr(1,name,":")=0Then
name=Replace(name,"","/")
whichfile=server.mappath(name)
Else
name=Replace(name,"/","")
whichfile=name
EndIf
Setfso=CreateObject("Scripting.FileSystemObject")
IfNotfso.fileexists(whichfile)Then
response.write(warn_red("文件不存在或者无访问权限"))
ExitFunction
EndIf
Dimf2,s_mess
Setf2=fso.GetFile(whichfile)
s_mess="<divclass=""admin_post_form""><b><fontcolor=""#00008b"">父目录:</font><ahref=""default.asp?action=fso&this=top&path="&f2.parentfolder&""">"&f2.parentfolder&
"</a></b><br/>"
s_mess=s_mess&"文件名称："&f2.name&"<br>"
s_mess=s_mess&"文件短路径名："&f2.shortPath&"<br>"
s_mess=s_mess&"文件物理地址："&f2.Path&"<br>"
s_mess=s_mess&"文件属性："&f2.Attributes&"<br>"
s_mess=s_mess&"文件大小："&f2.size&"<br>"
s_mess=s_mess&"文件类型："&f2.type&"<br>"
s_mess=s_mess&"文件创建时间："&f2.DateCreated&"<br>"
s_mess=s_mess&"最近访问时间:"&f2.DateLastAccessed&"<br>"
s_mess=s_mess&"最近修改时间:"&f2.DateLastModified&"<br/></div>"
response.write(s_mess)
Ifkillint(Trim(request("type")),0,0,2)<>0Then
showtext(whichfile)
EndIf
response.writedeltext(whichfile,0)
EndFunction
'
SUBshowtext(files)
dimiStr,adosText,strasp
setadosText=Server.CreateObject("ADODB.Stream")
adosText.mode=3
adosText.type=2
adosText.charset="gb2312"
'adosText.charset="big5"
adosText.open
IfInStr(1,files,":")=0Then
files=Replace(files,"","/")
files=server.mappath(files)
Else
files=Replace(files,"/","")
files=files
EndIf
adosText.loadFromFile(files)
strasp=adosText.ReadText()
adosText.close
setadosText=nothing%>
<formmethod="post"class="admin_post_form"action="default.asp?action=fso&this=edit&mode=1">
<textareaid="txt"name="txt"rows="15"cols="60"><%=Server.HTMLEncode(strasp)%></textarea>
<label><inputname="path"type="hidden"value="<%=Trim(request("path"))%>"/><inputtype="submit"name="okedit"class="submit"value="确定编辑"></label>
</form>
<%EndSub
Functiondeltext(file,mode)
Dimdeltext_mess
deltext_mess="<divclass=""deltext"">"
SelectCasekillint(mode,0,0,2)
Case0:
deltext_mess=deltext_mess&"文件操作:<ahref=""default.asp?action=fso&this=file&path="&file&""">属性</a><aonclick=""{if(confirm('警告,非文本请不要读取,否则文件无法读取了,你坚持点击确定么?劝你点击取消')){returntrue;}returnfalse;}""href=""default.asp?action=fso&this=file&path="&file&"&type=1""><fontcolor=red><b>编辑</b></font></a><ahref=""default.asp?action=fso&this=move&path="&file&""">移动</a><ahref=""default.asp?action=fso&this=copy&path="&file&"&mode=0"">复制</a><ahref=""default.asp?action=fso&this=rename&path="&file&"&mode=0"">重命名</a><aonclick=""{if(confirm('警告,删除操作不能恢复,小心使用!!!')){returntrue;}returnfalse;}""href=""default.asp?action=fso&this=del&path="&file&"&mode=0""><fontcolor=red><b>删除</b></font></a>"
Case1:
deltext_mess=deltext_mess&"文件夹操作:<ahref=""default.asp?action=fso&this=top&path="&file&""">列表</a><ahref=""default.asp?action=fso&this=add&path="&file&"&ff=1"">创建目录</a><ahref=""default.asp?action=fso&this=add&path="&file&""">手建文件</a><ahref=""default.asp?action=fso&this=up&path="&file&""">上传文件</a><ahref=""default.asp?action=fso&this=move&path="&file&"&mode=1"">移动</a><ahref=""default.asp?action=fso&this=copy&path="&file&"&mode=1"">复制</a><ahref=""default.asp?action=fso&this=rename&path="&file&"&mode=1"">重命名</a><aonclick=""{if(confirm('警告,删除操作不能恢复,以上列表的文件全部被删除,你坚持点击确定么?劝你点击取消')){returntrue;}returnfalse;}""href=""default.asp?action=fso&this=del&path="&file&"&mode=1""><fontcolor=red><b>删除</b></font></a>"
EndSelect
deltext_mess=deltext_mess&"</div>"
deltext=deltext_mess
EndFunction