直接保存URL图像或网页到服务器本地的类
程序员文章站
2022-03-25 20:24:50
复制代码 代码如下:<% @ language="vbscript" codepage="936"%> <% option&...
复制代码 代码如下:
<% @ language="vbscript" codepage="936"%>
<%
option explicit
class boxinfoimg
'传输类的使用方法
'图象上传和上传信息获取class
'用法:
'dim imgup
'set imgup=new boxinfoimg
'属性:
'imgup.width '宽
'imgup.height '高
'imgup.imgsize '大小
'imgup.imgtype '类型
'imgup.imgname '文件名
'imgup.imgname '图像文件名:"&
'imgup.filename '文件名"&
'imgup.extname '扩展名"
'imgup.diskpath '保存位置"
'imgup.xupath '虚拟路径"
'imgup.newurl '保存后url"
'imgup.savemode '保存后url"
'方法:
'imgup.saveimg(fullpath) '保存图像文件
dim ados
dim width,height,imgsize,imgtype,imgname,filename
dim prename,extname
dim savepath,savename,savemode
dim diskpath,xupath,newurl
dim textstr
dim i
private sub class_initialize
set ados=server.createobject("adodb.stream")
ados.type=1
ados.mode=3
ados.open
getimagesize
end sub
private sub class_terminate
ados.close
set ados=nothing
end sub
public function getimagesize()
dim ret(3),bflag,fdata,fsize
fdata=getwebdata(getstrurl) '取得xmlhttp数据
fsize=clng(lenb(fdata)) '取得数据尺寸
if fsize=0 then
exit function
r_write "无有效数据保存",0
end if
ados.write fdata
ados.position=0
savename=isavename
savepath=isavepath
savemode=isavemode
'写文本对象读取图像长宽和类型
ados.position=0 '重置数据开始位置
bflag=ados.read(3)
if isnull(bflag) then
width=0
height=0
imgsize=0
imgtype="unknow"
ret(0)=imgtype:ret(1)=width:ret(2)=height:ret(3)=""
getimagesize=ret
exit function
end if
'取文件类型和长宽
select case hex(binval(bflag))
case "4e5089":
ados.read(15)
ret(0)="png"
ret(1)=binval2(ados.read(2))
ados.read(2)
ret(2)=binval2(ados.read(2))
case "464947":
ados.read(3)
ret(0)="gif"
ret(1)=binval(ados.read(2))
ret(2)=binval(ados.read(2))
case "ffd8ff":
dim p1
do
do: p1=binval(ados.read(1)): loop while p1=255 and not ados.eos
if p1>191 and p1<196 then exit do else ados.read(binval2(ados.read(2))-2)
do:p1=binval(ados.read(1)):loop while p1<255 and not ados.eos
loop while true
ados.read(3)
ret(0)="jpg"
ret(2)=binval2(ados.read(2))
ret(1)=binval2(ados.read(2))
case else:
if left(bin2str(bflag),2)="bm" then
ados.read(15)
ret(0)="bmp"
ret(1)=binval(ados.read(4))
ret(2)=binval(ados.read(4))
else
ret(0)=""
end if
end select
'
dim tempstr
dim namestr
dim defaultname
dim ln
tempstr=split(getstrurl,"/")
namestr=tempstr(ubound(tempstr))
if namestr="" then
r_write "错误的url,请输入可访问的url",0
exit function
end if
filename=split(namestr,"?")(0)
ln=instrrev(filename,".")
if ln>0 then
prename=left(filename,instrrev(filename,".")-1)
else
prename=filename
end if
'r_write filename,1
'r_write instrrev(filename,"."),1
'r_write filename,0
extname=right(filename,len(filename)-instrrev(filename,"."))
select case ret(0)
case "png","jpg","bmp","gif","swf"
width=ret(1)
height=ret(2)
imgsize=fsize
imgtype=ret(0)
imgname=prename&"."&ret(0)
case else
width=0
height=0
imgsize=fsize
imgname="unknow"
imgtype=".unknow"
end select
if savemode="1" then
defaultname=imgname
if savename="" then
savename=defaultname
else
if lcase(right(savename,4))<>"."&imgtype then
savename=savename&"."&imgtype
end if
end if
else
defaultname=filename
end if
if savename="" then savename=defaultname
savepath=replace(savepath,"//","/")
if right(savepath,1)<>"/" then savepath=savepath&"/"
if savepath="" then savepath="./"
diskpath=server.mappath(savepath&savename)
xupath=replace(replace(diskpath,server.mappath("/"),""),"\","/")
newurl="http://"&request.servervariables("server_name")&xupath
getimagesize=ret
end function
public function saveimg(fullpath)
saveimg=false
if savemode="1" then
if trim(fullpath)="" or _
width=0 or _
height=0 or _
imgsize=0 or _
imgtype=".unknow" then exit function end if
end if
ados.position=0
if savemode="2" then
ados.type=2
ados.charset ="gb2312"
ados.savetofile fullpath,2
textstr=ados.readtext()
else
ados.savetofile fullpath,2
end if
saveimg=true
end function
private function bin2str(bin)
dim i,str,clow
for i=1 to lenb(bin)
clow=midb(bin,i,1)
if ascb(clow)<128 then
str = str & chr(ascb(clow))
else
i=i+1
if i <= lenb(bin) then str = str & chr(ascw(midb(bin,i,1)&clow))
end if
next
bin2str = str
end function
private function num2str(num,base,lens)
dim ret:ret = ""
while(num>=base)
ret=(num mod base) & ret
num=(num - num mod base)/base
wend
num2str = right(string(lens,"0") & num & ret,lens)
end function
private function str2num(str,base)
dim ret:ret = 0
for i=1 to len(str)
ret = ret *base + cint(mid(str,i,1))
next
str2num=ret
end function
private function binval(bin)
dim ret:ret = 0
for i = lenb(bin) to 1 step -1
ret = ret *256 + ascb(midb(bin,i,1))
next
binval=ret
end function
private function binval2(bin)
dim ret:ret = 0
for i = 1 to lenb(bin)
ret = ret *256 + ascb(midb(bin,i,1))
next
binval2=ret
end function
private function getwebdata(byval strurl)
if strurl="" then
r_write "无效",1
exit function
end if
dim tempstr
tempstr=split(getstrurl,"/")
if tempstr(ubound(tempstr))="" or instr(strurl,"/")=0 then
r_write "未指定有效的url",0
exit function
end if
dim retrieval
set retrieval = server.createobject("microsoft.xmlhttp")
with retrieval
.open "get", strurl, false, "", ""
.send
getwebdata =.responsebody
end with
set retrieval = nothing
end function
end class
%>
<%
sub saveupload(geturl,savepath,savename,mode)
dim chkinfo
if geturl="" then
call tform()
r_write "<br>传输文件栏没有填写!",0
end if
set imgup=new boxinfoimg
if mode="1" and imgup.imgname="unknow" then
call tform()
set imgup=nothing
r_write "<br>传输文件栏没有填写有效的图像url!",0
end if
chkinfo=""
dim i,teststr,showstr
'限定格式
select case imgup.imgtype
case "png","jpg","bmp","gif"
if imgup.width=0 or imgup.height=0 or imgup.imgsize=0 then
chkinfo="<li>"+"传输图像数据不存在,请确定你的url是否正确"
end if
case else
chkinfo="<li>无效的传输格式,允许图像数据格式为 ""png"",""jpg"",""bmp"",""gif""</li>"
end select
'r_write savepath,1
'r_write mode,1
'r_write imgup.imgname,1
'r_write imgup.filename,1
'r_write "savename="&savename,1
if mode="1" and chkinfo<>"" then '检查上传图像数据合格后,则保存之
call tform()
r_write chkinfo,0
else
server.scripttimeout=5000
imgup.saveimg imgup.diskpath
end if
'-------------
r_write "<b>===处理结果部分资料===</b><br>",1
r_write " 宽:"&imgup.width&" pix",1
r_write " 高:"&imgup.height&" pix",1
r_write " 大小:"&formatnumber(imgup.imgsize/1024,2,-1)&" kb",1
r_write " 格式:"&imgup.imgtype,1
r_write "图像文件名:"&imgup.imgname,1
r_write "文件名:"&imgup.filename,1
r_write "扩展名:"&imgup.extname,1
r_write "保存位置:"&imgup.diskpath,1
r_write "虚拟路径:"&imgup.xupath,1
r_write "保存后url:"&imgup.newurl,1
call tform()
set imgup=nothing
r_write "------------------------<br>传输完毕",0
end sub
sub tform()
%>
<form method=post name=form2 style="margin:0px;">
获取 url:<input type="text" size=50 name="getstrurl" value="http://www.blueidea.com/img/common/logo.gif"><br>
保存路径:<input type="text" size=50 name="savepath" value="./"><br>
保存文件名:<input type="text" size=50 name="savename" value=""><br>
保存类型:
<input type="radio" name="savemode" value=1 <%if isavemode="1" or isavemode="" then response.write "checked" end if%>> web图像
<input type="radio" name="savemode" value=2 <%if isavemode="2" then response.write "checked" end if%>> 文本文件
<input type="radio" name="savemode" value=0 <%if isavemode="0" then response.write "checked" end if%>> 二进制数据
<input type="submit" value="确定提交">
<hr size=1>
<%
if getstrurl<>"" then
if isavemode="2" then
r_write "<button name=""previews"" title=""页面快照"" onclick=""runcode(0);"">run this code</button>",1
r_write "<textarea cols=100 name=content rows=10 style="" width:90%;fixed;word-break:break-all;"">"&server.htmlencode(imgup.textstr)&"</textarea>",1
else
r_write "<img src="""&imgup.xupath&"?"&timer()&""" width="&imgup.width&" height="&imgup.height&" alt="&imgup.imgname&">",1
end if
end if
%>
</form>
<hr size=1>
<br>如果保存为图像,不要加扩展名,自动识别加上,如果加的扩展名不合也回自动加上
<br>保存文件路径为空则保存在当前路径
<br>保存文件名为空则使用自动识别取得的文件名
<br>保存为其他任意方式,对asp html 等为取得发送结果的html
<%end sub
sub r_write(str,num)
dim istr:istr=str
dim inum:inum=num
response.write str&"<br>"
if inum=0 then response.end
end sub
'=================调用过程 execute========================
%>
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
<head>
<title> new document </title>
<meta name="generator" content="editplus">
<meta name="author" content="v37">
<meta name="keywords" content="">
<meta name="description" content="">
<script language="javascript">
<!--
/*function runcode()
{
var code=event.srcelement.parentelement.children[0].value;
var newwin=window.open('','','');
newwin.opener = null
newwin.document.write(code);
newwin.document.close();
}
function setsmiley(what)
{
document.postform.comment.value += " "+what;
document.postform.comment.focus();
} */
function runcode(num) //运行代码html
{
// var code=event.srcelement.parentelement.children[0].value;
if(num==1){var code=window.form2.code.innertext;}
if(num==0){var code=window.form2.content.innertext;}
var newwin=window.open('','','');
newwin.opener = null
newwin.document.write(code);
newwin.document.close();
}
//-->
</script>
</head>
<body>
<%
dim imgup '传输对象
dim getstrurl '要获取的图像或网页url
dim isavename '要保存的名字
dim isavepath '要保存的虚拟路径
dim isavemode '保存的模式 1 为图像 0 为任意文件
isavepath=trim(request.form("savepath"))
isavename=trim(request.form("savename"))
getstrurl=trim(request.form("getstrurl"))
isavemode=trim(request.form("savemode"))
if getstrurl<>"" then
call saveupload(getstrurl,isavepath,isavename,isavemode)
call tform()
else
call tform()
end if
%>
</body>
</html>
上一篇: ASP利用Google实现在线翻译功能
下一篇: [ASP]使用类,实现模块化