模板
教程
环境
性能
功能
管理
以前搜集的一些资料---如何建立自己的上传组件的编程思路
发表于：2007-06-30来源：作者：点击数：
标签：
在上次贴出的文章中我提到了几种上载组件的比较 现在我们自己动手，丰衣足食，来建立自己的上载组件 这个上载组件应该具备以下功能： 1。应该能够接受各种HTML的form元素中传过来的数值，而不 用知道是通过text或则select传过来的 2。应该能够给出一个上载路
在上次贴出的文章中我提到了几种上载组件的比较现在我们自己动手，丰衣足食，来建立自己的上载组件
这个上载组件应该具备以下功能：
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
