一个asp版的xheditor上传图片服务器端文件（2）

网上有很多asp无组件上传类的源码可以下载到。我找了一个体积比较小的默飞冲天无组件上传类，三下五除二地削掉了不必要的文件，以及一些不必要的代码，把它改造成这种样子：

<％
Option Explicit
class clsUp  
Dim Form,File
Dim AllowExt_
Dim NoAllowExt_
Private oUpFileStream
Private isErr_
Private ErrMessage_
Private isGetData_
Private fileName_
Public Property Get isErr
 isErr=isErr_
End Property
Public Property Get fileName
 fileName=fileName_
End Property
Public Property Get ErrMessage
 ErrMessage=ErrMessage_
End Property
Public Property Get AllowExt
 AllowExt=AllowExt_
End Property
Public Property Let AllowExt(Value)
 AllowExt_=LCase(Value)
End Property
Public Property Get NoAllowExt
 NoAllowExt=NoAllowExt_
End Property
Public Property Let NoAllowExt(Value) 
 NoAllowExt_=LCase(Value)
End Property
Private Sub Class_Initialize
 isErr_ = 0
 NoAllowExt="" 
 NoAllowExt=LCase(NoAllowExt)
 AllowExt="" 
 AllowExt=LCase(AllowExt)
 isGetData_=false
End Sub
Private Sub Class_Terminate 
 on error Resume Next
 Form.RemoveAll
 Set Form = Nothing
 File.RemoveAll
 Set File = Nothing
 oUpFileStream.Close
 Set oUpFileStream = Nothing
End Sub
Public Sub GetData (MaxSize)
 on error Resume Next
 if isGetData_=false then 
  Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
  Dim sFormValue,sFileName
  Dim iFindStart,iFindEnd
  Dim iFormStart,iFormEnd,sFormName
  If Request.TotalBytes < 10 Then 
   isErr_ = 1
   ErrMessage_="Have No File"
   Exit Sub
  End If
  If MaxSize > 0 Then 
   If Request.TotalBytes > MaxSize Then
   isErr_ = 2 
   ErrMessage_="File is too big"
   Exit Sub
   End If
  End If
  Set Form = Server.CreateObject ("Scripting.Dictionary")
  Form.CompareMode = 1
  Set File = Server.CreateObject ("Scripting.Dictionary")
  File.CompareMode = 1
  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)
    sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
  iStart = LenB(sSpace)
  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,sSpace)-1
   iFindStart = InStr (22,sInfo,"name=""",1)+6
   iFindEnd = InStr (iFindStart,sInfo,"""",1)
   sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
    Set oFileInfo = new clsFileInfo
    iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
    iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,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.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
    oFileInfo.FileStart = iInfoEnd
    oFileInfo.FileSize = iFormStart -iInfoEnd -2
    oFileInfo.FormName = sFormName
    file.add sFormName,oFileInfo
    Set oFileInfo = nothing
   tStream.Close
   iFormStart = iFormStart+iStart+2
  Loop Until (iFormStart+2) >= iFormEnd 
  RequestBinDate = ""
  Set tStream = Nothing
  isGetData_=true
 end if
End Sub
Public Function SaveToFile(Item,Path)
 SaveToFile=SaveToFileEx(Item,Path,True)
End Function
Public Function AutoSave(Item,Path)
 AutoSave=SaveToFileEx(Item,Path,false)
End Function
Private Function SaveToFileEx(Item,Path,Over)
 On Error Resume Next
 Dim oFileStream
 Dim tmpPath
 Dim nohack
 isErr=0
 Set oFileStream = CreateObject ("ADODB.Stream")
 oFileStream.Type = 1
 oFileStream.Mode = 3
 oFileStream.Open
 oUpFileStream.Position = File(Item).FileStart
 oUpFileStream.CopyTo oFileStream,File(Item).FileSize
 nohack=split(path,".") 
 tmpPath=nohack(0)&"."&nohack(ubound(nohack)) 
 if Over then
  if isAllowExt(GetFileExt(tmpPath)) then
   oFileStream.SaveToFile tmpPath,2
   Else
   isErr_=3
   ErrMessage_="It is a wrong file"
  End if
 Else
  Path=GetFilePath(Path)
  if isAllowExt(File(Item).FileExt) then
   do
    Err.Clear()
    fileName_=GetNewFileName()&"."&File(Item).FileExt
    nohack=split(Path&fileName_,".") 
    tmpPath=nohack(0)&"."&nohack(ubound(nohack))
    oFileStream.SaveToFile tmpPath
   loop Until Err.number<1
   oFileStream.SaveToFile Path
   Else
   isErr_=3
   ErrMessage_="It is a wrong file"
  End if
 End if
 oFileStream.Close
 Set oFileStream = Nothing
 if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
 
End Function
Public Function FileData(Item)
 isErr_=0
 if isAllowExt(File(Item).FileExt) then
  oUpFileStream.Position = File(Item).FileStart
  FileData = oUpFileStream.Read (File(Item).FileSize)
  Else
  isErr_=3
  ErrMessage_="It is a wrong file"
  FileData=""
 End if
End Function
Public function GetFilePath(FullPath)
  If FullPath <> "" Then
    GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
    Else
    GetFilePath = ""
  End If
End function
Public Function GetFileName(FullPath)
  If FullPath <> "" Then
    GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
    Else
    GetFileName = ""
  End If
End function
Public Function GetFileExt(FullPath)
  If FullPath <> "" Then
    GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
    Else
    GetFileExt = ""
  End If
End function
Public Function GetNewFileName()
 dim ranNum
 dim dtNow
 dtNow=Now()
 ranNum=int(90000*rnd)+10000
 GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End Function
Public Function isAllowExt(Ext)
 if NoAllowExt="" then
  isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
 else
  isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
 end if
End Function
End Class
Class clsFileInfo
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
dim upfile,FSPath,formName,FileName
set upfile=new clsUp
upfile.AllowExt="jpg;jpeg;gif;png;rar;doc;zip;xls;pdf;swf;avi;mp3;txt"
upfile.GetData (1024000)
 if upfile.isErr then  
 Response.Write "{""err"":"""&upfile.ErrMessage&""",""msg"":""""}"
 else
 FSPath=Server.mappath("/uploadpic/upload.asp")
 
 for each formName in upfile.file 
    upfile.AutoSave formname,FSPath 
    if upfile.iserr then 
  Response.Write "{""err"":"""&upfile.ErrMessage&""",""msg"":""""}"
 else
  Response.write "{""err"":"""",""msg"":""/uploadpic/"&upfile.fileName&"""}"
 end if
 next
