化境ASP无组件上传类 - upload_5xsoft 使用手册 2.0
what's new
1.使用了网友“梁无惧” 提供的高效的处理方式,上传速度可提高一倍以上,可上传更大的文件。
2.添加了form 方法和file方法,把原来的 form 集和 file改为 objForm 和 objFile,避免了若上传时没有数据会出错的Bug。
3.对多选框的优化,上传同名的多选框时,会自动用 ", " 连接起来。
4.对于表单名,不再区分大小写,使用ASP使用者更习惯。
关于 upload_5xsoft
一直以来,由于FileSystemObject的局限,所以ASP最大的难题就是文件上传,大多解决法就是安装
第三方上传组件。可第三方组件有很多问题,有的组件要注册,有的组件要在表单中加上他的版权信息。
还有的就是组件的兼容问题。
在网上也流传了很多无组件上传的代码,但都是只能上传文本文件,或是只能将文件上传到数据库中。
我这段时间在研究ASP,发现可以不用第三方组件上传任意类型的文件。就写了这个类,给大家一
个方便,整个类放在一个文件中: upload_5xsoft.inc 在 Example 目录下还有一个完整的多文件上传示
例程序,可以直接使用。
申明:源代码是完全开放的,可能随意传播,但请保留其完整性,未经作者同意,不得用于商业。
运行平台与注意事项
a)可直接运行于 Windows2000+IIS 5
NT4 或是 Win98+PWS, 要安装ADO2.6 下载地址:http://www.microsoft.com/data/:
<!--#include FILE="upload_5xsoft.inc"--> 就行了
b) 在使用文件上传时, 表单 form 要加上 enctype="multipart/form-data" 即:
<form name="form1" method="post" action="" enctype="multipart/form-data">
<input type="text" value="abc" name="text1">
<input type=file name="file">
<input type=submit name="submit" value="提交">
</form>
upload_5xsoft的对象
如定义一个上传对象
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft 'upload就是一个对象
%>
upload_5xsoft 对象成员
File 方法,得到文件对象,例如:set file=upload.file("file1")
文件对象成员下面有说明
objFile 文件对象集,(是个dictionary对象)
文件对象成员:
Count 属性,文件表单的个数
FileName 属性,上传文件的名字
FileSize 属性,上传文件的大小(为0是表示没有文件)
FilePath 属性,上传前文件所在的路径
FormName 属性,文件表单的名字
SaveAs 方法,储存上传后文件,有一个参数,路径要为真实路径如:
例子: set file=upload.file("file1") 'file1为表单名
response.write "<br>文件名:"&file.FileName
response.write "<br>文件大小:"&file.FileSize
response.write "<br>文件路径:"&file.FilePath
file.saveAs Server.mappath("/1.jpg")
set file=nothing
Form 方法,获得表单数据,如 Response.Write upload.Form("abc")
objForm 表单数据集,(是个dictionary对象)用来代替 Request.Form
count 属性,表单数
exists 方法,检查是否有指定的表单名
更多的用法可看 vbscript 的dictionary对象帮助
例子:
'得到text1表单的数据,uplaod就是一开始创建的对象
sText=upload.form("text1")
Version 属性,upload_5xsoft类的版本号,如:
response.write upload.Version
使用示例
1.上传一个jpg文件的示例:
文件1: upload.htm
<html><title>example</title>
<body>
<form name="form1" method="post" action="upload.asp" enctype="multipart/form-data">
<input type=file name="file1">
<input type=submit name="submit" value="提交">
</form>
</body>
</html>
文件2: upload.asp
<html><title>example</title>
<body>
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft
set file=upload.file("file1")
response.write upload.form("submit")&"<br>"
if file.fileSize>0 then
file.saveAs Server.mappath("temp.jpg")
response.write "<br>上传文件:"&file.FileName&" => temp.jpg OK!"
response.write "<br>文件大小:"&file.FileSize
end if
set file=nothing
set upload=nothing
%></body>
</html>
2.列表出有文件表单(多文件上传)
<html><title>example</title>
<body>
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft
''列出所有form数据
for each formName in upload.objForm
response.write formName&"="&upload.objForm(formName)&"<br>"
next
''列出所有文件
for each formName in upload.objFile
set file=upload.objFile(formName)
if file.FileSize>0 then
file.SaveAs Server.mappath(file.FileName)
response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "
response.write file.FileName&" 成功!<br>"
end if
set file=nothing
next
set upload=nothing
%>
若程序有问题,请写作者联系 getc@163.com
稻香老农 2003年 1月8日
首先是为了完成上传并且显示进度条所需要的四个包含文件,放入include文件夹
1、wang_upload_5xsoft.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft
Class upload_5xsoft
dim objForm,objFile,Version
'------------------------begin add by mytju.com----------------------------
dim mProgressID,tempFileName
Public Property Get ProgressID()
ProgressID=mProgressID
End Property
Public Property Let ProgressID(byVal itemValue)
mProgressID=itemValue
End Property
'-----------------------end add by mytju.com-----------------------------
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
Public Sub GetUpFile '-----------change by mytju.com------------------------------
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
dim readBlock,readBlockSize,upBytes
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
'------------------------modify begin by mytju.com------------------------------
'---create xml File--------------------
Dim objFSO, objTextFile
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
tempFileName=objFSO.GetSpecialFolder(2)&"\upload_"&mProgressID&".xml"
Set objTextFile = objFSO.CreateTextFile(tempFileName, True)
objTextFile.WriteLine("<?xml version=""1.0"" encoding=""gb2312""?>")
objTextFile.WriteLine("<tree>")
objTextFile.WriteLine("<fileUpProgress myID=""1"">")
objTextFile.WriteLine("<BytesTransferred>0</BytesTransferred>")
objTextFile.WriteLine("<TotalBytes>0</TotalBytes>")
objTextFile.WriteLine("<useTime>1</useTime>")
objTextFile.WriteLine("</fileUpProgress>")
objTextFile.WriteLine("</tree>")
objTextFile.Close
Set objTextFile = Nothing
Set objFSO = Nothing
'---start to upload---------------------
upBytes=0
readBlockSize=1024*100
startTime=Timer()
readBlock=Request.BinaryRead(readBlockSize)
'---create xmlDom------------------------
set objDOM = Server.CreateObject("Microsoft.XMLDOM")
objDOM.async = false
objDOM.load tempFileName
Set objRoot = objDom.documentElement
Set objField = objRoot.selectSingleNode("/tree/fileUpProgress[@myID=1]")
'---loop to get data--------------------
while Lenb(readBlock)>0
upBytes=upBytes+Lenb(readBlock)
'--save value---------
objField.childNodes.item(0).text=Cstr(upBytes)
objField.childNodes.item(1).text=Cstr(Request.TotalBytes)
objField.childNodes.item(2).text=Cstr(Timer()-startTime)
objDom.save tempFileName
'--write to Stream-----
Data_5xsoft.Write readBlock
readBlock=Request.BinaryRead(readBlockSize)
wend
Set objField = Nothing
Set objRoot = Nothing
Set objDom = Nothing
'------------------------modify end by mytju.com------------------------------
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>
2、fileUpProgress.asp
<% @codepage=936 EnableSessionState=False%>
<HTML xmlns:v>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=gb2312">
<TITLE>文件上传进度指示条</TITLE>
<STYLE>
v\:*{behavior:url(#default#VML);}
*{font-size:12px;}
</STYLE>
<style type="text/css">
<!--
font {
font-size: 14px;
}
td {
font-size: 14px;
color: #333333;
}
b {
font-size: 14px;
}
span {
font-size: 14px;
}
a:link {
color: #333333;
text-decoration: none;
}
a:hover {
color: #990000;
text-decoration: underline;
}
a:visited {
color: #000000;
text-decoration: none;
}
-->
</style>
</HEAD>
<BODY topmargin="0" leftmargin="0" onLoad="begin()" bgcolor="#CCCCCC">
<p><br>
<table width="100%" border="0" cellspacing="0" cellpadding="4">
<tr>
<td align="center"><b>文件上传进度指示条</b></td>
</tr>
<tr>
<td>状态:<span ID="myStatus"></span></td>
</tr>
<tr>
<td width="500"><div style="table-Layout:fixed;width:100%;height:100%;border:1 solid black"><v:RoundRect id="myRect" style="height:20;" name="myRect"> <v:fill type="gradient" id="fill1" color="blue"/> </v:RoundRect></div></td>
</tr>
<tr>
<td>已经上传:<span ID="message"></span></td>
</tr>
<tr>
<td>使用时间:<span ID="time">0</span> 秒 </td>
</tr>
<tr>
<td>平均速率:<span ID="speed">0</span> KB/秒 </td>
</tr>
</table>
<script language="Javascript">
self.moveTo(getTop(200),getLeft(500));
var intBytesTransferred=0;
var intTotalBytes=0;
var useTime=1; //s
var getData;
var myWidth=486;
var beginUploadFlg=false;
fill1.color="rgb("+Math.round(Math.random()*255)+","+Math.round(Math.random()*255)+","+Math.round(Math.random()*255)+")";
myStatus.innerHTML="正在初始化....";
function begin()
{
message.innerHTML="开始获取信息....";
var Doc = new ActiveXObject('Microsoft.XMLDOM');
Doc.async = false;
Doc.load("fileUpProgressRead.asp?progressID=<%=Request.QueryString("progressID")%>&aa="+new Date().getTime());
if(Doc.parseError.errorCode != 0) //检查获取数据时是否发生错误
{
delete(Doc);
if(beginUploadFlg){
intBytesTransferred=intTotalBytes;
}else{
message.innerHTML="上传动作尚未启动!";
}
}else{
var rootNode=Doc.documentElement;
if(rootNode.childNodes != null)
{ beginUploadFlg=true;
intBytesTransferred=Number(rootNode.childNodes.item(0).childNodes.item(0).text);
intTotalBytes=Number(rootNode.childNodes.item(0).childNodes.item(1).text);
useTime=Number(rootNode.childNodes.item(0).childNodes.item(2).text);
message.innerHTML="获取信息成功。";
}
delete(rootNode);
}
delete(Doc);
if(intTotalBytes==0){
intBytesTransferred=1;
intTotalBytes=100;
}
display();
if(intTotalBytes>0 && intBytesTransferred<intTotalBytes){
if(beginUploadFlg){
myStatus.innerHTML="正在上传,请耐心等待....";
}
time.innerHTML=useTime;
speed.innerHTML=Math.round((intBytesTransferred/useTime)/1024);
getData = setTimeout("begin()",1000);
}else{
myStatus.innerHTML="数据上传完毕,3秒后自动关闭。";
setTimeout("self.close()",3000);
}
}
function display(){
myRect.style.width=Math.round(myWidth/(intTotalBytes/intBytesTransferred));
fill1.angle=Math.round(300/(intTotalBytes/intBytesTransferred));
if(beginUploadFlg){
message.innerText=intBytesTransferred+"/"+intTotalBytes+","+Math.round(100/(intTotalBytes/intBytesTransferred))+"%";
}
}
function getTop(windowHeight){
var top = parseInt((screen.height - windowHeight)/2-15);
return top;
}
function getLeft(windowWidth){
var left = parseInt((screen.width - windowWidth)/2-5);
return left;
}
</script>
</BODY>
</HTML>
3、fileUpProgressRead.asp
<% @codepage=936 EnableSessionState=False%>
<%
Set fso = Server.CreateObject("Scripting.FileSystemObject")
mProgressID=Request.QueryString("progressID")
filePath=fso.GetSpecialFolder(2)&"\upload_"&mProgressID&".xml"
Set f = fso.OpenTextFile(filePath,1)
response.write f.ReadAll
set f=nothing
set fso=nothing
%>
4、randomString.asp
<% Function gen_key(digits)
dim char_array(80)
For i = 0 To 9
char_array(i) = CStr(i)
Next
For i = 10 To 35
char_array(i) = Chr(i + 55)
Next
For i = 36 To 61
char_array(i) = Chr(i + 61)
Next
Randomize
do while len(output) < digits
num = char_array(Int((62 - 0 + 1) * Rnd + 0))
output = output & num
loop
gen_key = output
End Function %>
下面的文件 在include文件夹外面
测试页面
5、test_upload.asp
<!--#include file="include/randomString.asp" -->
<% ProgressID = gen_key(10) %>
<meta HTTP-EQUIV=Content-Type content="text/html; charset=gb2312">
<form action="test_uploadSave.asp" method="post" enctype="multipart/form-data" onSubmit="myOpen(this)">
文件:<INPUT name="file" type="file" size="20">
文本:<INPUT name="text" type="text" size="20" >
<input type="submit" value="submit">
</form>
<script>
function myOpen(form){
window.open("include/fileUpProgress.asp?progressID=<%=ProgressID%>","","width=500,height=200,scrollbars=no,toolbar=no,status=no,resizable=no,menubar=no,location=no");
var url=form.action;
if (url.indexOf("?",0)==-1) {
form.action = url+"?progressID=<%=ProgressID%>";
}else{
form.action = url+"&progressID=<%=ProgressID%>";
}
}
</script>
6、test_uploadSave.asp
<%@ CODEPAGE="936"%>
<!--#include file="include/wang_upload_5xsoft.inc" -->
<META http-equiv="Content-Type" content="text/html; charset=gb2312">
<%
Server.ScriptTimeOut=300
'--注意下面是写法稍有不同的地方---
set upload=new upload_5xsoft
upload.ProgressID=Request.QueryString("progressID") '一定是这行在先。
upload.GetUpFile
'--结束---其他与以前的写法完全相同-------------
response.write upload.form("text")
set file=upload.file("file")
file.saveas Server.mappath(".")&"\"&file.fileName
set upload=nothing
%>
<br>----------ok-----------
首先,图片在页面中能查找选择。设计表单页面index.asp和上传选择页upload.asp,upload.asp在index.asp中以iframe包含。
其次,所选图片应能上传到某文件夹。建立一文件夹uploadimg
最后,传上去的图片应如何引用?很显然,采用UBB立即显示。upload.asp的指向对象upfile.asp具有写入UBB标签的功能。
无组件上传调试文件夹
-- index.asp
-- upload.asp
-- upfile.asp
-- uploadimg文件夹
图片上传采用稻香老农的无组件上传。所以upload.inc文件必不可少。
1,upload.inc(拷贝以下文本框的所有代码)
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim upfile_5xSoft_Stream
Class upload_5xSoft
dim Form,File,Version
Private Sub Class_Initialize
dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
Version=""
if Request.TotalBytes<1 then Exit Sub
set Form=CreateObject("Scripting.Dictionary")
set File=CreateObject("Scripting.Dictionary")
set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")
upfile_5xSoft_Stream.mode=3
upfile_5xSoft_Stream.type=1
upfile_5xSoft_Stream.open
upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes)
vbEnter=Chr(13)&Chr(10)
iDivLen=inString(1,vbEnter)+1
strDiv=subString(1,iDivLen)
iFormStart=iDivLen
iFormEnd=inString(iformStart,strDiv)-1
while iFormStart < iFormEnd
iStart=inString(iFormStart,"name=""")
iEnd=inString(iStart+6,"""")
mFormName=subString(iStart+6,iEnd-iStart-6)
iFileNameStart=inString(iEnd+1,"filename=""")
if iFileNameStart>0 and iFileNameStart<iFormEnd then
iFileNameEnd=inString(iFileNameStart+10,"""")
mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
if iEnd>iStart then
mFileSize=iEnd-iStart-4
else
mFileSize=0
end if
set theFile=new FileInfo
theFile.FileName=getFileName(mFileName)
theFile.FilePath=getFilePath(mFileName)
theFile.FileSize=mFileSize
theFile.FileStart=iStart+4
theFile.FormName=FormName
file.add mFormName,theFile
else
iStart=inString(iEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
if iEnd>iStart then
mFormValue=subString(iStart+4,iEnd-iStart-4)
else
mFormValue=""
end if
form.Add mFormName,mFormValue
end if
iFormStart=iformEnd+iDivLen
iFormEnd=inString(iformStart,strDiv)-1
wend
End Sub
Private Function subString(theStart,theLen)
dim i,c,stemp
upfile_5xSoft_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
if upfile_5xSoft_Stream.EOS then Exit for
c=ascB(upfile_5xSoft_Stream.Read(1))
If c > 127 Then
if upfile_5xSoft_Stream.EOS then Exit for
stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&Chr(c)
End If
Next
subString=stemp
End function
Private Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to upfile_5xSoft_Stream.Size-theLen
if i>upfile_5xSoft_Stream.size then exit Function
upfile_5xSoft_Stream.Position=i-1
if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if upfile_5xSoft_Stream.EOS then
inString=0
Exit for
end if
if AscB(upfile_5xSoft_Stream.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
Private Sub Class_Terminate
form.RemoveAll
file.RemoveAll
set form=nothing
set file=nothing
upfile_5xSoft_Stream.close
set upfile_5xSoft_Stream=nothing
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
Private 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
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
End Sub
Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=1
if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function
if FileStart=0 or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
upfile_5xSoft_Stream.position=FileStart-1
upfile_5xSoft_Stream.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=0
end function
End Class
</SCRIPT>
2,表单页面index.asp。注意框架包含的上传选择页upload.asp
<form name="form_name" method="POST" action="add.asp">
<textarea cols="100" name="cn_content" rows="18" width="100%"></textarea>
</form>
<iframe border="0" frameBorder="0" noResize scrolling="no" width="100%" src="upload.asp"></iframe>
3,上传选择页upload.asp 注意: enctype="multipart/form-data"
<form name="form" method="post" action="upfile.asp" enctype="multipart/form-data">
<input type="hidden" name="filepath" value="uploadimg">
<input type="hidden" name="act" value="upload">
<input type="file" name="file1" size=40>
<input type="submit" class=button name="Submit" value="上传图片" οnclick="parent.document.forms[0].Submit.disabled=true">类型:gif,jpg,限制:100K
</form>
4,最后一 个文件 upfile.asp 主要作用:生成图片名,并将图片上传,同样也要将UBB标签写入index.asp中的textarea中。
<!--#include file="upload.inc"-->
<html>
<head>
<title>文件上传</title>
</head>
<body>
<script>
parent.document.forms[0].Submit.disabled=false;
</script>
<%
dim upload,file,formName,formPath,iCount,filename,fileExt
set upload=new upload_5xSoft ''建立上传对象
formPath=upload.form("filepath")
''在目录后加(/)
if right(formPath,1)<>"/" then formPath=formPath&"/"
response.write "<body>"
iCount=0
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.filesize<100 then
response.write "请选择你要上传的文件 [ <a href=# οnclick=history.go(-1)>重新上传</a> ]"
response.end
end if
if file.filesize>100*1000 then
response.write "文件大小超过了限制100K [ <a href=# οnclick=history.go(-1)>重新上传</a> ]"
response.end
end if
fileExt=lcase(right(file.filename,4))
uploadsuc=false
Forum_upload="gif,jpg,png"
Forumupload=split(Forum_upload,",")
for i=0 to ubound(Forumupload)
if fileEXT="."&trim(Forumupload(i)) then
uploadsuc=true
exit for
else
uploadsuc=false
end if
next
if uploadsuc=false then
response.write "文件格式不正确 [ <a href=# οnclick=history.go(-1)>重新上传</a> ]"
response.end
end if
randomize
ranNum=int(90000*rnd)+10000
filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&fileExt
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
file.SaveAs Server.mappath(FileName) ''保存文件
for i=0 to ubound(Forumupload)
if fileEXT="."&trim(Forumupload(i)) then
response.write "<script>parent.form_name.cn_content.value+='[img]"&FileName&"[/img]'</script>"
exit for
end if
next
iCount=iCount+1
end if
set file=nothing
next
set upload=nothing ''删除此对象
Htmend iCount&" 个文件上传结束!"
sub HtmEnd(Msg)
set upload=nothing
response.write "上传成功 [ <a href=# οnclick=history.go(-1)>继续上传</a>]"
response.end
end sub
%>
</body>
</html>
what's new
1.使用了网友“梁无惧” 提供的高效的处理方式,上传速度可提高一倍以上,可上传更大的文件。
2.添加了form 方法和file方法,把原来的 form 集和 file改为 objForm 和 objFile,避免了若上传时没有数据会出错的Bug。
3.对多选框的优化,上传同名的多选框时,会自动用 ", " 连接起来。
4.对于表单名,不再区分大小写,使用ASP使用者更习惯。
关于 upload_5xsoft
一直以来,由于FileSystemObject的局限,所以ASP最大的难题就是文件上传,大多解决法就是安装
第三方上传组件。可第三方组件有很多问题,有的组件要注册,有的组件要在表单中加上他的版权信息。
还有的就是组件的兼容问题。
在网上也流传了很多无组件上传的代码,但都是只能上传文本文件,或是只能将文件上传到数据库中。
我这段时间在研究ASP,发现可以不用第三方组件上传任意类型的文件。就写了这个类,给大家一
个方便,整个类放在一个文件中: upload_5xsoft.inc 在 Example 目录下还有一个完整的多文件上传示
例程序,可以直接使用。
申明:源代码是完全开放的,可能随意传播,但请保留其完整性,未经作者同意,不得用于商业。
运行平台与注意事项
a)可直接运行于 Windows2000+IIS 5
NT4 或是 Win98+PWS, 要安装ADO2.6 下载地址:http://www.microsoft.com/data/:
<!--#include FILE="upload_5xsoft.inc"--> 就行了
b) 在使用文件上传时, 表单 form 要加上 enctype="multipart/form-data" 即:
<form name="form1" method="post" action="" enctype="multipart/form-data">
<input type="text" value="abc" name="text1">
<input type=file name="file">
<input type=submit name="submit" value="提交">
</form>
upload_5xsoft的对象
如定义一个上传对象
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft 'upload就是一个对象
%>
upload_5xsoft 对象成员
File 方法,得到文件对象,例如:set file=upload.file("file1")
文件对象成员下面有说明
objFile 文件对象集,(是个dictionary对象)
文件对象成员:
Count 属性,文件表单的个数
FileName 属性,上传文件的名字
FileSize 属性,上传文件的大小(为0是表示没有文件)
FilePath 属性,上传前文件所在的路径
FormName 属性,文件表单的名字
SaveAs 方法,储存上传后文件,有一个参数,路径要为真实路径如:
例子: set file=upload.file("file1") 'file1为表单名
response.write "<br>文件名:"&file.FileName
response.write "<br>文件大小:"&file.FileSize
response.write "<br>文件路径:"&file.FilePath
file.saveAs Server.mappath("/1.jpg")
set file=nothing
Form 方法,获得表单数据,如 Response.Write upload.Form("abc")
objForm 表单数据集,(是个dictionary对象)用来代替 Request.Form
count 属性,表单数
exists 方法,检查是否有指定的表单名
更多的用法可看 vbscript 的dictionary对象帮助
例子:
'得到text1表单的数据,uplaod就是一开始创建的对象
sText=upload.form("text1")
Version 属性,upload_5xsoft类的版本号,如:
response.write upload.Version
使用示例
1.上传一个jpg文件的示例:
文件1: upload.htm
<html><title>example</title>
<body>
<form name="form1" method="post" action="upload.asp" enctype="multipart/form-data">
<input type=file name="file1">
<input type=submit name="submit" value="提交">
</form>
</body>
</html>
文件2: upload.asp
<html><title>example</title>
<body>
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft
set file=upload.file("file1")
response.write upload.form("submit")&"<br>"
if file.fileSize>0 then
file.saveAs Server.mappath("temp.jpg")
response.write "<br>上传文件:"&file.FileName&" => temp.jpg OK!"
response.write "<br>文件大小:"&file.FileSize
end if
set file=nothing
set upload=nothing
%></body>
</html>
2.列表出有文件表单(多文件上传)
<html><title>example</title>
<body>
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft
''列出所有form数据
for each formName in upload.objForm
response.write formName&"="&upload.objForm(formName)&"<br>"
next
''列出所有文件
for each formName in upload.objFile
set file=upload.objFile(formName)
if file.FileSize>0 then
file.SaveAs Server.mappath(file.FileName)
response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "
response.write file.FileName&" 成功!<br>"
end if
set file=nothing
next
set upload=nothing
%>
若程序有问题,请写作者联系 getc@163.com
稻香老农 2003年 1月8日
首先是为了完成上传并且显示进度条所需要的四个包含文件,放入include文件夹
1、wang_upload_5xsoft.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft
Class upload_5xsoft
dim objForm,objFile,Version
'------------------------begin add by mytju.com----------------------------
dim mProgressID,tempFileName
Public Property Get ProgressID()
ProgressID=mProgressID
End Property
Public Property Let ProgressID(byVal itemValue)
mProgressID=itemValue
End Property
'-----------------------end add by mytju.com-----------------------------
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
Public Sub GetUpFile '-----------change by mytju.com------------------------------
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
dim readBlock,readBlockSize,upBytes
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
'------------------------modify begin by mytju.com------------------------------
'---create xml File--------------------
Dim objFSO, objTextFile
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
tempFileName=objFSO.GetSpecialFolder(2)&"\upload_"&mProgressID&".xml"
Set objTextFile = objFSO.CreateTextFile(tempFileName, True)
objTextFile.WriteLine("<?xml version=""1.0"" encoding=""gb2312""?>")
objTextFile.WriteLine("<tree>")
objTextFile.WriteLine("<fileUpProgress myID=""1"">")
objTextFile.WriteLine("<BytesTransferred>0</BytesTransferred>")
objTextFile.WriteLine("<TotalBytes>0</TotalBytes>")
objTextFile.WriteLine("<useTime>1</useTime>")
objTextFile.WriteLine("</fileUpProgress>")
objTextFile.WriteLine("</tree>")
objTextFile.Close
Set objTextFile = Nothing
Set objFSO = Nothing
'---start to upload---------------------
upBytes=0
readBlockSize=1024*100
startTime=Timer()
readBlock=Request.BinaryRead(readBlockSize)
'---create xmlDom------------------------
set objDOM = Server.CreateObject("Microsoft.XMLDOM")
objDOM.async = false
objDOM.load tempFileName
Set objRoot = objDom.documentElement
Set objField = objRoot.selectSingleNode("/tree/fileUpProgress[@myID=1]")
'---loop to get data--------------------
while Lenb(readBlock)>0
upBytes=upBytes+Lenb(readBlock)
'--save value---------
objField.childNodes.item(0).text=Cstr(upBytes)
objField.childNodes.item(1).text=Cstr(Request.TotalBytes)
objField.childNodes.item(2).text=Cstr(Timer()-startTime)
objDom.save tempFileName
'--write to Stream-----
Data_5xsoft.Write readBlock
readBlock=Request.BinaryRead(readBlockSize)
wend
Set objField = Nothing
Set objRoot = Nothing
Set objDom = Nothing
'------------------------modify end by mytju.com------------------------------
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>
2、fileUpProgress.asp
<% @codepage=936 EnableSessionState=False%>
<HTML xmlns:v>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=gb2312">
<TITLE>文件上传进度指示条</TITLE>
<STYLE>
v\:*{behavior:url(#default#VML);}
*{font-size:12px;}
</STYLE>
<style type="text/css">
<!--
font {
font-size: 14px;
}
td {
font-size: 14px;
color: #333333;
}
b {
font-size: 14px;
}
span {
font-size: 14px;
}
a:link {
color: #333333;
text-decoration: none;
}
a:hover {
color: #990000;
text-decoration: underline;
}
a:visited {
color: #000000;
text-decoration: none;
}
-->
</style>
</HEAD>
<BODY topmargin="0" leftmargin="0" onLoad="begin()" bgcolor="#CCCCCC">
<p><br>
<table width="100%" border="0" cellspacing="0" cellpadding="4">
<tr>
<td align="center"><b>文件上传进度指示条</b></td>
</tr>
<tr>
<td>状态:<span ID="myStatus"></span></td>
</tr>
<tr>
<td width="500"><div style="table-Layout:fixed;width:100%;height:100%;border:1 solid black"><v:RoundRect id="myRect" style="height:20;" name="myRect"> <v:fill type="gradient" id="fill1" color="blue"/> </v:RoundRect></div></td>
</tr>
<tr>
<td>已经上传:<span ID="message"></span></td>
</tr>
<tr>
<td>使用时间:<span ID="time">0</span> 秒 </td>
</tr>
<tr>
<td>平均速率:<span ID="speed">0</span> KB/秒 </td>
</tr>
</table>
<script language="Javascript">
self.moveTo(getTop(200),getLeft(500));
var intBytesTransferred=0;
var intTotalBytes=0;
var useTime=1; //s
var getData;
var myWidth=486;
var beginUploadFlg=false;
fill1.color="rgb("+Math.round(Math.random()*255)+","+Math.round(Math.random()*255)+","+Math.round(Math.random()*255)+")";
myStatus.innerHTML="正在初始化....";
function begin()
{
message.innerHTML="开始获取信息....";
var Doc = new ActiveXObject('Microsoft.XMLDOM');
Doc.async = false;
Doc.load("fileUpProgressRead.asp?progressID=<%=Request.QueryString("progressID")%>&aa="+new Date().getTime());
if(Doc.parseError.errorCode != 0) //检查获取数据时是否发生错误
{
delete(Doc);
if(beginUploadFlg){
intBytesTransferred=intTotalBytes;
}else{
message.innerHTML="上传动作尚未启动!";
}
}else{
var rootNode=Doc.documentElement;
if(rootNode.childNodes != null)
{ beginUploadFlg=true;
intBytesTransferred=Number(rootNode.childNodes.item(0).childNodes.item(0).text);
intTotalBytes=Number(rootNode.childNodes.item(0).childNodes.item(1).text);
useTime=Number(rootNode.childNodes.item(0).childNodes.item(2).text);
message.innerHTML="获取信息成功。";
}
delete(rootNode);
}
delete(Doc);
if(intTotalBytes==0){
intBytesTransferred=1;
intTotalBytes=100;
}
display();
if(intTotalBytes>0 && intBytesTransferred<intTotalBytes){
if(beginUploadFlg){
myStatus.innerHTML="正在上传,请耐心等待....";
}
time.innerHTML=useTime;
speed.innerHTML=Math.round((intBytesTransferred/useTime)/1024);
getData = setTimeout("begin()",1000);
}else{
myStatus.innerHTML="数据上传完毕,3秒后自动关闭。";
setTimeout("self.close()",3000);
}
}
function display(){
myRect.style.width=Math.round(myWidth/(intTotalBytes/intBytesTransferred));
fill1.angle=Math.round(300/(intTotalBytes/intBytesTransferred));
if(beginUploadFlg){
message.innerText=intBytesTransferred+"/"+intTotalBytes+","+Math.round(100/(intTotalBytes/intBytesTransferred))+"%";
}
}
function getTop(windowHeight){
var top = parseInt((screen.height - windowHeight)/2-15);
return top;
}
function getLeft(windowWidth){
var left = parseInt((screen.width - windowWidth)/2-5);
return left;
}
</script>
</BODY>
</HTML>
3、fileUpProgressRead.asp
<% @codepage=936 EnableSessionState=False%>
<%
Set fso = Server.CreateObject("Scripting.FileSystemObject")
mProgressID=Request.QueryString("progressID")
filePath=fso.GetSpecialFolder(2)&"\upload_"&mProgressID&".xml"
Set f = fso.OpenTextFile(filePath,1)
response.write f.ReadAll
set f=nothing
set fso=nothing
%>
4、randomString.asp
<% Function gen_key(digits)
dim char_array(80)
For i = 0 To 9
char_array(i) = CStr(i)
Next
For i = 10 To 35
char_array(i) = Chr(i + 55)
Next
For i = 36 To 61
char_array(i) = Chr(i + 61)
Next
Randomize
do while len(output) < digits
num = char_array(Int((62 - 0 + 1) * Rnd + 0))
output = output & num
loop
gen_key = output
End Function %>
下面的文件 在include文件夹外面
测试页面
5、test_upload.asp
<!--#include file="include/randomString.asp" -->
<% ProgressID = gen_key(10) %>
<meta HTTP-EQUIV=Content-Type content="text/html; charset=gb2312">
<form action="test_uploadSave.asp" method="post" enctype="multipart/form-data" onSubmit="myOpen(this)">
文件:<INPUT name="file" type="file" size="20">
文本:<INPUT name="text" type="text" size="20" >
<input type="submit" value="submit">
</form>
<script>
function myOpen(form){
window.open("include/fileUpProgress.asp?progressID=<%=ProgressID%>","","width=500,height=200,scrollbars=no,toolbar=no,status=no,resizable=no,menubar=no,location=no");
var url=form.action;
if (url.indexOf("?",0)==-1) {
form.action = url+"?progressID=<%=ProgressID%>";
}else{
form.action = url+"&progressID=<%=ProgressID%>";
}
}
</script>
6、test_uploadSave.asp
<%@ CODEPAGE="936"%>
<!--#include file="include/wang_upload_5xsoft.inc" -->
<META http-equiv="Content-Type" content="text/html; charset=gb2312">
<%
Server.ScriptTimeOut=300
'--注意下面是写法稍有不同的地方---
set upload=new upload_5xsoft
upload.ProgressID=Request.QueryString("progressID") '一定是这行在先。
upload.GetUpFile
'--结束---其他与以前的写法完全相同-------------
response.write upload.form("text")
set file=upload.file("file")
file.saveas Server.mappath(".")&"\"&file.fileName
set upload=nothing
%>
<br>----------ok-----------
首先,图片在页面中能查找选择。设计表单页面index.asp和上传选择页upload.asp,upload.asp在index.asp中以iframe包含。
其次,所选图片应能上传到某文件夹。建立一文件夹uploadimg
最后,传上去的图片应如何引用?很显然,采用UBB立即显示。upload.asp的指向对象upfile.asp具有写入UBB标签的功能。
无组件上传调试文件夹
-- index.asp
-- upload.asp
-- upfile.asp
-- uploadimg文件夹
图片上传采用稻香老农的无组件上传。所以upload.inc文件必不可少。
1,upload.inc(拷贝以下文本框的所有代码)
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim upfile_5xSoft_Stream
Class upload_5xSoft
dim Form,File,Version
Private Sub Class_Initialize
dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
Version=""
if Request.TotalBytes<1 then Exit Sub
set Form=CreateObject("Scripting.Dictionary")
set File=CreateObject("Scripting.Dictionary")
set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")
upfile_5xSoft_Stream.mode=3
upfile_5xSoft_Stream.type=1
upfile_5xSoft_Stream.open
upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes)
vbEnter=Chr(13)&Chr(10)
iDivLen=inString(1,vbEnter)+1
strDiv=subString(1,iDivLen)
iFormStart=iDivLen
iFormEnd=inString(iformStart,strDiv)-1
while iFormStart < iFormEnd
iStart=inString(iFormStart,"name=""")
iEnd=inString(iStart+6,"""")
mFormName=subString(iStart+6,iEnd-iStart-6)
iFileNameStart=inString(iEnd+1,"filename=""")
if iFileNameStart>0 and iFileNameStart<iFormEnd then
iFileNameEnd=inString(iFileNameStart+10,"""")
mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
if iEnd>iStart then
mFileSize=iEnd-iStart-4
else
mFileSize=0
end if
set theFile=new FileInfo
theFile.FileName=getFileName(mFileName)
theFile.FilePath=getFilePath(mFileName)
theFile.FileSize=mFileSize
theFile.FileStart=iStart+4
theFile.FormName=FormName
file.add mFormName,theFile
else
iStart=inString(iEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
if iEnd>iStart then
mFormValue=subString(iStart+4,iEnd-iStart-4)
else
mFormValue=""
end if
form.Add mFormName,mFormValue
end if
iFormStart=iformEnd+iDivLen
iFormEnd=inString(iformStart,strDiv)-1
wend
End Sub
Private Function subString(theStart,theLen)
dim i,c,stemp
upfile_5xSoft_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
if upfile_5xSoft_Stream.EOS then Exit for
c=ascB(upfile_5xSoft_Stream.Read(1))
If c > 127 Then
if upfile_5xSoft_Stream.EOS then Exit for
stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&Chr(c)
End If
Next
subString=stemp
End function
Private Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to upfile_5xSoft_Stream.Size-theLen
if i>upfile_5xSoft_Stream.size then exit Function
upfile_5xSoft_Stream.Position=i-1
if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if upfile_5xSoft_Stream.EOS then
inString=0
Exit for
end if
if AscB(upfile_5xSoft_Stream.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
Private Sub Class_Terminate
form.RemoveAll
file.RemoveAll
set form=nothing
set file=nothing
upfile_5xSoft_Stream.close
set upfile_5xSoft_Stream=nothing
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
Private 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
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
End Sub
Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=1
if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function
if FileStart=0 or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
upfile_5xSoft_Stream.position=FileStart-1
upfile_5xSoft_Stream.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=0
end function
End Class
</SCRIPT>
2,表单页面index.asp。注意框架包含的上传选择页upload.asp
<form name="form_name" method="POST" action="add.asp">
<textarea cols="100" name="cn_content" rows="18" width="100%"></textarea>
</form>
<iframe border="0" frameBorder="0" noResize scrolling="no" width="100%" src="upload.asp"></iframe>
3,上传选择页upload.asp 注意: enctype="multipart/form-data"
<form name="form" method="post" action="upfile.asp" enctype="multipart/form-data">
<input type="hidden" name="filepath" value="uploadimg">
<input type="hidden" name="act" value="upload">
<input type="file" name="file1" size=40>
<input type="submit" class=button name="Submit" value="上传图片" οnclick="parent.document.forms[0].Submit.disabled=true">类型:gif,jpg,限制:100K
</form>
4,最后一 个文件 upfile.asp 主要作用:生成图片名,并将图片上传,同样也要将UBB标签写入index.asp中的textarea中。
<!--#include file="upload.inc"-->
<html>
<head>
<title>文件上传</title>
</head>
<body>
<script>
parent.document.forms[0].Submit.disabled=false;
</script>
<%
dim upload,file,formName,formPath,iCount,filename,fileExt
set upload=new upload_5xSoft ''建立上传对象
formPath=upload.form("filepath")
''在目录后加(/)
if right(formPath,1)<>"/" then formPath=formPath&"/"
response.write "<body>"
iCount=0
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.filesize<100 then
response.write "请选择你要上传的文件 [ <a href=# οnclick=history.go(-1)>重新上传</a> ]"
response.end
end if
if file.filesize>100*1000 then
response.write "文件大小超过了限制100K [ <a href=# οnclick=history.go(-1)>重新上传</a> ]"
response.end
end if
fileExt=lcase(right(file.filename,4))
uploadsuc=false
Forum_upload="gif,jpg,png"
Forumupload=split(Forum_upload,",")
for i=0 to ubound(Forumupload)
if fileEXT="."&trim(Forumupload(i)) then
uploadsuc=true
exit for
else
uploadsuc=false
end if
next
if uploadsuc=false then
response.write "文件格式不正确 [ <a href=# οnclick=history.go(-1)>重新上传</a> ]"
response.end
end if
randomize
ranNum=int(90000*rnd)+10000
filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&fileExt
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
file.SaveAs Server.mappath(FileName) ''保存文件
for i=0 to ubound(Forumupload)
if fileEXT="."&trim(Forumupload(i)) then
response.write "<script>parent.form_name.cn_content.value+='[img]"&FileName&"[/img]'</script>"
exit for
end if
next
iCount=iCount+1
end if
set file=nothing
next
set upload=nothing ''删除此对象
Htmend iCount&" 个文件上传结束!"
sub HtmEnd(Msg)
set upload=nothing
response.write "上传成功 [ <a href=# οnclick=history.go(-1)>继续上传</a>]"
response.end
end sub
%>
</body>
</html>