shawl.qiu ASP 无组件上传类 1.0 Beta 版发布

来源：互联网发布：淘宝代销怎么同步库存编辑：程序博客网时间：2024/05/16 15:32

/**/

本版由于 IE 提交完全客户端文件路径, 鄙人很少用 IE, 现在才发现问题.
新一版已解决该问题: shawl.qiu ASP 无组件上传类 1.0 Final 版.
URL: http://blog.csdn.net/btbtd/archive/2006/09/30/1309457.aspx
shawl.qiu
2006-09-30

shawl.qiu ASP 无组件上传类 1.0 Beta 版

主要功能:
支持自定义上传N个文件
支持自定义文件名前缀
支持随机自定义文件名后缀
支持任何编码的中文文件名
支持自定义上传文件框个数

说明:
为了方便使用, 把表单域也封装进class(类)

后续版本待加功能:
增加文件上传总大小限制
增加单个文件总大小限制
增加自定义允许上传的文件类型
增加检测特定文件类型包含恶意代码的功能
Subject: shawl.qiu ASP 无组件上传类 1.0 Beta 版

Author: shawl.qiu
Version: 1.0 Beta
Date: 2006-09-27
Blog: http://blog.csdn.net/btbtd
E-Mail: shawl.qiu@gmail.com

目录:
1. shawl.qiu ASP 无组件上传类(cUpload)及演示
2. 上传预览

本文原格式: http://my.opera.com/btbtd/homes/article/shawl.qiu_upload_1.0Beta.htm

shawl.qiu@gmail.com
2006-09-27
http://blog.csdn.net/btbtd

1. shawl.qiu ASP 无组件上传类(cUpload)及演示:

linenum

