'将二进制流数据同时写入Uploadfile_Stream这个Stream对象
Set Uploadfile_Stream=CreateObject("Adodb.Stream")
Uploadfile_Stream.mode=3
Uploadfile_Stream.type=1
Uploadfile_Stream.open
Uploadfile_Stream.Write RequestBin
'-------------------------------------------
'以下三个函数用于二进制字符数据(包含中文数据)与字节的相互转化
Private Function getByteString(byval StringStr)
dim char, i
For i = 1 to Len(StringStr)
char = Mid(StringStr, i, 1)
getByteString = getByteString & chrB(AscB(char))
Next
End Function
Public Function getString(byval StringBin)
dim intCount
getString =""
For intCount = 1 to LenB(StringBin)
getString = getString & chr(AscB(MidB(StringBin, intCount, 1)))
Next
End Function
Public Function getStringChinese(ByVal strFrom)
Dim i
Dim l
Dim strTo
Dim ch, cl
l = LenB(strFrom)
i = 1
Do While i <= l
If AscB(MidB(strFrom, i, 1)) <= 127 Then
strTo = strTo + ChrW(AscB(MidB(strFrom, i, 1)))
Else
If i + 1 <= l Then
If AscB(MidB(strFrom, i + 1, 1)) > 63 Then
ch = AscB(MidB(strFrom, i, 1))
cl = AscB(MidB(strFrom, i + 1, 1))
strTo = strTo + Chr(ch * 256 + cl)
i = i + 1
Else
strTo = strTo + ChrW(AscB(MidB(strFrom, i, 1)))
End If
Else
strTo = strTo + ChrW(AscB(MidB(strFrom, i, 1)))
End If
End If
i = i + 1
Loop
getStringChinese = strTo
End Function
'-------------------------------------------
'BuildUploadRequest用于分离上传的表单数据。
Public Sub BuildUploadRequest(byref RequestBin, byref UploadRequest)
dim PosBeg, PosEnd, boundary, boundaryPos, Pos, Name, PosFile
dim PosBound, FileName, ContentType, Value, sEncType, sReqMeth
dim tmphash, isfile
'zero byte check
if lenb(RequestBin) = 0 then
exit sub
end if
isfile = false
End If
UploadControl.Add "Value" , Value
UploadControl.Add "InputName", Name
If not uploadrequest.exists(name) then
UploadRequest.Add name, UploadControl
Else
If not isfile then
Set tmphash = uploadrequest(name)
tmphash("Value") = tmphash("Value") & ", " & Value
Set uploadrequest(name) = tmphash
End if
End if
BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
Loop
End Sub
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")
<!--#include file="config.inc"-->
<script language="Javascript" runat=server>
function getType(typestr){
x=/(\w+)$/.test(typestr)
return RegExp.$1
}
</script>
<%
Function ToBin(Strvar)
ToBin = ""
For TempPos = 1 to Len(Strvar)
Charvar=Mid(Strvar,TempPos,1)
Charasc = Asc(Charvar)
if Charasc < 0 then Charasc = Charasc + 65535
if Charasc > 255 then
CharL = ChrB("&H" & Left (Hex(Asc(Charasc)),2))
CharH = ChrB("&H" & Right(Hex(Asc(Charasc)),2))
ToBin = ToBin & CharL & CharH
else
ToBin = ToBin & ChrB(AscB(CharVar))
End if
Next
End Function
'--------------------------将字节串转化为标准字串-------------------------
'
Function Tostr(Strvar)
Tostr = ""
isChinese=False
if Not isNull(Strvar) then
For tempPos = 1 to LenB(Strvar)
if Not isChinese then
Charbin = MidB(StrVar,tempPos,1)
if AscB(CharBin) > 127 then
Tostr = Tostr & Chr(AscW(MidB(StrVar,tempPos+1,1) & CharBin))
isChinese = TRUE
Else
Tostr = Tostr & Chr(AscB(Charbin))
End if
Else
isChinese = Flase
End if
Next
end if
End Function
'--------------------------------------------------------------------------------
Response.Buffer=TRUE
Response.Clear
'读取数据总长度
ByteCount=Request.TotalBytes
'定义一个结构,用完之后要用 Set Upload=nothing清除
Set Upload=CreateObject("Scripting.Dictionary")
formnum=0
if ByteCount>0 then
'读取表单的所有内容
BinForm=Request.BinaryRead(ByteCount)
'取出字段分隔串,即开如:-----------------------------7d02a0338e9 的字串
FormID=MidB(BinForm,1,InstrB(BinForm,ChrB(13))-1)
'搜索字段结束串位置,结束串为:-----------------------------7d02a0338e9--
FormEnd=InstrB(1,BinForm,FormID & ChrB(45) & ChrB(45))
BinStart=1 '设置开始串位置为1
'为以下查找作准备
Contentstr=ToBin("Content-Disposition")
Do Until BinStart=>FormEnd '如果是结束位则退出
Set UpLoadAttrib=CreateObject("Scripting.Dictionary") '定义一个对象存放参数和值
Binbeg=InstrB(BinStart,BinForm,Contentstr) '查找“Content-Disposition”的字串位置
Binbeg=InstrB(Binbeg,BinForm,ToBin("name="))+6 '搜索“name=”字串后跳过“name="表单名"”中第一个引号
Binend=InstrB(Binbeg,BinForm,ChrB(34)) '搜索“name="表单名"”中最后一个引号
FormName=Tostr(MidB(BinForm,Binbeg,BinEnd-BinBeg)) '取出表单名
BinStart=BinEnd+1 '设置下一个搜索指针
Binbeg=InstrB(BinStart,BinForm,ToBin("filename=")) '搜索“filename=”字串以判断是否是File类型表单
Binend=InstrB(BinStart,BinForm,FormID) '搜索下一个字段分隔符以确定上一个搜索是否是File表单内容
if BinBeg<>0 and Binbeg<BinEnd then '判断“filename=”字串是否存在,且在本表单范围内
Binstart=Binbeg+10 '跳过“filename="文件名"”在第一个引号
BinEnd=InstrB(BinStart,BinForm,ChrB(34)) '搜索“filename="文件名"”中最后一个引号
UploadFileName=Lcase(Tostr(MidB(BinForm,BinStart,BinEnd-BinStart))) '取文件名
Binbeg=InstrB(BinEnd,BinForm,ToBin("Content-Type:"))+14 '搜索“Content-Type:”字串,并跳过它
BinEnd=InstrB(Binbeg,BinForm,ChrB(13)) '搜索回车符以确定文件类型串的长度
UpLoadType=ToStr(MidB(BinForm,Binbeg,BinEnd-Binbeg)) '取出文件类型串
Binbeg=BinEnd+4 '跳过“0D 0A 0D 0A”指向表单值的开始位置
BinEnd=InstrB(BinBeg,BinForm,FormID)-2 '搜索下一个字段开始位置,并后退“0D 0A”两位,以指向表单值结束位置
FileSize=BinEnd-BinBeg '求出值的长度
if FileSize>MaxSize then '判断值的长度是否超过最大长度
FileSize=-1 '如果超过,则设长度为-1
Value=""
elseif FileSize<1 then
FileSize=0
Value=""
else
'Value=MidB(BinForm,BinBeg,FileSize) '取出值
Value=""
end if
formnum=formnum+1
Else
BinBeg=InstrB(BinStart,BinForm,ChrB(13))+4 '确定非文件类型表单的值的开始位置
BinEnd=InstrB(BinBeg,BinForm,FormID)-2 '确定结束位置
FileSize=BinEnd-BinBeg '求出值的长度
Value=ToStr(MidB(BinForm,BinBeg,FileSize)) '取出值并转化为标准字串
UpLoadType="Text" '定义保存类型为“Text”
UpLoadFileName=FormName '设置文件名为表单名
End if
UploadAttrib.Add "Start",BinBeg
UpLoadAttrib.Add "Size",FileSize '将取出数据存入对象中
UpLoadAttrib.Add "Value",Value
UpLoadAttrib.Add "Type",UploadType
UpLoadAttrib.Add "FileName",UploadFileName
UpLoad.Add FormName,UploadAttrib
set UploadAttrib=nothing
BinStart=BinEnd+2 '指向下一个字段开始处
Loop
'------------------------------------------------------------------------------------------
' Name=upload.item("inp").item("FileName")
' size=upload.item("inp").item("Size")
' typ =upload.item("inp").item("Type")
End if
errs=""
if formnum=0 then
errs="没有上传文件"
else
Set conn=Server.CreateObject("ADODB.Connection")
DbPath = Server.mapPath(datpath)
conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DbPath
Set rs=Server.Createobject("ADODB.Recordset")
for i=0 to upload.count-1
mime=Upload.Item(f(i)).Item("Type")
if mime<>"Text" then
name=Upload.Item(f(i)).Item("FileName")
size=Upload.Item(f(i)).Item("Size")
temp=instrRev(name,"\")
name=mid(name,temp+1)
typ=getType(mime)
savefile=Server.MapPath(UploadFilePath & "\" & name)
response.write savefile
'response.end
if size=-1 then
errs=errs & "<br>" & name & "已超过" & MaxSize/1024 & "K,该文件上传失败。"
elseif size=0 then
errs=errs & "<br>" & name & "没有内容或已损坏,该文件上传失败。"
else
rs.Open "Select * From upload Where FileName='" & name & "'",conn,1,3
if not rs.EOF then
errs=errs & "<br>" & name & "已有同名文件,该文件上传失败。"
else
'rs("FileValue").AppendChunk Upload.Item(f(i)).Item("Value")
rs("FileName") =name
rs("MIME")=mime
rs("FileType")=typ
rs("FileSize")=size
rs("userName")=replace(username,"'","''")
rs.Update
errs=errs & "<br>" & name & "已成功上传。"
end if
rs.close
end if
end if
next
sStream.Close '关闭Stream对象
set sStream=nothing '释放Stream对象
dStream.Close '关闭Stream对象
set dStream=nothing '释放Stream对象
conn.close
set rs=nothing
set conn=nothing
end if
%>
<html>