Caricamento ASP puro con rilevamento di immagini

Come caricare file dal browser al server con ASP classico e rilevare, lato server, se i file sono immagini valide? Per foto valide, come ottenere le loro dimensioni?

Solitamente il caricamento di file in ASP classico viene effettuato da componenti di terze parti che vengono forniti con un file DLL e richiedono la registrazione sul server, a volte anche costano denaro. Inutile dire che molti host non permetteranno componenti di terze parti per motivi di sicurezza.

Esistono già moltissimi script di caricamento ASP puri, ma prendono solo il file e lo salvano sul disco del server, senza alcun rilevamento di immagini.

Di seguito è riportato il mio script scritto per lo scopo di cui sopra, ma ovviamente più risposte sono sempre benvenute con alternative o modi migliori.

Ecco una singola class che gestisce il caricamento dei file e il rilevamento delle immagini. Il caso d’uso verrà di seguito. Salva questo come-è, preferibilmente come un nuovo file, con estensione .asp ShadowUpload.asp

Nota : se si desidera consentire il caricamento di immagini superiori a 200 kb, dare un’occhiata alla risposta a Request.BinaryRead (Request.TotalBytes) genera errore per file di grandi dimensioni . (In caso contrario, potrebbe verificarsi l’errore “Operazione non consentita” sulla riga BinaryRead.)

 <% 'constants: Const MAX_UPLOAD_SIZE=1500000 'bytes Const MSG_NO_DATA="nothing to upload!" Const MSG_EXCEEDED_MAX_SIZE="you exceeded the maximum upload size!" Const SU_DEBUG_MODE=False Class ShadowUpload Private m_Request Private m_Files Private m_Error Public Property Get GetError GetError = m_Error End Property Public Property Get FileCount FileCount = m_Files.Count End Property Public Function File(index) Dim keys keys = m_Files.Keys Set File = m_Files(keys(index)) End Function Public Default Property Get Item(strName) If m_Request.Exists(strName) Then Item = m_Request(strName) Else Item = "" End If End Property Private Sub Class_Initialize Dim iBytesCount, strBinData 'first of all, get amount of uploaded bytes: iBytesCount = Request.TotalBytes WriteDebug("initializing upload, bytes: " & iBytesCount & "
