CSDN博客

img iuhxq

FSO操作示例(给初学者)

发表于2004/6/3 16:59:00  3473人阅读

截图:
截图
代码如下:

<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">
<meta http-equiv="Expires" CONTENT="0">
<meta http-equiv="Cache-Control" CONTENT="no-cache">
<meta http-equiv="Pragma" CONTENT="no-cache">
<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("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
%>
<body onload="document.form1.password.focus();">
<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="登陆">
<br><br><br><br><br><br>
版权所有:<a href="http://Asp2004.net" target="_blank">http://Asp2004.net</a>
</center>
</form>
</body>
<%
response.End
End If

'保存上传

If action = "saveupload" Then
    On Error Resume Next
    server.ScriptTimeout = 999
    Const filetype = ".bmp.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

Set fso = CreateObject("Scripting.FileSystemObject")

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("foldername")
        filename = request("filename")
        Path = foldername
        If Path = "" Then Path = server.MapPath("./")
        ShowFolderList(Path)
End Select

Set fso = Nothing

'列出文件和文件夹

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, "/", "/")
    upfolderspec = fso.GetParentFolderName(folderspec&"/")
 Set f = fso.GetFolder(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="<%= url%>">返回首页</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="54%" align="center">名称</td>
    <td width="17%" align="right">大小<%= formatnumber(f.size/1024,2)%>K</td>
    <td width="6%" align="center">类型</td>
    <td width="15%">修改时间</td>
    <td width="8%" align="center">操作</td>
  </tr>
<%
'列出目录
Set fc = f.SubFolders
For Each f1 in fc
%>
  <tr bgcolor="#EEEEEE" onmouseover=this.bgColor='#F3F6FA'; onmouseout=this.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%>" onclick="return confirm('删除文件夹 <%= f1.name%> ?');">删除</a></td>
  </tr>
<%
Next
'列出文件
Set fc = f.Files
For Each f1 in fc
%>
  <tr bgcolor="#EFEFEF" onmouseover=this.bgColor='#F3F6FA'; onmouseout=this.bgColor='#EEEEEE';>
    <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%>" onclick="return confirm('删除文件 <%= f1.name%> ?');">删除</a></td>
  </tr>
<%
Next
%>
</table>
<%
End Function

'文件操作

'删除文件

Function delfile()
    filename = request("filename")
    fso.DeleteFile(filename)
    tempurl = url&"?foldername="&fso.GetParentFolderName(filename)
    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
        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)
    End If
    response.Redirect(tempurl)
End Function

'新文件

Function filenew()
    filename = request("filename")
    content = ""
    fileform filename, content, filename1
End Function

'编辑文件

Function fileedit()
    filename = request("filename")
    filename1 = request("filename")
    Set f1 = fso.OpenTextFile(filename, 1, true)
    content = server.HTMLEncode(f1.ReadAll)
    f1.Close
    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" onclick="return confirm('保存 '+filename.value+' ?');" value="保存">
    <input type="reset" class="tx1" value="重置">
    </center></td></tr>
</form>
</table>
<%
End Function

'文件夹操作函数

Function delfolder()
    foldername = request("foldername")
    tempurl = url&"?foldername="&fso.GetParentFolderName(foldername)
    fso.DeleteFolder(foldername)
    response.Redirect(tempurl)
End Function

'保存文件夹

Function savefolder()
    foldername = request.Form("foldername")
    foldername1 = request.Form("foldername1")
    If foldername1 = "" Then
        Set f = fso.CreateFolder(foldername)
    Else
        fso.MoveFolder foldername1, foldername
    End If
    tempurl = url&"?foldername="&f
    response.Redirect(tempurl)
End Function

'新文件夹

Function newfolder()
    foldername = request("foldername")&"/"
    formfolder foldername, foldername1
End Function

'编辑文件夹

Function editfolder()
    foldername = request("foldername")
    foldername1 = request("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" onclick="return confirm('保存 '+foldername.value+' ?');" value="保存">
    <input type="reset" class="tx1" value="重置">
    </center></td></tr>
</form>
  </table>
<%
End Function

'上传表单

Function uploadform()
%>
<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="<%= url%>?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 name="upcount" class="tx" value="1"><input type="button" class="tx1" onclick="setid();" value="设定">
<li>上传到:<input name="filepath" class="tx" value="<%= request("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"></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>
<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>
<%
End Function

'注销

Function logout()
    session.Abandon()
    response.Redirect(url)
End Function
%>

0 0

相关博文

我的热门文章

img
取 消
img