<%
Class AppDataBase
	Public dbConn,dbRs,iConnect,ifetchCount,iquerycount
	Public ConnStr
	Private errid,errdes
	
	Private sub Class_Initialize
		iConnect=False
		iquerycount=0
		ifetchCount=0
	end sub
	
	public sub Class_Terminate()
		if isObject(dbRs) then dbRs.close : set dbRs = Nothing:end if
		if iConnect then dbConn.close : set dbConn = Nothing:end if
	end sub
	
	Private sub GetConnStr()
		if app_dbtype = "mssql" then
			ConnStr = "Provider=Sqloledb;Data Source=" & app_dbserver & ";Initial Catalog=" & app_dbname & ";User ID=" & app_dbuser & ";Password=" & app_dbpass & ";"
		elseif app_dbtype = "access" then
			ConnStr = "Provider=Microsoft.Jet.OLEdb.4.0;Data Source=" & server.mappath(app_installdir & app_dbpath)
		end if
	end sub
	
	public sub CreatConn()
		On Error Resume next
		if isObject(dbConn) = False or iConnect = False then
			set dbConn=Server.CreateObject("ADODB.Connection")
			dbConn.open ConnStr
			iConnect = True
		end if
		if Err.number <> 0 then
			writeE "数据库服务器端连接错误，请检查数据库连接:" & err.number & ","  & Err.Description
			dbConn.Close
			set dbConn = Nothing
		end if
	end sub
	
	public function DB(byval SqlStr,byval sqlType)
		if iConnect = false then CreatConn : end if
		SqlStr=replace(SqlStr,"{pre}",app_tablepre)
		
		select case sqlType
			case "exe"
				set DB = dbConn.execute(SqlStr)
			case "rs1"
				set DB=Server.CreateObject("ADODB.RecordSet")
				DB.open SqlStr,dbConn,1,1
			case "rs3"
				set DB=Server.CreateObject("ADODB.RecordSet")
				DB.open SqlStr,dbConn,3,3
			case "arr"
				set dbRs=Server.CreateObject("ADODB.RecordSet")
				dbRs.open SqlStr,dbConn,1,1
				if not dbRs.Eof then
					if ifetchCount = 0 then 
						DB = dbRs.getRows()
					else
						DB = dbRs.getRows(ifetchCount)
					end if
				end if
				dbRs.close:set dbRs=Nothing
		end select
		iquerycount = iquerycount + 1
	end function
	
	public function C(byref ObjRs)
		On Error Resume next
		ObjRs.close()
		set ObjRs = Nothing
	end function
	
 	Public Function Exist(byval tableName,byval fieldName ,byval ID)
		Dim i,sqlstrFN,sqlstrV,SqlStr,Rst
		SqlStr="SELECT * FROM "&tableName&" WHERE "&fieldName&"="&ID
		SqlStr=replace(SqlStr,"{pre}",app_tablepre)
		On Error Resume Next
		Set Rst = DB(SqlStr,"rs1")
		IF Rst.Eof Then:Exist = False:Else:Exist = True:End IF
		Rst.close:Set Rst = nothing
		IF Err Then 
			errid=Err.number:errdes=Err.description:Err.Clear
			Exist=false
		End IF
	End Function
	
	public function AutoID(byval tableName,byval colname)
		dim tmpID
		tableName=replace(tableName,"{pre}",app_tablepre)
		set dbRs = DB("SELECT Max("&colname&") FROM ["&tableName&"]","rs1")
		tmpID = dbRs.Fields.Item(0).Value 
		dbRs.Close() : set dbRs = Nothing
		AutoID = tmpID
	end function
	
	Public Function Add(byval tableName,byval arrFieldName , byval arrValue)
		Dim i,sqlstrFN,sqlstrV,SqlStr,Rst
		Add=true
		sqlstrFN = "":sqlstrV = ""
		tableName=replace(tableName,"{pre}",app_tablepre)
		IF chkArray(arrFieldName,arrValue) = False Then Add=false:exit function:end IF
		SqlStr="SELECT * FROM "&tableName
		On Error Resume Next
		Set Rst = DB(SqlStr,"rs3")
		Rst.addnew
		For i = 0 to ubound(arrFieldName)
			Rst(arrFieldName(i)) = arrValue(i)
		Next
		Rst.Update:Rst.Close:Set Rst = nothing
		IF Err Then
			errid=Err.number:errdes=Err.description:Err.Clear
			Add =false
		End IF
	End Function
	
	Public Function Update(byval tableName,byval arrFieldName , byval arrValue ,byval KeyStr)
		Dim i,sqlstrFN,sqlstrV,SqlStr,Rst
		Update=true
		sqlstrFN = "":sqlstrV = ""
		tableName=replace(tableName,"{pre}",app_tablepre)
		IF chkArray(arrFieldName,arrValue) = False Then Update=false:exit function:End IF
		SqlStr = "SELECT * FROM "&tableName&" WHERE "&KeyStr
		On Error Resume Next
		Set Rst = DB(SqlStr,"rs3")
		For i = 0 to ubound(arrFieldName)
			Rst(arrFieldName(i))=arrValue(i)
		Next
		Rst.Update:Rst.close:Set Rst = nothing
		IF Err Then
			errid=Err.number:errdes=Err.description:Err.Clear
			Update=false
		End IF
	End Function
	
	Public Function Delete(byval tableName,byval KeyStr)
		Dim SqlStr
		Delete=true
		On Error Resume Next
		tableName=replace(tableName,"{pre}",app_tablepre)
		SqlStr = "DELETE FROM "&tableName&" WHERE "&KeyStr: DB SqlStr,"exe"
		IF Err Then 
			errid=Err.number:errdes=Err.description:Err.Clear
			Delete=false
		End IF
	End Function
	