") 'abort if nothing there: If iBytesCount=0 Then m_Error = MSG_NO_DATA Exit Sub End If 'abort if exceeded maximum upload size: If iBytesCount>MAX_UPLOAD_SIZE Then m_Error = MSG_EXCEEDED_MAX_SIZE Exit Sub End If 'read the binary data: strBinData = Request.BinaryRead(iBytesCount) 'create private collections: Set m_Request = Server.CreateObject("Scripting.Dictionary") Set m_Files = Server.CreateObject("Scripting.Dictionary") 'populate the collection: Call BuildUpload(strBinData) End Sub Private Sub Class_Terminate Dim fileName If IsObject(m_Request) Then m_Request.RemoveAll Set m_Request = Nothing End If If IsObject(m_Files) Then For Each fileName In m_Files.Keys Set m_Files(fileName)=Nothing Next m_Files.RemoveAll Set m_Files = Nothing End If End Sub Private Sub BuildUpload(ByVal strBinData) Dim strBinQuote, strBinCRLF, iValuePos Dim iPosBegin, iPosEnd, strBoundaryData Dim strBoundaryEnd, iCurPosition, iBoundaryEndPos Dim strElementName, strFileName, objFileData Dim strFileType, strFileData, strElementValue strBinQuote = AsciiToBinary(chr(34)) strBinCRLF = AsciiToBinary(chr(13)) 'find the boundaries iPosBegin = 1 iPosEnd = InstrB(iPosBegin, strBinData, strBinCRLF) strBoundaryData = MidB(strBinData, iPosBegin, iPosEnd-iPosBegin) iCurPosition = InstrB(1, strBinData, strBoundaryData) strBoundaryEnd = strBoundaryData & AsciiToBinary("--") iBoundaryEndPos = InstrB(strBinData, strBoundaryEnd) 'read binary data into private collection: Do until (iCurPosition>=iBoundaryEndPos) Or (iCurPosition=0) 'skip non relevant data... iPosBegin = InstrB(iCurPosition, strBinData, AsciiToBinary("Content-Disposition")) iPosBegin = InstrB(iPosBegin, strBinData, AsciiToBinary("name=")) iValuePos = iPosBegin 'read the name of the form element, eg "file1", "text1" iPosBegin = iPosBegin+6 iPosEnd = InstrB(iPosBegin, strBinData, strBinQuote) strElementName = BinaryToAscii(MidB(strBinData, iPosBegin, iPosEnd-iPosBegin)) 'maybe file? iPosBegin = InstrB(iCurPosition, strBinData, AsciiToBinary("filename=")) iPosEnd = InstrB(iPosEnd, strBinData, strBoundaryData) If (iPosBegin>0) And (iPosBegin0 Then 'create file data: Set objFileData = New FileData objFileData.FileName = strFileName 'read file type: iPosBegin = InstrB(iPosEnd, strBinData, AsciiToBinary("Content-Type:")) iPosBegin = iPosBegin+14 iPosEnd = InstrB(iPosBegin, strBinData, strBinCRLF) strFileType = BinaryToAscii(MidB(strBinData, iPosBegin, iPosEnd-iPosBegin)) objFileData.ContentType = strFileType 'read file contents: iPosBegin = iPosEnd+4 iPosEnd = InstrB(iPosBegin, strBinData, strBoundaryData)-2 strFileData = MidB(strBinData, iPosBegin, iPosEnd-iPosBegin) 'check that not empty: If LenB(strFileData)>0 Then objFileData.Contents = strFileData 'append to files collection if not empty: Set m_Files(strFileName) = objFileData Else Set objFileData = Nothing End If End If strElementValue = strFileName Else 'ordinary form value, just read: iPosBegin = InstrB(iValuePos, strBinData, strBinCRLF) iPosBegin = iPosBegin+4 iPosEnd = InstrB(iPosBegin, strBinData, strBoundaryData)-2 strElementValue = BinaryToAscii(MidB(strBinData, iPosBegin, iPosEnd-iPosBegin)) End If 'append to request collection m_Request(strElementName) = strElementValue 'skip to next element: iCurPosition = InstrB(iCurPosition+LenB(strBoundaryData), strBinData, strBoundaryData) Loop End Sub Private Function WriteDebug(msg) If SU_DEBUG_MODE Then Response.Write(msg) Response.Flush End If End Function Private Function AsciiToBinary(strAscii) Dim i, char, result result = "" For i=1 to Len(strAscii) char = Mid(strAscii, i, 1) result = result & chrB(AscB(char)) Next AsciiToBinary = result End Function Private Function BinaryToAscii(strBinary) Dim i, result result = "" For i=1 to LenB(strBinary) result = result & chr(AscB(MidB(strBinary, i, 1))) Next BinaryToAscii = result End Function End Class Class FileData Private m_fileName Private m_contentType Private m_BinaryContents Private m_AsciiContents Private m_imageWidth Private m_imageHeight Private m_checkImage Public Property Get FileName FileName = m_fileName End Property Public Property Get ContentType ContentType = m_contentType End Property Public Property Get ImageWidth If m_checkImage=False Then Call CheckImageDimensions ImageWidth = m_imageWidth End Property Public Property Get ImageHeight If m_checkImage=False Then Call CheckImageDimensions ImageHeight = m_imageHeight End Property Public Property Let FileName(strName) Dim arrTemp arrTemp = Split(strName, "\") m_fileName = arrTemp(UBound(arrTemp)) End Property Public Property Let CheckImage(blnCheck) m_checkImage = blnCheck End Property Public Property Let ContentType(strType) m_contentType = strType End Property Public Property Let Contents(strData) m_BinaryContents = strData m_AsciiContents = RSBinaryToString(m_BinaryContents) End Property Public Property Get Size Size = LenB(m_BinaryContents) End Property Private Sub CheckImageDimensions Dim width, height, colors Dim strType '''If gfxSpex(BinaryToAscii(m_BinaryContents), width, height, colors, strType) = true then If gfxSpex(m_AsciiContents, width, height, colors, strType) = true then m_imageWidth = width m_imageHeight = height End If m_checkImage = True End Sub Private Sub Class_Initialize m_imageWidth = -1 m_imageHeight = -1 m_checkImage = False End Sub Public Sub SaveToDisk(strFolderPath, ByRef strNewFileName) Dim strPath, objFSO, objFile Dim i, time1, time2 Dim objStream, strExtension strPath = strFolderPath&"\" If Len(strNewFileName)=0 Then strPath = strPath & m_fileName Else strExtension = GetExtension(strNewFileName) If Len(strExtension)=0 Then strNewFileName = strNewFileName & "." & GetExtension(m_fileName) End If strPath = strPath & strNewFileName End If WriteDebug("save file started...
") time1 = CDbl(Timer) Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.CreateTextFile(strPath) objFile.Write(m_AsciiContents) '''For i=1 to LenB(m_BinaryContents) ''' objFile.Write chr(AscB(MidB(m_BinaryContents, i, 1))) '''Next time2 = CDbl(Timer) WriteDebug("saving file took " & (time2-time1) & " seconds.
") objFile.Close Set objFile=Nothing Set objFSO=Nothing End Sub Private Function GetExtension(strPath) Dim arrTemp arrTemp = Split(strPath, ".") GetExtension = "" If UBound(arrTemp)>0 Then GetExtension = arrTemp(UBound(arrTemp)) End If End Function Private Function RSBinaryToString(xBinary) 'Antonin Foller, http://www.motobit.com 'RSBinaryToString converts binary data (VT_UI1 | VT_ARRAY Or MultiByte string) 'to a string (BSTR) using ADO recordset Dim Binary 'MultiByte data must be converted To VT_UI1 | VT_ARRAY first. If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary Dim RS, LBinary Const adLongVarChar = 201 Set RS = CreateObject("ADODB.Recordset") LBinary = LenB(Binary) If LBinary>0 Then RS.Fields.Append "mBinary", adLongVarChar, LBinary RS.Open RS.AddNew RS("mBinary").AppendChunk Binary RS.Update RSBinaryToString = RS("mBinary") Else RSBinaryToString = "" End If End Function Function MultiByteToBinary(MultiByte) '© 2000 Antonin Foller, http://www.motobit.com ' MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY) ' Using recordset Dim RS, LMultiByte, Binary Const adLongVarBinary = 205 Set RS = CreateObject("ADODB.Recordset") LMultiByte = LenB(MultiByte) If LMultiByte>0 Then RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte RS.Open RS.AddNew RS("mBinary").AppendChunk MultiByte & ChrB(0) RS.Update Binary = RS("mBinary").GetChunk(LMultiByte) End If MultiByteToBinary = Binary End Function Private Function WriteDebug(msg) If SU_DEBUG_MODE Then Response.Write(msg) Response.Flush End If End Function Private Function BinaryToAscii(strBinary) Dim i, result result = "" For i=1 to LenB(strBinary) result = result & chr(AscB(MidB(strBinary, i, 1))) Next BinaryToAscii = result End Function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This routine will attempt to identify any filespec passed ::: '::: as a graphic file (regardless of the extension). This will ::: '::: work with BMP, GIF, JPG and PNG files. ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: Based on ideas presented by David Crowell ::: '::: (credit where due) ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: blah blah blah blah blah blah blah blah blah blah blah blah ::: '::: blah blah blah blah blah blah blah blah blah blah blah blah ::: '::: blah blah Copyright *c* MM, Mike Shaffer blah blah ::: '::: bh blah ALL RIGHTS RESERVED WORLDWIDE blah blah ::: '::: blah blah Permission is granted to use this code blah blah ::: '::: blah blah in your projects, as long as this blah blah ::: '::: blah blah copyright notice is included blah blah ::: '::: blah blah blah blah blah blah blah blah blah blah blah blah ::: '::: blah blah blah blah blah blah blah blah blah blah blah blah ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This function gets a specified number of bytes from any ::: '::: file, starting at the offset (base 1) ::: '::: ::: '::: Passed: ::: '::: flnm => Filespec of file to read ::: '::: offset => Offset at which to start reading ::: '::: bytes => How many bytes to read ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: Private Function GetBytes(flnm, offset, bytes) Dim startPos If offset=0 Then startPos = 1 Else startPos = offset End If if bytes = -1 then ' Get All! GetBytes = flnm else GetBytes = Mid(flnm, startPos, bytes) end if ' Dim objFSO ' Dim objFTemp ' Dim objTextStream ' Dim lngSize ' ' Set objFSO = CreateObject("Scripting.FileSystemObject") ' ' ' First, we get the filesize ' Set objFTemp = objFSO.GetFile(flnm) ' lngSize = objFTemp.Size ' set objFTemp = nothing ' ' fsoForReading = 1 ' Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading) ' ' if offset > 0 then ' strBuff = objTextStream.Read(offset - 1) ' end if ' ' if bytes = -1 then ' Get All! ' GetBytes = objTextStream.Read(lngSize) 'ReadAll ' else ' GetBytes = objTextStream.Read(bytes) ' end if ' ' objTextStream.Close ' set objTextStream = nothing ' set objFSO = nothing End Function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: Functions to convert two bytes to a numeric value (long) ::: '::: (both little-endian and big-endian) ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: Private Function lngConvert(strTemp) lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256))) end function Private Function lngConvert2(strTemp) lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256))) end function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This function does most of the real work. It will attempt ::: '::: to read any file, regardless of the extension, and will ::: '::: identify if it is a graphical image. ::: '::: ::: '::: Passed: ::: '::: flnm => Filespec of file to read ::: '::: width => width of image ::: '::: height => height of image ::: '::: depth => color depth (in number of colors) ::: '::: strImageType=> type of image (eg GIF, BMP, etc.) ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: function gfxSpex(flnm, width, height, depth, strImageType) dim strPNG dim strGIF dim strBMP dim strType dim strBuff dim lngSize dim flgFound dim strTarget dim lngPos dim ExitLoop dim lngMarkerSize strType = "" strImageType = "(unknown)" gfxSpex = False strPNG = chr(137) & chr(80) & chr(78) strGIF = "GIF" strBMP = chr(66) & chr(77) strType = GetBytes(flnm, 0, 3) if strType = strGIF then ' is GIF strImageType = "GIF" Width = lngConvert(GetBytes(flnm, 7, 2)) Height = lngConvert(GetBytes(flnm, 9, 2)) Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1) gfxSpex = True elseif left(strType, 2) = strBMP then ' is BMP strImageType = "BMP" Width = lngConvert(GetBytes(flnm, 19, 2)) Height = lngConvert(GetBytes(flnm, 23, 2)) Depth = 2 ^ (asc(GetBytes(flnm, 29, 1))) gfxSpex = True elseif strType = strPNG then ' Is PNG strImageType = "PNG" Width = lngConvert2(GetBytes(flnm, 19, 2)) Height = lngConvert2(GetBytes(flnm, 23, 2)) Depth = getBytes(flnm, 25, 2) select case asc(right(Depth,1)) case 0 Depth = 2 ^ (asc(left(Depth, 1))) gfxSpex = True case 2 Depth = 2 ^ (asc(left(Depth, 1)) * 3) gfxSpex = True case 3 Depth = 2 ^ (asc(left(Depth, 1))) '8 gfxSpex = True case 4 Depth = 2 ^ (asc(left(Depth, 1)) * 2) gfxSpex = True case 6 Depth = 2 ^ (asc(left(Depth, 1)) * 4) gfxSpex = True case else Depth = -1 end select else strBuff = GetBytes(flnm, 0, -1) ' Get all bytes from file lngSize = len(strBuff) flgFound = 0 strTarget = chr(255) & chr(216) & chr(255) flgFound = instr(strBuff, strTarget) if flgFound = 0 then exit function end if strImageType = "JPG" lngPos = flgFound + 2 ExitLoop = false do while ExitLoop = False and lngPos < lngSize do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize lngPos = lngPos + 1 loop if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2)) lngPos = lngPos + lngMarkerSize + 1 else ExitLoop = True end if loop if ExitLoop = False then Width = -1 Height = -1 Depth = -1 else Height = lngConvert2(mid(strBuff, lngPos + 4, 2)) Width = lngConvert2(mid(strBuff, lngPos + 6, 2)) Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8) gfxSpex = True end if end if End Function End Class %>

