"2" align = "right"> td> tr> table> form> body> html> ** Note: Using ENCTYPE = "Multipart / Form-Data" is to allow Form to submit one Document 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 The Response.write component is not installed correctly.
"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 IFEEND IF%> Now develop this ActiveX control now: (Be noteworthy, because I am lazy, some code may be incomplete, but it is important to understand the programming idea of this component) 1 Quote Active Server Pages Object Library. 2.
Code is as follows: 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 (STRFI lePath, 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 Ten 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) = "No input to the file name you need to submit." Case err_no_extension Arrerror (0, 1) = "file extension error." Case Err_empty_file arrerror (0, 1) = "The length of the file you want to upload is 0. "Case Err_FILESIZE_NOT_ALLOWED Arrerror (0, 1) =" Total Upload [& lngFileLength & _ "] bytes exceeds the maximum allowable requirements [" & _ LNGMAXFILEBYTES & "]." "CASE ERR_FOLDER_DOES_NOT_EXIST Arrerror (0, 1) =" Uploaded directory does not exist. "CASE ERR_FILE_ALREADY_EXISTS Arrerror (0, 1) =" file ["& strfilename &"] already exists. "Case Else Arrerror (0, 1) = err.description end select dolpload = arrerror () End function Some information for previously collected components - related comparisons and descriptions
Keywords: ASP
转载请注明原文地址:https://www.9cbs.com/read-1564.html