Laden Sie Bilder ohne Komponenten in die SQLSERVER-Datenbank hoch

Autor：Eve Cole Aktualisierungszeit：2009-06-23 16:41:14

Ich habe gerade erfolgreich versucht, Komponenten ohne Komponenten hochzuladen, also stelle ich den Code bereit, den ich mit allen teilen kann.

/* addemployee.asp */
<html>
<Kopf>
<title>Mitarbeiterheim</title>
<meta 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">Titel:</div>
</td>
<td>
<input type="text" name="txtTitle" size="52" class="textarea">
</td>
</tr>
<tr>
<td class="textBlack">
<div align="right">Kategorie:</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">Text:</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">Bild:</div>
</td>
<td height="14" class="textBlack">
<div align="left">
<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. Bitte kontrollieren Sie die Größe der von Ihnen hochgeladenen Bilder auf <font color="#FF0000"><b>500 KB</b></font>, andernfalls wird der Upload nicht zugelassen<br>
2. Das von Ihnen hochgeladene Bild muss <font color="#FF0000"><b>150*130 Pixel</b></font><br> haben
3. Laden Sie das hochgeladene Bild im JPG- oder GIF-Format hoch</p>
</td>
</tr>
<tr>
<td height="39" class="textBlack"> </td>
<td height="39" valign="middle">
<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>
</body>
</html>
************************************************** * *********************

/* transact1.asp*/



<%
Wenn Request.ServerVariables("REQUEST_METHOD") = "POST", dann
Dunkle Felder
Dimmen Sie strTitle,strSort,strContent
Dimmen Sie rs,sql
Dimmen Sie iMaxid
Dim strMaxid
Dim strlen

Set Fields = GetUpload()
strTitle=BinaryToString(Fields("txtTitle").value)
strSort=BinaryToString(Fields("txtSort").value)
strContent=BinaryToString(Fields("txtContent").value)
strSort=split(trim(strSort),"-")

wenn instr(1,lcase(Fields("file").FileName),".jpg")=0 und instr(1,lcase(Fields("file").FileName),".gif")=0 dann
Response.write "<script language='javascript'>alert('Hochgeladene Bilder müssen im GIF- oder JPG-Format vorliegen')</script>"
Response.write "<script language='javascript'>window.location='addemployee.asp';</script>"
Antwort.Ende
end if

if Fields("file").Length>500000 then
Response.write "<script language='javascript'>alert('Es dürfen nur Bilder hochgeladen werden, die nicht größer als 500 KB sind');</script>"
Response.write "<script language='javascript'>window.location='addemployee.asp';</script>"
Antwort.Ende
end if

'/*In Datenbank speichern*/
if Fields("file").FileName<>"" then
Setze rs=Server.CreateObject("ADODB.Recordset")
sSql="wähle * aus Mitarbeiterbestellung nach ID desc aus"
rs.open sql,conn,2,2
wenn nicht rs.eof dann
iMaxid=Clng(rs("id"))+1
strlen=4-len(cstr(iMaxid))
strMaxid=string(strlen,"0") & cstr(iMaxid)
anders
strMaxid="0001"
Ende wenn
rs.addnew
rs("id")=strMaxid
rs("title")=strTitle
rs("sort")=strSort(0)
rs("img").AppendChunk Fields("file").Value
rs("content")=quoteChg(strContent)
rs("todate")=date()
rs.update
rs.close
Response.write "<script language='javascript'>alert('Datensatz erfolgreich hinzufügen')</script>"
Ende wenn
Ende wenn
%>

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

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Dim UploadSizeLimit

'********************************* GetUpload ************ **********************
'.Name Name des Formularfeldes (<Input Name="..." Type="File,...">)
'.ContentDisposition = Inhaltsdisposition des Formularfelds
'.FileName = Quelldateiname für <Eingabetyp=Datei>
'.ContentType = Content-Type für <Eingabetyp=Datei>
'.Wert = Binärwert des Quellfeldes.
'.Length = Länge des binären Datenfeldes
Funktion GetUpload()
Dunkles Ergebnis
Ergebnis festlegen = Nichts
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
'response.write CT
'application/x-www-form-urlencoded
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
Endfunktion

'*********************************** SeparateFields ************ **********************
'Diese Funktion ruft die Upload-Felder aus Binärdaten ab und gibt die Felder als Array zurück
„Binär ist ein sicheres Array aller rohen Binärdaten aus der Eingabe.“
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>