Accueil > > > UPLOADER UN FICHIER SANS COMPOSANT V2.0
UPLOADER UN FICHIER SANS COMPOSANT V2.0
Information sur la source
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
- <!----------- 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 --------->
<!----------- 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
Historique
- 10 décembre 2005 10:36:01 :
- .
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
suppression de caractères dans un champ [ par vegetalain ]
Bonjour, voilà, avec votre aide j'ai enfin réussi à charger un fichier texte dans un champ pour modification. Ca marche super bien. SAuf que : le cont
Convertir du texte en HTML [ par mariusapo ]
Bonjour J'ai du texte formaté dans un fichier resource que je veux afficher dans une vue ,je ne sais pas comment m'y prendre Exemple (dans mon fichie
ecrire dans un fichier texte, à l'envers [ par vegetalain ]
Salut, j'aimerais écrire dans un fichier texte, à l'envers, avec des formulaires c'est-à-dire :On a le fichier :bill.txtOn écrit dedans "coucou"Quand
Ajouter Un Fichier Texte dans une base de données [ par nabil2388 ]
Salut!! j'ai créer un fichier txt comment récupérer les données de ce fichier et les afficher dans une list(asp), et ajouter le contenu de ce liste da
Demande avis: parser fichier texte dans B.D [ par aminos85 ]
Bonjour, Je suis débutant en ASP.NEt et je veux vos avis. J'ai créer un RadioButtonList avec 4 choix. Comment programmer ce RadioButtonList pour que
Upload fichier ASP.NET Sous Win 2003 Server [ par gymdev ]
[i][b]Bonjour, J'ai un problème en asp.net sur l'upload des fichiers de plus de 4Mb. J'ai déjà augmenter la taille de MaxRequestLength en 20Mb , En
Affichage texte et variable base de données suivant la valeur de cette variable [ par lstephan ]
Bonjour, Je cherche a afficher ou pas un bloc comprenant du texte ainsi qu 'un champ de recordset (asp access) en fonction de la valeur de ce champ (
Upload ficher "serveur applicatif" --> "Serveur bdd" [ par francy7285 ]
Bonjour, mon application crée des fichier et les charge dans les tableaux de la base de données en utilisant de requete sql. Parfois les fichier so
conversion d'un fichier texte en son [ par moumoucha ]
Salut, SVP, y'a t-il quelqu'un qui peut m'aider à convertir un fichier texte "Bienvenu au groupe" en un son en java. Me
recuperer chaque lettre d'un champs de texte separement [ par pad ]
bonjour, est ce que l'un d'entre vous aurais une idee pour recupurer depuisun champs de txt dans une page html, chaque lettre qui est tapé et quechaqu
|
Derniers Blogs
TECHDAYS PARIS 2012 : SYSTEM CENTER SERVICE MANAGER 2012 VUE D'ENSEMBLETECHDAYS PARIS 2012 : SYSTEM CENTER SERVICE MANAGER 2012 VUE D'ENSEMBLE par ROMELARD Fabrice
Speakers: Julien Marechal, Gautier Confiant, Sébastien MEYER La session débute par le positionnement de la solution System Center par rapport aux concepts d'organisation ITIL. Le portail du catalogue de se...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2012 : PLEINIèRE SECOND JOURTECHDAYS PARIS 2012 : PLEINIèRE SECOND JOUR par ROMELARD Fabrice
Après une première journée dédiée aux développeurs, cette seconde journée est dédiée au monde des entreprises et de ses applications. Ainsi, cette pleinière est dédiée à faire un 360 de l'évolution des applications Business aux demandes ac...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2012 : RETOUR D'EXPéRIENCE SUR LA MISE EN PLACE D'UN CLOUD PRIVéTECHDAYS PARIS 2012 : RETOUR D'EXPéRIENCE SUR LA MISE EN PLACE D'UN CLOUD PRIVé par ROMELARD Fabrice
Speaker : Guillaume Rochette Cette session est dédiée à fournir le retour sur la mise en place d'un cloud privé (IaaS) par Osiatis pour son compte ou celui de ses clients. Ce projet s'est déroulé sur 4 mois et a permis de faire évoluer...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2012 : COMMENT SHAREPOINT A SAUVé MES TECHDAYSTECHDAYS PARIS 2012 : COMMENT SHAREPOINT A SAUVé MES TECHDAYS par ROMELARD Fabrice
Speakers : Lionel Limozin et Alain Marty La session commence par une découverte de SharePoint à travers la mise en place d'un environnement SharePoint pour la gestion des Sessions animées par BeWise. Le besoin est très ba...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice PERSPECTIVE 3.0 POUR SILVERLIGHT 5.0PERSPECTIVE 3.0 POUR SILVERLIGHT 5.0 par odewit
Je viens de publier la version 3.0 de Perspective pour Silverlight, qui regroupe un portage sous Silverlight 5.0 des fonctionnalités de Perspective 2.0, le framework 3D de haut-niveau introduit récemment et de nouveaux exemples de code. En voici la li...
Cliquez pour lire la suite de l'article par odewit
Logiciels
Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning COLLECTOR PLUS (3.00B)COLLECTOR PLUS (3.00B)COLLECTOR PLUS version 3.00B est un logiciel utilisant une base de données alimentée par :
- L... Cliquez pour télécharger COLLECTOR PLUS PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO LettresFaciles 2011 (8.0.0.1)LETTRESFACILES 2011 (8.0.0.1)LettresFaciles est un logiciel facilitant la création et la rédaction de lettres types.
Son inte... Cliquez pour télécharger LettresFaciles 2011
|