Téléchargez des images dans la base de données sans composants, la solution la plus complète

Auteur：Eve Cole Date de mise à jour：2009-06-23 16:59:05

up.htm

<html>
<tête>
<titre><% =nom Web %></titre>
<méta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="main.css" type="text/css">
<style type="text/css">
<!--
.tx1 { hauteur : 20 px ; largeur : 30 px ; taille de police : 9 pt ; bordure : 1px solide ; couleur de la bordure : noir noir

#000000 ; couleur : #0000FF}
-->
</style>

<langage de script="JavaScript">
<!--
var bgc_on=nouveau tableau("#74D738","#FF9C17","#3278AB","#486177","#078C00","#007ECA")
var bgc_off=new Array("#4CAD12","FFB859","5F9FD0","577590","08A700","009FFF")

fonction turnon(obj1,id){
obj1.style.background=bgc_on[id];
}
fonction d'arrêt (obj1, id) {
obj1.style.background=bgc_off[id];
}

//-->
</script>
<langage SCRIPT=javascript>
fonction check_input()
{
si (Frm.pic.value=="")
{ alert("请选择要上传的图片");
renvoie faux ;
}
si (Frm.type.value=="")
{ alert("请选择图片类型");
renvoie faux ;
}
si (Frm.thetext.value=="")
{ alert("请输入照片说明");
renvoie faux ;
}
renvoie vrai ;
}
</SCRIPT>
</head>

<table width=755 cellpadding=0 cellpacing=0 border=0 bgcolor=#ffffff align="center" bordercolor=#000000>
<tr>
<td height=400 width=180 bgcolor=#D1E9D5 style="border-right: 1px #0E801E solid">
<table width=100% height=100% cellpadding=0 cellpacing=0 border=0 align="center" bordercolor=#000000>
<tr><td height=30 align="center" class=L15><font color=#E96D08>欢迎你：<% =username %> 管理中心</font>
<tr><td height=23 align="center" class=L15 bgcolor=#4CAD12 style="border-top:0px #0E801E solid; border-bottom:1px #0E801E solid;"><font color=#C2F009 class =yinying>管理中心</font>
<tr><td hauteur=20 classe=L13>

<tr><td hauteur=5>
<tr><td>
</table>
<td>
<%
set rs=server.createobject("adodb.recordset")
sql="select * from photowhere author=""&username&"'"
rs.open sql, conn, 1,1
%>
<table cellpadding=0 cellpacing=0 border=0 width=100% height=100%>
<tr><td hauteur=3>
<tr><td height=3 bgcolor=#ffffff background=img/bj3.gif>
<tr><td height=20 valign="bottom" bgcolor=#eeeeee> Nom du produit : 98243班 - Nom du produit - Nom du produit
<tr><td height=3 bgcolor=#eeeeee style="border-bottom: 1px #cccccc solid"><p style="font-size:1pt">
<tr><td height=20 valign="bottom"> <font color=green><% =username %>：你一共上传了 <font color=red><% =rs.recordcount %></font> 张Photo</font> <a href="adminphoto.asp"><font color=red><u>Photos</font> <a href="adminphoto.asp"><font color=red><u>Photos</font></a>
<tr><td bgcolor=#ffffff valign=top>
<table cellpadding=0 cellpacing=0 border=0 width=95% height=100% align="center">
<form action=addphoto.asp method=post name=Frm onSubmit="return check_input()" enctype="multipart/form-data">
<tr><td hauteur=20 colspan=2>
<tr><td height=25 width=15% align="right" class=L13>选择照片： <td> <input NAME="pic" TYPE="FILE" class="tx1" style="width:300 "> <font color=red>拒绝色情、写真图等</font>

<tr><td height=25 width=20% align="right" class=L13>照片分类： <td> <select name=" tapez">
<option selected value="">选择类型</option>
<option value="班级合影">班级合影</option>
<option value="个人照片">个人照photo</option>
<option value="Photos de valeur">Photos de valeurs</option>
<option value="情人照片">情人照photo</option>
<option value="友人照片">友人照photo</option>
<option value="其他照片">其他照photo</option>
</select>

<tr><td height=25 width=20% align="right" class=L13>photo ci-dessous : <td> <textarea name="thetext" cols="46" rows="7" style= "bordure : 1px double RVB (88,88,88);police :9pt">
</textarea> <font color=red>最多20个字符</font>
<tr><td hauteur=5 colspan=2>
<tr><td height=25 colspan=2 align="center">
<input type="submit" name="Submit" value=" 提交 " style="border:1px double rgb(88,88,88);font:9pt">
<input type="reset" name="Reset" value=" 写 " style="border:1px double rgb(88,88,88);font:9pt">
<tr><td colspan=2>
</tr></form>
</table>
</table>

</table>

</corps>
</html>

fupload.inc

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'限制上传图片大小
Dim UploadSizeLimit

'************************************ ********* ***********************
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
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
Fonction de fin

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
Champ.Longueur = LenB (FieldContent)

Fields.Add FormFieldName, Field

'Cette limite se termine-t-elle ?
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
BinaireToString=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(sDe, 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>

addphoto.asp



<%
si Request.ServerVariables("REQUEST_METHOD") = "POST" Alors
Champs sombres
UploadSizeLimit = 100 000
Définir les champs = GetUpload()
champ faible
Pour chaque champ dans Fields.Items
sélectionner le cas Field.name
cas "letexte" sss=BinaryToString(Field.value)
cas "type" fff=BinaryToString(Field.value)
cas "submit" submit=BinaryToString(Field.value)
cas "photo"
nom de fichier = champ. Nom de fichier
fileContentType = champ.ContentType
valeur du fichier = champ.valeur
fin de la sélection
suivant
'-------------------
si filename<>"" et fileContentType<>"image/gif" et

fileContentType<>"image/pjpeg" alors
%>
<centre>
<br><br>
<font color=red size=3>上传的照photo应该为GIF或JPG文件！</font><br><br>
<input type="button" value="重填" onclick="history.go( -1 );return

true;">
</centre>
<%
autre
'------------
'开始输入
'---------------
réponse.write sss
réponse.écrire"<br>"
réponse.écrire fff
set rs=server.createobject("ADODB.recordset")
sql = "select * from tb où l'id est nul"
rs.Open sql, conn, 3,3
rs.addnew
rs("auteur")=nom d'utilisateur
rs("letexte")=sss
rs("types")=fff
rs("clics")=1
rs("posttime")=maintenant()
rs("photo").appendchunk valeur du fichier

rs.update
rs.fermer
%>
<br><br>
<center><font color=red

size=3>成功输入个人基本档案！</font><br><br><form method="post"

action="personinf.asp"><input type="submit" value="返回"></form>
</centre>
<%
finir si
finir si
%>

showpic.asp

<%
identifiant=Requête("id")
set rs=server.CreateObject("adodb.recordset")
sql="SELECT * FROM tb où theid="&id
rs.Open sql, conn, 1,3
réponse.contenttype="image/gif"
Réponse.BinaryWrite rs("photo")
%>