Laden Sie Bilder ohne Komponenten in die Datenbank hoch, die umfassendste Lösung

Autor：Eve Cole Aktualisierungszeit：2009-06-23 16:59:05

up.htm

<html>
<Kopf>
<title><% =webname %></title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="main.css" type="text/css">
<style type="text/css">
<!--
.tx1 { Höhe: 20px; Breite: 30px; Schriftgröße: 9pt; Rand: 1 Pixel fest; Randfarbe: schwarz schwarz

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

function turnon(obj1,id){
obj1.style.background=bgc_on[id];
}
Funktion turnoff(obj1,id){
obj1.style.background=bgc_off[id];
}

//-->
</script>
<SCRIPT-Sprache=Javascript>
Funktion check_input()
{
if (Frm.pic.value=="")
{ Alert("请选择要上传的图片");
return false;
}
if (Frm.type.value=="")
{ Alert("请选择图片类型");
return false;
}
if (Frm.thetext.value=="")
{ Alert("Erinnerung an das Problem");
return false;
}
return true;
}
</SCRIPT>
</head>

<table width=755 cellpadding=0 cellspaced=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 cellspaced=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 height=20 class=L13>

<tr><td height=5>
<tr><td>
</table>
<td>
<%
set rs=server.createobject("adodb.recordset")
sql="select * from photo where author='"&username&"'"
rs.open sql,conn,1,1
%>
<table cellpadding=0 cellspaced=0 border=0 width=100% height=100%>
<tr><td height=3>
<tr><td height=3 bgcolor=#ffffff background=img/bj3.gif>
<tr><td height=20 valign="bottom" bgcolor=#eeeeee> 现在位置: 98243班 - 管理中心 - 添加新闻
<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> 张照片</font> <a href="adminphoto.asp"><font color=red><u>管理以前上传的照片</u></font></a>
<tr><td bgcolor=#ffffff valign=top>
<table cellpadding=0 cellspaced=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 height=20 colspan=2>
<tr><td height=25 width=15% align="right" class=L13>Weitere Informationen: <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=" Typ">
<option selected value="">Weitere Informationen</option>
<option value="班级合影">班级合影</option>
<option value="个人照片">个人照片</option>
<option value="恩师照片">恩师照片</option>
<option value="情人照片">情人照片</option>
<option value="友人照片">友人照片</option>
<option value="其他照片">其他照片</option>
</select>

<tr><td height=25 width=20% align="right" class=L13>Beispiel: <td> <textarea name="thetext" cols="46" rows="7" style= "border:1px double rgb(88,88,88);font:9pt">
</textarea> <font color=red>vor 20 Jahren</font>
<tr><td height=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>

</body>
</html>

fupload.inc

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

'********************************* 得到上传数据 ********** **************************
Funktion GetUpload()
Dunkles Ergebnis
Ergebnis = Nichts festlegen
Wenn Request.ServerVariables("REQUEST_METHOD") = "POST", dann muss die Anforderungsmethode "POST" sein.
Dimmen Sie CT, PosB, Grenze, Länge, PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'liest den Content-Type-Header
Wenn LCase(Left(CT, 19)) = „multipart/form-data“ ist, dann muss der „Content-Type“-Header „multipart/form-data“ lauten.
„Dies ist eine Upload-Anfrage.
'Erhalten Sie die Grenze und Länge aus dem Content-Type-Header
PosB = InStr(LCase(CT), "boundary=") 'Findet Grenze
If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Trennt die Grenze
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Content-Length-Header abrufen
if "" & UploadSizeLimit<>"" then
UploadSizeLimit = clng(UploadSizeLimit)
wenn Länge > UploadSizeLimit dann
' on error continue next 'Löscht den Eingabepuffer
'response.AddHeader „Verbindung“, „Schließen“
' bei Fehler gehe zu 0
Request.BinaryRead(Länge)
Err.Raise 2, „GetUpload“, „Upload-Größe“ & FormatNumber(Length,0) & „B überschreitet den Grenzwert von“ & FormatNumber(UploadSizeLimit,0) & „B“
Exit-Funktion
Ende wenn
end if

If Length > 0 And Boundary <> "" Then 'Gibt es erforderliche Informationen zum Hochladen?
Grenze = „--“ & Grenze
Dim Head, Binär
Binary = Request.BinaryRead(Length) 'Liest Binärdaten vom Client.

'Ruft die Upload-Felder aus Binärdaten ab
Ergebnis festlegen = SeparateFields(Binary, Boundary)
Binär = Leer 'Variablen löschen
Anders
Err.Raise 10, „GetUpload“, „Nulllängenanforderung.“
Ende wenn
Anders
Err.Raise 11, „GetUpload“, „Keine Datei gesendet.“
Ende wenn
Anders
Err.Raise 1, „GetUpload“, „Ungültige Anforderungsmethode.“
Ende wenn
Setze GetUpload = Ergebnis
Funktion beenden

Funktion SeparateFields(Binary, Boundary)
Dimmen Sie PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Dunkle Felder
Boundary = StringToBinary(Boundary)

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

Set Fields = CreateObject("Scripting.Dictionary")

Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
'Header- und Datei-/Quellfelddaten
HeaderContent, FieldContent abblenden
'Kopfzeilenfelder
Dimmen Sie Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Hilfsvariablen
Dim Field, TwoCharsAfterEndBoundary
'Ende des Headers abrufen
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Trennt den Feldheader
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Trennt den Feldinhalt
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Trennt Header-Felder vom Header
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Ein Feld erstellen und Parameter zuweisen
Set Field = CreateUploadField()
Field.Name = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName(SourceFileName)
Field.ContentType = Content_Type
Field.Value = FieldContent
Field.Length = LenB(FieldContent)

Fields.Add FormFieldName, Field

'Ist diese Endgrenze?
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
Wenn nicht, lautet „isLastBoundary“, dann „Dies ist keine Endgrenze – gehe zum nächsten Formularfeld.“
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
Ende wenn
Schleife
Legen Sie SeparateFields = Fields fest
Endfunktion

'*********************************** Dienstprogramme ************ **********************
Funktion BinaryToString(str)
strto = ""
für i=1 bis lenb(str)
wenn AscB(MidB(str, i, 1)) > 127 dann
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
ich = ich + 1
anders
strto = strto & Chr(AscB(MidB(str, i, 1)))
Ende wenn
nächste
BinaryToString=strto
Endfunktion

Funktion StringToBinary(String)
Dim I, B
Für I=1 bis len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Nächste
StringToBinary = B
Endfunktion

'Trennt Header-Felder vom Upload-Header
Funktion GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Name = (SeparateField(Head, "name=", ";")) 'ltrim
Wenn Left(Name, 1) = „““ Then Name = Mid(Name, 2, Len(Name) – 2)
FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
Wenn Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End-Funktion

'Trennt ein Feld zwischen sStart und sEnd
Funktion SeparateField(From, ByVal sStart, ByVal sEnd)
Dimmen Sie PosB, PosE, sFrom
sFrom = LCase(Von)
PosB = InStr(sFrom, sStart)
Wenn PosB > 0, dann
PosB = PosB + Len(sStart)
PosE = InStr(PosB, sFrom, sEnd)
Wenn PosE = 0, dann ist PosE = InStr(PosB, sFrom, vbCrLf)
Wenn PosE = 0, dann ist PosE = Len(sFrom) + 1
SeparateField = Mid(Von, PosB, PosE - PosB)
Anders
SeparateField = Leer
Ende wenn
End-Funktion

'Trennt den Dateinamen vom vollständigen Dateipfad
Funktion GetFileName(FullPath)
Dim Pos, PosF
PosF = 0
Für Pos = Len(FullPath) To 1 Schritt -1
Wählen Sie Case Mid(FullPath, Pos, 1)
Fall „/“, „“: PosF = Pos + 1: Pos = 0
Endauswahl
Nächste
Wenn PosF = 0, dann ist PosF = 1
GetFileName = Mid(FullPath, PosF)
Funktion beenden
</SCRIPT>
<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
//Die Funktion erstellt ein Feldobjekt.
Funktion CreateUploadField(){ return new uf_Init() }
Funktion uf_Init(){
this.Name = null
this.ContentDisposition = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
</SCRIPT>

addphoto.asp



<%
if Request.ServerVariables("REQUEST_METHOD") = "POST" Dann
Dunkle Felder
UploadSizeLimit=100000
Set Fields = GetUpload()
dunkles Feld
Für jedes Feld in Fields.Items
Wählen Sie den Fall Field.name aus
case „thetext“ sss=BinaryToString(Field.value)
case „type“ fff=BinaryToString(Field.value)
case „submit“ subscribe=BinaryToString(Field.value)
Fall „Bild“
Dateiname=Feld.Dateiname
fileContentType=field.ContentType
filevalue=field.value
Ende auswählen
nächste
'---------------
wenn filename<>"" und fileContentType<>"image/gif" und

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

true;">
</center>
<%
anders
'------------
'开始输入
'-----------
Antwort.write sss
Response.write"<br>"
Antwort.write fff
set rs=server.createobject("ADODB.recordset")
sql = „select * from tb where theid is null“
rs.Open sql,conn,3,3
rs.addnew
rs("Autor")=Benutzername
rs("thetext")=sss
rs("types")=fff
rs("hits")=1
rs("posttime")=now()
rs("photo").appendchunk Dateiwert

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

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

action="personinf.asp"><input type="submit" value="返回"></form>
</center>
<%
Ende wenn
Ende wenn
%>

showpic.asp

<%
id=Anfrage("id")
set rs=server.CreateObject("adodb.recordset")
sql="SELECT * FROM tb where theid="&id
rs.Open sql,conn,1,3
Response.contenttype="image/gif"
Response.BinaryWrite rs("photo")
%>