直接保存URL图像或网页到服务器本地的类

　　复制代码 代码如下:
<%@LANGUAGE=VBSCRIPTCODEPAGE=936%>
<%
OptionExplicit

ClassBoxInfoImg
传输类的使用方法
图象上传和上传信息获取CLASS

用法:
dimimgUp
setimgUp=newBoxInfoImg

属性:
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)保存图像文件

dimADOS
dimwidth,height,imgSize,imgType,imgName,fileName
dimpreName,extName
dimSavePath,SaveName,SaveMode
dimDiskPath,XuPath,NewUrl
dimtextStr
dimi

PrivateSubClass_Initialize
setADOS=Server.CreateObject(Adodb.Stream)
ADOS.Type=1
ADOS.Mode=3
ADOS.Open
getImageSize
EndSub

PrivateSubClass_Terminate
ADOS.close
setADOS=nothing
EndSub

PublicFunctiongetImageSize()

dimret(3),bFlag,fdata,fsize

fdata=GetWebData(GetStrUrl)取得XmlHttp数据
fsize=clng(lenb(fdata))取得数据尺寸


iffsize=0then
exitfunction
R_write无有效数据保存,0
endif

ADOS.Writefdata
ADOS.Position=0

SaveName=iSaveName
SavePath=iSavePath
SaveMode=iSaveMode

写文本对象读取图像长宽和类型

ADOS.Position=0重置数据开始位置
bFlag=ADOS.read(3)

ifisNull(bFlag)then
width=0
height=0
imgSize=0
imgType=unknow
ret(0)=imgType:ret(1)=width:ret(2)=height:ret(3)=
getimagesize=ret
exitfunction
endif

取文件类型和长宽
selectcasehex(binVal(bFlag))
case4E5089:
ADOS.read(15)
ret(0)=png
ret(1)=BinVal2(ADOS.read(2))
ADOS.read(2)
ret(2)=BinVal2(ADOS.read(2))
case464947:
ADOS.read(3)
ret(0)=gif
ret(1)=BinVal(ADOS.read(2))
ret(2)=BinVal(ADOS.read(2))
caseFFD8FF:
dimp1
do
do:p1=binVal(ADOS.Read(1)):loopwhilep1=255andnotADOS.EOS
ifp1>191andp1<196thenexitdoelseADOS.read(binval2(ADOS.Read(2))-2)
do:p1=binVal(ADOS.Read(1)):loopwhilep1<255andnotADOS.EOS
loopwhiletrue
ADOS.Read(3)
ret(0)=jpg
ret(2)=binval2(ADOS.Read(2))
ret(1)=binval2(ADOS.Read(2))
caseelse:
ifleft(Bin2Str(bFlag),2)=BMthen
ADOS.Read(15)
ret(0)=bmp
ret(1)=binval(ADOS.Read(4))
ret(2)=binval(ADOS.Read(4))
else
ret(0)=
endif
endselect

dimtempStr
dimnameStr
dimdefaultName
dimln
tempStr=split(GetStrUrl,/)
nameStr=tempStr(ubound(tempStr))
ifnameStr=then
r_write错误的URL,请输入可访问的URL,0
exitfunction
endif
fileName=split(nameStr,?)(0)
ln=inStrRev(fileName,.)
ifln>0then
preName=left(fileName,inStrRev(fileName,.)-1)
else
preName=fileName
endif
R_writefileName,1
R_writeinStrRev(fileName,.),1
R_writefileName,0
extName=right(fileName,len(fileName)-inStrRev(fileName,.))

Selectcaseret(0)
casepng,jpg,bmp,gif,swf
width=ret(1)
height=ret(2)
imgSize=fsize
imgType=ret(0)
imgName=preName&.&ret(0)
caseelse
width=0
height=0
imgSize=fsize
imgName=unknow
imgType=.unknow
endselect

