化镜无组件上传的类

来源:互联网 发布:淘宝网如何修改评价 编辑:程序博客网 时间:2024/06/06 20:04
<SCRIPT   RUNAT=SERVER   LANGUAGE=VBSCRIPT>  
   
  dim   upfile_5xSoft_Stream  
   
  Class   upload_5xSoft  
       
  dim   Form,File,Version  
       
  Private   Sub   Class_Initialize    
  dim   iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile  
  dim   strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr  
  Version="WLONG3D专用上传程序   Version   1.0"  
  if   Request.TotalBytes<1   then   Exit   Sub  
  set   Form=CreateObject("Scripting.Dictionary")  
  set   File=CreateObject("Scripting.Dictionary")  
  set   upfile_5xSoft_Stream=CreateObject("Adodb.Stream")  
  upfile_5xSoft_Stream.mode=3  
  upfile_5xSoft_Stream.type=1  
  upfile_5xSoft_Stream.open  
  upfile_5xSoft_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_5xSoft_Stream.Position=theStart-1  
    stemp=""  
    for   i=1   to   theLen  
        if   upfile_5xSoft_Stream.EOS   then   Exit   for  
        c=ascB(upfile_5xSoft_Stream.Read(1))  
        If   c   >   127   Then  
          if   upfile_5xSoft_Stream.EOS   then   Exit   for  
          stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_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_5xSoft_Stream.Size-theLen  
        if   i>upfile_5xSoft_Stream.size   then   exit   Function  
        upfile_5xSoft_Stream.Position=i-1  
        if   AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1))   then  
          InString=i  
          for   j=2   to   theLen  
              if   upfile_5xSoft_Stream.EOS   then    
                  inString=0  
                  Exit   for  
              end   if  
              if   AscB(upfile_5xSoft_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_5xSoft_Stream.close  
      set   upfile_5xSoft_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_5xSoft_Stream.position=FileStart-1  
          upfile_5xSoft_Stream.copyto   dr,FileSize  
          dr.SaveToFile   FullPath,2  
          dr.Close  
          set   dr=nothing    
          SaveAs=0  
      end   function  
  End   Class   
 
原创粉丝点击