end if
set upfile = nothing
％>

当然，实际上我并不是“三下五除二”削掉不必要的代码的，这削代码的过程花了我四小时时间。以前我一直只用现成的上传类的，今天才第一次研究这些类到底是怎么写的，所以这个削代码的过程也是我学习vb的类写法的过程。因为在这个上传功能里，不需要获取upfile.form("****")属性值，所以我在第99行sFormName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)后面把这个If InStr (45,sInfo,"filename=""",1) > 0 Then .... else....end if给砍了，一方面，是因为我不需要upfile.form("***")这个属性，另一方面，也是因为在那个xheditor.js代码中命名的上传框的name属性并不是filename，到底是什么，有点难挖。不过我发现那个js构造的form框，甚至没有type=submit的input按钮，直接自动submit()上去的，所以我可以这样做，把那个sFormName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)后面的If InStr (45,sInfo,"filename=""",1) > 0 Then .... else....end if给砍了。这样就可以无视上传input框的name值究竟是什么，一概当作二进制文件对待了。

当然，最终我发现那个上传input框的name值其实就是upload。具体是怎么发现的我就不说了，这个xheditor.js真是看花我老眼也，更可恨的是它居然把所有的代码都写到一行里，把所有的缩进都删得光光，把所有的注释也删得光光。

我发现这个xheditor更新得满快的，才不到两个月功夫居然更新了两版，现在最新版已经为0.98版了，但是我还在用0.96版的代码。在0.98版的代码里，这个upload.asp也是有用的，但是那段顶上的js代码要改成这样子：

<SCRIPT type=text/javascript>
$(pageInit);
function pageInit()
{
 $('#elm1').xheditor(true,{tools:'full',upLinkUrl:"upload.asp",upLinkExt:"zip,rar,txt",upImgUrl:"upload.asp",upImgExt:"jpg,jpeg,gif,png",upFlashUrl:"upload.asp",upFlashExt:"swf",upMediaUrl:"upload.asp",upMediaExt:"avi"});
}
</SCRIPT>

看看现在我的图片上传框的样子吧：

只要在硬盘中一选中图片就立即自动上传。真的很赞。