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