28,409
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
shyboy139 2002-05-13
- 打赏
- 举报
谢谢各位大哥的鼎立支持。
jetplane 2002-05-12
- 打赏
- 举报
你的这个问题其实在ASP论坛中已经多次有提到，建议你先查查过去的相关贴子。
比如：http://www.csdn.net/expert/topic/649/649412.xml?temp=9.220523E-02
另外若我这里也贴出一段代码来。
//htm页面funtest4.htm==========================================
<form method="POST" action="futest4.asp" name="form1" enctype="multipart/form-data">
<p>
<input type="file" name="text1" size="20">
</p>
<p>
<input type="text" name="text2" size="20">
<input type="submit" value="提交" name="B1"><input type="reset" value="全部重写" name="B2">
</p>
</form>
//action指向的页面funtest4.asp=================================
<%
Dim Uploadfile_Stream
Dim RequestBin,iTotBytes
'取得上传的二进制数据
iTotBytes = Request.TotalBytes
'将二进制数据赋值RequestBin
RequestBin = Request.BinaryRead(iTotBytes)
'将二进制流数据同时写入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
PosBeg = 1
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
if posend = 0 then
BuildUploadRequest_ASCII getString(requestbin), UploadRequest
Exit Sub
end if
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryPos = InstrB(1,RequestBin,boundary)
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
Dim UploadControl
Set UploadControl = Server.CreateObject("Scripting.Dictionary")
Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
Pos = InstrB(Pos,RequestBin,getByteString("name="))
PosBeg = Pos+6
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
Name = getStringChinese(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
PosBound = InstrB(PosEnd,RequestBin,boundary)
isfile = false
If PosFile<>0 AND (PosFile<PosBound) Then
PosBeg = PosFile + 10
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "FileName", FileName
Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
PosBeg = Pos+14
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "ContentType",ContentType
PosBeg = PosEnd+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
' Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
Value = PosBeg & "$$" & PosEnd
isfile = true
Else
Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
PosBeg = Pos+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = getStringChinese(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
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")
'调用BuildUploadRequest，获取各表单数据。
BuildUploadRequest RequestBin,UploadRequest
'数据被分解并存储在dictionary对象中，并用Item() 方法恢复。
'这些item 数据可以保存在VBScript 变量中，并且可以在代码的任何地方使用。
'数据可以作为响应传送回客户机，或用在ASP代码中，或写进文件中及放入数据库中。取回数据
'UploadRequest 对象的普通数据可用Item("key") 函数进行存取。
'现在来考虑一下这样的情况：要存取你要的text2控制的值。可以这样做：
text2 = UploadRequest.Item("text2").Item("Value")
Response.write "表单数据text2:" & text2 & "<br>"
'不过对于上传的文件，即file类型的上传数据。dictionary对象中只保留它们的始/终位置。
'我们要取出这两个位置，然后用Stream对象来分解出。
text1 = UploadRequest.Item("text1").Item("Value")
If instr(1,text1,"$$")>0 then
arrTmpValue = split(text1,"$$")
'起始位置
PosBeg = arrTmpValue(0)
'结束位置
PosEnd = arrTmpValue(1)
If PosBeg < PosEnd then
'将上传文件写入指定目录下。
Set Savefile_Stream=CreateObject("Adodb.Stream")
Savefile_Stream.mode=3
Savefile_Stream.type=1
Savefile_Stream.Open
Uploadfile_Stream.Position = PosBeg -1
Uploadfile_Stream.Copyto Savefile_Stream,(PosEnd - PosBeg)
SavefilePath = "C:\text1.jpg"
Savefile_Stream.SaveToFile SavefilePath,2
Savefile_Stream.Close
Set Savefile_Stream=Nothing
Response.Write "文件上传起始位置:" & PosBeg & "<br>"
Response.Write "文件上传终于位置:" & PosEnd & "<br>"
Else
Response.Write "没有文件上传！"
End if
Else
Response.Write "没有文件上传！"
End if
'------------------------------------
%>
比如：http://www.csdn.net/expert/topic/649/649412.xml?temp=9.220523E-02
另外若我这里也贴出一段代码来。
//htm页面funtest4.htm==========================================
<form method="POST" action="futest4.asp" name="form1" enctype="multipart/form-data">
<p>
<input type="file" name="text1" size="20">
</p>
<p>
<input type="text" name="text2" size="20">
<input type="submit" value="提交" name="B1"><input type="reset" value="全部重写" name="B2">
</p>
</form>
//action指向的页面funtest4.asp=================================
<%
Dim Uploadfile_Stream
Dim RequestBin,iTotBytes
'取得上传的二进制数据
iTotBytes = Request.TotalBytes
'将二进制数据赋值RequestBin
RequestBin = Request.BinaryRead(iTotBytes)
'将二进制流数据同时写入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
PosBeg = 1
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
if posend = 0 then
BuildUploadRequest_ASCII getString(requestbin), UploadRequest
Exit Sub
end if
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryPos = InstrB(1,RequestBin,boundary)
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
Dim UploadControl
Set UploadControl = Server.CreateObject("Scripting.Dictionary")
Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
Pos = InstrB(Pos,RequestBin,getByteString("name="))
PosBeg = Pos+6
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
Name = getStringChinese(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
PosBound = InstrB(PosEnd,RequestBin,boundary)
isfile = false
If PosFile<>0 AND (PosFile<PosBound) Then
PosBeg = PosFile + 10
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "FileName", FileName
Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
PosBeg = Pos+14
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "ContentType",ContentType
PosBeg = PosEnd+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
' Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
Value = PosBeg & "$$" & PosEnd
isfile = true
Else
Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
PosBeg = Pos+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = getStringChinese(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
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")
'调用BuildUploadRequest，获取各表单数据。
BuildUploadRequest RequestBin,UploadRequest
'数据被分解并存储在dictionary对象中，并用Item() 方法恢复。
'这些item 数据可以保存在VBScript 变量中，并且可以在代码的任何地方使用。
'数据可以作为响应传送回客户机，或用在ASP代码中，或写进文件中及放入数据库中。取回数据
'UploadRequest 对象的普通数据可用Item("key") 函数进行存取。
'现在来考虑一下这样的情况：要存取你要的text2控制的值。可以这样做：
text2 = UploadRequest.Item("text2").Item("Value")
Response.write "表单数据text2:" & text2 & "<br>"
'不过对于上传的文件，即file类型的上传数据。dictionary对象中只保留它们的始/终位置。
'我们要取出这两个位置，然后用Stream对象来分解出。
text1 = UploadRequest.Item("text1").Item("Value")
If instr(1,text1,"$$")>0 then
arrTmpValue = split(text1,"$$")
'起始位置
PosBeg = arrTmpValue(0)
'结束位置
PosEnd = arrTmpValue(1)
If PosBeg < PosEnd then
'将上传文件写入指定目录下。
Set Savefile_Stream=CreateObject("Adodb.Stream")
Savefile_Stream.mode=3
Savefile_Stream.type=1
Savefile_Stream.Open
Uploadfile_Stream.Position = PosBeg -1
Uploadfile_Stream.Copyto Savefile_Stream,(PosEnd - PosBeg)
SavefilePath = "C:\text1.jpg"
Savefile_Stream.SaveToFile SavefilePath,2
Savefile_Stream.Close
Set Savefile_Stream=Nothing
Response.Write "文件上传起始位置:" & PosBeg & "<br>"
Response.Write "文件上传终于位置:" & PosEnd & "<br>"
Else
Response.Write "没有文件上传！"
End if
Else
Response.Write "没有文件上传！"
End if
'------------------------------------
%>
mind_1220 2002-05-12
- 打赏
- 举报
申明一下
这个程序我也是问的别人（不用谢我）
我的email
mind_1220@163.com
我问题告诉我
这个程序我也是问的别人（不用谢我）
我的email
mind_1220@163.com
我问题告诉我
mind_1220 2002-05-12
- 打赏
- 举报
preview.asp
-------------------------------------------------------------
<!--#include file="config.inc"-->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<bgsound id=Audio loop=-1 src="">
</head>
<body>
<table border="1" width="100%" height="100%">
<tr>
<td width="74%" height="23">
请选择要预览的文件<select size="1" name="D1" onchange=showFile(this.value,this.options(this.selectedIndex).text)>
<%
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")
rs.Open "Select * From upload",conn,1
if rs.EOF then
response.write "<option>数据库中没有上传文件。</option>"
else
response.write "<option selected>选择要预览的文件</option>"
do while not rs.EOF
filename=rs("FileName")
mime=rs("MIME")
response.write "<option value='" & mime & "'>" & filename & "</option>"
rs.MoveNext
loop
end if
rs.close
conn.close
set rs=nothing
set conn=nothing
%>
</select>
</td>
<td width="26%" height="23">
<input type="button" value="继续上传文件" onclick="location='uploadtest.htm'">
</td>
</tr>
<tr>
<td width="100%" id=PreView height="297" align="center" colspan="2">
预览区
</td>
</tr>
</table>
<p align="center">
<br><script>
function showFile(typ,name){
Audio.src="";
getf="<%=UploadFilePath%>"+"/"+name;
if (/\.mp3/i.test(name)) typ="audio/mp3";
x=/^(\w+)/.test(typ)
switch(RegExp.$1){
case "audio":
Audio.src=getf;
pr="开始播放音乐:"+name;
break;
case "image":
pr="<img src='"+getf+"'>";
break;
default:
pr="<iframe width=100% height=100% src='"+getf+"'></iframe>"
}
PreView.innerHTML=pr;
}
</script>
</body>
</html>
-------------------------------------------------------------
<!--#include file="config.inc"-->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<bgsound id=Audio loop=-1 src="">
</head>
<body>
<table border="1" width="100%" height="100%">
<tr>
<td width="74%" height="23">
请选择要预览的文件<select size="1" name="D1" onchange=showFile(this.value,this.options(this.selectedIndex).text)>
<%
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")
rs.Open "Select * From upload",conn,1
if rs.EOF then
response.write "<option>数据库中没有上传文件。</option>"
else
response.write "<option selected>选择要预览的文件</option>"
do while not rs.EOF
filename=rs("FileName")
mime=rs("MIME")
response.write "<option value='" & mime & "'>" & filename & "</option>"
rs.MoveNext
loop
end if
rs.close
conn.close
set rs=nothing
set conn=nothing
%>
</select>
</td>
<td width="26%" height="23">
<input type="button" value="继续上传文件" onclick="location='uploadtest.htm'">
</td>
</tr>
<tr>
<td width="100%" id=PreView height="297" align="center" colspan="2">
预览区
</td>
</tr>
</table>
<p align="center">
<br><script>
function showFile(typ,name){
Audio.src="";
getf="<%=UploadFilePath%>"+"/"+name;
if (/\.mp3/i.test(name)) typ="audio/mp3";
x=/^(\w+)/.test(typ)
switch(RegExp.$1){
case "audio":
Audio.src=getf;
pr="开始播放音乐:"+name;
break;
case "image":
pr="<img src='"+getf+"'>";
break;
default:
pr="<iframe width=100% height=100% src='"+getf+"'></iframe>"
}
PreView.innerHTML=pr;
}
</script>
</body>
</html>
mind_1220 2002-05-12
- 打赏
- 举报
upload.asp
--------------------------------------------------------
<!--#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")
username=Upload.Item("user").Item("Value")
f=Upload.Keys
Set sStream = Server.CreateObject("ADODB.Stream") '建立Stream对象
Set dStream = Server.CreateObject("ADODB.Stream") '建立Stream对象
dStream.mode=3 '设置为读/写方式
dStream.Type = 1 '设置数据类型为二进制
dStream.Open '打开Stream对象
sStream.mode=3 '设置为读/写方式
sStream.Type = 1 '设置数据类型为二进制
sStream.Open '打开Stream对象
sStream.write BinForm
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.addnew
filestart=Upload.Item(f(i)).Item("Start")
sStream.Position=filestart-1
sStream.CopyTo dStream,size
dStream.SaveToFile savefile ,2
'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>
<head>
<title></title>
</head>
<body >
<center>
<%=errs%>a
<p> </p>
<p>
<input type="button" value="预览上传文件" onclick="location='preview.asp'">
</p>
<p> </p>
</center>
</body>
</html>
<%
set upload=nothing
%>
--------------------------------------------------------
<!--#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")
username=Upload.Item("user").Item("Value")
f=Upload.Keys
Set sStream = Server.CreateObject("ADODB.Stream") '建立Stream对象
Set dStream = Server.CreateObject("ADODB.Stream") '建立Stream对象
dStream.mode=3 '设置为读/写方式
dStream.Type = 1 '设置数据类型为二进制
dStream.Open '打开Stream对象
sStream.mode=3 '设置为读/写方式
sStream.Type = 1 '设置数据类型为二进制
sStream.Open '打开Stream对象
sStream.write BinForm
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.addnew
filestart=Upload.Item(f(i)).Item("Start")
sStream.Position=filestart-1
sStream.CopyTo dStream,size
dStream.SaveToFile savefile ,2
'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>
<head>
<title></title>
</head>
<body >
<center>
<%=errs%>a
<p> </p>
<p>
<input type="button" value="预览上传文件" onclick="location='preview.asp'">
</p>
<p> </p>
</center>
</body>
</html>
<%
set upload=nothing
%>
baichuan168 2002-05-12
- 打赏
- 举报
有必要写怎么多吗！
mind_1220 2002-05-12
- 打赏
- 举报
uploadtest.htm
------------------------------------------------
<html>
<head>
<title>ASP无组件混合文件上传示范</title>
</head>
<body>
<table border="1" width="100%" bordercolor="#99CCFF" cellspacing="0" cellpadding="6" style="font-size: 10pt">
<tr>
<td width="100%" align="center">ASP无组件任意文件混合上传示范</td>
</tr>
<tr>
<td width="100%" align="center">
<table border="1" width="100%" bordercolor="#D7EBFF" cellspacing="0" cellpadding="6" style="font-size: 10pt">
<form method="POST" action='upload.asp' enctype='multipart/form-data' name="xy123">
<tr>
<td width="35%" align="right">文件1路径</td>
<td width="65%"><input type="file" name="file1" size="30"></td>
</tr>
<tr>
<td width="35%" align="right">文件2路径</td>
<td width="65%"><input type="file" name="file2" size="30"></td>
</tr>
<tr>
<td width="35%" align="right">文件3路径</td>
<td width="65%"><input type="file" name="file3" size="30"></td>
</tr>
<tr>
<td width="35%" align="right">上传者名称</td>
<td width="65%"><input type="text" name="user" size="30"></td>
</tr>
</form>
<tr>
<td width="100%" colspan="2">
<p align="center"><input type="button" value="开始上传文件" onclick="Post()">
<input type="button" value="预览已上传文件" onclick="location='preview.asp'">
</td>
</tr>
<tr>
<td width="100%" colspan="2">
<p align="center">
上传完成后请打开Preview.asp浏览</td>
</tr>
</table>
<a href="mailto:%0d%0a898801@sina.com">
<br>
</a>晓月—8988 工作室，<a href="mailto:%0d%0a898801@sina.com">898801@sina.com</a>
<p>请保留作者著作权。</p>
</td>
</tr>
</table>
<script>
function Post(){
if(xy123.file1.value=="" && xy123.file2.value=="" && xy123.file3.value) {alert("至少要上传一个文件");return;}
if(xy123.user.value==""){alert("用户名必须填写");return}
xy123.submit();
}
</script>
</body>
</html>
------------------------------------------------
<html>
<head>
<title>ASP无组件混合文件上传示范</title>
</head>
<body>
<table border="1" width="100%" bordercolor="#99CCFF" cellspacing="0" cellpadding="6" style="font-size: 10pt">
<tr>
<td width="100%" align="center">ASP无组件任意文件混合上传示范</td>
</tr>
<tr>
<td width="100%" align="center">
<table border="1" width="100%" bordercolor="#D7EBFF" cellspacing="0" cellpadding="6" style="font-size: 10pt">
<form method="POST" action='upload.asp' enctype='multipart/form-data' name="xy123">
<tr>
<td width="35%" align="right">文件1路径</td>
<td width="65%"><input type="file" name="file1" size="30"></td>
</tr>
<tr>
<td width="35%" align="right">文件2路径</td>
<td width="65%"><input type="file" name="file2" size="30"></td>
</tr>
<tr>
<td width="35%" align="right">文件3路径</td>
<td width="65%"><input type="file" name="file3" size="30"></td>
</tr>
<tr>
<td width="35%" align="right">上传者名称</td>
<td width="65%"><input type="text" name="user" size="30"></td>
</tr>
</form>
<tr>
<td width="100%" colspan="2">
<p align="center"><input type="button" value="开始上传文件" onclick="Post()">
<input type="button" value="预览已上传文件" onclick="location='preview.asp'">
</td>
</tr>
<tr>
<td width="100%" colspan="2">
<p align="center">
上传完成后请打开Preview.asp浏览</td>
</tr>
</table>
<a href="mailto:%0d%0a898801@sina.com">
<br>
</a>晓月—8988 工作室，<a href="mailto:%0d%0a898801@sina.com">898801@sina.com</a>
<p>请保留作者著作权。</p>
</td>
</tr>
</table>
<script>
function Post(){
if(xy123.file1.value=="" && xy123.file2.value=="" && xy123.file3.value) {alert("至少要上传一个文件");return;}
if(xy123.user.value==""){alert("用户名必须填写");return}
xy123.submit();
}
</script>
</body>
</html>
mind_1220 2002-05-12
- 打赏
- 举报
config.inc
----------------------------------------------------------
<%
MaxSize=3000*1024 '设置最大300K
datPath="upload.mdb" '设置数据库路径
UploadFilePath="UploadFiles" '设置上传文件路径（相对网络路径）
%>
----------------------------------------------------------
<%
MaxSize=3000*1024 '设置最大300K
datPath="upload.mdb" '设置数据库路径
UploadFilePath="UploadFiles" '设置上传文件路径（相对网络路径）
%>
mind_1220 2002-05-12
- 打赏
- 举报
你源代码
以下的办法是我刚使用过的应该不会有问题吧
解释一下uploadtest.htm是添加页面
在数据库中
应该有以下的字段
id(自动编号)、filevalue(ole对象)、filename、mime、filetype、
filesize、username、savetime（now()）
这个程序的功能：
1、可以同时传递几个（多少可以改的）图片
2、除了图片它还可以传递其他的如（word文档，歌曲，等等）担有大小
限制
3、计算出文件大小
以下的办法是我刚使用过的应该不会有问题吧
解释一下uploadtest.htm是添加页面
在数据库中
应该有以下的字段
id(自动编号)、filevalue(ole对象)、filename、mime、filetype、
filesize、username、savetime（now()）
这个程序的功能：
1、可以同时传递几个（多少可以改的）图片
2、除了图片它还可以传递其他的如（word文档，歌曲，等等）担有大小
限制
3、计算出文件大小
julyclyde 2002-05-12
- 打赏
- 举报
http://www.csdn.net/Subject/5/index.shtm
