无组件文件上传

无组件文件是用网上的。我只在这里转载一下。如果禁止转载我马上删掉。

上传程序是我写的。有点乱。希望各位看过用过的朋友多提意见。

<%
'----------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响你的速度!
'*******************   无惧上传类 V1.0  *********************************
'作者:梁无惧
'网站:http://www.25cn.com
'电子邮件:yjlrb@21cn.com
'版权声明:版权所有,源代码公开,各种用途均可免费使用,但是修改后必须把修改后的文件
'发送一份给作者.
'***********************************************************************
'***********************************************************************
'上传类强化记录
'修改者:Fssunwin
'----------------------------------------------------------------------
'添加以下属性:
'InceptFileType 允许上传的文件类型,以英文逗号“,”分隔。
'添加以下方法:
'FileWidth  图片宽度
'FileHeight  图片高度
'----------------------------------------------------------------------
'***********************************************************************

Dim oUpFileStream

Class UpFile_Class
 Public Form,File,Version,Err
 Private CHK_FileType,CHK_MaxSize

 Private Sub Class_Initialize
  Version = "无惧上传类 Version V1.0"
  Err = -1
  CHK_FileType = ""
  CHK_MaxSize = -1
  Set Form = Server.CreateObject ("Scripting.Dictionary")
  Set File = Server.CreateObject ("Scripting.Dictionary")
  Set oUpFileStream = Server.CreateObject ("Adodb.Stream")
  Form.CompareMode = 1
  File.CompareMode = 1
  oUpFileStream.Type = 1
  oUpFileStream.Mode = 3
  oUpFileStream.Open
 End Sub

 Private Sub Class_Terminate 
  '清除变量及对像
  Form.RemoveAll
  Set Form = Nothing
  File.RemoveAll
  Set File = Nothing
  oUpFileStream.Close
  Set oUpFileStream = Nothing
 End Sub

 Public Property Get InceptFileType
  InceptFileType = CHK_FileType
 End Property
 Public Property Let InceptFileType(Byval vType)
  CHK_FileType = vType
 End Property

 Public Property Get MaxSize
  MaxSize = CHK_MaxSize
 End Property
 Public Property Let MaxSize(vSize)
  If IsNumeric(vSize) Then CHK_MaxSize = Int(vSize)
 End Property

 Public Sub GetDate()
    '定义变量
   Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoEnd,tStream,iStart,oFileInfo
   Dim sFormValue,sFileName,sFormName,RequestSize
   Dim iFindStart,iFindEnd,iFormStart,iFormEnd,FileBlag
    '代码开始
   RequestSize = Int(Request.TotalBytes)
   If  RequestSize < 1 Then
  Err = 1
  Exit Sub
   End If
   Set tStream = Server.CreateObject ("Adodb.Stream")
   oUpFileStream.Write Request.BinaryRead (RequestSize)
   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)
     '如果是文件
  If InStr(45,sInfo,"filename=""",1) > 0 Then
   Set oFileInfo = new FileInfo_Class
   '取得文件属性
   iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
   iFindEnd = InStr(iFindStart,sInfo,"""",1)
   sFileName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
   oFileInfo.FileName = Mid(sFileName,InStrRev(sFileName, "/")+1)
   oFileInfo.FilePath = Left(sFileName,InStrRev(sFileName, "/"))
   oFileInfo.FileExt = Lcase(Mid(sFileName,InStrRev(sFileName, ".")+1))
   iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
   iFindEnd = InStr (iFindStart,sInfo,vbCr)
   oFileInfo.FileType = Ucase(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
   oFileInfo.FileStart = iInfoEnd
   oFileInfo.FileSize = iFormStart -iInfoEnd -2
   oFileInfo.FormName = sFormName
   If Instr(oFileInfo.FileType,"IMAGE/") Or Instr(oFileInfo.FileType,"FLASH") Then
    FileBlag = GetImageSize
    oFileInfo.FileExt = FileBlag(0)
    oFileInfo.FileWidth = FileBlag(1)
    oFileInfo.FileHeight = FileBlag(2)
    FileBlag = Empty
   End If
   If CHK_MaxSize > 0 Then
    If oFileInfo.FileSize > CHK_MaxSize Then
     Err = 2
     Exit Sub
    End If
   End If
   If CheckErr(oFileInfo.FileExt) = False Then Exit Sub
   File.Add sFormName,oFileInfo
  Else
   '如果是表单项目
   tStream.Close
   tStream.Type = 1
   tStream.Mode = 3
   tStream.Open
   oUpFileStream.Position = iInfoEnd
   oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
   tStream.Position = 0
   tStream.Type = 2
   tStream.CharSet = "gb2312"
   sFormValue = tStream.ReadText
   If Form.Exists (sFormName) Then _
    Form (sFormName) = Form (sFormName) & ", " & sFormValue _
   Else _
    Form.Add sFormName,sFormValue
  End If
  tStream.Close
  iFormStart = iFormStart+iStart+2
   '如果到文件尾了就退出
   Loop Until  (iFormStart+2) = iFormEnd
   RequestBinDate = ""
   Set tStream = Nothing
 End Sub

 '====================================================================
 '验证上传类型
 '====================================================================
 Private Function CheckErr(Byval ChkExt)
  CheckErr=False
  If CHK_FileType = "" Then CheckErr=True : Exit Function
  Dim ChkStr
  ChkStr = ","&Lcase(CHK_FileType)&","
  If Instr(ChkStr,","&ChkExt&",")>0 Then _
   CheckErr=True _
  Else _
   Err = 3
 End Function
 '====================================================================
 '图像宽高类型读取
 '====================================================================
 Private Function Bin2Str(Byval Bin)
  Dim i, Str, Sclow
  For i = 1 To LenB(Bin)
   Sclow = MidB(Bin,i,1)
   If ASCB(Sclow)<128 Then
    Str = Str & Chr(ASCB(Sclow))
   Else
    i = i+1
    If i <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,i,1)&Sclow))
   End If
  Next
  Bin2Str = Str
 End Function

 Private Function Num2Str(Byval num,Byval Base,Byval Lens)
  Dim ImageSize
  ImageSize = ""
  While(num>=Base)
   ImageSize = (num mod Base) & ImageSize
   num = (num - num mod Base)/Base
  Wend
  Num2Str = Right(String(Lens,"0") & num & ImageSize,Lens)
 End Function

 Private Function Str2Num(Byval str,Byval Base)
  Dim ImageSize,i
  ImageSize = 0
  For i=1 To Len(str)
   ImageSize = ImageSize *Base + Cint(Mid(str,i,1))
  Next
  Str2Num = ImageSize
 End Function

 Private Function BinVal(Byval bin)
  Dim ImageSize,i
  ImageSize = 0
  For i = lenb(bin) To 1 Step -1
   ImageSize = ImageSize *256 + ASCB(Midb(bin,i,1))
  Next
  BinVal = ImageSize
 End Function

 Private Function BinVal2(Byval bin)
  Dim ImageSize,i
  ImageSize = 0
  For i = 1 To Lenb(bin)
   ImageSize = ImageSize *256 + ASCB(Midb(bin,i,1))
  Next
  BinVal2 = ImageSize
 End Function

 Private Function GetImageSize()
  Dim ImageSize(2),bFlag
  bFlag = oUpFileStream.Read(3)
  Select Case Hex(BinVal(bFlag))
   Case "4E5089":
    oUpFileStream.Read(15)
    ImageSize(0) = "png"
    ImageSize(1) = BinVal2(oUpFileStream.Read(2))
    oUpFileStream.Read(2)
    ImageSize(2) = BinVal2(oUpFileStream.Read(2))
   Case "464947":
    oUpFileStream.Read(3)
    ImageSize(0) = "gif"
    ImageSize(1) = BinVal(oUpFileStream.Read(2))
    ImageSize(2) = BinVal(oUpFileStream.Read(2))
   Case "535746":
    Dim BinData,sConv,nBits
    oUpFileStream.Read(5)
    BinData = oUpFileStream.Read(1)
    sConv = Num2Str(ASCB(binData),2 ,8)
    nBits = Str2Num(Left(sConv,5),2)
    sConv = Mid(sConv,6)
    While(Len(sConv)<nBits*4)
     BinData = oUpFileStream.Read(1)
     sConv = sConv&Num2Str(ASCB(BinData),2 ,8)
    Wend
    ImageSize(0) = "swf"
    ImageSize(1) = Int(ABS(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20)
    ImageSize(2) = Int(ABS(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20)
   Case "FFD8FF":
    Dim p1
    Do
     Do: p1 = BinVal(oUpFileStream.Read(1)): Loop While p1 = 255 And Not oUpFileStream.EOS
     If p1>191 and p1<196 Then Exit Do Else oUpFileStream.Read(BinVal2(oUpFileStream.Read(2))-2)
     Do:p1 = BinVal(oUpFileStream.Read(1)):Loop While p1<255 And Not oUpFileStream.EOS
     Loop While True
     oUpFileStream.Read(3)
     ImageSize(0) = "jpg"
     ImageSize(2) = BinVal2(oUpFileStream.Read(2))
     ImageSize(1) = BinVal2(oUpFileStream.Read(2))
   Case Else:
    If Left(Bin2Str(bFlag),2) = "BM" Then
     oUpFileStream.Read(15)
     ImageSize(0) = "bmp"
     ImageSize(1) = BinVal(oUpFileStream.Read(4))
     ImageSize(2) = BinVal(oUpFileStream.Read(4))
    Else
     ImageSize(0) = "(UNKNOWN)"
    End If
  End Select
  GetImagesize = ImageSize
 End Function
End Class

'文件属性类
Class FileInfo_Class
 Public FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt,FileWidth,FileHeight
 Private Sub Class_Initialize
  FileWidth=0
  FileHeight=0
 End Sub
 '保存文件方法
 Public Sub SaveToFile (Byval Path)
  Dim Ext,oFileStream
  Ext = LCase(Mid(Path, InStrRev(Path, ".") + 1))
  If Ext <> FileExt Then Exit Sub
  On Error Resume Next
  Set oFileStream = CreateObject ("Adodb.Stream")
  oFileStream.Type = 1
  oFileStream.Mode = 3
  oFileStream.Open
  oUpFileStream.Position = FileStart
  oUpFileStream.CopyTo oFileStream,FileSize
  oFileStream.SaveToFile Path,2
  oFileStream.Close
  Set oFileStream = Nothing
 End Sub
 '取得文件数据
 Public Function FileData
  oUpFileStream.Position = FileStart
  FileData = oUpFileStream.Read (FileSize)
 End Function
End Class

'*******************************************************************************

'以上为转载的无组件类

'*******************************************************************************

function ConvertDate(sdate)
'转换时间格式
 on error resume next
 S_Date = right(year(sdate),4)
 if len(month(sdate))=1 then
  S_Date =S_Date&"0"&month(sdate)
 else
  S_Date =S_Date&month(sdate) 
 end if
 if len(day(sdate))=1 then
  S_Date =S_Date&"0"&day(sdate)
 else
  S_Date =S_Date&day(sdate)
 end if
 if len(sdate) > 10 then
  if len(hour(sdate))=1 then
   S_Date =S_Date&"0"&hour(sdate)
  else
   S_Date =S_Date&hour(sdate)
  end if
  if len(minute(sdate))=1 then
   S_Date =S_Date&"0"&minute(sdate)
  else
   S_Date =S_Date&minute(sdate)
  end if
  if len(second(sdate))=1 then
   S_Date =S_Date&"0"&second(sdate)
  else
   S_Date =S_Date&second(sdate)
  end if
 end if
 ConvertDate = S_Date
end function
function verify(Obj)
 If CInt(Obj) > 0 then
  Select Case CInt(Obj)
   Case 1 '未选择文件或文件不存在
    Response.write "<script language=javascript>alert('请先选择你要上传的文件!');window.history.go(-1);</script>"
    Response.End()
   Case 2 '文件大小超过限制
    Response.write "<script language=javascript>alert('文件大小超过了限制 2M');window.history.go(-1);</script>"
    Response.End()
   Case 3 '文件扩展名不在允许范围内
    Response.write "<script language=javascript>alert('您要上传的文件不合法!');window.history.go(-1);</script>"
    Response.End()
  End Select
 Else
  verify = 1
 End If
end function
Function RndName(Ext)
 m_rndname = convertdate(now) '格式化时间为20040101样式
 m_rndname = m_rndname&"."&Ext '生成扩展名:当前时间+扩展名
 RndName = m_rndname '返回生成的文件名
End Function
if lcase(request.ServerVariables("REQUEST_METHOD")) = "post" then
 Set Upload = new UpFile_Class      ''建立上传对象
 Upload.InceptFileType = "rar,zip,doc,txt,pdf,mdb,xls,ppt" '可以上传的扩展名
 Upload.MaxSize = 2097152 '最大可上传的文件
 Upload.GetDate () '取得上传数据
 m_check = verify(Upload.Err)
 Set File=upload.File("upfile")  ''生成一个文件对象

 m_rndname = RndName(File.FileExt)
 File.SaveToFile server.MapPath("../../m2pdownload/app/"&m_rndname)
 if err.number = 0 then
  response.Write("<script language=javascript>alert('上传成功!');</script>")
 end if
 Set File = NoThing
 Set upload = NoThing
End If
%>
<script language="JavaScript" type="text/JavaScript">
<!--
function test(){
 if (document.form1.upfile.value == "") {
  window.alert("您没有选择要上传的文件!");
  return false;
 }
}
-->
</script>
<form action="" method="post" name="form1" enctype="multipart/form-data" onSubmit="return test();">
<table><tr>
<td width="20%" height="25"><div align="left">上传文件:</div></td>
<td height="25" colspan="3"><input name="upfile" type="file" class="img5" size="50">
<font color="#FF0000">*</font></td>
</tr>
<tr>
<td height="25" colspan="4"><div align="center">
<input name="Submit3" type="submit" value="确定">
  
<input type="reset" name="Submit2" value="取消">
</div></td>
</tr>
</table>
</form> 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值