Costanti spiegate:

  • MAX_UPLOAD_SIZE : dimensione massima, in byte, di tutti i file caricati. Quando si superano tali dimensioni, il processo di caricamento viene interrotto e l’errore globale viene impostato sulla costante MSG_EXCEEDED_MAX_SIZE .

  • MSG_NO_DATA – quando l’utente non sceglie alcun file da caricare, l’errore globale sarà impostato su quella costante.

  • SU_DEBUG_MODE – se impostato su True lo script genererà vari messaggi tramite Response.Write() , utile per i problemi di debug.

Caso d’uso semplice: (codice completo)

  <% Dim objUpload If Request("action")="1" Then Set objUpload=New ShadowUpload If objUpload.GetError<>"" Then Response.Write("sorry, could not upload: "&objUpload.GetError) Else Response.Write("found "&objUpload.FileCount&" files...
") For x=0 To objUpload.FileCount-1 Response.Write("file name: "&objUpload.File(x).FileName&"
") Response.Write("file type: "&objUpload.File(x).ContentType&"
") Response.Write("file size: "&objUpload.File(x).Size&"
") Response.Write("image width: "&objUpload.File(x).ImageWidth&"
") Response.Write("image height: "&objUpload.File(x).ImageHeight&"
") If (objUpload.File(x).ImageWidth>200) Or (objUpload.File(x).ImageHeight>200) Then Response.Write("image to big, not saving!") Else Call objUpload.File(x).SaveToDisk(Server.MapPath("Uploads"), "") Response.Write("file saved successfully!") End If Response.Write("
") Next Response.Write("thank you, "&objUpload("name")) End If End If %>
?action=1" enctype="multipart/form-data" method="POST"> File1:
File2:
File3:
Name:

Ciò dimostra che l’utilizzo della maggior parte delle funzioni di script, per bloccare i file non di immagini dal caricamento, può avere solo qualcosa di simile:

 If objUpload.File(x).ImageWidth<0 Then Response.Write("Not a valid image!") Else 'proceed to save the file... End If 

Disclaimer: Questo è stato originariamente pubblicato qui sette anni fa e come accreditato nel codice stesso, contiene parti non scritte da me.

Nota per i clienti che utilizzano il browser Chrome sul dispositivo Android :

  1. Per qualche motivo, l'elemento standard di tipo submit sembra non funzionare correttamente in Chrome per Android. Se ricevi lamentele da parte dei clienti, prova a modificare questa riga nel modulo:

      

    a questo invece:

      
  2. A causa di un ansible bug nell'app Chrome per Android, quando si utilizza l'app fotocamera del telefono per scattare una nuova immagine e quindi si tenta di inviare questa immagine, potrebbe non riuscire. In tal caso, basta chiedere al cliente di utilizzare un browser diverso.

Il codice di @ShadowWizard è bello ed eseguito come un fascino su un computer locale, ma ho riscontrato problemi di caricamento su un server di produzione, quindi ho riscritto la class con una routine di analisi più affidabile per la richiesta di caricamento.

La class può gestire più errori in questo momento e puoi caricare più file con un singolo elemento INPUT; salva questo come un nuovo file e rinominalo come “uploadhelper.asp”

 <% Const MAX_UPLOAD_SIZE = 25000000 '25 MB Const MSG_NO_DATA = "Nothing to upload." Const MSG_EXCEEDED_MAX_SIZE = "You exceeded the maximum upload size." Const MSG_BAD_REQUEST_METHOD = "Bad request method. Use the POST method." Const MSG_BAD_ENCTYPE = "Bad encoding type. Use a ""multipart/form-data"" enctype." Const MSG_ZERO_LENGTH = "Zero length request." Class UploadHelper Private m_Request Private m_Files Private m_Error Public Property Get GetError GetError = m_Error End Property Public Property Get FileCount FileCount = m_Files.Count End Property Public Function File(index) If m_Files.Exists(index) Then Set File = m_Files(index) Else Set File = Nothing End If End Function Public Default Property Get Item(strName) If m_Request.Exists(strName) Then Item = m_Request(strName) Else Item = "" End If End Property Private Sub Class_Initialize Dim iBytesCount, strBinData 'first of all, get amount of uploaded bytes: iBytesCount = Request.TotalBytes 'abort if nothing there: If iBytesCount = 0 Then m_Error = MSG_NO_DATA Exit Sub End If 'abort if exceeded maximum upload size: If iBytesCount > MAX_UPLOAD_SIZE Then m_Error = MSG_EXCEEDED_MAX_SIZE Exit Sub End If If Request.ServerVariables("REQUEST_METHOD") = "POST" Then Dim CT, PosB, Boundary, PosE CT = Request.ServerVariables("HTTP_Content_Type") If LCase(Left(CT, 19)) = "multipart/form-data" Then PosB = InStr(LCase(CT), "boundary=") If PosB > 0 Then Boundary = Mid(CT, PosB + 9) PosB = InStr(LCase(CT), "boundary=") If PosB > 0 Then PosB = InStr(Boundary, ",") If PosB > 0 Then Boundary = Left(Boundary, PosB - 1) End If If iBytesCount > 0 And Boundary <> "" Then Boundary = "--" & Boundary Dim Head, Binary Binary = Request.BinaryRead(iBytesCount) 'create private collections: Set m_Request = Server.CreateObject("Scripting.Dictionary") Set m_Files = Server.CreateObject("Scripting.Dictionary") Call ParseRequest(Binary, Boundary) Binary = Empty Else m_Error = MSG_ZERO_LENGTH Exit Sub End If Else m_Error = MSG_BAD_ENCTYPE Exit Sub End If Else m_Error = MSG_BAD_REQUEST_METHOD Exit Sub End If End Sub Private Sub Class_Terminate Dim fileName If IsObject(m_Request) Then m_Request.RemoveAll Set m_Request = Nothing End If If IsObject(m_Files) Then For Each fileName In m_Files.Keys Set m_Files(fileName)=Nothing Next m_Files.RemoveAll Set m_Files = Nothing End If End Sub Private Sub ParseRequest(Binary, Boundary) Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary Boundary = StringToBinary(Boundary) PosOpenBoundary = InStrB(Binary, Boundary) PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0) Dim HeaderContent, FieldContent, bFieldContent Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type Dim TwoCharsAfterEndBoundary, n : n = 0 Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary) PosEndOfHeader = InStrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf)) HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2) bFieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2) GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type Set objFileData = New FileData objFileData.FileName = SourceFileName objFileData.ContentType = Content_Type objFileData.Contents = bFieldContent objFileData.FormFieldName = FormFieldName objFileData.ContentDisposition = Content_Disposition Set m_Files(n) = objFileData Set objFileData = Nothing TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2)) isLastBoundary = TwoCharsAfterEndBoundary = "--" If Not isLastBoundary Then PosOpenBoundary = PosCloseBoundary PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary) End If n = n + 1 Loop End Sub Private Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type) Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";")) Name = (SeparateField(Head, "name=", ";")) If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2) FileName = (SeparateField(Head, "filename=", ";")) If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2) Content_Type = LTrim(SeparateField(Head, "content-type:", ";")) End Function Private Function SeparateField(From, ByVal sStart, ByVal sEnd) Dim PosB, PosE, sFrom sFrom = LCase(From) PosB = InStr(sFrom, sStart) If PosB > 0 Then PosB = PosB + Len(sStart) PosE = InStr(PosB, sFrom, sEnd) If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf) If PosE = 0 Then PosE = Len(sFrom) + 1 SeparateField = Mid(From, PosB, PosE - PosB) Else SeparateField = Empty End If End Function Private Function BinaryToString(Binary) dim cl1, cl2, cl3, pl1, pl2, pl3 Dim L cl1 = 1 cl2 = 1 cl3 = 1 L = LenB(Binary) Do While cl1<=L pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1))) cl1 = cl1 + 1 cl3 = cl3 + 1 if cl3>300 then pl2 = pl2 & pl3 pl3 = "" cl3 = 1 cl2 = cl2 + 1 if cl2>200 then pl1 = pl1 & pl2 pl2 = "" cl2 = 1 End If End If Loop BinaryToString = pl1 & pl2 & pl3 End Function Private Function StringToBinary(String) Dim I, B For I=1 to len(String) B = B & ChrB(Asc(Mid(String,I,1))) Next StringToBinary = B End Function End Class Class FileData Private m_fileName Private m_contentType Private m_BinaryContents Private m_AsciiContents Private m_imageWidth Private m_imageHeight Private m_checkImage Private m_formFieldName Private m_contentDisposition Public Property Get FormFieldName FormFieldName = m_formFieldName End Property Public Property Let FormFieldName(sFieldName) m_formFieldName = sFieldName End Property Public Property Get ContentDisposition ContentDisposition = m_contentDisposition End Property Public Property Let ContentDisposition(sContentDisposition) m_contentDisposition = sContentDisposition End Property Public Property Get FileName FileName = m_fileName End Property Public Property Get ContentType ContentType = m_contentType End Property Public Property Get ImageWidth If m_checkImage=False Then Call CheckImageDimensions ImageWidth = m_imageWidth End Property Public Property Get ImageHeight If m_checkImage=False Then Call CheckImageDimensions ImageHeight = m_imageHeight End Property Public Property Let FileName(ByVal strName) strName = Replace(strName, "/", "\") Dim arrTemp : arrTemp = Split(strName, "\") m_fileName = arrTemp(UBound(arrTemp)) End Property Public Property Let CheckImage(blnCheck) m_checkImage = blnCheck End Property Public Property Let ContentType(strType) m_contentType = strType End Property Public Property Let Contents(strData) m_BinaryContents = strData m_AsciiContents = RSBinaryToString(m_BinaryContents) End Property Public Property Get Size Size = LenB(m_BinaryContents) End Property Private Sub CheckImageDimensions Dim width, height, colors Dim strType '''If gfxSpex(BinaryToAscii(m_BinaryContents), width, height, colors, strType) = true then If gfxSpex(m_AsciiContents, width, height, colors, strType) = true then m_imageWidth = width m_imageHeight = height End If m_checkImage = True End Sub Private Sub Class_Initialize m_imageWidth = -1 m_imageHeight = -1 m_checkImage = False End Sub Public Sub SaveToDisk(strFolderPath, ByRef strNewFileName) Dim strPath, objFSO, objFile Dim i, time1, time2 Dim objStream, strExtension strPath = strFolderPath&"\" If Len(strNewFileName)=0 Then strPath = strPath & m_fileName Else strExtension = GetExtension(strNewFileName) If Len(strExtension)=0 Then strNewFileName = strNewFileName & "." & GetExtension(m_fileName) End If strPath = strPath & strNewFileName End If time1 = CDbl(Timer) Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.CreateTextFile(strPath) objFile.Write(m_AsciiContents) '''For i=1 to LenB(m_BinaryContents) ''' objFile.Write chr(AscB(MidB(m_BinaryContents, i, 1))) '''Next time2 = CDbl(Timer) objFile.Close Set objFile=Nothing Set objFSO=Nothing End Sub Private Function GetExtension(strPath) Dim arrTemp arrTemp = Split(strPath, ".") GetExtension = "" If UBound(arrTemp)>0 Then GetExtension = arrTemp(UBound(arrTemp)) End If End Function Private Function RSBinaryToString(xBinary) 'Antonin Foller, http://www.motobit.com 'RSBinaryToString converts binary data (VT_UI1 | VT_ARRAY Or MultiByte string) 'to a string (BSTR) using ADO recordset Dim Binary 'MultiByte data must be converted To VT_UI1 | VT_ARRAY first. If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary Dim RS, LBinary Const adLongVarChar = 201 Set RS = CreateObject("ADODB.Recordset") LBinary = LenB(Binary) If LBinary>0 Then RS.Fields.Append "mBinary", adLongVarChar, LBinary RS.Open RS.AddNew RS("mBinary").AppendChunk Binary RS.Update RSBinaryToString = RS("mBinary") Else RSBinaryToString = "" End If End Function Function MultiByteToBinary(MultiByte) '© 2000 Antonin Foller, http://www.motobit.com ' MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY) ' Using recordset Dim RS, LMultiByte, Binary Const adLongVarBinary = 205 Set RS = CreateObject("ADODB.Recordset") LMultiByte = LenB(MultiByte) If LMultiByte>0 Then RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte RS.Open RS.AddNew RS("mBinary").AppendChunk MultiByte & ChrB(0) RS.Update Binary = RS("mBinary").GetChunk(LMultiByte) End If MultiByteToBinary = Binary End Function Private Function BinaryToAscii(strBinary) Dim i, result result = "" For i=1 to LenB(strBinary) result = result & chr(AscB(MidB(strBinary, i, 1))) Next BinaryToAscii = result End Function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This routine will attempt to identify any filespec passed ::: '::: as a graphic file (regardless of the extension). This will ::: '::: work with BMP, GIF, JPG and PNG files. ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: Based on ideas presented by David Crowell ::: '::: (credit where due) ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: blah blah blah blah blah blah blah blah blah blah blah blah ::: '::: blah blah blah blah blah blah blah blah blah blah blah blah ::: '::: blah blah Copyright *c* MM, Mike Shaffer blah blah ::: '::: bh blah ALL RIGHTS RESERVED WORLDWIDE blah blah ::: '::: blah blah Permission is granted to use this code blah blah ::: '::: blah blah in your projects, as long as this blah blah ::: '::: blah blah copyright notice is included blah blah ::: '::: blah blah blah blah blah blah blah blah blah blah blah blah ::: '::: blah blah blah blah blah blah blah blah blah blah blah blah ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This function gets a specified number of bytes from any ::: '::: file, starting at the offset (base 1) ::: '::: ::: '::: Passed: ::: '::: flnm => Filespec of file to read ::: '::: offset => Offset at which to start reading ::: '::: bytes => How many bytes to read ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: Private Function GetBytes(flnm, offset, bytes) Dim startPos If offset=0 Then startPos = 1 Else startPos = offset End If if bytes = -1 then ' Get All! GetBytes = flnm else GetBytes = Mid(flnm, startPos, bytes) end if ' Dim objFSO ' Dim objFTemp ' Dim objTextStream ' Dim lngSize ' ' Set objFSO = CreateObject("Scripting.FileSystemObject") ' ' ' First, we get the filesize ' Set objFTemp = objFSO.GetFile(flnm) ' lngSize = objFTemp.Size ' set objFTemp = nothing ' ' fsoForReading = 1 ' Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading) ' ' if offset > 0 then ' strBuff = objTextStream.Read(offset - 1) ' end if ' ' if bytes = -1 then ' Get All! ' GetBytes = objTextStream.Read(lngSize) 'ReadAll ' else ' GetBytes = objTextStream.Read(bytes) ' end if ' ' objTextStream.Close ' set objTextStream = nothing ' set objFSO = nothing End Function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: Functions to convert two bytes to a numeric value (long) ::: '::: (both little-endian and big-endian) ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: Private Function lngConvert(strTemp) lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256))) end function Private Function lngConvert2(strTemp) lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256))) end function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This function does most of the real work. It will attempt ::: '::: to read any file, regardless of the extension, and will ::: '::: identify if it is a graphical image. ::: '::: ::: '::: Passed: ::: '::: flnm => Filespec of file to read ::: '::: width => width of image ::: '::: height => height of image ::: '::: depth => color depth (in number of colors) ::: '::: strImageType=> type of image (eg GIF, BMP, etc.) ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: function gfxSpex(flnm, width, height, depth, strImageType) dim strPNG dim strGIF dim strBMP dim strType dim strBuff dim lngSize dim flgFound dim strTarget dim lngPos dim ExitLoop dim lngMarkerSize strType = "" strImageType = "(unknown)" gfxSpex = False strPNG = chr(137) & chr(80) & chr(78) strGIF = "GIF" strBMP = chr(66) & chr(77) strType = GetBytes(flnm, 0, 3) if strType = strGIF then ' is GIF strImageType = "GIF" Width = lngConvert(GetBytes(flnm, 7, 2)) Height = lngConvert(GetBytes(flnm, 9, 2)) Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1) gfxSpex = True elseif left(strType, 2) = strBMP then ' is BMP strImageType = "BMP" Width = lngConvert(GetBytes(flnm, 19, 2)) Height = lngConvert(GetBytes(flnm, 23, 2)) Depth = 2 ^ (asc(GetBytes(flnm, 29, 1))) gfxSpex = True elseif strType = strPNG then ' Is PNG strImageType = "PNG" Width = lngConvert2(GetBytes(flnm, 19, 2)) Height = lngConvert2(GetBytes(flnm, 23, 2)) Depth = getBytes(flnm, 25, 2) select case asc(right(Depth,1)) case 0 Depth = 2 ^ (asc(left(Depth, 1))) gfxSpex = True case 2 Depth = 2 ^ (asc(left(Depth, 1)) * 3) gfxSpex = True case 3 Depth = 2 ^ (asc(left(Depth, 1))) '8 gfxSpex = True case 4 Depth = 2 ^ (asc(left(Depth, 1)) * 2) gfxSpex = True case 6 Depth = 2 ^ (asc(left(Depth, 1)) * 4) gfxSpex = True case else Depth = -1 end select else strBuff = GetBytes(flnm, 0, -1) ' Get all bytes from file lngSize = len(strBuff) flgFound = 0 strTarget = chr(255) & chr(216) & chr(255) flgFound = instr(strBuff, strTarget) if flgFound = 0 then exit function end if strImageType = "JPG" lngPos = flgFound + 2 ExitLoop = false do while ExitLoop = False and lngPos < lngSize do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize lngPos = lngPos + 1 loop if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2)) lngPos = lngPos + lngMarkerSize + 1 else ExitLoop = True end if loop if ExitLoop = False then Width = -1 Height = -1 Depth = -1 else Height = lngConvert2(mid(strBuff, lngPos + 4, 2)) Width = lngConvert2(mid(strBuff, lngPos + 6, 2)) Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8) gfxSpex = True end if end if End Function End Class %> 

Usage: create a new *.asp file with the following code to upload your files.

           
?cmd=upload" method="POST" enctype="multipart/form-data"> File:
<% If Request("cmd")="upload" Then Dim objUpload : Set objUpload = New UploadHelper If objUpload.GetError <> "" Then Response.Write("Warning: "&objUpload.GetError) Else Response.Write("found "&objUpload.FileCount&" files...
") Dim x : For x = 0 To objUpload.FileCount - 1 Response.Write("form field name: "&objUpload.File(x).FormFieldName&"
") Response.Write("content disposition: "&objUpload.File(x).ContentDisposition&"
") Response.Write("file name: "&objUpload.File(x).FileName&"
") Response.Write("file type: "&objUpload.File(x).ContentType&"
") Response.Write("file size: "&objUpload.File(x).Size&"
") Response.Write("image width: "&objUpload.File(x).ImageWidth&"
") Response.Write("image height: "&objUpload.File(x).ImageHeight&"
") If (objUpload.File(x).ImageWidth>1024) Or (objUpload.File(x).ImageHeight>1024) Then Response.Write("the image is too big, file not saved!") Else Call objUpload.File(x).SaveToDisk(Server.MapPath("/public"), "") Response.Write("file saved successfully!") End If Response.Write("
") Next End If End If %>

As a PPS, the problem might be a little more basic than you might think. IIS has a limit of 200K for a BinaryRead() function call. Has anyone come into this problem while trying to implement this solution?

Why wasn’t the BinaryRead() limitation mentioned anywhere in the initial documentation? I’ve been struggling with this for over an hour.

This link on StackOverflow explains it: Request.BinaryRead(Request.TotalBytes) throws error for large files