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%"> </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" onblur="document.all.picview.src=document.all.pic.value" /></td>
</tr>
<tr>
<td align="right"> </td>
<td><%
for each ArrFolder in ArrFolders
response.write "<input name=""add"" type=""radio"" value="""&AttPath&"/"&ArrFolder&"""/> <img src=images/wenjianjia.gif> <a href=""?AttPath="&AttPath&"/"&ArrFolder&""">"&ArrFolder&"</a><br>"
next
for each Arrfile in Arrfiles
'response.write "<input name=""Files"" type=""checkbox"" value="""&AttPath&"/"&Arrfile&"""/> <a href="""&AttPath&"/"&Arrfile&""" target=""_blank"">"&Arrfile&"</a>  "&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
%>