作者：woozhj
文件名：upload.inc
說(shuō)明：支持中文的無(wú)組件文件上傳ASP函數(shù)，由于ASP不支持二進(jìn)制寫入文件，所以存成文件時(shí)必須使用組件，本函數(shù)只提供截取上傳文件的數(shù)據(jù)，可以寫入到數(shù)據(jù)庫(kù)。

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Function GetUpload(FormData)
Dim DataStart,DivStr,DivLen,DataSize,FormFieldData
'分隔標(biāo)志串(+CRLF)
DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1)
'分隔標(biāo)志串長(zhǎng)度
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是因?yàn)閇name="]長(zhǎng)度為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 < PosCloseBoundaryAnd FieldFileCTStart > PosOpenBoundary Then
FieldFileCTSize = InStrB(FieldFileCTStart,FormData,str2bin(VbCrLf & VbCrLf)) - FieldFileCTStart
FormFileCT = bin2str(MidB(FormData,FieldFileCTStart,FieldFileCTSize))
 Else
FormFileCT = ""
 End If
 
 '數(shù)據(jù)起始位置：2個(gè)CRLF開始
 DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4
 If FormFileName <> "" Then
'數(shù)據(jù)長(zhǎng)度，減1是因?yàn)閿?shù)據(jù)文件的存取字節(jié)數(shù)問(wèn)題(可能是AppendChunk方法的問(wèn)題)：
'由于字節(jié)數(shù)為奇數(shù)的圖象存到數(shù)據(jù)庫(kù)時(shí)會(huì)去掉最后一個(gè)字符導(dǎo)致圖象不能正確顯示,
'字節(jié)數(shù)為偶數(shù)的數(shù)據(jù)文件就不會(huì)出現(xiàn)這個(gè)問(wèn)題，因此必須保持字節(jié)數(shù)為偶數(shù)。
DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1
FormFieldData = MidB(FormData,DataStart,DataSize)
 Else
'數(shù)據(jù)長(zhǎng)度，減2是因?yàn)榉指魳?biāo)志串前有一個(gè)CRLF
DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2
FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))
 End If

 '建立一個(gè)Dictionary集存儲(chǔ)Form中各個(gè)Field的相關(guān)數(shù)據(jù)
 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

'把二進(jìn)制字符串轉(zhuǎn)換成普通字符串函數(shù)
Function bin2str(binstr)
 Dim varlen,clow,ccc,skipflag
 '中文字符Skip標(biāo)志
 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會(huì)把二進(jìn)制的中文雙字節(jié)字符高位和低位反轉(zhuǎn)，所以要先把中文的高低位反轉(zhuǎn)
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


'把普通字符串轉(zhuǎn)成二進(jìn)制字符串函數(shù)
Function str2bin(varstr)
 str2bin=""
 For i=1 To Len(varstr)
 varchar=mid(varstr,i,1)
 varasc = Asc(varchar)
 ' asc對(duì)中文字符求出來(lái)的值可能為負(fù)數(shù)，
 ' 加上65536就可求出它的無(wú)符號(hào)數(shù)值
 ' -1在機(jī)器內(nèi)是用補(bǔ)碼表示的0xffff,
 ' 其無(wú)符號(hào)值為65535,65535=-1+65536
 ' 其他負(fù)數(shù)依次類推。
 If varasc<0 Then
varasc = varasc + 65535
 End If
 '對(duì)中文的處理：把雙字節(jié)低位和高位分開
 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>