📄 ixs_clsup_cnbbr.asp
字号:
<%
Class iXs_ClsUp
Private P_MaxSize, P_TotalSize, P_FileType, P_SavePath, P_AutoSave, P_Error
Private ObjForm, BinForm, BinItem, LngTime
Public FormItem, FileItem, StrDate
Public Property Get Version
Version = "爱雪儿无组件上传类 Version 1.0.0"
End Property
Public Property Get Error
Error = P_Error
End Property
Public Property Get MaxSize
MaxSize = P_MaxSize
End Property
Public Property Let MaxSize(LngSize)
If IsNumeric(LngSize) Then
P_MaxSize = Clng(LngSize)
End If
End Property
Public Property Get TotalSize
TotalSize = P_TotalSize
End Property
Public Property Let TotalSize(LngSize)
If IsNumeric(LngSize) Then
P_TotalSize = Clng(LngSize)
End If
End Property
Public Property Get FileType
FileType = P_FileType
End Property
Public Property Let FileType(strType)
P_FileType = strType
End Property
Public Property Get SavePath
SavePath = P_SavePath
End Property
Public Property Let SavePath(StrPath)
P_SavePath = Replace(StrPath, chr(0), "") & CreatePath(StrPath)
End Property
Public Property Get AutoSave
AutoSave = P_AutoSave
End Property
Public Property Let AutoSave(byVal Flag)
Select Case Flag
Case 0 ' 取无重复的服务器时间字符串为文件名自动保存文件
Case 1 ' 取源文件名自动保存文件
Case 2 ' 不自动保存文件，Open之后请用Save/GetData方法保存文件
Case False Flag = 2
Case Else Flag = 0
End Select
P_AutoSave = Flag
End Property
Private Sub Class_Initialize
P_Error = -1
P_MaxSize = 1536000 ' 单位：字节
P_FileType = "gif/jpg/jpeg/bmp/png/rar/txt/zip/mid"
P_SavePath = "UploadFile/"
P_AutoSave = 0
P_TotalSize = 0
StrDate = Replace(Replace(Replace(CStr(Now()), "-", ""), ":", ""), " ", "")
Randomize Timer()
LngTime = Clng(1000 + Rnd()*8999)
Set BinForm = Server.CreateObject("ADODB.Stream")
Set BinItem = Server.CreateObject("ADODB.Stream")
Set ObjForm = Server.CreateObject("Scripting.Dictionary")
ObjForm.CompareMode = 1
End Sub
Private Sub Class_Terminate
ObjForm.RemoveAll
Set ObjForm = Nothing
Set BinItem = Nothing
If P_Error <> 4 Then BinForm.Close()
Set BinForm = Nothing
End Sub
Public Sub Open()
If P_Error = -1 Then
P_Error = 0
Else
Exit Sub
End If
Dim LngRequestSize, LngReadSize, BinRequestData, StrFormItem, StrFileItem ,P_ChunkByte, IntTemp, StrTemp
Const StrSplit = "'"">"
LngRequestSize = Request.TotalBytes
If LngRequestSize < 1 Or (LngRequestSize > P_TotalSize And P_TotalSize <> 0) Then
P_Error = 4
Exit Sub
End If
BinForm.Type = 1
BinForm.Open
LngReadSize = 0
P_ChunkByte = 102400
BinItem.Type = 2
BinItem.Charset = "gb2312"
BinItem.Open
Response.Flush()
Do
BinForm.Write Request.BinaryRead(P_ChunkByte)
LngReadSize = LngReadSize + P_ChunkByte
If LngReadSize >= LngRequestSize Then Exit Do
BinItem.WriteText "LngTotalSize=" & LngRequestSize & ";LngReadSize=" & LngReadSize & ";"
BinItem.SaveToFile Server.MapPath("CnbbrUpIni.ini"),2
Response.flush()
Loop
BinItem.WriteText "LngTotalSize=" & LngRequestSize & ";LngReadSize=" & LngReadSize & ";"
BinItem.SaveToFile Server.MapPath("CnbbrUpIni.ini"),2
BinItem.Close()
Response.Flush()
BinForm.Position = 0
BinRequestData = BinForm.Read()
Dim bCrLf, StrSeparator, IntSeparator
bCrLf = ChrB(13) & ChrB(10)
IntSeparator = InstrB(1, BinRequestData, bCrLf)-1
StrSeparator = LeftB(BinRequestData, IntSeparator)
Dim P_Start, P_End, StrItem, StrInam
Dim StrFtyp, StrFnam, StrFext, LngFsiz
P_Start = IntSeparator + 2
Do
P_End = InStrB(P_Start, BinRequestData, bCrLf & bCrLf) + 3
BinItem.Type=1
BinItem.Open
BinForm.Position = P_Start
BinForm.CopyTo BinItem, P_End - P_Start
BinItem.Position = 0
BinItem.Type = 2
BinItem.Charset = "gb2312"
StrItem = BinItem.ReadText
BinItem.Close()
P_Start = P_End
P_End = InStrB(P_Start, BinRequestData, StrSeparator)-1
BinItem.Type = 1
BinItem.Open
BinForm.Position = P_Start
LngFsiz = P_End-P_Start-2
BinForm.CopyTo BinItem, LngFsiz
IntTemp = Instr(39, StrItem, """")
StrInam = Mid(StrItem, 39, IntTemp-39)
If Instr(IntTemp, StrItem, "filename=""") <> 0 Then
If Not ObjForm.Exists(StrInam & "_From") Then
StrFileItem = StrFileItem & StrSplit & StrInam
If BinItem.Size <> 0 Then
IntTemp = IntTemp + 13
StrFtyp = Mid(StrItem, Instr(IntTemp, StrItem, "Content-Type: ") + 14)
StrTemp = Mid(StrItem, IntTemp, Instr(IntTemp, StrItem, """") - IntTemp)
IntTemp = InstrRev(StrTemp, "\")
StrFnam = Mid(StrTemp, IntTemp+1)
ObjForm.Add StrInam & "_Type", Replace(StrFtyp, vbCrLF, "")
ObjForm.Add StrInam & "_Name", StrFnam
ObjForm.Add StrInam & "_Path", Left(StrTemp, IntTemp)
ObjForm.Add StrInam & "_Size", LngFsiz
If Instr(IntTemp, StrTemp, ".") <> 0 Then
StrFext = Mid(StrTemp, InstrRev(StrTemp, ".") + 1)
Else
StrFext = ""
End If
If Left(StrFtyp, 6) = "image/" Then
BinItem.Position = 0
BinItem.Type = 1
StrTemp = BinItem.Read(10)
If InStr(StrFtyp, "jpeg") > 0 Then
If LCase(StrFext) <> "jpg" Then StrFext = "jpg"
BinItem.Position = 3
Do While Not BinItem.EOS
Do
IntTemp = AscB(BinItem.Read(1))
Loop While IntTemp = 255 And Not BinItem.EOS
If IntTemp < 192 Or IntTemp > 195 Then
BinItem.Read(Bin2Val(BinItem.Read(2))-2)
Else
Exit Do
End If
Do
IntTemp = AscB(BinItem.Read(1))
Loop While IntTemp < 255 And Not BinItem.EOS
Loop
BinItem.Read(3)
ObjForm.Add StrInam & "_Height", Bin2Val(BinItem.Read(2))
ObjForm.Add StrInam & "_Width", Bin2Val(BinItem.Read(2))
ElseIf InStr(StrFtyp, "/png") > 0 Then
If LCase(StrFext) <> "png" Then StrFext = "png"
BinItem.Position = 18
ObjForm.Add StrInam & "_Width", Bin2Val(BinItem.Read(2))
BinItem.Read(2)
ObjForm.Add StrInam & "_Height", Bin2Val(BinItem.Read(2))
ElseIf InStr(StrFtyp, "/gif") > 0 Then
If LCase(StrFext) <> "gif" Then StrFext="gif"
BinItem.Position = 6
ObjForm.Add StrInam & "_Width", BinVal2(BinItem.Read(2))
ObjForm.Add StrInam & "_Height", BinVal2(BinItem.Read(2))
ElseIf InStr(StrFtyp, "/bmp") > 0 Then
If LCase(StrFext) <> "bmp" Then StrFext="bmp"
BinItem.Position = 18
ObjForm.Add StrInam & "_Width", BinVal2(BinItem.Read(4))
ObjForm.Add StrInam & "_Height", BinVal2(BinItem.Read(4))
Else
ObjForm.Add StrInam & "_Width", 200
ObjForm.Add StrInam & "_Height", 150
End If
ElseIf InStr(StrFtyp, "/x-shockwave-flash") > 0 Then
If LCase(StrFext) <> "swf" Then StrFext="swf"
Dim BinData, sConv, nBits
BinItem.Position = 0
BinItem.Type = 1
BinItem.Read(8)
BinData = BinItem.Read(1)
sConv = Num2Str(AscB(BinData), 2 ,8)
nBits = Str2Num(Left(sConv, 5), 2)
sConv = Mid(sConv, 6)
While (Len(sConv) < nBits * 4)
BinData = BinItem.Read(1)
sConv = sConv & Num2Str(AscB(BinData), 2 ,8)
Wend
ObjForm.Add StrInam & "_Width", Int(Abs(Str2Num(Mid(sConv, 1 * nBits + 1, nBits), 2) - Str2Num(Mid(sConv, 0 * nBits + 1, nBits), 2)) / 20)
ObjForm.Add StrInam & "_Height", Int(Abs(Str2Num(Mid(sConv, 3 * nBits + 1, nBits), 2) - Str2Num(Mid(sConv, 2 * nBits + 1, nBits), 2)) / 20)
Else
ObjForm.Add StrInam & "_Width", 0
ObjForm.Add StrInam & "_Height", 0
End If
ObjForm.Add StrInam & "_Ext", StrFext
ObjForm.Add StrInam & "_From", P_Start
IntTemp = GetFerr(LngFsiz, StrFext)
If P_AutoSave <> 2 Then
ObjForm.Add StrInam & "_Err", IntTemp
If IntTemp = 0 Then
If P_AutoSave = 0 Then
StrFnam = GetTimeStr()
If StrFext <> "" Then StrFnam = StrFnam & "." & StrFext
End If
BinItem.SaveToFile Server.MapPath(P_SavePath & StrFnam), 2
ObjForm.Add StrInam, StrFnam
End If
End If
Else
ObjForm.Add StrInam & "_Err", -1
End If
End If
Else
BinItem.Position = 0
BinItem.Type = 2
BinItem.Charset = "gb2312"
StrTemp = BinItem.ReadText
If ObjForm.Exists(StrInam) Then
ObjForm(StrInam) = ObjForm(StrInam) & "," & StrTemp
Else
StrFormItem = StrFormItem & StrSplit & StrInam
ObjForm.Add StrInam, StrTemp
End If
End If
BinItem.Close()
P_Start = P_End + IntSeparator + 2
Loop Until P_Start + 3 > LngRequestSize
FormItem = split(StrFormItem, StrSplit)
FileItem = split(StrFileItem, StrSplit)
End Sub
Private Function GetTimeStr()
LngTime = LngTime + 1
GetTimeStr = StrDate & LngTime
End Function
Private Function GetFerr(LngFsiz, StrFext)
Dim IntFerr
IntFerr = 0
If LngFsiz > P_MaxSize And P_MaxSize > 0 Then
If P_Error = 0 Or P_Error = 2 Then P_Error = P_Error + 1
IntFerr = IntFerr + 1
End If
If InStr(1, LCase("/" & P_FileType & "/"), LCase("/" & StrFext & "/")) = 0 And P_FileType <> "" Then
If P_Error < 2 Then P_Error = P_Error + 2
IntFerr = IntFerr + 2
End If
GetFerr = IntFerr
End Function
Public Function Save(Item, StrFnam)
Rem ******************************************
Rem Item是表单中file元素
Rem Name是保存的文件名，可选值：
Rem ０：自动取无重复的服务器时间字符串为文件名
Rem １：自动取源文件名
Rem ******************************************
Save = False
If ObjForm.Exists(Item & "_From") Then
Dim IntFerr, StrFext
StrFext = ObjForm(Item & "_Ext")
IntFerr = GetFerr(ObjForm(Item & "_Size"), StrFext)
If ObjForm.Exists(Item & "_Err") Then
If IntFerr = 0 Then
ObjForm(Item & "_Err") = 0
End If
Else
ObjForm.Add Item & "_Err", IntFerr
End If
If IntFerr <> 0 Then Exit Function
If VarType(StrFnam) = 2 Then
Select Case StrFnam
Case 0 : StrFnam = GetTimeStr()
If StrFext <> "" Then StrFnam = StrFnam & "." & StrFext
Case 1 : StrFnam = ObjForm(Item & "_Name")
End Select
End If
BinItem.Type = 1
BinItem.Open
BinForm.Position = ObjForm(Item & "_From")
BinForm.CopyTo BinItem,ObjForm(Item & "_Size")
Dim noHack,TmpPath
nohack=split(Server.MapPath("Images/" & StrFnam),".") '重要修改，防止黑客二进制"01"断名!!!
tmpPath=nohack(0)&"."&nohack(ubound(nohack)) '重要修改，防止黑客二进制"01"断名！！!
BinItem.SaveToFile TmpPath, 2
BinItem.Close()
If ObjForm.Exists(Item) Then
ObjForm(Item) = StrFnam
Else
ObjForm.Add Item, StrFnam
End If
Save = True
End If
End Function
Public Function GetData(Item)
GetData = ""
If ObjForm.Exists(Item & "_From") Then
If GetFerr(ObjForm(Item & "_Size"), ObjForm(Item & "_Ext")) <> 0 Then Exit Function
BinForm.Position = ObjForm(Item & "_From")
GetData = BinFormStream.Read(ObjForm(Item & "_Size"))
End If
End Function
Public Function Form(Item)
If ObjForm.Exists(Item) Then
Form = ObjForm(Item)
Else
Form = ""
End If
End Function
Private Function BinVal2(Bin)
Dim LngValue,i
LngValue = 0
For i = LenB(Bin) to 1 Step -1
LngValue = LngValue * 256 + AscB(MidB(Bin, i, 1))
Next
BinVal2 = LngValue
End Function
Private Function Bin2Val(Bin)
Dim LngValue, i
LngValue = 0
For i = 1 To LenB(Bin)
LngValue = LngValue * 256 + AscB(MidB(Bin, i, 1))
Next
Bin2Val = LngValue
End Function
Private Function Num2Str(Num, Base, Lens)
Dim Ret
Ret = ""
While(Num >= Base)
Ret = (Num Mod Base) & Ret
Num = (Num - Num Mod Base) / Base
Wend
Num2Str = Right(String(Lens, "0") & Num & Ret, Lens)
End Function
Private Function Str2Num(Str, Base)
Dim Ret, I
Ret = 0
For I = 1 To Len(Str)
Ret = Ret * base + Cint(Mid(Str, I, 1))
Next
Str2Num = Ret
End Function
Private Function CreatePath(StrPath)
Dim ObjFSO, Fsofolder, UpLoadPath
Dim m
m = Month(Now)
If Len(m) = 1 Then m = "0" & m
UpLoadPath = Year(now) & "-" & m '以年月创建上传文件夹，格式：2004-01
On Error Resume Next
Set ObjFSO = Server.CreateObject("Scripting.FileSystemObject")
If ObjFSO.FolderExists(Server.MapPath(StrPath & UpLoadPath)) = False Then
ObjFSO.CreateFolder Server.MapPath(StrPath & UpLoadPath)
End If
If Err.Number = 0 Then
Err.Clear
CreatePath = UpLoadPath & "\"
Else
CreatePath = ""
End If
Set ObjFSO = Nothing
End Function
End Class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -