无组件上传的问题

[shijian58]

Microsoft VBScript 运行时错误 错误 '800a01b6'

对象不支持此属性或方法: 'sortid'

/admin/Ex_DataBase.asp，行28

相关代码如下：


<form method=post ENCTYPE="multipart/form-data" action="Ex_DataBase.asp">
<p>文件:
<input type="file" name="myfile">
<br>
分类：
<input type="radio" name="sortid" value="1">
高中
<input type="radio" name="sortid" value="2">
初中
<br />
<input type="submit" />
</p>
</form>
========================================
ex_database.asp
....................................
If upload.ErrMsg = "" then

Response.Write ("<BR><BR>上传：<BR>")
For Each formName In upload.Files ''列出所有上传了的文件
Set file = upload.Files(formName) ''生成一个文件对象
binary = file.GetBinary()
RS.Open "Upload", Conn, 1, 2
RS.AddNew
RS("ContentType") = file.FileType
RS("Content") = binary
RS("FileName") = file.FileName
RS("FileSize") = file.FileSize
RS("sort")=file.sortid //该行报错
RS.Update
uploadID = RS("UploadID")
RS.Close
...................................................

[shijian58]

upload.asp
<%
Dim DoteyUpload_SourceData
Class DoteyUpload
Public Files
Public Form
Public MaxTotalBytes
Public Version
Public ProgressID
Public ErrMsg
Private BytesRead
Private ChunkReadSize
Private Info
Private Progress
Private UploadProgressInfo
Private CrLf
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set Form = Server.CreateObject("Scripting.Dictionary")
UploadProgressInfo = "DoteyUploadProgressInfo" ' Application的Key
MaxTotalBytes = 1 *1024 *1024 *1024
ChunkReadSize = 64 * 1024
CrLf = Chr(13) & Chr(10)

Set DoteyUpload_SourceData = Server.CreateObject("ADODB.Stream")
DoteyUpload_SourceData.Type = 1
DoteyUpload_SourceData.Open

Version = "1.0 Beta"
ErrMsg = ""
Set Progress = New ProgressInfo

End Sub
Public Sub SaveTo(path)

Upload()

if right(path,1) <> "/" then path = path & "/"
For Each fileItem In Files.Items
fileItem.SaveAs path & fileItem.FileName
Next
Progress.ReadyState = "complete"
UpdateProgressInfo progressID

End Sub
Public Sub Upload ()
Dim TotalBytes, Boundary
TotalBytes = Request.TotalBytes
If TotalBytes < 1 Then
Raise("无数据传入")
Exit Sub
End If
If TotalBytes > MaxTotalBytes Then
Raise("您当前上传大小为" & TotalBytes/1000 & " K，最大允许为" & MaxTotalBytes/1024 & "K")
Exit Sub
End If
Boundary = GetBoundary()
If IsNull(Boundary) Then
Raise("如果form中没有包括multipart/form-data上传是无效的")
Exit Sub
End If
Boundary = StringToBinary(Boundary)
Progress.ReadyState = "loading"
Progress.TotalBytes = TotalBytes
UpdateProgressInfo progressID

Dim DataPart, PartSize
BytesRead = 0
Do While BytesRead < TotalBytes
PartSize = ChunkReadSize
if PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
DataPart = Request.BinaryRead(PartSize)
BytesRead = BytesRead + PartSize

DoteyUpload_SourceData.Write DataPart

Progress.UploadedBytes = BytesRead
Progress.LastActivity = Now()
UpdateProgressInfo progressID

Loop
Progress.ReadyState = "loaded"
UpdateProgressInfo progressID
Dim Binary
DoteyUpload_SourceData.Position = 0
Binary = DoteyUpload_SourceData.Read
Dim BoundaryStart, BoundaryEnd, PosEndOfHeader, IsBoundaryEnd
Dim Header, bFieldContent
Dim FieldName
Dim File
Dim TwoCharsAfterEndBoundary
BoundaryStart = InStrB(Binary, Boundary)
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary, 0)
Do While (BoundaryStart > 0 And BoundaryEnd > 0 And Not IsBoundaryEnd)

