网站首页 手机版
 注册 登录
您现在的位置: 畅无忧设计 >> 网络编程 >> ASP教程 >> 正文
最新文章
· FSO 组件asp生成html静态页面碰到缓存
· asp实现长文章自动分页插件
· 在ASP中访问和更新Cookies集合
· ASP错误提示大全
· 学习ASP的几个观点
· ASP用两级联动下拉列表来显示大类和小
· ASP取当前页面地址和参数
· ASP删除记录的同时删除相关图片
· asp将查询结果导出到excel
· ASP批量导入Excel到Access或者Sql Se
热门文章
 化境ASP无组件上传类 - upload_5xs
 一个获取ACCESS数据库表名以及表名
 asp将查询结果导出到excel
 艾恩ASP无组件上传修改版
 ASP批量导入Excel到Access或者Sql 
 ASP读取数据库的Flash+JS图片切换特
 ASP用两级联动下拉列表来显示大类和
 ASP+JS实现网页歌曲连播、点播功能
 使用ASP重启服务器
 asp批量替换access数据库中指定字段
相关文章
没有相关文章
化境ASP无组件上传类 - upload_5xsoft 使用手册 2.0
来源:网络 更新时间:2010/4/16 16:45:11 阅读次数:
字体:[ ] 我要投稿

1.使用了网友“梁无惧” 提供的高效的处理方式,上传速度可提高一倍以上,可上传更大的文件。

2.添加了form 方法和file方法,把原来的 form 集和 file改为 objForm 和 objFile,避免了若上传时没有数据会出错的Bug。

3.对多选框的优化,上传同名的多选框时,会自动用 ", " 连接起来。

4.对于表单名,不再区分大小写,使用ASP使用者更习惯。


关于 upload_5xsoft


一直以来,由于FileSystemObject的局限,所以ASP最大的难题就是文件上传,大多解决法就是安装

第三方上传组件。可第三方组件有很多问题,有的组件要注册,有的组件要在表单中加上他的版权信息。

还有的就是组件的兼容问题。

   在网上也流传了很多无组件上传的代码,但都是只能上传文本文件,或是只能将文件上传到数据库中。

我这段时间在研究ASP,发现可以不用第三方组件上传任意类型的文件。就写了这个类,给大家一

个方便,整个类放在一个文件中: upload_5xsoft.inc 在 Example 目录下还有一个完整的多文件上传示

例程序,可以直接使用。

申明:源代码是完全开放的,可能随意传播,但请保留其完整性,未经作者同意,不得用于商业。

 

运行平台与注意事项

a)可直接运行于 Windows2000+IIS 5
NT4 或是 Win98+PWS, 要安装ADO2.6 下载地址:http://www.microsoft.com/data/:
<!--#include FILE="upload_5xsoft.inc"--> 就行了


b) 在使用文件上传时, 表单 form 要加上 enctype="multipart/form-data" 即:

<form name="form1" method="post" action="" enctype="multipart/form-data">
<input type="text" value="abc" name="text1">
<input type=file name="file">
<input type=submit name="submit" value="提交">
</form>


upload_5xsoft的对象

如定义一个上传对象
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft 'upload就是一个对象
%>

upload_5xsoft 对象成员
File 方法,得到文件对象,例如:set file=upload.file("file1")

文件对象成员下面有说明
objFile 文件对象集,(是个dictionary对象)

文件对象成员:
Count 属性,文件表单的个数
FileName 属性,上传文件的名字
FileSize 属性,上传文件的大小(为0是表示没有文件)
FilePath 属性,上传前文件所在的路径
FormName 属性,文件表单的名字
SaveAs 方法,储存上传后文件,有一个参数,路径要为真实路径如:
例子: set file=upload.file("file1") 'file1为表单名

response.write "<br>文件名:"&file.FileName

response.write "<br>文件大小:"&file.FileSize

response.write "<br>文件路径:"&file.FilePath

