《结合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 NewFile<>1 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 NewFile<>1 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_To<>Img_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
- %>