网络编程 | 站长之家 | 网页制作 | 图形图象 | 操作系统 | 冲浪宝典 | 软件教学 | 网络办公 | 邮件系统 | 网络安全 | 认证考试 | 系统进程
Firefox | IE | Maxthon | 迅雷 | 电驴 | BitComet | FlashGet | QQ | QQ空间 | Vista | 输入法 | Ghost | Word | Excel | wps | Powerpoint
asp | .net | php | jsp | Sql | c# | Ajax | xml | Dreamweaver | FrontPages | Javascript | css | photoshop | fireworks | Flash | Cad | Discuz!
当前位置 > 网站建设学院 > 网络编程 > ASP实例
Tag:注入,存储过程,分页,安全,优化,xmlhttp,fso,jmail,application,session,防盗链,stream,无组件,组件,md5,乱码,缓存,加密,验证码,算法,cookies,ubb,正则表达式,水印,索引,日志,压缩,base64,url重写,上传,控件,Web.config,JDBC,函数,内存,PDF,迁移,结构,破解,编译,配置,进程,分词,IIS,Apache,Tomcat,phpmyadmin,Gzip,触发器,socket
网络编程:ASP教程,ASP.NET教程,PHP教程,JSP教程,C#教程,数据库,XML教程,Ajax,Java,Perl,Shell,VB教程,Delphi,C/C++教程,软件工程,J2EE/J2ME,移动开发
本月文章推荐
.一个ASP版的图片浏览管理器.
.论坛中有新贴子功能的实现.
.多表单域无组件文件上传的例子.
.让您的主页支持各种浏览设备(AS.
.使用 ASP+ 列表绑定控件(中).
.股票报价的WebService之三.
.用ASP技术编制隐藏用户密码程序.
.用ASP实现对Web搜索引擎Index Se.
.用ASP实现论坛的UBB功能(一).
.上传的进度条 实时反映上传情况.
.功能非常全面的日期处理函数.
.使用VB编写纯ASP程序.
.2栏分页显示(附显示的形式[1][2.
.如何开发基于ASP的FLASH MX在线图.
.XMLHTTP+Javascript+Asp写得聊天.
.2栏分页显示(附显示的形式前页,.
.负载平衡环境下的ASP会话管理(2).
.读取目录下的所有文件(源码).
.网络寻呼机数据库版显示历史消息.
.用asp实现的代码批量修改程序.

一个的无组件上传的ASP代码

发表日期:2002-1-24


<!--#include file="../lib/filelib.asp"-->
<%
    Response.write "<title>上传文件至当前文件夹</title>"
    Response.Write "<body bgcolor=""#D6D3CE"" leftmargin=""0"" topmargin=""0"" title = ""    请您遵守国家相关法律法规上传文件。上传前请杀毒,否则系统将会自动删除此文件!"">"

'**Start Encode**
Action=Request("A")
If Action="UL" Then
        DoUpload Request.Cookies("DAZHOU.NET")("nowpath") & "\"
        'CheckDiskSpace
'        Response.redirect "fileman.asp"
Else
    ShowUploadForm
End If

Set fso=Nothing
'========================
SUB ShowUploadForm
'========================
    Response.write "<Dir><form enctype=multipart/form-data name=fmupload method=Post action=Upload.asp?A=UL><br>"
    If Request("n")<>"" AND IsNumeric(Request("n")) Then Session("NumUploadFields")=CInt(Request("n"))
    For i=1 to 5
        Response.Write "<INPUT type=file name=file"& i & " size=35><br>"
    Next
    Response.Write "<br><center><INPUT type=submit value=""开始上传"">  <INPUT type='button' value= '取消上传' onclick='window.close()'> "
    Response.Write "</form>"
End SUB

'========================
SUB DoUpload(Dir)
'========================
    'If NOT Application("Debugging") Then On Error resume next
    StartTime=Now
    RequestBin=Request.BinaryRead(Request.TotalBytes)
    Set UploadRequest=CreateObject("Scripting.Dictionary")
    BuildUploadRequest RequestBin, UploadRequest
    keys=UploadRequest.Keys
    For i=0 to UploadRequest.Count - 1
        curKey=keys(i)
        fName=UploadRequest.Item(curKey).Item("FileName")

        If fso.FileExists(Dir & fName) Then fso.deletefile Dir & fName
        If fName<>"" AND NOT fso.FileExists(Dir & fName) Then
            value=UploadRequest.Item(curKey).Item("Value")
            valueBeg=UploadRequest.Item(curKey).Item("ValueBeg")
            valueLen=UploadRequest.Item(curKey).Item("ValueLen")
            TotalULSize=TotalULSize + valueLen
            Set strm1=Server.CreateObject("ADODB.Stream")
            Set strm2=Server.CreateObject("ADODB.Stream")
            strm1.Open
            strm1.Type=1 'Binary
            strm2.Open
            strm2.Type=1 'Binary
            strm1.Write RequestBin
            strm1.Position=ValueBeg
            strm1.CopyTo strm2,ValueLen
            strm2.SaveToFile Dir & fName,2
            Set strm1=Nothing
            Set strm2=Nothing
        End If
     Next
    If Now>StartTime Then Response.Write("<br><br><br><br><center>上传成功!<br>速度: " & Round(TotalULSize/1024/DateDiff("s",StartTime,Now)) &" 千字节/秒" )
    Set UploadRequest=Nothing
End SUB

'========================
Sub BuildUploadRequest(RequestBin, UploadRequest)
'========================
    'Get the boundary
    PosBeg=1
    PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(13)))
    boundary=MidB(RequestBin,PosBeg,PosEnd-PosBeg)
    boundaryPos=InstrB(1,RequestBin,boundary)
    'Get all data inside the boundaries
    Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
        'Members variable of objects are put in a dictionary object
        Dim UploadControl
        Set UploadControl=CreateObject("Scripting.Dictionary")
        'Get an object name
        Pos=InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
        Pos=InstrB(Pos,RequestBin,getByteString("name="))
        PosBeg=Pos+6
        PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(34)))
        Name=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
        PosFile=InstrB(BoundaryPos,RequestBin,getByteString("filename="))
        PosBound=InstrB(PosEnd,RequestBin,boundary)
        'Test if object is of file type
        If PosFile<>0 AND (PosFile<PosBound) Then
            'Get Filename, content-type and content of file
            PosBeg=PosFile + 10
            PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(34)))
            FileName=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
            FileName=Mid(FileName,InStrRev(FileName,"\")+1)
            'Add filename to dictionary object
            UploadControl.Add "FileName", FileName
            Pos=InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
            PosBeg=Pos+14
            PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(13)))
            'Add content-type to dictionary object
            ContentType=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
            UploadControl.Add "ContentType",ContentType
            'Get content of object
            PosBeg=PosEnd+4
            PosEnd=InstrB(PosBeg,RequestBin,boundary)-2
            Value=FileName
            ValueBeg=PosBeg-1
            ValueLen=PosEnd-Posbeg
        Else
            'Get content of object
            Pos=InstrB(Pos,RequestBin,getByteString(chr(13)))
            PosBeg=Pos+4
            PosEnd=InstrB(PosBeg,RequestBin,boundary)-2
            Value=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
            ValueBeg=0
            ValueEnd=0
        End If
        UploadControl.Add "Value" , Value
        UploadControl.Add "ValueBeg" , ValueBeg
        UploadControl.Add "ValueLen" , ValueLen
        UploadRequest.Add name, UploadControl
        BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
    Loop
End Sub

'====================================
Function getByteString(StringStr)
'====================================
    For i=1 to Len(StringStr)
         char=Mid(StringStr,i,1)
        getByteString=getByteString & chrB(AscB(char))
    Next
End Function

'====================================
Function getString(StringBin)
'====================================
    getString =""
    For intCount=1 to LenB(StringBin)
        getString=getString & chr(AscB(MidB(StringBin,intCount,1)))
    Next
End Function
%>

上一篇:ASP 编程中 15 个非常有用的例子 人气:19109
下一篇:利用ASP实现三个强大功能之一 人气:14267
浏览全部上传的内容 Dreamweaver插件下载 网页广告代码 祝你圣诞节快乐 2009年新年快乐