<SCRIPT LANGUAGE=vbscript RUNAT=Server>
Class doufuUpload
'========================================================='
'========================================================='
Private m_objFiles
Private m_objForm
Private m_filePath
Private m_MaxSize
Private strCopyRight


Public Property Get FilePath()
FilePath=m_filePath
End Property

public Property Let FilePath(strPath)
m_filePAth=strPath
end Property

Public Property Get MaxSize()
MaxSize=m_MaxSize
End Property

public Property Let MaxSize(strMax)
m_MaxSize=strMax
end Property

Public Property Get Forms()
Set Forms = m_objForm
End Property

Public Property Get Form(ItemName)
Set M = m_objForm
for i=0 to M.Count-1
if M.item(i).name=ItemName then
set Form=new clsForm
Form.Name=M.item(i).name
Form.value=M.item(i).value
end if
next
End Property

Public Property Get Files()
Set Files = m_objFiles
End Property

Public Property Get File(ItemName)
Set F = m_objFiles
For i = 0 to F.Count - 1
if F.Item(i).name=ItemName then
Set File = New clsFile
File.Name = F.Item(i).name
File.FileName = F.Item(i).FileName
File.ContentType = F.Item(i).ContentType
File.Blob = F.Item(i).Blob
end if
next
End Property

Private Sub Class_Initialize()
Set m_objFiles = New clsCollection
Set m_objForm = New clsCollection
strCopyRight="http://www.asp888.net"
End Sub

public sub Upload()
ParseRequest
'set copyRightForm=new clsForm
Set copyRightForms = m_objForm
'检查版权
copyRightFind=true
for i=0 to copyRightForms.Count-1
if lCase(trim(copyRightForms.item(i).name))="copyright" then
if lcase(copyRightForms.item(i).value)=strCopyRight then
copyRightFind=true
exit for
end if
end if
next
'版权判断结束，下面来判断是否已经超过最大的Maxsize
set FileMaxSize=m_objFiles
dim intMaxSize
for i=0 to FileMaxSize.count-1
intMaxSize=intMaxSize+lenB(FileMAxSize.item(i).Blob)
next
if m_MaxSize>0 then
'如果小于等于 0 表示不对大小进行限制
'反之，如果大于0,则按照这个大小对 字节进行判断
if intMaxSize>m_MaxSize then
err.raise 2,"文件上传--字节大小错误","对不起，现在的上传字节大小(" & cStr(intMaxSize) & "Bytes) 已经大于系统允许的最大允许字节数(" & cStr(m_MaxSize) & "Bytes)"
end if
end if
response.write "上传的大小"+ cStr(intMaxSize)+"bytes"
end sub

public Sub ParseRequest()
Dim lngTotalBytes, lngPosBeg, lngPosEnd, lngPosBoundary, lngPosTmp, lngPosFileName
Dim strBRequest, strBBoundary, strBContent
Dim strName, strFileName, strContentType, strValue, strTemp
Dim objFile

