http://topic.csdn.net/u/20110601/18/8605d746-cdbf-41cb-a598-0b8e41844d98.html?seed=401059464&r=73977978#r_73977978 <% '================================如有朋友继续完善此程序,请发原作者一份 'BuildSmallPic 1.0 'Author1:laifangsong QQ:25313644 '开发日期:不知 'BuildSmallPic 2.0 'Author2:shuangren QQ:80677452 '开发日期:2011-6-10 '要求:ASPJPEG组件2.1及以上版本!!! 'BuildSmallPic 2.0增加了以下功能: '1.自动判断jpg、gif、png格式图片,成比例产生缩略图 '2.生成gif动画文件的缩略图功能,缩略图可动 '3.生成png文件的缩略图功能 '4.增加了缩略图质量参数 '功能:按照指定图片生成缩略图 '注意:以下提到的“路径”都是值相对于调用本函数的文件的相对路径 '参数: ' m_path1: 原图片路径 例:images/image1.gif ' m_path2: 生成图片的基路径,不论是否以“/”结尾均可 例:images或images/ ' n_MaxWidth: 生成图片最大宽度 ' n_MaxHeight: 生成图片最大高度 ' n_Quality: 缩略图质量0-100 '返回值: ' 返回生成后的缩略图的路径 '错误处理: ' 如果函数执行过程中出现错误,将返回错误代码,错误代码以 “Error”开头 ' Error_01:创建AspJpeg组件失败,没有正确安装注册该组件 ' Error_02:原图片不存在,检查s_OriginalPath参数传入值 ' Error_03:缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足 ' Error_Other:未知错误 '调用例子: ' Dim sSmallPath '缩略图路径 ' sSmallPath = BuildSmallPic("images/image1.gif", "images", 100, 100, 90) '================================================================ Function BuildSmallPic(m_path1, m_path2, n_MaxWidth, n_MaxHeight, n_Quality) Err.Clear On Error Resume Next '检查组件是否已经注册 Dim AspJpeg Set AspJpeg = Server.Createobject("Persits.Jpeg") If Err.Number <> 0 Then Err.Clear BuildSmallPic = "组件安装不正确!" Exit Function End If '按比例取得缩略图宽度和高度 Dim n_picWidth, n_picHeight '原图片宽度、高度 Dim n_newWidth, n_newHeight '缩略图宽度、高度 Dim extn '判断不同扩展名 extn = split(m_path1, ".") select case extn(ubound(extn)) case "jpg" AspJpeg.Open m_path1 n_picWidth = AspJpeg.Width n_picHeight = AspJpeg.Height if n_picWidth > n_MaxWidth or n_picHeight > n_MaxHeight then if n_picWidth/n_picHeight >= n_MaxWidth/n_MaxHeight then AspJpeg.Width = n_MaxWidth AspJpeg.Height = n_MaxWidth/(n_picWidth/n_picHeight) else AspJpeg.Width = n_picWidth/n_picHeight*n_MaxHeight AspJpeg.Height = n_MaxHeight end if else AspJpeg.Width = n_picWidth AspJpeg.Height = n_picHeight end if AspJpeg.Quality = n_Quality AspJpeg.Save m_path2 '保存 If Err.Number <> 0 Then Err.Clear BuildSmallPic = "Error_03" Exit Function End If Set AspJpeg = Nothing case "gif" Set Gif = AspJpeg.Gif Gif.Open m_path1 n_picWidth = Gif.Width n_picHeight = Gif.Height if n_picWidth > n_MaxWidth or n_picHeight > n_MaxHeight then if n_picWidth/n_picHeight >= n_MaxWidth/n_MaxHeight then Gif.Resize n_MaxWidth, n_MaxWidth/(n_picWidth/n_picHeight) else Gif.Resize n_picWidth/n_picHeight*n_MaxHeight, n_MaxHeight end if else Gif.Resize n_picWidth, n_picHeight end if Gif.Save m_path2 '保存 If Err.Number <> 0 Then Err.Clear BuildSmallPic = "Error_03" Exit Function End If Set AspJpeg = Nothing Set Gif = Nothing case "png" AspJpeg.Open m_path1 n_picWidth = AspJpeg.Width n_picHeight = AspJpeg.Height AspJpeg.PreserveAspectRatio = True if n_picWidth > n_MaxWidth or n_picHeight > n_MaxHeight then if n_picWidth/n_picHeight >= n_MaxWidth/n_MaxHeight then AspJpeg.Width = n_MaxWidth AspJpeg.Height = n_MaxWidth/(n_picWidth/n_picHeight) else AspJpeg.Width = n_picWidth/n_picHeight*n_MaxHeight AspJpeg.Height = n_MaxHeight end if else AspJpeg.Width = n_picWidth AspJpeg.Height = n_picHeight end if AspJpeg.PNGOutput = True AspJpeg.Save m_path2 case else end select If Err.Number <> 0 Then BuildSmallPic = "Error_Other" Err.Clear End If BuildSmallPic = s_BuildBasePath & s_BuildFileName End Function %>