台灣最大程式設計社群網站
線上人數
389
 
會員總數:245785
討論主題:189420
歡迎您免費加入會員
討論區列表 >> 專欄文章 >> 多個表單和多個圖片一起上傳完美解決方案
[]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
多個表單和多個圖片一起上傳完美解決方案
價值 : 0 QP  點閱數:866 回應數:0
樓主

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

捐贈 VP 給 站務人員
多個表單和多個圖片一起上傳完美解決方案

upload.inc

<!--------------------->

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>

Function GetUpload(FormData)

Dim DataStart,DivStr,DivLen,DataSize,FormFieldData

''分隔標志串(+CRLF)

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

''name起始位置(name="xxxxx"),加6是因為[name="]長度為6

FieldNameStart = InStrB(PosOpenBoundary,FormData,str2bin("name=")) + 6

FieldNameSize = InStrB(FieldNameStart,FormData,ChrB(34)) - FieldNameStart ''(")的ASC值=34

FormFieldName = bin2str(MidB(FormData,FieldNameStart,FieldNameSize))


''filename起始位置(filename="xxxxx")

FieldFileNameStart = InStrB(PosOpenBoundary,FormData,str2bin("filename=")) + 10

If FieldFileNameStart < PosCloseBoundary And FieldFileNameStart > PosopenBoundary Then

FieldFileNameSize = InStrB(FieldFileNameStart,FormData,ChrB(34)) - FieldFileNameStart ''(")的ASC值=34

FormFileName = bin2str(MidB(FormData,FieldFileNameStart,FieldFileNameSize))

Else

FormFileName = ""

End If


''Content-Type起始位置(Content-Type: xxxxx)

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



''資料起始位置:2個CRLF開始

DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4

If FormFileName <> "" Then

''資料長度,減1是因為資料文件的存取字節數問題(可能是AppendChunk方法的問題):

''由於字節數為奇數的圖像存到資料庫時會去掉最後一個字符導致圖像不能正確顯示,

''字節數為偶數的資料文件就不會出現這個問題,因此必須保持字節數為偶數。

DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1

FormFieldData = MidB(FormData,DataStart,DataSize)

Else

''資料長度,減2是因為分隔標志串前有一個CRLF

DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2

FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))

End If



''建立一個Dictionary集存儲Form中各個Field的相關資料

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

''中文字符Skip標志

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

''AscW會把二進製的中文雙字節字符高位和低位反轉,所以要先把中文的高低位反轉

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)

'' asc對中文字符求出來的值可能為負數,

'' 加上65536就可求出它的無符號數值

'' -1在機器內是用補碼表示的0xffff,

'' 其無符號值為65535,65535=-1+65536

'' 其他負數依次類推。

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



''取得文件名(去掉Path)

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>

<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>

<!---------------------------------------------------->

在提交的頁面使用

<form method="POST" enctype="multipart/form-data">

保存的頁面

將upload.inc包含

<!--#include file="upload.inc"-->

<%



function lngConvert2(strTemp)

str1=leftb(strTemp,1)

str2=rightb(strTemp,1)

lngConvert2 = clng(ascb(str2) + ((ascb(str1) * 256)))

end function



function lngConvert(strTemp)

str1=leftb(strTemp,1)

str2=rightb(strTemp,1)

len1=ascb(str1)

len2=ascb(str2)

lngConvert = clng(ascb(str1) + ascb(str2) * 256)

end function



Dim FormData,FormSize

FormSize=Request.TotalBytes

FormData=Request.BinaryRead(FormSize)



Set Fields = GetUpload(FormData)

If Fields("newfile").FileName<>"" Then

tempstr=Leftb(Fields("newfile").Value,10)

tstr=chrb(255)&chrb(216)&chrb(255)&chrb(224)&chrb(0)&chrb(16)&chrb(74)&chrb(70)&chrb(73)&chrb(70)

end if



'提交頁面的表單內容

txt1=Fields("txt1").Value

txt2=Fields("txt2").Value

txt3=Fields("txt3").Value



Set rs = Server.CreateObject("ADODB.Recordset")

sql="select * from news"

rs.open sql,conn,1,3

'插入紀錄

rs.addnew

rs("title")=title

rs("body")=content

rs("pub")=from

rs("up_date")=now()

set field=rs.fields("pic")

field.appendchunk Fields("newfile").Value

'多個圖片一樣處理

Rs.Update

rs.close

conn.close

set rs=nothing

set conn=nothing

%>

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

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