结合FSO操作和Aspjpeg组件写的Class

《结合FSO操作写的一个Class》

尚在完善中,基本功能已具备.
也可作为初学者的教程

 程序代码
<%
‘***************************** CDS系统 FSO操作类 Beta1 *****************************
‘调用方法: Set Obj=New FSOControl
‘所有路径必须为绝对路径,请采用Server.MapPath方法转换路径后再定义变量
‘—— FileRun —————————————
‘
‘必选参数:
‘FilePath —— 处理文件路径
‘
‘可选参数:
‘FileAllowType —— 处理文件允许的类型,定义方法例: gif|jpg|png|txt
‘FileNewDir —— 文件处理后保存到的目录
‘FileNewName —— 新文件名前缀,请不要添加后缀, 例: sample.txt 则为 sample
‘CoverPr —— 是否覆盖已有的文件 0为否 1为是 默认为1
‘deletePr —— 是否删除原文件 0为否 1为是 默认为1
‘———————————————————

‘—— UpDir(path) 取path的父目录
‘path可为文件,也可为目录

‘—— GetPrefixName(path) 取文件名前缀
‘path必须为文件,可为完整路径,也可是单独文件名

‘—— GetFileName(path) 取文件名
‘path必须为文件,可为完整路径,也可是单独文件名

‘—— GetExtensionName(path) 取文件名后缀,不包含”.”
‘path必须为文件,可为完整路径,也可是单独文件名

‘—— FileIs(path) path是否为一文件
‘如为,返回 true 否则返回 false
‘—— FolderCreat(Path)
‘—— Folderdelete(Path,FileIF)
‘—— FileCopy(Path_From,Path_To,CoverIF)
‘—— FileMove(Path_From,Path_To,CoverIF)
‘—— Filedelete(Path)
‘—— Filerename(OldName,NewName,CoverIf)

Class FSOControl

Dim FSO
Private File_Path,File_AllowType,File_NewFolder_Path,File_NewName,File_CoverIf,File_deleteIf
Public Property Let FilePath(StrType)
File_Path=StrType
End Property
Public Property Let FileAllowType(StrType)
File_AllowType=StrType
End Property
Public Property Let FileNewDir(StrType)
File_NewFolder_Path=StrType
End Property
Public Property Let FileNewName(StrType)
File_NewName=StrType
End Property
Public Property Let CoverPr(LngSize)
If isNumeric(LngSize) then
File_CoverIf=Clng(LngSize)
End If
End Property
Public Property Let deletePr(LngSize)
If isNumeric(LngSize) then
File_deleteIf=Clng(LngSize)
End If
End Property

Private Sub Class_Initialize()
Set FSO=createObject(“Scripting.FileSystemObject”) 
File_Path=””
File_AllowType=”gif|jpg|png|txt”
File_NewFolder_Path=””
File_NewName=””
File_CoverIf=1
File_deleteIf=0
End Sub 
Private Sub Class_Terminate()
Err.Clear
Set FSO=Nothing
End Sub

Public Function UpDir(ByVal D)
If Len(D) = 0 then
UpDir=””
Else
UpDir=Left(D,InStrRev(D,”\”)-1)
End If
End Function
Public Function GetPrefixName(ByVal D)
If Len(D) = 0 then
GetPrefixName=””
Else
FileName=GetFileName(D)
GetPrefixName=Left(FileName,InStrRev(FileName,”.”)-1)
End If
End Function
Public Function GetFileName(name)
FileName=Split(name,”\”)
GetFileName=FileName(Ubound(FileName))
End Function
Public Function GetExtensionName(name)
FileName=Split(name,”.”)
GetExtensionName=FileName(Ubound(FileName))
End Function
Public Function FileIs(Path)
If fso.FileExists(Path) then
FileIs=true
Else
FileIs=false
End If
End Function

