Problema al subir imagen con ASP

lalitovilla · #1 (**permalink**) 04/11/2009, 09:59

Les cuento, tengo 2 archivos, uno IngresaArticulo.asp y otro FrmArcticulo.asp.
Lo que quiero realizar es poder subir una noticia a travez del sgte. formulario:

Código HTML:

<%
conecta= "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & server.MapPath("productos.mdb")  
   
Set oconn = Server.CreateObject("ADODB.Connection")
oconn.Open  conecta
Sql = "SELECT * from noticias"
Set RS = Server.CreateObject ("ADODB.RecordSet")
RS.Open sql, oConn
%>
<head>
<!--#include file="clsUpload.asp"-->
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title></title>
<link rel="stylesheet" type="text/css" href="style.css" media="screen" />
</head>
<body>
<div id="wrapper">
		</div>
		<div id="banner"><img src="images/9280noticias.jpg" width="667" height="118" alt="" /></div>
	</div>
	<div id="menu" class="container">
		<ul>
			<li class="active"><a href="indexinicio.asp">Noticias</a></li>
			<li><a href="indexavisos.asp">Avisos</a></li>
		
		</ul>
	</div>
	<div id="top-bar" class="container">
		<div class="bar">
			<div class="text">Bienvenido(a) <%= Request.Form("name")%>, te has conectado desde la dirección IP: <% Response.Write Request.ServerVariables("REMOTE_ADDR") %> </div>
			<div id="search">
				<form nmethod="get" action="">
					<fieldset>
						<input type="text" name="query" value="" class="input-text" />
						<input type="submit" value="Search" class="input-submit" />
					</fieldset>
				</form>
			</div>
		</div>
	</div>
	<div id="page" class="container">
	  <div id="content">
	    <p>&nbsp;</p>
	    <form name="frmIngreso" action="IngresaArticulo.asp" method="POST" ENCTYPE="multipart/form-data">
	      <table width="300" border="1">
  <tr>
    <td colspan="2" bgcolor="#000000">
	  <div align="center"><span class="style2"><font color="#FF0000">INGRESE SU NOTICIA AQUÍ</font><strong><span class="style3"></span></strong></span> </div></td>

  <tr>
    <td>Encabezado</td>
	<td><input name="encabezado" type="text" size="60" /></td>
  </tr>
  <tr>
    <td>Resumen</td>
    <td><textarea name="resumen" cols="40" rows="2"></textarea></td>
  </tr>
  <tr>
    <td>Cuerpo</td>
    <td><textarea name="cuerpo" cols="50" rows="4"></textarea></td>
  </tr>
  <tr>
    <td>fecha</td>
    <td><input name="fecha" type="text" size="10" maxlength="10" /></td>
  </tr>
  <tr>
<td>Archivo: </td><td><INPUT TYPE=FILE NAME="txtFile"></td>
</tr>
  <tr>
    <td colspan="2"><div align="center">
      <input type="submit" value="Aceptar"/>
      <input type="reset" value="Borrar"/>
    </div></td>
  </tr>
  
</table>

</form>
	    <div class="post"></div>
	  </div>
		<div class="clearfix">&nbsp;</div>
  </div>
</div>
<div id="footer" class="container">
</div>
</body>
</html>

, luego tengo el sgte. codigo para la insercion de la imagen:

Código HTML:

<%
conecta= "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & server.MapPath("productos.mdb")  
   
