Modificare il file: \Admin\include\clsUpload.asp

<!--METADATA TYPE="TypeLib" NAME="Microsoft ActiveX Data Objects 2.5 Library" UUID="{00000205-0000-0010-8000-00AA006D2EA4}" VERSION="2.5" --> <!--#INCLUDE FILE="clsField.asp"--> <% ' ------------------------------------------------------------------------------ ' Author: Lewis Moten ' Email: Lewis@Moten.com ' URL: http://www.lewismoten.com ' Date: March 19, 2002 ' ------------------------------------------------------------------------------ ' Upload class retrieves multi-part form data posted to web page ' and parses it into objects that are easy to interface with. ' Requires MDAC (ADODB) COM components found on most servers today ' Additional compenents are not necessary. ' ' Demo: ' Set objUpload = new clsUpload ' Initializes object and parses all posted multi-part from data. ' Once this as been done, Access to the Request object is restricted ' ' objUpload.Count ' Number of fields retrieved ' ' use: Response.Write "There are " & objUpload.Count & " fields." ' ' objUpload.Fields ' Access to field objects. This is the default propert so it does ' not necessarily have to be specified. You can also determine if ' you wish to specify the field index, or the field name. ' ' Use: ' Set objField = objUpload.Fields("File1") ' Set objField = objUpload("File1") ' Set objField = objUpload.Fields(0) ' Set objField = objUpload(0) ' Response.Write objUpload("File1").Name ' Response.Write objUpload(0).Name ' ' ------------------------------------------------------------------------------ ' ' List of all fields passed: ' ' For i = 0 To objUpload.Count - 1 ' Response.Write objUpload(i).Name & "<BR>" ' Next ' ' ------------------------------------------------------------------------------ ' ' HTML needed to post multipart/form-data ' '<FORM method="post" encType="multipart/form-data" action="Upload.asp"> ' <INPUT type="File" name="File1"> ' <INPUT type="Submit" value="Upload"> '</FORM> Class clsUpload ' ------------------------------------------------------------------------------ Private mbinData ' bytes visitor sent to server Private mlngChunkIndex ' byte where next chunk starts Private mlngBytesReceived ' length of data Private mstrDelimiter ' Delimiter between multipart/form-data (43 chars) Private CR ' ANSI Carriage Return Private LF ' ANSI Line Feed Private CRLF ' ANSI Carriage Return & Line Feed Private mobjFieldAry() ' Array to hold field objects Private mlngCount ' Number of fields parsed ' ------------------------------------------------------------------------------ Private Sub RequestData Dim llngLength ' Number of bytes received ' Determine number bytes visitor sent mlngBytesReceived = Request.TotalBytes ' Store bytes recieved from visitor mbinData = Request.BinaryRead(mlngBytesReceived) End Sub ' ------------------------------------------------------------------------------ Private Sub ParseDelimiter() ' Delimiter seperates multiple pieces of form data ' "around" 43 characters in length ' next character afterwards is carriage return (except last line has two --) ' first part of delmiter is dashes followed by hex number ' hex number is possibly the browsers session id? ' Examples: ' -----------------------------7d230d1f940246 ' -----------------------------7d22ee291ae0114 mstrDelimiter = MidB(mbinData, 1, InStrB(1, mbinData, CRLF) - 1) End Sub ' ------------------------------------------------------------------------------ Private Sub ParseData() ' This procedure loops through each section (chunk) found within the ' delimiters and sends them to the parse chunk routine Dim llngStart ' start position of chunk data Dim llngLength ' Length of chunk Dim llngEnd ' Last position of chunk data Dim lbinChunk ' Binary contents of chunk ' Initialize at first character llngStart = 1 ' Find start position llngStart = InStrB(llngStart, mbinData, mstrDelimiter & CRLF) ' While the start posotion was found While Not llngStart = 0 ' Find the end position (after the start position) llngEnd = InStrB(llngStart + 1, mbinData, mstrDelimiter) - 2 ' Determine Length of chunk llngLength = llngEnd - llngStart ' Pull out the chunk lbinChunk = MidB(mbinData, llngStart, llngLength) ' Parse the chunk Call ParseChunk(lbinChunk) ' Look for next chunk after the start position llngStart = InStrB(llngStart + 1, mbinData, mstrDelimiter & CRLF) Wend End Sub ' ------------------------------------------------------------------------------ Private Sub ParseChunk(ByRef pbinChunk) ' This procedure gets a chunk passed to it and parses its contents. ' There is a general format that the chunk follows. ' First, the deliminator appears ' Next, headers are listed on each line that define properties of the chunk. ' Content-Disposition: form-data: name="File1"; filename="C:\Photo.gif" ' Content-Type: image/gif ' After this, a blank line appears and is followed by the binary data. Dim lstrName ' Name of field Dim lstrFileName ' File name of binary data Dim lstrContentType ' Content type of binary data Dim lbinData ' Binary data Dim lstrDisposition ' Content Disposition Dim lstrValue ' Value of field ' Parse out the content dispostion lstrDisposition = ParseDisposition(pbinChunk) ' And Parse the Name lstrName = ParseName(lstrDisposition) ' And the file name lstrFileName = ParseFileName(lstrDisposition) ' Parse out the Content Type lstrContentType = ParseContentType(pbinChunk) ' If the content type is not defined, then assume the ' field is a normal form field If lstrContentType = "" Then ' Parse Binary Data as Unicode lstrValue = CStrU(ParseBinaryData(pbinChunk)) ' Else assume the field is binary data Else ' Parse Binary Data lbinData = ParseBinaryData(pbinChunk) End If ' Add a new field Call AddField(lstrName, lstrFileName, lstrContentType, lstrValue, lbinData) End Sub ' ------------------------------------------------------------------------------ Private Sub AddField(ByRef pstrName, ByRef pstrFileName, ByRef pstrContentType, ByRef pstrValue, ByRef pbinData) Dim lobjField ' Field object class ' Add a new index to the field array ' Make certain not to destroy current fields ReDim Preserve mobjFieldAry(mlngCount) ' Create new field object Set lobjField = New clsField ' Set field properties lobjField.Name = pstrName lobjField.FilePath = pstrFileName lobjField.ContentType = pstrContentType ' If field is not a binary file If LenB(pbinData) = 0 Then lobjField.BinaryData = ChrB(0) lobjField.Value = pstrValue lobjField.Length = Len(pstrValue) ' Else field is a binary file Else lobjField.BinaryData = pbinData lobjField.Length = LenB(pbinData) lobjField.Value = "" End If ' Set field array index to new field Set mobjFieldAry(mlngCount) = lobjField ' Incriment field count mlngCount = mlngCount + 1 End Sub ' ------------------------------------------------------------------------------ Private Function ParseBinaryData(ByRef pbinChunk) ' Parses binary content of the chunk Dim llngStart ' Start Position ' Find first occurence of a blank line llngStart = InStrB(1, pbinChunk, CRLF & CRLF) ' If it doesn't exist, then return nothing If llngStart = 0 Then Exit Function ' Incriment start to pass carriage returns and line feeds llngStart = llngStart + 4 ' Return the last part of the chunk after the start position ParseBinaryData = MidB(pbinChunk, llngStart) End Function ' ------------------------------------------------------------------------------ Private Function ParseContentType(ByRef pbinChunk) ' Parses the content type of a binary file. ' example: image/gif is the content type of a GIF image. Dim llngStart ' Start Position Dim llngEnd ' End Position Dim llngLength ' Length ' Fid the first occurance of a line starting with Content-Type: llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Type:"), vbTextCompare) ' If not found, return nothing If llngStart = 0 Then Exit Function ' Find the end of the line llngEnd = InStrB(llngStart + 15, pbinChunk, CR) ' If not found, return nothing If llngEnd = 0 Then Exit Function ' Adjust start position to start after the text "Content-Type:" llngStart = llngStart + 15 ' If the start position is the same or past the end, return nothing If llngStart >= llngEnd Then Exit Function ' Determine length llngLength = llngEnd - llngStart ' Pull out content type ' Convert to unicode ' Trim out whitespace ' Return results ParseContentType = Trim(CStrU(MidB(pbinChunk, llngStart, llngLength))) End Function ' ------------------------------------------------------------------------------ Private Function ParseDisposition(ByRef pbinChunk) ' Parses the content-disposition from a chunk of data ' ' Example: ' ' Content-Disposition: form-data: name="File1"; filename="C:\Photo.gif" ' ' Would Return: ' form-data: name="File1"; filename="C:\Photo.gif" Dim llngStart ' Start Position Dim llngEnd ' End Position Dim llngLength ' Length ' Find first occurance of a line starting with Content-Disposition: llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Disposition:"), vbTextCompare) ' If not found, return nothing If llngStart = 0 Then Exit Function ' Find the end of the line llngEnd = InStrB(llngStart + 22, pbinChunk, CRLF) ' If not found, return nothing If llngEnd = 0 Then Exit Function ' Adjust start position to start after the text "Content-Disposition:" llngStart = llngStart + 22 ' If the start position is the same or past the end, return nothing If llngStart >= llngEnd Then Exit Function ' Determine Length llngLength = llngEnd - llngStart ' Pull out content disposition ' Convert to Unicode ' Return Results ParseDisposition = CStrU(MidB(pbinChunk, llngStart, llngLength)) End Function ' ------------------------------------------------------------------------------ Private Function ParseName(ByRef pstrDisposition) ' Parses the name of the field from the content disposition ' ' Example ' ' form-data: name="File1"; filename="C:\Photo.gif" ' ' Would Return: ' File1 Dim llngStart ' Start Position Dim llngEnd ' End Position Dim llngLength ' Length ' Find first occurance of text name=" llngStart = InStr(1, pstrDisposition, "name=""", vbTextCompare) ' If not found, return nothing If llngStart = 0 Then Exit Function ' Find the closing quote llngEnd = InStr(llngStart + 6, pstrDisposition, """") ' If not found, return nothing If llngEnd = 0 Then Exit Function ' Adjust start position to start after the text name=" llngStart = llngStart + 6 ' If the start position is the same or past the end, return nothing If llngStart >= llngEnd Then Exit Function ' Determine Length llngLength = llngEnd - llngStart ' Pull out field name ' Return results ParseName = Mid(pstrDisposition, llngStart, llngLength) End Function ' ------------------------------------------------------------------------------ Private Function ParseFileName(ByRef pstrDisposition) ' Parses the name of the field from the content disposition ' ' Example ' ' form-data: name="File1"; filename="C:\Photo.gif" ' ' Would Return: ' C:\Photo.gif Dim llngStart ' Start Position Dim llngEnd ' End Position Dim llngLength ' Length ' Find first occurance of text filename=" llngStart = InStr(1, pstrDisposition, "filename=""", vbTextCompare) ' If not found, return nothing If llngStart = 0 Then Exit Function ' Find the closing quote llngEnd = InStr(llngStart + 10, pstrDisposition, """") ' If not found, return nothing If llngEnd = 0 Then Exit Function ' Adjust start position to start after the text filename=" llngStart = llngStart + 10 ' If the start position is the same of past the end, return nothing If llngStart >= llngEnd Then Exit Function ' Determine length llngLength = llngEnd - llngStart ' Pull out file name ' Return results ParseFileName = Mid(pstrDisposition, llngStart, llngLength) End Function ' ------------------------------------------------------------------------------ Public Property Get Count() ' Return number of fields found Count = mlngCount End Property ' ------------------------------------------------------------------------------ Public Default Property Get Fields(ByVal pstrName) Dim llngIndex ' Index of current field ' If a number was passed If IsNumeric(pstrName) Then llngIndex = CLng(pstrName) ' If programmer requested an invalid number If llngIndex > mlngCount - 1 Or llngIndex < 0 Then ' Raise an error Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.") Exit Property End If ' Return the field class for the index specified Set Fields = mobjFieldAry(pstrName) ' Else a field name was passed Else ' convert name to lowercase pstrName = LCase(pstrname) ' Loop through each field For llngIndex = 0 To mlngCount - 1 ' If name matches current fields name in lowercase If LCase(mobjFieldAry(llngIndex).Name) = pstrName Then ' Return Field Class Set Fields = mobjFieldAry(llngIndex) Exit Property End If Next End If ' If matches were not found, return an empty field Set Fields = New clsField ' ' ERROR ON NonExistant: ' ' If matches were not found, raise an error of a non-existent field ' Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.") ' Exit Property End Property ' ------------------------------------------------------------------------------ Private Sub Class_Terminate() ' This event is called when you destroy the class. ' ' Example: ' Set objUpload = Nothing ' ' Example: ' Response.End ' ' Example: ' Page finnishes executing ... Dim llngIndex ' Current Field Index ' Loop through fields For llngIndex = 0 To mlngCount - 1 ' Release field object Set mobjFieldAry(llngIndex) = Nothing Next ' Redimension array and remove all data within ReDim mobjFieldAry(-1) End Sub ' ------------------------------------------------------------------------------ Private Sub Class_Initialize() ' This event is called when you instantiate the class. ' ' Example: ' Set objUpload = New clsUpload ' Redimension array with nothing ReDim mobjFieldAry(-1) ' Compile ANSI equivilants of carriage returns and line feeds CR = ChrB(Asc(vbCr)) ' vbCr Carriage Return LF = ChrB(Asc(vbLf)) ' vbLf Line Feed CRLF = CR & LF ' vbCrLf Carriage Return & Line Feed ' Set field count to zero mlngCount = 0 ' Request data Call RequestData ' Parse out the delimiter Call ParseDelimiter() ' Parse the data Call ParseData End Sub ' ------------------------------------------------------------------------------ Private Function CStrU(ByRef pstrANSI) ' Converts an ANSI string to Unicode ' Best used for small strings Dim llngLength ' Length of ANSI string Dim llngIndex ' Current position ' determine length llngLength = LenB(pstrANSI) ' Loop through each character For llngIndex = 1 To llngLength ' Pull out ANSI character ' Get Ascii value of ANSI character ' Get Unicode Character from Ascii ' Append character to results CStrU = CStrU & Chr(AscB(MidB(pstrANSI, llngIndex, 1))) Next End Function ' ------------------------------------------------------------------------------ Private Function CStrB(ByRef pstrUnicode) ' Converts a Unicode string to ANSI ' Best used for small strings Dim llngLength ' Length of ANSI string Dim llngIndex ' Current position ' determine length llngLength = Len(pstrUnicode) ' Loop through each character For llngIndex = 1 To llngLength ' Pull out Unicode character ' Get Ascii value of Unicode character ' Get ANSI Character from Ascii ' Append character to results CStrB = CStrB & ChrB(Asc(Mid(pstrUnicode, llngIndex, 1))) Next End Function ' ------------------------------------------------------------------------------ End Class ' ------------------------------------------------------------------------------ %>

[Íàçàä]