最近写了一个主要为图片、视频的网站,网站程序服务器与图片服务器不在同一个域,经过探索与测试,终于解决这个问题;需要转载的朋友请注明来源于赢家互联网(winsgood.com);尊重原创;
本程序解决的问题有:
1、各类文件上传;
2、文件跨域上传;
3、图片缩略图产生;
4、图片水印;
5、上传文件各类限制;
缺点:只能返回一个值;
开发(运行)环境:win2003+iis + aspupload + aspjpeg + Md5
本程序可以进行很多扩展、修正、简化,有兴趣的可以一起进行探讨;
[HR]
网站服务器程序文件: A.ASP
<%Up_Type =1 '允许上传文件标记;1:gif,jpg,png" 2:swf,3:"gif,jpg,swf",4:rm,wav
Up_Path ="Ltd/Img_Ltd" '图片服务器存放文件夹
Up_Date =1 '是否以年月产生文件夹,0:否,1:是
Up_Md5 =0 '文件名是否需要MD5加密,0:否,1:是
Up_Slt =1 '是否需要缩略图,0:否,1:是
Up_Sy_Yn =1 '是否需要水印,0:否,1:是
Up_Sy ="×××.COM" '水印文字
Up_K =120 '缩略图宽
Up_G =68 '缩略图宽
Up_Url ="Up.Asp" '递交的网址,返回地址
Up_Sjmc ="企业形象图" '操作事件名称
Up_Bdmc ="form1" '表单名称 * 注意大小写
Up_Bd ="Ltd_Img" '文件返回对应表单 * 注意大小写
Up_Bd_1 ="Ltd_Img_1" '一个表单多个上传
Up_Bddx ="Ltd_Img_Dx" '文件大小返回对应表单 * 注意大小写
Up_Dx =200 'K文件大小
UpUrl ="Up_Type="&Up_Type&"&Up_Path="&Up_Path&"&Up_Date="&Up_Date&"&Up_Md5="&Up_Md5&"&Up_Sy_Yn="&Up_Sy_Yn&"&_
"&Up_Sy="&Up_Sy&"&Up_Slt="&Up_Slt&"&Up_K="&Up_K&""&_
"&Up_G="&Up_G&"&Up_Url="&Up_Url&"&Up_Sjmc="&Up_Sjmc&"&Up_Bdmc="&Up_Bdmc&"&Up_Bd="&Up_Bd&""&_
"&Up_Bddx="&Up_Bddx&"&Up_Dx="&Up_Dx&""%>
html><head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>跨域/本地 图片上传|曾建孙原创</title>
<link rel="stylesheet" type="text/css" href="../Images/css.css">
</head>
<body topmargin=0 leftmargin=3>
<%Set rs = Server.CreateObject("ADODB.Recordset")
Sql = "SELECT * FROM Sys_Ltd where Ltd_Id="&Session("LtdId")&""
Rs.Open Sql, Conn, 1, 1
Ltd_Img=rs("Ltd_Img")
Ltd_Img_1=rs("Ltd_Img_1")
rs.close
set rs=nothing%>
<table border="0" cellpadding="0" cellspacing="0" width="100%" bgcolor="#28A6D6">
<tr><td width="707" colspan="2" bgcolor="#0182CD" height="3"></td>
</tr><tr><td bgcolor="#28A6D6" width="118"><img border="0" src="../Images/addedit.gif"></td>
<td class="t1" width=100%><b>上传图片</b></td></tr>
</table>
<table border="0" cellpadding="8" cellspacing="1" width="100%" bgcolor="#28A6D6" height="548">
<tr><td bgcolor="#F7F7F7">
<table border=0 align=center width=772 cellspacing=6 cellpadding=0>
<form name="form1" action="" method="Post" onSubmit="return check_input()">
<tr><td align=right width="262">图1
</td><td width="488"><input type=text name="Ltd_Img" value=""></td></tr>
<tr><td align=right width="262">
</td><td width="488"><iframe name="admin" src="[URL=http://www.]http://www.[/URL]×××.com/Up.asp?<%=UpUrl%>" ID=t1 width="350" height="32" frameborder=0 scrolling=no></iframe></td></tr><!---跨域上传 注意ID的对应-->
<!---跨域取得上传返回表单值-->
<script for=t1 event=onload>
Ltd_Img.value=window.status;
</script>
<tr><td align=right width="262">图2
</td><td width="488"><input type=text name="Ltd_Img_1" value=""></td></tr>
<tr><td width="262"></td><td width="488"><iframe name="admin" src="../Inc/Up.asp?<%=UpUrl_1%>" width="350" height="32" frameborder=0 scrolling=no></iframe> <!---本地上传-->
</td></tr>
<tr><td width="262"></td><td align=center width="488">
<input type="submit" value="提交"> <input type="reset" value="重写"></td></tr></form></table>
</td></tr>
</table>
[HR]
图片服务器程序 UP.ASP
<%Server.ScriptTimeOut=999999
'*********** 这里验证提交客户端传递的密码、网站URL等;
'*********** 尊重原创,曾建孙(winsgood.com,zengjiawang.com)
Up_Type =Request("Up_Type") '允许上传文件标记,上传文件在这里控制;以防上传非法文件
If Up_Type=1 Then Up_Lx = "gif,jpg,png" '相片
If Up_Type=2 Then Up_Lx = "swf" 'Flash
If Up_Type=3 Then Up_Lx = "gif,jpg,swf" '广告
If Up_Type=4 Then Up_Lx = "rm,wav" '电影
Up_Path =Request("Up_Path") '存放文件夹
Up_Date =Request("Up_Date") '是否以年月产生文件夹,0:否,1:是
Up_Md5 =Request("Up_Md5") '文件名是否需要MD5加密
Up_Slt =Request("Up_Slt") '是否需要缩略图,0:否,1:是
Up_Sy_Yn =Request("Up_Sy_Yn") '是否需要水印,0:否,1:是
Up_Sy =Request("Up_Sy") '水印文字
Up_K =Request("Up_K") '缩略图宽
Up_G =Request("Up_G") '缩略图宽
Up_Url =Request("Up_Url") '递交的网址,返回地址
Up_Sjmc =Request("Up_Sjmc") '操作事件名称
Up_Bdmc=Request("Up_Bdmc")'表单名称 *** 注意大小写
Up_Bd =Request("Up_Bd") '文件返回对应表单 *** 注意大小写
Up_Bddx=Request("Up_Bddx") '文件大小返回对应表单 *** 注意大小写
Up_Dx =Request("Up_Dx") '文件大小
UpUrl ="Up_Type="&Up_Type&"&Up_Path="&Up_Path&"&Up_Date="&Up_Date&"&Up_Md5="&Up_Md5&"&Up_Sy="&Up_Sy&"&_
"&Up_Slt="&Up_Slt&"&Up_K="&Up_K&""&_
"&Up_G="&Up_G&"&Up_Url="&Up_Url&"&Up_Sjmc="&Up_Sjmc&"&Up_Bdmc="&Up_Bdmc&"&Up_Bd="&Up_Bd&""&_
"&Up_Bddx="&Up_Bddx&"&Up_Dx="&Up_Dx&""
'response.write Up_Sy
If Request("up")="Add" Then '********************************************开始上传文件操作
On Error Resume Next
randomize
ranNum=int(90000*rnd)+10000
nn="0"&month(now)
yy="0"&day(now)
If Up_Date = 1 Then Up_Path=Up_Path&"/"&right(year(now),2)&right(nn,2)
File_Path =server.MapPath(Up_Path) '得到上传文件夹
File_Name =right(year(now),2)&right(nn,2)&right(yy,2)&hour(now)&minute(now)&second(now)&ranNum '上传文件名
If Up_Md5=1 Then%>
<!--#include file = "Md5.Asp"-->
<%File_BigName =Md5(File_BigName) '加密文件名
End If
filesize=Request.TotalBytes '获得上传文件的大小
'response.write filesize
If filesize > Up_Dx*1024 Then '这个验证大小与下面重复,可考虑去掉
response.write "<script>alert('1.发生错误\n\n2.文件太大\n\n3.只允许小于"&Up_Dx&"k文件');location.href='javascript:window.history.go(-1);'</script>"
Response.end
End if
'filedata=Request.BinaryRead(filesize) '获得上传文件的二进制数据
'Response.BinaryWrite filedata '在浏览器上显示二进制数据
'******************************************************************************上传文件
Set Upload=Server.CreateObject("Persits.Upload.1")
upload.overwritefiles=false
Upload.SetMaxSize Up_Dx * 1024,True '允许文件大小
Upload.CreateDirectory File_Path,true '尝试创建路径文件夹,true表示忽略目录已存在错误
Count = Upload.Save(File_Path) '先上传文件至服务器内存
If Err.Number = 8 Then
Set Upload=Nothing
response.write "<script>alert('1.发生错误\n\n2.文件太大\n\n3.只允许小于"&Up_Dx&"k文件');location.href='javascript:window.history.go(-1);'</script>"
Response.end
Else
If Err <> 0 Then
Set Upload=Nothing
response.write "<script>alert('1.未知错误\n\n2."&Err.Description&"');location.href='javascript:window.history.go(-1);'</script>"
Response.end
End If
End If
'*******************上传后文件处理*************************
set File = Upload.Files("FILE1")
If Not File Is Nothing Then
FileSize=File.Size
Filename = File.Filename '获取原本文件名
Fileext = File.Ext ' 获取文件扩展名
ChkStr = ","&Lcase(Up_Lx)&"," '判断文件类型是否正确
If Instr(ChkStr,","&right(Fileext,3)&",") <= 0 Then
File.Delete '删除内存中的临时文件,以释放内存或硬盘空间(还可用Copy、Move两个指令)
Set Upload=Nothing
set File=Nothing
response.write "<script>alert('1.错误的文件类型\n\n2.只允许后缀为 "&Up_Lx&" 的文件上传');location.href='javascript:window.history.go(-1);'</script>"
Response.end
end If
Else
Set Upload=Nothing
set File=Nothing
Response.Write "错误: 您并没有选择文件!"
response.write "<script>alert('1.错误\n\n2.没有选择文件\n\n3.上传文件数据流丢失');location.href='javascript:window.history.go(-1);'</script>"
Response.end
End If
File_Lj = File_Path&"\"& File_Name & Fileext '得到服务器存放文件绝对路径
File_Lj_Slt = File_Path&"\0"& File_Name & Fileext '缩略图路径
Upload.MoveFile File_Path&"\"&File.Filename,File_Lj '给文件改名
Set Upload=Nothing
set File=Nothing
response.write "<script>window.status='"&Up_Path &"/"& File_Name & Fileext&"';</script>" '跨域传递回表单值
response.write "<script>parent.document."&Up_Bdmc&"."&Up_Bd&".value='"& File_Name & Fileext&"'</script>" '返回文件名称到表单
If Up_Bddx <>"" Then response.write "<script>parent.document."&Up_Bdmc&"."&Up_Bddx&".value='"&FileSize&"'</script>" '返回文件大小到表单
If Up_Sy <>"" Then Call UpSy(File_Lj)
If Up_Slt = 1 Then Call Upslt(File_Lj,File_Lj_Slt,Up_K,Up_G)
response.write "<script>alert('1."&Up_Sjmc&"\n\n2.上传文件成功\n\n3."&File_Name&Fileext&"');location.href='javascript:window.history.go(-1);'</script>"
Response.end
End If
%>
<html><head>
<title>跨域/本地图片上传|曾建孙原创</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="css.css">
</head>
<body text="#000000" leftmargin="0" topmargin="0" bgcolor="#F4EEE4">
<table width="100%" border="0" cellspacing="0" cellpadding="0" bordercolor="#CCCCCC">
<tr><form name="form" method="post" action="Up.asp?<%=UpUrl%>&Up=Add" enctype="multipart/form-data">
<td valign="middle"><input type="file" name="file1" size="30"><input type="submit" name="Submit" value="上传"></td></form></tr>
</table>
</body></html>
<%Function Upsy(FileLj)
Set Jpeg = Server.CreateObject("Persits.Jpeg") '::::::::::水印:::::::::::::
Jpeg.Open FileLj '打开图片
Jpeg.Canvas.Pen.Color = &H000000 'black 颜色 '*****************************加边框处理******************************
Jpeg.Canvas.Pen.Width = 20 '画笔宽度
Jpeg.Canvas.Brush.Solid = False '是否加粗处理
Jpeg.Canvas.Bar 1, 1, Jpeg.Width, Jpeg.Height '起始X坐标 起始Y坐标 输入长度 输入高度
TempA=Jpeg.Binary '将原始数据赋给TempA **********加文字水印******************************
Jpeg.Canvas.Font.Color = &Hfffffff '水印文字的颜色,&H后面输入色彩值
Jpeg.Canvas.Font.Family = "Arial" '字体
Jpeg.Canvas.Font.Bold = True '是否加粗
Jpeg.Canvas.Font.Size = 36 '字体大小
Jpeg.Canvas.Font.ShadowColor = &H000000 '水印文字的阴影色彩
Jpeg.Canvas.Font.ShadowYOffset = 1 '水印文字阴影向右偏移的像素值,输入负值则向左偏移
Jpeg.Canvas.Font.ShadowXOffset = 1 '水印文字阴影向下偏移的像素值,输入负值则向右偏移
Jpeg.Canvas.Brush.Solid = True
Jpeg.Canvas.Font.Quality = 5 '输出质量
Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-20,Jpeg.OriginalHeight-60,Up_Sy 'x,y,文字
TempB=Jpeg.Binary '将文字水印处理后的值赋给TempB,这时,文字水印没有不透明度
'***************利用缓存调整透明度*******************
Set MyJpeg = Server.CreateObject("Persits.Jpeg")
MyJpeg.OpenBinary TempA
Set Logo = Server.CreateObject("Persits.Jpeg")
Logo.OpenBinary TempB
MyJpeg.DrawImage 0,0, Logo, 0.3 '0.3是透明度
TempC=MyJpeg.Binary '将最终结果赋值给TempC,这时也可以生成目标图片了
'response.BinaryWrite TempC '将二进输出给浏览器
MyJpeg.Save FileLj '保存透明的水印了
set TempA=nothing
set TempB=nothing
set TempC=nothing
Set MyJpeg=Nothing
Logo.Close
Set Jpeg=Nothing
Set Logo=nothing
end Function
Function Upslt(FileLj,FileLjSlt,UpK,UpG) '**********************上传文件
Set Jpeg = Server.CreateObject("Persits.Jpeg") '::::::::::缩略图:::::::::::::
Jpeg.Open FileLj '打开图片
If Jpeg.OriginalWidth / Jpeg.OriginalHeight > 1.5 then '多种设定方法 先判断宽高比 按比例缩放
Jpeg.Width = UpK
Jpeg.Height = int((UpK/Jpeg.OriginalWidth)*Jpeg.OriginalHeight)
elseif Jpeg.OriginalWidth / Jpeg.OriginalHeight <= 1.5 Then '图片高比宽大时,强制大小
Jpeg.Width = UpK
Jpeg.Height = UpG
end if
Jpeg.Sharpen 1, 180 '锐化效果
Jpeg.Save FileLjSlt '生成缩略中图
Set Jpeg=Nothing
end Function%>
' 原创:曾建孙(zengjiawang.com)
需要转载的朋友请注明本程序来源于赢家互联网(winsgood.com);