第七天：實現附加功能

今天，我們就來實現昨天提出的方法和屬性，來完善我們的文件上傳類。以前沒有太注意的性能問題，這一次也要徹底的解決：
1。所有的變量先聲明，后使用；
2。設置類的teminate方法；
3。簡化有些地方的寫法，注意細節。
我們的原則，就是先實現，后優化。當然，象變量聲明這樣的東西，如果程序很大，最好還是在寫程序的時候一次過。如果寫完了才加，可以在頁面開頭加上option explicit（強制變量聲明），然后測試所有的方法和屬性，直到沒有錯誤為止。

另外，異常代碼我們也整理一下：
代碼 類名 類型 描述
==============================================================================
11 FormElement IndexOutOfBound 表單元素子集索引越界
12 FormElement IllegalArgument 非法的表單元素子集索引
21 UploadRequest IndexOutOfBound 文本元素索引越界
22 UploadRequest IllegalArgument 非法的文本元素索引
23 UploadRequest IndexOutOfBound 文件元素索引越界
24 UploadRequest NullRef 文件元素索引不存在
25 UploadRequest IllegalArgument 非法的表單元素索引
26 UploadRequest TooLargeFile 文件%fldname尺寸過大
27 UploadRequest TooLargeFiles 文件總尺寸過大
28 UploadRequest InvalidFileType 文件%fldname類型錯誤

好了，下面的，就是我們的整個實現了：
1。com.2yup.util.uploadrequest.class
<%
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 沒有版權，歡迎拷貝或是作為商業用途。
' 如果要轉載，能注明出處最好，我們會很感激您的支持；如果不方便，就算了，呵呵。
' 感謝各位常來2yup的網友（很多名字，寫不下了，呵呵）長期熱情的支持，
' 你們是我持久的動力。
'
' 關于這個組件的詳細信息，以及編程的全過程，可以來
' http://www.2yup.com/asp
' 的文檔中心看個究竟。有任何疑問，歡迎來我們的論壇討論，或是給我發email：
' miles2yup@hotmail.com
' ---- Miles [Yup Studio] ^ ^
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'=========================================================================
'' 這個，是存儲文本域信息的的類。每一個name的文本域，對應一個這樣的類。
'=========================================================================
Class FormElement

' m_開頭，表示類成員變量。
Private m_dicItems

Private Sub Class_Initialize()
Set m_dicItems = Server.CreateObject("Scripting.Dictionary")
End Sub

' set nothing時激發。清理資源
Private Sub Class_Terminate()
Set m_dicItems = Nothing
End Sub

' count是咱們這個類的一個只讀屬性
Public Property Get Count()
Count = m_dicItems.Count
End Property

' Value是一個默認屬性。目的是得到值
Public Default Property Get Value()
Value = Item("")
End Property

' Name是得到文本域名稱。就是<input name=xxx>里的xxx
Public Property Get Name()
Dim Keys
Keys = m_dicItems.Keys
Name = Keys(0)
Name = left(Name,instrrev(Name,"_")-1)
End Property

' Item屬性用來得到重名表單域（比如checkbox）的某一個值
Public Property Get Item(index)
Dim Items, i
If isNumeric(index) Then '是數字，合法！
If index > m_dicItems.Count-1 Then
err.raise 11,"IndexOutOfBound", "表單元素子集索引越界"
End If
Items = m_dicItems.Items
Item = Items(index)
ElseIf index = "" Then '沒給值？那就返回所有的！逗號分隔
Items = m_dicItems.Items
For i = 0 to m_dicItems.Count-1
If i = 0 Then
Item = Items(0)
Else
Item = Item & "," & Items(i)
End If
Next
Else '給個一個不是數字的東東？出錯！
err.raise 12,"IllegalArgument", "非法的表單元素子集索引"
End If
End Property

Public Sub Add(key, item)
m_dicItems.Add key, item
End Sub

End Class

'=========================================================================
'' 這個，是存儲文件域信息的的類。每一個name的文件，對應一個這樣的類。
'=========================================================================
Class FileElement

' m_開頭，表示類成員變量。
Private m_strName
Private m_bData
Private m_bRawData
Private m_strContentType
Private m_strFilePath
Private m_strFileName
Private m_lSize

' Data是一個默認屬性。目的是得到值
Public Default Property Get Data()
Data = m_bData
End Property

