Foros del Web - Ver Mensaje Individual

jonathan.m.a · #12 (**permalink**) 12/03/2007, 10:12

Hola de nuevo, lo ideal seria programar un componente tipo smartupload, pero ya que el tiempo no apremia he buscado la clase xelupload y la he adaptado para utilizar un pequeño componente dll activex, este le proporciona unicamente las funciones para poder decodificar más rapido, como no puedo adjuntar archivos

lo voy pegando y solo sigue los pasos:

Los 2 siguientes archivos pertenecen a la clase xelupload programada por:

Código HTML:

ht tp://ww w.aspfacil.com

Archivos originales:

Código HTML:

ht tp://ww w.aspfacil.c om/codigo/xelupload.zip

Una Rfc al respecto:

Código:

ht tp://ww w.ietf.o rg/rfc/rfc2388.txt

Datos extraidos de:

Código HTML:

ht tp://ww w.aspfacil.c om

Las modificaciones siguientes han sido realizadas por Jonathan M.A.

Archivo: 'xleupload.asp'

Código:

<%
'#################################################
'																									
'	Fichero:			xelupload.asp
'	Descripción:		contiene las clases 
'						"xelUpload" y "Fichero"
'						escritas en VBScript
'
'	Autor:				Carlos de la Orden Dijs
'	Email:				[email protected]
'	Fecha:				Septiembre 2001
'	Documentación:		LEEME.TXT
'
'				Ultima versión en 
'	 		ht-tp://ww-w.aspfacil.c-om/
'	
'-------------------------------------------------
'			Ultima modificación	6/9/2001 
'#################################################

'#################################################
' Clase:       xelUpload.asp
' Revisión:    1.0.2007.03.12
' Autor:       Jonathan M.A
' Descripción: 
'Modificación de las funciones str2byte, byte2str
'Guardar y GuardarComo
Private oAspFunc
'#################################################


Class xelUpload
' Maneja los formularios enviados como 'multipart/form-data' (ficheros)

Public Ficheros
Private eltosForm

'------------------------------------------------------------------------
Private Sub Class_Initialize()
	set Ficheros = Server.CreateObject("Scripting.Dictionary")
	set eltosForm = Server.CreateObject("Scripting.Dictionary")
	
	'Cargar el objecto axAspUtils.clsAspFunctions
	On Error Resume Next 
	Set oAspFunc = Server.CreateObject("axAspUtils.clsAspFunctions")
End Sub
'------------------------------------------------------------------------
Private Sub Class_Terminate()
	if IsObject(Ficheros) then
		Ficheros.RemoveAll
		set Ficheros = nothing
	end if
	if IsObject(eltosForm) then
		eltosForm.RemoveAll
		set eltosForm = nothing
	end if
	
	'Eliminar el objeto axAspUtils.clsAspFunctions
	If IsObject(oAspFunc) Then Set oAspFunc = Nothing
End Sub
'------------------------------------------------------------------------
'Permite hacer, por ejemplo: Response.Write(upload.Form("nombre"))
Public Property Get Form(campo)
	if eltosForm.Exists(campo) then
		Form = eltosForm.Item(campo)
	else
		Form = ""
	end if
End Property
'------------------------------------------------------------------------

Public Function IsLoadAspFunc()
	IsLoadAspFunc = IsObject(oAspFunc)
End Function 

