Err.Clear Set AspJpeg_Obj=Nothing End Sub '判断文件是否存在 Private Function FileIs(path) Set fsos=Server.createObject("Scripting.FileSystemObject") FileIs=fsos.FileExists(path) Set fsos=Nothing End Function
'判断目录是否存在 Private Function FolderIs(path) Set fsos=Server.createObject("Scripting.FileSystemObject") FolderIs=fsos.FolderExists(path) Set fsos=Nothing End Function '******************************************* '函数作用：取得当前文件的上一级路径 '******************************************* Private Function UpDir(ByVal D) If Len(D) = 0 then UpDir="" Else UpDir=Left(D,InStrRev(D,"\")-1) End If End Function
Private Function Errors(Errors_id) select Case Errors_id Case "0" Errors="指定文件不存在" Case 1 Errors="指定目录不存在" Case 2 Errors="已存在相同名称文件" Case 3 Errors="参数溢出" End select End Function
'取图片宽度 Public Function ImgInfo_Width(Img_MathPath) If Not(FileIs(Img_MathPath)) then 'Exit Function ImgInfo_Width=Errors(0) Else AspJpeg_Obj.Open Img_MathPath ImgInfo_Width=AspJpeg_Obj.width End If End Function '取图片高度 Public Function ImgInfo_Height(Img_MathPath) If Not(FileIs(Img_MathPath)) then 'Exit Function ImgInfo_Height=Errors(0) Else AspJpeg_Obj.Open Img_MathPath ImgInfo_Height=AspJpeg_Obj.height End If End Function '生成缩略图/放大图 Public Function Img_Reduce() If Not(FileIs(Img_MathPath_From)) then Img_Reduce=Errors(0) Exit Function End If If Not(FolderIs(UpDir(Img_MathPath_To))) then Img_Reduce=Errors(1) Exit Function End If If CoverIf=0 or CoverIf=False then If FileIs(Img_MathPath_To) then Img_Reduce=Errors(2) Exit Function End If End If AspJpeg_Obj.Open Img_MathPath_From AspJpeg_Obj.PreserveAspectRatio = True If AspJpeg_Obj.OriginalWidth>AspJpeg_Obj.OriginalHeight Then AspJpeg_Obj.Width=Img_Reduce_Size
精品推荐