Uploader un fichier sans composant v2.0

Soyez le premier à donner votre avis sur cette source.

Vue 35 300 fois - Téléchargée 1 394 fois


Description

Pas grand chose de plus que la version précédente à part une petite option mais pas des moindres :) qui permet de récupérer des champs de type text, textaera, checkbox, radio, etc... en même temps que l'upload d'un fichier.

Cela faisait un certain temps que l'on me demandait comment faire, j'avais pas trouvé le temps avant de m'y pencher et comme j'ai eu besoin de cette option pour un projet, j'ai pris le temps de le faire et donc de vous en faire profiter au passage :)
La version précédente se trouve sur cette page : http://www.aspfr.com/code.aspx?id=8645

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>
    FICHIER1 : <input type="file" name="Fichier1" accept="image/jpeg"><br>
    FICHIER2 : <input type="file" name="Fichier2" accept="image/jpeg"><br>
    FICHIER3 : <input type="file" name="Fichier3" accept="image/jpeg"><br>
	TEXTE : <input type="text" name="txttest"><br>
	TEXTAERA : <textarea cols="" rows="" name="txtarea"></textarea><br>
    <input type="submit" value="Envoyer !">
</form>
</div>
<%
'	On Error Resume Next
		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
			%>
			<font color="#FF0000">
			<%
				' .ChampForm(NomDuChamp) permet de récupérer un Champ texte, 
			 	' il fonctionne comme l'Objet Request()
			%>
			<b>TEXTE : </b><%=MonUpload.ChampForm("txttest")%><br>
			<b>TEXTAERA : </b><%=MonUpload.ChampForm("txtarea")%><br>
			</font>
			<%
			Set MonUpload = Nothing
	End Select
	%>	
</font>
</body>
</html>
<!----------- Fin Fichier uploadfichier.asp --------->

