网站地图
【www.gdgbn.com--组件控件开发】
说明：空间必须支持：aspjpeg组件。。现在的空间基本都支持.
index.asp文件
配置如下
<script language="网页特效">
function getwindow(url,width,height) {
//根据屏幕居中
window.open(url,"","width="+width+",height="+height+",top="+(screen.height-height)/2+",left="+(screen.width-width)/2);
//下面是根据页面居中
//window.open(url,"","width="+width+",height="+height+",top="+(document.body.offsetheight-height)/2+",left="+(document.body.offsetwidth-width)/2);
//window.open(url,"","width="+width+",height="+height+",top=250,left="+document.body.offsetwidth/3);
}
</script>
<%
action = trim(request("action"))
select case action
case "list"
call list()
case "saveconfig"
call saveconfig()
case else
call list()
end select
sub list()
%>
只做了简单操作,更改config.asp文件里面的参数
上传图片水印设置
水印组件
checked<%end if%>>
aspjpeg
水印类型
checked<%end if%>>
关闭水印功能
<%if isobjinstalled("persits.jpeg") then%>
checked<%end if%>>
文字水印
checked<%end if%>>
图片水印
<%else%>
注意：你还没有安装水印组件，无法启用水印功能。
<%end if%>
水印位置
checked<%end if%>>
左上
checked<%end if%>>
右上
checked<%end if%>>
左下
checked<%end if%>>
右下
checked<%end if%>>
居中
水印文字
字体
字号
px
颜色
#
水印图片
示例如下：
<%
end sub
%>
config.asp文件
<%
"----------------------------- 详细信息查看：index.asp
dim jpegtype,jpeglocation,jpegtxt,jpegsize,jpegfont,jpegcolor,jpegpic
"---------- 水印类型,0:关闭水印功能,1:文字水印,2:图片水印
jpegtype = 2
"---------- 水印位置,0:左上,1:右上,2:左下,3:右下,4:居中
jpeglocation = 2
"---------- 水印文字,随便输入
jpegtxt = "永恒浪子哥哥"
"---------- 水印文字,字号
jpegsize = 14
"---------- 水印文字,字体
jpegfont = "宋体"
"---------- 水印文字,颜色
jpegcolor = "ffffff"
"---------- 图片水印,图片
jpegpic = "logo.gif"
"==========================================
"函数名：isobjinstalled
"作 用：检查组件是否已经安装
"参 数：strclassstring ----组件名
"返回值：true ----已经安装
" false ----没有安装
"==========================================
function isobjinstalled(strclassstring)
on error resume next
isobjinstalled = false
err = 0
dim xtestobj
set xtestobj = server.createobject(strclassstring)
if 0 = err then isobjinstalled = true
set xtestobj = nothing
err = 0
end function
%>upload.asp文件
上传文件
<%
"=====================================================================
" 软件名称：永恒浪子旅游管理系统
" 当前版本：hulang content management system version 1.0
" 文件名称：upload.asp
" 更新日期：2010-08-09
" 开发作者：永恒浪子 email(邮箱)：hulangfy@163.com qq：383131380
" 官方网站：http://hi.baidu.com/hulangfy
"=====================================================================
" copyright 2010-2010 hulangfy@163.com - all rights reserved.
" hulangfy is a trademark of hulangfy@163.com
"=====================================================================
"------------------------------------------------------
dim formname,forminput,ouploadtype,oaction,ofileexe,oofilesize,ofilesize,ispics,picsp
"------------------------------------------------------
response.buffer = true
response.expiresabsolute = now()-1
response.expires = 0
response.cachecontrol = "no-cache"
response.charset = "gb2312"
"------------------------------------------------------
formname = trim(request("formname"))
forminput = trim(request("forminput"))
ouploadtype = trim(request("ouploadtype"))
"------------------------------------------------------
select case ouploadtype
"------------------------------------------- oaspjpeg
case "oaspjpeg"
ofileexe = "jpg|gif|swf|png"
sfilesize = 540
"-------------------------------------------
case else
ofileexe = "jpg|gif|swf|png"
sfilesize = 888
end select
ofilesize = 1024*sfilesize
"------------------------------------------------------
oaction = trim(request("oaction"))
select case oaction
case "uploadshow"
call uploadshow()
case "oupload"
call oupload()
case else
call uploadshow()
end select
"------------------------------------------------------
sub uploadshow()
%>
<%
end sub
"------------------------------------------------------
sub oupload()
dim upload,path,tempcls,fname,uploadfile
"===============================================================================
set upload = new anupload "创建类实例
upload.singlesize = ofilesize "设置单个文件最大上传限制,按字节计；默认为不限制
upload.maxsize = 1024*1024*1024 "设置最大上传限制,按字节计；默认为不限制
upload.exe = ofileexe "设置合法扩展名,以|分割,忽略大小写
upload.charset = "gb2312" "设置文本编码，默认为gb2312
upload.openprocesser = false "禁止进度条功能，如果启用，需配合客户端程序
upload.getdata() "获取并保存数据,必须调用本方法
"===============================================================================
if upload.errorid>0 then "判断错误号,如果myupload.err<=0表示正常
response.write upload.description "如果出现错误,获取错误描述
else
if upload.files(-1).count > 0 then "这里判断你是否选择了文件
ouploadtype = upload.forms("ouploadtype")
select case ouploadtype
case "oaspjpeg"
uploadfile = "uploadfile/images/"
case else
uploadfile = "uploadfile/others/"
end select
path = server.mappath(uploadfile) "文件保存路径
set tempcls = upload.files("myupload")
tempcls.savetofile path,0
fname = tempcls.filename
set tempcls = nothing
uploadfilename = uploadfile&fname
if isobjinstalled("persits.jpeg") then
s_uploadfilename = uploadfile&"s_"&fname
os_pic = startjpeg(uploadfilename,s_uploadfilename)
call s_uploadopener(formname,"s_"&forminput,os_pic)
call uploadopener(formname,forminput,uploadfilename,"上传成功!")
else
call uploadopener(formname,forminput,uploadfilename,"上传成功!")
end if
else
call goupload("您没有上传任何文件!")
end if
end if
set upload = nothing
end sub
"------------------------------------------------------
sub uploadopener(fname,finput,fvalue,outstr)
echo("<script language=""javascript"" type=""text/javascript"" charset=""gb2312"">")
echo("window.opener.document."&fname&"."&finput&".value=""&fvalue&"";")
echo("alert(""&outstr&"");")
echo("window.opener =null;")
echo("window.close();")
echo("</script>")
end sub
"------------------------------------------------------
sub s_uploadopener(fname,finput,fvalue)
echo("<script language=""javascript"" type=""text/javascript"" charset=""gb2312"">")
echo("window.opener.document."&fname&"."&finput&".value=""&fvalue&"";")
echo("</script>")
end sub
"------------------------------------------------------
sub goupload(outstr)
echo("<script language=""javascript"" type=""text/javascript"" charset=""gb2312"">")
echo("alert(""&outstr&"");")
echo("history.go(-1);")
echo("</script>")
end sub
"------------------------------------------------------
sub echo(str)
response.write(str) & vbcrlf
end sub
"------------------------------------------------------
function bytestostring(byval isize)
dim sret,kb,mb,s
kb = 1024 : mb = kb * kb
if not isnumeric(isize) then
bytestostring = "未知"
exit function
end if
if isize < kb then
sret = isize & " bytes"
else
s = isize / kb
if s < 10 then
sret = formatnumber(isize / kb, 2, -1) & " kb"
elseif s < 100 then
sret = formatnumber(isize / kb, 1, -1) & " kb"
elseif s < 1000 then
sret = formatnumber(isize / kb, 0, -1) & " kb"
elseif s < 10000 then
sret = formatnumber(isize / mb, 2, -1) & " mb"
elseif s < 100000 then
sret = formatnumber(isize / mb, 1, -1) & " mb"
elseif s < 1000000 then
sret = formatnumber(isize / mb, 0, -1) & " mb"
elseif s < 10000000 then
sret = formatnumber(isize / mb / kb, 2, -1) & " gb"
else
sret = formatnumber(isize / mb / kb, 1, -1) & " gb"
end if
end if
bytestostring = sret
end function
function isobjinstalled(strclassstring)
on error resume next
isobjinstalled = false
err = 0
dim xtestobj
set xtestobj = server.createobject(strclassstring)
if 0 = err then isobjinstalled = true
set xtestobj = nothing
err = 0
end function
function startjpeg(codepic,iscodepic)
"================aspjpeg 开始====================
if (codepic = "" or isnull(codepic)) then
exit function
end if
if jpegtype <> 0 then
set bg = server.createobject("persits.jpeg")
bg.open server.mappath(codepic)
bg_w = bg.width
bg_h = bg.height
if jpegtype = 1 then
bg.canvas.font.color = "&h" & jpegcolor
bg.canvas.font.shadowcolor = &hffffff
bg.canvas.font.family = jpegfont
bg.canvas.font.size = jpegsize
bg.canvas.font.bold = false
bg.canvas.font.quality = 3
select case jpeglocation
case 0
x = 20 : y = 20
case 1
x = bg_w - len(jpegtxt) * 20 : y = 20
case 2
x = 20 : y = bg_h - 20
case 3
x = bg_w - len(jpegtxt) * 20 : y = bg_h - 20*2
case 4
x = bg_w - len(jpegtxt) * 20 : y = bg_h - 20*2
end select
bg.canvas.printtext x, y, jpegtxt
end if
if jpegtype = 2 then
set logo = server.createobject("persits.jpeg")
logo.open server.mappath(jpegpic)
logo_w = logo.width
logo_h = logo.height
select case jpeglocation
case 0
x = 20 : y = 20
case 1
x = bg_w - logo_w - 20 : y = 20
case 2
x = 20 : y = logo_h - 20
case 3
x = bg_w - logo_w - 20 : y = bg_h - logo_h - 20
case 4
x = bg_w - logo_w : y = bg_h - logo_h - 20
end select
bg.drawimage x, y, logo, 0.8, &hffffff
set logo = nothing
end if
bg.quality = 85
bg.save server.mappath(iscodepic)
set bg = nothing
startjpeg = iscodepic
end if
"================aspjpeg 结束====================
end function
%>
upload_class.asp文件
<%
class anupload
private form, fils
private vcharset, vmaxsize, vsinglesize, verr, vversion, vtotalsize, vexe, pid, vop, verrexe,vboundary, vlosttime, vmode, vfilecount
"==============================
"设置和读取属性开始
"==============================
public property let mode(byval value)
vmode = value
end property
public property let maxsize(byval value)
vmaxsize = value
end property
public property let singlesize(byval value)
vsinglesize = value
end property
public property let exe(byval value)
vexe = lcase(value)
end property
public property let charset(byval value)
vcharset = value
end property
public property get errorid()
errorid = verr
end property
public property get filecount()
filecount = fils.count
end property
public property get description()
description = geterr(verr)
end property
public property get version()
version = vversion
end property
public property get totalsize()
totalsize = vtotalsize
end property
public property get processid()
processid = pid
end property
public property let openprocesser(byval value)
vop = value
end property
public property get losttime()
losttime = vlosttime
end property
"==============================
"设置和读取属性结束，初始化类
"==============================
private sub class_initialize()
set form = server.createobject("scripting.dictionary")
set fils = server.createobject("scripting.dictionary")
vversion = "艾恩asp无组件上传类优化版(v9.11.1)"
vmaxsize = -1
vsinglesize = -1
verr = -1
vexe = ""
vtotalsize = 0
vcharset = "gb2312"
vop=false
pid="anupload"
setapp "",0,0,""
vmode = 0
end sub
private sub class_terminate()
dim f
form.removeall()
for each f in fils
fils(f).value=empty
set fils(f) = nothing
next
fils.removeall()
set form = nothing
set fils = nothing
end sub
"==============================
"函数名:getdata
"作用:处理客户端提交来的所有数据
"==============================
public sub getdata()
dim time1
time1 = timer()
if vop then pid=request.querystring("processid")
dim value, str, bcrlf, fpos, ssplit, slen, istart,ef
dim totalbytes,tempdata,bytesread,chunkreadsize,partsize,datapart,formend, formhead, startpos, endpos, formname, filename, fileexe, valueend, newname,localname,type_1,contenttype
totalbytes = request.totalbytes
ef = false
if checkentrytype = false then ef = true : verr = 2
"下面3句注释掉了，因为在iis5.0中，如果上传大小大于限制大小的文件，会出错，一直没找到解决方法。如果是在iis5以上的版本使用，可以取消下面3句的注释
"if not ef then
"if vmaxsize > 0 and totalbytes > vmaxsize then ef = true : verr = 1
"end if
if ef then exit sub
if vmode = 0 then
vtotalsize = 0
dim streamt
set streamt = server.createobject("adodb.stream")
streamt.type = 1
streamt.mode = 3
streamt.open
bytesread = 0
chunkreadsize = 1024 * 16
do while bytesread < totalbytes
partsize = chunkreadsize
if partsize + bytesread > totalbytes then partsize = totalbytes - bytesread
datapart = request.binaryread(partsize)
streamt.write datapart
bytesread = bytesread + partsize
setapp "uploading",totalbytes,bytesread,""
loop
setapp "uploaded",totalbytes,bytesread,""
streamt.position = 0
tempdata = streamt.read
streamt.close()
set streamt = nothing
else
tempdata = request.binaryread(totalbytes)
end if
bcrlf = chrb(13) & chrb(10)
fpos = instrb(1, tempdata, bcrlf)
ssplit = midb(tempdata, 1, fpos - 1)
slen = lenb(ssplit)
istart = slen + 2
do while lenb(tempdata) > 2 + slen
formend = instrb(istart, tempdata, bcrlf & bcrlf)
formhead = midb(tempdata, istart, formend - istart)
str = bytes2str(formhead)
startpos = instr(str, "name=""") + 6
endpos = instr(startpos, str, """")
formname = lcase(mid(str, startpos, endpos - startpos))
valueend = instrb(formend + 3, tempdata, ssplit)
if instr(str, "filename=""") > 0 then
startpos = instr(str, "filename=""") + 10
endpos = instr(startpos, str, """")
type_1=instr(endpos,lcase(str),"content-type")
contenttype=trim(mid(str,type_1+13))
filename = mid(str, startpos, endpos - startpos)
if trim(filename) <> "" then
localname = filename
filename = replace(filename, "/", "")
filename = mid(filename, instrrev(filename, "") + 1)
filename = replace(filename,chr(0),"")
if instr(filename,".")>0 then
fileexe = split(filename, ".")(ubound(split(filename, ".")))
else
fileexe = ""
end if
if vexe <> "" then "判断扩展名
if checkexe(fileexe) = true then
verr = 3
verrexe = fileexe
tempdata = empty
exit sub
end if
end if
newname = getname()
newname = newname & "." & fileexe
vtotalsize = vtotalsize + valueend - formend - 6
if vsinglesize > 0 and (valueend - formend - 6) > vsinglesize then "判断上传单个文件大小
verr = 5
tempdata = empty
exit sub
end if
if vmaxsize > 0 and vtotalsize > vmaxsize then "判断上传数据总大小
verr = 1
tempdata = empty
exit sub
end if
if fils.exists(formname) then
verr = 4
tempdata = empty
exit sub
else
dim filecls:set filecls=getnewfileobj()
filecls.contenttype=contenttype
filecls.size = (valueend - formend - 5)
filecls.formname = formname
filecls.newname = newname
filecls.filename = filename
filecls.localname = filename
filecls.extend=split(newname,".")(ubound(split(newname,".")))
filecls.value =midb(tempdata,formend + 4,valueend - formend - 5)
fils.add formname, filecls
set filecls = nothing
end if
end if
else
value = midb(tempdata, formend + 4, valueend - formend - 6)
if form.exists(formname) then
form(formname) = form(formname) & "," & bytes2str(value)
else
form.add formname, bytes2str(value)
end if
end if
istart = 2 + slen
tempdata = midb(tempdata,valueend+2)
loop
verr = 0
tempdata = empty
vlosttime = formatnumber((timer-time1)*1000,2)
end sub
public sub setapp(stp,total,current,desc)
application.lock()
application(pid)="{id:""" & pid & """,step:""" & stp & """,total:" & total & ",now:" & current & ",description:""" & desc & """,dt:""" & now() & """}"
application.unlock()
end sub
"==============================
"判断扩展名
"==============================
private function checkexe(byval ex)
dim notin: notin = true
if vexe="*" then
notin=false
elseif instr(1, vexe, "|") > 0 then
dim tempexe: tempexe = split(vexe, "|")
dim i: i = 0
for i = 0 to ubound(tempexe)
if lcase(ex) = tempexe(i) then
notin = false
exit for
end if
next
else
if vexe = lcase(ex) then
notin = false
end if
end if
checkexe = notin
end function
"==============================
"把数字转换为文件大小显示方式
"==============================
public function getsize(byval isize)
dim sret,kb,mb,s
kb = 1024 : mb = kb * kb
if not isnumeric(isize) then
getsize = "未知"
exit function
end if
if isize < kb then
sret = isize & " bytes"
else
s = isize / kb
if s < 10 then
sret = formatnumber(isize / kb, 2, -1) & " kb"
elseif s < 100 then
sret = formatnumber(isize / kb, 1, -1) & " kb"
elseif s < 1000 then
sret = formatnumber(isize / kb, 0, -1) & " kb"
elseif s < 10000 then
sret = formatnumber(isize / mb, 2, -1) & " mb"
elseif s < 100000 then
sret = formatnumber(isize / mb, 1, -1) & " mb"
elseif s < 1000000 then
sret = formatnumber(isize / mb, 0, -1) & " mb"
elseif s < 10000000 then
sret = formatnumber(isize / mb / kb, 2, -1) & " gb"
else
sret = formatnumber(isize / mb / kb, 1, -1) & " gb"
end if
end if
getsize = sret
end function
"==============================
"二进制数据转换为字符
"==============================
private function bytes2str(byval byt)
if lenb(byt) = 0 then
bytes2str = ""
exit function
end if
dim mystream, bstr
set mystream =server.createobject("adodb.stream")
mystream.type = 2
mystream.mode = 3
mystream.open
mystream.writetext byt
mystream.position = 0
mystream.charset = vcharset
mystream.position = 2
bstr = mystream.readtext()
mystream.close
set mystream = nothing
bytes2str = bstr
end function
"==============================
"弹出提示信息框
"==============================
private function gostr(omsg)
dim outstr
outstr = ""
if omsg = "" or isnull(omsg) then
gostr = outstr
else
outstr = outstr & "<script language=""javascript"" type=""text/javascript"" charset=""gb2312"">" & vbcrlf
outstr = outstr & "alert(""&omsg&"");" & vbcrlf
outstr = outstr & "history.go(-1);" & vbcrlf
outstr = outstr & "</script>" & vbcrlf
end if
gostr = outstr
end function
"==============================
"获取错误描述
"==============================
private function geterr(byval num)
select case num
case 0
geterr = gostr("数据处理完毕!")
case 1
geterr = gostr("上传数据超过" & getsize(vmaxsize) & "限制!可设置maxsize属性来改变限制!")
case 2
geterr = gostr("未设置上传表单enctype属性为multipart/form-data或者未设置method属性为post,上传无效!")
case 3
geterr = gostr("含有非法扩展名(" & verrexe & ")文件!只能上传扩展名为" & replace(vexe, "|", ",") & "的文件")
case 4
geterr = gostr("对不起,程序不允许使用相同name属性的文件域!")
case 5
geterr = gostr("单个文件大小超出" & getsize(vsinglesize) & "的上传限制!")
end select
end function
private function rndnumber(maxnum,minnum)
randomize
rndnumber = int((maxnum-minnum+1)*rnd+minnum)
rndnumber = rndnumber
end function
"==============================
"根据日期生成随机文件名
"==============================
private function getname()
dim y, m, d, h, mm, s, r
randomize
y = year(now)
m = month(now): if m < 10 then m = "0" & m
d = day(now): if d < 10 then d = "0" & d
h = hour(now): if h < 10 then h = "0" & h
mm = minute(now): if mm < 10 then mm = "0" & mm
s = second(now): if s < 10 then s = "0" & s
r = rndnumber(9999999999,1111111111)
getname = y & m & d & h & mm & s & r
end function
"==============================
"检测上传类型是否为multipart/form-data
"==============================
private function checkentrytype()
dim contenttype, ctarray, barray,requestmethod
requestmethod=trim(lcase(request.servervariables("request_method")))
if requestmethod="" or requestmethod<>"post" then
checkentrytype = false
exit function
end if
contenttype = lcase(request.servervariables("http_content_type"))
ctarray = split(contenttype, ";")
if ubound(ctarray)>=0 then
if trim(ctarray(0)) = "multipart/form-data" then
checkentrytype = true
vboundary = split(contenttype,"boundary=")(1)
else
checkentrytype = false
end if
else
checkentrytype = false
end if
end function
"==============================
"获取上传表单值,参数可选,如果为-1则返回一个包含所有表单项的一个dictionary对象
"==============================
public function forms(byval formname)
if trim(formname) = "-1" then
set forms = form
else
if form.exists(lcase(formname)) then
forms = form(lcase(formname))
else
forms = ""
end if
end if
end function
"==============================
"获取上传的文件类,参数可选,如果为-1则返回一个包含所有上传文件类的一个dictionary对象
"==============================
public function files(byval formname)
if trim(formname) = "-1" then
set files = fils
else
if fils.exists(lcase(formname)) then
set files = fils(lcase(formname))
else
set files = nothing
end if
end if
end function
end class
%>
<script language="jscript" runat="server">
function getnewfileobj(){
return new uploadfile();
}
function uploadfile(){
this.formname="";
this.newname = "";
this.localname="";
this.filename="";
this.usersetname="";
this.contenttype="";
this.size=0;
this.value=null;
this.path = "";
this.extend="";
}//保存文件的方法
uploadfile.prototype.savetofile=function(){
var arg = arguments;
var path ,option, overwrite
if(arg.length==0){return {error:true,description:"参数错误,请传递至少一个参数"};}
if(arg.length==1){path = arg[0];option=0;overwrite=true;}
if(arg.length==2){path = arg[0];option=arg[1];overwrite=true;}
if(arg.length==3){path = arg[0];option=arg[1];overwrite=arg[2];}
if(arg.length>3){return {error:true,description:"参数错误,最多传递3个参数"};}
try{
var isp = (path.indexof(":")==1)
if(!isp){
path = server.mappath(path);
}
path = path.replace("/","\");
if(path.substr(path.length-1,1)!="\"){path = path + "\";}
this.createfolder(path);
this.path = path;
if(option==1){
path = path + this.localname;this.filename = this.localname;
}else{
if(option==-1 && this.usersetname!=""){
path = path + this.usersetname + "." + this.extend;this.filename = this.usersetname + "." + this.extend;
}else{
path = path + this.newname;this.filename = this.newname;
}
}
if(!overwrite){
path = this.getfilepath();
}
var tmps教程trm;
tmpstrm = server.createobject("adodb.stream");
tmpstrm.mode=3;
tmpstrm.type= 1;
tmpstrm.open();
var info = server.createobject("adodb.recordset");
info.fields.append("value", 205,-1);
info.open();
info.addnew();
info("value").appendchunk(this.value);
tmpstrm.write(info("value"));
info("value").appendchunk(null);
info.update();
info.close();
info = null;
path = path.replace(/u0000/igm,"");
tmpstrm.savetofile(path,2);
tmpstrm.close();
tmpstrm = null;
return {error:false,description:"成功保存文件"};
}catch(ex){
return {error:true,description:ex.description};
}
};
//获取二进制数据的方法
uploadfile.prototype.getbytes=function(){
return this.value
};
uploadfile.prototype.createfolder=function(folderpath){
var ofso;
ofso =server.createobject("scripting.filesystemobject" );
var sparent;
sparent = ofso.getparentfoldername( folderpath );
if(sparent == ""){return;}
if(!ofso.folderexists(sparent)){this.createfolder( sparent );}
if(!ofso.folderexists(folderpath)){ofso.createfolder(folderpath);}
ofso = null;
};uploadfile.prototype.getfilepath=function(){
var ofso,fname,fnamel,i=0;
ofso =server.createobject("scripting.filesystemobject" );
fname = this.path + this.filename;
fnamel = this.filename.substr(0,this.filename.lastindexof("."));
while(ofso.fileexists(fname)){
fname = this.path + fnamel + "(" + i + ")." + this.extend;
this.filename = fnamel + "(" + i + ")." + this.extend
i++;
}
ofso = null;
return fname;
};
</script>