Public Function FileOpen(Path,NewFile,ReadAction,LineCount)
If FileIs(Path)=False then
If NewFile1 then
FileOpen=False
ElseIf FolderIs(UpDir(Path))=False then
FileOpen=False
Exit Function
Else
fso.OpenTextFile Path,1,True
FileOpen=””
End If
Exit Function
End If
Set FileOption=fso.GetFile(Path)
If FileOption.size=0 then
Set FileOption=Nothing
FileOpen=””
Exit Function
End If
Set FileOption=Nothing
Set FileText=fso.OpenTextFile(Path,1)
If IsNumeric(ReadAction) then
FileOpen=FileText.Read(ReadAction)
ElseIf Ucase(ReadAction)=”ALL” then
FileOpen=FileText.ReadAll()
ElseIf Ucase(ReadAction)=”LINE” then
If Not(IsNumeric(LineCount)) or LineCount=0 then
FileOpen=False
Set FileText=Nothing
Exit Function
Else
i=0
Do While Not FileText.AtEndOfStream
FileOpen=FileOpen&FileText.ReadLine
i=i+1
If i=LineCount then Exit Do
Loop
End If
End If
Set FileText=Nothing 
End Function

Public Function FileWrite(Path,WriteStr,NewFile)
If FolderIs(UpDir(Path))=False then
FileWrite=False
Exit Function
ElseIf FileIs(Path)=False and NewFile1 then
FileWrite=False
Exit Function
End If
Set FileText=fso.OpenTextFile(Path,2,True)
FileText.Write WriteStr
Set FileText=Nothing
FileWrite=True
End Function

Public Function FolderIs(Path)
If fso.FolderExists(Path) then
FolderIs=true
Else
FolderIs=false
End If
End Function
Public Function FolderCreat(Path)
If fso.FolderExists(Path) then
FolderCreat=”指定要创建目录已存在”
Exit Function
ElseIf Not(fso.FolderExists(UpDir(Path))) then
FolderCreat=”指定要创建的目录路径错误”
Exit Function
End If
fso.createFolder(Path)
FolderCreat=True
End Function
Public Function Folderdelete(Path,FileIF)
If Not(fso.FolderExists(Path)) then
Folderdelete=”指定要删除的目录不存在”
Exit Function
End If
If FileIF=1 then
Set FsoFile = Fso.GetFolder(Path)
If(FsoFile.SubFolders.count>0 or FsoFile.Files.count>0) then
Set FsoFile=Nothing
Folderdelete=”只要要删除的目录下含有文件或子目录,不允许删除”
Exit Function
End If
Set FsoFile=Nothing
End If
Fso.deleteFolder(Path)
Folderdelete=True
End Function
Public Function FileCopy(Path_From,Path_To,CoverIF)
If Not(fso.FileExists(Path_From)) then
FileCopy=”指定要复制的文件不存在”
Exit Function
ElseIf Not(fso.FolderExists(UpDir(Path_To))) then
FileCopy=”指定要复制到的目录不存在”
Exit Function
End If
If CoverIF=0 and fso.FileExists(Path_To) then
FileCopy=”指定要复制到的目录下已存在相同名称文件,不允许覆盖”
Exit Function
End If
fso.CopyFile Path_From,Path_To
FileCopy=True
End Function
Public Function FileMove(Path_From,Path_To,CoverIF)
If Not(fso.FileExists(Path_From)) then
FileMove=”指定要移动的文件不存在”
Exit Function
ElseIf Not(fso.FolderExists(UpDir(Path_To))) then
FileMove=”指定要移动到的目录不存在”
Exit Function
End If
If fso.FileExists(Path_To) then
If CoverIF=0 then
FileMove=”指定要移动到的目录下已存在相同名称文件,不允许覆盖”
Exit Function
Else
Call Filedelete(Path_To)
End If
End If
fso.MoveFile Path_From,Path_To
FileMove=True
End Function
Public Function Filedelete(Path)
If Not(fso.FileExists(Path)) then
Filedelete=”指定要删除的文件不存在”
Exit Function
End If
Fso.deleteFile Path
Filedelete=True
End Function
Public Function Filerename(OldName,NewName,CoverIf)
NewName=NewName&”.”&GetExtensionName(OldName)
If GetFileName(OldName)=NewName then
Filerename=”更改前的文件与更改后的文件名称相同”
Exit Function
ElseIf Not(fso.FileExists(OldName)) then
Filerename=”指定更改名称的文件不存在”
Exit Function
ElseIf fso.FileExists(UpDir(OldName)&”\”&NewName) then
If CoverIf=0 then
Filerename=”目录下已存在与更改后的文件名称相同的文件,不允许覆盖”
Exit Function
Else
Call Filedelete(UpDir(OldName)&”\”&NewName)
End If
End If
Set FsoFile=fso.GetFile(OldName)
FsoFile.Name=NewName
Set FsoFile=Nothing
Filerename=True
End Function

