Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

<%Rafael%>

Problemas com UPLOAD...

Por , em ASP Clássico

Recommended Posts

<%Rafael%>    0

<%Rafael%>
Postado

E ai galera beleza???

 

Pô... uma semana com dor de cabeça e durmindo as 5 da manhã por causa desse bendito upload... hehehe!!!

 

É o seguinte...

Tenho um script de upload que funciona 'corretamente' o único problema, é que se eu envio um arquivo com nome 'aninha.jpg' e á houver um arquivo com o mesmo nome (aninha.jpg) na pasta para onde vão os arquivos, ele nem sobrepõe o arquivo, e nem aparece nada falando que o arquivo já existe e tals!

 

Alguém sabe o que eu tenho que colocar para ou sobrepor o arquivo ou avisar dizendo que o arquivo já existe???

Ai vão os códigos:

 

Página upload_send.asp:

<html>

<head>

<title>Enviando arquivos...</title>

</head>

<body bgcolor="#EFF5D9" scroll="no">

<script>

 

function check(){

if(document.upload.File1.value == ''){

alert('        Por favor, escolha um arquivo para Upload!        ');

return false;

}

}

 

</script>

<form name="upload" action="upload.asp" method="post"  ENCTYPE="multipart/form-data">

<b>Upload de arquivos:</b  <input type="file" size="38" name="File1"><br>

<input name="Action" type="submit" id="Action2" value="Enviar" onClick="return check(this)">

</form>

</body>

</html>

-----------------------------------

 

Página upload.asp:

<html>

<head>

<title>Arquivos enviados...</title>

</head>

<body bgcolor="#EFF5D9" scroll="no">

<!---#INCLUDE FILE="upload.inc" --->

Upload de arquivos:<br>

    <%

    Set fields = GetUpload()

 

    'Pasta em que serão colocados os arquivos!

    FilePath = Server.MapPath("files\" & Fields("File1").FileName)

    Fields("File1").Value.SaveAs FilePath

 

    response.Write("Aquivo '<b>" & fields("File1").FileName & "</b>' enviado com sucesso!")

    %>

</body>

</html>

-----------------------------------

 

Página upload.inc:

<script RUNAT=SERVER LANGUAGE=VBSCRIPT>

Const IncludeType = 2

 

'Vous pouvez utiliser ce composant d'upload pourr :

' 1. Uploader de petits fichiers sur le serveur (sauvegarde via les FileSystem object)

' 2. Uploader des fichiers binaires/texte de n'importe quelle taille sur une base de données serveur (RS("BinField") = Upload("FormField").Value)

 

 

'restriction de la taille de l'upload

Dim UploadSizeLimit

 

'********************************** Méthode GetUpload **********************************

'Cette fonction lit les champs de formulaires en entrée binaire et les renvoie en tant qu'objet du dictionnaire.

 

Function GetUpload()

  Dim Result

  Set Result = Nothing

  If Request.ServerVariables("REQUEST_METHOD") = "POST" Then  'la méthode REQUEST doit être POST

    Dim CT, PosB, Boundary, Length, PosE

    CT = Request.ServerVariables("HTTP_Content_Type") ' lit le header

    If LCase(Left(CT, 19)) = "multipart/form-data" Then 'qui doit être de type "multipart/form-data"

 

     

      PosB = InStr(LCase(CT), "boundary=") 'Finds boundary

      If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary

 

      '****** Erreur sur IE5.01 - doublement des entêtes http

      PosB = InStr(LCase(CT), "boundary=")

      If PosB > 0 then 'Patch pour l'erreur IE

        PosB = InStr(Boundary, ",")

        If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)

      end if

      '****** Erreur sur IE5.01 - doublement des entêtes http

 

      Length = CLng(Request.ServerVariables("HTTP_Content_Length"))

      If "" & UploadSizeLimit <> "" Then

        UploadSizeLimit = CLng(UploadSizeLimit)

        If Length > UploadSizeLimit Then

          Request.BinaryRead (Length)

          Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length, 0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit, 0) & "B"

          Exit Function

        End If

      End If

     

      If Length > 0 And Boundary <> "" Then

        Boundary = "--" & Boundary

        Dim Head, Binary

        Binary = Request.BinaryRead(Length) 'lit les données à partir du poste client

       

     

        Set Result = SeparateFields(Binary, Boundary)

        Binary = Empty 'Mise à jour des variables

      Else

        Err.Raise 10, "GetUpload", "longueur nulle ."

      End If

    Else

      Err.Raise 11, "GetUpload", "Pas de fichier joint."

    End If

  Else

    Err.Raise 1, "GetUpload", "Mauvaise méthode de request."

  End If

  Set GetUpload = Result

