تحميل الصور إلى قاعدة البيانات بدون مكونات، الحل الأكثر اكتمالا

الكاتب：Eve Cole وقت التحديث：2009-06-23 16:59:05

up.htm

<أتش تي أم أل>
<الرأس>
<العنوان><% =اسم الويب %></العنوان>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="main.css" type="text/css">
<نمط النوع = "نص/CSS">
<!--
.tx1 { الارتفاع: 20 بكسل؛ العرض: 30 بكسل؛ حجم الخط: 9pt؛ الحدود: 1 بكسل صلبة؛ لون الحدود: أسود أسود

#000000؛ اللون: #0000FF}
-->
</style>

وظيفة Turnon(obj1,id){
obj1.style.background=bgc_on[id];
}
إيقاف تشغيل الوظيفة (obj1،id) {
obj1.style.background=bgc_off[id];
}

//-->
</script>
<لغة البرنامج النصي=جافا سكريبت>
وظيفة check_input()
{
إذا (Frm.pic.value = = "")
{ تنبيه ("تحذير من الخطأ")؛
عودة كاذبة.
}
إذا (Frm.type.value = "")
{ تنبيه("请选择图片类型");
عودة كاذبة.
}
إذا (Frm.thetext.value = "")
{ تنبيه("请输入照片说明");
عودة كاذبة.
}
عودة صحيحة؛
}
</النص>
</head>

<عرض الجدول=755 خلية الحشو=0 تباعد الخلايا=0 الحدود=0 bgcolor=#ffffff align='center' bordercolor=#000000>
<تر>
<ارتفاع td=400 العرض=180 bgcolor=#D1E9D5 style='border-right: 1px #0E801E Solid'>
<عرض الجدول=ارتفاع 100%=100% تباعد الخلايا=0 تباعد الخلايا=0 حد=0 محاذاة='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 الارتفاع=5>
<tr><td>
</الجدول>
<TD>
<%
مجموعة rs=server.createobject("adodb.recordset")
sql="اختر * من الصورة حيث المؤلف='"&اسم المستخدم&"'"
rs.open SQL، كون، 1،1
%>
<حشوة خلايا الجدول=0 تباعد الخلايا=0 حد=0 عرض=100% ارتفاع=100%>
<tr><td الارتفاع=3>
<tr><td height=3 bgcolor=#ffffff الخلفية=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%>:اللون الموجود =red><%=rs.recordcount%></font> الصورة</font> <a href="adminphoto.asp"><font color=red><u>الصورة الفوتوغرافية</font></a>
<tr><td bgcolor=#ffffff valign=top>
<حشوة خلايا الجدول=0 تباعد الخلايا=0 حد=0 عرض=95% ارتفاع=100% محاذاة='center'>
<form action=addphoto.aspmethod=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>الصورة: <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=" اكتب">
<option Selected value="">القيمة المحددة</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>照片说明: <td> <textarea name="thetext" cols="46"rows="7" style= "border:1px double rgb(88,88,88);font:9pt">
</textarea> <font color=red>الرقم 20 لون</font>
<tr><td height=5 colspan=2>
<tr><td height=25 colspan=2 align="center">
<input type = "submit" name = "إرسال" value = " اختر " style = "border:1px double rgb(88,88,88);font:9pt">
<input type = "reset" name = "إعادة تعيين" value = " 重写 " style = "border:1px double rgb(88,88,88);font:9pt">
<tr><td colspan=2>
</tr></form>
</الجدول>
</الجدول>

</الجدول>

</الجسم>
</html>

fupload.inc

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'مرحبا بكم في الصورة
Dim UploadSizeLimit

'*************************************************************** ************************
الدالة GetUpload()
نتيجة خافتة
تحديد النتيجة = لا شيء
إذا كانت Request.ServerVariables("REQUEST_METHOD") = "POST" فيجب أن تكون طريقة الطلب "POST"
خافت CT، PosB، الحدود، الطول، PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'يقرأ رأس نوع المحتوى
إذا كان LCase(Left(CT, 19)) = "متعدد الأجزاء/بيانات النموذج" فيجب أن يكون رأس "نوع المحتوى" "متعدد الأجزاء/بيانات النموذج"
'هذا طلب تحميل.
"احصل على الحدود والطول من رأس نوع المحتوى."
PosB = InStr(LCase(CT), "boundary=") 'يبحث عن الحدود
إذا PosB > 0 فإن الحدود = منتصف (CT، PosB + 9) 'الحدود المنفصلة
الطول = CLng(Request.ServerVariables("HTTP_Content_Length")) 'الحصول على رأس طول المحتوى
إذا كان "" & UploadSizeLimit<>"" إذن
UploadSizeLimit = clng(UploadSizeLimit)
إذا كان الطول > UploadSizeLimit بعد ذلك
"في استئناف الخطأ التالي" يمسح المخزن المؤقت للإدخال
'response.AddHeader "اتصال"، "إغلاق"
"عند الخطأ انتقل إلى 0
طلب.قراءة ثنائية (الطول)
Err.Raise 2، "GetUpload"، "حجم التحميل" & FormatNumber(Length,0) & "B يتجاوز الحد الأقصى" & FormatNumber(UploadSizeLimit,0) & "B"
وظيفة الخروج
نهاية إذا
end if

If length > 0 And Boundary <> "" ثم "هل هناك معلومات مطلوبة حول التحميل؟"
الحدود = "--" والحدود
خافت الرأس، ثنائي
Binary = Request.BinaryRead(Length) 'يقرأ البيانات الثنائية من العميل

' ويسترد حقول التحميل من البيانات الثنائية
تعيين النتيجة = حقول منفصلة (ثنائي، حدود)
ثنائي = فارغ "مسح المتغيرات".
آخر
Err.Raise 10، "GetUpload"، "طلب بطول صفر".
نهاية إذا
آخر
Err.Raise 11، "GetUpload"، "لم يتم إرسال أي ملف."
نهاية إذا
آخر
Err.Raise 1، "GetUpload"، "طريقة طلب غير صالحة."
نهاية إذا
تعيين GetUpload = النتيجة
وظيفة النهاية

وظيفة الحقول المنفصلة (ثنائية، حدودية)
Dim PosOpenBoundary، PosCloseBoundary، PosEndOfHeader، isLastBoundary
الحقول الخافتة
الحدود = StringToBinary(Boundary)

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

تعيين الحقول = CreateObject("Scripting.Dictionary")

Do while (PosOpenBoundary > 0 وPosCloseBoundary > 0 وليس isLastBoundary)
"بيانات حقل الرأس والملف/المصدر."
محتوى الرأس الخافت، المحتوى الميداني
"حقول الرأس."
خافت Content_Disposition، FormFieldName، SourceFileName، Content_Type
"مساعدة المتغيرات
الحقل الخافت، TwoCharsAfterEndBoundary
"احصل على نهاية الرأس."
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'يفصل رأس الحقل
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'يفصل محتوى الحقل
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'يفصل حقول الرأس عن الرأس
GetHeadFields BinaryToString(HeaderContent)، Content_Disposition، FormFieldName، SourceFileName، Content_Type

'إنشاء حقل واحد وتعيين المعلمات
تعيين الحقل = CreateUploadField()
Field.Name = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName(SourceFileName)
Field.ContentType = Content_Type
Field.Value = FieldContent
طول الحقل = LenB(FieldContent)

Fields.Add FormFieldName، الحقل

'هل هذه حدود النهاية؟
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary)، 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
إذا لم يكن isLastBoundary، فعندئذٍ "هذه ليست حدود النهاية - انتقل إلى حقل النموذج التالي."
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary)، ثنائي، Boundary)
نهاية إذا
حلقة
قم بتعيين حقول منفصلة = الحقول
وظيفة النهاية