' 這個屬性很尷尬——stream對象write方法要求的數據類型是
' "A Variant that contains an array of bytes to be written."
' 但是我卻無法從一個二進制串中得到這個數據類型！的確很奇怪。所以，我打算
' 使用符合要求的原始數據m_bRawData。但是，vbs的類功能少得可憐，既不能傳遞
' 當前對象的引用來回訪UploadRequest的m_bRawData也不能用inner class的方
' 法進行組織。為了保持方法的簡潔，所以加了這個只寫的RawData屬性。
' 這個地方很值得改進。
Public Property Let RawData(data)
m_bRawData = data
End Property

' Name是得到文件域名稱，就是<input type=file name=xxx>里的xxx
Public Property Get Name()
Name = m_strName
End Property

' ContentType是得到文件contentType
Public Property Get ContentType()
ContentType = m_strContentType
End Property

' FilePath是得到文件在客戶端的路徑
Public Property Get FilePath()
FilePath = m_strFilePath
End Property

' FilePath是得到文件在客戶端的路徑
Public Property Get FileName()
FileName = m_strFileName
End Property

' Size是得到文件大小
Public Property Get Size()
Size = m_lSize
End Property

Public Sub Add(name, data, contenttype, path)
m_strName = name
m_bData = data
m_strContentType = contenttype
m_strFilePath = path
m_strFileName = right(path, len(path)-instrrev(path, "\"))
m_lSize = lenb(data)
End Sub

Public Sub SaveTo(path)
Call SaveAs(path, m_strFileName)
End Sub

Public Sub SaveAs(path, name)
Call Save(path, name, True)
End Sub

Public Sub SaveWithoutOverwrite(path, name)
Call Save(path, name, False)
End Sub

Private Sub Save(path, name, isOverwrite)
Dim st, st2
'這樣就可以兼顧c:\xxx\和c:\xxx兩種格式了
If right(path,1) <> "\" Then path = path & "\"
'用兩個stream對象，來截取我們要的內容
Set st = Server.CreateObject("ADODB.Stream")
Set st2 = Server.CreateObject("ADODB.Stream")
st.Type = 1
st.open
st2.Type = 1
st2.open
st.write m_bRawData
st.Position = instrb(m_bRawData,m_bData)-1
st.copyto st2, m_lSize

If isOverwrite Then '覆蓋保存
st2.SaveToFile path & name,2
Else '不覆蓋
st2.SaveToFile path & name
End If

st.Close
Set st = Nothing
st2.Close
Set st2 = Nothing
End Sub

End Class

'=========================================================================
'' 這個，是我們模擬的request類。我們用它完成asp的request完成不了的任務 :)
'=========================================================================
Class UploadRequest

Private m_dicForms
Private m_dicFiles
Private m_bRawData
Private m_lTotalBytes
Private m_strAllowedFilesList
Private m_strDeniedFilesList
Private m_lMaxFileSize
Private m_lTotalMaxFileSize

'初始化類成員
Private Sub Class_Initialize()
m_lTotalBytes = 0
m_strAllowedFilesList = ""
m_strDeniedFilesList = ""
m_lMaxFileSize = -1
m_lTotalMaxFileSize = -1
End Sub

' set nothing時激發。清理資源
Private Sub Class_Terminate()
' 這些對象應該有自己的清理方法，咱就不管了
Set m_dicForms = Nothing
Set m_dicFiles = Nothing
End Sub

Public Sub Upload
Set m_dicForms = Server.CreateObject("Scripting.Dictionary")
Set m_dicFiles = Server.CreateObject("Scripting.Dictionary")
Call fill()
End Sub

'存文件到指定路徑
Public Sub SaveTo(path)
Dim fElement
'調用FileElement自己的方法
For Each fElement In m_dicFiles
Call m_dicFiles.Item(fElement).SaveTo(path)
Next
End Sub

' 有了這個，就可以檢查原始數據了
Public Property Get RawData()
RawData = m_bRawData
End Property

' 這一段丑陋的代碼是為了實現ourRequest.Forms.Count這個功能。這個地方值得改進。
Public Property Get Forms()
Set Forms = New Counter
Forms.setCount(m_dicForms.Count)
End Property

' 這一段丑陋的代碼是為了實現ourRequest.Files.Count這個功能。這個地方值得改進。
Public Property Get Files()
Set Files = New Counter
Files.setCount(m_dicFiles.Count)
End Property

'只讀的TotalBytes屬性
Public Property Get TotalBytes()
TotalBytes = m_lTotalBytes
End Property

'只寫的AllowedFilesList屬性，填入允許類型的擴展名，用|分隔
Public Property Let AllowedFilesList(afl)
m_strAllowedFilesList = afl
End Property

'只寫的DeniedFilesList屬性，填入允許類型的擴展名，用|分隔
Public Property Let DeniedFilesList(dfl)
m_strDeniedFilesList = dfl
End Property

'只寫的MaxFileSize屬性，填入各個允許上傳文件的大小
Public Property Let MaxFileSize(mfs)
m_lMaxFileSize = mfs
End Property

'只寫的TotalMaxFileSize屬性，填入允許上傳文件的總大小
Public Property Let TotalMaxFileSize(tmfs)
m_lTotalMaxFileSize = tmfs
End Property

Public Property Get Form(index)
Dim Items
If isNumeric(index) Then '是數字？用數字來檢索
If index > m_dicForms.Count-1 Then
err.raise 21,"IndexOutOfBound", "文本元素索引越界"
End If
Items = m_dicForms.Items
Set Form = Items(index)
ElseIf VarType(index) = 8 Then '字符串？也行！
If m_dicForms.Exists(index) Then '存在，就返回值
Set Form = m_dicForms.Item(index)
Else '不存在，就給個空值——request對象就是這么做的。
Exit Property
End If
Else '給了一個不是數字也不是字符串的東東？出錯！
err.raise 22,"IllegalArgument", "非法的文本元素索引"
End If
End Property

Public Property Get File(index)
Dim Items
If isNumeric(index) Then '是數字？用數字來檢索
If index > m_dicFiles.Count-1 Then
err.raise 23,"IndexOutOfBound", "文件元素索引越界"
End If
Items = m_dicFiles.Items
Set File = Items(index)
ElseIf VarType(index) = 8 Then '字符串？也行！
If m_dicFiles.Exists(index) Then '存在，就返回值
Set File = m_dicFiles.Item(index)
Else '不存在，出錯！
err.raise 24,"NullRef", "文件元素索引不存在"
End If
Else '給了一個不是數字也不是字符串的東東？出錯！
err.raise 25,"IllegalArgument", "非法的表單元素索引"
End If
End Property

Private Sub fill
' 得到數據
m_bRawData=request.binaryread(request.totalbytes)
' 調用這個函數實現遞歸循環，讀取文本/文件單元
Call fillEveryFirstPart(m_bRawData)
End Sub

Private Sub fillEveryFirstPart(data)
Dim const_nameis, const_filenameis, bncrlf, divider, startpos, endpos
Dim part1, firstline
Dim fldname, fldvalue, fElement, filepath, contenttype, ext, afl, dfl
Dim isTypeError, i

' 這就是name="
const_nameis=chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
' 這就是filename="
const_filenameis=chrb(102)&chrb(105)&chrb(108)&chrb(101)&_
chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
' 這是回車<return>
bncrlf=chrb(13) & chrb(10)
' 得到divider，分隔符
divider=leftb(data,instrb(data,bncrlf)-1)
' 起始位置
startpos = instrb(data,divider)+lenb(divider)+lenb(bncrlf)
' 終止位置，從起始位置開始到下一個divider
endpos = instrb(startpos, data, divider)-lenb(bncrlf)
If endpos < 1 Then '沒有下一個了！結束！
Exit Sub
End If
part1 = midb(data, startpos, endpos-startpos)
' 得到part1的第一行
firstline = midb(part1, 1, instrb(part1, bncrlf)-1)

'沒有filename="，有name="，說明是一個文本單元
'（這里有一個BUG，自己研究一下？當作業吧）
If Not instrb(firstline, const_filenameis) > 0_
And instrb(firstline, const_nameis) > 0 Then
' 得到表單域名稱，就是<input type=sometype name=somename>里的somename。
fldname = B2S(midb(part1,_
instrb(part1, const_nameis)+lenb(const_nameis),_
instrb(part1, bncrlf)_
-instrb(part1, const_nameis)-lenb(const_nameis)-1))
' 得到表單域的值
fldvalue = B2S(midb(part1,_
instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf),_
lenb(part1)-instrb(part1, bncrlf&bncrlf)+_
lenb(bncrlf&bncrlf)))
If m_dicForms.Exists(fldname) Then
Set fElement = m_dicForms.Item(fldname)
m_dicForms.Remove fldname
Else
Set fElement = new FormElement
End If

