無元件上傳圖片到資料庫中，最完整解決方案

作者：Eve Cole 更新時間：2009-06-23 16:59:05

up.htm

<html>
<頭>
<標題><% =網站名稱%></標題>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="main.css" type="text/css">
<樣式類型=“文字/css”>
<!--
.tx1 { 高度：20px;寬度：30px；字體大小：9pt；邊框：1px實線；邊框顏色：黑色黑色

#000000；顏色：#0000FF}
-->
</風格>

<腳本語言=“JavaScript”>
<!--
var bgc_on=新陣列("#74D738","#FF9C17","#3278AB","#486177","#078C00","#007ECA")
var bgc_off=new Array("#4CAD12","FFB859","5F9FD0","577590","08A700","009FFF")

函數turnon(obj1,id){
obj1.style.background=bgc_on[id];
}
函數關閉（obj1，id）{
obj1.style.background=bgc_off[id];
}

//-->
</腳本>
<腳本語言=javascript>
函數 check_input()
{
if (Frm.pic.value=="")
{alert("請選擇要上傳的圖片");
返回假；
}
if (Frm.type.value=="")
{alert("請選擇圖片類型");
返回假；
}
if (Frm.thetext.value=="")
{alert("請輸入照片說明");
返回假；
}
返回真；
}
</腳本>
</head>

<表格寬度=755 cellpadding=0 cellspacing=0 border=0 bgcolor=#ffffffalign=“center”bordercolor=#000000>
<tr>
<td height=400 width=180 bgcolor=#D1E9D5 style="border-right: 1px #0E801Esolid">
<表格寬度=100% 高度=100% cellpadding=0 cellspacing=0 border=0align="center" bordercolor=#000000>
<tr><td height=30align="center"class=L15><font color=#E96D08>歡迎你：<%=username%>管理中心</font>
<tr><td height=23 align="center" class=L15 bgcolor=#4CAD12 style="border-top:0px #0E801Esolid; border-bottom:1px #0E801Esolid;"><font color=#C2F009 類別=nying >管理中心</font>
<tr><td 高度=20 等級=L13>

<tr><td高度=5>
<tr><td>
</表>
<td>
<%
設定 rs=server.createobject("adodb.recordset")
sql="從照片中選擇*，作者='"&用戶名&"'"
rs.open sql,conn,1,1
%>
<表格cellpadding=0 cellspacing=0 border=0 寬度=100% 高度=100%>
<tr><td 高度=3>
<tr><td height=3 bgcolor=#ffffff 背景=img/bj3.gif>
<tr><td height=20 valign="bottom" bgcolor=#eeeeee> 現在位置： 98243班 - 管理中心 - 新增新聞
<tr><td height=3 bgcolor=#eeeeee style="border-bottom: 1px #cccccc Solid"><p style="font-size:1pt">
<tr><td height=20 valign="bottom"> <font color=green><% =username %>：您總共上傳了<font color=red><% =rs.recordcount %></font> 張照片</font> <a href="adminphoto.asp"><font color=red><u>管理先前上傳的照片</u></font></a>
<tr><td bgcolor=#ffffff valign=top>
<table cellpadding=0 cellspacing=0 border=0 width=95% height=100%align="center">
<form action=addphoto.asp method=post name=Frm onSubmit="return check_input()" enctype="multipart/form-data">
<tr><td 高度=20 colspan=2>
<tr><td height=25 width=15%align="right" class=L13>選擇照片： <td> <input NAME="pic" TYPE="FILE" class="tx1" style="width:300 "> <font color=red>拒絕色情、寫真圖等</font>

<tr><td height=25 width=20%align="right" class=L13>照片分類： <td> <select name="類型">
<option selected value="">選擇類型</option>
<option value=「監護人合照」>監護人合照</option>
<option value="個人照片">個人照片</option>
<option value="恩師照片">恩師照片</option>
<option value="情人照片">情人照片</option>
<option value="友人照片">友人照片</option>
<option value="其他照片">其他照片</option>
</select>

</表>

</正文>
</html>

fupload.inc

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'限制上傳圖片大小
Dim UploadSizeLimit

'************************************ 得到上傳資料******** ** **********************
函數 GetUpload()
暗淡結果
設定結果=無
If Request.ServerVariables("REQUEST_METHOD") = "POST" then '請求方法必須是“POST”
昏暗 CT、PosB、邊界、長度、PosE
CT = Request.ServerVariables("HTTP_Content_Type") '讀取 Content-Type 標頭
如果 LCase(Left(CT, 19)) = "multipart/form-data" 那麼 'Content-Type 標頭必須是“multipart/form-data”
'這是上傳請求。
'從Content-Type header取得邊界和長度
PosB = InStr(LCase(CT), "boundary=") '找出邊界
If PosB > 0 then Boundary = Mid(CT, PosB + 9) '分隔邊界
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) '取得 Content-Length 標頭
如果 "" & UploadSizeLimit<>""" 那麼
上傳大小限制 = clng(上傳大小限制)
如果長度 > UploadSizeLimit 那麼
' 出錯時恢復下一步 ' 清除輸入緩衝區
'response.AddHeader“連接”，“關閉”
' 出錯時轉到 0
請求.BinaryRead(長度)
Err.Raise 2, "GetUpload", "上傳大小" & FormatNumber(Length,0) & "B 超出限制" & FormatNumber(UploadSizeLimit,0) & "B"
退出功能
結束如果
end if

If Length > 0 And Boundary <> "" then '是否有關於上傳的必要資訊？
邊界=“--”&邊界
昏暗的頭，二進位
Binary = Request.BinaryRead(Length) '從客戶端讀取二進位資料

'從二進位資料檢索上傳字段
設定結果=SeparateFields(Binary, Boundary)
Binary = Empty '清除變數
別的
Err.Raise 10，“GetUpload”，“零長度請求。”
結束如果
別的
Err.Raise 11，“GetUpload”，“未發送檔案。”
結束如果
別的
Err.Raise 1，“GetUpload”，“錯誤的請求方法。”
結束如果
設定獲取上傳=結果
結束功能

函數SeparateFields（二進制，邊界）
Dim PosOpenBoundary、PosCloseBoundary、PosEndOfHeader、isLastBoundary
昏暗的田野
邊界 = StringToBinary(邊界)

PosOpenBoundary = InstrB(二進位，邊界)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

Set Fields = CreateObject("Scripting.Dictionary")

Do While (PosOpenBoundary > 0 且 PosCloseBoundary > 0 且不是 isLastBoundary)
'標題和文件/來源字段數據
昏暗標題內容、欄位內容
'標頭字段
昏暗的 Content_Disposition、FormFieldName、SourceFileName、Content_Type
'幫助變數
昏暗字段，TwoCharsAfterEndBoundary
'取得標題末尾
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'分隔欄位標頭
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'分隔欄位內容
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'將標頭欄位與標頭分開
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'建立一個欄位並指派參數
設定欄位 = CreateUploadField()
欄位名稱 = 表單欄位名稱
欄位.ContentDisposition = Content_Disposition
欄位.檔案路徑 = 來源檔案名
欄位.檔名 = GetFileName(來源檔名)
欄位.ContentType = Content_Type
欄位.值 = 欄位內容
字段.長度 = LenB(字段內容)

Fields.Add FormFieldName, Field

'這是結束邊界嗎？
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(邊界), 2))
'Binary.Mid(PosCloseBoundary + Len(邊界), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
如果不是 isLastBoundary 那麼 '這不是結束邊界 - 轉到下一個表單欄位。
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(邊界)，二進制，邊界 )
結束如果
環形
設定分離字段 = 字段
結束功能

************************************* 實用程式********* *** **********************
函數 BinaryToString(str)
strto=“”
對於 i=1 到 lenb(str)
如果 AscB(MidB(str, i, 1)) > 127 那麼
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
我=我+1
別的
strto = strto & Chr(AscB(MidB(str, i, 1)))
結束如果
下一個
BinaryToString=strto
結束函數

Function StringToBinary(String)
昏暗的我，B
對於 I=1 到 len(字串)
B = B & ChrB(Asc(Mid(String,I,1)))
下一個
字串轉二進位 = B
End Function

'將標頭欄位與上傳標頭分開
函數 GetHeadFields(ByVal Head、Content_Disposition、名稱、檔案名稱、Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "內容處置：", ";"))
名稱 = (SeparateField(Head, "name=", ";")) 'ltrim
如果 Left(Name, 1) = """" 則 Name = Mid(Name, 2, Len(Name) - 2)
檔案名稱 = (SeparateField(Head, "filename=", ";")) 'ltrim
如果 Left(FileName, 1) = """" 則 FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "內容類型：", ";"))
End Function

'在 sStart 和 sEnd 之間分隔一個字段
函數SeparateField(From、ByVal sStart、ByVal sEnd)
調暗 PosB、PosE、sFrom
sFrom = LCase(來自)
PosB = InStr(sFrom, sStart)
如果 PosB > 0 則
PosB = PosB + Len(sStart)
PosE = InStr(PosB, sFrom, sEnd)
如果 PosE = 0 則 PosE = InStr(PosB, sFrom, vbCrLf)
如果 PosE = 0 則 PosE = Len(sFrom) + 1
分離字段 = Mid(From, PosB, PosE - PosB)
別的
分離欄位 = 空
結束如果
End Function

'將檔案名稱與檔案的完整路徑分開
函數 GetFileName(完整路徑)
暗淡 Pos、PosF
正F = 0
對於 Pos = Len(FullPath) 到 1 步驟 -1
選擇案例中（FullPath，Pos，1）
情況「/」、「」：PosF = Pos + 1：Pos = 0
結束選擇
下一個
如果 PosF = 0 則 PosF = 1
GetFileName = Mid(完整路徑, PosF)
結束功能
</腳本>
<SCRIPT RUNAT=伺服器語言=JSCRIPT>
//函數建立Field物件。
函數 CreateUploadField(){ 傳回新的 uf_Init() }
函數 uf_Init(){
這個.Name = null
this.ContentDisposition = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
</SCRIPT>

addphoto.asp



<%
如果 Request.ServerVariables("REQUEST_METHOD") = "POST" 那麼
昏暗的田野
上傳大小限制=100000
設定欄位 = GetUpload()
昏暗的場
對於 Fields.Items 中的每個字段
選擇案例 Field.name
案例“thetext” sss=BinaryToString(Field.value)
案例「類型」fff=BinaryToString(Field.value)
案例「提交」submit=BinaryToString(Field.value)
案例“圖片”
文件名=字段.文件名
文件內容類型=欄位.內容類型
文件值=欄位.值
結束選擇
下一個
'----------------
如果 filename<>"" 和 fileContentType<>"image/gif" 和

fileContentType<>"image/pjpeg" 那麼
%>
<中心>
<br><br>
<font color=red size=3>上傳的照片應該是GIF或JPG檔！
<input type="button" value="重填" onclick="history.go( -1 );return

true;">
</中心>
<%
別的
'------------
'開始輸入
'------------
回應.write sss
回應.write"<br>"
回應.write fff
設定 rs=server.createobject("ADODB.recordset")
sql = "從 tb 中選擇 *，其中 id 為空"
rs.打開sql,conn,3,3
rs.addnew
rs("作者")=用戶名
rs("文本")=sss
rs("類型")=fff
rs("點擊數")=1
rs("posttime")=now()
rs("photo").appendchunk 檔案值

rs.update
rs.close
%>
<br><br>
<center><font color=red

size=3>成功輸入個人基本檔案！</font><br><br><form method="post"

action="personinf.asp"><input type="submit"值=“返回”></形式>
</中心>
<%
結束如果
結束如果
%>

顯示圖片.asp

<%
id=請求（“id”）
設定 rs=server.CreateObject("adodb.recordset")
sql="SELECT * FROM tb where theid="&id
rs.打開sql,conn,1,3
回應.contenttype =“圖片/gif”
Response.BinaryWrite rs(“照片”)
%>