Pessoal, comprei uma loja virtual em asp e vez ou outra preciso resolver alguns problemas. Não sou programador, mas consigo me virar nas literaturas disponíveis. Porém ontem aconteceu um fato inusitado e não consigo resolver, por isso preciso da ajuda de vocês:
No meu cadastro de produtos, tem um código para adicionar a foto do produto ao seu cadastro. Até ontem havia cadastrado 1700 produtos sem problemas. Mas aí surgiu o erro mencionado, sem que tenha havido qualquer alteração no código. Seguem as linhas e o erro:
Agradeço a quem puder ajudar, pois estou com o cadastro de produtos parado por causa disso.
A linha 143 está destacada em negrito.
Erro de tempo de execução do Microsoft VBScript erro '800a01a8'
Objeto necessário: 'Item(...)'
/admin/upload_foto1.asp, linha 143
<%
Sub BuildUploadRequest(RequestBin)
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
pasta_imagens = "../" & Request("pasta")
pasta = Server.URLEncode(Request("pasta"))
campo = Server.URLEncode(Request("campo"))
Set objFS = Server.CreateObject("Scripting.FileSystemObject")
If Not objFS.FolderExists(Server.MapPath(pasta_imagens)) Then
objFS.CreateFolder(Server.MapPath(pasta_imagens))
End if
If Request("enviar") <> "" Then
Set objFS = Nothing
byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin
contentType = UploadRequest.Item("blob").Item("ContentType")
filepathname = UploadRequest.Item("blob").Item("FileName")
filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))
value = UploadRequest.Item("blob").Item("Value")
If Lcase(Right(filename,3)) = "jpg" Or Lcase(Right(filename,3)) = "gif" then
Set objFS = Server.CreateObject("Scripting.FileSystemObject")
If objFS.FileExists( Server.mappath(pasta_imagens & "\" & filename)) Then
%>
<script language=javascript>
alert("Erro ao enviar imagem, o arquivo '<%=filename%>' já existe na pasta '<%=pasta_imagens%>' do seu site")
enviar.disabled = false;
</script>
<%
Else
If LenB(value) > "200000" then
%>
<script language=javascript>
alert("Erro ao enviar a imagem, o tamanho do arquivo deve ser menor que 200Kb")
enviar.disabled = false;
</script>
<%
Else
%>
<strong>Aguarde o envio da imagem...</strong><br>
<input name="progress" value="0% enviado" style="border:none">
<table width="100" border="0" cellspacing="0" cellpadding="0" style="border: 1px inset">
<tr>
<td><input name="barra" style="border:none; background-color: orangered; height: 10; width:1" readonly=""></td>
<td></td>
</tr>
</table>
<%
Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
Set MyFile = ScriptObject.CreateTextFile( Server.mappath(pasta_imagens & "\" & filename))
progress = 0
n = 0
For i = 1 to LenB(value)
MyFile.Write chr(AscB(MidB(value,i,1)))
progress = Fix((i * 100) / LenB(value))
If n <> progress then
n = progress
%>
<script language=javascript>progress.value = "<%=n%>% enviado"</script>
<script language=javascript>barra.style.width = "<%=n%>"</script>
<%
End if
Next
MyFile.Close
' Create instance of AspJpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
' Open source image
imagem = ""&replace(Request.ServerVariables("PATH_TRANSLATED"), "admin\upload_foto1.asp", ""&replace(replace(pasta_imagens, "../", ""), "/", "\")&"") &"\" & filename &""
Jpeg.Open imagem
' New width
L = 185
' Resize, preserve aspect ratio
If jpeg.OriginalWidth > jpeg.OriginalHeight Then
jpeg.Width = L
jpeg.Height = jpeg.OriginalHeight * L / jpeg.OriginalWidth
Else
jpeg.Height = L
jpeg.Width = jpeg.OriginalWidth * L / jpeg.OriginalHeight
End If
' create thumbnail and save it to disk
imagem = ""&replace(replace(Request.ServerVariables("PATH_TRANSLATED"), "admin\upload_foto1.asp", ""&replace(replace(pasta_imagens, "../", ""), "/", "\")&""), "grande", "media") &"\" & filename &""
Jpeg.Save imagem
jpeg.close
set jpeg = nothing
Set Jpeg = Server.CreateObject("Persits.Jpeg")
' Open source image
imagem = ""&replace(Request.ServerVariables("PATH_TRANSLATED"), "admin\upload_foto1.asp", ""&replace(replace(pasta_imagens, "../", ""), "/", "\")&"") &"\" & filename &""
Jpeg.Open imagem
' New width
L = 75
' Resize, preserve aspect ratio
If jpeg.OriginalWidth > jpeg.OriginalHeight Then
jpeg.Width = L
jpeg.Height = jpeg.OriginalHeight * L / jpeg.OriginalWidth
Else
jpeg.Height = L
jpeg.Width = jpeg.OriginalWidth * L / jpeg.OriginalHeight
End If
' create thumbnail and save it to disk
imagem = ""&replace(replace(Request.ServerVariables("PATH_TRANSLATED"), "admin\upload_foto1.asp", ""&replace(replace(pasta_imagens, "../", ""), "/", "\")&""), "grande", "pequena") &"\" & filename &""
Jpeg.Save imagem
jpeg.close
set jpeg = nothing
Set Jpeg = Server.CreateObject("Persits.Jpeg")
' Open source image
imagem = ""&replace(Request.ServerVariables("PATH_TRANSLATED"), "admin\upload_foto1.asp", ""&replace(replace(pasta_imagens, "../", ""), "/", "\")&"") &"\" & filename &""
Jpeg.Open imagem
' New width
L = 600
' Resize, preserve aspect ratio
If jpeg.OriginalWidth > jpeg.OriginalHeight Then
jpeg.Width = L
jpeg.Height = jpeg.OriginalHeight * L / jpeg.OriginalWidth
Else
jpeg.Height = L
jpeg.Width = jpeg.OriginalWidth * L / jpeg.OriginalHeight
End If
' create thumbnail and save it to disk
imagem = ""&replace(Request.ServerVariables("PATH_TRANSLATED"), "admin\upload_foto1.asp", ""&replace(replace(pasta_imagens, "../", ""), "/", "\")&"") &"\" & filename &""
Jpeg.Save imagem
jpeg.close
set jpeg = nothing
%>
<script language=javascript>
envia_imagem('<%=pasta_imagens&"" & "/" & filename%>');
</script>
<%
End If
Set objFS = Nothing
End if
Else
%>
<script language=javascript>
alert("Erro ao enviar a imagem, lembre-se que ela deve possuir extensão JPG ou GIF");
enviar.disabled = false;
</script>
<%
End If
End If
%>
<FORM METHOD="post" ENCTYPE="multipart/form-data" ACTION="<%=Request.ServerVariables("SCRIPT_NAME")%>?campo=<%=campo%>&pasta=<%=pasta%>&enviar=sim" onSubmit="enviar.disabled=true">
Enviar uma nova imagem<BR>
<INPUT type="file" name="blob" class="campos_formulario" style="width: 100%"><BR>
<INPUT type="submit" name="enviar" value="Enviar" class="botao_enviar"><br>
<i>(A imagem deve ter nó máximo 200Kb)</i>
</FORM>
Selecionar uma imagem enviada anteriormente<BR>
<DIV class="titulo_campos" style="width:100%; height:175px; visibility: visible; overflow: auto; border:1px solid">
<%
lista_imagens pasta_imagens, "gif,jpg"
Function lista_imagens( strFolder, tipo )
If Trim( Request.QueryString("folder") ) <> "" Then
strFolder = Request.ServerVariables("APPL_PHYSICAL_PATH") & Request.QueryString("folder")
End If
Dim Folder, File
Dim ObjFS, objRootFolder
Set ObjFS = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = ObjFS.GetFolder(Server.MapPath(strFolder))
For Each File in objFolder.files
tipo = Replace(tipo, ",", "")
For i = 1 to len(tipo) step 3
If Right(File, 3) = Mid(tipo, i, 3) Then
Response.Write " <a href=""javascript: envia_imagem('"&pasta_imagens&"/" & File.Name & "')"" class=""texto_pagina"">" & File.Name & "</a><BR>" & vbcrlf
End If
Next
Next
Response.Write "</td></tr></table>" & vbcrlf
Set objFolder = Nothing
Set Folder = Nothing
End Function
%>