fElement.Add fldname&"_"&fElement.Count, fldvalue
m_dicForms.Add fldname, fElement

'有filename="，有name="，說明是一個文件單元
'（這里還是有一個BUG，研究出來沒？）
ElseIf instrb(firstline, const_filenameis) > 0_
And instrb(firstline, const_nameis) > 0 Then
' 得到表單域名稱，就是<input type=file name=somename>里的somename。
fldname = B2S(midb(part1,_
instrb(part1, const_nameis)+lenb(const_nameis),_
instrb(part1, const_filenameis)_
-instrb(part1, const_nameis)-lenb(const_nameis)-3))
' 得到表單域的值
fldvalue = midb(part1,_
instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf),_
lenb(part1)-instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf))
' 得到路徑
filepath = B2S(midb(part1,_
instrb(part1, const_filenameis)+lenb(const_filenameis),_
instrb(part1, bncrlf)_
-instrb(part1, const_filenameis)-lenb(const_filenameis)-1))
' 得到contenttype
contenttype = B2S(midb(part1,_
instrb(part1, bncrlf)+lenb(bncrlf)+14,_
instrb(part1,_
bncrlf&bncrlf)-instrb(part1, bncrlf)-_
lenb(bncrlf)-14))
If lenb(fldvalue) > 0 Then 'size>0說明有文件傳來了。
If m_dicFiles.Exists(fldname) Then
Set fElement = m_dicFiles.Item(fldname)
m_dicFiles.Remove fldname
Else
Set fElement = new FileElement
fElement.Rawdata = m_bRawData
End If

