无组件上传文件

 

声明：既然是上传，一般是需要相关上传组件的支持的，而无组件上传则是由网络上盛传的稻香老农的无组件上传类，目前版本为V2.0，该文件内容如下，拷贝代码，保存为 upload.inc

<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 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

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

        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>

[Ctrl+A 全部选择进行拷贝 提示：可先修改部分代码，再点击运行] 

接着，需要一个正常的后台信息录入平台，该平台页面是通过信息内容的输入，并提供“浏览”表单元素以提供本地文件的上传，该文件内容如下，拷贝代码，保存为index.asp

<form name="cn_bruce" method="POST" action="">

<textarea cols="100" name="cn_content" rows="18" width="100%"></textarea><br>

</form>

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

[Ctrl+A 全部选择进行拷贝 提示：可先修改部分代码，再点击运行] 

其中，index.asp中的“浏览”表单元素的出现是在浮动框架内的upload.asp，用浮动框架是防止文件上传的同时与index.asp的信息干扰，该文件内容如下，拷贝代码，保存为upload.asp

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

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

<input type="hidden" name="upfilefolder" value="uploadfile">

<input type="hidden" name="act" value="upload">

<input type="file" name="file11" size=40>

<input type="file" name="file12" size=40>

<input type="file" name="file13" size=40>

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

</form>

[Ctrl+A 全部选择进行拷贝 提示：可先修改部分代码，再点击运行] 

最后，最重要的文件就是如何将upload.asp选择的本地的文件传递到服务器上定义的文件夹中，action="upfile.asp"，该文件内容如下，拷贝代码，保存为upfile.asp

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> 

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

<html>

<head>

<title>文件上传</title>

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

</head>

<body>

<%

dim upload,f_folder,file,formPath,iCount,filename,fileExt,filesizemin,filesizemax

filesizemin=100

filesizemax=200*1024

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

f_folder=upload.form("upfilefolder")

'********************************列出所有上传文件***************************************************

For each formName in upload.objFile

set file=upload.file(formName)

If file.filesize>0 then

    '********************************检测文件大小***************************************************

    If file.filesize<filesizemin Then

        response.write "你上传的文件太小了　[ <a href=# οnclick=history.go(-1)>重新上传</a> ]"

    ElseIf file.filesize>filesizemax then

        response.write "文件大小超过了 "&filesizemax&"字节 限制　[ <a href=# οnclick=history.go(-1)>重新上传</a> ]"

    End If

    '********************************检测文件类型****************************************************

    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 "文件格式不正确　[ <a href=# οnclick=history.go(-1)>重新上传</a> ]"

        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(f_folder&"/"&f_type&"/"&f_name))=False Then

        If upf.FolderExists(Server.MapPath(f_folder&"/"&f_type))=False Then

            If upf.FolderExists(Server.MapPath(f_folder))=False Then

                upf.CreateFolder Server.MapPath(f_folder)

                upf.CreateFolder Server.MapPath(f_folder&"/"&f_type)

                upf.CreateFolder Server.MapPath(f_folder&"/"&f_type&"/"&f_name)

            Else

                upf.CreateFolder Server.MapPath(f_folder&"/"&f_type)

                upf.CreateFolder Server.MapPath(f_folder&"/"&f_type&"/"&f_name)

            End If

        Else

            upf.CreateFolder Server.MapPath(f_folder&"/"&f_type&"/"&f_name)

        End If

    End If

    f_ftn=f_folder&"/"&f_type&"/"&f_name

    Set upf=Nothing

    '********************************保存上传文件至文件夹*****************************************

    randomize

    ranNum=int(90000*rnd)+10000

    filename=f_ftn&"/"&day(now)&"-"&ranNum&"-"&file.filename

    if file.filesize>filesizemin and file.filesize<filesizemax then

    file.SaveAs Server.mappath(filename)  '保存文件

        if f_type="JPG" or f_type="GIF" or f_type="PNG" then

            response.write "<script>parent.cn_bruce.cn_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.cn_bruce.cn_content.value+='[url]"&filename&"[/url]'</script>"

        'ElseIf

        else

            response.write "<script>parent.cn_bruce.cn_content.value+=' "&filename&" '</script>"

        end if

        iCount=iCount+1

    end if

set file=nothing

end if

next

set upload=nothing '删除此对象

response.write (iCount&" 个文件上传成功! <a href=# οnclick=history.go(-1)>继续上传</a>")

%>

</body>

</html>

[Ctrl+A 全部选择进行拷贝 提示：可先修改部分代码，再点击运行] 

注意：

1，需要服务器支持FSO，否则文件夹建立不了；

2，在文件上传后最终在index.asp的文本区域中显示什么内容，由您的编辑器类型决定

比如支持UBB，则使用UBB标签，支持HTML标签，则将upfile.asp中parent.cn_bruce.cn_content.value+= 后的内容修改