上传图片的尺寸限制宽度高度能自动的按比例变动的组件或代码(在线等待...有用马上给分)

[huiren]

多多帮忙!!!!

[huiren]

你这样做高度能随着变动吗

[笨笨兔兔兔兔兔]

<SCRIPT RUNAT=SERVER language=vbscript>
Class possible
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
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,i
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,i
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)
dim ret(3),bFlag,p1
aso.LoadFromFile(filespec)
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

Function readX(pic_path)
dim fso1,ext,arr,f1
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
Set f1 = fso1.GetFile(pic_path)
ext=fso1.GetExtensionName(pic_path)
select case ext
case "gif","bmp","jpg","png":
arr=getImageSize(f1.path)
'Response.Write arr(1)
readX=arr(1)
case "swf"
arr=pp.getimagesize(f1.path)
'Response.Write arr(1)
readX=arr(1)
end select
Set f1=nothing
Set fso1=nothing
End Function

Function readY(pic_path)
dim fso1,f1,ext,arr
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
Set f1 = fso1.GetFile(pic_path)
ext=fso1.GetExtensionName(pic_path)
select case ext
case "gif","bmp","jpg","png":
arr=getImageSize(f1.path)
'Response.Write arr(2)
readY=arr(2)
case "swf"
arr=pp.getimagesize(f1.path)
'Response.Write arr(2)
ready=arr(2)
end select
Set f1=nothing
Set fso1=nothing
End Function
End Class
</script>

[笨笨兔兔兔兔兔]

<SCRIPT RUNAT=SERVER language=vbscript>
dim Data_5xsoft

Class upload_5xsoft

dim objForm,objFile,Version

Public function Form(strForm)
strForm=lcase(strForm)
if not objForm.exists(strForm) then
Form=""
else
Form=objForm(strForm)
end if
end function

Public function File(strFile)
strFile=lcase(strFile)
if not objFile.exists(strFile) then
set File=new FileInfo
else
set File=objFile(strFile)
end if
end function


Private Sub Class_Initialize
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
dim dataend,Image,head_height_l,head_height_h,head_width_l,head_width_h,jpgwidth,jpgheight
Version="化境HTTP上传程序 Version 2.0"
set objForm=Server.CreateObject("Scripting.Dictionary")
set objFile=Server.CreateObject("Scripting.Dictionary")
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set Data_5xsoft = Server.CreateObject("adodb.stream")
Data_5xsoft.Type = 1
Data_5xsoft.Mode =3
Data_5xsoft.Open
Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)
Data_5xsoft.Position=0
RequestData =Data_5xsoft.Read

iFormStart = 1
iFormEnd = LenB(RequestData)
vbCrlf = chrB(13) & chrB(10)
sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1
while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iFormStart
Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
set theFile=new FileInfo
'取得图片长宽
dataend = iformstart-iInfoEnd-1
Image=midb(RequestData,iInfoEnd+1,dataend)
head_height_l = Ascb( midb( Image,165,1 ) )
head_height_h = Ascb( midb( Image,164,1 ) )

head_width_l = Ascb( midb( Image,167,1 ) )
head_width_h = Ascb( midb( Image,166,1 ) )

head_width_h = head_width_h * 256

head_height_h = head_height_h * 256
jpgwidth= head_width_h + head_width_l
jpgheight=head_height_h + head_height_l
'取得文件名
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileName=getFileName(sFileName)
theFile.FilePath=getFilePath(sFileName)
'取得文件类型
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileStart =iInfoEnd
theFile.FileSize = iFormStart -iInfoEnd -3
theFile.FormName=sFormName
theFile.image=dataend
theFile.JpgWidth=jpgwidth
theFile.JpgHeight=jpgheight

if not objFile.Exists(sFormName) then
objFile.add sFormName,theFile
end if
else
'如果是表单项目
tStream.Type =1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iInfoEnd
Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sFormValue = tStream.ReadText
tStream.Close
if objForm.Exists(sFormName) then
objForm(sFormName)=objForm(sFormName)&", "&sFormValue
else
objForm.Add sFormName,sFormValue
end if
end if
iFormStart=iFormStart+iStart+1
wend
RequestData=""
set tStream =nothing
End Sub

Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_5xsoft.Close
set Data_5xsoft =nothing
end if
End Sub


Private function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function

Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
End Class

Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileType,FileStart,JpgWidth,JpgHeight,image
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
FileType = ""
JpgWidth=0
JpgHeight=0
image=0
End Sub

Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=true
if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
Data_5xsoft.position=FileStart
Data_5xsoft.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=false
end function
End Class
</SCRIPT>

[笨笨兔兔兔兔兔]

<%OPTION EXPLICIT%>
<%Server.ScriptTimeOut=5000%>
<!--#include FILE="upload_5xsoft.inc"-->
<!--#include FILE="picwl.inc"-->
<% dim id
id=session("id")
if id=0 then
response.redirect("manageindex.htm")
end if
%>

<%
dim upload,file,formName,formPath,iCount,length,pp,height,datey,datem,dated,dateh,datemin,random1,filename
set upload=new upload_5xsoft ''建立上传对象
dim conn,rs
Set conn=Server.CreateObject("ADODB.Connection")
conn.Open "liu","",""


formPath=id&"\"


iCount=0
for each formName in upload.objForm ''列出所有form数据
'response.write formName&"="&upload.form(formName)&"<br>"
next

response.write "<br>"
for each formName in upload.objFile ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
datey=year(now())
datem=month(now())
dated=day(now())
random1=cint(rnd()*1000)
filename=session("name")
filename=filename&"_"&datey&datem&dated&random1
file.SaveAs Server.mappath(formPath&filename) ''保存文件
'response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&" 成功!<br>"
set rs=Server.CreateObject("ADODB.Recordset")
rs.open "pic",conn,1,3
set pp=new possible
length=pp.readX(Server.mappath(formPath&filename))
height=pp.readY(Server.mappath(formPath&filename))
formPath=id&"\"&filename
rs.addnew
rs("picname")=formPath
rs("id")=cint(id)
rs("filesize")=cLng(file.filesize)
rs("width")=cLng(length)
rs("height")=cLng(height)
rs.update
iCount=iCount+1
end if
rs.close
set rs=nothing
set file=nothing
next

set upload=nothing ''删除此对象
'Htmend iCount&" 个文件上传结束!"
response.redirect("picdisplay1.asp")
sub HtmEnd(Msg)
set upload=nothing
'response.write "<br>"&Msg&" [<a href=""javascript:history.back();"">返回</a>]</body></html>"
'response.end
end sub
%>

[satans18]

显示的时候也可以啊~~<img src="<%=pic_big%>" onload="javascript:if(this.width>450)this.width=450">