下面是小编给大家分享的一篇FSO操作文件系统的详细教程，感兴趣的朋友跟小编一起来了解一下吧!
实现功能：
文件(夹)目录列表提供了查阅目录下面的文件和文件夹
文件写,创,删提供了编辑,删除文件(文件夹)的操作
创建文件夹/文件针对创建文件夹(文件)而设置.
上传文件您可以模拟FTP上传,文件大小,类型不受限制.
有兴趣的自己体验，出现任何问题我均不承担任何后果，在此说，我没多少时间上网，经常也顾不过来，是看到最近经常有人问这方面的问题，就发上来，希望有所帮助。
upfso.asp//控制上传的文件
复制代码 代码如下:
@importurl("admin.css");
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")
IfErr0Then
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"基本路径查找失败,返回"='#000080'>
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)
IfLen(F_FileName)
response.write("空文件,请返回")='#000080'>='javascript:history.go(-1);'>
response.End
EndIf
'F_FileType=Ucase(F_File.FileExt)
'IFF_File.FileSize>90000Then
'Response.Write("大小超过限制")='javascript:history.go(-1);'>
'exitsub
IFIsvalidFileName(F_FileName)=FalseThen
Response.Write("名称有误")='#000080'>='javascript:history.go(-1);'>
Else
DimFileIsExists
SetFSO=Server.CreateObject("Scripting.FileSystemObject")
FileIsExists=FSO.FileExists(path&F_FileName)
IfFileIsExists=TrueAndmode1Then
fso.deletefile(path&F_FileName)
Response.Write("文件已经存在,已经被删除;")='#000080'>
F_File.SaveToFilepath&F_FileName
Response.Write("点击这里继续上传:"&path&F_FileName&"='#000080'>")
ElseIfFileIsExists=TrueAndmode=1Then
Response.Write("文件已经存在,您选择了不覆盖")='#000080'>
Else
F_File.SaveToFilepath&F_FileName
Response.Write("点击这里继续上传:"&path&F_FileName&"='#000080'>")
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("")
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
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
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-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
Iferr0Thenf_re_file=False
fileexitornot=f_re_file
EndFunction
'错误抑制,打印错误
Functionshow_err(err)
OnErrorResumeNext
Iferr.Number0Then
Response.Clear
Dimerr_mess
err_mess="发生错误:
错误Number："&err.Number&"
错误信息:"&err.Description&"
出错文件："&err.Source&"
出错行："&err.Line&"(不被支持)
"&err
response.write(err_mess)
Endif
EndFunction
'警告:
Functionwarn_red(mess)
warn_red="跟踪:"&mess&"
"=red>
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("根目录
")
Else
response.write("父目录:
"&uploadfolder.parentfolder&"
")
EndIf
response.write("目录大小:"&int(uploadfolder.size/1024)&"KB
")
setobjSubFolders=uploadfolder.Subfolders
Dimfso_mes
fso_mes="
foreachobjSubFolderinobjSubFolders
fso_mes=fso_mes&"
next
setallfiles=uploadfolder.Files
foreachfileiteminallfiles
fso_mes=fso_mes&"
Next
fso_mes=fso_mes&"
"
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="父目录:"&f2.parentfolder&
"
"
s_mess=s_mess&"文件名称："&f2.name&"
"
s_mess=s_mess&"文件短路径名："&f2.shortPath&"
"
s_mess=s_mess&"文件物理地址："&f2.Path&"
"
s_mess=s_mess&"文件属性："&f2.Attributes&"
"
s_mess=s_mess&"文件大小："&f2.size&"
"
s_mess=s_mess&"文件类型："&f2.type&"
"
s_mess=s_mess&"文件创建时间："&f2.DateCreated&"
"
s_mess=s_mess&"最近访问时间:"&f2.DateLastAccessed&"
"
s_mess=s_mess&"最近修改时间:"&f2.DateLastModified&"
"
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%>
Functiondeltext(file,mode)
Dimdeltext_mess
deltext_mess=""
SelectCasekillint(mode,0,0,2)
Case0:
deltext_mess=deltext_mess&"文件操作:属性编辑移动复制重命名删除"=red>=red>
Case1:
deltext_mess=deltext_mess&"文件夹操作:列表创建目录手建文件上传文件移动复制重命名删除"=red>
EndSelect
deltext_mess=deltext_mess&""
deltext=deltext_mess
EndFunction
以上就是关于FSO操作文件系统的详细教程了，想必都了解了吧，更多相关内容请继续关注错新技术频道。