asp上传文件代码

add.html

<html>

<head>

<title>无组件上传</title>

</head>

<body>

<form method="POST" name="myform" action="xSave.asp" target="_self">

<input name="PicPath" type="text" id="PicPath" readonly="true">

<input name="sPicPath" type="hidden" id="sPicPath">

<iframe id="Upload" src="upload.html" frameborder=0 scrolling=no width="100%" height="20"></iframe>

<img src="" id="objimg" style="display:none;" />

</form>

</body>

</html>

upload.html

<html>

<head>

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

<SCRIPT language=javascript>

function check_file()

{

var strFileName=form.FileName.value;

if (strFileName=="")

{

    alert("请选择要上传的文件");

    return false;

}

}

</SCRIPT>

</head>

<body leftmargin="0" topmargin="0">

<form action="upfile.asp" method="post" name="form1" enctype="multipart/form-data">

<input name="FileName" type="FILE" class="tx1" size="20" onChange="window.parent.document.getElementById('objimg').src=this.value;window.parent.document.getElementById('objimg').style.display='';">

<input type="submit" name="Submit" value="上传">

</form>

</body>

</html>

upfile.asp

<!--#include file="upload.asp"-->

<%

Const MaxFileSize=2048       '上传文件大小限制单位k

Const UpFileType="gif|jpg|bmp|png"        '允许的上传文件类型

set fs=createobject("scripting.filesystemobject")

%>

<html>

<head>

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

</head>

<body>

<%

call upload_0() '使用化境无组件上传类

%>

</body>

</html>

<%

sub upload_0()    '使用化境无组件上传类

    set upload=new upload_file    '建立上传对象

    for each formName in upload.file '列出所有上传了的文件

        set file=upload.file(formName) '生成一个文件对象

        if file.filesize<100 then

            msg="请先选择你要上传的文件!"

            founderr=true

        end if

        if file.filesize>(MaxFileSize*1024) then

            msg="文件大小超过了限制,最大只能上传" & CStr(MaxFileSize) & "K的文件!"

            founderr=true

        end if

        fileExt=lcase(file.FileExt)

        Forumupload=split(UpFileType,"|")

        for i=0 to ubound(Forumupload)

            if fileEXT=trim(Forumupload(i)) then

                EnableUpload=true

                exit for

            end if

        next

        if fileEXT="asp" or fileEXT="asa" or fileEXT="aspx" then

            EnableUpload=false

        end if

        if EnableUpload=false then

            msg="这种文件类型不允许上传!/n/n只允许上传这几种文件类型:" & UpFileType

                        response.write"<SCRIPT language=JavaScript>alert('这种文件类型不允许上传!/n/n只允许上传这几种文件类型:" & UpFileType & "');"

                        response.write"javascript:history.go(-1)</SCRIPT>"

         founderr=true

        end if

       

        strJS="<SCRIPT language=javascript>" & vbcrlf

        if founderr<>true then

            randomize

            ranNum=int(900*rnd)+100

            filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileEXT

          

            file.SaveToFile Server.mappath("/images/Big/"&FileName)   '保存文件

            file_on=Server.mappath("/images/Big/"&FileName)

            if fs.FileExists(file_on) then

                Set Jpeg = Server.CreateObject("Persits.Jpeg")

                Jpeg.Open file_on

                IW=Jpeg.OriginalWidth

                IH=Jpeg.OriginalHeight

                XH=130

                XW=130

                If IH>IW Then

                    VW =cint( XH*IW/IH)

                    VH=XH

                Else

                    if IH=IW THEN

                        VW=XW

                        VH=XH

                    ELSE

                        VW = XW

                        VH=cint(XW*IH/IW)

                    end if

                   

                End If

                Jpeg.Width = VW

                Jpeg.Height = VH

                fname1=split(Filename,"/")

                chsave=fname1(Ubound(fname1))

                Jpeg.Save Server.MapPath("/images/SmallPic/"&chsave)

                Jpeg.close

                Set Jpeg = nothing

                msg="保存缩位图成功! --"

                Set conn = Server.CreateObject("ADODB.Connection")

                conn.Open "Driver={Microsoft Access Driver (*.mdb)};DBQ="&Server.mappath("../../web_db/#web_db#.asp")

                set Rs = server.CreateObject("adodb.recordset")

                sqlstr="select * from Pic"

                Rs.open sqlstr,conn,1,3

                Rs.addnew

                Rs("BigPic")="/images/Big/"&FileName

                Rs("SmallPic")="/images/SmallPic/"&chsave

                Rs.update

                rs.close

                conn.close

                set rs=nothing

                set conn=nothing

            else

                msg="保存缩位图不成功!--"

            end if

            msg=msg&"上传文件成功!"

            FileType=right(fileExt,3)

            strJS=strJS & "window.parent.document.getElementById('PicPath').value='" & replace(filename,"../","") & "';" & vbcrlf

            strJS=strJS & "window.parent.document.getElementById('sPicPath').value='" & replace(chsave,"../","") & "';" & vbcrlf

        end if

        strJS=strJS & "alert('" & msg & "');" & vbcrlf

        strJS=strJS & "history.go(-1);" & vbcrlf

        strJS=strJS & "</script>"

        response.write strJS

        set file=nothing

    next

    set upload=nothing

end sub

%>

upload.asp

<%

'----------------------------------------------------------------------

