日期:2014-05-16 浏览次数:21135 次
<!--#include file="../../inc/MainClass.asp"-->
<%
server.scripttimeout=1800
sitePic=sitePic&"/"&Year(now())&"-"&Month(now())
Sub downPic(pg,dt)
dim i,rsObj,sql,page,fileName,filePath,picUrl,downType,isDownOk:isDownOk=false
downType=dt
select case downType
case "all"
sql="select m_id,m_name,m_pic from {pre}data where m_pic like 'http://%' order by m_addtime desc"
case else
sql="select m_id,m_name,m_pic from {pre}data where m_pic like '%bokecc.com%' or m_pic like '%cmsplugin.net%' order by m_addtime desc"
end select
set rsObj=conn.db(sql,"records1")
if rsObj.recordcount=0 then response.write "所有图片已经下载完成":response.end''''''''
rsObj.pagesize=30
page=pg
if isNul(page) then page=1 else page=clng(page)
if page>rsObj.pagecount then page=rsObj.pagecount
if page=1 then session("m_pic_page") = rsObj.pagecount
rsObj.absolutepage=page
echo "<font color=red>共"&session("m_pic_page")&"页,正在开始下载第"&page&"页数据的的图片</font><br>"
for i=1 to rsObj.pagesize
picUrl=rsObj("m_pic")
fileName=mid(picUrl,instrrev(picUrl,"/")+1)
if instr(" "&fileName,"?")>0 then:fileName=mid(fileName,1,instr(fileName,"?")-1):end if
filePath = "/"&sitePath&"pic/"&sitePic&"/"&fileName
if not isExistFile(filePath) then
isDownOk=downSinglePic(picUrl,rsObj("m_id"),rsObj("m_name"),filePath,"down")
else
echo "数据<font color=red>"&rsObj("m_name")&"</font>的图片已经存在 <a target=_blank href="&filePath&">预览图片</a><br>"
isDownOk=true
end if
if isDownOk then
updatePicUrl rsObj("m_id"),replaceStr("pic/"&sitePic&"/"&fileName,"../","")
if waterMark=1 and isInstallObj(JPEG_OBJ_NAME) then writeFontWaterPrint filePath,waterMarkLocation
else
'updatePicUrl rsObj("m_id"),""
updatePicUrl rsObj("m_id"),"erro/"&picUrl'''''''''''''''''''''''
end if
rsObj.movenext
if rsObj.eof then exit for
next
rsObj.close : set rsObj=nothing
echo "<br>暂停5秒后继续下载<script language=""javascript"">setTimeout(""gatherNextPagePic();"",5000);function gatherNextPagePic(){location.href='?action=downpic&downtype="&downType&"&page="&(page+1)&"';}</script>"
End Sub
Sub updatePicUrl(id,pic)
conn.db "update {pre}data set m_pic='"&pic&"' where m_id="&id,"execute"
End Sub
Function downSinglePic(picUrl,vid,vname,filePath,infotype)
dim streamLen,spanstr,filename,fileext
if infotype="" then spanstr="" else spanstr="<br/>"
on error resume next
if isNul(picUrl) or instr(picUrl,"http://")=0 then echo "数据<font color=red>"&vname&"</font>的图片路径错误1,请检查是否有效 "&spanstr : downSinglePic=false :Exit Function
fileext=getFileFormat(filePath):filename=mid(picUrl,instrrev(pi