Set oconn = Server.CreateObject("ADODB.Connection")
oconn.Open  conecta
Sql = "SELECT * from noticias"
Set RS = Server.CreateObject ("ADODB.RecordSet")
RS.Open sql, oConn
%>
<head>
<!--#include file="clsUpload.asp"-->
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title></title>
<link rel="stylesheet" type="text/css" href="style.css" media="screen" />
</head>
<body>
<div id="wrapper">
	<div id="header" class="container">
		<div id="logo">
			<h1><a href="#">Newz+cias<sup></sup></a></h1>
		</div>
		<div id="banner"><img src="images/9280noticias.jpg" width="667" height="118" alt="" /></div>
	</div>
	<div id="menu" class="container">
		<ul>
			<li class="active"><a href="indexinicio.asp">Noticias</a></li>
			<li><a href="indexavisos.asp">Avisos</a></li>
		
		</ul>
	</div>
	<div id="top-bar" class="container">
		<div class="bar">
			<div class="text">Bienvenido(a) <%= Request.Form("name")%>, te has conectado desde la direccin IP: <% Response.Write Request.ServerVariables("REMOTE_ADDR") %> </div>
			<div id="search">
				<form nmethod="get" action="">
					<fieldset>
						<input type="text" name="query" value="" class="input-text" />
						<input type="submit" value="Search" class="input-submit" />
					</fieldset>
				</form>
			</div>
		</div>
	</div>
	<div id="page" class="container">
	  <div id="content">
	    <p>&nbsp;</p>
<%
set o = new clsUpload
if o.Exists("cmdSubmit") then

