以前搜集的一些资料---如何建立自己的上传组件的编程思路
关键词：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 explicitResponse.Buffer = TrueOn Error Resume NextIf 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 IfEnd If%>现在使用VB6开发这个ActiveX控件：(要注意的是，由于本人比较懒，中间有些代码可能不完整，但重要的是要理解这个组件的编程思路)1。引用Active Server Pages Object library. 2。代码如下：Option ExplicitPrivate MyScriptingContext As ScriptingContextPrivate MyRequest As RequestPrivate MyResponse As RequestPrivate Const ERR_NO_FILENAME As Long = vbObjectError + 100Private Const ERR_NO_EXTENSION As Long = vbObjectError + 101Private Const ERR_EMPTY_FILE As Long = vbObjectError + 102Private Const ERR_FILESIZE_NOT_ALLOWED As Long = vbObjectError + 103Private Const ERR_FOLDER_DOES_NOT_EXIST As Long = vbObjectError + 104Private Const ERR_FILE_ALREADY_EXISTS As Long = vbObjectError + 105Public Sub OnStartPage(PassedScriptingContext As ScriptingContext) Set MyScriptingContext = PassedScriptingContext Set MyRequest = MyScriptingContext.Request Set MyResponse = MySriptingContext.ResponseEnd SubPrivate 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 FunctionPrivate 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 FunctionPrivate Sub WriteFile(ByVal strUploadPath As String, ByVal strFileName As String, _ ByVal lngFileLength As Long)End SubPublic 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 FunctionDoUpload_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 Acceptor2.如果你要实现对网站的解决方案，使用ASPUpload或则SA-FileUp，当然你还可以自己动手编程
