Télécharger des images vers la base de données SQLSERVER sans composants

Auteur：Eve Cole Date de mise à jour：2009-06-23 16:41:26

Je viens d'essayer avec succès de télécharger des composants sans composants, je fournis donc le code à partager avec tout le monde.

/* addemployee.asp */
<html>
<tête>
<title>Accueil du personnel</title>
<méta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="../css/site_css.css" type="text/css">
</head>

<body bgcolor="#FFFFFF" text="#000000" leftmargin="1" topmargin="1">
<form name="form1" method="post" action="transact1.asp" enctype="multipart/form-data">
<table border="0" cellpacing="0" cellpadding="0">
<tr>
<td colspan="2" bgcolor="#006699" height="15"> </td>
</tr>
<tr>
<td class="textBlack">
<div align="right">Titre :</div>
</td>
<td>
<input type="text" name="txtTitle" size="52" class="textarea">
</td>
</tr>
<tr>
<td class="textBlack">
<div align="right">Catégorie :</div>
</td>
<td>
<input type="text" name="txtSort" size="35" class="textarea">
<input type="button" name="Submit2" class="buttonSkid" onclick="selectsort(txtSort);">
</td>
</tr>
<tr>
<td class="textBlack" valign="top">
<div align="right">Texte :</div>
</td>
<td>
<textarea name="txtContent" rows="15" cols="50" class="textarea"></textarea>
</td>
</tr>
<tr>
<td height="14" class="textBlack" valign="top">
<div align="right">Image :</div>
</td>
<td height="14" class="textBlack">
<div align="gauche">
<input type="file" name="file" size="35" class="textarea">
</div>
</td>
</tr>
<tr>
<td height="42" class="textBlack" valign="top"> </td>
<td height="42" class="textBlack" valign="middle">
<p>1. Veuillez contrôler la taille des images que vous téléchargez dans <font color="#FF0000"><b>500K</b></font>, sinon le téléchargement ne sera pas autorisé<br>
2. L'image que vous téléchargez doit mesurer <font color="#FF0000"><b>150*130 pixels</b></font><br>
3. Téléchargez l'image téléchargée au format JPG ou GIF</p>
</td>
</tr>
<tr>
<td height="39" class="textBlack"> </td>
<td hauteur="39" valign="milieu">
<div align="center"><img src="../images/save.gif" width="85" height="19" onClick="if(isOK(form1)){form1.submit()}" >
<img src="../images/close.gif" width="85" height="19" onClick="self.close();" ></div>
</td>
</tr>
</table>
</form>
</corps>
</html>
************************************************** * ***********************

/* transact1.asp*/



<%
Si Request.ServerVariables("REQUEST_METHOD") = "POST" Alors
Champs sombres
Dim strTitle, strSort, strContent
Dim rs, sql
Dim iMaxid
Dim strMaxid
Dim strlen

Définir les champs = GetUpload()
strTitle=BinaryToString(Fields("txtTitle").value)
strSort=BinaryToString(Fields("txtSort").value)
strContent=BinaryToString(Fields("txtContent").value)
strTri=split(trim(strSort),"-")

si instr(1,lcase(Fields("file").FileName),".jpg")=0 et instr(1,lcase(Fields("file").FileName),".gif")=0 alors
réponse.write "<script language='javascript'>alert('Les images téléchargées doivent être au format gif ou jpg')</script>"
réponse.write "<script language='javascript'>window.location='addemployee.asp';</script>"
Réponse.end
terminer si

si Fields("file").Length>500000 then
réponse.write "<script language='javascript'>alert('Seules les images ne dépassant pas 500 000 sont autorisées à être téléchargées');</script>"
réponse.write "<script language='javascript'>window.location='addemployee.asp';</script>"
réponse.end
end if

'/*Enregistrer dans la base de données*/
si Fields("file").FileName<>"" alors
Définir rs=Server.CreateObject("ADODB.Recordset")
sSql="sélectionner * dans la commande des employés par identifiant desc"
rs.open sSql, conn, 2,2
sinon rs.eof alors
iMaxid=Clng(rs("id"))+1
strlen=4-len(cstr(iMaxid))
strMaxid=string(strlen,"0") & cstr(iMaxid)
autre
strMaxid="0001"
finir si
rs.addnew
rs("id")=strMaxid
rs("titre")=strTitre
rs("tri")=strTri(0)
rs("img").AppendChunk Fields("fichier").Valeur
rs("content")=quoteChg(strContent)
rs("aujourd'hui")=date()
rs.mise à jour
rs.fermer
réponse.write "<script language='javascript'>alert('Ajouter un enregistrement avec succès')</script>"
finir si
finir si
%>

*********************************************** **********************
/*fupload.inc*/

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Dim UploadSizeLimit

'************************************ GetUpload ************ **********************
'.Name nom du champ du formulaire (<Input Name="..." Type="File,...">)
'.ContentDisposition = Content-Disposition du champ du formulaire
'.FileName = Nom du fichier source pour <input type=file>
'.ContentType = Content-Type pour <input type=file>
'.Value = Valeur binaire du champ source.
'.Length = Len du champ de données binaires
Fonction GetUpload()
Résultat Faible
Définir le résultat = Rien
Si Request.ServerVariables("REQUEST_METHOD") = "POST" Alors 'La méthode de requête doit être "POST"
Dim CT, PosB, limite, longueur, PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'lit l'en-tête Content-Type
'response.write CT
'application/x-www-form-urlencoded
Si LCase(Left(CT, 19)) = "multipart/form-data" Alors l'en-tête 'Content-Type doit être "multipart/form-data"
'Il s'agit d'une demande de téléchargement.
'Obtenir la limite et la longueur de l'en-tête Content-Type
PosB = InStr(LCase(CT), "boundary=") 'Trouver la limite
Si PosB > 0 Alors Boundary = Mid(CT, PosB + 9) 'Sépare la limite
Longueur = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Obtenir l'en-tête Content-Length
si "" & UploadSizeLimit<>"" alors
UploadSizeLimit = clng(UploadSizeLimit)
si Longueur > UploadSizeLimit alors
'en cas d'erreur, reprendre ensuite 'Efface le tampon d'entrée
' réponse.AddHeader "Connexion", "Fermer"
' en cas d'erreur, allez à 0
Requête.BinaryRead(Longueur)
Err.Raise 2, "GetUpload", "Taille du téléchargement" & FormatNumber(Length,0) & "B dépasse la limite de " & FormatNumber(UploadSizeLimit,0) & "B"
fonction de sortie
finir si
end if

