上传图片的方案

upfile_class.asp
%
'----------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响你的速度!
'******************* 无惧上传类 V1.0 ************************************
'作者:梁无惧
'网站:
'电子邮件:yjlrb@
'版权声明:版权所有,源代码公开,各种用途均可免费使用,但是修改后必须把修改后的文件
'发送一份给作者.
'**********************************************************************
'----------------------------------------------------------------------
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")
pareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
pareMode = 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 (iFindEn

d,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

<% 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=t rim(upload.form("fpath")) fpath="../uploadfile/product" if upload.err > 0 then select case upload.err case 1 response.write " 请先选择您要上传的文件! [重新上传]" case 2 response.write " 文件大小超过了限制 10M! [重新上传]" 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 " 请先选择您要上传的文件! [重新上传]" response.end end if fileExt=lcase(file.FileExt) if CheckFileExt(fileEXT)=false then response.write " 文件格式不正确! [重新上传]" 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 "" 'else ' response.write "" 'end if if fpath="../uploadfile/product" then response.write "" 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 " 文件上传成功! [重新上传]" 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 %>

upload.asp

第二种方案：
1.asp

标题
内容
图片

2.asp
<%@LANGUAGE= "VBSCRIPT " CODEPAGE= "CP_ACP "%>


<%
dim upload,file,formName,formPath,iCount,filename,fileExt
set upload=new upload_5xSoft
title=upload.form( "title ")
content=upload.form( "content ")
iCount=0
for each formName in upload.file
set file=upload.file(formName)

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


randomize
ranNum=int(90000*rnd)+10000
if iCount=0 then
filename= "pic/ "&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&fileExt
if file.FileSize> 0 then
file.SaveAs Server.mappath(FileName)
iCount=iCount+1
end if
end if

set file=nothing
next
set upload=nothing

sql= "insert into pro (lpic,title,content) values ( ' "&filename& " ', ' "&title& " ', ' "&content& " ') "
conn.execute(sql)
%>

读出

以后直接用img标签显示就可以了，我这里保存的是文件名


'==================================================================
'
' 无组件版文件上传 upload.asp
'
'==================================================================


<%
select case request( "action ")
case "save "
upload
case else
defaultp
end select
%>
<%sub defaultp()
CaseFlowId=request( "CaseFlowId ")
'checkid CaseFlowId
%>

">

<%end sub%>


<%sub upload()

Response.Expires=0
set iRe=Server.CreateObject( "ADODB.Recordset ")
iSql= "uploads "
iRe.Open iSql,conn,1,3
iLen=Request.TotalBytes
sBin=Request.BinaryRead(iLen)
iCrlf1 = ChrB(13) & ChrB(10)
iCrlf2 = iCrlf1 & iCrlf1
iLen = InStrB(1, sBin, iCrlf1) - 1
iSpc = LeftB(sBin, iLen)
sBin = MidB(sBin, iLen + 34)
iPos1 = InStrB(sBin, iCrlf2) - 1
While iPos1 > 0
iStr = f_Bin2Str(LeftB(sBin, iPos1))
iPos1 = iPos1 + 5
iPos2 = InStrB(iPos1, sBin, iSpc)

iPos3 = InStr(iStr, "; filename= " " ") + 12
If iPos3 > 12 Then
iStr = Mid(iStr, iPos3)
iPos3 = InStr(iStr, Chr(13) & Chr(10) & "Content-Type: ") - 2
iFn = Left(iStr, iPos3)
If iFn <> " " Then
iRe.AddNew
iRe( "CaseFlowId ")=request.querystring( "CaseFlowId ")
iRe( "UserId ")=session( "Userid ")
iRe( "UpFileName ") = mid(iFn,instrrev(iFn, "\ ")+1)
iRe( "Filetype ") = Mid(iStr, iPos3 + 18)
iRe( "Uploads ").AppendChunk MidB(sBin, iPos1, iPos2 - iPos1)
iRe.Update
End If
End If

sBin = MidB(sBin, iPos2 + iLen + 34)
iPos1 = InStrB(sBin, iCrlf2) - 1
Wend
iRe.close
set iRe=Nothing
response.write( "上传成功！
继续上传 ")
end sub%>
<%
Function f_Bin2Str(ByVal sBin)
Dim iI, iLen, iChr, iRe
iRe = " "
If Not IsNull(sBin) Then
iLen = LenB(sBin)
For iI = 1 To iLen
iChr = MidB(sBin, iI, 1)
If AscB(iChr) > 127 Then
iRe = iRe & Chr(AscW(M

idB(sBin, iI + 1, 1) & iChr))
iI = iI + 1
Else
iRe = iRe & Chr(AscB(iChr))
End If
Next
End If
f_Bin2Str = iRe
End Function
%>
'==================================================================
'
' 下载数据的ASP页: downLoad.asp
'
'==================================================================

<%
Response.Buffer=true
Response.Clear

downloadID=request( "downloadID ")

set iRe=server.createobject( "adodb.recordset ")
iSql= "select * from uploads where uploadID= "&downloadID
iRe.open iSql,conn,1,1
Response.ContentType=ire( "Filetype ")
Response.AddHeader "Content-Disposition ", "attachment;filename= "&iRe( "UpFileName ")
Response.BinaryWrite iRe( "Uploads ")
iRe.close
set iRe=Nothing
%>