'檢查單個文件尺寸
If m_lMaxFileSize > 0 And m_lMaxFileSize < lenb(fldvalue) Then _
err.raise 26,"TooLargeFile", "文件"&fldname&"尺寸過大"
m_lTotalBytes = m_lTotalBytes + lenb(fldvalue)
'檢查文件總尺寸
If m_lTotalMaxFileSize > 0 And m_lTotalMaxFileSize < m_lTotalBytes Then
err.raise 27,"TooLargeFiles", "文件總尺寸過大"
End If
'檢查文件類型
ext = right(filepath, len(filepath)-instrrev(filepath, "."))
If m_strAllowedFilesList <> "" Then
afl = Split(m_strAllowedFilesList,"|")
isTypeError = True
For i = 0 To Ubound(afl)
'找到了，允許
If ucase(trim(ext)) = ucase(trim(afl(i))) Then
isTypeError = False
Exit For
End If
Next
If isTypeError Then _
err.raise 28,"InvalidFileType", "文件"&fldname&"類型錯誤"
End If
If m_strDeniedFilesList <> "" Then
dfl = Split(m_strDeniedFilesList,"|")
For i = 0 To Ubound(dfl)
'找到了，不允許
If ucase(trim(ext)) = ucase(trim(dfl(i))) Then _
err.raise 28,"InvalidFileType", "文件"&fldname&"類型錯誤"
Next
End If

fElement.Add fldname, fldvalue, contenttype, filepath
m_dicFiles.Add fldname, fElement
End If
End If

' 截取剩下的部分，遞歸調用這個函數，來得到下一個part1。
Call fillEveryFirstPart(rightb(data, lenb(data)-endpos-1))
End Sub

' 這是一個公用函數，作用是二進制和字符串的轉換
Private Function B2S(bstr)
Dim bchr, temp, i
If not IsNull(bstr) Then
for i = 0 to lenb(bstr) - 1
bchr = midb(bstr,i+1,1)
If ascb(bchr) > 127 Then '遇到了雙字節，就得兩個字符一起處理
temp = temp & chr(ascw(midb(bstr, i+2, 1) & bchr))
i = i+1
Else
temp = temp & chr(ascb(bchr))
End If
next
End If
B2S = temp
End Function

End Class

' 這是一個輔助類，為了實現ourRequest.Forms.Count功能。
Class Counter
Private m_iCnt

' count是咱們這個類的一個只讀屬性
Public Property Get Count()
Count = m_iCnt
End Property

Public Function setCount(cnt)
m_iCnt = cnt
End Function
End Class
%>


2。testform.html
<form action="doupload.asp" method=post enctype="multipart/form-data">
file1說明:<input type=text name=file1_desc>
file1:<input type=file name=file1><br>
file2說明:<input type=text name=file2_desc>
file2:<input type=file name=file2><br>
<input type=checkbox name=chk value=a>a
<input type=checkbox name=chk value=b>b
<input type=checkbox name=chk value=c>c
<input type=checkbox name=chk value=d>d
<input type=checkbox name=chk value=e>e<hr>
<input type=submit name=upload value=upload>
</form>


3。doupload.asp
<%Option Explicit%>
<!--#INCLUDE FILE="com.2yup.util.uploadrequest.class"-->

<%
'下面是測試碼
Dim ourRequest
set ourRequest = new UploadRequest
ourRequest.AllowedFilesList = "gif|doc"
ourRequest.DeniedFilesList = "jpg"
ourRequest.MaxFileSize = 10*1000 '10k
ourRequest.TotalMaxFileSize = 15*1000 '15k
on error resume next
ourRequest.Upload
if err.number <> 0 then
response.write err.description
response.end
end if
on error goto 0 '關閉on error resume next
%>

