'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
'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, e.g. "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 (iPosBegin<iPosEnd) Then
'skip non relevant data..
iPosBegin = iPosBegin+10
'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
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...<br />")
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
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 (e.g. 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
Load balance : Server 00