End Function

 

'********************************** SeparateFields **********************************

Function SeparateFields(Binary, Boundary)

  Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary

  Dim Fields

  Boundary = StringToBinary(Boundary)

 

  PosOpenBoundary = InStrB(Binary, Boundary)

  PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

 

  Set Fields = CreateObject("Scripting.Dictionary")

  Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)

    'Entête et fichier source

    Dim HeaderContent, FieldContent, bFieldContent

    'entêtes

    Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type

    'variable

    Dim Field, TwoCharsAfterEndBoundary

    'Fin de l'entête

    PosEndOfHeader = InStrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

 

    'Séparation des champs de l'entêter

    HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

   

    'séparation du contenu

    bFieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

 

    'séparation des champs d'entête de l'entêter

    GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

 

    'Creation d'un champs et attribution des paramètres

    Set Field = CreateUploadField()'See the JS function bellow

    Set FieldContent = CreateBinaryData(bFieldContent,LenB(bFieldContent))

'    FieldContent.ByteArray = bFieldContent

'    FieldContent.Length = LenB(bFieldContent)

 

    Field.Name = FormFieldName

    Field.ContentDisposition = Content_Disposition

    Field.FilePath = SourceFileName

    Field.FileName = GetFileName(SourceFileName)

    Field.ContentType = Content_Type

    Field.Length = FieldContent.Length

    Set Field.Value = FieldContent

 

' response.write "<br>:" & FormFieldName

    Fields.Add FormFieldName, Field

 

    'Dernière borne ?

    TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))

    isLastBoundary = TwoCharsAfterEndBoundary = "--"

 

    If Not isLastBoundary Then 'Putain!!! Pas la dernière... on avance jusqu'au champ suivant.

      PosOpenBoundary = PosCloseBoundary

      PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary)

    End If

  Loop

  Set SeparateFields = Fields

End Function

 

'********************************** Utilities **********************************

 

'Separation des champs d'entête de l'entête uploadé

Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)

  Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))

 

  Name = (SeparateField(Head, "name=", ";")) 'ltrim

  If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)

 

  FileName = (SeparateField(Head, "filename=", ";")) 'ltrim

  If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)

 

  Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))

End Function

 

'Separation du champ entre sStart et sEnd

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

 

'Separation du nom de fichier du chemin

Function GetFileName(FullPath)

  Dim Pos, PosF

  PosF = 0

  For Pos = Len(FullPath) To 1 Step -1

    Select Case Mid(FullPath, Pos, 1)

      Case "/", "\": PosF = Pos + 1: Pos = 0

    End Select

  Next

  If PosF = 0 Then PosF = 1

  GetFileName = Mid(FullPath, PosF)

End Function

 

 

 

Function BinaryToStringSimple(Binary)

  Dim I, S

  For I = 1 To LenB(Binary)

    S = S & Chr(AscB(MidB(Binary, I, 1)))

  Next

  BinaryToStringSimple = S

End Function

 

Function BinaryToString(Binary)

' BinaryToString = RSBinaryToString(Binary)

' Exit Function

 

 

  dim cl1, cl2, cl3, pl1, pl2, pl3

  Dim L', nullchar

  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

 

 

Function RSBinaryToString(xBinary)

 

Dim Binary

 

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)

  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

 

 

 

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

 

 

