Ir para conteúdo

POWERED BY:

Arquivado

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

Ricardo Galvão

Upload de arquivos apenas com codigo asp

Recommended Posts

olá estou tentando utilizar um script em ASP para fazer upload de fotos, mas está dando um erro e por eu não ser muito experiente não tenho a minima idéia do que seja. se puderem me ajudar agradeço..

salva.asp

 

<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%><html><body><% Set x = new cla_Upload x.processaupload() x.salvararquivos() set x=nothing response.redirect("procure.asp")%> </body></html>upload.asp<% Class cla_Upload Dim myRequest,myRequestFiles,tmpRequestFiles dim crlf Dim bJaProcessou Public property get Variaveis(sVariavel) on error resume next if bJaProcessou then Variaveis=myRequest(sVariavel) end if end property Public Sub ProcessaUpload() if bJaProcessou then 'erro exit sub end if 'Altera o tempo de processamento para arquivos grandes Server.ScriptTimeout = 5400 Const ForWriting = 2 Const TristateTrue = -1 'Recupera os dados postados na forma binária PostData = "" Dim biData biData = Request.BinaryRead(Request.TotalBytes) 'Transforma os dados da forma binária para algo mais legível For nIndex = 1 to LenB(biData) PostData = PostData & Chr(AscB(MidB(biData,nIndex,1))) Next 'Recupera o content type para determinar o encoding dos dados ContentType = Request.ServerVariables( _ "HTTP_CONTENT_TYPE") ctArray = Split(ContentType, ";") 'Se o encoding for '"multipart/form-data", então foi feito upload, damos sequencia ao processamento If Trim(ctArray(0)) = "multipart/form-data" Then ErrMsg = "" ' Obtem o boundery, o separador de variáveis utilizado na transmissão bArray = Split(Trim(ctArray(1)), "=") Boundary = Trim(bArray(1)) 'Usa o Boundary para separar todas as variáveis FormData = Split(PostData, Boundary) 'Criação de 3 scripting.dictionary que guardarão as informações Set myRequest = CreateObject("Scripting.Dictionary") set myRequestFiles=CreateObject("Scripting.Dictionary") FileCount = 1 For x = 0 to UBound(FormData) set tmpRequestFiles=CreateObject("Scripting.Dictionary") 'Faz a localização de dois caracteres crlf que 'Marcam o fim dos metadados do campo e inicio dos dados propriamente InfoEnd = InStr(FormData(x), CrLf & CrLf) If InfoEnd > 0 Then 'Pega as informações sobre o campo varInfo = Mid(FormData(x), 3, InfoEnd - 3) 'Pega o valor do campo, evitando os 2 crlf no inicio 'e o crlf que encontra-se no final varValue = Mid(FormData(x), InfoEnd + 4, _ Len(FormData(x)) - InfoEnd - 7) 'Verifica se trata-se de um arquivo ou de uma variável qualquer If (InStr(varInfo, "filename=") > 0) Then 'Monta um script dictionary com as informações sobre o arquivo tmpRequestFiles.add "nome",GetFieldName(varInfo) tmpRequestFiles.add "conteudo",varValue tmpRequestFiles.add "filename",GetFileName(varInfo) tmpRequestFiles.add "filetype",GetFileType(varInfo) 'Insere o script dictionary montado dentro de outro, contendo 'Todos os arquivos que levaram upload MyRequestFiles.ADD "arq" & FileCount,tmpRequestFiles FileCount = FileCount + 1 Else 'É um campo comum myRequest.add GetFieldName(varInfo), varValue End If End If Next Else ErrMsg = "Falha no Encoding Type!" End If bjaprocessou=true End Sub Sub class_Initialize bJaprocessou=false CrLf = Chr(13) & Chr(10) end Sub Public Sub SalvarArquivos() dim icnt icnt=1 do while icnt<=myRequestFiles.Count set tmprequestfiles=myrequestfiles.Item("arq" & icnt) Set lf = server.createObject("Scripting.FileSystemObject") ' para utilizar o nome do arquivo original é necessário 'determinar que tipo de client enviou o arquivo. 'clientes Macintosh enviam apenas o nome do arquivo 'sem path, enquanto clientes Windows 'enviam o caminho inteiro do arquivo selecionado BrowserType = UCase(Request.ServerVariables( "HTTP_USER_AGENT")) If (InStr(BrowserType, "WIN") > 0) Then 'Sendo Windows, obtem o nome do arquivo do final do path sPos = InStrRev(tmprequestfiles("filename"), "\") fName = Mid(tmprequestfiles("filename"), sPos + 1) End If If (InStr(BrowserType, "MAC") > 0) Then 'Neste caso apenas o nome do arquivo foi recebido fName = tmprequestfiles("filename") End If 'se fizer um upload para um caminho diferente, altere aqui FilePath = "/global/Upload/" & fName SavePath = Server.MapPath(FilePath) Set SaveFile = lf.CreateTextFile(SavePath, True) SaveFile.Write(tmprequestfiles("conteudo")) SaveFile.Close icnt=icnt+1 loop End Sub 'Esta função recupera o nome de um campo Private Function GetFieldName(infoStr) sPos = InStr(infoStr, "name=") EndPos = InStr(sPos + 6, infoStr, Chr(34) & ";") If EndPos = 0 Then EndPos = inStr(sPos + 6, infoStr, Chr(34)) End If GetFieldName = Mid(infoStr, sPos + 6, endPos - (sPos + 6)) End Function 'Esta função recupera o filename de um arquivo Private Function GetFileName(infoStr) sPos = InStr(infoStr, "filename=") EndPos = InStr(infoStr, Chr(34) & CrLf) GetFileName = Mid(infoStr, sPos + 10, EndPos - (sPos + 10)) End Function 'Esta função recupera o MIME type de um arquivo Private Function GetFileType(infoStr) sPos = InStr(infoStr, "Content-Type: ") GetFileType = Mid(infoStr, sPos + 14) End Function End Class dim xSet x = new cla_upload x.processaupload() x.salvararquivos() set x=nothing response.redirect("sucesso.asp")%>

Tipo de erro:

Erro de tempo de execução do Microsoft VBScript (0x800A01A8)

Objeto necessário: '3'

/fs/upload.asp, line 148

Compartilhar este post


Link para o post
Compartilhar em outros sites

x.salvararquivos() É a linha da chamada da sub salvar arquivos (), mas não consigo localizar o que pode estar faltando nesta sub. Aparece: Ojetos necessários 3, que objetos são esses ??Public Sub SalvarArquivos() dim icnt icnt=1 do while icnt<=myRequestFiles.Count set tmprequestfiles=myrequestfiles.Item("arq" & icnt) Set lf = server.createObject("Scripting.FileSystemObject") ' para utilizar o nome do arquivo original é necessário 'determinar que tipo de client enviou o arquivo. 'clientes Macintosh enviam apenas o nome do arquivo 'sem path, enquanto clientes Windows 'enviam o caminho inteiro do arquivo selecionado BrowserType = UCase(Request.ServerVariables( "HTTP_USER_AGENT")) If (InStr(BrowserType, "WIN") > 0) Then 'Sendo Windows, obtem o nome do arquivo do final do path sPos = InStrRev(tmprequestfiles("filename"), "\") fName = Mid(tmprequestfiles("filename"), sPos + 1) End If If (InStr(BrowserType, "MAC") > 0) Then 'Neste caso apenas o nome do arquivo foi recebido fName = tmprequestfiles("filename") End If 'se fizer um upload para um caminho diferente, altere aqui FilePath = "C:\Inetpub\wwwroot\FS\teste\" & fName SavePath = Server.MapPath(FilePath) Set SaveFile = lf.CreateTextFile(SavePath, True) SaveFile.Write(tmprequestfiles("conteudo")) SaveFile.Close icnt=icnt+1 loop End SubSe eu comento a chamada da sub salva arquivos (x.salvararquivos() ), o arquivo roda sem erros

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

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