Subir archivos

Upload - Explicado en español





Recursosfree.com


<%
'************************************* 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>

23

Volver

    Warning: mysql_fetch_array(): supplied argument is not a valid MySQL result resource in /home/cssboule/public_html/asp/scripts/index.php on line 92

    Warning: mysql_free_result(): supplied argument is not a valid MySQL result resource in /home/cssboule/public_html/asp/scripts/index.php on line 98
    Script error: local_152429.xml does not exist. Please create a blank file named local_152429.xml.