Prezados, tenho um código que me atende 95%.
Não chega a 100% porque eu dependo que depois que ele completo o upload dos arquivos ele retorne o nome do arquivo alterado randomicamente que ele gravou na pasta determinada.
O sistema sobe os arquivos, avalia o tipo se está de acordo com a regra de só subir imagens, renomeia ele randomicamente e até pega o nome do arquivo só que o original.
Como faço para pegar o nome que ele gerou e guardou na pasta?
esse é o arquivo do formulário
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>1 sem título</title>
</head>
<body>
<!-- #include file="env_upl.asp" -->
<%
'------------------------------------------------------------------------
'Gera uma string aleatória com 'n' dígitos
'Usado para criar um nome aleatório para o arquivo
function fnGeraChave(n)
dim s
randomize
s = ""
while len(s) < n
s = chr (int((57 - 48 + 1) * Rnd + 48)) + s
wend
fnGeraChave = s
end function
'------------------------------------------------------------------------
Dim objUpload, file
If Request("action")="1" Then
Set objUpload=New ShadowUpload
If objUpload.GetError<>"" Then
Response.Write("Regra de upload: "&objUpload.GetError)
Else
Response.Write("Enviando "&objUpload.FileCount&" arquivo(s)...<br />")
For x=0 To objUpload.FileCount-1
Response.Write("file name: "&objUpload.File(x).FileName&"<br />")
Response.Write("file type: "&objUpload.File(x).ContentType&"<br />")
Response.Write("file size: "&objUpload.File(x).Size&"<br />")
If (objUpload.File(x).ImageWidth>200) Or (objUpload.File(x).ImageHeight>200) Or (objUpload.File(x).ContentType <> "image/jpeg") Then
'(objUpload.File(x).ContentType <> "image/jpeg") impede arquivos deferentes de jpg. caso queira liberar png ponha image/png
Response.Write("Arquivo inválido ou imagem inválida!")
Else
Call objUpload.File(x).SaveToDisk(Server.MapPath("image"),fnGeraChave(15) & "" & "")
Response.Write("Arquivo Salvo com Sucesso!")
End If
Response.Write("<hr />")
Next
Response.Write("thank you, "&objUpload("FileName"))
End If
End If
%>
<form action="<%=Request.ServerVariables( "Script_Name" )%>?action=1" enctype="multipart/form-data" method="POST">
File1: <input type="file" name="file1" multiple /><br />
<button type="submit">Upload</button>
</form>
</body>
</html>
e esse é o arquivo que processa o upload.
<%
'constants:
Const MAX_UPLOAD_SIZE=200000 'bytes
Const MSG_NO_DATA="nothing to upload!"
Const MSG_EXCEEDED_MAX_SIZE="um dos arquivos excede o limite!"
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 & "<br />")
'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, 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
'read file name:
iPosEnd = InstrB(iPosBegin, strBinData, strBinQuote)
strFileName = BinaryToAscii(MidB(strBinData, iPosBegin, iPosEnd-iPosBegin))
'verify that we got name:
If Len(strFileName)>0 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...<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
time2 = CDbl(Timer)
WriteDebug("saving file took " & (time2-time1) & " seconds.<br />")
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
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
strType = ""
strImageType = "(jpg)"
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
%>