FSO操作示例

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft
Class upload_5xsoft
dim objForm,objFile,Version
Public function Form(strForm)
   strForm=lcase(strForm)
   if not objForm.exists(strForm) then
     Form=""
   else
     Form=objForm(strForm)
   end if
 end function
Public function File(strFile)
   strFile=lcase(strFile)
   if not objFile.exists(strFile) then
     set File=new FileInfo
   else
     set File=objFile(strFile)
   end if
 end function
Private Sub Class_Initialize
  dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
  dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
  Version="化境HTTP上传程序 Version 2.0"
  set objForm=Server.CreateObject("Scripting.Dictionary")
  set objFile=Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes<1 then Exit Sub
  set tStream = Server.CreateObject("adodb.stream")
  set Data_5xsoft = Server.CreateObject("adodb.stream")
  Data_5xsoft.Type = 1
  Data_5xsoft.Mode =3
  Data_5xsoft.Open
  Data_5xsoft.Write  Request.BinaryRead(Request.TotalBytes)
  Data_5xsoft.Position=0
  RequestData =Data_5xsoft.Read
  iFormStart = 1
  iFormEnd = LenB(RequestData)
  vbCrlf = chrB(13) & chrB(10)
  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
  iStart = LenB (sStart)
  iFormStart=iFormStart+iStart+1
  while (iFormStart + 10) < iFormEnd
 iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
 tStream.Type = 1
 tStream.Mode =3
 tStream.Open
 Data_5xsoft.Position = iFormStart
 Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
 tStream.Position = 0
 tStream.Type = 2
 tStream.Charset ="gb2312"
 sInfo = tStream.ReadText
 tStream.Close
 iFormStart = InStrB(iInfoEnd,RequestData,sStart)
 iFindStart = InStr(22,sInfo,"name=""",1)+6
 iFindEnd = InStr(iFindStart,sInfo,"""",1)
 sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
 if InStr (45,sInfo,"filename=""",1) > 0 then
  set theFile=new FileInfo
  iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
  iFindEnd = InStr(iFindStart,sInfo,"""",1)
  sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
  theFile.FileName=getFileName(sFileName)
  theFile.FilePath=getFilePath(sFileName)
  iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
  iFindEnd = InStr(iFindStart,sInfo,vbCr)
  theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
  theFile.FileStart =iInfoEnd
  theFile.FileSize = iFormStart -iInfoEnd -3
  theFile.FormName=sFormName
  if not objFile.Exists(sFormName) then
    objFile.add sFormName,theFile
  end if
 else
  tStream.Type =1
  tStream.Mode =3
  tStream.Open
  Data_5xsoft.Position = iInfoEnd
  Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
  tStream.Position = 0
  tStream.Type = 2
  tStream.Charset ="gb2312"
         sFormValue = tStream.ReadText
         tStream.Close
  if objForm.Exists(sFormName) then
    objForm(sFormName)=objForm(sFormName)&", "&sFormValue   
  else
    objForm.Add sFormName,sFormValue
  end if
 end if
 iFormStart=iFormStart+iStart+1
 wend
  RequestData=""
  set tStream =nothing
End Sub
Private Sub Class_Terminate 
 if Request.TotalBytes>0 then
 objForm.RemoveAll
 objFile.RemoveAll
 set objForm=nothing
 set objFile=nothing
 Data_5xsoft.Close
 set Data_5xsoft =nothing
 end if
End Sub
 Private function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = left(FullPath,InStrRev(FullPath, "/"))
  Else
   GetFilePath = ""
  End If
 End  function
 
 Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1)
  Else
   GetFileName = ""
  End If
 End  function
End Class
Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart
  Private Sub Class_Initialize
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
    FileType = ""
  End Sub
 
 Public function SaveAs(FullPath)
    dim dr,ErrorChar,i
    SaveAs=true
    if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
    set dr=CreateObject("Adodb.Stream")
    dr.Mode=3
    dr.Type=1
    dr.Open
    Data_5xsoft.position=FileStart
    Data_5xsoft.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing
    SaveAs=false
  end function
  End Class
</SCRIPT>
<title>WEB文件管理器1.0版 http://asp2004.net</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
<!--
a:link {
 font-size: 9pt;
}
a:visited {
 font-size: 9pt;
}
a:hover {
 font-size: 9pt;
}
a:active {
 font-size: 9pt;
}
body {
 font-size: 9pt;
 margin-left: 0px;
 margin-top: 0px;
 margin-right: 0px;
 margin-bottom: 0px;
 line-height: 20px;
 background-color: #EEEEEE;
}
td {
 font-size: 9pt;
 line-height: 20px;
}
.tx {
 border-color:#000000;
 border-left-width: 0px;
 border-top-width: 0px;
 border-right-width: 0px;
 border-bottom-width: 1px;
 font-size: 9pt;
 background-color: #EEEEEE;
}
.tx1 {
 font-size: 9pt;
 border: 1px solid;
 border-color:#000000;
 color: #000000;
}
-->
</style>
<%
'版权声明：未经作者书面许可不得用于商业用途。
'QQ：103895
'http://asp2004.net
action=request.QueryString("action")
temp=split(request.ServerVariables("URL"),"/")
url=temp(ubound(temp))
Const pass="ok"'登陆密码
'登陆验证
if request("password")=pass then
 session("login")=pass
 response.Redirect(url)
elseif session("login")="" then
%>
<br><br><br><br><br>
<form name="form1" method="post" action="<%= url%>?action=chklogin">
<center>请输入密码：<input name="password" type="password" class="tx">
<input type="submit" class="tx1" value="登陆">
</center>
</form>
<%
response.end
end if

if action="saveupload" then
 On Error Resume Next
 server.ScriptTimeout=999
 Const filetype=".gif.jpg.png.rar.zip.txt."'允许上传的文件类型。以.分隔
 Const MaxSize=2097152'允许的文件大小
 dim upload,file,formName,formPath
 set upload=new upload_5xsoft
 if upload.form("filepath")<>"" then
  formPath=upload.form("filepath")
  if right(formPath,1)<>"/" then formPath=formPath&"/"
  Set mypath=Server.CreateObject("Scripting.FileSystemObject")
  if mypath.FolderExists(server.MapPath("./")&"/"&formPath)<>true then
   mypath.CreateFolder(server.MapPath("./")&"/"&formPath)
  end if
  for each formName in upload.objFile
   set file=upload.file(formName)
   temp=split(file.FileName,".")
   fileExt=temp(ubound(temp))
   if inStr(1,filetype,lcase(fileExt))>0 or upload.form("uppass")=pass then
    if upload.form("checkbox")="true" then
     randomize
     ranNum=int(90000*rnd)+10000
     filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt
    else
     filename=file.FileName
    end if
    if file.FileSize>0 and (file.FileSize<MaxSize or upload.form("uppass")=pass) then
     file.SaveAs Server.mappath(formPath&filename)
    end if
    set file=nothing
   end if
  next
 end if
 response.Write("<script language='javascript'>window.opener.location.reload();self.close();</script>")
 set upload=nothing
end if

select case action
case "logout"
 logout()
case "delfile"
 delfile()
case "savefile"
 savefile()
case "editfile"
 fileedit()
case "newfile"
 filenew()
case "delfolder"
 delfolder()
case "savefolder"
 savefolder()
case "editfolder"
 editfolder()
case "newfolder"
 newfolder()
case "uploadform"
 uploadform()
case else
 foldername=request.QueryString("foldername")
 filename=request.QueryString("filename")
 path=foldername
 if path="" then path=server.MapPath("./")
 ShowFolderList(path)
end select

Function ShowFolderList(folderspec)
temp=request.ServerVariables("HTTP_REFERER")
temp=left(temp,Instrrev(temp,"/"))
temp1=len(folderspec)-len(server.MapPath("./"))-1
if temp1>0 then
 temp1=right(folderspec,cint(temp1))+"/"
elseif temp1=-1 then
 temp1=""
end if
tempurl=temp+replace(temp1,"/","/")
uppath="./"+replace(temp1,"/","/")
Set fso = CreateObject("Scripting.FileSystemObject")
upfolderspec=fso.GetParentfoldername(folderspec&"/")
%>
<a href="<%= url%>?action=newfolder&foldername=<%= folderspec%>">新建文件夹</a> | <a href="<%= url%>?action=newfile&filename=<%= folderspec&"/"%>">新建文件</a> | <a href="#"onClick="javascript:window.open('<%= url%>?action=uploadform&filepath=<%= uppath%>','new_page','width=600,height=260,left=100,top=100,scrollbars=auto');return false;">上传文件</a> | <a href="<%= url%>?foldername=<%= upfolderspec%>">向上</a> | <a href="file.asp">返回首页</a> | <a href="<%= url%>?action=logout">退出</a>
<table width="100%" height="24" border="1" cellpadding="0" cellspacing="0" bordercolor="#FFFFFF" bordercolorlight="#FFFFFF" bordercolordark="#000000">
  <tr bgcolor="#CCCCCC">
    <td width="64%" align="center">名称</td>
    <td width="7%" align="right">大小</td>
    <td width="6%" align="center">类型</td>
    <td width="15%">修改时间</td>
    <td width="8%" align="center">操作</td>
  </tr>
<%
'列出目录
Set f = fso.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 in fc
%>
  <tr bgcolor="#EEEEEE">
    <td><a href="<%= url%>?foldername=<%= folderspec%>/<%= f1.name%>"><%= f1.name%></a></td>
    <td align="right"><%= f1.size%></td>
    <td>文件夹</td>
    <td><%= f1.datelastmodified%></td>
    <td><a href="<%= url%>?action=editfolder&foldername=<%= folderspec&"/"&f1.name%>">修改</a> <a href="<%= url%>?action=delfolder&foldername=<%= folderspec&"/"&f1.name%>" οnclick="return confirm('删除文件夹<<%= f1.name%>>么?');">删除</a></td>
  </tr>
<%
Next
'列出文件
Set fc = f.Files
For Each f1 in fc
%>
  <tr bgcolor="#EFEFEF">
    <td><a href="<%= tempurl+f1.name%>" target="_blank"><%= f1.name%></a></td>
    <td align="right"><%= f1.size%></td>
    <td>文件</td>
    <td><%= f1.datelastmodified%></td>
    <td><a href="<%= url%>?action=editfile&filename=<%= folderspec&"/"&f1.name%>">修改</a> <a href="<%= url%>?action=delfile&filename=<%= folderspec&"/"&f1.name%>" οnclick="return confirm('删除文件<<%= f1.name%>>么?');">删除</a></td>
  </tr>
<%
Next
set fso=nothing
%>
</table>
<%
End Function
'文件操作
function delfile()
 filename=request.QueryString("filename")
 set fso=server.CreateObject("scripting.filesystemobject")
 fso.deletefile(filename)
 tempurl=url&"?foldername="&fso.GetParentfoldername(filename)
 set fso=nothing
 response.Redirect(tempurl)
end function

function savefile()
 filename=request.Form("filename")
 content=request.Form("content")
 filename1=request.Form("filename1")
 if request.ServerVariables("PATH_TRANSLATED")<>filename then
  set fso=server.CreateObject("scripting.filesystemobject")
  if filename1<>"" and filename1<>filename then
   fso.movefile filename1,filename
  else
   set f1=fso.opentextfile(filename,2,true)
   f1.write(content)
   f1.close
  end if
  tempurl=url&"?foldername="&fso.GetParentfoldername(filename)
  set fso=nothing
 end if
 response.Redirect(tempurl)
end function

function filenew()
 filename=request.QueryString("filename")
 content=""
 fileform filename,content,filename1
end function

function fileedit()
 filename=request.QueryString("filename")
 filename1=request.QueryString("filename")
 set fso=server.CreateObject("scripting.filesystemobject")
 set f1=fso.opentextfile(filename,1,true)
 content=server.HTMLEncode(f1.readall)
 f1.close
 set fso=nothing
 fileform filename,content,filename1
end function

function fileform(filename,content,filename1)
%>
<table width="100%"  border="0" align="center" cellpadding="0" cellspacing="0">
<form name="form1" method="post" action="<%= url%>?action=savefile">
    <tr><td><input name="filename1" type="hidden" value="<%= filename1%>"><input name="filename" type="text" class="tx" style="width:100%" value="<%= filename%>"></td></tr>
    <tr><td><textarea name="content" wrap="VIRTUAL" class="tx" style="width:100%;height:100%;font:Arial,Helvetica,sans-serif;" onKeyUp="style.height=this.scrollHeight;"><%= content%></textarea></td></tr>
    <tr><td><center><input type="submit" class="tx1" value="保存">
    <input type="reset" class="tx1" value="重置">
    </center></td></tr>
</form>
</table>
<%
end function
'文件夹操作函数
function delfolder()
 foldername=request.QueryString("foldername")
 set fso=server.CreateObject("scripting.filesystemobject")
 tempurl=url&"?foldername="&fso.GetParentfoldername(foldername)
 fso.deletefolder(foldername)
 set fso=nothing
 response.Redirect(tempurl)
end function

function savefolder()
 foldername=request.Form("foldername")
 foldername1=request.Form("foldername1")
 set fso=server.CreateObject("scripting.filesystemobject")
 if foldername1="" then
  set f=fso.createfolder(foldername)
 else
  fso.MoveFolder foldername1,foldername
 end if
 tempurl=url&"?foldername="&f
 set fso=nothing
 response.Redirect(tempurl)
end function

function newfolder()
 foldername=request.QueryString("foldername")&"/"
 formfolder foldername,foldername1
end function

function editfolder()
 foldername=request.QueryString("foldername")
 foldername1=request.QueryString("foldername")
 formfolder foldername,foldername1
end function

function formfolder(foldername,foldername1)
%>
  <table width="100%" height="24" border="0">
<form name="form1" method="post" action="<%= url%>?action=savefolder">
    <tr><td><input name="foldername1" type="hidden" value="<%= foldername1%>"><input name="foldername" type="text" class="tx" style="width:100%" value="<%= foldername%>"></td></tr>
    <tr><td><center><input type="submit" class="tx1" value="保存">
    <input type="reset" class="tx1" value="重置">
    </center></td></tr>
</form>
  </table>
<%
end function

'上传表单
function uploadform()
%>
<script language="JavaScript">
function exec()
{
 waitting.style.visibility="visible";
 upload.style.visibility="hidden";
}
function setid()
{
 if(window.form1.upcount.value>0)
 {
  str='';
  for(i=1;i<=window.form1.upcount.value;i++)
  str+='文件'+i+':<input type="file" name="file'+i+'" style="width:400" class="tx1"><br>';
  window.upid.innerHTML=str+'';
 }
}
setid();
</script>
<div id=tdcent style='position:relative;left:0;top:0'>
<div id="waitting" style="position:absolute; top:100px; left:240px; z-index:10; visibility:hidden">
<table border="0" cellspacing="1" cellpadding="0" bgcolor="0959AF">
<tr><td bgcolor="#FFFFFF" align="center">
<table width="160" border="0" height="50">
<tr><td valign="top" class="g1"><div align="center">操&nbsp;作&nbsp;执&nbsp;行&nbsp;中<br>请稍候... </div></td></tr>
</table>
</td></tr>
</table>
</div></div>
<div id="upload" style="visibility:visible">
<form name="form1" method="post" action="file.asp?action=saveupload" enctype="multipart/form-data" >
  <table width="100%" height="24" border="1" cellpadding="0" cellspacing="0" bordercolor="#FFFFFF" bordercolorlight="#FFFFFF" bordercolordark="#000000">
    <tr bgcolor="#CCCCCC"><td bgcolor="#CCCCCC">文件上传
      <input type="hidden" name="act" value="upload"></td>
    </tr>
    <tr align="left" bgcolor="#EEEEEE"><td>
<li>需要上传的个数：<input type="text" name="upcount" class="tx" value="1"><input type="button" class="tx1" οnclick="setid();" value="设定">
<li>上传到：<input name="filepath" type="text" class="tx" value="<%= request.QueryString("filepath")%>">
<li>防止覆盖自动重命名<input name="checkbox" type="checkbox" value="true" checked>
<li>密码：<input name="uppass" type="password" class="tx">
      </td></tr>
    <tr><td align="left" id="upid">文件1:<input type="file" name="file1" class="tx1" style="width:400" value=""></td></tr>
    <tr bgcolor="#EEEEEE"><td align="center" bgcolor="#EEEEEE">
          <input type="submit" class="tx1" onClick="exec();" value="提交">
          <input type="reset" class="tx1" value="重置">
          <input type="button" class="tx1" onClick="window.close();" value="取消">
        </td></tr>
  </table>
</form></div>
<%
end function

'注销
function logout()
session.Abandon()
response.Redirect(url)
end function
%>