'************************************ الأدوات المساعدة ************ **********************
الدالة BinaryToString(str)
سترتو = ""
لأني=1 إلى lenb(str)
إذا AscB(MidB(str, i, 1)) > 127 إذن
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
ط = ط + 1
آخر
strto = strto & Chr(AscB(MidB(str, i, 1)))
نهاية إذا
التالي
BinaryToString=strto
وظيفة نهاية

الوظيفة StringToBinary(String)
ديم أنا، ب
لأني = 1 إلى لين (سلسلة)
B = B & ChrB(تصاعدي(منتصف(سلسلة،I،1)))
التالي
سترينجتوبيناري = ب
وظيفة النهاية

"تفصل حقول الرأس عن رأس التحميل
وظيفة GetHeadFields (ByVal Head، Content_Disposition، الاسم، اسم الملف، Content_Type)
Content_Disposition = LTrim(SeparateField(Head، "content-disposition:"، "؛"))
الاسم = (SeparateField(Head, "name=", ";")) 'ltrim
إذا كان اليسار (الاسم، 1) = """" ثم الاسم = منتصف (الاسم، 2، لين (الاسم) - 2)
اسم الملف = (SeparateField(Head, "filename=", ";")) 'ltrim
إذا Left(FileName, 1) = """" ثم FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head، "content-type:"، "؛"))
وظيفة النهاية