End Class

Class AppBase64
	Private sBASE_64_CHARACTERS
	Private len1,k
	Private asc1,asContents1
	Private varchar,varasc,varHex,varlow,varhigh
	
	Private Sub Class_Initialize
	  sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"  
	  sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
	End Sub
	
	Private Function strUnicodeLen(asContents)
	  asContents1="a"&asContents
	  len1=len(asContents1)
	  k=0
	  for i=1 to len1
	      asc1=asc(mid(asContents1,i,1))
	      if asc1<0 then asc1=65536+asc1
	      if asc1>255 then
	         k=k+2
	      else
	         k=k+1
	      end if
	  next
	  strUnicodeLen=k-1
	End Function
	
	Private Function strUnicode2Ansi(asContents)
	  dim i,len1
	  strUnicode2Ansi=""
	  len1=len(asContents)
	  for i=1 to len1
	      varchar=mid(asContents,i,1)
	      varasc=asc(varchar)
	      if varasc<0 then varasc=varasc+65536
	      if varasc>255 then
	         varHex=Hex(varasc)
	         varlow=left(varHex,2)
	         varhigh=right(varHex,2)
	         strUnicode2Ansi=strUnicode2Ansi & chrb("&H" & varlow ) & chrb("&H" & varhigh )
	      else
	         strUnicode2Ansi=strUnicode2Ansi & chrb(varasc)
	      end if
	   next
	End function
	
	Private Function strAnsi2Unicode(asContents)
	  dim i,len1
	  strAnsi2Unicode = ""
	  if isnull(asContents) or asContents="" then exit function
	  len1=lenb(asContents)
	  if len1=0 then exit function
	  for i=1 to len1
	      varchar=midb(asContents,i,1)
	      varasc=ascb(varchar)
	      if varasc > 127  then
	      if midb(asContents,i+1,1)<>"" then
	         strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
	   end if
	         i=i+1
	      else
	         strAnsi2Unicode = strAnsi2Unicode & chr(varasc)
	      end if
	  next
	End function
	
	Private Function strBase64encode(asContents)
		Dim lnPosition,lsResult,lsGroupBinary,lsGroup64
		Dim Char1,Char2,Char3,Char4,Byte1,Byte2,Byte3,SaveBits1,SaveBits2
		Dim m3,m4,len1,len2
		len1=Lenb(asContents)
		if len1<1 then 
		   strBase64encode="" : exit Function
		end if
		m3=Len1 Mod 3 
		If M3 > 0 Then asContents = asContents & String(3-M3, chrb(0))
		IF m3 > 0 THEN 
		   len1=len1+(3-m3) : len2=len1-3
		else
		   len2=len1
		end if
		lsResult = ""
		For lnPosition = 1 To len2 Step 3
		    lsGroup64 = ""
		    lsGroupBinary = Midb(asContents, lnPosition, 3)
		    Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
		    Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
		    Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
		    Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
		    Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
		    Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
		    Char4 = Midb(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)
		    lsGroup64 = Char1 & Char2 & Char3 & Char4
		    lsResult = lsResult & lsGroup64
		Next
		if M3 > 0  then
		    lsGroup64 = ""
		    lsGroupBinary = Midb(asContents, len2+1, 3)
		    Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
		    Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
		    Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
		    Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
		    Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
		    Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
		    if M3=1 then
		       lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61)
		    else
		       lsGroup64 = Char1 & Char2 & Char3 & ChrB(61)
		    end if
		    lsResult = lsResult & lsGroup64
		end if
		strBase64encode = lsResult
	End Function
	
	Private Function strBase64decode(asContents)
		Dim lsResult,lnPosition,lsGroup64,lsGroupBinary
		Dim Char1, Char2, Char3, Char4,Byte1, Byte2, Byte3
		Dim M4,len1,len2
		len1= Lenb(asContents) 
		M4 = len1 Mod 4
		if len1 < 1 or M4 > 0 then
		   strBase64decode = "" : exit Function
		end if
		if midb(asContents, len1, 1) = chrb(61)   then   m4=3
		if midb(asContents, len1-1, 1) = chrb(61) then   m4=2
		if m4 = 0 then
		   len2=len1
		else
		   len2=len1-4
		end if
		For lnPosition = 1 To Len2 Step 4
		    lsGroupBinary = ""  
		    lsGroup64 = Midb(asContents, lnPosition, 4)
		    Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
		    Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
		    Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
		    Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
		    Byte1 = Chrb(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
		    Byte2 = lsGroupBinary & Chrb(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
		    Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
		    lsGroupBinary = Byte1 & Byte2 & Byte3
		    lsResult = lsResult & lsGroupBinary
		Next 
		if M4 > 0 then 
		    lsGroupBinary = ""  
		    lsGroup64 = Midb(asContents, len2+1, m4) & chrB(65)
		    if M4=2 then
		        lsGroup64 = lsGroup64 & chrB(65)                  
		    end if
		    Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1  
		    Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1  
		    Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1  
		    Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1  
		    Byte1 = Chrb(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)  
		    Byte2 = lsGroupBinary & Chrb(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)  
		    Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))  
			
		    if M4=2 then
		       lsGroupBinary = Byte1
		    elseif M4=3 then
		       lsGroupBinary = Byte1 & Byte2
		    end if
		    
		    lsResult = lsResult & lsGroupBinary
		end if
		strBase64decode = lsResult
	End Function
	
	Public Function Base64EnCode(strContents)
	   if strContents = null then
	      Base64EnCode = ""
	   else
	      Base64EnCode = strAnsi2Unicode(strBase64encode(strUnicode2Ansi(strContents)))
	   end if
	End Function
	
	Public Function Base64DeCode(strContents)
	   if strContents = null then
	      Base64DeCode = ""
	   else
	      Base64DeCode = strAnsi2Unicode(strBase64decode(strUnicode2Ansi(strContents)))
	   end if
	End Function