<%
dim upload
set upload=new cUpload
with upload
.header '头部信息 [非必须]
'---------------------------------------
' 页面设置:
'--------------------
.upQueryString=request.queryString("id") '目标查询 ID [必选项]
.upCharSet="utf-8" '页面编码 [必选项], 请正确设置页面编码!
'---------------------------------------
' 上传文件各参数设置:
'--------------------
.upBinaryTotal=cLng(request.TotalBytes) '读取二进制字节长度 [必选项]
.upPath="/saveimg/" ' 默认存放路径 [必选项]
.upOverWrite=2 ' 上传文件是否覆盖原有文件设置. 1 或空为不覆盖, 2 为覆盖, 默认为 1 [非必选]
'---------------------------------------
' 表单域默认值:
'--------------------
' 提交表单目标地址, 处理上传操作 ID值必须为 upfile, 如 ?xxx=upfile [必选项]
.upAction="?id=upfile"
.upNumber= 5 ' 显示上传文件文件框数量. 最小为1, 最大为 99, 默认为 1 [非必选]
.fileNamePrefix="前缀" ' 自定义文件名前缀, 不想加前缀, 注释掉此项 [非必选]
.fileNamePostfix=1 ' 是否添加随机后缀, 空值不添加, 注释掉此项 [非必选]
'---------------------------------------
.pgUpFile ' 处理上传文件操作 [必选项]
.pgUpForm ' 上传文件表单域 [必选项]
'---------------------------------------
' 文件上传操作相关信息:
' response.write join(.upFilePathArray,"<br/>") ' 存储所有文件路径的数组 [非必选]
.pgUploadInfo ' 表单域内容相关信息及已上传文件相关信息 [非必选]
'.pgShowImage ' 显示已上传的图片文件 [非必选]
.info ' 功能信息 [非必选]
.auther ' 作者及版本信息 [非必选]
end with
set upload=nothing
class cUpload
'dim upload
'set upload=new cUpload
'with upload
''---------------------------------------
'' 页面设置:
''--------------------
'.upQueryString=request.queryString("id") '目标查询 ID [必选项]
'.upCharSet="utf-8" '页面编码 [必选项], 请正确设置页面编码!
''---------------------------------------
'' 上传文件各参数设置:
''--------------------
'.upBinaryTotal=cLng(request.TotalBytes) '读取二进制字节长度 [必选项]
'.upPath="/saveimg/" ' 默认存放路径 [必选项]
'.upOverWrite=2 ' 上传文件是否覆盖原有文件设置. 1 或空为不覆盖, 2 为覆盖, 默认为 1 [非必选]
''---------------------------------------
'' 表单域默认值:
''--------------------
'' 提交表单目标地址, 处理上传操作 ID值必须为 upfile, 如 ?xxx=upfile [必选项]
'.upAction="?id=upfile"
'.upNumber= 5 ' 显示上传文件文件框数量. 最小为1, 最大为 99, 默认为 1 [非必选]
'.fileNamePrefix="前缀" ' 自定义文件名前缀, 不想加前缀, 注释掉此项 [非必选]
'.fileNamePostfix=1 ' 是否添加随机后缀, 空值不添加, 注释掉此项 [非必选]
''---------------------------------------
'.pgUpFile ' 处理上传文件操作 [必选项]
'.pgUpForm ' 上传文件表单域 [必选项]
''---------------------------------------
'' 文件上传操作相关信息:
'' response.write join(.upFilePathArray,"<br/>") ' 存储所有文件路径的数组 [非必选]
'.pgUploadInfo ' 表单域内容相关信息及已上传文件相关信息 [非必选]
''.pgShowImage ' 显示已上传的图片文件 [非必选]
'.info ' 功能信息 [非必选]
'.auther ' 作者及版本信息 [非必选]
'end with
'set upload=nothing
'-----------------------------------------------------------------------------------------------
' 附:
' 1. 添加单引号(')的正则: 查找: ^(.*?)([/S]) 替换: $1'$2
' 2. 移除单引号(')的正则: 查找: ^(.*?)/' 替换: $1
'-----------------------------------------------------------------------------------------------
public sub class_initialize()
upShowImageExtension=".jpg|.gif|.png|.jpeg|.bmp"
end sub
public sub class_terminate()
end sub
public sub header()
response.write "<div style=""text-align:center;display:table;width:100%;color:red;font-size:28px;"">"
response.write "shawl.qiu ASP 无组件上传类 1.0 Beta 版"
response.write "</div>"
end sub
public sub info()
response.write "<xmp>"
response.write "shawl.qiu ASP 无组件上传类 1.0 Beta 版"&vbcrlf&vbcrlf
response.write "主要功能:"&vbcrlf
response.write "支持自定义上传N个文件"&vbcrlf
response.write "支持自定义文件名前缀"&vbcrlf
response.write "支持随机自定义文件名后缀"&vbcrlf
response.write "支持任何编码的中文文件名"&vbcrlf
response.write "支持自定义上传文件框个数"&vbcrlf&vbcrlf
response.write "说明:"&vbcrlf
response.write "为了方便使用, 把表单域也封装进class(类)"&vbcrlf&vbcrlf
response.write "后续版本待加功能:"&vbcrlf
response.write "增加文件上传总大小限制"&vbcrlf
response.write "增加单个文件总大小限制"&vbcrlf
response.write "增加自定义允许上传的文件类型"&vbcrlf
response.write "增加检测特定文件类型包含恶意代码的功能"&vbcrlf
response.write "</xmp>"
end sub
public sub auther()
response.write "<xmp>"
response.write "Subject: shawl.qiu ASP 无组件上传类 1.0 Beta 版"&vbcrlf&vbcrlf
response.write "Author: shawl.qiu"&vbcrlf
response.write "Version: 1.0 Beta"&vbcrlf
response.write "Date: 2006-09-27"&vbcrlf
response.write "Blog: http://blog.csdn.net/btbtd"&vbcrlf
response.write "E-Mail: shawl.qiu@gmail.com"
response.write "</xmp>"
end sub
public upQueryString, upCharSet
public upAction, upNumber, fileNamePrefix, fileNamePostfix
public upPath, upOverWrite, upBinaryTotal
public upFilePathArray
private upTotalFiled, upAvailableField, upFileUploaded
private upSourceNameArray, upRenamedArray
private upShowImageExtension
public property get pgUploadInfo
if upFileUploaded="" then upFileUploaded=0
response.write "<xmp>"
response.write "表单域共有 "&upTotalFiled&"个 Field, "
response.write "可用 Field "&upAvailableField&"个, "
response.write "已上传文件数 "&upFileUploaded&"个. "
if upFileUploaded>0 then
response.write vbCrlf&vbCrlf
dim i
for i=0 to upFileUploaded-1
response.write "文件 "&i+1&" 原文件名:"&upSourceNameArray(i)&vbCrLf
response.write "最终文件名:"&upRenamedArray(i)&vbCrLf
response.write "路径:"&upFilePathArray(i)
response.write vbCrLf&vbCrLf
next
end if
response.write "</xmp>"
pgUploadInfo=pgUploadInfo
end property
public property get pgUpFile
pgUpFile=fOperate(upBinaryTotal)
end property
public property get pgUpForm
pgUpForm=upForm(upAction, upNumber, fileNamePrefix, fileNamePostfix)
end property
public property get pgShowImage
pgShowImage=upShowImage(upShowImageExtension, upFilePathArray)
end property
private function upShowImage(extension, filepath_)
if not isArray(upFilePathArray) then exit function
dim extAr:extAr=split(extension,"|")
dim temp, temp_
for each temp in upFilePathArray
for each temp_ in extAr
if strComp(mid(temp,inStrRev(temp,".")),temp_,1)=0 then
response.write "<a href="""
response.write temp
response.write """ target=""_blank""><img src="""
response.write temp
response.write """ alt=""shawl.qiu upload"" title=""shawl.qiu upload""/></a>"
end if
next
next
end function
private function fOperate(upBinaryTotal)
if upQueryString<>"upfile" or upAction="" then exit function
if upOverWrite="" then upOverWrite=1
if upOverWrite<1 or upOverWrite>2 then upOverWrite=1
dim lf:lf=chrB(13)&chrB(10)
dim bRead ' 读取二进制流内容
bRead=request.BinaryRead(upBinaryTotal)
dim fieldMarker ' 定义取二进制流 Field 分隔标记 (内容为二进制)
fieldMarker=leftB(bRead,inStrB(bRead,chrB(13))-1)
dim headerMarker:headerMarker=leftB(bRead,instrB(bRead,chrB(32))-1)
dim temp:temp=1
dim temp_
dim temp1
dim temp1_
dim headerTotal
dim headerAvailable:headerAvailable=0
dim headerStartPsti, headerEndPsti, headerStr
dim fieldStartPsti, fieldEndPsti
dim fnPrefix, fnPostfix
do
temp_=inStrB(temp, bRead, headerMarker)
if temp_<>0 then
temp=temp_+1
temp1=inStrB(temp, bRead, lf&lf)
temp1_=inStrB(temp1+5, bRead, fieldMarker)
headerTotal=headerTotal+1
if inStrB(midB(bRead, temp1+4, 36),midB(fieldMarker,1))=0 then
if isArray(headerStartPsti) then redim preserve headerStartPsti(headerAvailable) _
else redim headerStartPsti(headerAvailable)
headerStartPsti(headerAvailable)=temp-1
if isArray(headerEndPsti) then redim preserve headerEndPsti(headerAvailable) else _
redim headerEndPsti(headerAvailable)
headerEndPsti(headerAvailable)=temp1+2-temp
if isArray(headerStr) then redim preserve headerStr(headerAvailable) else redim _
headerStr(headerAvailable)
headerStr(headerAvailable)=fBin2Str(midB(bRead,temp-1,temp1+2-temp),upCharSet)
if isArray(fieldStartPsti) then redim preserve fieldStartPsti(headerAvailable) else redim fieldStartPsti(headerAvailable)
fieldStartPsti(headerAvailable)=temp1
if isArray(fieldEndPsti) then redim preserve fieldEndPsti(headerAvailable) else redim fieldEndPsti(headerAvailable)
fieldEndPsti(headerAvailable)=temp1_
if inStr(headerStr(headerAvailable),"filename")=0 and inStr(headerStr(headerAvailable),"; name=")<>0 then
select case fRegExpSgl(headerStr(headerAvailable),true,true,true,"[/s/S]*?name/=/""(.*?)""[/s/S]*","$1")
case "fnPrefix"
if upCharSet="gb2312" then
fnPrefix=bTsGb2312(midB(bRead,temp1,temp1_-temp1))
else
fnPrefix=fBin2Str(midB(bRead,temp1,temp1_-temp1), upCharSet)
end if
case "fnPostfix"
if upCharSet="gb2312" then
fnPostfix=bTsGb2312(midB(bRead,temp1,temp1_-temp1))
else
fnPostfix=fBin2Str(midB(bRead,temp1,temp1_-temp1), upCharSet)
end if
end select
end if
headerAvailable=headerAvailable+1
end if
else
exit do
end if
loop
upTotalFiled=headerTotal
upAvailableField=headerAvailable
dim fileName, fileNamePrx, fileNamePox
dim i
for i=0 to uBound(headerStr)
if inStr(headerStr(i),"filename=")<>0 then
fileName=fRegExpSgl(headerStr(i),true,true,true,"[/s/S]*filename/=""(.*?)""[/s/S]*","$1")
if isArray(upSourceNameArray) then redim preserve upSourceNameArray(i) else redim upSourceNameArray(i)
upSourceNameArray(i)=fileName
fileNamePrx=fRegExpSgl(fileName,true,true,true,"(.*?)/..*","$1")
fileNamePox=fRegExpSgl(fileName,true,true,true,".*(/..*)","$1")
if fnPrefix<>"" then fileNamePrx=fnPrefix&fileNamePrx
if fnPostfix<>"" then fileNamePrx=fileNamePrx&fGuid
fileName=fileNamePrx&fileNamePox
fileName=fRegExpSgl(fileName,true,true,true,"[/s]+","")
if isArray(upRenamedArray) then redim preserve upRenamedArray(i) else redim upRenamedArray(i)
upRenamedArray(i)=fileName
if isArray(upFilePathArray) then redim preserve upFilePathArray(i) else redim upFilePathArray(i)
upFilePathArray(i)=upPath&fileName
call fBinSv2fl(bRead,fieldStartPsti(i)+3,fieldEndPsti(i)-fieldStartPsti(i)-3, upPath&fileName, upOverWrite)
upFileUploaded=upFileUploaded+1
end if
next
end function
private function fBinSv2fl(bin, bStart, bEnd, filepath_, ovWrite)
'''''''''''''''''''''''''''''
' 截取二进制流保存为文件 By shawl.qiu
' http://blog.csdn.net/btbtd
''''''''''''''''
' sample call: call fBinSv2fl(bRead,fieldStartPsti(i)+3,fieldEndPsti(i)-fieldStartPsti(i)-3, fileName, 2)
''''''''''
' 参数说明
''''''''''
' bin: 源二进制流
' bStart: 截取二进制流的起始位置
' bEnd: 截取二进制流的结束位置
' filepath_: 保存文件的路径
' ovWrite: 是否覆盖原有文件. 1: 不覆盖; 2. 覆盖
'''''''''''''''''''''''''''''
filepath_=server.MapPath(filepath_)
dim stm_, fromStm_
set stm_=createObject("adodb.stream")
stm_.type=1
stm_.mode=3
stm_.open
stm_.write bin
set fromStm_=createOBject("adodb.stream")
with fromStm_
.type=1
.mode=3
.open
stm_.position = bStart
stm_.copyTo fromStm_, bEnd
.saveTofile filepath_, ovWrite
.close
end with
set fromStm_=nothing
stm_.close 'shawl.qiu code'
set stm_=nothing
end function
private function fStr2Bin(str, charSet)
'''''''''''''''''''''''''''''
' 字符串转二进制函数 By shawl.qiu
' http://blog.csdn.net/btbtd
''''''''''''''''
' 参数说明
''''''''''
' str: 要转换成二进制的字符串
' charSet: 字符串默认编码集, 如不指定, 则默认为 gb2312
''''''''''
' sample call: response.binaryWrite fStr2Bin(str, "utf-8")
'''''''''''''''''''''''''''''
dim stm_
set stm_=createObject("adodb.stream")
with stm_
.type=2
if charSet<>"" then
.charSet=charSet
else
.charSet="gb2312"
end if
.open
.writeText str
.Position = 0
.type=1
fStr2Bin=.Read
.close
end with 'shawl.qiu code'
set stm_=nothing
end function
private function fBin2Str(str, charSet)
'--------------------------------------
' 二进制转字符串函数 By shawl.qiu
' http://blog.csdn.net/btbtd
'--------------------------
' 参数说明:
'----------
' str: 要转换成字符串的二进制数据
' charSet: 字符串默认编码集, 如不指定, 则默认为 gb2312
'-------------
' sample call: response.write fBin2Str(midB(fStr2Bin(str, "utf-8"),1),"utf-8")
'--------------------------------------
' 注意: 二进制字符串必须先用 midB(binaryString,1) 读取(可自定读取长度).
'--------------------------------------
dim stm_
set stm_=createObject("adodb.stream")
with stm_
.type=2
.open
.writeText str
.Position = 0
if charSet<>"" then
.CharSet = charSet
else
.CharSet = "gb2312"
end if
fBin2Str=.ReadText
.close
end with 'shawl.qiu code'
set stm_=nothing
end function
private function bTsGb2312(bin)
'二进制转为 string | gb2312 编码
dim i, iByt, sByt, bLen:bLen=lenB(bin)
for i=1 to bLen
sByt=midB(bin,i,1):iByt=ascB(sByt)
if iByt<128 then
bTsGb2312=bTsGb2312&chr(iByt)
else
bTsGb2312=bTsGb2312&chr(ascW(midB(bin,i+1,1)&sByt))
i=i+1
end if
next 'shawl.qiu code'
end function
private function fRegExpSgl(str,glb,igc,mtl,pt,rpt)
dim re
set re=new RegExp
re.global=glb
re.ignoreCase=igc
re.multiline=mtl
re.pattern=pt
fRegExpSgl=re.replace(str,rpt)
set re=nothing
end function 'shawl.qiu code'
private function fGuid
fGuid=mid(cstr(createObject("scriptlet.typeLib").GUID),2,36)
end function 'shawl.qiu code'
private function upForm(upAction, upNumber, fileNamePrefix, fileNamePostfix)
'-------------------------------------------
' shalw.qiu ASP 无组件上传类, 表单域
'-------------------------------------------
' sample call: call upForm("?id=test", 5, "文件前缀", "")
'----------------------------------------------------------
if upNumber="" then upNumber=1
if upNumber<1 or upNumber>99 then upNumber=5
if fileNamePostfix<>"" then fileNamePostfix=" checked=""checked"" "
dim i_
response.write "<form action="""&upAction&""" method=""post"" enctype=""multipart/form-data"" name=""upForm"" id=""upForm"">"
for i_=1 to upNumber
response.write "<div class=""upBrowser""><input type=""file"" name=""file"" class=""upButton"" /> </div>"
next
response.write "<div class=""upPrefix"">自定义前缀: <input name=""fnPrefix"" type=""text"" value="""&fileNamePrefix&""" class=""upPrefixButton""/></div>"
response.write "<div class=""upPostfix"">添加随机后缀: <input name=""fnPostfix"" type=""checkbox"" value=""checkbox"""& fileNamePostfix&"class=""upPostfixButton"" /> </div>"
response.write " <input type=""submit"" value=""Submit"" class=""upSubmit"" />"
response.write "</form>"
end function
end class
%>
<a href="?">back</a>