If Longueur > 0 Et Boundary <> "" Then 'Y a-t-il des informations requises sur le téléchargement ?
Limite = "--" & Limite
Tête Dim, Binaire
Binary = Request.BinaryRead(Length) 'Lit les données binaires du client

'Récupère les champs de téléchargement à partir des données binaires
Définir le résultat = SeparateFields (binaire, limite)
Binaire = Vide 'Effacer les variables
Autre
Err.Raise 10, "GetUpload", "Demande de longueur nulle."
Fin si
Autre
Err.Raise 11, "GetUpload", "Aucun fichier envoyé."
Fin si
Autre
Err.Raise 1, "GetUpload", "Méthode de requête incorrecte."
Fin si
Définir GetUpload = Résultat
Fin de la fonction

'********************************* SeparateFields ************ **********************
'Cette fonction récupère les champs de téléchargement à partir des données binaires et renvoie les champs sous forme de tableau
'Le binaire est un tableau sécurisé de toutes les données binaires brutes provenant de l'entrée.
Fonction SeparateFields (binaire, limite)
Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Champs sombres
Limite = StringToBinary (limite)

PosOpenBoundary = InstrB (binaire, limite)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

Set Fields = CreateObject("Scripting.Dictionary")

Do While (PosOpenBoundary > 0 et PosCloseBoundary > 0 et non isLastBoundary)
'Données d'en-tête et de fichier/champ source
Dim HeaderContent, FieldContent
'Champs d'en-tête
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Variables aidantes
Champ Dim, TwoCharsAfterEndBoundary
'Récupérer la fin de l'en-tête
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Sépare l'en-tête du champ
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Sépare le contenu du champ
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Sépare les champs d'en-tête de l'en-tête
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Créer un champ et attribuer des paramètres
Définir le champ = CreateUploadField()
Field.Name = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName (SourceFileName)
Champ.ContentType = Content_Type
Champ.Valeur = FieldContent
Field.Length = LenB (FieldContent)

Fields.Add FormFieldName, Field

'Est-ce une limite de fin ?
TwoCharsAfterEndBoundary = BinaryToString (MidB (Binary, PosCloseBoundary + LenB (Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
If Not isLastBoundary Then 'Ceci n'est pas une limite de fin - passez au champ de formulaire suivant.
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB (PosOpenBoundary + LenB (Boundary), Binaire, Limite)
Fin si
Boucle
Définir SeparateFields = Champs
Fin de la fonction

'******************************** Utilitaires ************ **********************
Fonction BinaireVersChaîne(str)
strto = ""
pour i=1 à lenb(str)
si AscB(MidB(str, i, 1)) > 127 alors
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
je = je + 1
autre
strto = strto & Chr(AscB(MidB(str, i, 1)))
finir si
suivant
BinaryToString=strto

Fin de la fonction

Fonction StringToBinary(String)
Dim I,B
Pour I=1 à len(String)
B = B & ChrB (Asc (Mid (Chaîne, I, 1)))
Suivant
ChaîneVersBinaire = B
End Function

'Sépare les champs d'en-tête de l'en-tête de téléchargement
Fonction GetHeadFields (ByVal Head, Content_Disposition, Name, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Nom = (SeparateField(Head, "name=", ";")) 'ltrim
Si Gauche(Nom, 1) = """" Alors Nom = Milieu(Nom, 2, Len(Nom) - 2)
FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
Si Left(FileName, 1) = """" Alors FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End Function

'Séparets un fichier entre sStart et sEnd
Fonction SeparateField (From, ByVal sStart, ByVal sEnd)
Dim PosB, PosE, sFrom
sDe = LCas(De)
PosB = InStr(sDepuis, sDébut)
Si PosB > 0 Alors
PosB = PosB + Len(sDébut)
PosE = InStr(PosB, sFrom, sEnd)
Si PosE = 0 Alors PosE = InStr(PosB, sFrom, vbCrLf)
Si PosE = 0 Alors PosE = Len(sFrom) + 1
SeparateField = Mid (De, PosB, PosE - PosB)
Autre
ChampSéparé = Vide
Fin si
End Function

'Sépare le nom du fichier du chemin complet du fichier
Fonction GetFileName (FullPath)
Dim Pos, PosF
PosF = 0
Pour Pos = Len (FullPath) à 1 étape -1
Sélectionnez le milieu du cas (FullPath, Pos, 1)
Cas "/", "" : PosF = Pos + 1 : Pos = 0
Fin de la sélection
Suivant
Si PosF = 0 Alors PosF = 1
GetFileName = Milieu (FullPath, PosF)
Fonction de fin
</SCRIPT>
<SCRIPT RUNAT=LANGUE DU SERVEUR=JSCRIPT>
//La fonction crée un objet Field.
function CreateUploadField(){ return new uf_Init() }
fonction uf_Init(){
ceci.Nom = null
this.ContentDisposition = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
</SCRIPT>