以前蒐集的一些資料---如何建立自己的上傳組件的編程思路
關鍵詞：ASP
在上次貼出的文章中我提到了幾種上載組件的比較
現在我們自己動手，豐衣足食，來建立自己的上載組件
這個上載組件應該具備以下功能：
1。應該能夠接受各種HTML的form元素中傳過來的數值，而不
用知道是通過text或則select傳過來的
2。應該能夠給出一個上載路徑
3。應該能夠限制上載文件的大小
4。應該能夠支持多個文件同時上載
5。應該能夠處理異常錯誤
6。應該能夠工作穩定
7。應該能夠不厚此薄彼（即能夠同時工作在IE和Netscape中）
8。能夠把文件保存在數據庫中
9。應該能夠限制用戶權限
代碼和文件如下所示（老規矩，我就不作詳細解釋了）
1。Upload.htm
<HTML>
<HEAD><TITLE>Upload</TITLE></HEAD>
<BODY>
<FORM NAME="frmUpload" METHOD="Post" ENCTYPE="multipart/form-data" ACTION="Upload.asp"> <TABLE>
<TR><TD>作者</TD><TD><INPUT TYPE="text" NAME="txtAuthor"></TD></TR>
<TR><TD>文件</TD><TD><INPUT TYPE="file" NAME="txtFileName"></TD></TR>
<TR><TD COLSPAN="2" ALIGN="right"><INPUT TYPE="Submit" VALUE="Upload"></TD></TR>
</TABLE>
</FORM>
</BODY>
</HTML>
**注意：使用ENCTYPE="multipart/form-data"是爲了能夠讓form提交一個文件
2。Upload.asp
<%@ Language=VBScript %>
<%
Option explicit
Response.Buffer = True
On Error Resume Next
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
Dim objUpload
Dim lngMaxFileBytes
Dim strUploadPath
Dim varResult
lngMaxFileBytes = 10000
strUploadPath = "c:/inetpub/wwwroot/upload/"
Set objUpload = Server.CreateObject("pjUploadFile.clsUpload")
If Err.Number <> 0 Then
Response.Write "組件沒有安裝正確。"
Else
varResult = objUpload.DoUpload (lngMaxFileBytes, strUploadPath)
Set objUpload = Nothing
Dim i
For i = 0 to UBound(varResult,1)
Response.Write varResult(i,0) & " : " & varResult(i,1) & "<br>"
Next
End If
End If
%>
現在使用VB6開發這個ActiveX控件：(要注意的是，由於本人比較懶，中間有些代碼可能不完整，
但重要的是要理解這個組件的編程思路)
1。引用Active Server Pages Object library.
2。代碼如下：
Option Explicit
Private MyScriptingContext As ScriptingContext
Private MyRequest As Request
Private MyResponse As Request
Private Const ERR_NO_FILENAME As Long = vbObjectError + 100
Private Const ERR_NO_EXTENSION As Long = vbObjectError + 101
Private Const ERR_EMPTY_FILE As Long = vbObjectError + 102
Private Const ERR_FILESIZE_NOT_ALLOWED As Long = vbObjectError + 103
Private Const ERR_FOLDER_DOES_NOT_EXIST As Long = vbObjectError + 104
Private Const ERR_FILE_ALREADY_EXISTS As Long = vbObjectError + 105
Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)
Set MyScriptingContext = PassedScriptingContext
Set MyRequest = MyScriptingContext.Request
Set MyResponse = MySriptingContext.Response
End Sub
Private Function GetFileName(strFilePath) As String
Dim intPos As Integer
GetFileName = strFilePath
For intPos = Len(strFilePath) To 1 Step -1
If Mid(strFilePath, intPos, 1) = "/" Or Mid(strFilePath, intPos, 1) = ":" Then
GetFileName = Right(strFilePath, Len(strFilePath) - intPos)
Exit Function
End If
Next
End Function
Private Function CheckFileExtension(strFileName) As Boolean
Dim strFileExtension As String
If InStr(strFileName, ".") Then
strFileExtension = Mid(strFileName, InStrRev(strFileName, ".") + 1)
If Len(strFileExtension) < 3 Then
CheckFileExtension = False
Else
CheckFileExtension = True
End If
Else
CheckFileExtension = False
End If
End Function
Private Sub WriteFile(ByVal strUploadPath As String, ByVal strFileName As String, _
ByVal lngFileLength As Long)
End Sub
Public Function DoUpload (ByVal lngMaxFileBytes As Long, _
ByVal strUploadPath As String) As Variant
Dim varByteCount As Variant
Dim varHTTPHeader As Variant
Dim lngFileLength As Long
Dim arrError(0, 1) As Variant
On Error GoTo DoUpload_Err
varByteCount = MyRequest.TotalBytes
varHTTPHeader = StrConv(MyRequest.BinaryRead(varByteCount), vbUnicode)
MyResponse.Write varHTTPHeader
Dim intFormFieldCounter As Integer
intFormFieldCounter = Len(varHTTPHeader) - Len(Replace(varHTTPHeader, "; name=", Mid("; name=", 2)))
ReDim arrFormFields(intFormFieldCounter - 1, 1) As Variant
For i = 0 To intFormFieldCounter - 1
lngFormFieldNameStart = InStrB(lngFormFieldNameStart + 1, varHTTPHeader, "; name=" & Chr(34))
lngFormFieldNameEnd = InStrB(lngFormFieldNameStart + _
Len(StrConv("; name=" & Chr(34), vbUnicode)), varHTTPHeader, Chr(34)) _
+ Len(StrConv(Chr(34), vbUnicode))
strFormFieldName = MidB(varHTTPHeader, lngFormFieldNameStart, lngFormFieldNameEnd - lngFormFieldNameStart)
strFormFieldName = Replace(strFormFieldName, "; name=", vbNullString)
strFormFieldName = Replace(strFormFieldName, Chr(34), vbNullString)
If MidB(varHTTPHeader, lngFormFieldNameEnd, 2) = ";" Then
lngFormFieldValueStart = InStrB(lngFormFieldNameEnd, varHTTPHeader, "filename=" & Chr(34))
lngFormFieldValueEnd = InStrB(lngFormFieldValueStart + Len(StrConv("filename=" & Chr(34), vbUnicode)), varHTTPHeader, Chr(34))
strFileName = MidB(varHTTPHeader, lngFormFieldValueStart, lngFormFieldValueEnd - lngFormFieldValueStart)
strFileName = Mid(strFileName, InStr(strFileName, "=") + 2, Len(strFileName) - InStr(strFileName, "="))
strFileName = Replace(strFileName, Chr(34), vbNullString)
Else
lngFormFieldValueStart = lngFormFieldNameEnd
lngFormFieldValueEnd = InStrB(lngFormFieldValueStart, varHTTPHeader, varDelimeter)
strFormFieldValue = MidB(varHTTPHeader, lngFormFieldValueStart, lngFormFieldValueEnd - lngFormFieldValueStart)
strFormFieldValue = Replace(strFormFieldValue, vbCrLf, vbNullString)
lngFormFieldNameStart = lngFormFieldValueEnd
End If
arrFormFields(i, 0) = strFormFieldName
arrFormFields(i, 1) = strFormFieldValue
strFileName = GetFileName(strFileName)
If Len(strFileName) = 0 Then
Err.Raise ERR_NO_FILENAME
End If
If Not CheckFileExtension(strFileName) Then
Err.Raise ERR_NO_EXTENSION
End If
lngFileDataStart = InStr(InStr(varHTTPHeader, strFileName), varHTTPHeader, vbCrLf & vbCrLf) + 4
lngFileDataEnd = InStr(lngFileDataStart, varHTTPHeader, varDelimeter)
lngFileLength = lngFileDataEnd-lngFileDataStart
If lngFileLength <= 2 Then
Err.Raise ERR_EMPTY_FILE
End If
If Not lngMaxFileBytes = 0 Then
If lngMaxFileBytes < lngFileLength Then
Err.Raise ERR_FILESIZE_NOT_ALLOWED
End If
End If
If Not fs.FolderExists(strUploadPath) Then
Err.Raise ERR_FOLDER_DOES_NOT_EXIST
End If
If fs.FileExists(strUploadPath & strFileName) Then
Err.Raise ERR_FILE_ALREADY_EXISTS
End If
Set sFile = fs.CreateTextFile(strUploadPath & strFileName, True)
sFile.Write varContent , lngFileDataStart, lngFileLength
Close File
sFile.Close
Set sFile = Nothing
Set fs = Nothing
Next
DoUpload = ""
Exit Function
DoUpload_Err:
arrError(0, 0) = "Error"
Select Case Err.Number
Case ERR_NO_FILENAME
arrError(0, 1) = "沒有輸入需要提交的文件名。"
Case ERR_NO_EXTENSION
arrError(0, 1) = "文件擴展名出錯。"
Case ERR_EMPTY_FILE
arrError(0, 1) = "你要上載的文件長度爲0。"
Case ERR_FILESIZE_NOT_ALLOWED
arrError(0, 1) = "總共要上傳 [" & lngFileLength &_
"] 字節超過了允許的最大要求 [" &_
lngMaxFileBytes & "]."
Case ERR_FOLDER_DOES_NOT_EXIST
arrError(0, 1) = "上傳的目錄不存在。"
Case ERR_FILE_ALREADY_EXISTS
arrError(0, 1) = "文件 [" & strFileName & "] 已經存在了。"
Case Else
arrError(0, 1) = Err.Description
End Select
DoUpload = arrError()
End Function
以前蒐集的一些資料---有關文件上傳組件的一些比較和說明
關鍵詞：ASP
介紹現在比較常用的三種上載組件：
這三種組件都允許用戶使用IE3.02以上和Netscape2.0以上版本上載文件
1。Microsoft的 Posting Acceptor組件
該組件使用ISAPI這個不用註冊的DLL，FORM提交後發給這個dll,該組件
能夠將文件寫入指定目錄，同時能夠redirect到下一頁面。
當然你必須要對寫入的
目錄具有寫入的權限，所以一般用它在win95+pws下通過的程序一放到NT上來
就會出現錯誤，因爲它不理解NT的權限和SSL機制。這就意味着不是所有的人都能夠
隨便上載文件甚至根本就沒人能夠上載文件。
其次，它不支持把文件寫入到數據庫中。所以如果你想擁有這個功能，你就需要
使用VB6來開發自己的組件。
再則，它的幫助少得可憐，你還不能夠限制上載文件的大小，以及設置用戶的權限
總之，它除了能夠完成把文件保存下來的功能外一無是處。
2。Persits Software的 ASPUpload組件
這是一個功能很強大的COM組件，但如果要使用它的完全版需要交費。
它能夠實現以下功能：
a.限制上載文件的大小
b.設置用戶的權限
c.修改文件屬性
d.同時上載多個文件
e.能夠將文件保存到數據庫中
f.支持文件刪除，自動生成與服務器上文件不同名的文件
g.擁有管理權限的用戶甚至可以使用該控件進行遠程註冊
3。Software Artisans的SA-FileUp 組件
這是最貴和功能最強大的文件上載組件了。
它的完全版本具備以下功能：
1。完整的文檔，包括豐富的例子程序
2。給文件上載提供了完善的安全機制
3。使用ADO方式寫入數據庫，它還支持VB Web class
總結如下：
Feature Posting Acceptor ASPUpload SA-FileUp
單用戶 Free $99 $129
完全版 Free $300 $1,999
簡單Form提交 Yes Yes Yes
多文件上傳 No Yes Yes
和ASP結合程度 No Yes Yes
是否能夠處理文件 No Yes Yes
是否支持數據庫插入操作No Yes Yes
是否支持ADO NO Yes No
是否有對ACL的處理 No Yes Yes
是否支持對文件加密 No No Yes
是否支持自動安裝 No No Yes
在線幫助 很少 充分 多方面的
例子程序 很少 一些 很多
在線幫助 很少 好 很好
建議：
1。如果你僅僅是想練手，可以使用Posting Acceptor
2.如果你要實現對網站的解決方案，使用ASPUpload或則SA-FileUp，當然你還
可以自己動手編程