Uploader un fichier sans composant ! {nouvelle methode}


Télécharger le projet
Commenter

Description

Et oui, c'est possible !
Bon, pour éviter tout mal entendu, j'ai enlevé la méthode précédente car j'utilisais une fonction qui provenait semble-t-il de ASPToday.
Stéphane Dorlac (Webmaster de Gasp) travaillant chez Wrox m'a demandé de retirer la source et pour éviter tout malentendu, je l'ai retirée et remplacée par une source que j'ai développé et qui n'a rien à voir avec la précédente)
Voici une méthode made by Nix De A à Z !
Je l'ai faite sous forme d'une Class car c'est plus simple à utiliser comme ça.
Il a quelques options, j'ai essayé de commenter un maximum.
Essayez le, vous verrez, c'est pas sorcié à utiliser
Je pense rajouter des options, si vous avez de bonnes idées, je suis preneur :)

(UNE NOUVELLE VERSION PERMETANT DE RECUPERER DES CHAMPS TEXTE EN MEME TEMPS EST DISPO ICI http://www.aspfr.com/code.aspx?ID=8673 )

Source / Exemple : 


<!----------- Fichier uploadfichier.asp --------->
<!--#include file="clsUplFich.asp"-->
<%
' *****************************************************************************
' Réalisé par Nicolas SOREL ( Nix pour les intimes :) )
' Pour le site ASPFr.com
' Retrouvez d'autres scripts ASP sur www.ASPFr.com
' Vous avez le droit d'utiliser ce script dans vos pages mais si vous souhaitez
' l'exposer sur un autre site de programmation merci de me contacter
' (nix@codes-sources.com)
' *****************************************************************************
%>
<html>
<head>
    <title>Envoyer des fichiers</title>
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#0000FF" alink="#FF0000">
<font face="Verdana" size="2" color="#000000">
<%
	Select Case Request.Querystring("Etape")
		Case ""
%>
<div align="center">
<form action="uploadfichier.asp?Etape=1" method="post" enctype="multipart/form-data">
    <br><br>
    Sélectionnez le(s) fichier(s) que vous souhaitez uploader.<br><br>
    <input type="file" name="Fichier1" accept="image/jpeg"><br>
    <input type="file" name="Fichier2" accept="image/jpeg"><br>
    <input type="file" name="Fichier3" accept="image/jpeg"><br>
    <input type="submit" value="Envoyer !">
</form>

</div>
<%
		Case "1"
			Dim MonUpload
			Dim i

			Set MonUpload = New UplFichier

			' .NbFichiers Retourne le nombre de fichiers Uploadé
			For i = 1 To MonUpload.NbFichiers
				Response.Write "<b>Fichier N° " & i & "</b><br>"
				' NomFichier(ID) Retourne le nom du fichier uploadé
				Response.Write "Nom du fichier : <b>" & MonUpload.NomFichier(i) & "</b><br>"
				' TailleFichier(ID) Retourne la taille du fichier uploadé
				Response.Write "Taille : <b>" & MonUpload.TailleFichier(i) & "</b> octets<br>"
				' ExtensionFichier(ID) Retourne l'extension du fichier uploadé
				Response.Write "Extension : <b>" & MonUpload.ExtensionFichier(i) & "</b><br>"
				' TypeFichier(ID) Retourne le type mime du fichier uploadé
				Response.Write "Type mime : <b>" & MonUpload.TypeFichier(i) & "</b><br>"
				' NomForm(ID) Retourne le nom du champ dans lequel était le fichier uploadé
				Response.Write "Nom de l'Input : <b>" & MonUpload.NomForm(i) & "</b><br>"
				' CheminFichierDistant(ID) Retourne le chemin distant sur lequel le fichier uploadé se trouvait
				Response.Write "Chemin distant : <b>" & MonUpload.CheminFichierDistant(i) & "</b><br><br>"

				' .NouveauNom Optionnel , si vous souahitez forcer le nom du fichier en local
				' Par défaut, le nom du fichier Uploadé sera utilisé
				' Exemple :
				' MonUpload.NouveauNom = "NouveauNomDuFichier.txt"

				' SauveFichier(ID) sauvegarde le fichier Uploadé
				MonUpload.SauveFichier(i)

				' ID représente le N° du fichier uploadé.
				' Si vous n'avez qu'un champ pour uploader, alors le ID sera 1
				' Dans cet Exemple, il y a plusieurs fichiers uploadé donc, je l'ai 
				' mis dans une boucle pour vous montrer comment faire
			Next
			Set MonUpload = Nothing
	End Select
	%>	
</font>
</body>
</html>
<!----------- Fin Fichier uploadfichier.asp --------->

<!----------- Fichier clsUplFich.asp --------->
<%
Option Explicit

' *****************************************************************************
' Cette Class a été réalisé par Nicolas SOREL ( Nix pour les intimes :) )
' Pour le site ASPFr.com
' Retrouvez d'autres scripts ASP sur www.ASPFr.com
' Vous avez le droit d'utiliser ce script dans vos pages mais si vous souhaitez
' l'exposer sur un autre site de programmation merci de me contacter
' (nix@codes-sources.com)
' *****************************************************************************
Class UplFichier

	Private ToutEnvoi

	Private VarFichierBin
	Private VarTailleFichier
	Private VarTailleBinFichier
	
	Private NomDesFichier()
	Private TailleDesFichier()
	Private NbDeFichiers
	Private LesFichiers()
	Private NomDesForm()
	Private CheminLocal
	Private CheminDistant()
	Private LocalNomFichier
	
	Private Property Let AjoutNomFichier(LeNom)
		Redim Preserve NomDesFichier(Ubound(NomDesFichier) + 1)
		NomDesFichier(Ubound(NomDesFichier)) = LeNom
	End Property

	Private Property Let AjoutTailleFichier(LaTaille)
		Redim Preserve TailleDesFichier(Ubound(TailleDesFichier) + 1)
		TailleDesFichier(Ubound(TailleDesFichier)) = LaTaille
	End Property

	Private Property Let AjoutCheminDistant(LeCheminDistant)
		Redim Preserve CheminDistant(Ubound(CheminDistant) + 1)
		CheminDistant(Ubound(CheminDistant)) = LeCheminDistant
	End Property

	Private Property Let AjoutFichier(LeFichier)
		Redim Preserve LesFichiers(Ubound(LesFichiers) + 1)
		LesFichiers(Ubound(LesFichiers)) = LeFichier
	End Property

	Private Property Let AjoutNomForm(LeNomForm)
		Redim Preserve NomDesForm(Ubound(NomDesForm) + 1)
		NomDesForm(Ubound(NomDesForm)) = LeNomForm
	End Property

	Public Property Let Dossier(LeDossier)
		CheminLocal = LeDossier
	End Property

	Public Property Let NouveauNom(NouvNomFichier)
		LocalNomFichier = NouvNomFichier
	End Property

	Public Function SauveFichier(Lequel)
		On Error Resume Next
		Dim fso, fs
		If LocalNomFichier = "" Then
			LocalNomFichier = NomDesFichier(Lequel)
		End If
		Set fso = CreateObject("Scripting.FileSystemObject")
		Set fs = fso.OpenTextFile(CheminLocal & LocalNomFichier, 2, True)
			If Err.Number <> 0 Then Response.Write "Erreur lors de l'écriture du fichier : " & CheminLocal & NomDesFichier(Lequel) & vbCrLf & Err.Description & "<br>":LocalNomFichier = "":Exit Function
			fs.Write LesFichiers(LeQuel)
			If Err.Number <> 0 Then Response.Write "Erreur lors de l'écriture du fichier : " & CheminLocal & NomDesFichier(Lequel) & vbCrLf & Err.Description & "<br>":LocalNomFichier = "":Exit Function
		Set fs = Nothing
		Set fso = Nothing
		LocalNomFichier = ""
	End Function

	Public Property Get NomFichier(Lequel)
		NomFichier = NomDesFichier(Lequel)
	End Property

	Public Property Get CheminFichierDistant(Lequel)
		CheminFichierDistant = CheminDistant(Lequel)
	End Property

	Public Property Get TailleFichier(Lequel)
		TailleFichier = TailleDesFichier(Lequel)
	End Property

	Public Property Get NomForm(Lequel)
		NomForm = NomDesForm(Lequel)
	End Property

	Public Property Get NbFichiers()
		NbFichiers = NbDeFichiers
	End Property

	Private Property Get HttpContentType()
		HttpContentType = Request.ServerVariables ("HTTP_CONTENT_TYPE")
	End Property

	Public Property Get TypeFichier(Lequel)
		TypeFichier = TypeDeFichier(NomDesFichier(Lequel))
	End Property

	Public Property Get ExtensionFichier(Lequel)
		ExtensionFichier = Right(NomDesFichier(Lequel), Len(NomDesFichier(Lequel)) - InStrRev(NomDesFichier(Lequel),"."))
	End Property

	Private Function Preliminaires()
		VarFichierBin = Request.BinaryRead(Request.TotalBytes)
		VarTailleBinFichier = LenB(VarFichierBin)
	End Function

	Private Sub Class_Initialize()
		ReDim NomDesFichier(0)
		ReDim LesFichiers(0)
		ReDim TailleDesFichier(0)
		Redim NomDesForm(0)
		ReDim CheminDistant(0)
		CheminLocal = Server.MapPath(".\") & "\" ' Dossier d'upload par defaut
		LocalNomFichier = "" ' Nom du fichier si l'on souhaite forcer un autre nom que le fichier envoyé
		Call Preliminaires
		Call LetsGOOOO
	End Sub

	Private Sub Class_Terminate()
		Set NomDesFichier = Nothing
		Set LesFichiers = Nothing
		Set TailleDesFichier = Nothing
	End Sub

	Private Function Upl2ADO()
		On Error Resume Next
		Upl2ADO = False
		Dim MonObjRs
		Set MonObjRs = CreateObject("ADODB.Recordset")
			MonObjRs.Fields.Append "TmpBin", 201, VarTailleBinFichier
			MonObjRs.Open
			MonObjRs.AddNew
			MonObjRs("TmpBin").AppendChunk VarFichierBin
			MonObjRs.Update
			ToutEnvoi = MonObjRs("TmpBin")
			MonObjRs.Close
		Set MonObjRs = Nothing
		If Err.Number <> 0 Then Response.Write "Erreur lors de l'upload du/des fichier(s) : " & vbCrLf & Err.Description & "<br>" : Exit Function
		Upl2ADO = True
	End Function

	Public Function LetsGOOOO()
		Dim LesLimites, LimitePosition
		Dim CompteFichier
		Dim DernierFichierDebut, DernierFichierFin, FichierEnCours
		Dim DebutNomFichier, FinNomFichier, NomDuFichier, DernierFichier
		Dim DebutFichier, FinFichier, DonneesDuFichier
		Dim LeContentType, TailleDuFichier, NomInput

		If Not VarTailleBinFichier > 0 Then
			Response.Write "Aucun fichier n'a été sélectionné"
			Exit Function
		End If

		If Upl2ADO = True Then
			' On Récupère l'entête HTTP
			LesLimites = HttpContentType

			' On met notre compteur de Fichier à 0
			CompteFichier = 0

			' On cherche les limites (les Boundaries)
		    LimitePosition = InStr(1, LesLimites, "boundary=") + 8
		    LesLimites = "--" & Right(LesLimites, Len(LesLimites) - LimitePosition)

			' ********************************************
			' ** Les choses sérieuses commencent ici :) **
			' ********************************************

			' On cherche le 1er fichier
			DernierFichierDebut = InStr(1, ToutEnvoi, LesLimites)
		    DernierFichierFin = InStr(InStr(1, ToutEnvoi ,LesLimites) + 1 , ToutEnvoi , LesLimites) - 1
			DernierFichier = False

			Do While DernierFichier = False
				FichierEnCours = Mid(ToutEnvoi, DernierFichierDebut, DernierFichierFin - DernierFichierDebut)
		    	DebutNomFichier = InStr(1, FichierEnCours, "filename=") + 10
		    	FinNomFichier = InStr(DebutNomFichier, FichierEnCours, Chr(34))
				
				' On vérifie que le champ du fichier n'est pas vide
		    	If DebutNomFichier <> FinNomFichier Then
					CompteFichier = CompteFichier + 1
					' On récupère le(s) nom(s) du/des champ(s) Input du formulaire
		    		NomInput = InStr(1, FichierEnCours, "name=""")
		    		If NomInput > 0 Then
		    			NomInput = Mid(FichierEnCours, NomInput + 6, InStr(NomInput + 6, FichierEnCours, """") - NomInput - 6)
		    		End If
					AjoutNomForm = NomInput
					'Response.Write NomInput & "<br>"
					
					' On récupère le chemin du fichier (distant) puis on extrait juste le non du fichier
		    		NomDuFichier = InStr(1, FichierEnCours, "filename=""")
		    		If NomDuFichier > 0 Then
		    			NomDuFichier = Mid(FichierEnCours, NomDuFichier + 10, InStr(NomDuFichier + 10, FichierEnCours, """") - NomDuFichier - 10)
		    		End If
					'Response.Write NomDuFichier
					
					AjoutCheminDistant = NomDuFichier
					NomDuFichier = Right(NomDuFichier, Len(NomDuFichier) - InStrRev(NomDuFichier,"\"))

					' On repère le début du fichier qui se trouve après le Content-Tpye
		    		LeContentType = InStr(1, FichierEnCours, "Content-Type:")
		    		If LeContentType > 0 Then
		    			DebutFichier = InStr(LeContentType, FichierEnCours, vbCrLf) + 4
		    		End If
		    		FinFichier = Len(FichierEnCours)

				    ' Calcul de la taille du fichier
		    		TailleDuFichier = FinFichier - DebutFichier

				    ' Recup. du fichier
		    		DonneesDuFichier = Mid(FichierEnCours, DebutFichier, TailleDuFichier)

					AjoutFichier = DonneesDuFichier
					AjoutNomFichier = NomDuFichier
					AjoutTailleFichier = Len(DonneesDuFichier) 'LaTaille
				End If
				' On va au fichier suivant
				' On repère le début et la fin du fichier suivant
			    DernierFichierDebut = InStr(DernierFichierFin + 1, ToutEnvoi, LesLimites)
			    DernierFichierFin = InStr(DernierFichierDebut + 1 , ToutEnvoi, LesLimites) - 1
				If Not DernierFichierFin > 0 Then DernierFichier = True
			Loop
			NbDeFichiers = CompteFichier
			' ************************
			' ** La Fin du bazar :) **
			' ************************

		Else
			Response.Write "Il y a eu une erreur lors de l'upload"
		End If

	End Function

	Private Function TypeDeFichier(LeFichier)
		Dim TmpExt
			TmpExt = Right(LeFichier, Len(LeFichier) - InStrRev(LeFichier,"."))
        Select Case LCase(TmpExt)
            Case "jpg", "jpeg"
                TypeDeFichier = "image/jpeg"
            Case "gif"
                TypeDeFichier = "image/gif"
            Case "png"
                TypeDeFichier = "image/png"

            Case "txt"
                TypeDeFichier = "text/plain"
            Case "asp"
                TypeDeFichier = "text/asp"
            Case "html", "htm"
                TypeDeFichier = "text/html"
            Case "xml"
                TypeDeFichier = "text/xml"

            Case "doc"
                TypeDeFichier = "application/msword"
            Case "doc"
                TypeDeFichier = "application/vnd.ms-excel"
            Case "pdf"
                TypeDeFichier = "application/pdf"

            Case "exe"
                TypeDeFichier = "application/x-msdownload"
            Case "zip"
                TypeDeFichier = "application/x-compressed"
            Case "rar"
                TypeDeFichier = "application/x-rar-compressed"

			Case "mp3", "mp2"
				TypeDeFichier = "audio/mpeg"
			Case "au"
				TypeDeFichier = "audio/basic"
			Case "wav"
				TypeDeFichier = "audio/x-wav"

			Case "mpg", "mpeg"
				TypeDeFichier = "video/mpeg"
			Case "avi"
				TypeDeFichier = "video/avi"
			' Liste non exhaustive, vous pouvez en rajouter autant que vous voulez

            Case Else
                TypeDeFichier = "application/unknown"
        End Select
	End Function

End Class
%>
<!----------- Fin Fichier clsUplFich.asp --------->

Conclusion :


P.S : Cette fois, je veux pas entendre parler que ce source serait déjà sur un autre site parce que :
1) C'est pas possible :)
2) J'ai passé la soirée et la nuit à le faire :(
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Nix)