'得到 从 浏览器 传送过来的全部数据
lngTotalBytes = Request.TotalBytes
strBRequest = Request.BinaryRead(lngTotalBytes)
'找到第一个二进制 数据
lngPosBeg = 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2Bstr(Chr(13)))
If lngPosEnd > 0 Then
strBBoundary = MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
lngPosBoundary = InStrB(1, strBRequest, strBBoundary)
End If
If strBBoundary = "" Then
lngPosBeg = 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr("&"))
Do While lngPosBeg < LenB(strBRequest)
strTemp = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
lngPosTmp = InStr(1, strTemp, "=")
strName = URLDecode(Left(strTemp, lngPosTmp - 1))
strValue = URLDecode(Right(strTemp, Len(strTemp) - lngPosTmp))
Set objForm = New clsForm
objForm.Name=strName
objForm.Value=strValue
m_objForm.Add strName, objForm
lngPosBeg = lngPosEnd + 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr("&"))
If lngPosEnd = 0 Then lngPosEnd = LenB(strBRequest) + 1
Loop
Else
Do Until (lngPosBoundary = InStrB(strBRequest, strBBoundary & UStr2Bstr("--")))
lngPosTmp = InStrB(lngPosBoundary, strBRequest, UStr2BStr("Content-Disposition"))
lngPosTmp = InStrB(lngPosTmp, strBRequest, UStr2BStr("name="))
lngPosBeg = lngPosTmp + 6
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr(Chr(34)))
strName = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
lngPosFileName = InStrB(lngPosBoundary, strBRequest, UStr2BStr("filename="))
If lngPosFileName <> 0 And lngPosFileName < InStrB(lngPosEnd, strBRequest, strBBoundary) Then
'现在分析的是文件的内容
lngPosBeg = lngPosFileName + 10
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr(chr(34)))
strFileName = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
lngPosTmp = InStrB(lngPosEnd, strBRequest, UStr2BStr("Content-Type:"))
lngPosBeg = lngPosTmp + 14
lngPosEnd = InstrB(lngPosBeg, strBRequest, UStr2BStr(chr(13)))
strContentType = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
lngPosBeg = lngPosEnd + 4
lngPosEnd = InStrB(lngPosBeg, strBRequest, strBBoundary) - 2
strBContent = MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
'strBContent=BStr2UStr(strBContent)
'response.end
If strFileName <> "" And strBContent <> "" Then
Set objFile = New clsFile
objFile.Name = strName
objFile.FileName = Right(strFileName, Len(strFileName) - InStrRev(strFileName, "\"))
objFile.ContentType = strContentType
objFile.Blob = strBContent
m_objFiles.Add strName, objFile
End If
Else

lngPosTmp = InStrB(lngPosTmp, strBRequest, UStr2BStr(chr(13)))
lngPosBeg = lngPosTmp + 4
lngPosEnd = InStrB(lngPosBeg, strBRequest, strBBoundary) - 2
strValue=MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
strValue=BStr2UStr(strValue)
'strValue1= BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
'response.write "sadmasd" & strValue
'response.end
Set objForm = New clsForm
objForm.Name=strName
objForm.Value=strValue
m_objForm.Add strName, objForm
End If
lngPosBoundary = InStrB(lngPosBoundary + LenB(strBBoundary), strBRequest, strBBoundary)
Loop
End If
End Sub

Private Function BStr2UStr(BStr)
Dim lngLoop
BStr2UStr = ""
BStr2UStr = BtoS(BStr)
End Function

Private Function BtoS(varstr)
Dim str2bin
Dim varchar
Dim varasc
Dim varlow, varhigh
Dim i
str2bin = ""
'''''''''''''''''''''''''''''''''''''''''''测试
skipflag = 0
strC = ""
binstr=varstr
If Not IsNull(binstr) Then
lnglen = LenB(binstr)
For i = 1 To lnglen
If skipflag = 0 Then
tmpBin = MidB(binstr, i, 1)
'判断是否中文的字符
If AscB(tmpBin) > 127 Then
'AscW会把二进制的中文双字节字符高位和低位反转，所以要先把中文的高低位反转
strC = strC & Chr(AscW(MidB(binstr, i + 1, 1) & tmpBin))
skipflag = 1
Else
strC = strC & Chr(AscB(tmpBin))
End If
Else
skipflag = 0
End If
Next
End If
BtoS = strC
End Function

Private Function UStr2Bstr(UStr)
Dim lngLoop
Dim strChar
UStr2Bstr = ""
For lngLoop = 1 to Len(UStr)
strChar = Mid(UStr, lngLoop, 1)
UStr2Bstr = UStr2Bstr & ChrB(AscB(strChar))
Next
End Function

Private Function URLDecode(Expression)
Dim strSource, strTemp, strResult
Dim lngPos
strSource = Replace(Expression, "+", " ")
For lngPos = 1 To Len(strSource)
strTemp = Mid(strSource, lngPos, 1)
If strTemp = "%" Then
If lngPos + 2 < Len(strSource) Then
strResult = strResult & Chr(CInt("&H" & Mid(strSource, lngPos + 1, 2)))
lngPos = lngPos + 2
End If
Else
strResult = strResult & strTemp
End If
Next
URLDecode = strResult
End Function

End Class

Class clsCollection
Private m_objDicItems

Private Sub Class_Initialize()
Set m_objDicItems = Server.CreateObject("Scripting.Dictionary")
m_objDicItems.CompareMode = vbTextCompare
End Sub

Public Property Get Count()
Count = m_objDicItems.Count
End Property


Public Default Function Item(Index)
Dim arrItems
If IsNumeric(Index) Then
arrItems = m_objDicItems.Items
If IsObject(arrItems(Index)) Then
Set Item = arrItems(Index)
Else
Item = arrItems(Index)
End If
Else
If m_objDicItems.Exists(Index) Then
If IsObject(m_objDicItems.Item(Index)) Then
Set Item = m_objDicItems.Item(Index)
Else
Item = m_objDicItems.Item(Index)
End If
End If
End If
End Function

Public Function Key(Index)
Dim arrKeys
If IsNumeric(Index) Then
arrKeys = m_objDicItems.Keys
Key = arrKeys(Index)
End If
End Function

Public Sub Add(Name, Value)
If m_objDicItems.Exists(Name) Then
m_objDicItems.Item(Name) = Value
Else
m_objDicItems.Add Name, Value
End If
End Sub
End Class

Class clsFile
Private m_strName
Private m_strContentType
Private m_strFileName
Private m_Blob

Public Property Get Name() : Name = m_strName : End Property
Public Property Let Name(vIn) : m_strName = vIn : End Property
Public Property Get ContentType() : ContentType = m_strContentType : End Property
Public Property Let ContentType(vIn) : m_strContentType = vIn : End Property
Public Property Get FileName() : FileName = m_strFileName : End Property
Public Property Let FileName(vIn) : m_strFileName = vIn : End Property
Public Property Get Blob() : Blob = m_Blob : End Property
Public Property Let Blob(vIn) : m_Blob = vIn : End Property
Public Property Get Size()
Size=LenB(m_Blob)
End Property
Public Sub Save(Path)
Dim objFSO, objFSOFile
Dim lngLoop
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFSOFile = objFSO.CreateTextFile(objFSO.BuildPath(Path, m_strFileName))
objFSOFile.Write BToS(m_Blob)
'For lngLoop = 1 to LenB(m_Blob)
' objFSOFile.Write Chr(AscB(MidB(m_Blob, lngLoop, 1)))
' response.write "1" & Chr(AscB(MidB(m_Blob, lngLoop, 1))) & "1"
'
'Next
objFSOFile.Close
response.end
End Sub

Public Sub SaveAs(strFileName)
Dim objFSO, objFSOFile
Dim lngLoop
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFSOFile = objFSO.CreateTextFile(strFileName)
objFSOFile.Write BToS(m_Blob)
objFSOFile.Close
end sub

Private Function BtoS(varstr)
Dim str2bin
Dim varchar
Dim varasc
Dim varlow, varhigh
Dim i
str2bin = ""
'''''''''''''''''''''''''''''''''''''''''''测试
skipflag = 0
strC = ""
binstr=varstr
If Not IsNull(binstr) Then
lnglen = LenB(binstr)
For i = 1 To lnglen
If skipflag = 0 Then
tmpBin = MidB(binstr, i, 1)
'判断是否中文的字符
If AscB(tmpBin) > 127 Then
'AscW会把二进制的中文双字节字符高位和低位反转，所以要先把中文的高低位反转
strC = strC & Chr(AscW(MidB(binstr, i + 1, 1) & tmpBin))
skipflag = 1
Else
strC = strC & Chr(AscB(tmpBin))
End If
Else
skipflag = 0
End If
Next
End If
BtoS = strC
End Function
End Class

Class clsForm
Private m_Name1
Private m_value

Public Property Get Name() : Name = m_Name1 : End Property
Public Property Let Name(vIn) : m_Name1 = vIn : End Property
Public Property Get Value() : Value = m_Value : End Property
Public Property Let Value(vIn) : m_value = vIn : End Property
End Class
</SCRIPT>

<%
Dim objUpload, lngLoop

If Request.TotalBytes > 0 Then
Set objUpload = New doufuUpload
objUpload.MaxSize=10485860 '允许10M的附件上传
objUpload.upload
%>

<%
DBSaveUpload objUpload.file("File1")
%>
<script language=javascript>
alert("新问题添加成功！")
{
window.location.href = "add_wt.asp"
}
</script>
<%end if%>
<%
function OpenConn()
set conn=server.createobject("ADODB.Connection")
Conn.Open "Provider=OraOLEDB.Oracle.1;Persist Security Info=True;User ID=sjkgl;Password=sjkgl;Data Source=ljl"
set OpenConn=Conn
end function
sub DBSaveUpload(Fields)
set conn=openConn()
Set RS = Server.CreateObject("ADODB.Recordset")
RS.Open "select * from wtgl1", Conn, 2, 2
RS.AddNew
Rs("lb")=objUpload.form("lb").value
Rs("nrms")=objUpload.form("nrms").value
Rs("sspt")=objUpload.form("sspt").value
Rs("tcr")=objUpload.form("tcr").value
Rs("yxj")=objUpload.form("yxj").value
Rs("fl")=objUpload.form("fl").value

'If Filename<>"" Then '就是这里应该怎么写？
Rs("filename")=Fields.Filename
RS("ContentType")=Fields.ContentType
RS("fj").AppendChunk Fields.Blob
'end if
RS.Update
RS.Close
Conn.Close
end sub
%>