Jump to content


giga19

Member Since 19/03/2012
Offline Last Active 08/11/2013, 15:28
-----

Topics I've Started

Upload De Imagem

06/08/2012, 21:16

Olá pessoal....

estou com o seguinte erro:

Microsoft VBScript runtime error '800a0046'

Permission denied

/web/upload.asp, line 59

o código é esse:
<%@ Language=VBScript %>
<%
   
Dim Contador, Tamanho
Dim ConteudoBinario, ConteudoTexto
Dim Delimitador, Posicao1, Posicao2
Dim ArquivoNome, ArquivoConteudo, PastaDestino
Dim objFSO, objArquivo

PastaDestino = Server.MapPath("Uploads")

'Determina o tamanho do conteúdo
Tamanho = Request.TotalBytes

'Obtém o conteúdo no formato binário
ConteudoBinario = Request.BinaryRead(Tamanho)

'Transforma o conteúdo binário em string
For Contador = 1 To Tamanho
  ConteudoTexto = ConteudoTexto & Chr(AscB(MidB(ConteudoBinario, Contador, 1)))
Next 

'Determina o delimitador de campos
Delimitador = Left(ConteudoTexto, InStr(ConteudoTexto, vbCrLf) - 1)

'Percorre a String procurando os campos
'identifica os arquivo e grava no disco
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

Posicao1 = InStr(ConteudoTexto, Delimitador) + Len(Delimitar)

do while True
  ArquivoNome = ""
  Posicao1 = InStr(Posicao1, ConteudoTexto, "filename=")
  if Posicao1 = 0 then
    exit do
  else
   'Determina o nome do arquivo
   Posicao1 = Posicao1 + 10
   Posicao2 = InStr(Posicao1, ConteudoTexto, """")
   For contador = (Posicao2 - 1) to Posicao1 step -1
    if Mid(ConteudoTexto, Contador, 1) <> "\" then '"
      ArquivoNome = Mid(ConteudoTexto, Contador, 1) & ArquivoNome
    else
      exit for
    end if
   next
	
   'Determina o conteúdo do arquivo
   Posicao1 = InStr(Posicao1, ConteudoTexto, vbCrLf & vbCrLf) + 4
   Posicao2 = InStr(Posicao1, ConteudoTexto, Delimitador) - 2
   ArquivoConteudo = Mid(ConteudoTexto, Posicao1, (Posicao2 - Posicao1 + 1))
		
   'Grava o arquivo
    if ArquivoNome <> "" then

 --------linha59--------- Set objArquivo = objFSO.CreateTextFile(PastaDestino & "\" & ArquivoNome, true)
 objArquivo.WriteLine ArquivoConteudo
     objArquivo.Close
		set tb = Banco.execute("select * from imagens where codimagem = '" & session("CodPro") & "'")'verificar Imagem já cadastrada
		if tb.eof = true then
   			SQL = "insert into imagens(codimagem,imagem,numacesso,ultvizualizacao) values ('" & session("CodPro") & "','" & ArquivoNome & "','" & "0" & "','" & "0" & "')"
			set tb = Banco.execute(SQL)	
		else
			SQL = "update imagens set Imagem = '" & ArquivoNome & "' where codimagem =  '" & session("CodPro") & "'"
      		set tb = Banco.execute(SQL)	
		end if	
    
     Set objArquivo = nothing
   end if
end if
Loop
Set objFSO = nothing
%>
destaquei a linha do erro
Se alguém puder me ajudar agradeço desde já

IPB Skin By Virteq