[求助]记录数达到限定数量代码提示,应怎么加入.

[复制链接]

ylsdf

电梯直达

1^#

发表于 2010-1-7 02:16:20 | 只看该作者回帖奖励

|倒序浏览 |阅读模式

<%
'注意系统会自动检测您的服务器是否支持AspJpeg组件，
'如果支持则会自动生成 jpg图像反之则生成bmp图像
'img.asp为数据库里面有两个表
'表 img 用来对没有aspjpeg组件的用户上传图片进行辅助
'表 myphoto 用来记录上传的用户信息
Response.Expires = -1
Response.AddHeader "Pragma", "no-cache"
Response.AddHeader "Cache-Control", "no-cache, must-revalidate"
on error resume next
dim strSaveFileName

strnow =replace(replace(replace(now(), ":", ""), "-", ""), " ", "")

Dim intTotalLine
intTotalLine =Request.Form.Count
Dim strHeadData
strHeadData =ChrB(66) & ChrB(77) & ChrB(230) & ChrB(4) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(160) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(120) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(1) & ChrB(0) &_
ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(176) & ChrB(4) &_
ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) &_
ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_
ChrB(0) & ChrB(0)
Dim strSaveData, intLoop1, intLoop2, strTempData
For intLoop1 =intTotalLine To 0 Step -1
strTempData =Request.Form("PX"&intLoop1)
strTempData =Split(strTempData, ",")
For intLoop2 =0 To ubound(strTempData)
'strSaveData =strSaveData &toBin(strTempData(intLoop2))
strSaveData =strSaveData &To3(strTempData(intLoop2))
Next
Next
strSaveData =strHeadData & strSaveData

Dim Jpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
if Err Then
Err.Clear()
strSaveFileName =strNow &".bmp"
call DataConnect '打开数据库

set rs =server.CreateObject("adodb.recordset")
sql ="select * from [img]"
rs.open sql,conn,1,3
rs.addnew
rs("id") =strnow
rs("addtime") =now
rs("imgdata").AppendChunk(strSaveData)
rs.update
rs.close
set rs =nothing

set rs =conn.execute("select * from [img] where id ="& strnow)
img_size =rs("imgdata").ActualSize
saa= rs("imgdata").GetChunk(img_size)
set rs =nothing

Call SaveStream("image_photo/"& strSaveFileName, saa)
set rs =server.CreateObject("adodb.recordset")
sql ="select * from [myphoto]"
rs.open sql,conn,1,3
rs.addnew
rs("userid") ="测试用户"
rs("update")=now()
rs("myshow")="image_photo/"& strSaveFileName
rs.update
rs.close
set rs =nothing

conn.execute("delete from [img] where id ="& strnow)
call DataDisConnect '关闭数据库
else
strSaveFileName =strNow &".jpg"
Jpeg.OpenBinary strSaveData
Jpeg.Width = Jpeg.OriginalWidth
Jpeg.Height = Jpeg.OriginalHeight
' 保存缩略图到指定文件夹下
Jpeg.Save Server.MapPath("image_photo/"& strSaveFileName)
' 注销实例
Set Jpeg = Nothing
'数据库处理
call DataConnect '打开数据库

set rs =server.CreateObject("adodb.recordset")
sql ="select * from [myphoto]"
rs.open sql,conn,1,3
rs.addnew
rs("userid") ="测试用户"
rs("update")=now()
rs("myshow")="image_photo/"& strSaveFileName
rs.update
rs.close
set rs =nothing

call DataDisConnect '关闭数据库
end if
response.Write("thisfile="& strSaveFileName)

Function To3(nums)
Dim myArray()
Dim iii, tmp
For iii=1 To 3
tmp=Mid(nums,iii*2-1,2)
Redim Preserve myArray(iii)
myArray(iii) =chn10(tmp)
'myArray(iii) =tmp
Next
To3 = ChrB(myArray(3))&ChrB(myArray(2))&ChrB(myArray(1))
End Function
Function toBin(str)
Dim intTemp, binTemp, strTemp
For intTemp =1 To 6 Step 2
strTemp =Mid(str, intTemp, 2)
binTemp =binTemp & ChrB(chn10(strTemp))
Next
toBin =binTemp
End Function
Function chn10(nums)
Dim tmp, tmpstr, intLoop4
nums_len=Len(nums)
For intLoop4=1 To nums_len
tmp=Mid(nums,intLoop4,1)
If IsNumeric(tmp) Then
tmp=tmp * 16 * (16^(nums_len-intLoop4-1))
Else
tmp=(ASC(UCase(tmp))-55) * (16^(nums_len-intLoop4))
End If
tmpstr=tmpstr+tmp
Next
chn10 = tmpstr
End Function
Sub SaveStream(paR_strFile, paR_streamContent)
Dim objStream
Set objStream =Server.CreateObject("ADODB.Stream")
with objStream
.Type =1
.Open
.Write paR_streamContent
.SaveToFile Server.Mappath(paR_strFile), 2
.Close()
End with
Set objStream =Nothing
End Sub
%>

请问这段代码应怎么加入,控制上传图片数量.如记录达到500个,会提示,已达到上传数量.不能再上传

谢谢.

收藏0