Ver Mensaje Individual
  #3 (permalink)  
Antiguo 16/09/2004, 13:23
Avatar de Saruman
Saruman
 
Fecha de Ingreso: mayo-2003
Ubicación: Panama city, Panama, Panama
Mensajes: 1.154
Antigüedad: 21 años, 11 meses
Puntos: 5
aqui esta el codigo.
no lo he probado, pero este script me funciona perfectamente....
lo adapte mas o menos a los campos que tenias....

me avisas como sale el test.


upload.asp

Código:
<!--#include file="loader.asp" -->

<%
	server.ScriptTimeout = 100000000
	
	Set Master = Server.CreateObject("ADODB.Connection")
	Master.Open("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("../base/cybernetsc.mdb"))
	
	path = "../noticias/images/"
	
	Dim Uploader, File
	Set Uploader = New FileUploader
	
	Uploader.Upload()

	If Uploader.Files.Count <> 0 Then
		titulo = Uploader.form("txttitulo")
		noticia = Uploader.form("txtnoticia")
		archivo = Uploader.form("txtarchivo")
		archivo = replace(archivo, "/", "\")
		archivo = right(archivo, len(archivo) - instrrev(archivo, "\"))
		archivo = lcase(archivo)
		archivo = replace(archivo, " ", "_")
		
		For Each File In Uploader.Files.Items
			File.SaveToDisk Server.MapPath(path), archivo
		Next
		
		sSQL = "insert into noticias(imagen,titulo,noticia) values ('" & archivo & "', '" & titulo & "', '" & noticia & "')"
		Master.Execute(sSQL)
		
		response.Redirect("confirma.htm")
	end if
%>

<script language="javascript">
	function get_archivo() {
		var f = document.form1
		
		f.txtarchivo.value = f.file.value;
		return true
	}
</script>

<form action="upload.asp" method="post" enctype="multipart/form-data" name="form1" onSubmit="return get_archivo()">
  <table width="400" border="1">
    <tr>
      <td width="49">titulo</td>
      <td width="335"><input name="textfield" type="text" size="30"></td>
    </tr>
    <tr>
      <td>foto</td>
      <td><input name="file" type="file" size="30">
      <input name="txtarchivo" type="hidden"></td>
    </tr>
    <tr>
      <td>noticia</td>
      <td><textarea name="textarea" cols="40"></textarea></td>
    </tr>
    <tr>
      <td colspan="2" align="center"><input type="submit" name="Submit" value="grabar"></td>
    </tr>
  </table>
</form>

loader.asp

Código:
<%
Class FileUploader
	Public  Files
	Private mcolFormElem

	Private Sub Class_Initialize()
		Set Files = Server.CreateObject("Scripting.Dictionary")
		Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
	End Sub
	
	Private Sub Class_Terminate()
		If IsObject(Files) Then
			Files.RemoveAll()
			Set Files = Nothing
		End If
		If IsObject(mcolFormElem) Then
			mcolFormElem.RemoveAll()
			Set mcolFormElem = Nothing
		End If
	End Sub

	Public Property Get Form(sIndex)
		Form = ""
		If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
	End Property

	Public Default Sub Upload()
		Dim biData, sInputName
		Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
		Dim nPosFile, nPosBound

		biData = Request.BinaryRead(Request.TotalBytes)
		nPosBegin = 1
		nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
		
		If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
		 
		vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
		nDataBoundPos = InstrB(1, biData, vDataBounds)
		
		Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
			
			nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
			nPos = InstrB(nPos, biData, CByteString("name="))
			nPosBegin = nPos + 6
			nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
			sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
			nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
			nPosBound = InstrB(nPosEnd, biData, vDataBounds)
			
			If nPosFile <> 0 And  nPosFile < nPosBound Then
				Dim oUploadFile, sFileName
				Set oUploadFile = New UploadedFile
				
				nPosBegin = nPosFile + 10
				nPosEnd =  InstrB(nPosBegin, biData, CByteString(Chr(34)))
				sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
				oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))

				nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
				nPosBegin = nPos + 14
				nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
				
				oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
				
				nPosBegin = nPosEnd+4
				nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
				oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
				
				If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
			Else
				nPos = InstrB(nPos, biData, CByteString(Chr(13)))
				nPosBegin = nPos + 4
				nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
				If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
			End If

			nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
		Loop
	End Sub

	'String to byte string conversion
	Private Function CByteString(sString)
		Dim nIndex
		For nIndex = 1 to Len(sString)
		   CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
		Next
	End Function

	'Byte string to string conversion
	Private Function CWideString(bsString)
		Dim nIndex
		CWideString =""
		For nIndex = 1 to LenB(bsString)
		   CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1))) 
		Next
	End Function
End Class

Class UploadedFile
	Public ContentType
	Public FileName
	Public FileData
	
	Public Property Get FileSize()
		FileSize = LenB(FileData)
	End Property

	Public Sub SaveToDisk(sPath, archivo)
		Dim oFS, oFile
		Dim nIndex
	
		If sPath = "" Or FileName = "" Then Exit Sub
		If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
	
		Set oFS = Server.CreateObject("Scripting.FileSystemObject")
		If Not oFS.FolderExists(sPath) Then Exit Sub
		
		'Set oFile = oFS.CreateTextFile(sPath & FileName, True)
		Set oFile = oFS.CreateTextFile(sPath & archivo, True)
		
		For nIndex = 1 to LenB(FileData)
		    oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
		Next

		oFile.Close
	End Sub
	
	Public Sub SaveToDatabase(ByRef oField)
		If LenB(FileData) = 0 Then Exit Sub
		
		If IsObject(oField) Then
			oField.AppendChunk FileData
		End If
	End Sub

End Class
%>

cualquier comentario sabes que estoy a la orden.
__________________
Saruman

One Ring to rule them all, One Ring to find them, One Ring to bring them all and in the darkness bind them.