200分求,ASP图片上传,生成缩略图,图片变小,无组件源代码,UP有分。

xmayxmei 2003-08-22 10:12:14
RT
...全文
164 23 打赏 收藏 转发到动态 举报
写回复
用AI写文章
23 条回复
切换为时间正序
请发表友善的回复…
发表回复
minghui000 2004-01-14
  • 打赏
  • 举报
回复
好象没有一个能正确回答楼主的问题啊。。是要无组件。。。UP
deng1107 2003-08-27
  • 打赏
  • 举报
回复
up
xmayxmei 2003-08-27
  • 打赏
  • 举报
回复

要是用组件,我的买服务器啊!!
请问各位现在要不要揭贴?
凯晰叶子 2003-08-27
  • 打赏
  • 举报
回复
太多了我就不写了!

UP
xuya 2003-08-27
  • 打赏
  • 举报
回复
upload.asp:

<table width="26%" border="0" height="15" cellspacing="0" cellpadding="0">
<form name="form" method="post" action="upfile.asp?info=asfsdfs" enctype="multipart/form-data">

<tr>
<td colspan="2">
<input type="text" name="info" size="30">
<font size="2" color="#CC0000"><b>图片标题</b></font>
</td>
</tr>

<tr>
<td width="28%">
<input type="file" name="file1" size=22>
</td>
<td width="72%"> 
<input type="submit" name="Submit" value="上传">
</td>
</tr>
<tr>
<td colspan="2"><font color="#666666" size="2">建议图片:宽200象素,高度不限,图片不超过10副.</font></td>
</tr>
</form>
</table>



upfile.asp:


<%

dim upfile_5xSoft_Stream

