首页 > 编程 > ASP > 正文

FSO操作文件系统的详细教程

2024-05-04 11:05:02
字体:
来源:转载
供稿:网友

  下面是小编给大家分享的一篇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="

  1. "

     

      foreachobjSubFolderinobjSubFolders

      fso_mes=fso_mes&"

  2. "&objSubFolder.name&"=blue>
  3. "

     

      next

      setallfiles=uploadfolder.Files

      foreachfileiteminallfiles

      fso_mes=fso_mes&"

  4. "&fileitem.Name&"
  5. "

     

      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操作文件系统的详细教程了,想必都了解了吧,更多相关内容请继续关注错新技术频道。

发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表