| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2326 人关注过本帖
标题:如何上传图片并自动生成缩略图和水印
只看楼主 加入收藏
h527
Rank: 1
等 级:新手上路
帖 子:24
专家分:0
注 册:2006-6-29
收藏
 问题点数:0 回复次数:9 
如何上传图片并自动生成缩略图和水印

请问大家 如何实现图片上传并自动生成缩略图和水印和功能啊,有的话麻烦提供一下代码学习一下,先谢谢了啊?

搜索更多相关主题的帖子: 缩略图 水印 自动 功能 代码 
2006-06-30 00:06
litianyi520
Rank: 1
等 级:新手上路
帖 子:75
专家分:0
注 册:2006-5-18
收藏
得分:0 

1.
<form action="img_save.asp" method="POST" enctype="multipart/form-data" name=form id="form">
<TABLE cellpadding="3" cellspacing="1" align="center">
<tr>
<td class=th colspan="2">
<font size="3" color="#FF0000">Logo</font></td>
</tr>
<tr>
<td align="right" width="21%">上传Logo:</td>
<td width="77%"><input type="file" name="img" size="20" value="浏览" />
&nbsp; <input type="submit" value="上传" name="B1" isshowprocessbar="True" >
gif或jpg格式</td>
</tr>

<tr>
<td align="right" width="21%">Logo预览:

</td>
<td align="left" width="77%" ><%if myrs("img")<>"" then %>
<img src="<%=myrs("img")%>" width="50" height="50" border="1" />
<%else
response.write "您还没有上传图片!"
end if%></td>
</tr>
</table>
</form>
2.
<!--#include FILE="conn.asp"-->
<!--#include FILE="upload.inc"-->
<%
if session("user_name")="" then '''''''''''自己定义的用户名,每个人有每人的图片
response.write "<script language='javascript'>"
response.write "alert('非法操作!');"
response.write "history.go(-1);"
response.write "</script>"
else

user_name="user_name_"&session("user_name")&"_"
nowtime=now()
sj=cstr(year(nowtime))+"-"+right("0"+cstr(month(nowtime)),2)+"-"+right("0"+cstr(day(nowtime)),2)

dim upload,file,formName,formPath,iCount
set upload=new upload_F
function MakedownName()
dim fname
fname = now()
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
fname = int(fname) + int((10-1+1)*Rnd + 1)
MakedownName=fname
end function
formPath="img/" ''''''''''文件夹名称,放在根目录里
iCount=0
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象

if file.FileSize<100 then
response.write "<FIELDSET align=center><LEGEND align=center>文件上传发生错误 </LEGEND><br>请先选择你要上传的文件! [ <a href=# onclick=history.go(-1)>重新上传</a> ]</fieldset>"
response.end
end if

if file.FileSize>204800 then
response.write "<FIELDSET align=center><LEGEND align=center>文件上传发生错误 </LEGEND><br>文件大小超过了限制200K![ <a href=# onclick=history.go(-1)>重新上传</a> ]</fieldset>"
response.end
end if

fileExt=lcase(right(file.filename,4))

if fileEXT<>".gif" and fileEXT<>".jpg" then
response.write "<FIELDSET align=center><LEGEND align=center>文件上传发生错误!</LEGEND><br>文件格式不正确![ <a href=# onclick=history.go(-1)>重新上传</a> ]</fieldset>"
response.end
end if

if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据

set myrs = server.CreateObject ("Adodb.recordset")
strsql = "select * from 注册 where user_name="&session("user_name")&""
myrs.open strsql,myconn,1,3
if myrs("img")<>"" then
tempfpath=myrs("img")
FiLePaTh = Server.MapPath(tempfpath)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(FiLePaTh)
Set fso = nothing
end if

