结合FSO操作和Aspjpeg组件写的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                
相关文章