upload_config.asp

来自「是个不错的文件代码,希望大家好好用,」· ASP 代码 · 共 209 行

<%
dim upfile_classes_Stream

Class upload_classes
  dim Form,File
  Private Sub Class_Initialize 
    dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
    dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
    if Request.TotalBytes<1 then Exit Sub
    set Form=CreateObject("Scripting.Dictionary")
    set File=CreateObject("Scripting.Dictionary")
    set upfile_classes_Stream=CreateObject("Adodb.Stream")
    upfile_classes_Stream.mode=3
    upfile_classes_Stream.type=1
    upfile_classes_Stream.open
    upfile_classes_Stream.write Request.BinaryRead(Request.TotalBytes)
    vbEnter=Chr(13)&Chr(10)
    iDivLen=inString(1,vbEnter)+1
    strDiv=subString(1,iDivLen)
    iFormStart=iDivLen 
    iFormEnd=inString(iformStart,strDiv)-1
    while iFormStart < iFormEnd
      iStart=inString(iFormStart,"name=""")
      iEnd=inString(iStart+6,"""")
      mFormName=subString(iStart+6,iEnd-iStart-6)
      iFileNameStart=inString(iEnd+1,"filename=""")
      if iFileNameStart>0 and iFileNameStart<iFormEnd then 
        iFileNameEnd=inString(iFileNameStart+10,"""")
        mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
        iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
        iEnd=inString(iStart+4,vbEnter&strDiv)
        if iEnd>iStart then
          mFileSize=iEnd-iStart-4
        else
          mFileSize=0
        end if
        set theFile=new FileInfo 
        theFile.FileName=getFileName(mFileName) 
        theFile.FilePath=getFilePath(mFileName)
        theFile.FileSize=mFileSize
        theFile.FileStart=iStart+4 
        theFile.FormName=FormName 
        file.add mFormName,theFile 
        set theFile=nothing
      else 
        iStart=inString(iEnd+1,vbEnter&vbEnter)
        iEnd=inString(iStart+4,vbEnter&strDiv)
        if iEnd>iStart then 
          mFormValue=subString(iStart+4,iEnd-iStart-4) 
        else
          mFormValue=""
        end if
        form.Add mFormName,mFormValue
      end if 
      iFormStart=iformEnd+iDivLen
      iFormEnd=inString(iformStart,strDiv)-1 
    wend 
  End Sub

  Private Function subString(theStart,theLen)
    dim i,c,stemp
    upfile_classes_Stream.Position=theStart-1
    stemp=""
    for i=1 to theLen
      if upfile_classes_Stream.EOS then Exit for
      c=ascB(upfile_classes_Stream.Read(1))
      If c > 127 Then
        if upfile_classes_Stream.EOS then Exit for 
        stemp=stemp&Chr(AscW(ChrB(AscB(upfile_classes_Stream.Read(1)))&ChrB(c)))
        i=i+1
      else
        stemp=stemp&Chr(c)
      End If
    Next 
    subString=stemp
  End function

  Private Function inString(theStart,varStr)
    dim i,j,bt,theLen,str
    InString=0 
    Str=toByte(varStr)
    theLen=LenB(Str)
    for i=theStart to upfile_classes_Stream.Size-theLen 
      if i>upfile_classes_Stream.size then exit Function
      upfile_classes_Stream.Position=i-1
      if AscB(upfile_classes_Stream.Read(1))=AscB(midB(Str,1)) then 
        InString=i
        for j=2 to theLen 
          if upfile_classes_Stream.EOS then
            inString=0 
            Exit for 
          end if
          if AscB(upfile_classes_Stream.Read(1))<>AscB(MidB(Str,j,1)) then 
            InString=0 
            Exit For 
          end if
        next 
        if InString<>0 then Exit Function
      end if 
    next
  End Function

  Private Sub Class_Terminate 
    form.RemoveAll
    file.RemoveAll 
    set form=nothing
    set file=nothing 
    upfile_classes_Stream.close
    set upfile_classes_Stream=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 toByte(Str) 
    dim i,iCode,c,iLow,iHigh 
    toByte="" 
    For i=1 To Len(Str) 
      c=mid(Str,i,1) 
      iCode =Asc(c)
      If iCode<0 Then iCode = iCode + 65535 
      If iCode>255 Then 
        iLow = Left(Hex(Asc(c)),2)
        iHigh =Right(Hex(Asc(c)),2)
        toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh) 
      Else 
        toByte = toByte & chrB(AscB(c))
      End If
    Next
  End function
End Class


Class FileInfo 
dim FormName,FileName,FilePath,FileSize,FileStart 
Private Sub Class_Initialize 
FileName = "" 
FilePath = "" 
FileSize = 0 
FileStart= 0 
FormName = "" 
End Sub 
Public Function byte2asc(inbyte) 
 dim ThisCharCode,tmpreturn,NextCharCode,tmpvar 
 tmpreturn = "" 
 For tmpvar = 1 To LenB(inbyte) 
 ThisCharCode = AscB(MidB(inbyte,tmpvar,1)) 
 If ThisCharCode < &H80 Then 
 tmpreturn = tmpreturn & Chr(ThisCharCode) 
 Else 
 NextCharCode = AscB(MidB(inbyte,tmpvar+1,1)) 
 tmpreturn = tmpreturn & Chr (CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) 
 tmpvar = tmpvar + 1 
 End If 
 Next 
 byte2asc = tmpreturn 
End Function 

Public function SaveAs(FullPath) 
dim dr,ErrorChar,i,ComStr,strArray,strText 
SaveAs=1 
if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function 
if FileStart=0 or right(fullpath,1)="/" then exit function 

ComStr="cookie|.getfolder|.createfolder|.deletefolder|.createdirectory|.deletedirectory" 
ComStr=ComStr&"|.saveas|wscript.shell|script.encode|folderfath|session|script" '禁止字符 
strArray=split(ComStr,"|") 
strText=LCase(byte2asc(FileData)) 
for i=0 to ubound(strArray) 
 if instr(strText,strArray(i))<>0 then 
   response.write("您上传的文件中含有不安全的代码,抱歉!<a href='javascript:history.go(-1)'>  ←返回</a>") 
   response.end 
   'Exit function 
 end if 
next 

set dr=CreateObject("Adodb.Stream") 
dr.Mode=3 
dr.Type=1 
dr.Open 
upfile_classes_Stream.position=FileStart-1 
upfile_classes_Stream.copyto dr,FileSize 
dr.SaveToFile FullPath,2 
dr.Close 
set dr=nothing 
SaveAs=0 
end function 

Public Function FileData 
  upfile_classes_Stream.Position = FileStart 
  FileData = upfile_classes_Stream.Read (FileSize) 
End Function 

End Class
%>