【www.gdgbn.com--组件控件开发】

asp教程?act=upfile" enctype="multipart/form-data">

<%if act="upfile" then "上传相关%>




<script runat=server language=vbscript>
dim data_5xsoft
class upload_5xsoft

dim objform,objfile,version
public function form(strform)
strform=lcase(strform)
if not objform.exists(strform) then form="" else form=objform(strform)
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 function

private sub class_initialize
dim requestdata,sstart,vbcrlf,sinfo,iinfostart,iinfoend,tstream,istart,thefile
dim ifilesize,sfilepath,sfiletype,sformvalue,sfilename
dim ifindstart,ifindend
dim iformstart,iformend,sformname
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
data_5xsoft.write request.binaryread(request.totalbytes)
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
    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 function

private function getfilename(fullpath)
if fullpath <> "" then getfilename = mid(fullpath,instrrev(fullpath, "")+1) else getfilename = ""
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>
<%
dim upload,file,formpath,icount,filename,fileext
dim formname,uploadsuc,forum_upload,forumupload,upf,f_type,f_name,f_ftn,rannum
set upload=new upload_5xsoft "建立上传对象
"********************************列出所有上传文件***************************************************
for each formname in upload.objfile
set file=upload.file(formname)
if file.filesize>0 then
    "********************************检测文件类型****************************************************
    fileext=ucase(right(file.filename,4))
    uploadsuc=false
    forum_upload="rar|zip|swf|jpg|png|gif|doc|txt|chm|pdf|ace|mp3|wma|wmv|midi|avi|rm|ra|rmvb|mov|xls"
    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 "文件格式不正确[继续上传]"
        response.end
    end if
    "********************************建立文件上传的目录文件夹****************************************
    set upf=server.createobject("scripting.filesystemobject")
    if err<>0 then
        err.clear
        response.write("您的服务器不支持fso")
        response.end
    end if
    f_type= replace(fileext,".","")
    f_name= year(now)&"-"&month(now)
    if upf.folderexists(server.mappath("upload/"&f_name))=false then
       upf.createfolder server.mappath("upload/"&f_name)
    end if
    f_ftn="upload/"&f_name
    set upf=nothing
    "********************************保存上传文件至文件夹*****************************************
    randomize
    rannum=int(90000*rnd)+10000
    filename=f_ftn&"/"&day(now)&"-"&rannum&"-"&file.filename
    file.saveas server.mappath(filename)  "保存文件
        if f_type="jpg" or f_type="gif" or f_type="png" then
            response.write "<script>parent.form1.content.value+="[img]"&filename&"[/img]"</script>"
        elseif f_type="zip" or f_type="rar" or f_type="doc" or f_type="txt" then
            response.write "<script>parent.form1.content.value+="[url]"&filename&"[/url]"</script>"
        else
            response.write "<script>parent.form1.content.value+=" "&filename&" "</script>"
        end if
        icount=icount+1
set file=nothing
end if
next
set upload=nothing "删除此对象
response.write("文件上传成功！继续上传")
%>


<%end if%>

<%call closeall%>

本文来源：http://www.gdgbn.com/asp/29489/