asp和fso实现上传文件

'---------------------------------------------------------------------------------------------------1.asp

<!--#include file="function.asp" -->
<%if Request.Cookies("venshop")("user_name")<>"" then%>'当用户登录时可以执行then
<script>
   function checkAll(){
   for (i=0;i<document.forms[0].length;i++){
    if (document.forms[0][i].tagName=="INPUT"){
    if (document.forms[0][i].type=="radio")
     {document.forms[0][i].checked="checked"}
    }
   }
   }
</script>

<style type="text/css">
<!--
.STYLE1 {
 color: #CC3300;
 font-size: 13px;
 font-family: "宋体";
 font-weight: bold;
}
.STYLE5 {
 font-family: "宋体";
 color: #FF0000;
}
.STYLE7 {
 font-family: "宋体";
 font-size: 13px;
}
-->
</style>
<script language="javascript">
<!--
function checkform1()
{

if (form1.AttPath.value=="")
{
alert("请输入名称！")
form1.AttPath.focus()
return false
}
if (form1.pic.value=="")
{
alert("请选择上传文件！")
form1.pic.focus()
return false
}
return true
}

//-->
</script>
<%                                                                                           '遍历uploadfile文件夹
AttPath=Request.QueryString("AttPath")
  if len(AttPath)<1 then
    AttPath="uploadfile"
   elseif bc(server.mapPath(AttPath),server.mapPath("uploadfile")) then
    AttPath="uploadfile"
   end If

ArrFolders=split(getPathList(AttPath)(0),"*")
Arrfiles=split(getPathList(AttPath)(1),"*")
'response.write (AttPath&"<br>")

if AttPath<>"uploadfile" then
    arrUpFolders=split(AttPath,"/")
    for i=0 to ubound(arrUpFolders)-1
    arrUpFolder=arrUpFolder&TempF&arrUpFolders(i)
    TempF="/"
    next
end if
%>
<table width="100%" border="0" cellspacing="0">

 '表单中使用enctype="multipart/form-data"会出现表单中的除了type="file"，的文件可以上传其他的文本框中的值都是不能传递的，所以通过用javascript脚本，来实现值的传递。
<form name="form1" enctype="multipart/form-data" action="upload.asp" method="post" onSubmit="return checkform1()">
<tr>
  <td bgcolor="#ff9600" colspan="5"height="2"></td>
</tr>
<tr>
<td colspan="2">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="0">
  <tr>
    <td width="9%" align="center"><a href="keshikongjian.asp"><img src="images/fhmu.gif" alt="" width="83" height="26" /></a></td>
    <td width="17%" align="center"><%
if len(arrUpFolder)>0 then
  %>
        <% response.write "<a href=""?AttPath="&arrUpFolder&"""><img src=images/fanhui.gif></a><br>"%>
        <%else%>
      <img src=images/fanhui1.gif>
        <%end if%></td>
    <td width="10%" align="left"><a href="cjwjj.asp"><img src="images/xinjianwenjan.gif" alt="" width="110" height="26" /></a></td>
    <td width="31%"><a href="scwj.asp"><img src="images/shangchuan.gif" alt="" width="53" height="26" /></a></td>
    <td width="33%">&nbsp;</td>
  </tr>
</table></td>
</tr>

<tr>
  <td bgcolor="#ff9600" colspan="5"height="1"></td>
  </tr>
<tr></tr>
<tr>
  <td width="16%" align="right">请选择上传位置：</td>
  <td width="84%"><input name="AttPath" type="text" class="input1" value="<%=AttPath%>" size="30" /></td>
</tr>

<tr>
  <td width="16%" align="right">上传文件：</td>
  <td width="84%"><input type="file" name="pic" size="30" maxlength="20" class="input1" οnblur="document.all.picview.src=document.all.pic.value" /></td>
  </tr>
<tr>
  <td align="right">&nbsp;</td>
  <td><%
for each ArrFolder in ArrFolders
   response.write "<input name=""add"" type=""radio"" value="""&AttPath&"/"&ArrFolder&"""/>&nbsp;<img src=images/wenjianjia.gif>&nbsp;<a href=""?AttPath="&AttPath&"/"&ArrFolder&""">"&ArrFolder&"</a><br>"
next
for each Arrfile in Arrfiles
 'response.write "<input name=""Files"" type=""checkbox"" value="""&AttPath&"/"&Arrfile&"""/>&nbsp;<a href="""&AttPath&"/"&Arrfile&""" target=""_blank"">"&Arrfile&"</a>&nbsp;&nbsp;"&getFileInfo(AttPath&"/"&Arrfile)(0)&" | "&getFileInfo(AttPath&"/"&Arrfile)(2)&" | "&getFileInfo(AttPath&"/"&Arrfile)(3)&"<br>"
next
%></td>
</tr>
<tr>
  <td bgcolor="#ff9600" colspan="2" height="1"></td>
  </tr>
<tr>
<td width="16%" align="right">　</td>
<td width="84%"><input type="submit" value=" o k " class="inputbtn"></td>
</tr>
<tr>
<td bgcolor="#ff9600" colspan="2"height="1"></td>
</tr>
</form>
</table>
<%else%>'如果用户没有登录就执行else退回到ksyx.asp页面中。
<%response.write"<script language=javascript>alert('对不起您还未登录！或您权限不够！');window.location='ksyx.asp';</script>"
response.write"javascript:history.go(-1)</script>"
response.end%>
<%end if%>

 

 

 

 

 

'---------------------------------------------------------------------------------------------function.asp

