台灣最大程式設計社群網站
線上人數
1651
 
會員總數:246133
討論主題:189712
歡迎您免費加入會員
討論區列表 >> 專欄文章 >> 上傳圖片和文字到database
[]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
上傳圖片和文字到database
價值 : 0 QP  點閱數:1371 回應數:0
樓主

站務人員 站長
門外漢
0 1580
542 9
發送站內信

捐贈 VP 給 站務人員
第一種

<%
Function GetUpload(FormData)
Dim DataStart,DivStr,DivLen,DataSize,FormFieldData
DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1)
DivLen = LenB(DivStr)
PosOpenBoundary = InStrB(FormData,DivStr)
PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)
Set Fields = CreateObject("Scripting.Dictionary")

While PosOpenBoundary > 0 And PosCloseBoundary > 0
FieldNameStart = InStrB(PosOpenBoundary,FormData,str2bin("name=")) + 6
FieldNameSize = InStrB(FieldNameStart,FormData,ChrB(34)) - FieldNameStart
FormFieldName = bin2str(MidB(FormData,FieldNameStart,FieldNameSize))

FieldFileNameStart = InStrB(PosOpenBoundary,FormData,str2bin("filename=")) + 10
If FieldFileNameStart < PosCloseBoundary And FieldFileNameStart > PosopenBoundary Then
FieldFileNameSize = InStrB(FieldFileNameStart,FormData,ChrB(34)) - FieldFileNameStart
FormFileName = bin2str(MidB(FormData,FieldFileNameStart,FieldFileNameSize))
Else
FormFileName = ""
End If

FieldFileCTStart = InStrB(PosOpenBoundary,FormData,str2bin("Content-Type:")) + 14
If FieldFileCTStart < PosCloseBoundary And FieldFileCTStart > PosOpenBoundary Then
FieldFileCTSize = InStrB(FieldFileCTStart,FormData,str2bin(VbCrLf & VbCrLf)) - FieldFileCTStart
FormFileCT = bin2str(MidB(FormData,FieldFileCTStart,FieldFileCTSize))
Else
FormFileCT = ""
End If

DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4
If FormFileName <> "" Then
DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1
FormFieldData = MidB(FormData,DataStart,DataSize)
Else
DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2
FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))
End If

Set Field = CreateUploadField()
Field.Name = FormFieldName
Field.FilePath = FormFileName
Field.FileName = GetFileName(FormFileName)
Field.ContentType = FormFileCT
Field.Length = LenB(FormFieldData)
Field.Value = FormFieldData

Fields.Add FormFieldName, Field

PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)
Wend
Set GetUpload = Fields
End Function

Function bin2str(binstr)
Dim varlen,clow,ccc,skipflag
skipflag=0
ccc = ""
If Not IsNull(binstr) Then
varlen=LenB(binstr)
For i=1 To varlen
If skipflag=0 Then
clow = MidB(binstr,i,1)
If AscB(clow) > 127 Then
ccc =ccc & Chr(AscW(MidB(binstr,i+1,1) & clow))
skipflag=1
Else
ccc = ccc & Chr(AscB(clow))
End If
Else
skipflag=0
End If
Next
End If
bin2str = ccc
End Function


Function str2bin(varstr)
str2bin=""
For i=1 To Len(varstr)
varchar=mid(varstr,i,1)
varasc = Asc(varchar)
If varasc<0 Then
varasc = varasc + 65535
End If
If varasc>255 Then
varlow = Left(Hex(Asc(varchar)),2)
varhigh = right(Hex(Asc(varchar)),2)
str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)
Else
str2bin = str2bin & chrB(AscB(varchar))
End If
Next
End Function

Function GetFileName(FullPath)
If FullPath <> "" Then
FullPath = StrReverse(FullPath)
FullPath = Left(FullPath, InStr(1, FullPath, "\") - 1)
GetFileName = StrReverse(FullPath)
Else
GetFileName = ""
End If
End Function
%>

<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
this.Name = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
</SCRIPT>

=====================================================================

第二種

<%
FormSize=Request.TotalBytes
FormData=Request.BinaryRead(FormSize)
Set Fields = GetUpload(FormData)

imgsize= Fields("photo").length
if imgsize>30720 then
%>
<script language="VBScript">
<!--
msgbox "您上传图片的字节数是<%=imgsize%>!"+chr(13)+chr(13)+"文件太大,服务器不接受,请重新选择一张图片!!!",vbokonly,"用心之旅"
window.history.back
//-->
</script>
<%
response.end
end if
imgtype= Fields("photo").ContentType
imgdata=Fields("photo").Value

name=Fields("T1").value
sex=Fields("sex").value
email=Fields("T2").value
url=Fields("T3").value
QQ=Fields("T4").value
title=Fields("T5").value
memo=Fields("S1").value
face=Fields("D2").value
set gbook=server.createobject("adodb.recordset")
gbook.open "select * from gbook where id is null",wly,3,3
gbook.AddNew
gbook("name")=name
gbook("sex")=sex
gbook("QQ")=QQ
gbook("email")=email
gbook("url")=url
gbook("title")=title
gbook("memo")=memo
gbook("face")=face
if imgtype<>"image/pjpeg" and imgtype<>"image/gif" then
gbook("photo")= null
else
gbook("photo").appendchunk imgdata
end if
gbook.Update
set gbook=nothing
set wly=nothing
%>
====================================================================

本篇文章發表於2002-04-11 00:00
目前尚無任何回覆
   

回覆
如要回應,請先登入.