<%=ourRequest.Form(0).Name%>:<%=ourRequest.Form("file1_desc")%><br>
<%=ourRequest.Form(1).Name%>:<%=ourRequest.Form("file2_desc")%><br>
<%=ourRequest.Form(2).Name%>:<%=ourRequest.Form(2).Count%><br>
<%=ourRequest.Form(3).Name%>:<%=ourRequest.Form(3)%>

一共有<%=ourRequest.Forms.Count%>個文本單元<hr>

<%=ourRequest.File(0).Name%>:
<%=ourRequest.File("file1").ContentType%>:
<%=ourRequest.File("file1").Size%>byte:
<%=ourRequest.File("file1").FileName%>:
<%=ourRequest.File("file1").FilePath%><br>

<%=ourRequest.File(1).Name%>:
<%=ourRequest.File("file2").ContentType%>:
<%=ourRequest.File("file2").Size%>byte:
<%=ourRequest.File("file2").FileName%>:
<%=ourRequest.File("file2").FilePath%><br>

一共有<%=ourRequest.Files.Count%>個文件單元，共<%=ourRequest.TotalBytes%>Byte<hr>

<%
'測試存盤。
Dim desFolder:desFolder=server.mappath("incoming")
Call ourRequest.SaveTo(desFolder)
Call ourRequest.File(0).SaveAs(desFolder, "復件 "&ourRequest.File(0).FileName)
'因為選擇了不覆蓋的方法，所以第二次執行這一句會出錯，一定要注意啊
Call ourRequest.File("file2").SaveWithoutOverwrite(desFolder,_
"復件 "&ourRequest.File(1).FileName)
%>

<%
'測試寫庫
If False Then '要測的話，就把False改成True。

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 數據庫結構：
' ID 自增主鍵
' img access里，用ole對象型；在sql server里，就應該是image型了
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' 這部分沒啥好說的。。
Dim connGraph, rec
set connGraph=server.CreateObject("ADODB.connection")
connGraph.ConnectionString="driver={Microsoft Access Driver (*.mdb)};DBQ=" &_
server.MapPath("img.mdb")
connGraph.Open
set rec=server.createobject("ADODB.recordset")
rec.Open "SELECT * FROM img where id is null",connGraph,1,3
rec.addnew
rec("img").appendchunk ourRequest.File(0)
rec.update
rec.close
set rec=nothing
set connGraph=nothing

' 讀庫代碼如下。當然，讀庫顯示是要在其他頁面進行的。。
' 這部分也沒啥好說的。不用contentType，IE也認。要是其他瀏覽器，就設一下。
'set connGraph=server.CreateObject("ADODB.connection")
'connGraph.ConnectionString="driver={Microsoft Access Driver (*.mdb)};DBQ=" &_
' server.MapPath("img.mdb")
'connGraph.Open
'set rec=server.createobject("ADODB.recordset")
'rec.Open "SELECT * FROM img order by id desc",connGraph,1,1
'response.BinaryWrite rec("img")
'rec.close
'set rec=nothing
'set connGraph=nothing
End If
%>

<%
'清理資源，別忘了啊
Set ourRequest = Nothing
%>


好了，把這3個文件保存到一個虛擬目錄下，然后，建立一個incoming的子目錄，并且給足權限（關于權限，看看http://www.2yup.com/asp/forum/branch.asp?pid=2430#F0002430），就可以測試了。現在，一個功能強大的無組件上傳類就已經完成了。

==============================================================
結束語

這里演示了文件上傳從分析倒實踐的全過程。通過不懈的努力，我們終于達到了預定的目標。當然，這個實現，和“完美”尚有差距。他沒有經過嚴格測試；還存在至少兩個BUG；還有幾個蹩腳的實現。這些，都是值的改進的。但是，如果能掌握這個示例的完整過程，相信大家也可以勝任各種復雜的應用，能夠獨立的完成一般的設計和編碼工作了。所以，我們的收獲，絕不僅僅是知道了怎樣上傳一個文件，更多的，是知道了怎樣達到一個目標。最后，附上整個示例的源碼和用到的庫。剛剛（2002-12-02 09:00）才進行了更新，做了一個自認為比較清晰的例子。不需要看懂，就可以用了 ^ ^：

http://www.2yup.com/asp/attach/A0000006.zip

注意，把這個包里的東西放到一個虛擬目錄下，其中的incoming子目錄一定要有IUSR的寫權限（關于權限，看看http://www.2yup.com/asp/forum/branch.asp?pid=2430#F0002430）。有任何問題，請到論壇提出。