Public Sub Upload()
	'Inicia el proceso. Debe llamarse ANTES DE HACER CUALQUIER OTRA COSA

	Dim byteDatos, strControl
	Dim iPosInicio, iPosFin, iPos, byteLimite, posLimite
	Dim iPosFich, iPosLim

	byteDatos = Request.BinaryRead(Request.TotalBytes)
	iPosInicio = 1
	iPosFin = InStrB(iPosInicio, byteDatos, str2byte(chr(13)))
	'terminamos, no hay nada que leer
	if (iPosFin-iPosInicio) <= 0 then  Exit Sub 

	'extraemos el limite de principio y fin de los datos (p.e. -----2323g237623)
	byteLimite = MidB(byteDatos, iPosInicio, iPosFin-iPosInicio)
	posLimite = InStrB(1, byteDatos, byteLimite)

	'terminamos cuando la posición del próximo límite sea igual 
	'a la del límite final, que lleva "--" detrás.
	do until posLimite = InStrB(byteDatos, byteLimite & str2byte("--"))

		iPos = InStrB(posLimite, byteDatos, str2byte("Content-Disposition"))
		iPos = InStrB(iPos, byteDatos, str2byte("name=")) 'nombre del control en <FORM>
		iPosInicio = iPos + 6 'me salto 6 caracteres -> name=" 
		iPosFin = InStrB(iPosInicio, byteDatos, str2byte(chr(34))) 'busco las comillas de cierre
		'y tengo el nombre del control!
		strControl = byte2str(MidB(byteDatos, iPosInicio, iPosFin-iPosInicio))
		'busco ahora los datos en sí del control
		iPosFich =InStrB(posLimite, byteDatos, str2byte("filename="))
		posLimite = InStrB(iPosFin, byteDatos, byteLimite)
	
		'¿fichero o campo del formulario?
		if iPosFich <> 0 and iPosFich < PosLimite then
			'es un fichero, creo un nuevo objeto fichero y lo añado a Ficheros
			Dim oFichero, strNombre, strForm
			set oFichero = new Fichero
		
			iPosInicio = iPosFich + 10 'me salto 10 caracteres -> filename="
			iPosFin = InStrB(iPosInicio, byteDatos, str2byte(chr(34)))
			strNombre = byte2str(MidB(byteDatos, iPosInicio, iPosFin-iPosInicio))
			'quito la ruta inicial
			oFichero.Nombre = Right(strNombre, Len(strNombre)-InStrRev(strNombre, "\")) '"
			
			iPos = InStrB(iPosFin, byteDatos, str2byte("Content-Type:"))
			iPosInicio = iPos + 14 'me salto Content-Type y un espacio!!
			iPosFin = InStrB(iPosInicio, byteDatos, str2byte(chr(13))) 'busco el retorno de carro
			oFichero.TipoContenido = byte2str(MidB(byteDatos, iPosInicio, iPosFin-iPosInicio))
		
			iPosInicio = iPosFin + 4	'me salto los 3 retornos de carro que lleva!!!
			iPosFin = InStrB(iPosInicio, byteDatos, byteLimite)-2 'dos caracteres atrás
			oFichero.Datos = MidB(byteDatos, iPosInicio, iPosFin-iPosInicio)
			
			'lo añado a la colección Ficheros!
			if oFichero.Tamano > 0 then Ficheros.Add strControl, oFichero
		else
			'es un campo del formulario
			iPos = InStrB(iPos, byteDatos, str2byte(chr(13)))
			iPosInicio = iPos + 4
			iPosFin = InStrB(iPosInicio, byteDatos, byteLimite)-2
			'extraigo el valor del control del formulario!
			strForm = byte2str(MidB(byteDatos, iPosInicio, iPosFin-iPosInicio))
			if not eltosForm.Exists(strControl) then
				eltosForm.Add strControl, strForm
			else
				eltosForm.Item(strControl) =  eltosForm.Item(strControl)+","&strForm
			end if
		end if
		'saltamos al siguiente límite
		iPosLimite = InStrB(iPosLimite+LenB(byteLimite), byteDatos, byteLimite)
	loop

End Sub
End Class



'############################ Clase Fichero!!! ##########################
Class Fichero
	'------------------------------------------------------------------------
	Public Nombre
	Public TipoContenido
	Public Datos
	
	Private Sub Class_Initialize()
		Datos = CStr("") ' Forzar conversión
	End Sub
	'------------------------------------------------------------------------
	Public Property Get Tamano()
		Tamano = LenB(Datos)
	End Property
	'------------------------------------------------------------------------

	Public Sub Guardar(ruta)
		Dim oFSO, oFich, i

		if ruta = "" or Nombre = "" then Exit Sub
		if Mid(ruta, Len(ruta)) <> "\" then	ruta = ruta & "\" 'añado la ultima barra a la ruta

		set oFSO = Server.CreateObject("Scripting.FileSystemObject")
		if not oFSO.FolderExists(ruta) then Exit Sub
		set oFich = oFSO.CreateTextFile(ruta & Nombre, true)

		' # oAspFunc
		If IsObject(oAspFunc) Then
			oFich.Write oAspFunc.UnicodeToAscii(CStr(Datos))
		Else	
			for i = 1 to LenB(Datos)
				oFich.Write Chr(AscB(MidB(Datos, i, 1)))
			next 	
		End If

		oFich.Close
		set oFSO = nothing
	End Sub
	'------------------------------------------------------------------------


	Public Sub GuardarComo(nombrefichero, ruta)
		Dim oFSO, oFich, i

		if ruta = "" or nombrefichero = "" then Exit Sub
		if Mid(ruta, Len(ruta)) <> "\" then	ruta = ruta & "\"

		set oFSO = Server.CreateObject("Scripting.FileSystemObject")
		if not oFSO.FolderExists(ruta) then Exit Sub
		set oFich = oFSO.CreateTextFile(ruta & nombrefichero, true)

		' # oAspFunc
		If IsObject(oAspFunc) Then
			oFich.Write oAspFunc.UnicodeToAscii(CStr(Datos))
		Else	
			for i = 1 to LenB(Datos)
				oFich.Write Chr(AscB(MidB(Datos, i, 1)))
			next 	
		End If

		oFich.Close: set oFSO = nothing
	End Sub
	
	
	'------------------------------------------------------------------------
	Public Sub GuardarBD (byRef field)
		if LenB(Datos) = 0 then Exit Sub
		field.AppendChunk Datos
	End Sub
	'------------------------------------------------------------------------
End Class 


	'------------------------------------------------------------------------
	' Utiliza el objeto oAspFunc.SringConv para codificar la cadena.
	Private Function str2byte(ByRef sData) 'ASCII - UNICODE
		If IsObject(oAspFunc) Then
			str2byte = Cstr("")
			str2byte = oAspFunc.AsciiToUnicode(CStr(sData))
		Else	
			Dim i, strbuf
			for i = 1 to Len(sData)
				strbuf = strbuf & ChrB(AscB(Mid(sData, i, 1)))
			next
			str2byte = strbuf
		End If
	End Function
	'------------------------------------------------------------------------
	Private Function byte2str(ByRef bin) 'UNICODE - ASCII
		If IsObject(oAspFunc) Then
			byte2str = CStr("")
			byte2str = oAspFunc.UnicodeToAscii(CStr(bin))
		Else	
			Dim i, bytebuf
			for i = 1 to LenB(bin)
				bytebuf = bytebuf & Chr(AscB(MidB(bin, i, 1)))
			next
			byte2str = bytebuf
		End If
	End Function
	'------------------------------------------------------------------------
	
	%>

Sigue -->