ASP文件上传

最新推荐文章于 2017-12-20 21:43:43 发布

lonefox

最新推荐文章于 2017-12-20 21:43:43 发布

阅读量1.3k

点赞数

文章标签： asp function stream file class vbscript

本文链接：https://blog.csdn.net/lonefox/article/details/631109

版权

最近整理以前写的文件上传代码, 发现很乱，且只可以传入数据库，没有写入文件功能（以前也没需要过），哈！就重写了还算面向对象，其中解决了无法上传二进制文件问题，参考了网上FSO方式的写文件，但发现很多问题，不是文件写不进去，就是文件写出来内容不符合，好像只能写文本文件，下面是我整出来的代码，可传多文件，可字段重名

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
'字段类
Class CField
Public Name
Public Id
Public Value
Public FType
End Class

'文件类
Class CFile
Public FileName  '文件名
Public FileSize  '文件大小
Public FileData  '文件数据
Public FileType  '文件网络类型

'将文件保存进指定的数据库
Function SaveToDB(Cmd , TypeFieldSaved)
  '判断是否将文件网络类型保存
  If TypeFieldSaved Then
   set Param = cmd.CreateParameter("@FileType", 201, 1, 255, FileType)
   Cmd.Parameters.Append param
  End If
  '查入表命令
  set Param = cmd.CreateParameter("@File", 201, 1, 255, FileData)
  Cmd.Parameters.Append param
  Cmd.Execute
End Function

'将文件保存进本地文件系统
Function SaveToFS(FilePath)
Dim FSO, File, i

  SaveToFS = False
  If FileSize <= 0 Then Exit Function

  '分析文件路径
  If FilePath = "" Then
   If FileName = "" Then
    Exit Function
   Else
    Pos = InstrRev(FileName, "/")
    FilePath =Server.MapPath("/") & Mid(FileName, Pos)
   End if
  End If
  'Response.Write(FilePath)

  '写入文件
  On Error Resume Next
  Set Stream = Server.CreateObject("ADODB.Stream")
  Set Stream2 = Server.CreateObject("ADODB.Stream")
  Stream.Type = 2
  Stream.Mode = 3
  Stream2.Type = 1
  Stream2.Mode = 3
  Stream.Open
  Stream.WriteText FileData
  Stream.position = 2
  Stream2.Open
  Stream.CopyTo(Stream2)
  Stream2.SaveToFile FilePath, 2
  Stream2.Close
  Stream.Close
  Set Stream2 = nothing
  Set Stream = nothing
End Function
End Class

'文件上传类
Class CFileUpload
'行分隔符
private Data
private LineSep
private CrLf

Private Sub Class_Initialize
  CrLf = ChrB(13) & ChrB(10)
End Sub

'将二进制笔编码转换成unicode字符串
private Function ToUnicode(Bin)
  ToUnicode =""
  For i = 1 to LenB(Bin)
   ToUnicode = ToUnicode & Chr(AscB(MidB(Bin,i,1)))
  Next
End Function

'读下一行数据
Private Function NextLine()
    Pos = InStrB(Data, CrLf)

  If Pos > 0 Then
   NextLine = LeftB(Data, Pos - 1)
   Data = MidB(Data, Pos + 2)
  Else
   If LenB(Data) > 0 Then
    NextLine = LeftB(Data, LenB(Data))
   End If
   Data = ""
  End If
End Function

'取得行分割串
Private Function GetLineSep()
GetLineSep = False

  Ln = ToUnicode(LeftB(Data, InStrB(Data, CrLf)))

  If Instr(Ln, "----------") > 0 Then
   LineSep = LeftB(Data, InStrB(Data, CrLf) - 1)
   GetLineSep = True
  End if
End Function

'表单字段分析
Public Function Parse(FormData)
  Dim Ln, i, n, Field, File

  Data = FormData

  '取得行分割串
  If Not GetLineSep Then
   Parse = False
   Exit Function
  End If

  '建立字段结合待处理后返回
  Set Parse = Server.CreateObject("Scripting.Dictionary")
  Do While TRUE
   Ln = NextLine()
   ULn = ToUnicode(Ln)

   If LenB(Data) <= 0 Then Exit Do

   If InstrB(Ln, LineSep) > 0 Then
    '建立新字段
    Set Field = new CField
   ElseIf Instr(ULn, "Content-Disposition:") > 0 Then
    '取字段名称、文件名称
    Items = Split(ULn, ";")
    For i = LBound(Items) To UBound(Items)
     KeyPairs = Split(Trim(Items(i)), "=")
     If Ubound(KeyPairs) > 0 Then
      Key = KeyPairs(0)
      Val = KeyPairs(1)
      Val = Mid(Val, Instr(Val, """") + 1)
      Val = Mid(Val, 1, Instr(Val, """") -1)
     End If
     If Key = "filename" Then
      Set Field.Value = new CFile
      Field.Value.FileName = Val
      Field.FType = "FILE"
     ElseIf key = "name" Then
      Field.Name = Val
      Field.Id = Val
      Field.FType = "STRING"
     End If
    Next
   ElseIf Instr(ULn, "Content-Type:") > 0 Then
    '取文件类型
    If Field.FType = "FILE" Then
     Field.Value.FileType = Trim(Mid(ULn, Instr(ULn, ":") + 1))
    End If
   ElseIf ULn = "" Then
    '取字段值或文件内容
     If Field.FType = "STRING" Then
     Field.Value = ToUnicode(NextLine())
     ElseIf Field.FType = "FILE" Then
     Pos = InstrB(Data, LineSep)
     Set File = Field.Value
     File.FileData = LeftB(Data, Pos - 3)
     Data = MidB(Data, Pos)
     File.FileSize = LenB(File.FileData)
     End If
    '将建立的字段加入字段集合(解决了字段重名)
    While Parse.Exists(Field.Id)
     FieldId = Field.Id
     Pos = InstrRev(FieldId, "_")
     n = Mid(FieldId, Pos + 1)
     If Not IsNumeric(n) Or n = "" Then
      Parse.Key(FieldId) = FieldId & "_0"
      FieldId = FieldId & "_1"
     Else
      n = n + 1
      FieldId = Left(FieldId, Pos) & n
     End If
     Field.Id = FieldId
    Wend
    Parse.Add Field.Id, Field
   Else
    Response.Write("No Validating Data!")
   End If
  Loop
End Function

End Class

'下面是测试

Dim FormData

dim starttime
starttime = timer
If Request.TotalBytes > 0 Then
set FileUpload = new CFileUpload
FormData = Request.BinaryRead(Request.TotalBytes)
Set f = FileUpload.Parse(FormData)
'Response.BinaryWrite(FormData)
a = f.items
for n = 0 to f.count - 1
  If a(n).FType = "FILE" Then
   a(n).Value.SaveToFS("")
  End If
next
End If
set FileUpLoad = Nothing

response.write (Timer - starttime)

%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>无标题文档</title>
</head>