手机
当前位置:查字典教程网 >编程开发 >ASP教程 >结合FSO操作和Aspjpeg组件写的Class
结合FSO操作和Aspjpeg组件写的Class
摘要:《结合FSO操作写的一个Class》尚在完善中,基本功能已具备.也可作为初学者的教程程序代码

《结合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】相关文章:

经验几则

FSO操作文件系统

FSO操作示例(给初学者)

对文件的操作--建立移动删除文件夹

用正则和xmlHttp实现的asp小偷程序

ASP操作Excel的方法

用XML+FSO+JS实现服务器端文件的

常见的ASP获取时间操作的代码

aspjpeg组件使用方法

ASP 环境下 VBS 事件应用 示例代码

精品推荐
分类导航