Ver Mensaje Individual
  #7 (permalink)  
Antiguo 01/08/2003, 12:15
larrea
 
Fecha de Ingreso: julio-2002
Mensajes: 50
Antigüedad: 22 años, 9 meses
Puntos: 0
Hola u_goldman
Gracias por tu paciencia pero te comento:
El valor de RutaUpload puede variar en función de su procedencia y el ar chivo a realizar el Upload al servidor puede ser cualquiera
esta página lo que hace en realidad es subir un archivo al servidor sin necesidad de ninguna .dll
A continuación te envío el código pus en alguna ocasión alguien lo pueda necesitar.

<%
'----------------------------------------------------------------
' Declarar variables del documento para ASP
'----------------------------------------------------------------
Option Explicit
Dim Func, ForWriting, adLongVarChar, lngNumberUploaded
Dim noBytes, binData, RST, LenBinary, strDataWhole
Dim strBoundry, lngBoundryPos, lngCurrentBegin, lngCurrentEnd
Dim strData, lngBeginFileName, lngEndFileName, strFilename
Dim tmpLng, PrevPos, FileName, lngCT, lngBeginPos, lngEndPos
Dim lngDataLenth, strFileData, fso, f
Dim RutaUpload, Id
'----------------------------------------------------------------
' Quitar el caché del navegador
'----------------------------------------------------------------
Response.addHeader "pragma", "no-cache"
Response.CacheControl = "Private"
Response.Expires = 0
'----------------------------------------------------------------
RutaUpload = request.querystring("Ruta")
%>
<html>
<head>
..................
Código html
..................
<%
Func = Request("Func")
If Len(Func) = 0 then
Func = 1
End If
Select Case Func
case 1
%>
..................
Código html
..................
<%
Case 2
ForWriting = 2
adLongVarChar = 201
lngNumberUploaded = 0

noBytes = Request.TotalBytes
binData = Request.BinaryRead (noBytes)

Set RST = CreateObject("ADODB.Recordset")
LenBinary = LenB(binData)

if LenBinary > 0 then
RST.Fields.Append "myBinary", adLongVarChar, LenBinary
RST.Open
RST.AddNew
RST("myBinary").AppendChunk BinData
RST.Update
strDataWhole = RST("myBinary")
End If

strBoundry = Request.ServerVariables ("HTTP_CONTENT_TYPE")
lngBoundryPos = instr(1,strBoundry,"boundary=") + 8
strBoundry = "--" & right(strBoundry,len(strBoundry)-lngBoundryPos)

lngCurrentBegin = instr(1,strDataWhole,strBoundry)
lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1

do while lngCurrentEnd > 0
strData = mid(strDataWhole,lngCurrentBegin, lngCurrentEnd - lngCurrentBegin)
strDataWhole = replace(strDataWhole,strData,"")

lngBeginFileName = instr(1,strdata,"filename=") + 10
lngEndFileName = instr(lngBeginFileName,strData,chr(34))

if lngBeginFileName = lngEndFileName and lngNumberUploaded = 0 then
Response.Write "<FONT FACE=Verdana SIZE=5>Ha ocurrido un error</FONT><BR><BR>"
Response.Write "<FONT FACE=Verdana SIZE=2><B>Explicación:</B><BR>"
Response.Write "1) Deberías seleccionar al menos 1 archivo.<BR>"
Response.Write "2) Deberías seleccionar los archivos en orden, de uno en uno y de arriba a abajo.<BR><BR>"
Response.Write "<B>Solución:</B><BR>"
Response.Write "Retrocede pulsando el botón de <B>Retroceder</B> e inténtalo de nuevo.</FONT><BR><BR>"
Response.Write "<INPUT TYPE=Button onclick=history.go(-1) value='<< Retroceder' ID='button'1 NAME='button'1 >"
Response.End
end if

if lngBeginFileName <> lngEndFileName then
strFilename = mid(strData,lngBeginFileName,lngEndFileName - lngBeginFileName)
tmpLng = instr(1,strFilename,"\")

Do While tmpLng > 0
PrevPos = tmpLng
tmpLng = instr(PrevPos + 1,strFilename,"\")
Loop

FileName = right(strFilename,len(strFileName) - PrevPos)

lngCT = instr(1,strData,"Content-Type:")

If lngCT > 0 then
lngBeginPos = instr(lngCT,strData,chr(13) & chr(10)) + 4
Else
lngBeginPos = lngEndFileName
End If

lngEndPos = len(strData)

lngDataLenth = lngEndPos - lngBeginPos

strFileData = mid(strData,lngBeginPos,lngDataLenth)

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile(server.mappath(RutaUpload ) & FileName, ForWriting, True)
response.write FileName

f.Write strFileData
set f = nothing
set fso = nothing

lngNumberUploaded = lngNumberUploaded + 1

End If

lngCurrentBegin = instr(1,strDataWhole,strBoundry)
lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1
loop

Response.Write "<FONT FACE=Verdana SIZE=5>Fichero(s) subido(s) al servidor</FONT><BR><BR>"
Response.Write "<FONT FACE=Verdana SIZE=2>" & lngNumberUploaded & " fichero(s) subidos al servidor.</FONT><BR><BR>"

End Select
%>
</body>
</html>

Gracias de nuevo