《结合FSO操作写的一个Class》
尚在完善中,基本功能已具备.
也可作为初学者的教程
程序代码
<%
'*****************************CDS系统FSO操作类Beta1*****************************
'调用方法:SetObj=NewFSOControl
'所有路径必须为绝对路径,请采用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)
ClassFSOControl
DimFSO
PrivateFile_Path,File_AllowType,File_NewFolder_Path,File_NewName,File_CoverIf,File_deleteIf
PublicPropertyLetFilePath(StrType)
File_Path=StrType
EndProperty
PublicPropertyLetFileAllowType(StrType)
File_AllowType=StrType
EndProperty
PublicPropertyLetFileNewDir(StrType)
File_NewFolder_Path=StrType
EndProperty
PublicPropertyLetFileNewName(StrType)
File_NewName=StrType
EndProperty
PublicPropertyLetCoverPr(LngSize)
IfisNumeric(LngSize)then
File_CoverIf=Clng(LngSize)
EndIf
EndProperty
PublicPropertyLetdeletePr(LngSize)
IfisNumeric(LngSize)then
File_deleteIf=Clng(LngSize)
EndIf
EndProperty
PrivateSubClass_Initialize()
SetFSO=createObject("Scripting.FileSystemObject")
File_Path=""
File_AllowType="gif|jpg|png|txt"
File_NewFolder_Path=""
File_NewName=""
File_CoverIf=1
File_deleteIf=0
EndSub
PrivateSubClass_Terminate()
Err.Clear
SetFSO=Nothing
EndSub
PublicFunctionUpDir(ByValD)
IfLen(D)=0then
UpDir=""
Else
UpDir=Left(D,InStrRev(D,"")-1)
EndIf
EndFunction
PublicFunctionGetPrefixName(ByValD)
IfLen(D)=0then
GetPrefixName=""
Else
FileName=GetFileName(D)
GetPrefixName=Left(FileName,InStrRev(FileName,".")-1)
EndIf
EndFunction
PublicFunctionGetFileName(name)
FileName=Split(name,"")
GetFileName=FileName(Ubound(FileName))
EndFunction
PublicFunctionGetExtensionName(name)
FileName=Split(name,".")
GetExtensionName=FileName(Ubound(FileName))
EndFunction
PublicFunctionFileIs(Path)
Iffso.FileExists(Path)then
FileIs=true
Else
FileIs=false
EndIf
EndFunction
PublicFunctionFileOpen(Path,NewFile,ReadAction,LineCount)
IfFileIs(Path)=Falsethen
IfNewFile<>1then
FileOpen=False
ElseIfFolderIs(UpDir(Path))=Falsethen
FileOpen=False
ExitFunction
Else
fso.OpenTextFilePath,1,True
FileOpen=""
EndIf
ExitFunction
EndIf
SetFileOption=fso.GetFile(Path)
IfFileOption.size=0then
SetFileOption=Nothing
FileOpen=""
ExitFunction
EndIf
SetFileOption=Nothing
SetFileText=fso.OpenTextFile(Path,1)
IfIsNumeric(ReadAction)then
FileOpen=FileText.Read(ReadAction)
ElseIfUcase(ReadAction)="ALL"then
FileOpen=FileText.ReadAll()
ElseIfUcase(ReadAction)="LINE"then
IfNot(IsNumeric(LineCount))orLineCount=0then
FileOpen=False
SetFileText=Nothing
ExitFunction
Else
i=0
DoWhileNotFileText.AtEndOfStream
FileOpen=FileOpen&FileText.ReadLine
i=i+1
Ifi=LineCountthenExitDo
Loop
EndIf
EndIf
SetFileText=Nothing
EndFunction
PublicFunctionFileWrite(Path,WriteStr,NewFile)
IfFolderIs(UpDir(Path))=Falsethen
FileWrite=False
ExitFunction
ElseIfFileIs(Path)=FalseandNewFile<>1then
FileWrite=False
ExitFunction
EndIf
SetFileText=fso.OpenTextFile(Path,2,True)
FileText.WriteWriteStr
SetFileText=Nothing
FileWrite=True
EndFunction
PublicFunctionFolderIs(Path)
Iffso.FolderExists(Path)then
FolderIs=true
Else
FolderIs=false
EndIf
EndFunction
PublicFunctionFolderCreat(Path)
Iffso.FolderExists(Path)then
FolderCreat="指定要创建目录已存在"
ExitFunction
ElseIfNot(fso.FolderExists(UpDir(Path)))then
FolderCreat="指定要创建的目录路径错误"
ExitFunction
EndIf
fso.createFolder(Path)
FolderCreat=True
EndFunction
PublicFunctionFolderdelete(Path,FileIF)
IfNot(fso.FolderExists(Path))then
Folderdelete="指定要删除的目录不存在"
ExitFunction
EndIf
IfFileIF=1then
SetFsoFile=Fso.GetFolder(Path)
If(FsoFile.SubFolders.count>0orFsoFile.Files.count>0)then
SetFsoFile=Nothing
Folderdelete="只要要删除的目录下含有文件或子目录,不允许删除"
ExitFunction
EndIf
SetFsoFile=Nothing
EndIf
Fso.deleteFolder(Path)
Folderdelete=True
EndFunction
PublicFunctionFileCopy(Path_From,Path_To,CoverIF)
IfNot(fso.FileExists(Path_From))then
FileCopy="指定要复制的文件不存在"
ExitFunction
ElseIfNot(fso.FolderExists(UpDir(Path_To)))then
FileCopy="指定要复制到的目录不存在"
ExitFunction
EndIf
IfCoverIF=0andfso.FileExists(Path_To)then
FileCopy="指定要复制到的目录下已存在相同名称文件,不允许覆盖"
ExitFunction
EndIf
fso.CopyFilePath_From,Path_To
FileCopy=True
EndFunction
PublicFunctionFileMove(Path_From,Path_To,CoverIF)
IfNot(fso.FileExists(Path_From))then
FileMove="指定要移动的文件不存在"
ExitFunction
ElseIfNot(fso.FolderExists(UpDir(Path_To)))then
FileMove="指定要移动到的目录不存在"
ExitFunction
EndIf
Iffso.FileExists(Path_To)then
IfCoverIF=0then
FileMove="指定要移动到的目录下已存在相同名称文件,不允许覆盖"
ExitFunction
Else
CallFiledelete(Path_To)
EndIf
EndIf
fso.MoveFilePath_From,Path_To
FileMove=True
EndFunction
PublicFunctionFiledelete(Path)
IfNot(fso.FileExists(Path))then
Filedelete="指定要删除的文件不存在"
ExitFunction
EndIf
Fso.deleteFilePath
Filedelete=True
EndFunction
PublicFunctionFilerename(OldName,NewName,CoverIf)
NewName=NewName&"."&GetExtensionName(OldName)
IfGetFileName(OldName)=NewNamethen
Filerename="更改前的文件与更改后的文件名称相同"
ExitFunction
ElseIfNot(fso.FileExists(OldName))then
Filerename="指定更改名称的文件不存在"
ExitFunction
ElseIffso.FileExists(UpDir(OldName)&""&NewName)then
IfCoverIf=0then
Filerename="目录下已存在与更改后的文件名称相同的文件,不允许覆盖"
ExitFunction
Else
CallFiledelete(UpDir(OldName)&""&NewName)
EndIf
EndIf
SetFsoFile=fso.GetFile(OldName)
FsoFile.Name=NewName
SetFsoFile=Nothing
Filerename=True
EndFunction
PublicFunctionFileRun()
IfFile_NewFolder_Path=""andFile_NewName=""then
FileRun="此操作执行后并未对指定文件产生变动,系统自动中止"
ExitFunction
ElseIfFile_Path=""orNot(fso.FileExists(File_Path))then
FileRun="要进行操作的文件不存在"
ExitFunction
ElseIfInstr(File_AllowType,GetExtensionName(File_Path))=0then
FileRun="要进行操作的文件被系统拒绝,允许的格式为:"&Replace(File_AllowType,"|","")
ExitFunction
EndIf
IfFile_NewFolder_Path=""then
File_NewFolder_Path=UpDir(File_Path)
ElseIfNot(fso.FolderExists(File_NewFolder_Path))then
FileRun="指定要移动到的目录不存在"
ExitFunction
EndIf
IfRight(File_NewFolder_Path,1)<>""thenFile_NewFolder_Path=File_NewFolder_Path&""
IfFile_NewName=""then
File_NewPath=File_NewFolder_Path&GetFileName(File_Path)
Else
File_NewPath=File_NewFolder_Path&File_NewName&"."&GetExtensionName(File_Path)
EndIf
IfFile_Path=File_NewPaththen
FileRun="此操作执行后并未对指定文件产生变动,系统自动中止"
ExitFunction
ElseIfUpDir(File_Path)<>UpDir(File_NewPath)then
IfFile_deleteIf=1then
CallFileMove(File_Path,File_NewPath,File_CoverIf)
Else
CallFileCopy(File_Path,File_NewPath,File_CoverIf)
EndIf
FileRun=True
Else
'IfFile_deleteIf=1then
CallFilerename(File_Path,GetPrefixName(File_NewPath),File_CoverIf)
'Else
'CallFileCopy(File_Path,File_NewPath,File_CoverIf)
'EndIf
FileRun=True
EndIf
EndFunction
EndClass
%>
《ASPJPEG综合操作CLASS》
>>>---------我想分页!--这么长的文章,在这里来个分页多好啊!哈哈----------<<<
《ASPJPEG综合操作CLASS》
基本上能实现ASPJPEG的所有功能
代码有详细注释,还不懂的请提出
有建议及更多功能提议的请提出
谢谢
程序代码
<%
'ASPJPEG综合操作CLASS
'Authour:tony05/09/05
ClassAspJpeg
DimAspJpeg_Obj,obj
PrivateImg_MathPath_From,Img_MathPath_To,Img_Reduce_Size,CoverIf
PrivateImg_Frame_Size,Img_Frame_Color,Img_Frame_Solid,Img_Frame_Width,Img_Frame_Height
PrivateImg_Font_Content,Img_Font_Family,Img_Font_Color,Img_Font_Quality,Img_Font_Size,Img_Font_Bold,Img_Font_X,Img_Font_Y
PrivateImg_PicIn_Path,Img_PicIn_X,Img_PicIn_Y
'--------------取原文件路径
PublicPropertyLetMathPathFrom(StrType)
Img_MathPath_From=StrType
EndProperty
'--------------取文件保存路径
PublicPropertyLetMathPathTo(strType)
Img_MathPath_To=strType
EndProperty
'--------------保存文件时是否覆盖已有文件
PublicPropertyLetCovePro(LngSize)
IfLngSize=0orLngSize=1orLngSize=trueorLngSize=falsethen
CoverIf=LngSize
EndIf
EndProperty
'---------------取缩略图/放大图缩略值
PublicPropertyLetReduceSize(LngSize)
IfisNumeric(LngSize)then
Img_Reduce_Size=LngSize
EndIf
EndProperty
'---------------取描边属性
'边框粗细
PublicPropertyLetFrameSize(LngSize)
IfisNumeric(LngSize)then
Img_Frame_Size=Clng(LngSize)
EndIf
EndProperty
'边框宽度
PublicPropertyLetFrameWidth(LngSize)
IfisNumeric(LngSize)then
Img_Frame_Width=Clng(LngSize)
EndIf
EndProperty
'边框高度
PublicPropertyLetFrameHeight(LngSize)
IfisNumeric(LngSize)then
Img_Frame_Height=Clng(LngSize)
EndIf
EndProperty
'边框颜色
PublicPropertyLetFrameColor(strType)
IfstrType<>""then
Img_Frame_Color=strType
EndIf
EndProperty
'边框是否加粗
PublicPropertyLetFrameSolid(LngSize)
IfLngSize=1orLngSize=0orLngSize=trueorLngSize=falsethen
Img_Frame_Solid=LngSize
EndIf
EndProperty
'---------------取插入文字属性
'插入的文字
PublicPropertyLetContent(strType)
IfstrType<>""then
Img_Font_Content=strType
EndIf
EndProperty
'文字字体
PublicPropertyLetFontFamily(strType)
IfstrType<>""then
Img_Font_Family=strType
EndIf
EndProperty
'文字颜色
PublicPropertyLetFontColor(strType)
IfstrType<>""then
Img_Font_Color=strType
EndIf
EndProperty
'文字品质
PublicPropertyLetFontQuality(LngSize)
IfisNumeric(LngSize)then
Img_Font_Quality=Clng(LngSize)
EndIf
EndProperty
'文字大小
PublicPropertyLetFontSize(LngSize)
IfisNumeric(LngSize)then
Img_Font_Size=Clng(LngSize)
EndIf
EndProperty
'文字是否加粗
PublicPropertyLetFontBold(LngSize)
IfLngSize=1orLngSize=0orLngSize=trueorLngSize=falsethen
Img_Font_Bold=LngSize
EndIf
EndProperty
'输入文字的X坐标
PublicPropertyLetFontX(LngSize)
IfisNumeric(LngSize)then
Img_Font_X=Clng(LngSize)
EndIf
EndProperty
'输入文字的Y坐标
PublicPropertyLetFontY(LngSize)
IfisNumeric(LngSize)then
Img_Font_Y=Clng(LngSize)
EndIf
EndProperty
'---------------取插入图片属性
'插入图片的路径
PublicPropertyLetPicInPath(strType)
Img_PicIn_Path=strType
EndProperty
'图片插入的X坐标
PublicPropertyLetPicInX(LngSize)
IfisNumeric(LngSize)then
Img_PicIn_X=Clng(LngSize)
EndIf
EndProperty
'图片插入的Y坐标
PublicPropertyLetPicInY(LngSize)
IfisNumeric(LngSize)then
Img_PicIn_Y=Clng(LngSize)
EndIf
EndProperty
PrivateSubClass_Initialize()
SetAspJpeg_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
EndSub
PrivateSubClass_Terminate()
Err.Clear
SetAspJpeg_Obj=Nothing
EndSub
'判断文件是否存在
PrivateFunctionFileIs(path)
Setfsos=Server.createObject("Scripting.FileSystemObject")
FileIs=fsos.FileExists(path)
Setfsos=Nothing
EndFunction
'判断目录是否存在
PrivateFunctionFolderIs(path)
Setfsos=Server.createObject("Scripting.FileSystemObject")
FolderIs=fsos.FolderExists(path)
Setfsos=Nothing
EndFunction
'*******************************************
'函数作用:取得当前文件的上一级路径
'*******************************************
PrivateFunctionUpDir(ByValD)
IfLen(D)=0then
UpDir=""
Else
UpDir=Left(D,InStrRev(D,"")-1)
EndIf
EndFunction
PrivateFunctionErrors(Errors_id)
selectCaseErrors_id
Case"0"
Errors="指定文件不存在"
Case1
Errors="指定目录不存在"
Case2
Errors="已存在相同名称文件"
Case3
Errors="参数溢出"
Endselect
EndFunction
'取图片宽度
PublicFunctionImgInfo_Width(Img_MathPath)
IfNot(FileIs(Img_MathPath))then
'ExitFunction
ImgInfo_Width=Errors(0)
Else
AspJpeg_Obj.OpenImg_MathPath
ImgInfo_Width=AspJpeg_Obj.width
EndIf
EndFunction
'取图片高度
PublicFunctionImgInfo_Height(Img_MathPath)
IfNot(FileIs(Img_MathPath))then
'ExitFunction
ImgInfo_Height=Errors(0)
Else
AspJpeg_Obj.OpenImg_MathPath
ImgInfo_Height=AspJpeg_Obj.height
EndIf
EndFunction
'生成缩略图/放大图
PublicFunctionImg_Reduce()
IfNot(FileIs(Img_MathPath_From))then
Img_Reduce=Errors(0)
ExitFunction
EndIf
IfNot(FolderIs(UpDir(Img_MathPath_To)))then
Img_Reduce=Errors(1)
ExitFunction
EndIf
IfCoverIf=0orCoverIf=Falsethen
IfFileIs(Img_MathPath_To)then
Img_Reduce=Errors(2)
ExitFunction
EndIf
EndIf
AspJpeg_Obj.OpenImg_MathPath_From
AspJpeg_Obj.PreserveAspectRatio=True
IfAspJpeg_Obj.OriginalWidth>AspJpeg_Obj.OriginalHeightThen
AspJpeg_Obj.Width=Img_Reduce_Size
Else
AspJpeg_Obj.Height=Img_Reduce_Size
EndIf
IfAspJpeg_Obj.OriginalWidth>Img_Reduce_SizeorAspJpeg_Obj.OriginalHeight>Img_Reduce_SizeThen
IfAspJpeg_Obj.Width<Img_Reduce_SizeorAspJpeg_Obj.Height<Img_Reduce_Sizethen
SetAspJpeg_Obj_New=createObject("Persits.Jpeg")
AspJpeg_Obj_New.newImg_Reduce_Size,Img_Reduce_Size,&HFFFFFF
AspJpeg_Obj_New.DrawImage(150-AspJpeg_Obj.width)/2,(150-AspJpeg_Obj.height)/2,AspJpeg_Obj
IfImg_Frame_Size>0then
CallImg_Pen(AspJpeg_Obj_New)
EndIf
IfImg_Font_Content<>""then
Img_Font_X=AspJpeg_Obj_New.Width/2
Img_Font_Y=AspJpeg_Obj_New.Height-15
CallImg_Font(AspJpeg_Obj_New)
EndIf
AspJpeg_Obj_New.Sharpen1,130
AspJpeg_Obj_New.SaveImg_MathPath_To
SetAspJpeg_Obj_New=Nothing
Else
IfImg_Frame_Size>0then
CallImg_Pen(AspJpeg_Obj)
EndIf
IfImg_Font_Content<>""then
Img_Font_X=AspJpeg_Obj.Width/2
Img_Font_Y=AspJpeg_Obj.Height-15
CallImg_Font(AspJpeg_Obj)
EndIf
AspJpeg_Obj.Sharpen1,130
AspJpeg_Obj.SaveImg_MathPath_To
EndIf
Else
IfImg_Frame_Size>0then
CallImg_Pen(AspJpeg_Obj)
EndIf
IfImg_Font_Content<>""then
Img_Font_X=AspJpeg_Obj.Width/2
Img_Font_Y=AspJpeg_Obj.Height-15
CallImg_Font(AspJpeg_Obj)
EndIf
AspJpeg_Obj.Sharpen1,130
AspJpeg_Obj.SaveImg_MathPath_To
EndIf
EndFunction
'生成水印
PublicFunctionImg_WaterMark()
IfNot(FileIs(Img_MathPath_From))then
Img_WaterMark=Errors(0)
ExitFunction
EndIf
IfImg_MathPath_To=""then
Img_MathPath_To=Img_MathPath_From
ElseIfNot(FolderIs(UpDir(Img_MathPath_To)))then
Img_WaterMark=Errors(1)
ExitFunction
EndIf
IfCoverIf=0orCoverIf=falsethen
IfImg_MathPath_To<>Img_MathPath_FromandFileIs(Img_MathPath_To)then
Img_WaterMark=Errors(2)
ExitFunction
EndIf
EndIf
AspJpeg_Obj.OpenImg_MathPath_From
IfImg_PicIn_Path<>""then
IfNot(FileIs(Img_PicIn_Path))then
Img_WaterMark=Errors(0)
ExitFunction
EndIf
SetAspJpeg_Obj_New=createObject("Persits.Jpeg")
AspJpeg_Obj_New.OpenImg_PicIn_Path
AspJpeg_Obj.PreserveAspectRatio=True
AspJpeg_Obj_New.PreserveAspectRatio=True
IfAspJpeg_Obj.OriginalWidth<Img_Reduce_SizeorAspJpeg_Obj.OriginalHeight<Img_Reduce_Sizethen
Img_WaterMark=Errors(3)
ExitFunction
EndIf
IfAspJpeg_Obj_New.OriginalWidth>AspJpeg_Obj_New.OriginalHeightThen
AspJpeg_Obj_New.Width=Img_Reduce_Size
Else
AspJpeg_Obj_New.Height=Img_Reduce_Size
EndIf
IfImg_PicIn_X=""thenImg_PicIn_X=AspJpeg_Obj.Width-AspJpeg_Obj_New.Width
IfImg_PicIn_Y=""thenImg_PicIn_Y=AspJpeg_Obj.Height-AspJpeg_Obj_New.Height
AspJpeg_Obj.DrawImageImg_PicIn_X,Img_PicIn_Y,AspJpeg_Obj_New
SetAspJpeg_Obj_New=Nothing
EndIf
IfImg_Frame_Size>0then
CallImg_Pen(AspJpeg_Obj)
EndIf
IfImg_Font_Content<>""then
CallImg_Font(AspJpeg_Obj)
EndIf
'AspJpeg_Obj.Sharpen1,130
AspJpeg_Obj.SaveImg_MathPath_To
EndFunction
'生成框架
PrivateFunctionImg_Pen(Obj)
IfImg_Frame_Width=0thenImg_Frame_Width=Obj.Width
IfImg_Frame_Height=0thenImg_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.Bar1,1,Img_Frame_Width,Img_Frame_Height
EndFunction
'生成水印字
PrivateFunctionImg_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.PrintImg_Font_X,Img_Font_Y,Img_Font_Content
EndFunction
EndClass
%>
【结合FSO操作和Aspjpeg组件写的Class】相关文章:
★ 经验几则