file.saveAs Server.mappath("/1.jpg")

set file=nothing
Form 方法,获得表单数据,如 Response.Write upload.Form("abc")
objForm 表单数据集,(是个dictionary对象)用来代替 Request.Form
count 属性,表单数
exists 方法,检查是否有指定的表单名
更多的用法可看 vbscript 的dictionary对象帮助
例子:
'得到text1表单的数据,uplaod就是一开始创建的对象

sText=upload.form("text1") 
Version 属性,upload_5xsoft类的版本号,如:

response.write upload.Version

 

使用示例

1.上传一个jpg文件的示例:

文件1: upload.htm

<html><title>example</title>
<body>
<form name="form1" method="post" action="upload.asp" enctype="multipart/form-data">
<input type=file name="file1">
<input type=submit name="submit" value="提交">
</form>
</body>
</html>

文件2: upload.asp

<html><title>example</title>
<body>
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft
set file=upload.file("file1")
response.write upload.form("submit")&"<br>"
if file.fileSize>0 then
file.saveAs Server.mappath("temp.jpg")
response.write "<br>上传文件:"&file.FileName&" => temp.jpg OK!"
response.write "<br>文件大小:"&file.FileSize
end if
set file=nothing
set upload=nothing
%></body>
</html>

2.列表出有文件表单(多文件上传)
<html><title>example</title>
<body>
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft

''列出所有form数据
for each formName in upload.objForm
response.write formName&"="&upload.objForm(formName)&"<br>"
next

''列出所有文件
for each formName in upload.objFile
set file=upload.objFile(formName)
if file.FileSize>0 then
  file.SaveAs Server.mappath(file.FileName)
  response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "
  response.write file.FileName&" 成功!<br>"
end if
set file=nothing
next
set upload=nothing
%>


若程序有问题,请写作者联系 getc@163.com

稻香老农 2003年 1月8日

 

首先是为了完成上传并且显示进度条所需要的四个包含文件,放入include文件夹

1、wang_upload_5xsoft.inc

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft

Class upload_5xsoft
 
dim objForm,objFile,Version
'------------------------begin add by mytju.com----------------------------
dim mProgressID,tempFileName
Public Property Get ProgressID()
ProgressID=mProgressID
End Property

Public Property Let ProgressID(byVal itemValue)
mProgressID=itemValue
End Property
'-----------------------end add by mytju.com-----------------------------
Public function Form(strForm)
   strForm=lcase(strForm)
   if not objForm.exists(strForm) then
     Form=""
   else
     Form=objForm(strForm)
   end if
end function

Public function File(strFile)
   strFile=lcase(strFile)
   if not objFile.exists(strFile) then
     set File=new FileInfo
   else
     set File=objFile(strFile)
   end if
end function


Public Sub GetUpFile '-----------change by mytju.com------------------------------
  dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
  dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
  dim readBlock,readBlockSize,upBytes
  Version="化境HTTP上传程序 Version 2.0"
  set objForm=Server.CreateObject("Scripting.Dictionary")
  set objFile=Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes<1 then Exit Sub
  set tStream = Server.CreateObject("adodb.stream")
  set Data_5xsoft = Server.CreateObject("adodb.stream")
  Data_5xsoft.Type = 1
  Data_5xsoft.Mode =3
  Data_5xsoft.Open
'------------------------modify begin by mytju.com------------------------------
'---create xml File--------------------
Dim objFSO, objTextFile
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
tempFileName=objFSO.GetSpecialFolder(2)&"\upload_"&mProgressID&".xml"
Set objTextFile = objFSO.CreateTextFile(tempFileName, True)
objTextFile.WriteLine("<?xml version=""1.0"" encoding=""gb2312""?>")
objTextFile.WriteLine("<tree>")
objTextFile.WriteLine("<fileUpProgress myID=""1"">")
objTextFile.WriteLine("<BytesTransferred>0</BytesTransferred>")
objTextFile.WriteLine("<TotalBytes>0</TotalBytes>")
objTextFile.WriteLine("<useTime>1</useTime>")
objTextFile.WriteLine("</fileUpProgress>")
objTextFile.WriteLine("</tree>")
objTextFile.Close
Set objTextFile = Nothing
Set objFSO = Nothing
'---start to upload---------------------
upBytes=0
readBlockSize=1024*100
startTime=Timer()
readBlock=Request.BinaryRead(readBlockSize)
'---create xmlDom------------------------
set objDOM = Server.CreateObject("Microsoft.XMLDOM")
objDOM.async = false
objDOM.load tempFileName
Set objRoot = objDom.documentElement
Set objField = objRoot.selectSingleNode("/tree/fileUpProgress[@myID=1]")
'---loop to get data--------------------
while Lenb(readBlock)>0
  upBytes=upBytes+Lenb(readBlock)
  '--save value---------
  objField.childNodes.item(0).text=Cstr(upBytes)
  objField.childNodes.item(1).text=Cstr(Request.TotalBytes)
  objField.childNodes.item(2).text=Cstr(Timer()-startTime)
  objDom.save tempFileName
  '--write to Stream-----
  Data_5xsoft.Write readBlock
  readBlock=Request.BinaryRead(readBlockSize)
wend
Set objField = Nothing
Set objRoot = Nothing
Set objDom = Nothing
'------------------------modify end by mytju.com------------------------------
  Data_5xsoft.Position=0
  RequestData =Data_5xsoft.Read

  iFormStart = 1
  iFormEnd = LenB(RequestData)
  vbCrlf = chrB(13) & chrB(10)
  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
  iStart = LenB (sStart)
  iFormStart=iFormStart+iStart+1
  while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iFormStart
Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
  set theFile=new FileInfo
  '取得文件名
  iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
  iFindEnd = InStr(iFindStart,sInfo,"""",1)
  sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
  theFile.FileName=getFileName(sFileName)
  theFile.FilePath=getFilePath(sFileName)
  '取得文件类型
  iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
  iFindEnd = InStr(iFindStart,sInfo,vbCr)
  theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
  theFile.FileStart =iInfoEnd
  theFile.FileSize = iFormStart -iInfoEnd -3
  theFile.FormName=sFormName
  if not objFile.Exists(sFormName) then
    objFile.add sFormName,theFile
  end if
else
'如果是表单项目
  tStream.Type =1
  tStream.Mode =3
  tStream.Open
  Data_5xsoft.Position = iInfoEnd
  Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
  tStream.Position = 0
  tStream.Type = 2
  tStream.Charset ="gb2312"
         sFormValue = tStream.ReadText
         tStream.Close
  if objForm.Exists(sFormName) then
    objForm(sFormName)=objForm(sFormName)&", "&sFormValue   
  else
    objForm.Add sFormName,sFormValue
  end if
end if
iFormStart=iFormStart+iStart+1
wend
  RequestData=""
  set tStream =nothing
End Sub

Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_5xsoft.Close
set Data_5xsoft =nothing
end if
End Sub
  

Private function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
  Else
   GetFilePath = ""
  End If
End  function

Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
  Else
   GetFileName = ""
  End If
End  function
End Class

Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart
  Private Sub Class_Initialize
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
    FileType = ""
  End Sub
 
Public function SaveAs(FullPath)
    dim dr,ErrorChar,i
    SaveAs=true
    if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
    set dr=CreateObject("Adodb.Stream")
    dr.Mode=3
    dr.Type=1
    dr.Open
    Data_5xsoft.position=FileStart
    Data_5xsoft.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing
    SaveAs=false
  end function
  End Class
</SCRIPT>

 

2、fileUpProgress.asp

<% @codepage=936 EnableSessionState=False%>
<HTML xmlns:v>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=gb2312">
<TITLE>文件上传进度指示条</TITLE>
<STYLE>
v\:*{behavior:url(#default#VML);}
*{font-size:12px;}
</STYLE>
<style type="text/css">
<!--
font {
font-size: 14px;
}
td {
font-size: 14px;
color: #333333;
}
b {
font-size: 14px;
}
span {
font-size: 14px;
}
a:link {
color: #333333;
text-decoration: none;
}
a:hover {
color: #990000;
text-decoration: underline;
}
a:visited {
color: #000000;
text-decoration: none;
}
-->
</style>
</HEAD>
<BODY topmargin="0" leftmargin="0" onLoad="begin()" bgcolor="#CCCCCC">
<p><br>
<table width="100%" border="0" cellspacing="0" cellpadding="4">
  <tr>
    <td align="center"><b>文件上传进度指示条</b></td>
  </tr>
  <tr>
    <td>状态:<span ID="myStatus"></span></td>
  </tr>
  <tr>
    <td width="500"><div style="table-Layout:fixed;width:100%;height:100%;border:1 solid black"><v:RoundRect id="myRect" style="height:20;" name="myRect">  <v:fill type="gradient" id="fill1" color="blue"/> </v:RoundRect></div></td>
  </tr>
  <tr>
    <td>已经上传:<span ID="message"></span></td>
  </tr>
  <tr>
    <td>使用时间:<span ID="time">0</span> 秒 </td>
  </tr>
  <tr>
    <td>平均速率:<span ID="speed">0</span> KB/秒 </td>
  </tr>
</table>
<script language="Javascript">
self.moveTo(getTop(200),getLeft(500));
var intBytesTransferred=0;
var intTotalBytes=0;
var useTime=1; //s
var getData;
var myWidth=486;
var beginUploadFlg=false;
fill1.color="rgb("+Math.round(Math.random()*255)+","+Math.round(Math.random()*255)+","+Math.round(Math.random()*255)+")";
myStatus.innerHTML="正在初始化....";
function begin()
{
message.innerHTML="开始获取信息....";
    var Doc = new ActiveXObject('Microsoft.XMLDOM');
    Doc.async = false;
    Doc.load("fileUpProgressRead.asp?progressID=<%=Request.QueryString("progressID")%>&aa="+new Date().getTime());
if(Doc.parseError.errorCode != 0) //检查获取数据时是否发生错误
{
  delete(Doc);
  if(beginUploadFlg){
   intBytesTransferred=intTotalBytes;
  }else{
   message.innerHTML="上传动作尚未启动!";
  }
}else{
     var rootNode=Doc.documentElement;
     if(rootNode.childNodes != null) 
     {     beginUploadFlg=true;
           intBytesTransferred=Number(rootNode.childNodes.item(0).childNodes.item(0).text);
           intTotalBytes=Number(rootNode.childNodes.item(0).childNodes.item(1).text);
           useTime=Number(rootNode.childNodes.item(0).childNodes.item(2).text);
           message.innerHTML="获取信息成功。";
     }
     delete(rootNode);
}
delete(Doc);
    if(intTotalBytes==0){
  intBytesTransferred=1;
  intTotalBytes=100;
}
display();
if(intTotalBytes>0 && intBytesTransferred<intTotalBytes){
  if(beginUploadFlg){
   myStatus.innerHTML="正在上传,请耐心等待....";
  }
  time.innerHTML=useTime;
  speed.innerHTML=Math.round((intBytesTransferred/useTime)/1024);
  getData = setTimeout("begin()",1000);
}else{
  myStatus.innerHTML="数据上传完毕,3秒后自动关闭。";
  setTimeout("self.close()",3000);
}
}
function display(){
myRect.style.width=Math.round(myWidth/(intTotalBytes/intBytesTransferred));
fill1.angle=Math.round(300/(intTotalBytes/intBytesTransferred));
if(beginUploadFlg){
  message.innerText=intBytesTransferred+"/"+intTotalBytes+","+Math.round(100/(intTotalBytes/intBytesTransferred))+"%";
}
}
function getTop(windowHeight){
  var top = parseInt((screen.height - windowHeight)/2-15);
  return top;
}

function getLeft(windowWidth){
  var left = parseInt((screen.width - windowWidth)/2-5);
  return left;
}
</script>
</BODY>
</HTML>

3、fileUpProgressRead.asp

<% @codepage=936 EnableSessionState=False%>
<%
Set fso = Server.CreateObject("Scripting.FileSystemObject")
mProgressID=Request.QueryString("progressID")
filePath=fso.GetSpecialFolder(2)&"\upload_"&mProgressID&".xml"
Set f = fso.OpenTextFile(filePath,1)
response.write f.ReadAll
set f=nothing
set fso=nothing
%>

4、randomString.asp

<% Function gen_key(digits)
    dim char_array(80)
    For i = 0 To 9
        char_array(i) = CStr(i)
    Next
    For i = 10 To 35
        char_array(i) = Chr(i + 55)
    Next
    For i = 36 To 61
        char_array(i) = Chr(i + 61)
    Next
Randomize
do while len(output) < digits
        num = char_array(Int((62 - 0 + 1) * Rnd + 0))
        output = output & num
    loop
    gen_key = output
End Function %>

 

下面的文件 在include文件夹外面

测试页面

5、test_upload.asp

<!--#include file="include/randomString.asp" -->
<% ProgressID = gen_key(10) %>
<meta HTTP-EQUIV=Content-Type content="text/html; charset=gb2312">
<form action="test_uploadSave.asp" method="post" enctype="multipart/form-data" onSubmit="myOpen(this)">
文件:<INPUT name="file" type="file"  size="20">
文本:<INPUT name="text" type="text"  size="20" >
<input type="submit" value="submit">
</form>
<script>
function myOpen(form){
window.open("include/fileUpProgress.asp?progressID=<%=ProgressID%>","","width=500,height=200,scrollbars=no,toolbar=no,status=no,resizable=no,menubar=no,location=no");
var url=form.action;
if (url.indexOf("?",0)==-1) {
  form.action = url+"?progressID=<%=ProgressID%>";
}else{
  form.action = url+"&progressID=<%=ProgressID%>";
}
}
</script>

6、test_uploadSave.asp

<%@ CODEPAGE="936"%>
<!--#include file="include/wang_upload_5xsoft.inc" -->
<META http-equiv="Content-Type" content="text/html; charset=gb2312">
<%
Server.ScriptTimeOut=300
'--注意下面是写法稍有不同的地方---
set upload=new upload_5xsoft
upload.ProgressID=Request.QueryString("progressID") '一定是这行在先。
upload.GetUpFile
'--结束---其他与以前的写法完全相同-------------
response.write upload.form("text")

set file=upload.file("file")
file.saveas Server.mappath(".")&"\"&file.fileName
set upload=nothing
%>
<br>----------ok-----------

 

 

 

 

首先,图片在页面中能查找选择。设计表单页面index.asp和上传选择页upload.asp,upload.asp在index.asp中以iframe包含。

其次,所选图片应能上传到某文件夹。建立一文件夹uploadimg

最后,传上去的图片应如何引用?很显然,采用UBB立即显示。upload.asp的指向对象upfile.asp具有写入UBB标签的功能。

 

无组件上传调试文件夹
    -- index.asp
    -- upload.asp
    -- upfile.asp
    -- uploadimg文件夹

 


图片上传采用稻香老农的无组件上传。所以upload.inc文件必不可少。

1,upload.inc(拷贝以下文本框的所有代码)
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>

dim upfile_5xSoft_Stream

Class upload_5xSoft

dim Form,File,Version

Private Sub Class_Initialize
        dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
        dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
        Version=""
        if Request.TotalBytes<1 then Exit Sub
        set Form=CreateObject("Scripting.Dictionary")
        set File=CreateObject("Scripting.Dictionary")
        set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")
        upfile_5xSoft_Stream.mode=3
        upfile_5xSoft_Stream.type=1
        upfile_5xSoft_Stream.open
        upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes)
       
        vbEnter=Chr(13)&Chr(10)
        iDivLen=inString(1,vbEnter)+1
        strDiv=subString(1,iDivLen)
        iFormStart=iDivLen
        iFormEnd=inString(iformStart,strDiv)-1
        while iFormStart < iFormEnd
         iStart=inString(iFormStart,"name=""")
         iEnd=inString(iStart+6,"""")
         mFormName=subString(iStart+6,iEnd-iStart-6)
         iFileNameStart=inString(iEnd+1,"filename=""")
         if iFileNameStart>0 and iFileNameStart<iFormEnd then
          iFileNameEnd=inString(iFileNameStart+10,"""")
          mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
          iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
          iEnd=inString(iStart+4,vbEnter&strDiv)
          if iEnd>iStart then
            mFileSize=iEnd-iStart-4
          else
            mFileSize=0
          end if
          set theFile=new FileInfo
          theFile.FileName=getFileName(mFileName)
          theFile.FilePath=getFilePath(mFileName)
          theFile.FileSize=mFileSize
          theFile.FileStart=iStart+4
          theFile.FormName=FormName
          file.add mFormName,theFile
         else
          iStart=inString(iEnd+1,vbEnter&vbEnter)
          iEnd=inString(iStart+4,vbEnter&strDiv)
       
          if iEnd>iStart then
            mFormValue=subString(iStart+4,iEnd-iStart-4)
          else
            mFormValue=""
          end if
          form.Add mFormName,mFormValue
         end if
       
         iFormStart=iformEnd+iDivLen
         iFormEnd=inString(iformStart,strDiv)-1
        wend
End Sub

Private Function subString(theStart,theLen)
dim i,c,stemp
upfile_5xSoft_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
  if upfile_5xSoft_Stream.EOS then Exit for
  c=ascB(upfile_5xSoft_Stream.Read(1))
  If c > 127 Then
  if upfile_5xSoft_Stream.EOS then Exit for
  stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c)))
  i=i+1
  else
  stemp=stemp&Chr(c)
  End If
Next
subString=stemp
End function

Private Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to upfile_5xSoft_Stream.Size-theLen
  if i>upfile_5xSoft_Stream.size then exit Function
  upfile_5xSoft_Stream.Position=i-1
  if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then
  InString=i
  for j=2 to theLen
   if upfile_5xSoft_Stream.EOS then
    inString=0
    Exit for
   end if
   if AscB(upfile_5xSoft_Stream.Read(1))<>AscB(MidB(Str,j,1)) then
    InString=0
    Exit For
   end if
  next
  if InString<>0 then Exit Function
  end if
next
End Function

Private Sub Class_Terminate
form.RemoveAll
file.RemoveAll
set form=nothing
set file=nothing
upfile_5xSoft_Stream.close
set upfile_5xSoft_Stream=nothing
End Sub
 

Private function GetFilePath(FullPath)
If FullPath <> "" Then
  GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
Else
  GetFilePath = ""
End If
End function

Private function GetFileName(FullPath)
If FullPath <> "" Then
  GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
  GetFileName = ""
End If
End function

Private function toByte(Str)
  dim i,iCode,c,iLow,iHigh
  toByte=""
  For i=1 To Len(Str)
  c=mid(Str,i,1)
  iCode =Asc(c)
  If iCode<0 Then iCode = iCode + 65535
  If iCode>255 Then
   iLow = Left(Hex(Asc(c)),2)
   iHigh =Right(Hex(Asc(c)),2)
   toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
  Else
   toByte = toByte & chrB(AscB(c))
  End If
  Next
End function
End Class


Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileStart
Private Sub Class_Initialize
  FileName = ""
  FilePath = ""
  FileSize = 0
  FileStart= 0
  FormName = ""
End Sub

Public function SaveAs(FullPath)
  dim dr,ErrorChar,i
  SaveAs=1
  if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function
  if FileStart=0 or right(fullpath,1)="/" then exit function
  set dr=CreateObject("Adodb.Stream")
  dr.Mode=3
  dr.Type=1
  dr.Open
  upfile_5xSoft_Stream.position=FileStart-1
  upfile_5xSoft_Stream.copyto dr,FileSize
  dr.SaveToFile FullPath,2
  dr.Close
  set dr=nothing
  SaveAs=0
end function
End Class
</SCRIPT>


2,表单页面index.asp。注意框架包含的上传选择页upload.asp
<form name="form_name" method="POST" action="add.asp">
<textarea cols="100" name="cn_content" rows="18" width="100%"></textarea>
</form>

<iframe border="0" frameBorder="0" noResize scrolling="no" width="100%" src="upload.asp"></iframe>


3,上传选择页upload.asp 注意: enctype="multipart/form-data"
<form name="form" method="post" action="upfile.asp" enctype="multipart/form-data">
<input type="hidden" name="filepath" value="uploadimg">
<input type="hidden" name="act" value="upload">
<input type="file" name="file1" size=40>
<input type="submit" class=button name="Submit" value="上传图片" onclick="parent.document.forms[0].Submit.disabled=true">类型:gif,jpg,限制:100K
</form>


4,最后一 个文件 upfile.asp 主要作用:生成图片名,并将图片上传,同样也要将UBB标签写入index.asp中的textarea中。
<!--#include file="upload.inc"-->

<html>
<head>
<title>文件上传</title>
</head>
<body>

<script>
parent.document.forms[0].Submit.disabled=false;
</script>
<%
dim upload,file,formName,formPath,iCount,filename,fileExt
set upload=new upload_5xSoft ''建立上传对象

formPath=upload.form("filepath")
''在目录后加(/)
if right(formPath,1)<>"/" then formPath=formPath&"/"

response.write "<body>"

iCount=0
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.filesize<100 then
     response.write "请选择你要上传的文件 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
    response.end
end if
    
if file.filesize>100*1000 then
     response.write "文件大小超过了限制100K [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
    response.end
end if

fileExt=lcase(right(file.filename,4))
uploadsuc=false
Forum_upload="gif,jpg,png"
Forumupload=split(Forum_upload,",")
for i=0 to ubound(Forumupload)
    if fileEXT="."&trim(Forumupload(i)) then
    uploadsuc=true
    exit for
    else
    uploadsuc=false
    end if
next
if uploadsuc=false then
     response.write "文件格式不正确 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
    response.end
end if

randomize
ranNum=int(90000*rnd)+10000
filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&fileExt

if file.FileSize>0 then     ''如果 FileSize > 0 说明有文件数据
file.SaveAs Server.mappath(FileName)  ''保存文件
    for i=0 to ubound(Forumupload)
        if fileEXT="."&trim(Forumupload(i)) then
         response.write "<script>parent.form_name.cn_content.value+=''</script>"
        exit for
        end if
    next
iCount=iCount+1
end if
set file=nothing
next
set upload=nothing ''删除此对象

Htmend iCount&" 个文件上传结束!"

sub HtmEnd(Msg)
set upload=nothing

response.write "上传成功 [ <a href=# onclick=history.go(-1)>继续上传</a>]"
response.end
end sub

%>
</body>
</html>

  • 上一篇文章:
  • 下一篇文章:
  • 关于我们 - 联系我们 - 广告服务 - 在线投稿 - 友情链接 - 网站地图 - 版权声明
    CopyRight 2008-2010, CWYDESIGN.COM - 畅无忧设计, Inc. All Rights Reserved
    滇ICP备09005765号