PosEndOfHeader = InStrB(BoundaryStart + LenB(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
' Content-Disposition: form-data; name="file1"; filename="G:\homepage.txt"
' Content-Type: text/plain
Header = BinaryToString(MidB(Binary, BoundaryStart + LenB(Boundary) + 2, PosEndOfHeader - BoundaryStart - LenB(Boundary) - 2))
bFieldContent = MidB(Binary, (PosEndOfHeader + 4), BoundaryEnd - (PosEndOfHeader + 4) - 2)

FieldName = GetFieldName(Header)
If InStr (Header,"filename=""") > 0 Then
Set File = New FileInfo
Dim clientPath
clientPath = GetFileName(Header)
File.FileName = GetFileNameByPath(clientPath)
File.FileExt = GetFileExt(clientPath)
File.FilePath = clientPath
File.FileType = GetFileType(Header)
File.FileStart = PosEndOfHeader + 3
File.FileSize = BoundaryEnd - (PosEndOfHeader + 4) - 2
File.FormName = FieldName
If Not Files.Exists(FieldName) And File.FileSize > 0 Then
Files.Add FieldName, File
End If

Else
If Form.Exists(FieldName) Then
Form(FieldName) = Form(FieldName) & "," & BinaryToString(bFieldContent)
Else
Form.Add FieldName, BinaryToString(bFieldContent)
End If
End If
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, BoundaryEnd + LenB(Boundary), 2))
IsBoundaryEnd = TwoCharsAfterEndBoundary = "--"

If Not IsBoundaryEnd Then BoundaryStart = BoundaryEnd
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary)
End If
Loop

Progress.UploadedBytes = TotalBytes
Progress.ReadyState = "interactive" '解析文件结束
UpdateProgressInfo progressID

End Sub
Private Sub Raise(Message)
ErrMsg = ErrMsg & "[" & Now & "]" & Message & "<BR>"

Progress.ErrorMessage = Message
UpdateProgressInfo ProgressID

'call Err.Raise(vbObjectError, "DoteyUpload", Message)

End Sub
Private Function GetBoundary()
Dim ContentType, ctArray, bArray
ContentType = Request.ServerVariables("HTTP_CONTENT_TYPE")
ctArray = Split(ContentType, ";")
If Trim(ctArray(0)) = "multipart/form-data" Then
bArray = Split(Trim(ctArray(1)), "=")
GetBoundary = "--" & Trim(bArray(1))
Else '如果form中没有包括multipart/form-data上传是无效的
GetBoundary = null
Raise("如果form中没有包括multipart/form-data上传是无效的")
End If
End Function
Private Function BinaryToString(xBinary)
Dim Binary
if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary

Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)

if LBinary>0 then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
BinaryToString = RS("mBinary")
Else
BinaryToString = ""
End If
End Function
Function MultiByteToBinary(MultiByte)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
if LMultiByte>0 then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
StringToBinary = B
End Function
Private Function GetFieldName(infoStr)
Dim sPos, EndPos
sPos = InStr(infoStr, "name=")
EndPos = InStr(sPos + 6, infoStr, Chr(34) & ";")
If EndPos = 0 Then
EndPos = inStr(sPos + 6, infoStr, Chr(34))
End If
GetFieldName = Mid(infoStr, sPos + 6, endPos - _
(sPos + 6))
End Function
Private Function GetFileName(infoStr)
Dim sPos, EndPos
sPos = InStr(infoStr, "filename=")
EndPos = InStr(infoStr, Chr(34) & CrLf)
GetFileName = Mid(infoStr, sPos + 10, EndPos - _
(sPos + 10))
End Function
Private Function GetFileType(infoStr)
sPos = InStr(infoStr, "Content-Type: ")
GetFileType = Mid(infoStr, sPos + 14)
End Function

[shijian58]