Function vbsSaveAs(FileName, ByteArray)

  Dim FS, TextStream

  Set FS = CreateObject("Scripting.FileSystemObject")

 

  Set TextStream = FS.CreateTextFile(FileName)

 

    TextStream.Write BinaryToString(ByteArray) ' BinaryToString is in upload.inc.

  TextStream.Close

End Function

 

 

</SCRIPT>

<script RUNAT=SERVER LANGUAGE=JSCRIPT>

 

function CreateUploadField(){ return new uf_Init() }

function uf_Init(){

  this.Name = null

  this.ContentDisposition = null

  this.FileName = null

  this.FilePath = null

  this.ContentType = null

  this.Value = null

  this.Length = null

}

 

 

function CreateBinaryData(Binary, mLength){ return new bin_Init(Binary, mLength) }

function bin_Init(Binary, mLength){

  this.ByteArray = Binary

  this.Length = mLength

  this.String = BinaryToString(Binary)

  this.SaveAs = jsSaveAs

}

//function jsBinaryToString(){

//  return BinaryToString(this.ByteArray)

//};

function jsSaveAs(FileName){

  return vbsSaveAs(FileName, this.ByteArray)

}

//Simulate ByteArray class by JS/VBS - end

 

</SCRIPT>

--------------------------------------------------------------------------

Ufa!!! :wacko:

 

E então... alguém sabe???

 

Valeu galera...

 

Abraços! :lol:

Compartilhar este post

Link para o post
Compartilhar em outros sites

allan.web    0

allan.web
Postado

Ola <%Rafael%>...Eu normalmente uso FSO para verificar se o arquivo existe ou não, mas você pode verificar se o componente que você usa não faz isso para você... de uma olhada na documentação dele.....Espero ter ajudado.Um abraço

Compartilhar este post

Link para o post
Compartilhar em outros sites

<%Rafael%>    0

<%Rafael%>
Postado

Como que você faz essa verificação???

 

Tipo, eu tenho uns arquivos salvos, com uns tutoriais que ensinam a ver se o arquivo existe na pasta... mas não sei onde colocá-los...

 

Teria como você dar uma luz???

 

Tipo, eu teria que fazer um Request do form, pegando o nome do arquivo, e verificando, antes dele fazer upload, se o mesmo já existe na pasta destinada, certo???

 

Mas, pelo que eu li, o ENCTYPE="multipart/form-data" não aceita a instrução Request.Form, certo???

 

Tipo, o código para verificar se um arquivo existe na pasta é:

Set objFS = Server.CreateObject("Scripting.FileSystemObject")

If objFS.FileExists( Server.MapPath("meu_arquivo.html") ) Then

  Response.Write "O arquivo existe"

Else

  Response.Write "O arquivo não existe"

End If

Set objFS = Nothing

Ai, eu precisaria trocar o valor do 'meu_arquivo.asp', por uma variável, que vamos supor, fosse:

var_arquivo = Request.Form("file1")

Então, ai eu teria o código:

var_arquivo = Request.Form("file1")

 

Set objFS = Server.CreateObject("Scripting.FileSystemObject")

If objFS.FileExists( Server.MapPath(""& var_arquivo& "") ) Then

  Response.Write "Esse arquivo já existe!"

Else

  Ai aqui entraria o código para fazer upload... certo???

End If

Set objFS = Nothing

Bom, ai a estrutura ficaria mais ou menos assim como acima... certo??

 

Se você puder colocar seu sistema (códigos), ficaria grato...

 

Abraços!!!! ;)

Compartilhar este post

Link para o post
Compartilhar em outros sites

allan.web    0

allan.web
Postado

Ola.

Bom eu uso assim:

