chdiaswdd

Outubro 21, 2016

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>

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

Entrar

chdiaswdd

Total de itens

Registro em

Última visita

Tipo de Conteúdo

Perfis

Fóruns

Posts postados por chdiaswdd

UPLOAD com ASP

Navegação

Atividades