结合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 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

%>