Public Function FileRun()
If File_NewFolder_Path=”” and File_NewName=”” then
FileRun=”此操作执行后并未对指定文件产生变动,系统自动中止”
Exit Function
ElseIf File_Path=”” or Not(fso.FileExists(File_Path)) then
FileRun=”要进行操作的文件不存在”
Exit Function
ElseIf Instr(File_AllowType,GetExtensionName(File_Path))=0 then
FileRun=”要进行操作的文件被系统拒绝,允许的格式为: “&Replace(File_AllowType,”|”,” “)
Exit Function
End If

If File_NewFolder_Path=”” then
File_NewFolder_Path=UpDir(File_Path)
ElseIf Not(fso.FolderExists(File_NewFolder_Path)) then
FileRun=”指定要移动到的目录不存在”
Exit Function
End If
If Right(File_NewFolder_Path,1)”\” then File_NewFolder_Path=File_NewFolder_Path&”\”
If File_NewName=”” then
File_NewPath=File_NewFolder_Path&GetFileName(File_Path)
Else
File_NewPath=File_NewFolder_Path&File_NewName&”.”&GetExtensionName(File_Path)
End If
If File_Path=File_NewPath then
FileRun=”此操作执行后并未对指定文件产生变动,系统自动中止”
Exit Function
ElseIf UpDir(File_Path)UpDir(File_NewPath) then
If File_deleteIf=1 then
Call FileMove(File_Path,File_NewPath,File_CoverIf)
Else
Call FileCopy(File_Path,File_NewPath,File_CoverIf)
End If
FileRun=True
Else
‘If File_deleteIf=1 then
Call Filerename(File_Path,GetPrefixName(File_NewPath),File_CoverIf)
‘Else
‘ Call FileCopy(File_Path,File_NewPath,File_CoverIf)
‘End If
FileRun=True
End If
End Function
End Class
%> 

《ASPJPEG综合操作CLASS》
>>>———我想分页！–这么长的文章，在这里来个分页多好啊！哈哈———-<<<
《ASPJPEG综合操作CLASS》
基本上能实现ASPJPEG的所有功能
代码有详细注释,还不懂的请提出

有建议及更多功能提议的请提出

谢谢

 程序代码
<%
‘ASPJPEG综合操作CLASS
‘Authour: tony 05/09/05
Class AspJpeg
Dim AspJpeg_Obj,obj
Private Img_MathPath_From,Img_MathPath_To,Img_Reduce_Size,CoverIf
Private Img_Frame_Size,Img_Frame_Color,Img_Frame_Solid,Img_Frame_Width,Img_Frame_Height
Private Img_Font_Content,Img_Font_Family,Img_Font_Color,Img_Font_Quality,Img_Font_Size,Img_Font_Bold,Img_Font_X,Img_Font_Y
Private Img_PicIn_Path,Img_PicIn_X,Img_PicIn_Y
‘————–取原文件路径
Public Property Let MathPathFrom(StrType)
Img_MathPath_From=StrType
End Property

‘————–取文件保存路径
Public Property Let MathPathTo(strType)
Img_MathPath_To=strType
End Property

‘————–保存文件时是否覆盖已有文件
Public Property Let CovePro(LngSize)
If LngSize=0 or LngSize=1 or LngSize=true or LngSize=false then
CoverIf=LngSize
End If
End Property

‘—————取缩略图/放大图 缩略值
Public Property Let ReduceSize(LngSize)
If isNumeric(LngSize) then
Img_Reduce_Size=LngSize
End If
End Property

‘—————取描边属性
‘边框粗细
Public Property Let FrameSize(LngSize)
If isNumeric(LngSize) then
Img_Frame_Size=Clng(LngSize)
End If
End Property
‘边框宽度
Public Property Let FrameWidth(LngSize)
If isNumeric(LngSize) then
Img_Frame_Width=Clng(LngSize)
End If
End Property
‘边框高度
Public Property Let FrameHeight(LngSize)
If isNumeric(LngSize) then
Img_Frame_Height=Clng(LngSize)
End If
End Property
‘边框颜色
Public Property Let FrameColor(strType)
If strType”” then
Img_Frame_Color=strType
End If
End Property
‘边框是否加粗
Public Property Let FrameSolid(LngSize)
If LngSize=1 or LngSize=0 or LngSize=true or LngSize=false then
Img_Frame_Solid=LngSize
End If
End Property