Private Function GetFileNameByPath(FullPath)
Dim pos
pos = 0
FullPath = Replace(FullPath, "/", "\")
pos = InStrRev(FullPath, "\") + 1
If (pos > 0) Then
GetFileNameByPath = Mid(FullPath, pos)
Else
GetFileNameByPath = FullPath
End If
End Function
Private Function GetFileExt(FullPath)
Dim pos
pos = InStrRev(FullPath,".")
if pos>0 then GetFileExt = Mid(FullPath, Pos)
End Function
Private Sub UpdateProgressInfo(progressID)
Const adTypeText = 2, adDate = 7, adUnsignedInt = 19, adVarChar = 200

If (progressID <> "" And IsNumeric(progressID)) Then
Application.Lock()
if IsEmpty(Application(UploadProgressInfo)) Then
Set Info = Server.CreateObject("ADODB.Recordset")
Set Application(UploadProgressInfo) = Info
Info.Fields.Append "ProgressID", adUnsignedInt
Info.Fields.Append "StartTime", adDate
Info.Fields.Append "LastActivity", adDate
Info.Fields.Append "TotalBytes", adUnsignedInt
Info.Fields.Append "UploadedBytes", adUnsignedInt
Info.Fields.Append "ReadyState", adVarChar, 128
Info.Fields.Append "ErrorMessage", adVarChar, 4000
Info.Open
Info("ProgressID").Properties("Optimize") = true
Info.AddNew
Else
Set Info = Application(UploadProgressInfo)
If Not Info.Eof Then
Info.MoveFirst()
Info.Find "ProgressID = " & progressID
End If
If (Info.EOF) Then
Info.AddNew
End If
End If

Info("ProgressID") = clng(progressID)
Info("StartTime") = Progress.StartTime
Info("LastActivity") = Now()
Info("TotalBytes") = Progress.TotalBytes
Info("UploadedBytes") = Progress.UploadedBytes
Info("ReadyState") = Progress.ReadyState
Info("ErrorMessage") = Progress.ErrorMessage
Info.Update

Application.UnLock
End IF
End Sub
Public Function GetProgressInfo(progressID)

Dim pi, Infos
Set pi = New ProgressInfo
If Not IsEmpty(Application(UploadProgressInfo)) Then
Set Infos = Application(UploadProgressInfo)
If Not Infos.Eof Then
Infos.MoveFirst
Infos.Find "ProgressID = " & progressID
If Not Infos.EOF Then
pi.StartTime = Infos("StartTime")
pi.LastActivity = Infos("LastActivity")
pi.TotalBytes = clng(Infos("TotalBytes"))
pi.UploadedBytes = clng(Infos("UploadedBytes"))
pi.ReadyState = Trim(Infos("ReadyState"))
pi.ErrorMessage = Trim(Infos("ErrorMessage"))
Set GetProgressInfo = pi
End If
End If
End If
Set GetProgressInfo = pi
End Function
Private Sub RemoveProgressInfo(progressID)
If Not IsEmpty(Application(UploadProgressInfo)) Then
Application.Lock
Set Info = Application(UploadProgressInfo)
If Not Info.Eof Then
Info.MoveFirst
Info.Find "ProgressID = " & progressID
If Not Info.EOF Then
Info.Delete
End If
End If
If Info.RecordCount = 0 Then
Info.Close
Application.Contents.Remove UploadProgressInfo
End If
Application.UnLock
End If
End Sub
Private Sub RemoveOldProgressInfo(progressID)
If Not IsEmpty(Application(UploadProgressInfo)) Then
Dim L
Application.Lock

Set Info = Application(UploadProgressInfo)
Info.MoveFirst

Do
L = Info("LastActivity").Value
If IsEmpty(L) Then
Info.Delete()
ElseIf DateDiff("d", Now(), L) > 30 Then
Info.Delete()
End If
Info.MoveNext()
Loop Until Info.EOF
If Info.RecordCount = 0 Then
Info.Close
Application.Contents.Remove UploadProgressInfo
End If
Application.UnLock
End If
End Sub

End Class

Class ProgressInfo

Public UploadedBytes
Public TotalBytes
Public StartTime
Public LastActivity
Public ReadyState
Public ErrorMessage

Private Sub Class_Initialize()
UploadedBytes = 0
TotalBytes = 0
StartTime = Now()
LastActivity = Now()
ReadyState = "uninitialized" ' uninitialized,loading,loaded,interactive,complete
ErrorMessage = ""
End Sub
Public Property Get TotalSize
TotalSize = FormatNumber(TotalBytes / 1024, 0, 0, 0, -1) & " K"
End Property
Public Property Get SizeCompleted
SizeCompleted = FormatNumber(UploadedBytes / 1024, 0, 0, 0, -1) & " K"
End Property
Public Property Get ElapsedSeconds
ElapsedSeconds = DateDiff("s", StartTime, Now())
End Property
Public Property Get ElapsedTime
If ElapsedSeconds > 3600 then
ElapsedTime = ElapsedSeconds \ 3600 & " 时 " & (ElapsedSeconds mod 3600) \ 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
ElseIf ElapsedSeconds > 60 then
ElapsedTime = ElapsedSeconds \ 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
else
ElapsedTime = ElapsedSeconds mod 60 & " 秒"
End If
End Property
Public Property Get TransferRate
If ElapsedSeconds > 0 Then
TransferRate = FormatNumber(UploadedBytes / 1024 / ElapsedSeconds, 2, 0, 0, -1) & " K/秒"
Else
TransferRate = "0 K/秒"
End If
End Property
Public Property Get Percentage
If TotalBytes > 0 Then
Percentage = fix(UploadedBytes / TotalBytes * 100) & "%"
Else
Percentage = "0%"
End If
End Property
Public Property Get TimeLeft
If UploadedBytes > 0 Then
SecondsLeft = fix(ElapsedSeconds * (TotalBytes / UploadedBytes - 1))
If SecondsLeft > 3600 then
TimeLeft = SecondsLeft \ 3600 & " 时 " & (SecondsLeft mod 3600) \ 60 & " 分 " & SecondsLeft mod 60 & " 秒"
ElseIf SecondsLeft > 60 then
TimeLeft = SecondsLeft \ 60 & " 分 " & SecondsLeft mod 60 & " 秒"
else
TimeLeft = SecondsLeft mod 60 & " 秒"
End If
Else
TimeLeft = "未知"
End If
End Property

End Class
Class FileInfo

Dim FormName, FileName, FilePath, FileSize, FileType, FileStart, FileExt, NewFileName

Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = "" ' 表单名
FileType = "" ' 文件Content Type
FileExt = "" ' 文件扩展名
NewFileName = "" '上传后文件名
End Sub

Public Function Save()
SaveAs(FileName)
End Function
Public Function SaveAs(fullpath)
Dim dr
SaveAs = false
If trim(fullpath) = "" Or FileStart = 0 Or FileName = "" Or right(fullpath,1) = "/" Then Exit Function

NewFileName = GetFileNameByPath(fullpath)
Set dr = CreateObject("Adodb.Stream")
dr.Mode = 3
dr.Type = 1
dr.Open
DoteyUpload_SourceData.position = FileStart
DoteyUpload_SourceData.copyto dr, FileSize
dr.SaveToFile MapPath(FullPath), 2
dr.Close
set dr = nothing
SaveAs = true
End function
Public Function GetBinary()
Dim Binary
If FileStart = 0 Then Exit Function
DoteyUpload_SourceData.Position = FileStart
Binary = DoteyUpload_SourceData.Read(FileSize)
GetBinary = Binary
End function
Private Function MapPath(Path)
If InStr(1, Path, ":") > 0 Or Left(Path, 2) = "\\" Then
MapPath = Path
Else
MapPath = Server.MapPath(Path)
End If
End function
Private Function GetFileNameByPath(FullPath)
Dim pos
pos = 0
FullPath = Replace(FullPath, "/", "\")
pos = InStrRev(FullPath, "\") + 1
If (pos > 0) Then
GetFileNameByPath = Mid(FullPath, pos)
Else
GetFileNameByPath = FullPath
End If
End Function
End Class
%>
顺便说一句，这里的人气现在差多了嘿嘿，以前可快了。

[hookee]

RS("sort")=upload.Form("sortid")

[凡夫与俗子]

额。好长的代码。改不了错误，帮顶下吧！

[ilxl520]

RS("sort")=reqeust("sortid")

[plcc123]

不明白

[sumjor]

RS("sort")=upload.Form("sortid")