复制代码 代码如下:
<%@LANGUAGE="VBSCRIPT"CODEPAGE="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))
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":
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)="BM"then
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)
case"png","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="1"then
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="http://"&Request.ServerVariables("SERVER_NAME")&XuPath
getimagesize=ret
EndFunction
PublicfunctionSaveImg(FullPath)
SaveImg=false
ifSaveMode="1"then
iftrim(fullpath)=""or_
width=0or_
height=0or_
imgSize=0or_
imgType=".unknow"thenexitfunctionendif
endif
ADOS.Position=0
ifSaveMode="2"then
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
.Open"Get",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="1"andimgUp.imgName="unknow"then
calltform()
setimgUp=nothing
R_Write"<br>传输文件栏没有填写有效的图像URL!",0
endif
chkInfo=""
dimi,testStr,showStr
'限定格式
selectcaseimgUp.imgType
case"png","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_Write"SaveName="&SaveName,1
ifmode="1"andchkInfo<>""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="text"size=50NAME="GetStrUrl"value="http://www.blueidea.com/img/common/logo.gif"><br>
保存路径：<INPUTTYPE="text"size=50NAME="SavePath"value="./"><br>
保存文件名：<INPUTTYPE="text"size=50NAME="SaveName"value=""><br>
保存类型：
<INPUTTYPE="radio"NAME="SaveMode"value=1<%ifiSaveMode="1"oriSaveMode=""thenresponse.write"checked"endif%>>Web图像
<INPUTTYPE="radio"NAME="SaveMode"value=2<%ifiSaveMode="2"thenresponse.write"checked"endif%>>文本文件
<INPUTTYPE="radio"NAME="SaveMode"value=0<%ifiSaveMode="0"thenresponse.write"checked"endif%>>二进制数据
<INPUTTYPE="submit"value="确定提交">
<hrsize=1>
<%
ifGetStrUrl<>""then
ifiSaveMode="2"then
R_write"<buttonname=""Previews""title=""页面快照""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="Generator"CONTENT="EditPlus">
<METANAME="Author"CONTENT="V37">
<METANAME="Keywords"CONTENT="">
<METANAME="Description"CONTENT="">
<SCRIPTLANGUAGE="JavaScript">
<>
</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>