'转发时请保留此声明信息,这段声明不并会影响你的速度!

'*******************    无组件上传类   ********************************

'声明:此上传类是在化境编程界发布的无组件上传类的基础上修改的.

'在与化境编程界无组件上传类相比,速度快了将近50倍,当上传4M大小的文件时

'服务器只需要10秒就可以处理完,是目前最快的无组件上传程序,当前版本为0.96

'源代码公开,免费使用,对于商业用途,请与作者联系

'文件属性:例如上传文件为c:/myfile/doc.txt

'FileName    文件名       字符串    "doc.txt"

'FileSize    文件大小     数值       1210

'FileType    文件类型     字符串    "text/plain"

'FileExt     文件扩展名   字符串    "txt"

'FilePath    文件原路径   字符串    "c:/myfile"

'使用时注意事项:

'由于Scripting.Dictionary区分大小写,所以在网页及ASP页的项目名都要相同的大小

'写,如果人习惯用大写或小写,为了防止出错的话,可以把

'sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)

'改为

'(小写者)sFormName = LCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))

'(大写者)sFormName = UCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))

'**********************************************************************

'----------------------------------------------------------------------

dim oUpFileStream

Class upload_file

 

dim Form,File,Version

 

Private Sub Class_Initialize

   '定义变量

dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo

dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName

dim iFindStart,iFindEnd

dim iFormStart,iFormEnd,sFormName

   '代码开始

Version="无组件上传类 Version 0.96"

set Form = Server.CreateObject("Scripting.Dictionary")

set File = Server.CreateObject("Scripting.Dictionary")

if Request.TotalBytes < 1 then Exit Sub

set tStream = Server.CreateObject("adodb.stream")

set oUpFileStream = Server.CreateObject("adodb.stream")

oUpFileStream.Type = 1

oUpFileStream.Mode = 3

oUpFileStream.Open

oUpFileStream.Write Request.BinaryRead(Request.TotalBytes)

oUpFileStream.Position=0

RequestBinDate = oUpFileStream.Read

iFormEnd = oUpFileStream.Size

bCrLf = chrB(13) & chrB(10)

'取得每个项目之间的分隔符

sStart = MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1)

iStart = LenB (sStart)

iFormStart = iStart+2

'分解项目

Do

    iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3

    tStream.Type = 1

    tStream.Mode = 3

    tStream.Open

    oUpFileStream.Position = iFormStart

    oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart

    tStream.Position = 0

    tStream.Type = 2

    tStream.Charset ="gb2312"

    sInfo = tStream.ReadText     

    '取得表单项目名称

    iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)-1

    iFindStart = InStr(22,sInfo,"name=""",1)+6

    iFindEnd = InStr(iFindStart,sInfo,"""",1)

    sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)

    '如果是文件

    if InStr (45,sInfo,"filename=""",1) > 0 then

      set oFileInfo= new FileInfo

      '取得文件属性

      iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10

      iFindEnd = InStr(iFindStart,sInfo,"""",1)

      sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)

      oFileInfo.FileName = GetFileName(sFileName)

      oFileInfo.FilePath = GetFilePath(sFileName)

      oFileInfo.FileExt = GetFileExt(sFileName)

      iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14

      iFindEnd = InStr(iFindStart,sInfo,vbCr)

      oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)

      oFileInfo.FileStart = iInfoEnd

      oFileInfo.FileSize = iFormStart -iInfoEnd -2

      oFileInfo.FormName = sFormName

      file.add sFormName,oFileInfo

    else

    '如果是表单项目

      tStream.Close

      tStream.Type = 1

      tStream.Mode = 3

      tStream.Open

      oUpFileStream.Position = iInfoEnd

      oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2

      tStream.Position = 0

      tStream.Type = 2

      tStream.Charset = "gb2312"

      sFormvalue = tStream.ReadText

      form.Add sFormName,sFormvalue

    end if

    tStream.Close

    iFormStart = iFormStart+iStart+2

    '如果到文件尾了就退出

    loop until (iFormStart+2) = iFormEnd

RequestBinDate=""

set tStream = nothing

End Sub

Private Sub Class_Terminate 

'清除变量及对像

if not Request.TotalBytes<1 then

    oUpFileStream.Close

    set oUpFileStream =nothing

    end if

Form.RemoveAll

File.RemoveAll

set Form=nothing

set File=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 GetFileExt(FullPath)

If FullPath <> "" Then

    GetFileExt = mid(FullPath,InStrRev(FullPath, ".")+1)

    Else

    GetFileExt = ""

End If

End function

End Class

'文件属性类

Class FileInfo

dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt

Private Sub Class_Initialize

    FileName = ""

    FilePath = ""

    FileSize = 0

    FileStart= 0

    FormName = ""

    FileType = ""

    FileExt = ""

End Sub

 

'保存文件方法

Public function SaveToFile(FullPath)

    dim oFileStream,ErrorChar,i

    SaveToFile=1

    if trim(fullpath)="" or right(fullpath,1)="/" then exit function

    set oFileStream=CreateObject("Adodb.Stream")

    oFileStream.Type=1

    oFileStream.Mode=3

    oFileStream.Open

    oUpFileStream.position=FileStart

    oUpFileStream.copyto oFileStream,FileSize

    oFileStream.SaveToFile FullPath,2

    oFileStream.Close

    set oFileStream=nothing

    SaveToFile=0

end function

End Class

%>

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值