‘—————取插入文字属性
‘插入的文字
Public Property Let Content(strType)
If strType”” then
Img_Font_Content=strType
End If
End Property
‘文字字体
Public Property Let FontFamily(strType)
If strType”” then
Img_Font_Family=strType
End If
End Property
‘文字颜色
Public Property Let FontColor(strType)
If strType”” then
Img_Font_Color=strType
End If
End Property
‘文字品质
Public Property Let FontQuality(LngSize)
If isNumeric(LngSize) then
Img_Font_Quality=Clng(LngSize)
End If
End Property
‘文字大小
Public Property Let FontSize(LngSize)
If isNumeric(LngSize) then
Img_Font_Size=Clng(LngSize)
End If
End Property
‘文字是否加粗
Public Property Let FontBold(LngSize)
If LngSize=1 or LngSize=0 or LngSize=true or LngSize=false then
Img_Font_Bold=LngSize
End If
End Property
‘输入文字的X坐标
Public Property Let FontX(LngSize)
If isNumeric(LngSize) then
Img_Font_X=Clng(LngSize)
End If
End Property
‘输入文字的Y坐标
Public Property Let FontY(LngSize)
If isNumeric(LngSize) then
Img_Font_Y=Clng(LngSize)
End If
End Property

‘—————取插入图片属性
‘插入图片的路径
Public Property Let PicInPath(strType)
Img_PicIn_Path=strType
End Property
‘图片插入的X坐标
Public Property Let PicInX(LngSize)
If isNumeric(LngSize) then
Img_PicIn_X=Clng(LngSize)
End If
End Property
‘图片插入的Y坐标
Public Property Let PicInY(LngSize)
If isNumeric(LngSize) then
Img_PicIn_Y=Clng(LngSize)
End If
End Property

Private Sub Class_Initialize()
Set AspJpeg_Obj=createObject(“Persits.Jpeg”) 
Img_MathPath_From=””
Img_MathPath_To=””
Img_Reduce_Size=150
Img_Frame_Size=1
‘Img_Frame_Width=0
‘Img_Frame_Height=0
‘Img_Frame_Color=”&H000000″
‘Img_Frame_Bold=false
Img_Font_Content=”GoldenLeaf”
‘Img_Font_Family=”Arial”
‘Img_Font_Color=”&H000000″
Img_Font_Quality=3
Img_Font_Size=14
‘Img_Font_Bold=False
Img_Font_X=10
Img_Font_Y=5
‘Img_PicIn_X=0
‘Img_PicIn_Y=0
CoverIf=1

