Jump to content
Fórum Script Brasil
  • 0

Codigo Do Dark - Upload Sem Componentes


luciano.soares
 Share

Question

Pessoal peguei o Codigo do Dark para uso de upload sem componentes, somente o codigo, fiz umas modificações para o que eu precisa, porem não esta funcionando, alguém pode me ajudar ?

Me sistema deve atualizar registros em banco em access de noticias e artigos com imagens (para isso preciso do upload) referente a cada artigo. Vejam:

Formulario modificado por mim:

<!-- #include file = "upload_funcoes.asp" -->

<body bgcolor="#C5DDC5">

<p><img src="../1024_2_arquivos/00000001_r1_c1.jpg" width="183" height="91"></p>

<table>

<form name="form1" action="upload_form2.asp" method="post" enctype="multipart/form-data">

<tr>

<td width="32">Foto:</td>

<td width="284"><input type="file" name="foto" size="30"></td>

</tr>

<tr>

<td colspan="2"> <input type="submit" name="submit" value="Enviar"> </td>

</tr>

</form>

</table>

Upload_funções.asp modificado por mim :

<!-- #include file = "upload_funcoes.asp" -->

<%

' Chamando Funções, que fazem o Upload funcionar

byteCount = Request.TotalBytes

RequestBin = Request.BinaryRead(byteCount)

Set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest RequestBin

' Recuperando os Dados Digitados ----------------------

'nome = UploadRequest.Item("nome").Item("Value")

'email = UploadRequest.Item("email").Item("Value")

' Tipo de arquivo que esta sendo enviado

tipo_foto = UploadRequest.Item("foto").Item("ContentType")

' Caminho completo dos arquivos enviados

caminho_foto = UploadRequest.Item("foto").Item("FileName")

' Nome dos arquivos enviados

nome_foto = Right(caminho_foto,Len(caminho_foto)-InstrRev(caminho_foto,"\"))

' Conteudo binario dos arquivos enviados

foto = UploadRequest.Item("foto").Item("Value")

' pasta onde as imagens serao guardadas

pasta = Server.MapPath("imagens/")

nome_foto = "/"&nome_foto

' pasta + nome dos arquivos

cfoto = "imagens/lojas" + nome_foto

' Fazendo o Upload do arquivo selecionado

if foto <> "" then

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

Set MyFile = ScriptObject.CreateTextFile(pasta & nome_foto)

For i = 1 to LenB(foto)

MyFile.Write chr(AscB(MidB(foto,i,1)))

Next

MyFile.Close

end if

' Conecta-se ao Banco de Dados

url_conexao = Server.MapPath("e:\home\gan-nutricao\dados\microfinancas.mdb")

set conexao = Server.CreateObject("ADODB.Connection")

conexao.open "DRIVER={Microsoft Access Driver (microfinancas.mdb)};DBQ="&url_conexao

'on error resume next

'Set conn_tt = Server.CreateObject("ADODB.Connection")

'conn_tt.Open Application("stringconn")

' cadastra os dados no banco de dados

sql = "Insert into clipping2 (foto) values ('"& cfoto &"')"

conexao.Execute(sql)

' Mostra Mensagem de Confirmação na Tela

Response.write "Dados Cadastrados com Sucesso!"

' Redireciona após 5 segundos

response.write "<br><br>você será redirecionado em 5 segundos..<br>"

response.write "<meta http-equiv='refresh' content='5; url=index.asp'/>"

%>

Upload_funcoes.asp não foi modificado:

<%

' Upload Sem componentes ---------------------------------------

Sub BuildUploadRequest(RequestBin)

on error resume next

PosBeg = 1

PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13)))

boundary = MidB(RequestBin, PosBeg, PosEnd - PosBeg)

BoundaryPos = InStrB(1, RequestBin, boundary)

Do Until (BoundaryPos = InStrB(RequestBin, boundary & getByteString("--")))

Dim UploadControl

Set UploadControl = CreateObject("Scripting.Dictionary")

Pos = InStrB(BoundaryPos, RequestBin, getByteString("Content-Disposition"))

Pos = InStrB(Pos, RequestBin, getByteString("name="))

PosBeg = Pos + 6

PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))

Name = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))

PosFile = InStrB(BoundaryPos, RequestBin, getByteString("filename="))

PosBound = InStrB(PosEnd, RequestBin, boundary)

If PosFile <> 0 And (PosFile < PosBound) Then

PosBeg = PosFile + 10

PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))

FileName = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))

UploadControl.Add "FileName", FileName

Pos = InStrB(PosEnd, RequestBin, getByteString("Content-Type:"))

PosBeg = Pos + 14

PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13)))

ContentType = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))

UploadControl.Add "ContentType", ContentType

PosBeg = PosEnd + 4

PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2

Value = MidB(RequestBin, PosBeg, PosEnd - PosBeg)

Else

Pos = InStrB(Pos, RequestBin, getByteString(Chr(13)))

PosBeg = Pos + 4

PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2

Value = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))

End If

UploadControl.Add "Value", Value

UploadRequest.Add Name, UploadControl

BoundaryPos = InStrB(BoundaryPos + LenB(boundary), RequestBin, boundary)

Loop

End Sub

Function getByteString(StringStr)

For i = 1 To Len(StringStr)

Char = Mid(StringStr, i, 1)

getByteString = getByteString & ChrB(AscB(Char))

Next

End Function

Function getString(StringBin)

getString = ""

For intCount = 1 To LenB(StringBin)

getString = getString & Chr(AscB(MidB(StringBin, intCount, 1)))

Next

End Function

' Fim upload sem Componentes -----------------------------------------

%>

Quando testo ele apresenta o ERRO:

Microsoft VBScript runtime error '800a0046'

Permission denied

/sco/upload_form2.asp, line 35

Gostaria de ajuda, pois preciso entregar esse trabalho e isso esta me matando.

Obrigado

Link to comment
Share on other sites

4 answers to this question

Recommended Posts

  • 0

você não deve ter permissõs de escrita na pasta onde quer mandar o arquivo.

já usei este mesmo script, mas modifiquei de acordo com minhas necessidades.

os diretorios, alterar o nome do arquivo de letras para números: de: foto.jpg para: 012541445.jpg

assim evitasse fotos com nomes iguais.

funcionou legal local e no host na web. Apenas ttive que alterar as permissoes da pasta.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share



  • Forum Statistics

    • Total Topics
      151k
    • Total Posts
      649.1k
×
×
  • Create New...