'get client file name without path
sFileSplit = split(o.FileNameOf("txtFile"), "\")
sFile = sFileSplit(Ubound(sFileSplit))

archivo = split(sFile,".")
extension = archivo(Ubound(archivo))



'response.Write "archivo=" & noticia & "<br>"
if extension<>"jpg" then
	response.Write "no puede subir archivos que no sean jpg"
else

	o.FileInputName = "txtFile"
	o.FileFullPath = Server.MapPath(".") & "\archivo\" & sFile
	o.save
	end if

conecta= "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & server.MapPath("productos.mdb") 
   Set oconn = Server.CreateObject("ADODB.Connection")
   oconn.Open  conecta
	Sql = "insert into noticias(" & _
	"encabezado" & _
	",resumen" & _
	",cuerpo" & _
	",fecha" & _
	",fotografia" 	& _
	") values(" & _
	"'" & o.ValueOf("encabezado")	& "'"  	& _
	",'" & o.ValueOf("resumen")	& "'"  	& _
	",'" & o.ValueOf("cuerpo")  & "'"  	& _
	",'" & o.ValueOf("fecha")  & "'"  	& _
	",'" & sFile	& "'"  	& _
	")"
	oconn.execute(sql)
	'response.Write(sql)
	Oconn.Close
set oconn = nothing
end if
%>
Registro Insertado <a href="indexinicio.asp">Regresar</a>
	    <div class="post"></div>
	  </div>
		<div id="sidebar">
			<ul>
			  <li>
			    <h2>Administrar</h2>
			  </li>
			  <li><a href="indexinicio.asp">Volver</a></li>
			  <li> </li>
			  <li>
<div id="footer" class="container">
</div>
</body>
</html>


<body>
</body>
</html>

¿Entonces cual es mi duda?
Se supone que al rellenar el formulario, y buscar el archivo de imagen y darle en el boton aceptar, deberia registrarse la noticia. Pues claro, me aparece en pantalla "registro ingresado", pero para mi sorpresa cuando voy a ver mi index, no sea registrado mi nueva noticia y tampoco en mi base de datos acces.

Todo esto esta atraves del include clsUpload

Help me!!

Adler · #2 (**permalink**) 04/11/2009, 12:23

Hola

Siempre te va a levantar "Registro Insertado" ya que esta fuera de la condicional.
Veo que ya tienes response.Write(sql) ¿Lo has usado? Si lo has usado y todo es correcto, podrías mostrarnos la clase

Suerte

lalitovilla · #3 (**permalink**) 04/11/2009, 13:58

Cita:

Iniciado por Adler

Hola

Siempre te va a levantar "Registro Insertado" ya que esta fuera de la condicional.
Veo que ya tienes response.Write(sql) ¿Lo has usado? Si lo has usado y todo es correcto, podrías mostrarnos la clase

Suerte

Lo siento Adler, pero no entiendo a lo que te refieres con clases, algo se de programacion en asp y html, pero si fueras mas especifico por favor...
Algo hice con respecto a lo que me djiste, pero no se si esta bn...
Descomente la parte donde decia response.write(sql), pero no paso nada...

Adler · #4 (**permalink**) 05/11/2009, 05:36

Hola

Muestranos el contenido del archivo clsUpload.asp y también el resultado que te muestra el bug, es decir cuando descomentas response.write(sql)

Suerte

lalitovilla · #5 (**permalink**) 05/11/2009, 10:04

Ahi esta el clsUpload.asp :

Código HTML:

<%
Class clsField
	Public FileName
	Public ContentType
	Public Value
	Public FieldName
	Public Length
	Public BinaryData
End Class
Class clsUpload
	Private nFieldCount
	Private oFields()
	Private psFileFullPath
	Private psError
	Private psFileInputName
	Public Property Get Count()
		Count = nFieldCount
	End Property
	Public Default Property Get Field(ByRef asFieldName)
		Dim lnLength
		Dim lnIndex
		
		lnLength = UBound(oFields)
		
		If IsNumeric(asFieldName) Then
			If lnLength >= asFieldName And asFieldName > -1 Then
				Set Field = oFields(asFieldName)
			Else
				Set Field = New clsField
			End If
		Else
			For lnIndex = 0 To lnLength
				If LCase(oFields(lnIndex).FieldName) = LCase(asFieldName) Then
					Set Field = oFields(lnIndex)
					Exit Property
				End If
			Next
			Set Field = New clsField
		End If
	End Property

	Public Function Exists(ByRef avKeyIndex)
		Exists = Not IndexOf(avKeyIndex) = -1
	End Function
	Public Property Get ValueOf(ByRef avKeyIndex)
		Dim lnIndex
		lnIndex = IndexOf(avKeyIndex)
		if lnIndex = -1 Then Exit Property
		ValueOf = oFields(lnIndex).Value
	End Property
	Public Property Get FileNameOf(ByRef avKeyIndex)
		Dim lnIndex
		lnIndex = IndexOf(avKeyIndex)
		if lnIndex = -1 Then Exit Property
		FileNameOf = oFields(lnIndex).FileName
	End Property
	Public Property Get LengthOf(ByRef avKeyIndex)
		Dim lnIndex
		lnIndex = IndexOf(avKeyIndex)
		if lnIndex = -1 Then Exit Property
		LengthOf = oFields(lnIndex).Length
	End Property
	Public Property Get BinaryDataOf(ByRef avKeyIndex)
		Dim lnIndex
		lnIndex = IndexOf(avKeyIndex)
		if lnIndex = -1 Then Exit Property
		BinaryDataOf = oFields(lnIndex).BinaryData
	End Property
' ------------------------------------------------------------------------------
	Private Function IndexOf(ByVal avKeyIndex)
		Dim lnIndex
		
		If avKeyIndex = "" Then
			IndexOf = -1
		ElseIf IsNumeric(avKeyIndex) Then
			avKeyIndex = CLng(avKeyIndex)
			If nFieldCount > avKeyIndex And avKeyIndex > -1 Then
				IndexOf = avKeyIndex
			Else
				IndexOf = -1
			End If
		Else
			For lnIndex = 0 To nFieldCount - 1
				If LCase(oFields(lnIndex).FieldName) = LCase(avKeyIndex) Then
					IndexOf = lnIndex
					Exit Function
				End If
			Next
			IndexOf = -1
		End If
	End Function
' ------------------------------------------------------------------------------
Public Property Let FileFullPath(sValue)
	psFileFullPath = sValue
End Property
'___________________________________________________________________________________
Public Property Get FileFullPath()
	FileFullPath = psFileFullPath 
End Property
' ------------------------------------------------------------------------------
Public Property Let FileInputName(sValue)
	psFileInputName = sValue
End Property
' --------------------	----------------------------------------------------------
Public Function Save()
	if psFileFullPath <> "" and psFileInputName <> "" then
		'Save to connectionless client side recordset, write to stream,
		'and persist stream.

		'would think you should be able to write directly to
		'stream without recordset, but I could not get that to work

		On error resume next
		binData = o.BinaryDataOf(psFileInputName)
	
		set rs = server.createobject("ADODB.RECORDSET")
		rs.fields.append "FileName", 205, LenB(binData)
		rs.open
		rs.addnew
 		rs.fields(0).AppendChunk binData 
		
		if err.number = 0 then
			set objStream = Server.CreateObject("ADODB.Stream")
  			objStream.Type  = 1
   			objStream.Open
 			objStream.Write rs.fields("FileName").value 
			objStream.SaveToFile psFileFullPath, 2
			objStream.close
			set objStream = Nothing

		ENd if
		rs.close
		set rs = nothing
		psError = Err.Description
else
		psError = "One or more required properties (FileFullPath and/or FileInputName) not set"

  End If


End Function

Public Property Get Error()
	Error = psError
End Property


' ------------------------------------------------------------------------------
	Public Property Get ContentTypeOf(ByRef avKeyIndex)
		Dim lnIndex
		lnIndex = IndexOf(avKeyIndex)
		if lnIndex = -1 Then Exit Property
		ContentTypeOf = oFields(lnIndex).ContentType
	End Property

' ------------------------------------------------------------------------------
	Private Sub Class_Terminate()
		Dim lnIndex
		For lnIndex = 0 To nFieldCount - 1
			Set oFields(0) = Nothing
		Next
	End Sub
' ------------------------------------------------------------------------------
	Private Sub Class_Initialize()
		
		Dim lnBytes				' Bytes received from the client
		Dim lnByteCount			' Number of bytes received
		Dim lnStartPosition		' Position at which content begins
		Dim lnEndPosition		' Position at which content ends
		
		Dim loDic				' Contains properties of each
								' specific field
								' Local dictionary object(s) 
								' to be appended to class-scope
								' dictioary object.
								
		Dim lnBoundaryBytes		' Bytes contained within the current boundary
		Dim lnBoundaryStart		' Position at wich the current boundary begins
								' within the lnBytes binary data.
		Dim lnBoundaryEnd		' Position at wich the current boundary ends
								' within the lnBytes binary data.
		Dim lnDispositionPosition
		
		Dim lsFieldName			' Name of the current field being parsed from
								' Binary Data
		Dim lsFileName			' Name of the file within the current boundary
		Dim lnFileNamePosition	' Location of file name within current boundary
		Dim loField				' clsField Object
		Dim lsValue				' Value of the current field
		Dim lsContentType		' ContentType of the binary file (MIME Type)
		
		' Initialize Fields
		nFieldCount = 0
		ReDim oFields(-1)
		
		' Read the bytes (binary data) into memory	
		lnByteCount = Request.TotalBytes
		lnBytes = Request.BinaryRead(lnByteCount)
		
		'Get the lnBoundaryBytes
		lnStartPosition = 1
		lnEndPosition = InstrB(lnStartPosition, lnBytes, CStrB(vbCr))
		
		If lnEndPosition >= lnStartPosition Then
			lnBoundaryBytes = MidB(lnBytes, lnStartPosition, lnEndPosition - lnStartPosition)
		End If
		
		lnBoundaryStart = InstrB(1, lnBytes, lnBoundaryBytes)
		
		
		' Loop until the BoundaryBytes begin with "--"
		Do Until (lnBoundaryStart = InstrB(lnBytes, lnBoundaryBytes & CStrB("--")))
		
			' All data within this boundary is stored within a local dictionary
			' to be appended to the class-scope dictionary.
			
			ReDim Preserve oFields(nFieldCount)
			nFieldCount = nFieldCount + 1
			
			Set loField = New clsField

			lnDispositionPosition = InstrB(lnBoundaryStart, lnBytes, CStrB("Content-Disposition"))
			
			' Get an object name
			lnStartPosition = InstrB(lnDispositionPosition, lnBytes, CStrB("name=")) + 6
			lnEndPosition = InstrB(lnStartPosition, lnBytes, CStrB(""""))
			lsFieldName = CStrU(MidB(lnBytes, lnStartPosition, lnEndPosition - lnStartPosition))
			loField.FieldName = lsFieldName
			
			' Get the location fo the file name.
			lnFileNamePosition = InstrB(lnBoundaryStart, lnBytes, CStrB("filename="))
			lnBoundaryEnd = InstrB(lnEndPosition, lnBytes, lnBoundaryBytes)
			
			'Test if object is a file
			If Not lnFileNamePosition = 0 And lnFileNamePosition < lnBoundaryEnd Then
			
				' Parse Filename
				lnStartPosition = lnFileNamePosition + 10
				lnEndPosition =  InstrB(lnStartPosition, lnBytes, CStrB(""""))
				lsFileName = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
				loField.FileName = lsFileName				
				
				' Parse Content-Type
				lnStartPosition = InstrB(lnEndPosition,lnBytes,CStrB("Content-Type:")) + 14
				lnEndPosition = InstrB(lnStartPosition,lnBytes,CStrB(vbCr))
				lsContentType = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
				loField.ContentType = lsContentType

				' Parse Content
				lnStartPosition = lnEndPosition + 4
				lnEndPosition = InstrB(lnStartPosition,lnBytes,lnBoundaryBytes)-2
				lsValue = MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition)
				loField.BinaryData = lsValue & CStrB(vbNull)
				loField.Length = LenB(lsValue)
			Else

				' Parse Content
				lnStartPosition = InstrB(lnDispositionPosition, lnBytes, CStrB(vbCr)) + 4
				lnEndPosition = InstrB(lnStartPosition, lnBytes, lnBoundaryBytes) - 2
				lsValue = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
				loField.Value = lsValue
				loField.Length = Len(lsValue)
			End If

			Set oFields(UBound(oFields)) = loField

			'Loop to next object
			lnBoundaryStart = InstrB(lnBoundaryStart + LenB(lnBoundaryBytes), lnBytes, lnBoundaryBytes)
			
			Set loField = Nothing
			
		Loop

	End Sub
' ------------------------------------------------------------------------------
	Private Function CStrU(ByRef psByteString)
		Dim lnLength
		Dim lnPosition
		lnLength = LenB(psByteString)
		For lnPosition = 1 To lnLength
			CStrU = CStrU & Chr(AscB(MidB(psByteString, lnPosition, 1)))
		Next
	End Function
' ------------------------------------------------------------------------------
	Private Function CStrB(ByRef psUnicodeString)
		Dim lnLength
		Dim lnPosition
		lnLength = Len(psUnicodeString)
		For lnPosition = 1 To lnLength
			CStrB = CStrB & ChrB(AscB(Mid(psUnicodeString, lnPosition, 1)))
		Next
	End Function
' ------------------------------------------------------------------------------
End Class
' ------------------------------------------------------------------------------
%>

Y cuando descomento me sale tal cual como si estuviera comentado, ningun error, nada!

Adler · #6 (**permalink**) 05/11/2009, 12:41

Hola

Cuando lo descomentas ¿se imprime algo parecido a esto?

Cita:

insert into noticias(encabezado,resumen,cuerpo,fecha,fotografi a) values('Una imagen','Resumen de la imagen','No lo entiendo','05/11/2009','img.gif')

Suerte

lalitovilla · #7 (**permalink**) 05/11/2009, 12:49

Cita:

Iniciado por Adler

Hola

Cuando lo descomentas ¿se imprime algo parecido a esto?

Suerte

No aparece en blanco

Adler · #8 (**permalink**) 06/11/2009, 06:46

Hola

... no te imprime nada

Prueba ahora

Cita:

'response.Write "archivo=" & noticia & "<br>"
if extension<>"jpg" then
response.Write "no puede subir archivos que no sean jpg"
else

o.FileInputName = "txtFile"
o.FileFullPath = Server.MapPath(".") & "\archivo\" & sFile
o.save
end if

Set oconn = Server.CreateObject("ADODB.Connection")
oconn= "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & server.MapPath("productos.mdb")

Sql = "insert into noticias(" & _
"encabezado" & _
",resumen" & _
",cuerpo" & _
",fecha" & _
",fotografia" & _
") values(" & _
"'" & o.ValueOf("encabezado") & "'" & _
",'" & o.ValueOf("resumen") & "'" & _
",'" & o.ValueOf("cuerpo") & "'" & _
",'" & o.ValueOf("fecha") & "'" & _
",'" & sFile & "'" & _
")"
oconn.execute(sql)
response.Write(sql)
oconn.Close
set oconn = nothing
end if

Suerte