<%if request.QueryString("link") = "insert" then          teste = request.ServerVariables("remote_addr")     data = date     hora = time          Dim objUpload, objUploadedFileDim lstFiles, strPath, str1FileDim strNome, intItem, strMsg Set objUpload = Server.CreateObject("Dundas.Upload.2") objUpload.UseVirtualDir = False objUpload.UseUniqueNames = False objUpload.SaveToMemory Upload_Fotos = ("E:\Paginas Web\mwfdb\new\teste\vdo\controler_all\")strPath = ""&Upload_Fotos&"" lstFiles = ""For Each objUploadedFile in objUpload.Files str1File = objUpload.GetFileName(objUploadedFile.OriginalPath) mes = objUpload.form("data01") set obj = createObject("Scripting.FileSystemObject") var_bol = obj.FileExists ("E:\Paginas Web\mwfdb\new\teste\vdo\controler_all\"&str1File) if var_bol = true then response.write("arquivo existe") response.Redirect("controler.asp?bg=b&link=coisa&arq="&str1File&"")end if set obj = nothing NextFor Each objUploadedFile in objUpload.Files str1File = objUpload.GetFileName(objUploadedFile.OriginalPath) objUploadedFile.SaveAs strPath & str1FileNextresponse.Write str1Fileset objUpload = nothing                   response.Write mes &" - <b>Arquivo</b> " & str1File & " <b>- Tamanho -</b> " & tamanho & " bytes <b>Salvo com sucesso!</b>"        set conexdados = server.createObject ("ADODB.Connection")          conexdados.open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & server.mappath("bd/dados.mdb")        conexdados.execute "insert into controler (arquivo, ip, data, hora, link, mes, tamanho) values ('"&str1File&"','"&teste&"','"&data&"','"&hora&"','"&arquivo&"','"&mes&"','"&tamanho&"')"        conexdados.close            end if%>

Explicação:

Ele pega o arquivo e salva em um diretório virtual, pega o nome dele e compara com os que ja existem naquela pasta (a verificação é toda pelo FSO) e se ja existir ele retorna uma mensagem.. caso não exista ele grava o arquivo e em seguida grava ele em um banco de dados também.

 

Acho que é isso....

 

Qualquer coisa posta ai.

 

Um abraço

Compartilhar este post

Link para o post
Compartilhar em outros sites

<%Rafael%>    0

<%Rafael%>
Postado

Entendi... legal!!!Teria como você por seu sistema para download???Tipo, ai eu adapto pra que for necessário para mim!!!PS>: To tentando ainda com FSO e não tá dando =((Abraços!!!

Compartilhar este post

Link para o post
Compartilhar em outros sites

<%Rafael%>    0

<%Rafael%>
Postado

Opa... novidades quanto ao meu caso UPLOADS... hehe!!!

 

Em casa, estou sem IIS, portanto para testar eu mandava meus arquivos para o servidor...

 

Agora, to no escritório, e aqui tem IIS...

 

O que acontece:

 

 

Se eu mando um arquivo que já existe na pasta para fazer upload, pelo IIS ele não dá erros, sobrescreve o arquivo, e beleza!!! Era isso mesmo que eu precisava!

 

 

Porém, quando eu mando o arquivo para o servidor, se lá eu tento fazer o mesmo (sobrescrever um arquivo, fazendo upload de um que já esteja numa pasta do servidor), ai sim ele apresenta esse erro:

Microsoft VBScript runtime error '800a0046'

 

Permission denied

 

/blog/upload.inc, line 263

Vale lembrar, que minhas pastas TEM permissão para ler e ESCREVER, mesmo porque se não tivesse o arquivo não seria enviado uma primeira vez...

 

Quem quiser testar:

CLIQUE AQUI - UPLOAD TESTE

 

Faça o upload de uma imagem qualquer. Veja que ela será enviada com sucesso, mas se você tentar enviar ela novamente, ela não irá sobrescrever, e irá aparecer uma mensagem de erro, como essa acima...

 

Alguém sabe o porque???

 

Por favor, me ajudem... !!!

 

Abraços galera!!! (y) :D

Compartilhar este post

Link para o post
Compartilhar em outros sites

allan.web    0

allan.web
Postado

Cara... tenta pega um componente de UPLOAD free como o Dundas... vai ficar bem mais facil... Um abraço

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito