請大家提供用 vb 做的在 asp 中上傳文件的組件的實現方法或代碼,謝謝!!!

Question

請大家提供用 vb 做的在 asp 中上傳文件的組件的實現方法或代碼,謝謝!!!

Answer 1

<!--#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 iferrs=""
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 
%>

Answer 2

<html>
<head>
<title>文件上傳</title>
<!--#INCLUDE FILE="config.asp" -->
<!--#INCLUDE FILE="inc_functions.asp" -->
<!--#INCLUDE FILE="inc_top.asp" -->
<meta http-equiv="Content-Type" content="text/html; charset=big5">
</head>
<body>
<table border="1" width="100%" bordercolor="#99CCFF" cellspacing="0" cellpadding="6" style="font-size: 10pt">
  <tr>
    <td width="100%" align="center">文件上傳</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()>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 
            <input type="button" value="預覽已上傳文件" onclick="location='preview.asp'"></td>
        </tr>
        <tr>
          <td width="100%" colspan="2">
            <p align="center">上傳完成後請打開Preview.asp瀏覽</td>
        </tr>
      </table>
    </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>        

Answer 3

<%
MaxSize=300000*1024 '设置最大300KdatPath="upload.mdb" '设置数据库路径UploadFilePath="UploadFiles" '设置上传文件路径（相对网络路径）
%>

Answer 4

我的系統不支持ado 2.1 以上的版本!!!

Answer 5

要是不支持
安装mdac2.6