建立自己的上傳元件的程式設計思路 (轉)[@more@]

以前蒐集的一些資料---如何建立自己的的思路

關鍵詞：

在上次貼出的文章中我提到了幾種上載元件的比較
現在我們自己動手，豐衣足食，來建立自己的上載元件
這個上載元件應該具備以下功能：
1。應該能夠接受各種HTML的form元素中傳過來的數值，而不
用知道是透過text或則傳過來的
2。應該能夠給出一個上載路徑
3。應該能夠限制上載的大小
4。應該能夠支援多個檔案同時上載
5。應該能夠處理異常錯誤
6。應該能夠工作穩定
7。應該能夠不厚此薄彼（即能夠同時工作在IE和scape中）
8。能夠把檔案儲存在中
9。應該能夠限制

程式碼和檔案如下所示（老規矩，我就不作詳細解釋了）
1。.htm

Upload

作者
檔案

**注意：使用ENCTYPE="multipart/form-data"是為了能夠讓form提交一個檔案

2。Upload.asp

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:inetpubwwwupload"
Set objUpload = Server.Create("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) & "
"
Next

End If
End If
%>

現在使用開發這個：(要注意的是，由於本人比較懶，中間有些程式碼可能不完整，
但重要的是要理解這個元件的程式設計思路)
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 intPAs 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 = Mi(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 ile = 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。的 Posting Acceptor元件
該元件使用IS這個不用註冊的DLL，FORM提交後發給這個dll,該元件
能夠將檔案寫入指定目錄，同時能夠redirect到下一頁面。
當然你必須要對寫入的
目錄具有寫入的許可權，所以一般用它在win95+pws下透過的一放到NT上來
就會出現錯誤，因為它不理解NT的許可權和機制。這就意味著不是所有的人都能夠
隨便上載檔案甚至根本就沒人能夠上載檔案。
其次，它不支援把檔案寫入到資料庫中。所以如果你想擁有這個功能，你就需要
使用VB6來開發自己的元件。
再則，它的幫助少得可憐，你還不能夠限制上載檔案的大小，以及設定使用者的許可權
總之，它除了能夠完成把檔案儲存下來的功能外一無是處。
2。Persits Software的 ASPUpload元件
這是一個功能很強大的COM元件，但如果要使用它的完全版需要交費。
它能夠實現以下功能：
a.限制上載檔案的大小
b.設定使用者的許可權
c.修改檔案屬性
d.同時上載多個檔案
e.能夠將檔案儲存到資料庫中
f.支援檔案刪除，自動生成與上檔案不同名的檔案
g.擁有管理許可權的使用者甚至可以使用該控制元件進行註冊
3。Software Artisans的SA-FileUp 元件
這是最貴和功能最強大的檔案上載元件了。
它的完全版本具備以下功能：
1。完整的文件，包括豐富的例子程式
2。給檔案上載提供了完善的機制
3。使用ADO方式寫入資料庫，它還支援 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，當然你還
可以自己動手程式設計

建立自己的上傳元件的程式設計思路 (轉)

相關文章