FSO操作文件系统

　　实现功能：
文件(夹)目录列表提供了查阅目录下面的文件和文件夹
文件写,创,删提供了编辑,删除文件(文件夹)的操作
创建文件夹/文件针对创建文件夹(文件)而设置.
上传文件您可以模拟FTP上传,文件大小,类型不受限制.

有兴趣的自己体验，出现任何问题我均不承担任何后果，在此说，我没多少时间上网，经常也顾不过来，是看到最近经常有人问这方面的问题，就发上来，希望有所帮助。

upfso.asp//控制上传的文件
复制代码 代码如下:
<!--#includefile=upload.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)=uploadThen
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-datamethod=postaction=upfso.asp?yes=upload&path=&path&&nn=&nn&&mode=&mmode&class=admin_fso_uponsubmit=CheckForm()name=form><label>选择:<inputname=Filetype=Filesize=20/></label><label><inputtype=Submitname=Submitclass=submitvalue=上传/></label></form>)
EndIF

效验名称
FunctionIsvalidFileName(File_Name)
IsvalidFileName=False
Dimre,reStr
Setre=newRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern=[^_\.a-zA-Z\d]
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)
SetFile=Server.CreateObject(Scripting.Dictionary)
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)
Ifitsafile
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
Ifitsformitem
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(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-Z\d]
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
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=postclass=admin_post_formaction=default.asp?action=fso&this=edit&mode=1>
<textareaid=txtname=txtrows=15cols=60><%=Server.HTMLEncode(strasp)%></textarea>
<label><inputname=pathtype=hiddenvalue=<%=Trim(request(path))%>/><inputtype=submitname=okeditclass=submitvalue=确定编辑></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