Class upload_5xSoft

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=""
if Request.TotalBytes<1 then Exit Sub
set Form=CreateObject("Scripting.Dictionary")
set File=CreateObject("Scripting.Dictionary")
set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")
upfile_5xSoft_Stream.mode=3
upfile_5xSoft_Stream.type=1
upfile_5xSoft_Stream.open
upfile_5xSoft_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_5xSoft_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
if upfile_5xSoft_Stream.EOS then Exit for
c=ascB(upfile_5xSoft_Stream.Read(1))
If c > 127 Then
if upfile_5xSoft_Stream.EOS then Exit for
stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_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_5xSoft_Stream.Size-theLen
if i>upfile_5xSoft_Stream.size then exit Function
upfile_5xSoft_Stream.Position=i-1
if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if upfile_5xSoft_Stream.EOS then
inString=0
Exit for
end if
if AscB(upfile_5xSoft_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_5xSoft_Stream.close
set upfile_5xSoft_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_5xSoft_Stream.position=FileStart-1
upfile_5xSoft_Stream.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=0
end function
End Class




response.write "<body bgcolor='#f3f3f3'>"

dim upload,file,formName,formPath,iCount,filename,fileExt,info
set upload=new upload_5xSoft ''建立上传对象
formPath="../loupan_imgs/" ''文件上传后存放的目录
if right(formPath,1)<>"/" then formPath=formPath&"/"
iCount=0
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象

info = "无标题"
if upload.form("info")<>"" then
info = upload.form("info") '''''''''''''''''''''关键所在××××××××××××××××
response.write info
end if
if file.filesize<100 then
response.write "<font size=2>请先选择你要上传的图片 [ <a href=# onclick=history.go(-1)>重新上传</a> ]</font>"
response.end
end if

if file.filesize>100000 then
response.write "<font size=2>图片大小超过了限制 [ <a href=# onclick=history.go(-1)>重新上传</a> ]</font>"
response.end
end if

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

if fileEXT<>".gif" and fileEXT<>".jpg" then
response.write "<font size=2>文件格式不对 [ <a href=# onclick=history.go(-1)>重新上传</a> ]</font>"
response.end
end if

filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&file.FileName
filename1=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&file.FileName
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
file.SaveAs Server.mappath(filename) ''保存文件
iCount=iCount+1
end if
set file=nothing
next
set upload=nothing ''删除此对象

session("upface")="done"

Htmend iCount&" 个文件上传结束!"

sub HtmEnd(Msg)
set upload=nothing

response.write "<script>"
response.write "document.write('<font size=2>图片上传成功,</font>');"
response.write "</script>"
end sub


%>
</body>
</html>

lei89413005 2003-08-27
  • 打赏
  • 举报
回复
up
showerXP 2003-08-27
  • 打赏
  • 举报
回复
up
ArvinGuo712 2003-08-27
  • 打赏
  • 举报
回复
你可一参照一下动网论坛的代码。它有着个功能。
xmayxmei 2003-08-27
  • 打赏
  • 举报
回复
谢谢各位,
要是到周末还是没有比较满意的答案,
就揭贴算了。
不过200分还是有效哦。。分不够再加。
calfhfah 2003-08-27
  • 打赏
  • 举报
回复
实现图片上传的时候你的form要加上

<form type=file name= method= action= enctype="multipart/form-data">

treeroot 2003-08-27
  • 打赏
  • 举报
回复
<%
Function str2bin(varstr)
str2bin=""
For i=1 To Len(varstr)
varchar=mid(varstr,i,1)
varasc = Asc(varchar)
' asc对中文字符求出来的值可能为负数,
' 加上65536就可求出它的无符号数值
' -1在机器内是用补码表示的0xffff,
' 其无符号值为65535,65535=-1+65536
' 其他负数依次类推。
If varasc<0 Then
varasc = varasc + 65535
End If
'对中文的处理:把双字节低位和高位分开
If varasc>255 Then
varlow = Left(Hex(Asc(varchar)),2)
varhigh = right(Hex(Asc(varchar)),2)
str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)
Else
str2bin = str2bin & chrB(AscB(varchar))
End If
Next
End Function

Function bin2str(binstr)
Dim varlen,clow,ccc,skipflag
'中文字符Skip标志
skipflag=0
ccc = ""
If Not IsNull(binstr) Then
varlen=LenB(binstr)
For i=1 To varlen
If skipflag=0 Then
clow = MidB(binstr,i,1)
'判断是否中文的字符
If AscB(clow) > 127 Then
'AscW会把二进制的中文双字节字符高位和低位反转,所以要先把中文的高低位反转
ccc =ccc & Chr(AscW(MidB(binstr,i+1,1) & clow))
skipflag=1
Else
ccc = ccc & Chr(AscB(clow))
End If
Else
skipflag=0
End If
Next
End If
bin2str = ccc
End Function
%>

<%

datalen=request.totalbytes
formdata=request.binaryread(datalen)
strformdata=bin2str(formdata)
divstr=LeftB(formdata,InStrB(FormData,str2bin(VbCrLf))-1)
divlen=LenB(divstr)

lngFileNameStart=Instr(strformdata,"filename="&chr(34))+Len("filename="&chr(34))
lngFileNameEnd=Instr(lngFileNameStart,strformdata,chr(34))
strFileName=Mid(strformdata,lngFileNameStart,lngFileNameEnd-lngFileNameStart)
strFileName=Trim(strFileName)
strFileName=Replace(strFileName,vbCRLF,vbNullString)

FileNameDot=InStr(1,strFileName,".")
FileEx=Mid(strFileName,FileNameDot+1)

DataStart = InStrB(lngFileNameStart,formdata,str2bin(VbCrLf & VbCrLf)) + 4
DataSize = InStrB(DataStart,formdata,DivStr) - DataStart - 2
FormFieldData = MidB(formdata,DataStart,DataSize)

filename=Year(Date()) & "_" & Month(Date()) & "_"
filename=filename & Day(Date()) & "_" & Hour(Time()) & "_"
filename=filename & Minute(Time()) & "_" & Second(Time()) & "_"
filename=filename & "."
filename=filename & FileEx

set objStream=Server.CreateObject("ADODB.Stream")
set objStream1=Server.CreateObject("ADODB.Stream")

objStream.Type=1
objStream1.Type=1
objStream.Mode=3
objStream1.Mode=3
objStream.Open 'formdata
objStream1.Open
'objStream.Type =1 'adTypeBinary
objStream.Write formdata
objStream.Position=DataStart-1
objStream.CopyTo objStream1,DataSize

objStream1.SaveToFile Server.MapPath("image\" & filename)
objStream.Close
objStream1.close

set objStream=nothing
set objStream1=nothing

if newsid<>0 then
set conn=Server.CreateObject("ADODB.Connection")
conn.ConnectionString=conn_string
conn.Open
sql="Insert into newsimage(image_name,image_newsid) values('"
sql=sql & filename & "'," & newsid & ")"
conn.Execute(sql)
conn.close
set conn=nothing
%>


以上可以上传二进制(包括图片)文件到服务器,至于缩略图就不知道了!!
yong1268 2003-08-27
  • 打赏
  • 举报
回复
虽然可以在一个SQL server BIOB 列中保存一个图片,但是最好将图片的URL保存在数据库表中而不保存图片本身,下面是通过名为myIMAGES的数据库表中检索各个图片的URL在一行中显示几个图片:
<%
set con =server.createobject("ADODB.Connection")
con.open"FILE NAME=C:\mydatelink.UDL"
mySQL="SELECT image_URL from myimages"
set rs =con.execute(mySQL)
while not rs.eof
%>
<img src ="<%=rs("image_URL")%>">
<%
RS.MoveNext
Wend
%>


注意上面的少了一个%,故再发一次,以后面这次为准。
yong1268 2003-08-27
  • 打赏
  • 举报
回复
虽然可以在一个SQL server BIOB 列中保存一个图片,但是最好将图片的URL保存在数据库表中而不保存图片本身,下面是通过名为myIMAGES的数据库表中检索各个图片的URL在一行中显示几个图片:
<%
set con =server.createobject("ADODB.Connection")
con.open"FILE NAME=C:\mydatelink.UDL"
mySQL="SELECT image_URL from myimages"
set rs =con.execute(mySQL)
while not rs.eof
%>
<img src ="<%=rs("image_URL")>">
<%RS.MoveNext
Wend
%>
cpio 2003-08-22
  • 打赏
  • 举报
回复
ASP不用组件是不行的

PHP可以
freetaiger 2003-08-22
  • 打赏
  • 举报
回复
up!关注
andy2001p 2003-08-22
  • 打赏
  • 举报
回复
帮你顶!
coffee_cn 2003-08-22
  • 打赏
  • 举报
回复
http://guozheimeng.ligang.net/
上面有个免费的,感觉不错,
54duke 2003-08-22
  • 打赏
  • 举报
回复
up 要求别我的还高
haper99 2003-08-22
  • 打赏
  • 举报
回复
asp不用组件好像不行吧,asp.net就没问题。
fireboys 2003-08-22
  • 打赏
  • 举报
回复
up买一个共享组件。要100块。。我哭。。
加载更多回复(3)

28,390

社区成员

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