无组件上传类的源代码

类别:Asp 点击:0 评论:0 推荐:

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'定义全局变量保存用户上传的内容'
dim strmUpload
'自定义class处理上传文件'
Class FileUpload
 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 strmUpload=CreateObject("Adodb.Stream")
  strmUpload.mode=3
  strmUpload.type=1
  strmUpload.open
  strmUpload.write Request.BinaryRead(Request.TotalBytes)
  'vbscript中的换行符字符串'
  vbEnter=Chr(13)&Chr(10)
  '换行符的位置'
  iDivLen=InStrB(1,vbEnter)+1
  '表单中不同控件数据的分隔字符串'
  strDiv=SubStrB(1,iDivLen)
  '表单有效数据开始位置'
  iFormStart=iDivLen
  '表单有效数据结束位置'
  iFormEnd=InStrB(iformStart,strDiv)-1
  '循环得到表单中所有控件的值'
  while iFormStart < iFormEnd
   '得到控件的name'
   iStart=InStrB(iFormStart,"name=""")
   iEnd=InStrB(iStart+6,"""")
   mFormName=SubStrB(iStart+6,iEnd-iStart-6)
   '得到file控件的filename'
   iFileNameStart=InStrB(iEnd+1,"filename=""")
   '如果是file控件'
   if iFileNameStart>0 and iFileNameStart<iFormEnd then
    iFileNameEnd=InStrB(iFileNameStart+10,"""")
    mFileName=SubStrB(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
    iStart=InStrB(iFileNameEnd+1,vbEnter&vbEnter)
    iEnd=InStrB(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 Directory中'
    file.add mFormName,theFile
   '如果不是file控件'
   else
    iStart=InStrB(iEnd+1,vbEnter&vbEnter)
    iEnd=InStrB(iStart+4,vbEnter&strDiv)
    
    if iEnd>iStart then
     mFormValue=SubStrB(iStart+4,iEnd-iStart-4)
    else
     mFormValue=""
    end if
    '将控件的名、值加入到form Directory中'
    form.Add mFormName,mFormValue
   end if
   '准备读取下一个控件值'
   iFormStart=iformEnd+iDivLen
   iFormEnd=InStrB(iformStart,strDiv)-1
  wend
 End Sub
 
 '类终结'
 Private Sub Class_Terminate 
  form.RemoveAll
  file.RemoveAll
  set form=nothing
  set file=nothing
  strmUpload.close
  set strmUpload=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 SubStrB(theStart,theLen)
  dim i,c,stemp
  strmUpload.Position=theStart-1
  stemp=""
  for i=1 to theLen
   if strmUpload.EOS then Exit for
   c=ascB(strmUpload.Read(1))
   If c > 127 Then
   if strmUpload.EOS then Exit for
   stemp=stemp&Chr(AscW(ChrB(AscB(strmUpload.Read(1)))&ChrB(c)))
   i=i+1
   else
   stemp=stemp&Chr(c)
   End If
  Next
  SubStrB=stemp
 End function
 
 '返回指定字符串在strmUpload中的位置
 Private Function InStrB(theStart,varStr)
  dim i,j,bt,theLen,str
  InStrB=0
  '得到字节串
  Str=toByte(varStr)
  theLen=LenB(Str)
  for i=theStart to strmUpload.Size-theLen
   if i>strmUpload.size then exit Function
   strmUpload.Position=i-1
   if AscB(strmUpload.Read(1))=AscB(midB(Str,1)) then
   InStrB=i
   for j=2 to theLen
    if strmUpload.EOS then
     InStrB=0
     Exit for
    end if
    if AscB(strmUpload.Read(1))<>AscB(MidB(Str,j,1)) then
     InStrB=0
     Exit For
    end if
   next
   if InStrB<>0 then Exit Function
   end if
  next
 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


'自定义类FileInfo'
Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileStart,DBContent
  '类初始化'
 Private Sub Class_Initialize
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
  DBContent = ""
  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
    strmUpload.position=FileStart-1
    strmUpload.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing
    SaveAs=0
  End function

 '自定义方法,将上传文件保存到数据库'
 Public function Save2DB()
    dim dr
    if FileSize=0 or FileStart=0 or FileName="" then exit function
    strmUpload.position=FileStart-1
  DBContent = strmUpload.Read(FileSize)
  End function
End Class
</SCRIPT>

本文地址:http://com.8s8s.com/it/it8193.htm