<%
function getPathList(pathName) '获得路径的文件信息
dim FSO,ServerFolder,getInfo,getInfos,tempS
 getInfo=""
        Set FSO=Server.CreateObject("Scripting.FileSystemObject")
        Set ServerFolder=FSO.GetFolder(Server.MapPath(pathName))
            Dim ServerFolderList,ServerFolderEvery
            Set ServerFolderList=ServerFolder.SubFolders
            tempS=""
            For Each ServerFolderEvery IN ServerFolderList
        getInfo=getInfo&tempS&ServerFolderEvery.Name
        tempS="*"
            Next
      getInfo=getInfo&"|"
            Dim ServerFileList,ServerFileEvery
            Set ServerFileList=ServerFolder.Files
            tempS=""
            For Each ServerFileEvery IN ServerFileList
        getInfo=getInfo&tempS&ServerFileEvery.Name
        tempS="*"
            Next
    Set FSO=Nothing
    getInfos=split(getInfo,"|")
    getPathList=getInfos
end function

function getFileInfo(FileName) '获取文件信息
 dim FSO,File,FileInfo(3)
 Set FSO=Server.CreateObject("Scripting.FileSystemObject")
 if FSO.FileExists(Server.MapPath(FileName)) then
  Set File=FSO.GetFile(Server.MapPath(FileName))
  FileInfo(0)=File.Size
  if FileInfo(0)/1000>1 then
   FileInfo(0)=int(FileInfo(0)/1000)&" KB"
  else
   FileInfo(0)=FileInfo(0)&" Bytes"
  end if
  FileInfo(1)=lcase(right(FileName,4))
  FileInfo(2)=File.DateCreated
  FileInfo(3)=File.Type
 end if
  getFileInfo=FileInfo
 Set FSO=Nothing
end function

function bc(t,s)
 dim tl,sl,i
 bc=false
 sl=len(s)
 tl=len(t)
 if tl< sl then bc=true:exit function
 for i=1 to sl
 if mid(t,i,1)<>mid(s,i,1) then bc=true:exit function
 next
end function
%>

 

 

 

'---------------------------------------------------------------------------------------------upload.asp

<!--#include file="savefile.asp"-->
<%
AttPath=request("AttPath")
Set objStream = Server.CreateObject("ADODB.Stream")

objstream.mode=3
objStream.Type = 1
objStream.Open

objstream.write Request.BinaryRead(Request.TotalBytes)

AttPath= getvalue("AttPath",true,"")

pic=getvalue("pic",false,""&AttPath&"/")        '上传文件到AttPath/路径下
objstream.close
response.write("AttPath:"+AttPath)             '输出AttPath路径
response.write("<br>")
response.write ("文件已上传!("+pic+")")
response.write"<script language=javascript>alert('上传成功！');window.location='scwj.asp';</script>"
response.write"javascript:history.go(-1)</script>"
response.end
%>

 

 

 

'---------------------------------------------------------------------------------------------savefile.asp

<%
Dim stream1,stream2,istart,iend,filename
istart=1
vbEnter=Chr(13)&Chr(10)

function getvalue(fstr,foro,paths)'fstr为接收的名称，foro布尔false为文件上传,true 为普通字段，path为上传文件存放路径
if foro then
getvalue=""
istart=instring(istart,fstr)

istart=istart+len(fstr)+5
iend=instring(istart,vbenter+"-----------------------------")
if istart>5+len(fstr) then
getvalue=substring(istart,iend-istart)

else
getvalue=""
end if
else
istart=instring(istart,fstr)
istart=istart+len(fstr)+13
iend=instring(istart,vbenter)-1

filename=substring(istart,iend-istart)
filename=getfilename(filename)

istart=instring(iend,vbenter+vbenter)+3
iend=instring(istart,vbenter+"-----------------------------")
filestart=istart
filesize=iend-istart-1
objstream.position=filestart
Set sf = Server.CreateObject("ADODB.Stream")
sf.Mode=3
sf.Type=1
sf.Open
objstream.copyto sf,FileSize

if filename<>"" then
Set rf = Server.CreateObject("Scripting.FileSystemObject")
i=0
fn=filename
while rf.FileExists(server.mappath(paths+fn))

fn=cstr(i)+filename
i=i+1
wend
filename=fn
sf.SaveToFile server.mappath(paths+filename),2
end if
getvalue=filename
end if

end function

Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1)
Else
GetFileName = ""
End If
End function

Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to objStream.Size-theLen
if i>objstream.size then exit Function

objstream.Position=i-1
if AscB(objstream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if objstream.EOS then
inString=0
Exit for
end if
if AscB(objstream.Read(1))<>AscB(MidB(Str,j,1)) then
InString=0
Exit For
end if
next
if InString<>0 then Exit Function
end if
next
End Function

function toByte(Str)
dim i,iCode,c,iLow,iHigh
toByte=""
For i=1 To Len(Str)
c=mid(Str,i,1)
iCode =Asc(c)
If iCode<0 Then iCode = iCode + 65535
If iCode>255 Then
iLow = Left(Hex(Asc(c)),2)
iHigh =Right(Hex(Asc(c)),2)
toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
Else
toByte = toByte & chrB(AscB(c))
End If
Next
End function

Function subString(theStart,theLen)
dim i,c,stemp
objStream.Position=theStart-1
stemp=""
for i=1 to theLen
if objStream.EOS then Exit for
c=ascB(objStream.Read(1))
If c > 127 Then
if objStream.EOS then Exit for
stemp=stemp&Chr(AscW(ChrB(AscB(objStream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&Chr(c)
End If
Next
subString=stemp
End function
%>