求ASP高手给个上传图片到数据库的程序，最好能够显示出的源代码！

uppic.asp上传程序名

<%

dim rs

dim formsize,formdata,bncrlf,divider,datastart,dataend,mydata

formsize=request.totalbytes '取得客户端发过来的大小

formdata=request.binaryread(formsize)'把客户发过来的数据转成二进制作

bncrlf=chrB(13) &chrB(10)

divider=leftB(formdata,clng(instrb(formdata,bncrlf))-1)

datastart=instrb(formdata,bncrlf &bncrlf)+4

dataend=instrb(datastart+1,formdata,divider)-datastart

mydata=midb(formdata,datastart,dataend)'上面总共是取得图片的二进制数据

%>

<!--#include file="conn.asp"-->

<%

sql="select * from pic order by id desc"

Set rs = Server.CreateObject("ADODB.Recordset")

rs.Open sql,conn,3,2

rs.addnew

rs("big").appendchunk mydata'增加到数据库中

rs.update

set rs=nothing

set conn=nothing

%>

接下来是显示图片：display.asp

<!--#include file="conn.asp"-->'这个大家都知道吧，他就是与数据库连的一个程序了燃返

<%

id=request("id")

set rs=server.createobject("ADODB.recordset")

sql="select * from pic where id=" &id

rs.open sql,conn,1,1

Response.ContentType = "text/html" '显橡和示图梁段盯片的格式也可以用

'Response.ContentType = "image/gif" 以gif显示

'Response.ContentType = "image/jpg" 以jpg显示

Response.BinaryWrite rs("big") '显示图片

rs.close

set rs=nothing

set connGraph=nothing

%>

给全站图片加水印，思路是，找出网站图片目录，循环遍历该目录将里面的图片通过一个加余亩水印函饥悔数处理竖肢森,不明hi我或Q我:573780643

以下为代码:

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

<%

Public Function AddPersitsJpeg(Path)

'**************加图片水印*******************

Dim photo,logo,photopath,logopath

Set Photo = Server.CreateObject("Persits.Jpeg")

PhotoPath = Server.MapPath(Path) 'Path为路片路径及名称

Photo.Open PhotoPath '打开图片

Set Logo = Server.CreateObject("Persits.Jpeg")

LogoPath = Server.MapPath("logo/sinalogo.gif") '水印图片的路径(自己修改)

Logo.Open LogoPath

Logo.Width = photo.width /4 '水印图片的宽度

Logo.Height = photo.width /12

Photo.Canvas.Pen.Color = &H000000

Photo.Canvas.Pen.Width = 0

Photo.Canvas.Brush.Solid = False

Photo.DrawImage (photo.width-Logo.Width-20), photo.height-Logo.Height-10, Logo,0.6

photo.Save Server.MapPath(Path) ''水印显示在图片上的XY位置

Set logo = Nothing

Set photo = Nothing

End Function

%>

<%

Set fso=Server.CreateObject("Scripting.FileSystemObject")

dim FileName

FPath="pic/"'网站图片目录(自己修改)

Set fs = fso.GetFolder(server.MapPath(FPath))

Set f = fs.Files

For each k in f'循环目录

AddPersitsJpeg(FPath&k.name) '用AddPersitsJpeg函数给图片加水印

next

end if

%>

分类: 电脑/网络 >>程序设计 >>其他编程语言

问题描述:

网上搜的多而且杂，越看友咐越迷糊..........

最好把每页的代码都写一下，大致两三个页就可以解决了，谢谢达人帮助！！！！！！

解析:

三个页历告含：选择页，上传页sub，调用的代码页upload.inc，

我自己就在用这个，LZ给分吧

1浏览上传：

<form action="sub" method="post" enctype="multipart/form-data" target="_self">

<input type=file name=src size="20" value="浏览">

<input type=submit value="上传" name=B1 IsShowProcessBar="True">

</form>

sub 执行上传并返回地址，同时保存文件名在session(ccc)中

<!--#include FILE="upload.inc"-->

<%

dim upload,file,formName,formPath,iCount,fileformat

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="/upload/"

iCount=0

for each formName in upload.file ''列出所有上传了的文件

set file=upload.file(formName) ''生成一个文件对象

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

if fileformat="" or fileformat="" then

response.write"<script>alert('文件格式不对，请重新上传！')location='"&request.ServerVariables("HTTP_REFERER")&"'</script>"

response.end

end if

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

newname=MakedownName()&"."&mid(file.FileName,InStrRev(file.FileName, ".")+1)

session("ccc")=newname

file.SaveAs Server.mappath(formPath&newname) ''保存文件

iCount=iCount+1

else

response.write "<font style=FONT-SIZE:9pt>未找到文件 <A HREF=javascript:history.back(1)>重新上传</A><font style=FONT-SIZE:9pt>"

response.end

end if

next

%>

<%

response.write "<a href='upload/"&newname&"' target=_blank>upload/"&newname&" </a>("&cint(file.FileSize/1024)&"K) 上传成功!"

%>

<%

set file=nothing

set upload=nothing ''删除此对象

%>

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="upload 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>

---