newname=user_id&MakedownName()&"."&mid(file.FileName,InStrRev(file.FileName, ".")+1) '''自定义
file.SaveAs Server.mappath(formPath&newname) ''保存文件
iCount=iCount+1
else
response.write "未找到文件 &nbsp;&nbsp;<A HREF=javascript:history.back(1)>返回</A>"
response.end
end if
next
myrs("img")="img/"&newname
myrs.Update
myrs.close
Set myrs=nothing
myconn.Close
Set myconn=nothing
response.Redirect("img.asp")
end if
%>
3.upload.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim upfile_Stream
Class upload_F
dim Form,File,Version
Private Sub Class_Initialize
dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
Version="化境编程界HTTP上传程序 Version 1.0"
if Request.TotalBytes<1 then Exit Sub
set Form=CreateObject("Scripting.Dictionary")
set File=CreateObject("Scripting.Dictionary")
set upfile_Stream=CreateObject("Adodb.Stream")
upfile_Stream.mode=3
upfile_Stream.type=1
upfile_Stream.open
upfile_Stream.write Request.BinaryRead(Request.TotalBytes)
vbEnter=Chr(13)&Chr(10)
iDivLen=inString(1,vbEnter)+1
strDiv=subString(1,iDivLen)
iFormStart=iDivLen
iFormEnd=inString(iformStart,strDiv)-1
while iFormStart < iFormEnd
iStart=inString(iFormStart,"name=""")
iEnd=inString(iStart+6,"""")
mFormName=subString(iStart+6,iEnd-iStart-6)
iFileNameStart=inString(iEnd+1,"filename=""")
if iFileNameStart>0 and iFileNameStart<iFormEnd then
iFileNameEnd=inString(iFileNameStart+10,"""")
mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
if iEnd>iStart then
mFileSize=iEnd-iStart-4
else
mFileSize=0
end if
set theFile=new FileInfo
theFile.FileName=getFileName(mFileName)
theFile.FilePath=getFilePath(mFileName)
theFile.FileSize=mFileSize
theFile.FileStart=iStart+4
theFile.FormName=FormName
file.add mFormName,theFile
else
iStart=inString(iEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
if iEnd>iStart then
mFormValue=subString(iStart+4,iEnd-iStart-4)
else
mFormValue=""
end if
form.Add mFormName,mFormValue
end if
iFormStart=iformEnd+iDivLen
iFormEnd=inString(iformStart,strDiv)-1
wend
End Sub
Private Function subString(theStart,theLen)
dim i,c,stemp
upfile_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
if upfile_Stream.EOS then Exit for
c=ascB(upfile_Stream.Read(1))
If c > 127 Then
if upfile_Stream.EOS then Exit for
stemp=stemp&Chr(AscW(ChrB(AscB(upfile_Stream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&Chr(c)
End If
Next
subString=stemp
End function
Private Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to upfile_Stream.Size-theLen
if i>upfile_Stream.size then exit Function
upfile_Stream.Position=i-1
if AscB(upfile_Stream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if upfile_Stream.EOS then
inString=0
Exit for
end if
if AscB(upfile_Stream.Read(1))<>AscB(MidB(Str,j,1)) then
InString=0
Exit For
end if
next
if InString<>0 then Exit Function
end if
next
End Function
Private Sub Class_Terminate
form.RemoveAll
file.RemoveAll
set form=nothing
set file=nothing
upfile_Stream.close
set upfile_Stream=nothing
End Sub
Private function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath =""
End If
End function
Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName =""
End If
End function
Private function toByte(Str)
dim i,iCode,c,iLow,iHigh
toByte=""
For i=1 To Len(Str)
c=mid(Str,i,1)
iCode =Asc(c)
If iCode<0 Then iCode = iCode + 65535
If iCode>255 Then
iLow = Left(Hex(Asc(c)),2)
iHigh =Right(Hex(Asc(c)),2)
toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
Else
toByte = toByte & chrB(AscB(c))
End If
Next
End function
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileStart
Private Sub Class_Initialize
FileName =""
FilePath =""
FileSize = 0
FileStart= 0
FormName =""
End Sub
Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=1
if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function
if FileStart=0 or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
upfile_Stream.position=FileStart-1
upfile_Stream.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=0
end function
End Class
</SCRIPT>


2006-06-30 10:17
litianyi520
Rank: 1
等 级:新手上路
帖 子:75
专家分:0
注 册:2006-5-18
收藏
得分:0 
补充一下,2.为IMG_SAVE.ASP

2006-06-30 10:18
h527
Rank: 1
等 级:新手上路
帖 子:24
专家分:0
注 册:2006-6-29
收藏
得分:0 

这样好像并没有生成缩略图和水印啊,不过还是非常感谢你啊?


2006-06-30 15:04
dzt0001
Rank: 13Rank: 13Rank: 13Rank: 13
等 级:蒙面侠
威 望:5
帖 子:1281
专家分:4998
注 册:2005-10-12
收藏
得分:0 
应该是需要有组件支持的

----我怎能在别人的苦难面前转过脸去----
2006-07-02 20:47
h527
Rank: 1
等 级:新手上路
帖 子:24
专家分:0
注 册:2006-6-29
收藏
得分:0 
谢谢各位了啊

2006-07-03 23:15
h527
Rank: 1
等 级:新手上路
帖 子:24
专家分:0
注 册:2006-6-29
收藏
得分:0 
终于搞定了啊,谢谢各位了职

2006-07-08 00:14
ggchen
Rank: 1
等 级:新手上路
帖 子:5
专家分:0
注 册:2006-7-7
收藏
得分:0 
哥们怎么搞定的??
2006-07-08 13:40
bluemoonte
Rank: 1
等 级:新手上路
帖 子:156
专家分:0
注 册:2006-2-12
收藏
得分:0 

伙计,能把你的代码帖上来吗?

2006-07-08 17:03
h527
Rank: 1
等 级:新手上路
帖 子:24
专家分:0
注 册:2006-6-29
收藏
得分:0 
我用的是aspjpeg组件,下面是这个组件的使用说明:
一、图片缩略

&amp;lt;%
Set Jpeg = Server.CreateObject("Persits.Jpeg") 调用组件
Path = Server.MapPath("images") &amp; "\clock.jpg" 待处理图片路径
Jpeg.Open Path 打开图片
高与宽为原图片的1/2
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
保存图片
Jpeg.Save Server.MapPath("images") &amp; "\clock_small.jpg"
%&amp;gt;
&amp;lt;IMG SRC="images/clock_small.jpg"&amp;gt; 查看处理的图片



二、图片水印

&amp;lt;%
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath("images/dodge_viper.jpg")
开始写文字
Jpeg.Canvas.Font.Color = &amp;000000' red 颜色
Jpeg.Canvas.Font.Family = "Courier New" 字体
Jpeg.Canvas.Font.Bold = True 是否加粗
Jpeg.Canvas.Print 10, 10, "Copyright (c) XYZ, Inc."
打印坐标x 打印坐标y 需要打印的字符
以下是对图片进行边框处理
Jpeg.Canvas.Pen.Color = &amp;H000000' black 颜色
Jpeg.Canvas.Pen.Width = 2 画笔宽度
Jpeg.Canvas.Brush.Solid = False 是否加粗处理
Jpeg.Canvas.Bar 1, 1, Jpeg.Width, Jpeg.Height
起始X坐标 起始Y坐标 输入长度 输入高度
Jpeg.Save Server.MapPath("images/dodge_viper_framed.jpg") 保存
%&amp;gt;



三、安全码

安全玛的道理和加水印差不多,很多朋友问我要具体的代码技术,在这里我就写出来和大家分享,一般人我还不告诉他。呵呵。
&amp;lt;%
生成安全码的函数 www.
function make_randomize(max_len,w_n) max_len 生成长度,w_n:0 可能包含字母,1:只为数字
randomize
for intcounter=1 to max_len
whatnext=int((1-0+1)*rnd+w_n)
if whatnext=0 then
upper=122
lower=97
else
upper=57
lower=48
end if
strnewpass=strnewpass &amp; chr(int((upper-lower+1)*rnd)+lower)
next
make_randomize=strnewpass
end function
%&amp;gt;

生成安全码的图片。当然你要预先准备一张背景图哦

&amp;lt;%random_num=make_randomize(4,1) 生成4位数字的安全码
session("random_num")=random_num 为什么调用session,没有session的安全码是完全没有意义的。呵呵

Set Jpeg = Server.CreateObject("Persits.Jpeg") 调用组件
Jpeg.Open Server.MapPath("infos/random_pic/random_index.gif") 打开准备的图片
Jpeg.Canvas.Font.Color = &amp;H006699
Jpeg.Canvas.Font.Family = "Arial Black"
Jpeg.Canvas.Font.Bold = false
Jpeg.Canvas.PrintText 0, -2, random_num
jpeg.save Server.MapPath("infos/random_pic/random_index.bmp") 保存
%&amp;gt; &amp;lt;img src="infos/random_pic/random_index.bmp" border="0" align="absmiddle"&amp;gt;
自己做做看。呵呵。




四、图片切割

一直以来,对aspjpeg不了解的人以为是无法用它来进行切割的。
其实有这样的一个方法的
crop x1,y1,x2,y2
切割长方型左上角x坐标,y坐标 右下角x坐标 y坐标
下面我就做一个演示哈
Set Jpeg = Server.CreateObject("Persits.Jpeg")
jpeg.open server.MapPath("/pic/1.gif")
jpeg.width=70
Jpeg.Height = Jpeg.OriginalHeight*70 / jpeg.Originawidth
jpeg.crop 0,0,70,52 开始切割其实是把超过52象素的下部分去掉
jpeg.save server.MapPath("/temp_pic/small_1.gif") 保存
怎么样,很简单吧



五、图片合并

我们这里是要把logo图片加到dodge_viper.jpg图片上去
其实,图片合并的方法也可以用来动态打水印哦
Set Photo = Server.CreateObject("Persits.Jpeg")
PhotoPath = Server.MapPath("images") &amp; "\dodge_viper.jpg"
Photo.Open PhotoPath
Set Logo = Server.CreateObject("Persits.Jpeg")
LogoPath = Server.MapPath("images") &amp; "\clock.jpg"
Logo.Open LogoPath

Logo.Width = 70
Logo.Height = Logo.Width * Logo.OriginalHeight / Logo.OriginalWidth

Photo.DrawImage 0, 0, Logo

Photo.SendBinary 这里用了sendBinary的输出方法。当然,你也可以先保存更改后的dodge_viper.jpg,再输入也可以。我个人不大喜欢用sendBinary方法,在网速慢的时候容易出错。在速度方面也不怎样。呵呵。



六、数据库支持

这里不多说了。其实就是Binary方法,大家知道图片存进数据库只能存为二进制的文件的。所以代码就懒的写了。



七、更多方法介绍

Canvas.Line(Left, Top, Right, Bottom)
画一条直线
Canvas.Ellipse(Left, Top, Right, Bottom)
画出一个椭圆
Canvas.Circle(X, Y, Radius)
画出一个圆
Canvas.Bar(Left, Top, Right, Bottom)
画出一个长方形,上面有代码介绍了
Canvas.Font.ShadowColor
文字阴影颜色
Canvas.Font.ShadowXOffset As Long
阴影X坐标设定
Canvas.Font.ShadowYOffset As Long
Y坐标设定
Canvas.Font.BkMode As String
文字背景
照 着他做应该不会有什么问题的

2006-07-10 03:05
快速回复:如何上传图片并自动生成缩略图和水印
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.030213 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved