下面是小編給大家分享的一篇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&"/","http://","/")
Else
path=Replace(Lcase(path),"/","/")
path=Replace(path&"/","http://","/")
EndIf
ifnotfso.folderexists(path)Then
response.write"
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("
response.End
EndIf
'F_FileType=Ucase(F_File.FileExt)
'IFF_File.FileSize>90000Then
'Response.Write("
'exitsub
IFIsvalidFileName(F_FileName)=FalseThen
Response.Write("
Else
DimFileIsExists
SetFSO=Server.CreateObject("Scripting.FileSystemObject")
FileIsExists=FSO.FileExists(path&F_FileName)
IfFileIsExists=TrueAndmode1Then
fso.deletefile(path&F_FileName)
Response.Write("
F_File.SaveToFilepath&F_FileName
Response.Write("
ElseIfFileIsExists=TrueAndmode=1Then
Response.Write("
Else
F_File.SaveToFilepath&F_FileName
Response.Write("
EndIf
EndIF
SetF_File=Nothing
SetFileUP=Nothing
Else
Dimpath,nn,mmode
nn=Trim(request("nn"))
mmode=Trim(request("mode"))
path=Replace(request("path"),"http://","/")
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&"/","http://","/")&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="
"
EndFunction
'FSO文件目錄
Functionshowallfile(path)
'OnErrorResumeNext
path=Replace(path,"http://","/")
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,"http://","/")
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&"文件操作:屬性
Case1:
deltext_mess=deltext_mess&"文件夾操作:列表創建目錄手建文件上傳文件移動復制重命名
EndSelect
deltext_mess=deltext_mess&""
deltext=deltext_mess
EndFunction
以上就是關于FSO操作文件系統的詳細教程了，想必都了解了吧，更多相關內容請繼續關注錯新技術頻道。
新聞熱點
疑難解答