<!----------- Fichier clsUplFich.asp --------->
<!--#include file="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 NomChampTXT()
	Private LesChampTXT()
	
	Private Property Let AjoutChampTXT(LeTxt)
		Redim Preserve LesChampTXT(Ubound(LesChampTXT) + 1)
		LesChampTXT(Ubound(LesChampTXT)) = LeTxt
	End Property

	Private Property Let AjoutChampNOM(LeNom)
		Redim Preserve NomChampTXT(Ubound(NomChampTXT) + 1)
		NomChampTXT(Ubound(NomChampTXT)) = LeNom
	End Property

	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 ChampForm(Lequel)
		For i = 1 To UBound(NomChampTXT)
			If NomChampTXT(i) = Lequel Then
				ChampForm = LesChampTXT(i)
				Exit For
			End If
		Next
	End Property

	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)
		Redim LesChampTXT(0)
		Redim NomChampTXT(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()
		' J'ai mis ces lignes en commentaire car des fois, il me dit type incompatible ?!?
		'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
		Dim EstFichier
		
		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
					
					' On récupère le chemin du fichier (distant) puis on extrait juste le non du fichier
		    		NomDuFichier = InStr(1, FichierEnCours, "filename=""")
					EstFichier = False
		    		If NomDuFichier > 0 Then
						EstFichier = True
		    			NomDuFichier = Mid(FichierEnCours, NomDuFichier + 10, InStr(NomDuFichier + 10, FichierEnCours, """") - NomDuFichier - 10)
		    		End If
				
					' Ici la petite astuce, on vérifie si cet "input" contient un Fichier
					If EstFichier = True Then
						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

					Else
						' C'est ici que cela se passe pour récupérer les valeurs 
						' tapées dans un champ text, textaera, radio button, checkbox etc...
						CompteFichier = CompteFichier - 1
						DebutFichier = InStr(InStr(1, FichierEnCours, "name=""") + 6, FichierEnCours, """") + 5
			    		FinFichier = Len(FichierEnCours)

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

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

						AjoutChampNOM = NomInput
						AjoutChampTXT = DonneesDuFichier
					End If
				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 "log"
                TypeDeFichier = "text/plain"

            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 :


Voilà, amusez-vous bien :)

Nix

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
10
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
4 mai 2005

AppendChunk ne fonctionne que sur les champs de type ntext ou image (taper AppendChunk dans Google).
Je n'ai par contre pas réussi à restituer le fichier uploadé après avec le code de Nix.
J'ai donc utilisé une autre solution similaire à celle-ci, sauf que le cas de la restitution a été envisagé et fonctionne (je l'ai fait fonctionner) : http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=7361&lngWId=4
Quelques remarques sur cette solution :
* Il faut modifier la méthode FileName dans clsField car des navigateurs comme Firefox ne retournent pas le chemin du fichier
* Je n'ai pas testé pour les listes à choix multiples
Messages postés
5
Date d'inscription
jeudi 30 janvier 2003
Statut
Membre
Dernière intervention
27 mars 2008

Je me suis créé une petite fonction qui fait ceci :
Public Function Upl2ADONew( NomDuFichier , TailleDuFichier)
'On Error Resume Next
Upl2ADONew = False
Dim MonObjRs
Set MonObjRs = CreateObject("ADODB.Recordset")
Isql ="Select * from upload"
MonObjRs.Open Isql, conn, adOpenKeyset, adLockPessimistic

MonObjRs.AddNew

MonObjRs("Data").AppendChunk VarFichierBin

' MonObjRs("DataBin").AppendChunk VarFichierBin

MonObjRs("SouceFileName") = CheminLocal & NomDuFichier
MonObjRs("Taille") = TailleDuFichier

MonObjRs("UploadDT") = Now()
MonObjRs.Update


MonObjRs.Close
Set MonObjRs = Nothing

If Err.Number <> 0 Then
Response.Write "Erreur lors de la sauvegarde du fichier en base du/des fichier(s) :
" & vbCrLf & Err.Description & "
"
Exit Function
End If
Upl2ADONew = True
End Function

Mais ça marche uniquement si c'est un champ destination de type image; or, je voulais le stocker dans un champ de type varbinary.
Pourquoi n'est-ce pas possible ?
Si j'essaie d'écrire dans un champ varbinary, j'obtiens l'erreur :

ADODB.Field error '800a0c93'

L'opération demandée n'est pas autorisée dans ce contexte.

What is the problem ??!!
Messages postés
10
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
4 mai 2005

A17249 > Il suffit de stocker le code binaire du fichier que tu obtiens avec ce script dans un champs de type binaire dans ta base...
Messages postés
5
Date d'inscription
jeudi 30 janvier 2003
Statut
Membre
Dernière intervention
27 mars 2008

Le code est super et marche très bien chez moi mais je n'arrive pas à ajouter une fonction qui marche vraiment bien pour stocker le fichier dans une base de données en lieu et place de la sauvegarde sur disque. Quelqu'un pourrait-il m'aider ?? car apparemment, je ne suis pas la seule à avoir ce genre de préoccupation mais je ne trouve aucune réponse valable !
Merci d'avance.
Messages postés
10
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
4 mai 2005

Code très bien pensé et super pratique. Une petite remarque par contre. Je l'ai utilisé dans un form où j'avais des selects à choix multiples. Or chaque ligne sélectionnée se voit éclatée en binaire (avec le même attribut name) et celà n'a pas été prévu (on ne récupérait que la dernière ligne sélectionnée...).
J'ai donc ajouté une fonction qui cumule si on trouve plusieurs fois le même nom :
Private Sub AjoutChamp(NomChamp, ValeurChamp)
dim trouve

trouve = false

For i = 1 To UBound(NomChampTXT)
If NomChampTXT(i) = NomChamp Then
trouve = true
Exit For
End If
Next

if trouve then
' pas besoin d'ajouter le nom du champ
LesChampTXT(i) = LesChampTXT(i) & ", " & ValeurChamp

else
' on ajoute le nom du champ et sa valeur

' nom du champ
Redim Preserve NomChampTXT(Ubound(NomChampTXT) + 1)
NomChampTXT(Ubound(NomChampTXT)) = NomChamp

' valeur du champ
Redim Preserve LesChampTXT(Ubound(LesChampTXT) + 1)
LesChampTXT(Ubound(LesChampTXT)) = ValeurChamp
end if
End Sub

Et il suffit de remplacer
AjoutChampNOM = NomInput
AjoutChampTXT = DonneesDuFichier
par
AjoutChamp NomInput, DonneesDuFichier
Afficher les 35 commentaires

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.