在页面中指定了宽度,如何用ASP获取远程图片的高度
比如:http://www.hdsjw.com/uploadfiles/200711299623757.jpg
<img src="http://www.hdsjw.com/uploadfiles/200711299623757.jpg" style="width: 313px; height: ???px;">
------解决方案--------------------
- VBScript code
Class imgInfo dim aso Private Sub Class_Initialize set aso=CreateObject("Adodb.Stream") aso.Mode=3 aso.Type=1 aso.Open End Sub Private Sub Class_Terminate err.clear set aso=nothing End Sub Private Function Bin2Str(Bin) Dim I, Str 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 getImageSize(filespec,filefrom) dim ret(3) select case filefrom case 1 '1为同域文件,否则为异域文件 aso.LoadFromFile(filespec) case 2 ASO.Write filespec ASO.Position = 0 end select bFlag=ASO.Read(3) select case hex(binVal(bFlag)) case "4E5089": aso.read(15) ret(0)="PNG" ret(1)=BinVal2(aso.read(2)) aso.read(2) ret(2)=BinVal2(aso.read(2)) case "464947": aso.read(3) ret(0)="GIF" ret(1)=BinVal(aso.read(2)) ret(2)=BinVal(aso.read(2)) case "535746": aso.read(5) binData=aso.Read(1) sConv=Num2Str(ascb(binData),2 ,8) nBits=Str2Num(left(sConv,5),2) sConv=mid(sConv,6) while(len(sConv)<nBits*4) binData=aso.Read(1) sConv=sConv&Num2Str(ascb(binData),2 ,8) wend ret(0)="SWF" ret(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20) ret(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20) case "FFD8FF": do do: p1=binVal(aso.Read(1)): loop while p1=255 and not aso.EOS If p1>191 and p1<196 Then exit do else aso.read(binval2(aso.Read(2))-2) do:p1=binVal(aso.Read(1)):loop while p1<255 and not aso.EOS loop while true aso.Read(3) ret(0)="JPG" ret(2)=binval2(aso.Read(2)) ret(1)=binval2(aso.Read(2)) case else: If left(Bin2Str(bFlag),2)="BM" Then aso.Read(15) ret(0)="BMP" ret(1)=binval(aso.Read(4)) ret(2)=binval(aso.Read(4)) else ret(0)="" End If end select ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &"""" getimagesize=ret End Function Public Function imgW(pic_path,filefrom) '参数filefrom是判断文件是远程http开头的还是本地的 '1为本地,2为远程 select case filefrom case 1 Set fso1 = server.CreateObject("Scripting.FileSystemObject") If (fso1.FileExists(pic_path)) Then Set f1 = fso1.GetFile(pic_path) ext=fso1.GetExtensionName(pic_path) select case ext case "gif","bmp","jpg","png": arr=getImageSize(f1.path,1) imgW = arr(1) end select Set f1=nothing else imgW = 0 End If Set fso1=nothing case 2 Arr=GetImageSize(pic_path,2) imgW = Arr(1) end select End Function Public Function imgH(pic_path,filefrom) select case filefrom case 1 Set fso1 = server.CreateObject("Scripting.FileSystemObject") If (fso1.FileExists(pic_path)) Then Set f1 = fso1.GetFile(pic_path) ext=fso1.GetExtensionName(pic_path) select case ext case "gif","bmp","jpg","png": arr=getImageSize(f1.path,1) imgH = arr(2) end select Set f1=nothing else imgH = 0 End If Set fso1=nothing case 2 Arr=getImageSize(pic_path,2) imgH = Arr(2) end select End Function End Class '可以用于读取远程图片信息的类 Class Class_Http Private ArrProgId,Prog,Flag,strXmlHttp Private Sub Class_Initialize On Error Resume Next ArrProgId = Array("MSXML2.ServerXMLHTTP.4.0", "MSXML2.ServerXMLHTTP.3.0", "MSXML2.ServerXMLHTTP", "MSXML2.XMLHTTP.5.0", "MSXML2.XMLHTTP.4.0", "MSXML2.XMLHTTP.3.0", "MSXML2.XMLHTTP","Microsoft.XMLHTTP") For Each Prog In ArrProgId If (IsObjInstalled(Prog) = true) Then strXmlHttp = Prog Exit For End If Next End Sub Public Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.createObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function Public Function GetHttpPage(URL) Dim xmlHttp If URL = "" Or Len(URL)<18 Or URL = "$False$" Then GetHttpPage = "$False$" Exit Function End If Set xmlHttp = Server.CreateObject(strXmlHttp) With xmlHttp .SetTimeouts 10000, 10000, 10000, 10000 .Open "GET", URL, False .Send() End With If xmlHttp.Readystate<>4 Then Set xmlHttp = Nothing GetHttpPage = "$False$" Exit Function End If GetHTTPPage = xmlHttp.responseBody Set xmlHttp = Nothing End Function End Class Set objHttp = New Class_Http Set objImage = New ImgInfo binBody = objHttp.GetHttpPage(img_file) 'response.write lenb(binbody) img_W = objImage.imgW(binBody,2) '取得图片宽度 img_H = objImage.imgH(binBody,2) '取得图片高度 Set objImage = Nothing Set objHttp = Nothing