End Sub 
Private Sub Class_Terminate()
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
Else
AspJpeg_Obj.Height=Img_Reduce_Size
End If
If AspJpeg_Obj.OriginalWidth>Img_Reduce_Size or AspJpeg_Obj.OriginalHeight>Img_Reduce_Size Then
If AspJpeg_Obj.Width<Img_Reduce_Size or AspJpeg_Obj.Height<Img_Reduce_Size then
Set AspJpeg_Obj_New=createObject(“Persits.Jpeg”)
AspJpeg_Obj_New.new Img_Reduce_Size,Img_Reduce_Size,&HFFFFFF
AspJpeg_Obj_New.DrawImage (150-AspJpeg_Obj.width)/2,(150-AspJpeg_Obj.height)/2,AspJpeg_Obj
If Img_Frame_Size>0 then
Call Img_Pen(AspJpeg_Obj_New)
End If
If Img_Font_Content”” then
Img_Font_X=AspJpeg_Obj_New.Width/2
Img_Font_Y=AspJpeg_Obj_New.Height-15
Call Img_Font(AspJpeg_Obj_New)
End If
AspJpeg_Obj_New.Sharpen 1, 130
AspJpeg_Obj_New.Save Img_MathPath_To
Set AspJpeg_Obj_New=Nothing
Else
If Img_Frame_Size>0 then
Call Img_Pen(AspJpeg_Obj)
End If
If Img_Font_Content”” then
Img_Font_X=AspJpeg_Obj.Width/2
Img_Font_Y=AspJpeg_Obj.Height-15
Call Img_Font(AspJpeg_Obj)
End If
AspJpeg_Obj.Sharpen 1, 130
AspJpeg_Obj.Save Img_MathPath_To
End If
Else
If Img_Frame_Size>0 then
Call Img_Pen(AspJpeg_Obj)
End If
If Img_Font_Content”” then
Img_Font_X=AspJpeg_Obj.Width/2
Img_Font_Y=AspJpeg_Obj.Height-15
Call Img_Font(AspJpeg_Obj)
End If
AspJpeg_Obj.Sharpen 1, 130
AspJpeg_Obj.Save Img_MathPath_To
End If
End Function
‘生成水印
Public Function Img_WaterMark()
If Not(FileIs(Img_MathPath_From)) then
Img_WaterMark=Errors(0)
Exit Function
End If
If Img_MathPath_To=”” then
Img_MathPath_To=Img_MathPath_From
ElseIf Not(FolderIs(UpDir(Img_MathPath_To))) then
Img_WaterMark=Errors(1)
Exit Function
End If
If CoverIf=0 or CoverIf=false then
If Img_MathPath_ToImg_MathPath_From and FileIs(Img_MathPath_To) then
Img_WaterMark=Errors(2)
Exit Function
End If
End If
AspJpeg_Obj.Open Img_MathPath_From
If Img_PicIn_Path”” then
If Not(FileIs(Img_PicIn_Path)) then
Img_WaterMark=Errors(0)
Exit Function
End If
Set AspJpeg_Obj_New=createObject(“Persits.Jpeg”)
AspJpeg_Obj_New.Open Img_PicIn_Path
AspJpeg_Obj.PreserveAspectRatio = True
AspJpeg_Obj_New.PreserveAspectRatio = True
If AspJpeg_Obj.OriginalWidth<Img_Reduce_Size or AspJpeg_Obj.OriginalHeight<Img_Reduce_Size then
Img_WaterMark=Errors(3)
Exit Function
End If
If AspJpeg_Obj_New.OriginalWidth>AspJpeg_Obj_New.OriginalHeight Then
AspJpeg_Obj_New.Width=Img_Reduce_Size
Else
AspJpeg_Obj_New.Height=Img_Reduce_Size
End If
If Img_PicIn_X=”” then Img_PicIn_X=AspJpeg_Obj.Width-AspJpeg_Obj_New.Width
If Img_PicIn_Y=”” then Img_PicIn_Y=AspJpeg_Obj.Height-AspJpeg_Obj_New.Height
AspJpeg_Obj.DrawImage Img_PicIn_X,Img_PicIn_Y,AspJpeg_Obj_New
Set AspJpeg_Obj_New=Nothing
End If
If Img_Frame_Size>0 then
Call Img_Pen(AspJpeg_Obj)
End If
If Img_Font_Content”” then
Call Img_Font(AspJpeg_Obj)
End If
‘AspJpeg_Obj.Sharpen 1, 130
AspJpeg_Obj.Save Img_MathPath_To
End Function
‘生成框架
Private Function Img_Pen(Obj)
If Img_Frame_Width=0 then Img_Frame_Width=Obj.Width
If Img_Frame_Height=0 then Img_Frame_Height=Obj.Height
Obj.Canvas.Pen.Color = Img_Frame_Color
Obj.Canvas.Pen.Width = Img_Frame_Size
Obj.Canvas.Brush.Solid = Img_Frame_Solid
Obj.Canvas.Bar 1,1,Img_Frame_Width,Img_Frame_Height
End Function
‘生成水印字
Private Function Img_Font(Obj)
Obj.Canvas.Font.Color = Img_Font_Color 
Obj.Canvas.Font.Family = Img_Font_Family 
Obj.Canvas.Font.Quality=Img_Font_Quality
Obj.Canvas.Font.Size=Img_Font_Size
Obj.Canvas.Font.Bold = Img_Font_Bold 
Obj.Canvas.Print Img_Font_X,Img_Font_Y,Img_Font_Content
End Function
End Class

%>