ifSaveMode=1then
defaultName=imgName
ifSaveName=then
SaveName=defaultName
else
iflcase(right(SaveName,4))<>.&imgTypethen
SaveName=SaveName&.&imgType
endif
endif
else
defaultName=filename
endif
ifSaveName=thenSaveName=defaultName
SavePath=replace(SavePath,//,/)
ifright(SavePath,1)<>/thenSavePath=SavePath&/
ifSavePath=thenSavePath=./
DiskPath=server.mappath(SavePath&SaveName)
XuPath=replace(replace(DiskPath,server.mappath(/),),\,/)
NewUrl=

getimagesize=ret
EndFunction

PublicfunctionSaveImg(FullPath)
SaveImg=false
ifSaveMode=1then
iftrim(fullpath)=or_
width=0or_
height=0or_
imgSize=0or_
imgType=.unknowthenexitfunctionendif
endif
ADOS.Position=0
ifSaveMode=2then
ADOS.Type=2
ADOS.Charset=gb2312
ADOS.SaveToFileFullPath,2
textStr=ADOS.readtext()
else
ADOS.SaveToFileFullPath,2
endif
SaveImg=true
Endfunction

PrivateFunctionBin2Str(Bin)
DimI,Str,clow
ForI=1toLenB(Bin)
clow=MidB(Bin,I,1)
ifASCB(clow)<128then
Str=Str&Chr(ASCB(clow))
else
I=I+1
ifI<=LenB(Bin)thenStr=Str&Chr(ASCW(MidB(Bin,I,1)&clow))
endif
Next
Bin2Str=Str
EndFunction

PrivateFunctionNum2Str(num,base,lens)
dimret:ret=
while(num>=base)
ret=(nummodbase)&ret
num=(num-nummodbase)/base
wend
Num2Str=right(string(lens,0)&num&ret,lens)
EndFunction

PrivateFunctionStr2Num(str,base)
dimret:ret=0
fori=1tolen(str)
ret=ret*base+cint(mid(str,i,1))
next
Str2Num=ret
EndFunction

PrivateFunctionBinVal(bin)
dimret:ret=0
fori=lenb(bin)to1step-1
ret=ret*256+ascb(midb(bin,i,1))
next
BinVal=ret
EndFunction

PrivateFunctionBinVal2(bin)
dimret:ret=0
fori=1tolenb(bin)
ret=ret*256+ascb(midb(bin,i,1))
next
BinVal2=ret
EndFunction

PrivateFunctionGetWebData(byvalStrUrl)
ifStrUrl=then
r_write无效,1
exitfunction
endif
dimtempStr
tempStr=split(GetStrUrl,/)
iftempStr(ubound(tempStr))=orinStr(StrUrl,/)=0then
R_Write未指定有效的URL,0
exitfunction
endif
dimRetrieval
SetRetrieval=Server.CreateObject(Microsoft.XMLHTTP)
WithRetrieval
.OpenGet,StrUrl,False,,
.Send
GetWebData=.ResponseBody
EndWith
SetRetrieval=Nothing
EndFunction

EndClass
%>
<%
SUBsaveUpload(GetUrl,SavePath,SaveName,mode)
dimchkInfo

ifGetUrl=then
calltform()
R_Write<br>传输文件栏没有填写!,0
endif

setimgUp=newBoxInfoImg

ifmode=1andimgUp.imgName=unknowthen
calltform()
setimgUp=nothing
R_Write<br>传输文件栏没有填写有效的图像URL!,0
endif

chkInfo=
dimi,testStr,showStr
限定格式
selectcaseimgUp.imgType
casepng,jpg,bmp,gif
ifimgUp.width=0orimgUp.height=0orimgUp.imgSize=0then
chkInfo=<li>+传输图像数据不存在,请确定你的URL是否正确
endif
caseelse
chkInfo=<li>无效的传输格式,允许图像数据格式为png,jpg,bmp,gif</li>
endselect

R_WriteSavePath,1
R_Writemode,1
R_WriteimgUp.imgName,1
R_WriteimgUp.filename,1
R_WriteSaveName=&SaveName,1

ifmode=1andchkInfo<>then检查上传图像数据合格后,则保存之
calltform()
R_WritechkInfo,0
else
Server.ScriptTimeOut=5000
imgUp.saveImgimgUp.DiskPath
endif
-------------
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
calltform()
setimgUp=nothing
R_write------------------------<br>传输完毕,0
EndSUB

SUBtform()
%>
<FORMMETHOD=POSTname=form2style=margin:0px;>
获取URL：<INPUTTYPE=textsize=50NAME=GetStrUrlvalue=
保存路径：<INPUTTYPE=textsize=50NAME=SavePathvalue=./><br>
保存文件名：<INPUTTYPE=textsize=50NAME=SaveNamevalue=><br>
保存类型：
<INPUTTYPE=radioNAME=SaveModevalue=1<%ifiSaveMode=1oriSaveMode=thenresponse.writecheckedendif%>>Web图像
<INPUTTYPE=radioNAME=SaveModevalue=2<%ifiSaveMode=2thenresponse.writecheckedendif%>>文本文件
<INPUTTYPE=radioNAME=SaveModevalue=0<%ifiSaveMode=0thenresponse.writecheckedendif%>>二进制数据
<INPUTTYPE=submitvalue=确定提交>

<hrsize=1>
<%
ifGetStrUrl<>then
ifiSaveMode=2then
R_write<buttonname=Previewstitle=页面快照onclick=runCode(0);>Runthiscode</button>,1
R_write<textareacols=100name=contentrows=10style=width:90%;fixed;word-break:break-all;>&server.htmlencode(imgUp.textStr)&</textarea>,1
else
R_write<imgsrc=&imgUp.XuPath&?&timer()&width=&imgUp.width&height=&imgUp.height&alt=&imgUp.imgName&>,1
endif
endif
%>
</FORM>
<hrsize=1>
<br>如果保存为图像，不要加扩展名，自动识别加上，如果加的扩展名不合也回自动加上
<br>保存文件路径为空则保存在当前路径
<br>保存文件名为空则使用自动识别取得的文件名
<br>保存为其他任意方式，对asphtml等为取得发送结果的Html
<%EndSUB

SubR_write(str,num)
dimistr:istr=str
diminum:inum=num
response.writestr&<br>
ifinum=0thenresponse.end
endsub

=================调用过程Execute========================
%>
<!DOCTYPEHTMLPUBLIC-//W3C//DTDHTML4.0Transitional//EN>
<HTML>
<HEAD>
<TITLE>NewDocument</TITLE>
<METANAME=GeneratorCONTENT=EditPlus>
<METANAME=AuthorCONTENT=V37>
<METANAME=KeywordsCONTENT=>
<METANAME=DescriptionCONTENT=>
<SCRIPTLANGUAGE=JavaScript>
<!--
/*functionrunCode()
{
varcode=event.srcElement.parentElement.children[0].value;
varnewwin=window.open(,,);
newwin.opener=null
newwin.document.write(code);
newwin.document.close();
}
functionsetsmiley(what)
{
}*/
functionrunCode(num)//运行代码HTML
{
//varcode=event.srcElement.parentElement.children[0].value;
if(num==0){varcode=window.form2.content.innerText;}
varnewwin=window.open(,,);
newwin.opener=null
newwin.document.write(code);
newwin.document.close();
}
//-->
</SCRIPT>
</HEAD>
<BODY>
<%
dimimgUp传输对象
dimGetStrUrl要获取的图像或网页URL
dimiSaveName要保存的名字
dimiSavePath要保存的虚拟路径
dimiSaveMode保存的模式1为图像0为任意文件
iSavePath=trim(request.form(SavePath))
iSaveName=trim(request.form(SaveName))
GetStrUrl=trim(request.form(GetStrUrl))
iSaveMode=trim(request.form(SaveMode))
ifGetStrUrl<>then
CALLsaveUpload(GetStrUrl,iSavePath,iSaveName,iSaveMode)
calltform()
else
calltform()
endif
%>
</BODY>
</HTML>