Ir para conteúdo
Fórum CódigoFonte.net
  • Anúncios

    • codigofonte

      Novo Fórum

      Pessoal, Atualizamos nossa versão do fórum para a mais recente da Invision Power. Como tínhamos uma versão muito antiga, talvez algumas áreas possam funcionar de forma errada ou com problemas, gostaria de pedir-lhes a compreensão, pois iremos resolvendo aos poucos. Até mais!
chdias

UPLOAD com ASP

Recommended Posts

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
%>

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar Agora

×