upload_config.asp

漂亮的企业网站系统v11 1、整体修改了上一版的一些BUG。 2、修改了页面底部的统计形式。 3、修改了“公告更新”栏目

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
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 
      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 SaveAs(FullPath) 
    dim dr,ErrorChar,i 
    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
    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
End Class
</SCRIPT>