我的缩略图函数

<%Option ExpliCit
Response.Buffer=True
%>
<!--#include file="FormatDateClass.asp" -->
<%
'//=========================生成缩略图类========================!//
'说明:
'类名:SlightlyClass
'/*---------------------------函数-------------------------------*/
'ISJpeg()
'作用:是否安装JPEG组件
'ISExpired()
'作用:判断JPEG组件是否过期
'CreateFolder()
'作用:创建保存图片目录
'FormatCurrentDate()
'作用:格式化当前时间
'FormatRealPath()
'格式化当前路径
'FormatContrary()
'反格式化当前路径
'PerformanceSub()
'作用:根据参数值决定调用的函数
'GetPostion()
'作用:计算相对图片的坐标
'AddTextMark()
'为图片添加文字水印
'/*-----------------------------属性---------------------------------*/
'FSO 创建FSO对象
'DictionaryObject 创建Dictionary对象
'SlightlyimgPath 操作图片的路径
'Watermark 是否启用水印缩略图
Class SlightlyClass
 Private FormatObject '格式化时间类
 Private FSO '创建FSO对象(私有)
 Private DictionaryObject '创建Dictionary(私有)
 Private SlightlyimgPath '要进行处理的图片路径(私有)
 Private Watermark '是否启用水印缩略图
 '//!=================构造函数==========================!//
 Private Sub Class_InitiaLize()
  Set FormatObject=New FormatDateClass '创建格式化时间类的对象
  Set FSO=Server.CreateObject("Scripting.FileSystemObject") '建立FSO对象
  Set DictionaryObject=Server.CreateObject("Scripting.Dictionary") '建立Dictionary对象
  Watermark=False '默认不启用水印缩略图
 End Sub
 '//!=================析构函数==========================!//
 Private Sub Class_Terminate()
  Set FormatObject=Nothing
  Set FSO=Nothing
  Set DictionaryObject=Nothing
  Set SlightlyClass=Nothing
 End Sub
 '//!=================Let属性============================!//
 '作用:获取原始图片路径
 Public Property Let Slightlyimg_Path(StrPath)
  SlightlyimgPath=StrPath
 End Property
 '作用:是否启用水印缩略图
 Public Property Let Water_mark(StrMark)
  If StrMark<>True And StrMark<>False Then
   Watermark=False
  Else
   Watermark=StrMark
  End If
 End Property
 '//!================Get属性==============================!//
 Public Property Get Slightlyimg_Path()
  Slightlyimg_Path=SlightlyimgPath
 End Property
 '//!=================成员函数===========================!//
 '函数名:ISJpeg
 '作用:是否支持JPEG组件
 '参数:无
 '返回值:True,False
 Private Function ISJpeg()
 On Error Resume Next
  Dim JPEG
  Set JPEG=Server.CreateObject("Persits.Jpeg")
  If Err=0 Then
   ISJpeg=True
  Else
   ISJpeg=False
  End If
 Set JPEG=Nothing
 If Err.Number<>0 Then
  Err.Clear
  Response.Write("程序在执行中遇到异常.运行将终止")
  Response.End()
 End If
 End Function
 '函数名:ISExpired
 '作用:判断JPEG组件是否过期
 '返回值:True,False
 '参数:无
 Public Function  ISExpired()
 On Error Resume Next
  Dim JPEG
  If ISJpeg=False Then
   Response.write("没有安装JPEG组件")
   Response.End()
  Else
   Set JPEG=Server.CreateObject("Persits.Jpeg")
  End If
  If JPEG.Expires>Now Then
   ISExpired=False
  Else
   ISExpired=True
  End If
 If Err.Number<>0 Then
  Err.Clear
  Response.Write("程序中执行中遇到异常.运行将终止")
  Response.End()
 End If
 Set JPEG=Nothing
 End Function
 '函数名:CreateFolder 可无限级进行创建(参考汉诺塔问题求解(C语言))
 '作用:根据指定目录生成新的目录名
 '参数:Str
 '说明:此函数调用格式化时间类FormatDateClass进行指定目录的创建
 '用法:如CreateFolder("/Test/") 在结尾须填上/做为结束标志,否则目录不与创建
 Public Function CreateFolder(Str)
 On Error Resume Next
 Dim FolderName,TempPoint,TempPath
 Dim FilePath,AimPath
  TempPath=""
  If ISObject(FSO)=False Then
   Set FSO=Server.CreateObject("Scripting.FileSystemObject")
   On Error Goto 0
  End If
  Do While(Len(Str)>0)
   TempPoint=InStr(Str,"/")
   If TempPoint<=0 Then Exit Do
    FolderName=Left(Str,TempPoint-1)
    TempPath=TempPath&"/"&FolderName
    Str=Right(Str,Len(Str)-TempPoint)
    If(Not FSO.FolderExists(Server.MapPath(Str)&FilePath&TempPath)) Then
     FSO.CreateFolder(Server.MapPath(Str)&FilePath&TempPath)
    End If
  Loop
  Set FSO=Nothing
  FilePath=FilePath&AimPath
 End Function
 '函数名:FormatCurrentDate
 '参数:Strvalue
 '作用:格式化当前时间
 '返回值:被格式化的当前时间
 Private Function FormatCurrentDate(Strvalue)
 On Error Resume Next '启用错误处理
 Dim FormatDate,ReturnDate
 If ISDate(Strvalue)=False Or ISnull(Strvalue)=False And ISDate(Strvalue)=False Then
  Strvalue=Now()
 End If
  FormatDate=Strvalue
  ReturnDate=Replace(FormatDate," ","")
  ReturnDate=Replace(ReturnDate,"-","")
  ReturnDate=Replace(ReturnDate,":","")
  ReturnDate=Replace(ReturnDate,"PM","")
  ReturnDate=Replace(ReturnDate,"AM","")
  ReturnDate=Replace(ReturnDate,"上午","")
  ReturnDate=Replace(ReturnDate,"下午","")
  FormatCurrentDate=ReturnDate
 On Error Goto 0 '如果遇到错误则跳过
 End Function
 '函数名:FormatRealPath
 '参数:StrPath
 '作用:格式化路径
 Private Function FormatRealPath(StrPath)
 On Error Resume Next
 If StrPath="" Or ISNull(StrPath)=True Then
  FormatRealPath=""
  Exit Function
 End If
 StrPath=Replace(StrPath,"/","/")
 StrPath=Replace(StrPath,"//","/")
 If(Mid(StrPath,1,1))="/" Then
  StrPath=Mid(StrPath,2)
 End If
 If(Mid(StrPath,Len(StrPath)))="/" Then
  StrPath=Mid(StrPath,1,Len(StrPath)-1)
 End If
 FormatRealPath=StrPath
 On Error Goto 0
 End Function
 '函数名:FormatContrary
 '参数:StrPath
 '作用:反格式化路径
 Private Function FormatContrary(StrPath)
 On Error Resume Next
 If StrPath="" Or ISNull(StrPath)=True Then
  FormatContrary=""
  Exit Function
 End If
 StrPath=Replace(StrPath,"/","/")
 StrPath=Replace(StrPath,"//","/")
 If(Mid(StrPath,1,1))="/" Then
  StrPath=Mid(StrPath,2)
 End If
 If(Mid(StrPath,Len(StrPath)))="/" Then
  StrPath=Mid(StrPath,1,Len(StrPath)-1)
 End If
 FormatContrary=StrPath
 On Error Goto 0
 End Function
 '函数名:GetPostion
 '作用: 计算水印相对图片的坐标
 '参数:
 '/*
  'MarkPosition:坐标类型
  'X,Y坐标值
  'ImageWidth 由JPEG组件获得图片的宽度
  'ImageHeigth 由JPEG组件获得图片的高度
  'MarkWidth 原始图片的宽度
  'MarkHeight 原始图片的高度
 '*/
 Private Function GetPostion(MarkPosition,X,Y,ImageWidth,ImageHeight,MarkWidth,MarkHeight)
 On Error Resume Next
  Select Case Cint(MarkPosition)
   Case 1
    X = 1
    Y = 1
   Case 2
    X = 1
    Y = Int(ImageHeight - MarkHeight - 1)
   Case 3
    X = Int((ImageWidth - MarkWidth)/2)
    Y = Int((ImageHeight - MarkHeight)/2)
   Case 4
    X = Int(ImageWidth - MarkWidth - 1)
    Y = 1
   Case 5
    X = Int(ImageWidth - MarkWidth - 1)
    Y = Int(ImageHeight - MarkHeight - 1)
   Case 6
    X=Int(ImageWidth-MarkWidth-25)
    Y=Int(ImageHeight-MarkHeight-10)
  End Select
 On Error Goto 0      
 End Function
 '函数名:ReplaceFolder
 '作用:创建文件夹过滤函数
 '参数:StrChar
 '返回值:ReplaceFolder
 Private Function ReplaceFolder(StrChar)
 On Error Resume Next
 Dim Returnvalue
  If StrChar="" Then
   Returnvalue=""
  End If
  Returnvalue=Replace(StrChar,"?","")
  Returnvalue=Replace(Returnvalue,"*","")
  Returnvalue=Replace(Returnvalue,">","")
  Returnvalue=Replace(Returnvalue,">","")
  Returnvalue=Replace(Returnvalue,":","")
  Returnvalue=Replace(Returnvalue,"|","")
  ReplaceFolder=Returnvalue
 On Error Goto 0
 End Function
 '函数名:AddTextMark
 '参数说明:
 '/*
  'FilePath=要添加水印图片的路径
  'FontColor=字体颜色
  'FontName=字体
  'FontBond=字体浓度
  'FontSize=字体大小
  'Savetype 保存类型 True 内部自动创建文件夹进行保存 False 外部路径保存
  'ExteriorPath '指定外部路径
 '*/
 '作用:为图片添加文字水印
 Public Function AddTextMark(FontColor,FontName,FondBond,FontSize,Content,MarkPosition,Savetype,ExteriorPath)
 On Error Resume Next
 Dim JPEG,AddContent,TextContent,SavePath,FilePath,Path
 Dim FSO,X,Y
 '/*-------------------验证JPEG组件是否过期----------------------*/
 If ISExpired=True Then
  Response.write("JPEG组件已经过期,请选择其他组件")
  Response.End()
 End If
 FilePath=Server.MapPath(SlightlyimgPath)
 '/*-----------------判断图片是否存在---------------------------*/ 
 If ISObject(FSO)=False Then
  Set FSO=Server.CreateObject("Scripting.FileSystemObject")
 End If
 If FSO.FileExists(FilePath)=False Then
  Response.Write("要进行操作的图片不存在")
  Response.End()
 End If
 '/*-----------------验证文件后缀是否为可添加水印的格式-----------*/
 If InStr(FilePath,".")>=0 Then
  Path=Trim(Mid(FilePath,InStrRev(FilePath,".")+1))
 End If
 If Path<>"jpg" And Path<>"jpeg" And Path<>"gif" And Path<>"bmp" And Path<>"png" Then  
  Exit Function
 End If
 '/*-----------------Bool类型(浓度)--------------------------------*/
 If FondBond="1" Then
  FondBond=True
 Else
  FondBond=False
 End If
 '/*----------------设置字体大小(并进行转换)-----------------------*/
 FontSize=Trim(FontSize)
 If ISnumeric(FontSize)=True Then
  FontSize=Cint(FontSize)
 Else
  FontSize=10
 End If
 '/*---------------要添加水印的内容-------------------------------*/
 AddContent=Trim(Content)
 If AddContent="" Or ISnull(AddContent)=True Then
  Exit Function
 End If
 '/*---------------创建JPEG对象----------------------------------*/
 Set JPEG=Server.CreateObject("Persits.Jpeg")
  JPEG.Open FilePath
  JPEG.Canvas.Font.Color=FontColor
  JPEG.Canvas.Font.Family=FontName
  JPEG.Canvas.Font.Bold=FondBond
  JPEG.Canvas.Font.Size=FontSize
 '/*-------------计算字体宽度|字体大小-----------------------*/
 '说明:如果图片宽度小于字体宽度或图片高度小于字体高度则退出函数
  TextContent=JPEG.Canvas.GetTextExtent(AddContent) '计算GB2312后编码所占的位置
  If JPEG.OriginalWidth<TextContent Or JPEG.OriginalHeight<FontSize Then
   Exit Function
  End If
  '/*--------------将实际路径转化为物理路径-------------------*/
  '说明:Savetype=True 则自动创建文件夹保存
  '续:Savetype=False 指定外部路径进行保存
  If Savetype<>True And Savetype<>False Then Savetype=True
   If ISObject(FormatObject)=False Then
    Set FormatObject=New FormatDateClass
    If Err.Number<>0 Then
     Err.Clear
     Response.Write("对象创建失败,请检查包含文件夹的路径是否正确")
     Response.End()
    End If
   End If
  If Savetype=True Then
   '调用ReplaceFolder函数过滤创建文件夹不被允许的字符
   '调用CreateFolder函数自动创建文件夹保存路径
   CreateFolder("/"&ReplaceFolder(FormatObject.FormatDateFunction(2)))
   SavePath=ReplaceFolder(FormatObject.FormatDateFunction(2))
    If Right(SavePath,1)<>"/" Then
     SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
    End If
  Else
   If ExteriorPath="" Or ISnull(ExteriorPath)=True Then
    Response.write("请指定外部保存路径")
    Response.End()
   End If
   If FSO.FolderExists(Server.MapPath(ExteriorPath))=False Then
    Response.Write("<Script>if(confirm('指定的保存路径<<"&ExteriorPath&">>不存在,要创建吗?'));else history.back();</Script>")
   '调用ReplaceFolder函数过滤创建文件夹不被允许的字符
   '调用CreateFolder函数创建文件夹保存路径
    CreateFolder("/"&ReplaceFolder(ExteriorPath))
    SavePath=ReplaceFolder(ExteriorPath)
    If Right(SavePath,1)<>"/" Then
     SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
    End If
   Else
    SavePath=ExteriorPath
    If Right(SavePath,1)<>"/" Then
     SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
    End If
   End If  
  End If
  '/*----------------调用GetPostion函数计算相对坐标-----------*/
  Call GetPostion(Cint(MarkPosition),X,Y,JPEG.OriginalWidth,JPEG.OriginalHeight,TextContent,FontSize)
  Jpeg.Canvas.Print X,Y,AddContent
  '/*--------------保存图片到指定路径-------------------------*/
  JPEG.Save Server.MapPath(SavePath)
  On Error Goto 0
  AddTextMark=SavePath
  Set FSO=Nothing
  Set JPEG=Nothing
 End Function
 '函数名:AddPicMark
 '作用:为图片添加图片水印
 '参数:MarkWidth 水印图片宽度 MarkPic 水印图片路径 MarkTranspColor
 '续:MarkHeight 水印图片高度  MarkOpactity 水印图片透明度 MarkPosition 水印相对图片坐标
 '续:Savetype 保存类型 True 内部自动创建文件夹进行保存 False 外部路径保存
 '续:ExteriorPath '指定外部路径
 Public Function AddPicMark(MarkWidth,MarkHeight,MarkPic,MarkOpacity,MarkTranspColor,MarkPosition,Savetype,ExteriorPath)
 On Error Resume Next
 Dim JPEG,PicJPEG,FilePath,Path,SavePath,FSO
 Dim X,Y
 '/*----------------创建JPEG组件对象---------------------*/
 Set JPEG=Server.CreateObject("Persits.Jpeg")
 Set PicJPEG=Server.CreateObject("Persits.Jpeg")
 '/*---------------验证JPEG组件是否过期------------------*/
 If ISExpired=True Then
  Response.write("JPEG组件已经过期,请选择其他组件")
  Response.End()
 End If
 '/*----------------获得图片路径-------------------------*/
 FilePath=Server.MapPath(SlightlyimgPath)
 If FilePath="" Or ISNull(FilePath)=True Then
  Exit Function
 End If
 '/*-------------验证图片宽度---------------------------*/
 If MarkWidth="" Or ISnull(MarkWidth)=True Then
  MarkWidth=0 '如果为空则默认值为0
 Else
  MarkWidth=MarkWidth
 End If
 '/*----------------验证图片高度-------------------------*/
 If MarkHeight="" Or ISnull(MarkHeight)=True Then
  MarkHeight=0 '如果为空则默认为0
 Else
  MarkHeight=MarkHeight
 End If
 If IsNull(MarkOpacity) Or MarkOpacity = "" Then
  MarkOpacity = 1
 Else
  MarkOpacity = Csng(MarkOpacity)
 End if
 '/*----------------验证图片是否为空----------------------*/
 If MarkPic="" Or ISnull(MarkPic)=True Then
  Exit Function
 End If
 '/*-----------------创建FSO对象--------------------------*/
 If ISObject(FSO)=False Then
  Set FSO=Server.CreateObject("Scripting.FileSystemObject")
  On Error Goto 0
 End If
 If FSO.FileExists(FilePath)=False Then
  Response.write("找到相关路径,请确认路径")
  Response.End()
 End If
 If FSO.FileExists(Server.MapPath(MarkPic))=False Then
  Response.Write("找不到水印原始图片的路径")
  Response.End()
 End If
 '/*-----------------验证文件后缀是否为缩略的格式-----------*/
 If InStr(FilePath,".")>=0 Then
  Path=Trim(Mid(FilePath,InStrRev(FilePath,".")+1))
 End If
 If Path<>"jpg" And Path<>"jpeg" And Path<>"gif" And Path<>"bmp" And Path<>"png" Then  
  Exit Function
 End If
 JPEG.Open FilePath
 '/*--如果水印图片宽度和高度大于原始图片的宽度和高度则退出---*/
 If JPEG.OriginalWidth<MarkWidth Or JPEG.OriginalHeight<MarkHeight Then
  Exit Function
 End If
 PicJPEG.Open Trim(Server.MapPath(MarkPic))
 '/*------------调用GetPostion计算坐标-------------------------*/
 JPEG.Canvas.Brush.Solid = True
 Call GetPostion(Cint(MarkPosition),X,Y,JPEG.OriginalWidth,JPEG.OriginalHeight,MarkWidth,MarkHeight)
 If MarkTranspColor <> "" Then
  JPEG.DrawImage X,Y,PicJPEG,MarkOpacity,MarkTranspColor
 Else
  JPEG.DrawImage X,Y,PicJPEG,MarkOpacity
 End if
 '/*--------------将实际路径转化为物理路径-------------------*/
 '说明:Savetype=True 则自动创建文件夹保存
 '续:Savetype=False 指定外部路径进行保存
 If Savetype<>True And Savetype<>False Then Savetype=True
  If ISObject(FormatObject)=False Then
   Set FormatObject=New FormatDateClass
   If Err.Number<>0 Then
    Err.Clear
    Response.Write("对象创建失败,请检查包含文件夹的路径是否正确")
    Response.End()
   End If
  End If
  If Savetype=True Then
  '调用ReplaceFolder函数过滤创建文件夹不被允许的字符
  '调用CreateFolder函数自动创建文件夹保存路径
  CreateFolder("/"&ReplaceFolder(FormatObject.FormatDateFunction(2)))
  SavePath=ReplaceFolder(FormatObject.FormatDateFunction(2))
   If Right(SavePath,1)<>"/" Then
    SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
   End If
  Else   
   If ExteriorPath="" Or ISnull(ExteriorPath)=True Then
    Response.write("请指定外部保存路径")
    Response.End()
   End If
   '如果指定为外部路径保存.则检查外部路径是否存在
   If FSO.FolderExists(Server.MapPath(ExteriorPath))=False Then
    Response.Write("<Script>if(confirm('指定的保存路径<<"&ExteriorPath&">>不存在,要创建吗?'));else history.back();</Script>")
   '调用ReplaceFolder函数过滤创建文件夹不被允许的字符
   '调用CreateFolder函数创建文件夹保存路径
    CreateFolder("/"&ReplaceFolder(ExteriorPath))
    SavePath=ReplaceFolder(ExteriorPath)
    If Right(SavePath,1)<>"/" Then
     SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
    End If
   Else
    SavePath=ExteriorPath
    If Right(SavePath,1)<>"/" Then
     SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
    End If
   End If  
 End If
 JPEG.Save Server.MapPath(SavePath)
 AddPicMark=SavePath
 Set FSO=Nothing
 Set JPEG=Nothing
 Set PicJPEG=Nothing
 End Function
 '函数名:Slightly
 '作用:生成缩略图
 '参数:Width,Height,Rate
 'Rate说明:1为按指定的宽度和高度进行缩放
 '2为按指定的百分比进行缩放
 '3为按指定的倍数进行缩放
 'Watermark 缩略图是否生成水印 True=生成 False=不生成
 'WatermarkType 生成水印类型 1=文字水印 2=图片水印
 'Savetype(缩略图不包括水印) 保存类型 True 内部自动创建文件夹进行保存 False 外部路径保存
 'ExteriorPath '指定外部保存路径
 Public Function Slightly(Width,Height,Rate,Savetype,ExteriorPath,WatermarkType)
 On Error Resume Next
 Dim JPEG,FilePath,Path,SavePath,FSO
 '/*----------------创建JPEG组件对象---------------------*/
 Set JPEG=Server.CreateObject("Persits.Jpeg")
 '/*---------------验证JPEG组件是否过期------------------*/
 If ISExpired=True Then
  Response.write("JPEG组件已经过期,请选择其他组件")
  Response.End()
 End If
 '/*----------------获得图片路径-------------------------*/
 FilePath=Server.MapPath(SlightlyimgPath)
 If FilePath="" Or ISNull(FilePath)=True Then
  Exit Function
 End If
 '/*-----------------创建FSO对象--------------------------*/
 If ISObject(FSO)=False Then
  Set FSO=Server.CreateObject("Scripting.FileSystemObject")
  On Error Goto 0
 End If
 If FSO.FileExists(FilePath)=False Then
  Response.write("找到相关路径,请确认路径")
  Response.End()
 End If
 '/*-----------------验证文件后缀是否为缩略的格式-----------*/
 If InStr(FilePath,".")>=0 Then
  Path=Trim(Mid(FilePath,InStrRev(FilePath,".")+1))
 End If
 If Path<>"jpg" And Path<>"jpeg" And Path<>"gif" And Path<>"bmp" And Path<>"png" Then  
  Exit Function
 End If
 '/*---------------验证生成缩略图的宽度和高度---------------*/
 If Width="" Or ISNull(Width)=True Then
  Width=0 '如果未指定缩略的宽度则默认值为0
 End If
 If Height="" Or ISNull(Height)=True Then
  Height=0 '如果未指定缩略图的高度则默认值为0
 End If
 If Rate="" Or ISNull(Rate)=True Then
  Rate=0 '如果缩略图缩放比例未指定则将其指定为0
 End If
 '/*-----------------获得缩略图的宽度和高度(转换)-----------*/
 '说明:如果类型为指定宽度和高度或为成倍数进行缩放时则进行转换
 If Rate=0 Or Rate=2 Then
  Width=Cint(Width)
  Height=Cint(Height)
 End If
 Rate=CSng(Rate)
 JPEG.Open FilePath
 '/*------------------开始计算缩略图------------------------*/
 '/*按指定的宽度和高度进行缩放
 If Rate=0 And(Width<>0 Or Height<>0) Then
  If Width<JPEG.OriginalWidth And Height<JPEG.OriginalHeight Then
   If Width=0 And Height<>0 Then
    JPEG.Width=JPEG.OriginalWidth/JPEG.OriginalHeigth*Height
    JPEG.Height=Height
   ElseIf Width<>0 And Height=0 Then
    JPEG.Width =Width
    JPEG.Height=JPEG.OriginalHeight/JPEG.OriginalWidth*Width
   ElseIf Width<>0 And Height<>0 Then
    JPEG.Width=Width
    JPEG.Height=Height
   End If
  End If
  On Error Goto 0
 ElseIf Rate=1 Then
 '/*-----------------按百分比缩放-------------------------*/
  Jpeg.Width = Jpeg.OriginalWidth * width
  Jpeg.Height = Jpeg.OriginalHeight * height
  On Error Goto 0
 '/*-----------------按倍数缩放----------------------------*/
 ElseIf Rate=2 Then
  Jpeg.Width = Jpeg.OriginalWidth / width
  Jpeg.Height = Jpeg.OriginalHeight / height
  On Error Goto 0
 Else '如果缩放类型不为0或1或2则按倍数缩放
  Jpeg.Width = Jpeg.OriginalWidth * width
  Jpeg.Height = Jpeg.OriginalHeight * height
  On Error Goto 0
 End If 
 '/*--------------将实际路径转化为物理路径-------------------*/
 '说明:Savetype=True 则自动创建文件夹保存
 '续:Savetype=False 指定外部路径进行保存
 If Savetype<>True And Savetype<>False Then Savetype=True
  If ISObject(FormatObject)=False Then
   Set FormatObject=New FormatDateClass
   If Err.Number<>0 Then
    Err.Clear
    Response.Write("对象创建失败,请检查包含文件夹的路径是否正确")
    Response.End()
   End If
  End If
  If Savetype=True Then
  '调用ReplaceFolder函数过滤创建文件夹不被允许的字符
  '调用CreateFolder函数自动创建文件夹保存路径
  CreateFolder("/"&ReplaceFolder(FormatObject.FormatDateFunction(2)))
  SavePath=ReplaceFolder(FormatObject.FormatDateFunction(2))
   If Right(SavePath,1)<>"/" Then
    SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
   End If
  Else   
   If ExteriorPath="" Or ISnull(ExteriorPath)=True Then
    Response.write("请指定外部保存路径")
    Response.End()
   End If
   '如果指定为外部路径保存.则检查外部路径是否存在
   If FSO.FolderExists(Server.MapPath(ExteriorPath))=False Then
    Response.Write("<Script>if(confirm('指定的保存路径<<"&ExteriorPath&">>不存在,要创建吗?'));else history.back();</Script>")
   '调用ReplaceFolder函数过滤创建文件夹不被允许的字符
   '调用CreateFolder函数创建文件夹保存路径
    CreateFolder("/"&ReplaceFolder(ExteriorPath))
    SavePath=ReplaceFolder(ExteriorPath)
    If Right(SavePath,1)<>"/" Then
     SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
    End If
   Else
    SavePath=ExteriorPath
    If Right(SavePath,1)<>"/" Then
     SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
    End If
   End If  
 End If
 '/*--------------保存图片缩略图到指定路径-------------------------*/
  JPEG.Save Server.MapPath(SavePath)
 '/*----------------是否生成水印-----------------------------*/
 If Watermark<>True And Watermark<>False Then Watermark=False
 If Watermark=True Then '如果为True则生成水印
  If WatermarkType<>1 And WatermarkType<>2 Then WatermarkType=1
   '/*--------声明生成带水印缩略图的变量--------*/
  Dim SlighltyPath,Font_Color,Font_Name,Fond_Bond,Wate_rmark
  Dim Font_Size,Add_Content,Mark_Position,Save_Type
  Select Case WatermarkType
   Case 1 '1:生成文字水印缩略图
   '/*注:此函数调用复杂(参考C语言的函数)
   '传入7个变量其中变量SlighltyPath做为二次参数传入
   '此参数通过父函数Slightly获得要添加文字水印的路径
   '在实例化缩略图类并调用Slightly函数将返回一个缩略图的路径
   '如果生成带水印的缩略图则必须保证此路径的存在
    Call TextMark(SlighltyPath,Font_Color,Font_Name,Fond_Bond,Font_Size,Add_Content,Mark_Position,Save_Type)
   Case 2 '2:生成图片水印缩略图   
    'Call TextMark(SavePath,&hFFFFFF,"宋体","1","14","中国","3")
  End Select
 End If
 '/*-------------------返回图片缩略图路径----------------------------*/
 Slightly=SavePath
 Set JPEG=Nothing
 Set FSO=Nothing
 End Function
 '函数名:TextMark
 '作用:生成带文字水印缩略图
 '参数:
 '/*--------------------------------------------------
 'Watermark 是否启用水印缩略图 Slighlty_Path 要处理图片路径 FontColor 字体颜色 FontName 字体类型
 'FontSize 字体大小 AddContent 要水印的内容 MarkPosition 相对坐标 SaveType 保存类型 FontdBond 字体浓度
 'SaveType =True 在原路径保存将覆盖原缩略图 SaveType=False 在原路径保存且不覆盖原缩略图
 '------------------------------------------------------------------------------*/
 Public Function TextMark(Slighlty_Path,FontColor,FontName,FondBond,FontSize,AddContent,MarkPosition,SaveType)
 Dim SlighltyPath,FSO,AddTextJpeg,X,Y,TextContent
 Dim SavePath
 '/*--------------是否启用缩略图------------------*/
 If Watermark<>True And Watermark<>False Then Watermark=False
 If Watermark=False Then Exit Function
 SlighltyPath=Slighlty_Path
 '/*---------------验证获得图片路径---------------*/
 If SlighltyPath="" Or ISnull(SlighltyPath)=True Then
  Exit Function
 End If
 '/*-------------建立FSO对象----------------------*/
 If ISObject(FSO)=False Then
  Set FSO=Server.CreateObject("Scripting.FileSystemObject")
 End If
 If FSO.FileExists(Trim(Server.MapPath(SlighltyPath)))=False Then
  Response.Write("找不到要处理的图片.可能已被移走或删除")
  Response.End()
 End If
 Set AddTextJpeg=Server.CreateObject("Persits.Jpeg")
  AddTextJpeg.Open Trim(Server.MapPath(SlighltyPath))
  AddTextJpeg.Canvas.Font.Color=FontColor
  AddTextJpeg.Canvas.Font.Family=FontName
  AddTextJpeg.Canvas.Font.Bold=FondBond
  AddTextJpeg.Canvas.Font.Size=FontSize
 '/*-------------计算字体宽度|字体大小-----------------------*/
 '说明:如果图片宽度小于字体宽度或图片高度小于字体高度则退出函数
  TextContent=AddTextJpeg.Canvas.GetTextExtent(AddContent) '计算GB2312后编码所占的位置
  If AddTextJpeg.OriginalWidth<TextContent Then Exit Function
  'If AddTextJpeg.OriginalHeight<FontSize Then Exit Function
 '/*----------------调用GetPostion函数计算相对坐标-----------*/
  Call GetPostion(Cint(MarkPosition),X,Y,AddTextJpeg.OriginalWidth,AddTextJpeg.OriginalHeight,AddContent,FontSize)
  AddTextJpeg.Canvas.Print X,Y,AddContent
   '/*--------------------指定保存路径---------------------------*/
    If SaveType=True Then 'SaveType=True 在原路径保存覆盖原缩略图
  '调用ReplaceFolder函数过滤创建文件夹不被允许的字符
  '调用CreateFolder函数自动创建文件夹保存路径
  CreateFolder("/"&ReplaceFolder(FormatObject.FormatDateFunction(2)))
  SavePath=ReplaceFolder(FormatObject.FormatDateFunction(2))
   If Right(SavePath,1)<>"/" Then
    SavePath=SavePath&"/"&FormatCurrentDate(Now())&".jpg"
   End If
   Else 'SaveType=False 在原路径保存且不覆盖原缩略图  
  CreateFolder("/"&ReplaceFolder(FormatObject.FormatDateFunction(2)))
  SavePath=ReplaceFolder(FormatObject.FormatDateFunction(2))
  If Right(SavePath,1)<>"/" Then
   SavePath=SavePath&"/"&Rnd*FormatCurrentDate(Now())&".jpg"
  End If
   End If
 '/*-----------------保存图片且返回路径---------------------*/
  AddTextJpeg.Save Server.MapPath(SavePath)
  TextMark=SavePath
 '/*----------------关闭对象-------------------------------*/
  Set FSO=Nothing
  Set AddTextJpeg=Nothing
 End Function
End Class
Dim China,Returnvalue,Returnvalue2
Set China=New SlightlyClass
China.Slightlyimg_Path="images/225226.jpg"
China.Water_mark=True '启用水印缩略图
'Returnvalue=China.AddTextMark(&hFFFFFF,"宋体","1","14","中华人民共和国","3",True,"中国")
'Response.write Returnvalue
'Returnvalue=China.Slightly("2","2",2,True,"dddd",1)
'Returnvalue2=China.TextMark(Returnvalue,&hFFFFFF,"宋体","1","14","中国","6",True)
'Response.write Returnvalue&"<br>"
'Response.write Returnvalue2
'Call AddPicMark(MarkWidth,MarkHeight,MarkPic,MarkOpacity,MarkTranspColor,MarkPosition)
'Returnvalue=China.AddPicMark(248,120,"images/200653171331.jpg","0.2",&hFFFFFF,"5",False,"Administrator")
'Response.write Returnvalue
%>