ASP实现上传图片自动 压缩图片大小 留存待修改

<!-- #include file="conn.asp" --><!--#include file="upload.inc"--><%'on error resume next%><%dim upload,file,formName,formPath,iCount,filename,fileExt,i,mima,passwordset upload=new upload_5xSoft '建立上传对象name=upload.form("name")formPath="../../uploadpic/"&Request.Cookies("login")("userName")&"/"'上传相对目录userFileName=request.Cookies("login")("userName")'建立企业图片保存目录CreateFolder(Server.MapPath("../../uploadpic/"&userFileName))   '建立企业文件夹CreateFolder(Server.MapPath("../../uploadpic/"&userFileName&"/s"))   '建立小图存放路径CreateFolder(Server.MapPath("../../uploadpic/"&userFileName&"/b"))   '建立小图存放路径if right(formPath,1)<>"/" then formPath=formPath&"/" for each formName in upload.file '列出所有上传了的文件    set file=upload.file(formName)  '生成一个文件对象       if file.filesize<0  then            response.Write("请选择上传的文件")        response.end    end if       if file.filesize>500000 then                response.Write("文件不得超过500Kb")        response.end    end if    fileExt=lcase(right(file.filename,4))    if fileEXT<>".gif" and fileEXT<>".jpg" and fileEXT<>".png" then        response.Write("只允许上传gif,jPG,png文件!")    response.end    end if             Dim Jpeg    FilePath=Server.MapPath("./")'设置上传目录位置   FilePath=Req(FilePath &"/"&formPath)   Set Jpeg = Server.CreateObject("Persits.Jpeg")If -2147221005=Err then response.Write("没有ASPJPEG组件请安装")Response.End() End If ranNum=int(900*rnd)+100    filenamett=file.FileName    filenamet=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&fileExt    filename=Req(filepath&filenamet)    filesize=file.filesize    if file.FileSize>0 then         '如果 FileSize > 0 说明有文件数据        file.SaveAs filename   '保存文件        else    response.redirect "info.asp?info=文件错误!"        response.Write("文件错误")    response.end    end if    '图片水印功能开始Jpeg.Open filenameJpeg.Canvas.Font.Color = &HFFFFFFJpeg.Canvas.Font.Family = "Arial" 'family设置字体Jpeg.Canvas.Font.Bold = True  '是否设置成粗体Jpeg.Canvas.Font.Size = 16 '字体大小Jpeg.Canvas.Font.Quality = 2'输出质量 Jpeg.Canvas.Print Jpeg.width-150, Jpeg.height-23, "WWW.2007LJFW.COM"'Jpeg.Save filename'需要水印保留这句即可'图片水印功能结束    set file=nothing    Jpeg.Open (filename)    '开始变更所有文件扩展名为jpg    filenamelen=len(filenamet)    filenamelen=filenamelen-4    filenamet1=filenamet    filenamet=left(filenamet,filenamelen)    filenamet=filenamet&".jpg"    '结束文件名变更    '开始判断哪边为长边，以长边进行缩放    imgWidth=Jpeg.OriginalWidth    imgHeight=Jpeg.OriginalHeight    if imgWidth>=imgHeight and imgWidth>=150 then         Jpeg.Width=150    Jpeg.Height=Jpeg.OriginalHeight/(Jpeg.OriginalWidth/150)        end if    if imgHeight>imgWidth and imgHeight>200 then         Jpeg.Height=200    Jpeg.Width=Jpeg.OriginalWidth/(Jpeg.OriginalHeight/200)        end if    '结束判断    'ImgObj.SaveFile(FilePath & "small_" & filenamet)        'end if    'ImgObj.Free    'Set ImgObj = nothing        Jpeg.Sharpen 1, 130    Jpeg.Save (FilePath & "/s/"&filenamet)    '写入数据库    yy=year(date)    mm=right("00"&month(date),2)    dd=right("00"&day(date),2)    idate=yy & "-" & mm & "-" & dd & " "    xx=right("00"&hour(time),2)    ff=right("00"&minute(time),2)    mm=right("00"&second(time),2)    itime=xx & ":" & ff & ":" & mm    itime=idate&itime    photourlb=formPath & filenamet1        'if imgwidth<320 and imgheight<240 then    photourls=formPath & "s/"&filenamet        'else        'photourls=photourlb        'end ifname=upload.form("name")rs.open "SMT_cp",conn_p,1,3rs.addnewrs("name")=trim(upload.form("name"))rs.updaters.close        nextset upload=nothing  conn.closeset conn=nothingconn_p.closeset conn_p=nothingresponse.Redirect("add_products.asp?action=ok")Function Req(Str)If IsEmpty(Str) Then Exit FunctionStr = Lcase(Str)doA_len=len(Str)Str = Replace(Str,Chr(0),"")Str = Replace(Str,"asp","")Str = Replace(Str,"asa","")Str = Replace(Str,"aspx","")Str = Replace(Str,"cer","")Str = Replace(Str,"cdx","")Str = Replace(Str,"htr","")Str = Replace(Str,"asax","")Str = Replace(Str,"ascx","")Str = Replace(Str,"ashx","")Str = Replace(Str,"asmx","")Str = Replace(Str,"axd","")Str = Replace(Str,"vsdiso","")Str = Replace(Str,"rem","")Str = Replace(Str,"soap","")Str = Replace(Str,"config","")Str = Replace(Str,"cs","")Str = Replace(Str,"csproj","")Str = Replace(Str,"vb","")Str = Replace(Str,"vbproj","")Str = Replace(Str,"webinfo","")Str = Replace(Str,"licx","")Str = Replace(Str,"resx","")Str = Replace(Str,"resou","")Str = Replace(Str,"jsp","")Str = Replace(Str,"php","")Str = Replace(Str,"cgi","")str = Replace(str," ","")str = Replace(str,"%5C","")str = Replace(str,"%2F","")str = Replace(str,"asp","")str = Replace(str,"asa","")str = Replace(str,"cer","")str = Replace(str,"cdx","")str = Replace(str,"mdb","")str = Replace(str,"hrt","")str = Replace(str,"aspx","")str = Replace(str,"php","")str = Replace(str,"jsp","")str = Replace(str,"'","")loop until A_len=len(Str) Req=StrEnd FunctionFunction CreateFolder(Filepath)        Dim fso, f        on error resume next        Set fso = CreateObject("Scripting.FileSystemObject")        if not fso.FolderExists(Filepath) then                Set f = fso.CreateFolder(Filepath)                set f = Nothing        end if        set fso = NothingEnd Function%>