2. 上传预览

shawl.qiu ASP 无组件上传类 1.0 Beta 版

表单域共有 7个 Field, 可用 Field 5个, 已上传文件数 3个.文件 1 原文件名:E-Studio001(44).jpg最终文件名:前缀E-Studio001(44)33C326FB-51D2-4933-AED0-1EC744B2A2C0.jpg路径:/saveimg/前缀E-Studio001(44)33C326FB-51D2-4933-AED0-1EC744B2A2C0.jpg文件 2 原文件名:E-Studio001(55).jpg最终文件名:前缀E-Studio001(55)72F24F09-B280-4B79-8CD6-3EAB80C44CAA.jpg路径:/saveimg/前缀E-Studio001(55)72F24F09-B280-4B79-8CD6-3EAB80C44CAA.jpg文件 3 原文件名:E-Studio001(52).jpg最终文件名:前缀E-Studio001(52)CF951352-0AD3-42EA-BA84-F8A30E88DEBE.jpg路径:/saveimg/前缀E-Studio001(52)CF951352-0AD3-42EA-BA84-F8A30E88DEBE.jpgshawl.qiu ASP 无组件上传类 1.0 Beta 版主要功能:支持自定义上传N个文件支持自定义文件名前缀支持随机自定义文件名后缀支持任何编码的中文文件名支持自定义上传文件框个数说明:为了方便使用, 把表单域也封装进class(类)后续版本待加功能:增加文件上传总大小限制增加单个文件总大小限制增加自定义允许上传的文件类型增加检测特定文件类型包含恶意代码的功能Subject: shawl.qiu ASP 无组件上传类 1.0 Beta 版Author: shawl.qiuVersion: 1.0 BetaDate: 2006-09-27Blog: http://blog.csdn.net/btbtdE-Mail: shawl.qiu@gmail.comback

shawl.qiu ASP 无组件上传类 1.0 Beta 版 发布

shawl.qiu ASP 无组件上传类 1.0 Beta 版发布