FSO操作文件系统_ASP教程-查字典教程网

摘要：实现功能：文件(夹)目录列表提供了查阅目录下面的文件和文件夹文件写,创,删提供了编辑,删除文件(文件夹)的操作创建文件夹/文件针对创建文件夹...

实现功能：

文件(夹)目录列表提供了查阅目录下面的文件和文件夹

文件写,创,删提供了编辑,删除文件(文件夹)的操作

创建文件夹/文件针对创建文件夹(文件)而设置.

上传文件您可以模拟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'>基本路径查找失败,返回</a>"

response.End

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'>空文件,请返回</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'>名称有误</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'>文件已经存在,已经被删除</a>;")

F_File.SaveToFilepath&F_FileName

Response.Write("<ahref='upfso.asp?action=fso&path="&path&"'><fontcolor='#000080'>点击这里继续上传:"&path&F_FileName&"</a>")

ElseIfFileIsExists=TrueAndmode=1Then

Response.Write("<fontcolor='#000080'>文件已经存在,您选择了不覆盖")

Else

F_File.SaveToFilepath&F_FileName

Response.Write("<ahref='upfso.asp?action=fso&path="&path&"'><fontcolor='#000080'>点击这里继续上传:"&path&F_FileName&"</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

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

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

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="发生错误: 错误Number："&err.Number&" 错误信息:"&err.Description&" 出错文件："&err.Source&" 出错行："&err.Line&"(不被支持) "&err

response.write(err_mess)

Endif

EndFunction

'警告:

Functionwarn_red(mess)

warn_red="<fontcolor=red>跟踪:"&mess&" "

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("<fontcolor=""#00008b"">父目录:<ahref=""default.asp?action=fso&this=top&path="&uploadfolder.parentfolder&""">

"&uploadfolder.parentfolder&"</a> ")

EndIf

response.write("目录大小:"&int(uploadfolder.size/1024)&"KB ")

setobjSubFolders=uploadfolder.Subfolders

Dimfso_mes

fso_mes="<ol>"

foreachobjSubFolderinobjSubFolders

fso_mes=fso_mes&"<li><ahref=""default.asp?action=fso&this=top&path="&path&"/"&objSubFolder.name&"""><fontcolor=blue>"&objSubFolder.name&"</a></li>"

setallfiles=uploadfolder.Files

foreachfileiteminallfiles

fso_mes=fso_mes&"<li><ahref=""default.asp?action=fso&this=file&path="&path&"/"&fileitem.Name&""">"&fileitem.Name&"</a></li>"

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""><fontcolor=""#00008b"">父目录:<ahref=""default.asp?action=fso&this=top&path="&f2.parentfolder&""">"&f2.parentfolder&

"</a> "

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&" </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>

</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>编辑</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>删除</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>删除</a>"

EndSelect

deltext_mess=deltext_mess&"</div>"

deltext=deltext_mess

EndFunction