Hacer una pagina para colgar imagenes via FTP

Sham
05 de Diciembre del 2002
Necesito saber como puedo colgar imagenes en mi servidor via FTP, i es mas, he de hacerlo creando una pagina de menu para ke el usuario seleccione ke imagen kiere cambiar i explorar en su makina para encotrar la suya i colocarla.
Alguien me puede explciar como hacerlo o darme una referencia?

Sham
05 de Diciembre del 2002
Ke me he ekivocado al introducir la direccion del correo en el titulo del foro, la direccion buebna esta en este cuadro.
Gracias por vuestra ayuda!

HeavenN :P
05 de Diciembre del 2002
<%
'************************************* Funcion para cambiar el nombre al archivo **************
Function cambiar_nombre(archivo_original,este_folder_variable,letras)

directorio_final = server.MapPath(".") & este_folder_variable ' esto es grabar el archivo subido abajo del directorio actual en este_folder_variable

x = revisar(directorio_final)

If x = "1" then
Response.write "Se cre un directorio especialmente para ti....."
Else
Response.write "Se agrego el siguiente archivo a tu directorio..."
End if


Randomize
cadena_variable = ""
temp = directorio_final & archivo_original
temp2 = temp
caracteres_a_agregar = letras

' caracteres_a_agregar es la cantidad de caracteres que se agregaran al inicio
' del nombre del archivo original

For i = 1 to caracteres_a_agregar
cadena_variable = cadena_variable & chr(int(Rnd * 26) + 65) '65 es el ASCII para la "A"
Next
' temp = cadena_variable & "-" & temp 'asi queda el archivo modificado
temp = directorio_final & cadena_variable & "-" & archivo_original 'asi queda el archivo modificado


' ahora se verificara que el "nuevo archivo" exista o no, si existe se vuelve a ejecutar este fun

Dim fso, msg
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(temp)) Then
cambiar_nombre(temp2) ' aqui se manda de vuelta a "randomizar" el nombre porque ya existe
Else
cambiar_nombre = temp ' aqui se regresa el nombre del archivo ya modificado y verificado que es unico
exit function
End If

End Function
'************************************* Fin de funcion para cambiar el nombre al archivo **************
%>
<%
'*************************************************** revisar que exista un directorio, si no, que lo haga
Function revisar(folder)
Dim fso, msg,f
Set fso = CreateObject("Scripting.FileSystemObject")
If not (fso.FolderExists(folder)) Then
Set f = fso.CreateFolder(folder)
revisar = "1"
Else
revisar = "0"
End If
End Function
%>


<%response.buffer=true
Func = Request("Func")
if isempty(Func) then
Func = 1
end if
Select case Func
case 1
'You do not need to use this form to send your files.
'However you should not give your submit button a NAME or ID.
%>
<h2>Please select a picture to upload.</h2>
<FORM ENCTYPE="multipart/form-data" ACTION="default.asp?func=2" METHOD=POST id=form1 name=form1>
<table>
<tr><td>Type in the full path and name of the file to upload.</td></tr>
<tr><td>-or-</td></tr>
<tr><td>Hit the [Browse] button to find the file on your computer.<br><br></td></tr>
<tr><td>Then hit the [Upload] button.<br><br></td></tr>
<tr><td><Strong>File Name...&nbsp;</strong></td></tr>
<tr><td><INPUT NAME=File1 SIZE=30 TYPE=file><br></td></tr>
<tr><td><INPUT NAME=File2 SIZE=30 TYPE=file><br></td></tr>
<tr><td><INPUT NAME=File2 SIZE=30 TYPE=file><br></td></tr>
<tr><td align=left><input type="submit" value="Upload File"><br><br></td></tr>
<tr><td>NOTE: Please be patient, you will not receive any notification until the file is completely transferred.<br><br></td></tr>
</table>
<%
case 2
ForWriting = 2

adLongVarChar = 201
lngNumberUploaded = 0
limite_de_tamano = 5000000 'cada uno de los archivos no puede medir mas de 5 millones de bytes
caracteres_a_agregar = 5 ' cantidad de letras que agreraran al inicio del nombre del archivo
este_folder_variable = "archivos-subidos" 'este es un folder abajo de la pagina actual donde se grabaran los archivos
' extensiones1 = ".jpg"
' extensiones2 = ".gif"
' extensiones3 = ".doc"
' extensiones4 = ".ppt"
' extensiones5 = ".xls"
' extensiones6 = ".zip"