'تفصل الملف بين sStart وsEnd
وظيفة حقل منفصل (من، ByVal sStart، ByVal sEnd)
خافت PosB، بوز، sFrom
sFrom = LCase(من)
PosB = InStr(sFrom, sStart)
إذا PosB > 0 ثم
PosB = PosB + لين (sStart)
PoE = InStr(PosB، sFrom، sEnd)
إذا PosE = 0 ثم PosE = InStr(PosB, sFrom, vbCrLf)
إذا كانت PosE = 0، فإن PosE = Len(sFrom) + 1
حقل منفصل = منتصف (من، PosB، PosE - PosB)
آخر
حقل منفصل = فارغ
نهاية إذا
وظيفة النهاية

'تفصل اسم الملف عن المسار الكامل للملف
الدالة GetFileName(FullPath)
ديم بوس، بوسف
بوسف = 0
بالنسبة إلى Pos = Len(FullPath) إلى الخطوة الأولى -1
حدد الحالة المتوسطة (FullPath، Pos، 1)
الحالة "/"، "": PosF = Pos + 1: Pos = 0
إنهاء التحديد
التالي
إذا PosF = 0 ثم PosF = 1
GetFileName = منتصف (FullPath، PosF)
وظيفة النهاية
</النص>
<SCRIPT RUNAT=لغة الخادم=JSCRIPT>
// تقوم الوظيفة بإنشاء كائن حقل.
الدالة CreateUploadField(){ إرجاع uf_Init() الجديد }
الدالة 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



<%
إذا Request.ServerVariables("REQUEST_METHOD") = "POST" إذن
الحقول الخافتة
UploadSizeLimit=100000
تعيين الحقول = GetUpload ()
الحقل الخافت
لكل حقل في الحقول.العناصر
حدد اسم الحقل للحالة
الحالة "النص" sss=BinaryToString(Field.value)
حالة "النوع" fff=BinaryToString(Field.value)
حالة "إرسال" إرسال = BinaryToString (Field.value)
حالة "صورة"
اسم الملف=field.FileName
fileContentType=field.ContentType
filevalue=field.value
حدد النهاية
التالي
'---------------
إذا كان اسم الملف<>"" و fileContentType<>"image/gif" و

fileContentType<>"image/pjpeg" ثم
%>
<المركز>
<br><br>
<font color=red size=3>استخدم صور GIF في JPG!</font><br><br>
<input type = "button" value = "重填" onclick = "history.go ( -1 )؛ return

true؛">
</مركز>
<%
آخر
'------------
'مرحبا بكم
'-----------
استجابة.اكتب SSS
استجابة.كتابة"<br>"
استجابة.كتابة وما يليها
مجموعة rs=server.createobject("ADODB.recordset")
sql = "اختر * من السل حيث يكون المعرف فارغًا"
rs.Open SQL، كون، 3،3
rs.addnew
rs("author")=اسم المستخدم
rs("thetext")=sss
rs("أنواع")=fff
rs("الزيارات")=1
rs("posttime")=الآن()
rs("photo").appendchunk filevalue

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

size=3>هل يمكن أن يحدث هذا؟</font><br><br><formmethod="post"

action="personinf.asp"><input type="submit" القيمة = "返回"></form>
</مركز>
<%
نهاية إذا
نهاية إذا
%>

showpic.asp

<%
معرف = طلب ("معرف")
تعيين rs=server.CreateObject("adodb.recordset")
sql = "SELECT * FROM tb حيث id = "&id
rs.Open SQL، كون، 1،3
Response.contenttype = "صورة/gif"
Response.BinaryWrite RS("الصورة")
%>