1. 论坛系统升级为Xenforo,欢迎大家测试!
    排除公告

ASP上传问题,帮忙啊!急~~~~

本帖由 leehui19832006-07-05 发布。版面名称:后端开发

  1. leehui1983

    leehui1983 New Member

    注册:
    2006-02-26
    帖子:
    130
    赞:
    0
    问题就是无发上传到指定目 录代码如下:
    uploadclass.asp
    <%
    dim oUpFileStream

    Class Upload_file

    dim Form,File,Err

    Private Sub Class_Initialize
    Err=-1
    end sub

    Private Sub Class_Terminate
    '清除变量及对像
    if Err < 0 then
    oUpFileStream.Close
    Form.RemoveAll
    File.RemoveAll
    set Form=nothing
    set File=nothing
    set oUpFileStream =nothing
    end if
    End Sub

    Public Sub GetDate(RetSize)
    '定义变量
    dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
    dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName
    dim iFindStart,iFindEnd
    dim iFormStart,iFormEnd,sFormName
    '代码开始
    If Request.TotalBytes < 1 Then
    Err=1
    Exit Sub
    End If
    If RetSize > 0 Then
    If Request.TotalBytes > RetSize then
    Err=2
    Exit Sub
    End If
    End If
    set Form = Server.CreateObject("Scripting.Dictionary")
    set File = Server.CreateObject("Scripting.Dictionary")
    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 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

    '取得文件内容
    Public Function GetDate
    oUpFileStream.Position =FileStart
    GetDate=oUpFileStream.Read(FileSize)
    End Function
    End Class
    %>
    savetofile.asp
    <!--#include file="inc/uploadclass.asp"-->
    <%
    sub check(typ)
    if instr("|"&UpFileGenre&"|","|"&typ&"|") <= 0 or typ="asa" or typ="asp" or typ="cdx" or typ="cer" then error2("对不起,本服务器不支持 "&typ&" 格式的文件")
    end sub

    on error resume next
    Set fso = Server.CreateObject("Scripting.FileSystemObject")
    strDir="uploadfile/"&year(now)&"-"&month(now)&""
    if not fso.folderexists(Server.MapPath(strDir)) then fso.CreateFolder(Server.MapPath(strDir))
    if Err=0 then catalog=""&year(now)&"-"&month(now)&"/"
    ftime=""&catalog&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&""


    set FileUP=new Upload_file
    FileUP.GetDate(-1)
    set file=FileUP.file("file")

    if file.filesize = 0 then error2("当前文件为空文件")

    if file.filesize > int(MaxFile) then error2("文件大小不得超过 "&int(MaxFile/1024)&" KB\n当前的文件大小为 "&int(file.filesize/1024)&" KB")

    types=LCase(file.FileExt)
    check(types)

    filename="uploadfile/"&ftime&"."&types&""
    file.SaveToFile Server.mappath(filename)
    set FileUP=nothing


    response.Write"成功!"
    %>