End Class


class AppJSON
	private output, innerCall
	public toResponse
	public recordsetPaging
	
	public sub class_initialize()
		newGeneration()
		toResponse = false
		recordsetPaging = false
	end sub
	
	public function escape(val)
		dim cDoubleQuote, cRevSolidus, cSolidus
		cDoubleQuote = &h22
		cRevSolidus = &h5C
		cSolidus = &h2F
		dim i, currentDigit
		for i = 1 to (len(val))
			currentDigit = mid(val, i, 1)
			if ascw(currentDigit) > &h00 and ascw(currentDigit) < &h1F then
				currentDigit = escapequence(currentDigit)
			elseif ascw(currentDigit) >= &hC280 and ascw(currentDigit) <= &hC2BF then
				currentDigit = "\u00" + right(padLeft(hex(ascw(currentDigit) - &hC200), 2, 0), 2)
			elseif ascw(currentDigit) >= &hC380 and ascw(currentDigit) <= &hC3BF then
				currentDigit = "\u00" + right(padLeft(hex(ascw(currentDigit) - &hC2C0), 2, 0), 2)
			else
				select case ascw(currentDigit)
					case cDoubleQuote: currentDigit = escapequence(currentDigit)
					case cRevSolidus: currentDigit = escapequence(currentDigit)
					case cSolidus: currentDigit = escapequence(currentDigit)
				end select
			end if
			escape = escape & currentDigit
		next
	end function
	
	public default function toJSON(name, val, nested)
		if not nested and not isEmpty(name) then write("{")
		if not isEmpty(name) then write("""" & escape(name) & """: ")
		generateValue(val)
		if not nested and not isEmpty(name) then write("}")
		toJSON = output
		if innerCall = 0 then newGeneration()
	end function
	
	private function generateValue(val)
		if isNull(val) then
			write("""""")
		elseif isArray(val) then
			generateArray(val)
		elseif isObject(val) then
			dim tName : tName = typename(val)
			if val is nothing then
				write("""""")
			elseif tName = "Dictionary" or tName = "IRequestDictionary" then
				generateDictionary(val)
			elseif tName = "Recordset" then
				generateRecordset(val)
			elseif tName = "IRequest" then
				set req = server.createObject("scripting.dictionary")
				req.add "clientcertificate", val.ClientCertificate
				req.add "cookies", val.cookies
				req.add "form", val.form
				req.add "querystring", val.queryString
				req.add "servervariables", val.serverVariables
				req.add "totalbytes", val.totalBytes
				generateDictionary(req)
			elseif tName = "IStringList" then
				if val.count = 1 then
					toJSON empty, val(1), true
				else
					generateArray(val)
				end if
			else
				generateObject(val)
			end if
		else
			dim varTyp
			varTyp = varType(val)
			if varTyp = 11 then
				if val then write("true") else write("false")
			elseif varTyp = 2 or varTyp = 3 or varTyp = 17 or varTyp = 19 then
				write(cLng(val))
			elseif varTyp = 4 or varTyp = 5 or varTyp = 6 or varTyp = 14 then
				write(replace(cDbl(val), ",", "."))
			else
				write("""" & escape(val & "") & """")
			end if
		end if
		generateValue = output
	end function
	
	private sub generateArray(val)
		dim item, i
		write("[")
		i = 0
		for each item in val
			if i > 0 then write(",")
			generateValue(item)
			i = i + 1
		next
		write("]")
	end sub
	
	private sub generateDictionary(val)
		innerCall = innerCall + 1
		if val.count = 0 then
			toJSON empty, null, true
			exit sub
		end if
		dim key, i
		write("{")
		i = 0
		for each key in val
			if i > 0 then write(",")
			toJSON key, val(key), true
			i = i + 1
		next
		write("}")
		innerCall = innerCall - 1
	end sub
	
	private sub generateRecordset(val)
		dim i, curRow
		if val.recordCount > 1 then write("[")
		curRow = 0
		while not val.eof and ((recordsetPaging and curRow < val.pageSize) or val.recordCount = -1 or not recordsetPaging)
			innerCall = innerCall + 1
			write("{")
			for i = 0 to val.fields.count - 1
				if i > 0 then write(",")
				toJSON lCase(val.fields(i).name), val.fields(i).value, true
			next
			write("}")
			val.movenext()
			curRow = curRow + 1
			if not val.eof and ((recordsetPaging and curRow < val.pageSize) or val.recordCount = -1 or not recordsetPaging) then write(",")
			innerCall = innerCall - 1
		wend
		if val.recordCount > 1 then  write("]")
	end sub
	
	private sub generateObject(val)
		dim props
		on error resume next
		set props = val.reflect()
		if err = 0 then
			on error goto 0
			innerCall = innerCall + 1
			toJSON empty, props, true
			innerCall = innerCall - 1
		else
			on error goto 0
			write("""" & escape(typename(val)) & """")
		end if
	end sub
	
	private sub newGeneration()
		output = empty
		innerCall = 0
	end sub
	
	private function escapequence(digit)
		escapequence = "\u00" + right(padLeft(hex(ascw(digit)), 2, 0), 2)
	end function
	
	private function padLeft(value, totalLength, paddingChar)
		padLeft = right(clone(paddingChar, totalLength) & value, totalLength)
	end function
	
	private function clone(byVal str, n)
		dim i
		for i = 1 to n : clone = clone & str : next
	end function
	
	private sub write(val)
		if toResponse then
			response.write(val)
		else
			output = output & val
		end if
	end sub
end class

Class AppFile
	Public objFso,objStream
	
	sub Class_initialize
		set objFso=server.createobject("Scripting.FileSystemObject")
		set objStream=server.createobject("ADODB.Stream")
    end sub
    
    sub Class_Terminate
    	set objFso=nothing
		set objStream=nothing
    end sub
	
	function getFile(byval filepath)
		on error resume next
	    With objStream
	        .Type=2
	        .Mode=3
	        .Open
			.Charset="utf-8"
	        .LoadFromFile Server.MapPath(filepath)
	        .Position=0
	        getFile=.ReadText
	        .Close
	    End With
	    if err then  writee "找不到文件："&filepath : getFile=false : err.clear
	end function
	
	function getFileTime(filepath)
		if isFileExists(filepath) then
			dim fileobj,filetime
			set fileobj = objFso.getFile(server.Mappath(filepath))
			filetime=fileobj.DateLastModified
			getFileTime = filetime
			set fileobj = nothing
		else
			getFileTime = ""
		end if
	end function
	
	function getFileSize(filepath)
		if isFileExists(filepath) then
			dim fileobj,filesize
			set fileobj = objFso.getFile(server.Mappath(filepath))
			filesize=fileobj.size
			getFileSize = filesize
			set fileobj = nothing
		else
			getFileTime = 0
		end if
	end function
	
	function createFile(byval filepath,byval filecontent)
		dim fileobj
		on error resume next
		With objStream
			.Charset="utf-8"
			.Type=2
			.Mode=3
			.Open
			.Position=0
			.WriteText filecontent
			.SaveToFile server.mappath(filepath), 2
			.Close
		End With
		if err then createFile=false : err.clear:  else createFile=true
	end function
	
	function createFileFso(byval filepath,byval filecontent)
		dim fileobj
		on error resume next
		set fileobj=objFso.CreateTextFile(server.mappath(filepath),True)
		fileobj.Write(filecontent)
		set fileobj=nothing
		if err then createFileFso=false : err.clear:  else createFileFso=true
	end function
	
	function createBinaryFile(byval filepath,byval filestream)
		call createFilePath(filepath)
		on error resume next
		With objStream
			.Type =1
			.Mode=3  
			.Open
			.write filestream
			.SaveToFile server.mappath(filepath),2
			.close
		End With
		if err then createBinaryFile=false : err.clear : else createBinaryFile=true
	end function
	
	function createFilePath(byval filepath)
		dim arrpath,tmppath,arrlen,i
	    on error resume next
		filepath=replaceStr(server.mappath(filepath), server.mappath("/"), "")
		arrpath=split(filepath, "\")
		tmppath=server.mappath("/")
		arrlen=ubound(arrpath) - 1
		for i=1 to  arrlen
			tmppath=tmppath&"\"&arrpath(i)
			if not isFolderExistsB(tmppath) then objFso.CreateFolder tmppath
		next
		if err then createFilePath=false : err.clear : else createFilePath=true
	end function
	
	function createPath(byval filepath)
		dim arrpath,tmppath,arrlen,i
	    on error resume next
		filepath=replaceStr(server.mappath(filepath), server.mappath("/"), "")
		arrpath=split(filepath, "\")
		tmppath=server.mappath("/")
		arrlen=ubound(arrpath)
		
		for i=1 to  arrlen
			tmppath=tmppath&"\"&arrpath(i)
			if not isFolderExistsB(tmppath) then objFso.CreateFolder tmppath
		next
		if err then createPath=false : err.clear : else createPath=true
	end function
	
	function isFileExists(byval filepath)
		on error resume next
		if (objFso.FileExists(server.MapPath(filepath))) then  isFileExists=true  Else  isFileExists=false
		if err then err.clear:isFileExists=false
	end function 
	
	function isFolderExists(byval folderpath)
		on error resume next
		if objFso.FolderExists(server.MapPath(folderpath)) then  isFolderExists=true Else isFolderExists=false
		if err then err.clear:isFolderExists=false
	end function 
	function isFolderExistsB(byval folderpath)
		on error resume next
		if objFso.FolderExists(folderpath) then  isFolderExistsB=true Else isFolderExistsB=false
		if err then err.clear:isFolderExistsB=false
	end function 
	
	function delFolder(byval folderpath)
		on error resume next
		if isFolderExists(folderpath)=True then  
			objFso.DeleteFolder(server.mappath(folderpath)) 
			if err then  delFolder=false : err.clear : else delFolder=true
		else
			delFolder=false
		end if
	end function 
	
	function delFile(byval filepath)
		on error resume next
		if isFileExists(filepath)=True then objFso.DeleteFile(server.mappath(filepath))
		if  err then  delFile=false : err.clear : else delFile=true
	end function 
	
	function moveFile(byval filepath,byval newfilepath)
		on error resume next
		if IsFileExists(newfilepath) then delFile newfilepath
		filepath = Server.MapPath(filepath)
		newfilepath = Server.MapPath(newfilepath)
		objFso.MoveFile filepath,newfilepath
		if  err then  moveFile=false : err.clear : else moveFile=true
	end function 
		
	function copyFile(byval filepath,byval newfilepath)
		on error resume next
		filepath = Server.MapPath(filepath)
		newfilepath = Server.MapPath(newfilepath)
		objFso.CopyFile filepath,newfilepath
		if  err then  copyFile=false : err.clear : else copyFile=true
	end function 
	
	function folderFileCount(byval folderpath)
		folderFileCount=0
		dim folderObj
		set folderObj= objFso.GetFolder(server.MapPath(folderpath))
		folderFileCount = folderObj.Files.count
		set folderObj=nothing
	end function
	
	function folderItem(byval folderpath)
		if IsFolderExists(folderpath) = false then folderItem=False : exit function
		dim folderObj,F,tempStr,tempName
		set folderObj= objFso.GetFolder(server.MapPath(folderpath))
		for each F in folderObj.SubFolders
			tempName = F.name
			tempStr = tempName & ","&tempStr
		next
		set folderObj=nothing
		folderItem = tempStr
	end function 
	
	function fileItem(byval folderpath)
		if IsFolderExists(folderpath) = false then  fileItem=False : exit function
		dim fileObj,fileList,F 
		set fileObj=objFso.GetFolder(Server.MapPath(folderpath))
		set fileList=fileObj.Files 
		for each F in fileList 
			fileItem= fileItem & F.Name & "|" & Round(F.size/1024,2) & "|" & F.DateLastModified & "||"
		next
		set fileList=nothing 
		set fileObj=nothing 
	end function

end Class

Class AppXmlDom
	Private objXml
	Private xmlDoc
	Private xmlPath
	public ver
	
	sub Class_initialize
		set objXml = getXmldom()
		objXml.preserveWhiteSpace = true
		objXml.async = false
	end sub
	
	sub Class_Terminate
		set xmlDoc = Nothing
		set objXml = Nothing
	end sub
    
    function getXmldom()
		dim i,arr
		arr = Array("Microsoft.XMLDOM","MSXML2.DOMDocument","MSXML2.DOMDocument.3.0","MSXML2.DOMDocument.4.0","MSXML2.DOMDocument.5.0")
		getXmldom = false
		on error resume next
		for i=0 to ubound(arr)
			set getXmldom=Server.CreateObject(arr(i))
			if err.number=0 then :ver=arr(i): err.clear:exit function : else err.clear :end if
		next
	end function
	
	public function CreateNew(sName)
		set tmpNode = objXml.createElement(sName)
		objXml.appendChild(tmpNode)
		set CreateNew = tmpNode
	end function
        
	public function OpenXml(sPath)
		OpenXml=False
		sPath=Server.MapPath(sPath)
		xmlPath = sPath
		if objXml.load(sPath) then
			set xmlDoc = objXml.documentElement
			OpenXml=True
		end if
	end function
        
	public sub LoadXml(sStr)
		objXml.loadXML(sStr)
		set xmlDoc = objXml.documentElement
		If left(sStr, 5) <> "<?xml" then writee "加载xml发生错误"
	end sub
	
	public sub InceptXml(xObj)
		set objXml = xObj
		set xmlDoc = xObj.documentElement
	end sub
	
	public function AddNode(sNode,rNode)
		dim TmpNode
		set TmpNode = objXml.createElement(sNode)
		rNode.appendChild TmpNode
		set AddNode = TmpNode
	end function
	
	public function AddAttribute(sName,sValue,oNode)
		oNode.setAttribute sName,sValue
	end function
	
	public function AddText(FStr,cdBool,oNode)
		dim tmpText
		if cdBool then
			set tmpText = objXml.createCDataSection(FStr)
		Else
			set tmpText = objXml.createTextNode(FStr)
		end if
	oNode.appendChild tmpText
	end function
        
	public function FindNodes(sNode)
		dim tmpNodes
		set tmpNodes = objXml.getElementsByTagName(sNode) 
		set FindNodes = tmpNodes
	end function
	
	public function GetNodeLen(NodeName)
		GetNodeLen = objXml.GetElementsByTagName(NodeName).Length
	end function
	
	public function GetAttr(NodeName, AttrName, ItemId)
		dim XmlAttrs, I
		if isN(ItemId) then  ItemId = 0
		set XmlAttrs = objXml.GetElementsByTagName(NodeName).Item(ItemId).Attributes
		for I = 0 To XmlAttrs.Length -1
		if XmlAttrs(I).Name = attrName then
			GetAttr = XmlAttrs(I).Value
			set XmlAttrs = nothing
			exit function
		end if
		next
		GetAttr = False
	end function
	    
	public function SelectSingleNode(byval XPath)
		set SelectSingleNode = objXml.SelectSingleNode(XPath)
	end function
	
	public function SelectNodes(byval XPath)
		set SelectNodes = objXml.SelectNodes(XPath)
	end function
 	
	public function DelNode(sNode)
		dim TmpNodes,Nodesss
		set Nodesss=sNode.parentNode
		Nodesss.removeChild(sNode)
	end function
	
	public function ReplaceNode(sNode,sText,cdBool) 
		dim TmpNodes,tmpText
		set TmpNodes=objXml.selectSingleNode(sNode)
		if cdBool then                        
			set tmpText = objXml.createCDataSection(sText)
		Else
			set tmpText = objXml.createTextNode(sText)
		end if
		TmpNodes.replaceChild tmpText,TmpNodes.firstChild
	end function
        
	public function SaveXML()
		objXml.save(xmlPath)
	end function
        
	Property Get Root
		set Root = xmlDoc
	End Property
End Class
%>