Question

ASP中上传图片怎么做啊？

我们在做一个网上书店的项目，用ASP编码，可是上传部分不知道怎么做……

Answer 1

采用无组件下载代码。
upfile.asp

<% 'OPTION EXPLICIT%>
<!--#include FILE="upload_5xsoft.inc"-->

<%
dim upload,file,formName,formPath,iCount,MyFile
set upload=new upload_5xSoft ''建立上传对象

formpath="userdata/" ''得到上传目录

nian=Year(Date)
yue=Month(Date)
ri=Day(Date)
if len(nian)<4 then nian="00"&nian
if len(yue)<2 then yue="0"&yue
if len(ri)<2 then ri="0"&ri

ipinit=""
ip=Request.ServerVariables("REMOTE_ADDR")
tmpip=Split(ip,".")
tmpipb=UBound(tmpip)
' ReDim ThisIP(tmpipb)
for i=0 to tmpipb
ThisIp=tmpip(i)

Do WHile len(ThisIP)<3
ThisIP="0"+ThisIP
loop
ipinit=ipinit+ThisIP
next

'Response.write nian&yue&ri&ipinit
'Response.end

for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
'MyFile=formPath&File.FileName
'MyFile=File.FileName

shi=Hour(time)
fen=Minute(Time)
Miao=Second(Time)
if len(shi)<2 then shi="0"&shi
if len(fen)<2 then fen="0"&fen
if len(miao)<2 then miao="0"&miao

MyFile=nian&yue&ri&shi&fen&miao&ipinit&".txt"

file.SaveAs Server.mappath(formPath&MyFile) ''保存文件
response.write file.FilePath&"#"&file.FileName&"#"&" ("&file.FileSize&") => "&MyFile&" 成功!<br>"
end if
set file=nothing
next
set upload=nothing ''删除此对象

%>

upload_5xsoft.inc

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>

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="HTTP上传程序 Version 1.0"
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
</SCRIPT>

Answer 2

3个页面
upfile_class.asp
%
'----------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响你的速度!
'******************* 无惧上传类 V1.0 ************************************
'作者:梁无惧
'网站:http://www.25cn.com
'电子邮件:yjlrb@21cn.com
'版权声明:版权所有,源代码公开,各种用途均可免费使用,但是修改后必须把修改后的文件
'发送一份给作者.
'**********************************************************************
'----------------------------------------------------------------------
Dim oUpFileStream

Class UpFile_Class

Dim Form,File,Version,Err

Private Sub Class_Initialize
Version = "无惧上传类 Version V1.0"
Err = -1
End Sub

Private Sub Class_Terminate
'清除变量及对像
If Err < 0 Then
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
End If
End Sub

Public Sub GetDate (RetSize)
'定义变量
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
'代码开始
If Request.TotalBytes < 1 Then
Err = 1
Exit Sub
End If
If RetSize > 0 Then
If Request.TotalBytes > RetSize Then
Err = 2
Exit Sub
End If
End If
Set Form = Server.CreateObject ("Scripting.Dictionary")
Form.CompareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
File.CompareMode = 1
Set tStream = Server.CreateObject ("ADODB.Stream")
Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
oUpFileStream.Position = 0
RequestBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'取得每个项目之间的分隔符
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB (sSpace)
iFormStart = iStart+2
'分解项目
Do
iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sInfo = tStream.ReadText
'取得表单项目名称
iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
iFindStart = InStr (22,sInfo,"name=""",1)+6
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
'如果是文件
If InStr (45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo = new FileInfo_Class
'取得文件属性
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, "\")+1)
oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, "\")+1)
oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1)
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
file.add sFormName,oFileInfo
else
'如果是表单项目
tStream.Close
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iInfoEnd
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sFormValue = tStream.ReadText
If Form.Exists (sFormName) Then
Form (sFormName) = Form (sFormName) & ", " & sFormValue
else
form.Add sFormName,sFormValue
End If
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until (iFormStart+2) = iFormEnd
RequestBinDate = ""
Set tStream = Nothing
End Sub
End Class

'文件属性类
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
'保存文件方法
Public Function SaveToFile (Path)
On Error Resume Next
Dim oFileStream
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.Position = FileStart
oUpFileStream.CopyTo oFileStream,FileSize
oFileStream.SaveToFile Path,2
oFileStream.Close
Set oFileStream = Nothing
End Function

'取得文件数据
Public Function FileDate
oUpFileStream.Position = FileStart
FileDate = oUpFileStream.Read (FileSize)
End Function
End Class
%>
upfile.asp
<!--#include file="upfile_class.asp"-->
<html>
<head>
<title>文件上传</title>
<style type="text/css">
<!--
font{
font-size:12px;
}
body{
font-size:12px;
}

-->
</style>
</head>
<body topmargin="0" leftmargin="0" background="#E7F7EF">
<table width=100% border=0 cellspacing="0" cellpadding="0" bgcolor=#FFFFFF>
<tr><td width=100% height=100% >
<script>
//parent.document.put.add.disabled=false;
</script>
<%
server.scripttimeout=3000 '指定更长时间，以防网速过慢造成服务器脚本超时！
dim fpath,EnableUpload
dim upload,file,formName,formPath,iCount,filename,fileExt
dim ranNum

call upload_0()

'===========无组件上传(upload_0)====================
sub upload_0()
set upload=new UpFile_Class ''建立上传对象

upload.GetDate (10*1024*1024) '取得上传数据,是大数10M

iCount=0

'fpath=trim(upload.form("fpath"))
fpath="../uploadfile/product"

if upload.err > 0 then
select case upload.err
case 1
response.write "<font color=red><br>请先选择您要上传的文件!</font>  [<a href=upload.asp>重新上传</a>]"
case 2
response.write "<font color=red><br>文件大小超过了限制 10M!</font>  [<a href=upload.asp>重新上传</a>]"
end select
exit sub
else
formPath=fpath '存放上传文件的目录

if right(formPath,1)<>"/" then formPath=formPath&"/" '在目录后加(/)

for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.filesize<100 then
response.write "<font color=red><br>请先选择您要上传的文件!</font>  [<a href=upload.asp>重新上传</a>]"
response.end
end if

fileExt=lcase(file.FileExt)

if CheckFileExt(fileEXT)=false then
response.write "<font color=red><br>文件格式不正确!</font>  [<a href=upload.asp>重新上传</a>]"
response.end
end if

randomize
ranNum=int(90000*rnd)+10000
filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt

if file.FileSize>0 then '如果 FileSize > 0 说明有文件数据
file.SaveToFile Server.mappath(filename) '保存文件

'if fpath="smallpic" then
'response.write "<script language=javascript>parent.document.forms[0].picurl.value=aaa</script>"
'else
' response.write "<script language=javascript>parent.document.forms[0].url.value='"&filename&"';</script>"
'end if
if fpath="../uploadfile/product" then
response.write "<script language=javascript>parent.document.forms[1].picurl.value='"&filename&"';</script>"
End if

iCount=iCount+1
end if
set file=nothing
next
set upload=nothing

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

end if
end sub

sub HtmEnd(Msg)
response.write "<font color=red><br>文件上传成功!</font>  [<a href=upload.asp>重新上传</a>]"
response.end
end sub

'判断文件类型是否合格

Private Function CheckFileExt (fileEXT)
dim Forumupload,i
if fpath="swf" then '上传swf
Forumupload="swf|fla"
else
Forumupload="jpeg|bmp|png|gif|xls|jpg" '允放上传的文件格式
end if

Forumupload=split(Forumupload,"|")
for i=0 to ubound(Forumupload)
if lcase(fileEXT)=lcase(trim(Forumupload(i))) then
CheckFileExt=true
exit Function
else
CheckFileExt=false
end if
next
End Function

%>
</td></tr></table>
</body>
</html>
upload.asp
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
<!--
BODY{
BACKGROUND-COLOR: #FFFFFF;
font-size:9pt
}
.tx1 { height: 20px;font-size: 9pt; border: 1px solid; border-color: #000000; color: #0000FF}
-->
</style>

<SCRIPT language=javascript>
function check()
{
var strFileName=form1.FileName.value;
var FileType;
if (strFileName=="")
{
alert("请选择要上传的文件");
return false;
}
}
</SCRIPT>
</head>
<body leftmargin="0" topmargin="0">
<form action="upfile.asp" method="post" name="form1" onSubmit="return check()" enctype="multipart/form-data">
<input name="FileName" type="FILE" class="tx1" size="20">
<input type="submit" name="Submit" value="上传" style="border:1px double rgb(88,88,88);font:9pt">
</form>

</body>
</html>

Answer 3

上传代码需要4-5个文件，在这说太麻烦了，告诉我你的邮箱我给你发过去吧！

Answer 4

你搜一下 化境的上传组件 和梁无惧的组件