imgdata变量 图片二进制数据流 s_BuildBasePat图片保存相对路径 n_MaxWidth图片最大宽度（超过最大宽度，即等比例缩放，长度不用设置）
Function BuildSmallPic(ByVal imgdata, s_BuildBasePath, n_MaxWidth) '缩放压缩保存图片
Err.Clear
On Error Resume Next

'检查组件是否已经注册
Dim AspJpeg
Set AspJpeg = Server.Createobject("Persits.Jpeg")
If Err.Number <> 0 Then
Err.Clear
BuildSmallPic = "Error_01"
Exit Function
End If
'检查原图片是否存在
AspJpeg.OpenBinary imgdata'打开数据流
' AspJpeg.Interpolation=0'插值
' AspJpeg.Quality=90'图片质量
If Err.Number <> 0 Then
Err.Clear
BuildSmallPic = "Error_02"
Exit Function
End If
'按比例取得缩略图宽度和高度
Dim n_OriginalWidth, n_OriginalHeight '原图片宽度、高度
Dim n_BuildWidth, n_BuildHeight '缩略图宽度、高度
Dim div1, div2
Dim n1, n2
n_OriginalWidth = AspJpeg.Width
n_OriginalHeight = AspJpeg.Height
div1 = n_OriginalWidth / n_OriginalHeight
div2 = n_OriginalHeight / n_OriginalWidth
n1 = 0
n2 = 0
If n_OriginalWidth > n_MaxWidth Then
n_BuildWidth=n_MaxWidth
n_BuildHeight=n_BuildWidth/div1
n1 = n_OriginalWidth / n_MaxWidth
Else
n_BuildWidth = n_OriginalWidth
n_BuildHeight= n_OriginalHeight
End If
'指定宽度和高度生成
AspJpeg.Width = n_BuildWidth
AspJpeg.Height = n_BuildHeight

'--将缩略图存盘开始--
Dim pos, s_OriginalFileName, s_OriginalFileExt '位置、原文件名、原文件扩展名
pos = InStrRev(s_OriginalPath, "/") + 1
s_OriginalFileName = Mid(s_OriginalPath, pos)
pos = InStrRev(s_OriginalFileName, ".")
s_OriginalFileExt = Mid(s_OriginalFileName, pos)
Dim s_MapBuildBasePath, s_MapBuildPath, s_BuildFileName '缩略图绝对路径、缩略图文件名
Dim s_EndFlag '小图片文件名结尾标识 例: 如果大图片文件名是“image1.gif”,结尾标识是“_small”,那么小图片文件名就是“image1_small.gif”
If Right(s_BuildBasePath, 1) <> "/" Then s_BuildBasePath = s_BuildBasePath & "/"
s_MapBuildBasePath = Server.MapPath(s_BuildBasePath)
s_EndFlag = "_small" '可以自定义,只要能区别大小图片即可
s_BuildFileName = Replace(s_OriginalFileName, s_OriginalFileExt, "") & s_EndFlag & s_OriginalFileExt
s_MapBuildPath = s_MapBuildBasePath & "\" & s_BuildFileName

AspJpeg.Save Server.MapPath(s_BuildBasePath) '保存
If Err.Number <> 0 Then
Err.Clear
BuildSmallPic = "Error_03"
Exit Function
End If
'--将缩略图存盘结束--
'注销实例
Set AspJpeg = Nothing
If Err.Number <> 0 Then
BuildSmallPic = "Error_Other"
Err.Clear
End If
BuildSmallPic = s_BuildBasePath & s_BuildFileName
End Function

声明：部分文章不代表本站观点，版权归原作者所有。