Response.write "Existe un limite de " & limite_de_tamano & " bytes para cada uno de los archivos a subir..." & "<br>"
Response.write "Se agregaran " & caracteres_a_agregar & " caracteres al inicio del nombre de los archivos renombrados..." & "<br>"
Response.write "Los archivos se grabaran en " & este_folder_variable & " que estara abajo de esta pagina..." & "<br>"
' Response.write "Solo se pueden subir archivos con ext... " & extensiones1 & extensiones2 & extensiones3 & extensiones4 & extensiones5 & extensiones6 & "<br>"

response.write "<hr>"

'Get binary data from form

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

'convery the binary data to a string
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

'get the boundry indicator

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

'Get first file boundry positions.

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

'*******************************************
do while lngCurrentEnd > 0

'Get the data between current boundry and remove it from the whole.
strData = mid(strDataWhole,lngCurrentBegin, lngCurrentEnd - lngCurrentBegin)
strDataWhole = replace(strDataWhole,strData,"")

'Get the full path of the current file.
lngBeginFileName = instr(1,strdata,"filename=") + 10
lngEndFileName = instr(lngBeginFileName,strData,chr(34))

'Make sure they selected at least one file.
if lngBeginFileName = lngEndFileName and lngNumberUploaded = 0 then
Response.Write "<h2> The following error occured.</h2>"
Response.Write "You must select at least one file to upload"
Response.Write "<br><br>Hit the back button, make the needed corrections and resubmit your information."
Response.Write "<br><br><input type='button' onclick='history.go(-1)' value='<< Back' id='button'1 name='button'1>"
Response.End
end if

'There could be one or more empty file boxes.
if lngBeginFileName <> lngEndFileName then
strFilename = mid(strData,lngBeginFileName,lngEndFileName - lngBeginFileName)
'Loose the path information and keep just the file name.
tmpLng = instr(1,strFilename,"")
do while tmpLng > 0
PrevPos = tmpLng
tmpLng = instr(PrevPos + 1,strFilename,"")
loop
FileName = right(strFilename,len(strFileName) - PrevPos)
este_folder_variable = "archivos-subidos" 'este es un folder abajo de la pagina actual

FileName = cambiar_nombre(Filename,este_folder_variable,caracteres_a_agregar) 'aqui es donde se le cambia el nombre al archivo
' y se regresa con la ruta ya dentro de este_folder_variable
Filename2 = Filename
tmpLng = instr(1,Filename2,"") ' ahora obtendres solo el nombre del archivo originado
do while tmpLng > 0 ' esto es solo es para hacer el link en la pagina
PrevPos = tmpLng ' asi que puedes borrar esta parte
tmpLng = instr(PrevPos + 1,FileName2,"")
loop

FileName3 = right(FileName2,len(FileName2) - PrevPos)
este_folder_variable_inverso = "archivos-subidos/"

'Get the begining position of the file data sent.
'if the file type is registered with the browser then there will be a Content-Type

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

if lngCT > 0 then
lngBeginPos = instr(lngCT,strData,chr(13) & chr(10)) + 4
else
lngBeginPos = lngEndFileName
end if

'Get the ending position of the file data sent.

lngEndPos = len(strData)

'Calculate the file size.

lngDataLenth = lngEndPos - lngBeginPos

tamano = lngDatalenth

If tamano<limite_de_tamano then

%>
<a href="<%=este_folder_variable_inverso & filename3%>">Da un click aqui para que veas el archivo que subiste.</a> Con: <%=lngDatalenth%> Bytes<br>
<%
'Get the file data

strFileData = mid(strData,lngBeginPos,lngDataLenth)

'Create the file.

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(FileName, ForWriting, True)
f.Write strFileData
set f = nothing
set fso = nothing

lngNumberUploaded = lngNumberUploaded + 1

'Get then next boundry postitions if any.
Else

Response.write "El archivo es demasiado grande (mas de 5000000 bytes ) y no sera subido..."
End if
End if
lngCurrentBegin = instr(1,strDataWhole,strBoundry)
lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1
loop
Response.Write "<h2>File(s) Uploaded</h2>"
Response.Write lngNumberUploaded & " files have been uploaded.<br>"
Response.Write "<br><br><input type='button' onclick='document.location=" & chr(34) & "default.asp" & chr(34) & "' value='<< Back to Listings' id='button'1 name='button'1>"
End select
%>

</form>

esta completito y validado, pa las repeticiopnes de nombres etc..