复制代码 代码如下:
<%@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://ment.focus();
}*/
functionrunCode(num)//运行代码HTML
{
//varcode=event.srcElement.parentElement.children[0].value;
if(num==1){varcode=window.form2.code.innerText;}
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>