<%
' +----------------------------------------------------------------------
' | KCMS [ 启点在线网站管理系统 ]
' | Copyright (c) 2018 http://www.kelvinvt.com All rights reserved.
' | Licensed ( http://www.kelvinvt.com )
' | Author: kelvinvt <kelvinvt@qq.com>
' +----------------------------------------------------------------------
	'检查组件是否已经安装
	public function isObjInstalled(byval str)
		on error resume next
		err.clear()
		dim obj
		set obj = server.createObject(str)
		if err.number = 0 then
			isObjInstalled = true
		else
			isObjInstalled = false
		end if
		set obj = nothing
		err.clear()
	end function
	
	'检查FSO组件
	function checkFSOInstalled()
		on error resume next
		err.clear()
		dim Fso
		set Fso = server.createObject("Scripting.FileSystemObject")
		if err.number = 0 then
			checkFSOInstalled = true
		else
			checkFSOInstalled = false
		end if
		set Fso = nothing
		err.clear()
	end function
	
	function setfolder(byval folderPath)
		on error resume next
		if ifstrin(folderPath,"://") then setfolder="" :  exit function
		if not ifstrin(folderPath,"\") then 
			setfolder=ABSPath(Server.MapPath(folderPath))
		else
			setfolder=ABSPath(folderPath)
		end if
	end function
	
	function ABSPath(byval path)		
		path = replace(path,"//","/")
		path = replace(path,"*","")
		path = replace(path,"?","")
		path = replace(path,"""","")
		path = replace(path,"|","")
		path = replace(path,"<","")
		path = replace(path,">","")
		path = replace(path,"../","")
		path = replace(path,"\..","")
		if isNul(path) or isNul(replace(path,"/","")) or isNul(replace(path,"\","")) then
			ABSPath = ""
			exit function
		end if
		if instr(path,":")>0 then
			path = regReplace(path,"[/]+","/")
		else
			path = replace(path,"\","/")
			path = regReplace(path,"[/]+","/")
			if left(path,1)<>"/" then
				path = sitepath & path
			end if
		end if
		if right(path,1)="\" then path=left(path,Len(path)-1)
		ABSPath = path
	end function

	'设定上传目录
	function uploaddir(byval files)
		if len(files)>0 then files=files&"/"
		uploaddir=sitePath&upLoadPath&"/"&files&getrndname
		newfolder uploaddir
	end function
	
	'文件夹存在
	function isfolder(byval folder)	
		on error resume next
		folder=setfolder(folder)
		isfolder=fso.folderexists(folder)	
	end function
	
	'检查文件存在
	function isfile(byVal files)
		on error resume next
		if isnul(files) then isfile="" : exit function
		if ifstrin(files,"://") then isfile="" :  exit function
		files=setfolder(files)		
		isfile=fso.fileexists(files)		
	end function
	
	'检查文件存在
	function getfiles(byVal files,byVal str)
		on error resume next
		if isnul(files) then filesize="" : exit function
		files=setfolder(files)
		select case str
		case "size" :  getfiles=fso.GetFile(files).Size						'返回指定文件的尺寸（字节）。
		case "type" :  getfiles=fso.GetFile(files).Type						'返回指定文件的类型。
		case "name" :  getfiles=fso.GetFile(files).Name						'设置或返回指定文件的名称
		case "path" :  getfiles=fso.GetFile(files).path						'返回指定文件的路径
		case "drive" :  getfiles=fso.GetFile(files).Drive					'返回指定文件或文件夹所在的驱动器的驱动器字母	
		case "sname" :  getfiles=fso.GetFile(files).ShortName			'返回指定文件的短名称（8.3 命名约定）。
		case "snath" :  getfiles=fso.GetFile(files).ShortPath			'返回指定文件的短路径（8.3 命名约定）。
		case "parent" :  getfiles=fso.GetFile(files).ParentFolder		'返回指定文件或文件夹的父文件夹对象
		case "attr" :  getfiles=fso.GetFile(files).Attributes			'设置或返回指定文件的属性。
		case "addtime" :  getfiles=fso.GetFile(files).DateCreated		'返回指定文件创建的日期和时间	
		case "readtime" :  getfiles=fso.GetFile(files).DateLastAccessed		'返回指定文件最后被访问的日期和时间
		case "edittime" :  getfiles=fso.GetFile(files).DateLastModified		'返回指定文件最后被修改的日期和时间
		case else :  getfiles=""
		end select
	end function	

	'判断文件夹是否有写入权限(文件夹的绝对路径)
	public function Checkrw(byval folderPath)
		on error resume next
		if not isfolder(folderPath) then echo "文件夹不存在"	:	exit function
		if Ischeckrw=1 then
		dim filepath,text : text = "writeable "& startime
		if right(folderPath,1)="/" then
			filepath = folderPath & "testwriteable.txt"
		else
			filepath = folderPath &"/"& "testwriteable.txt"
		end if
		SaveFile filepath,text		
		if err.number<>0 then
			Checkrw = false
		else
			if isfile(filepath) then
				Checkrw = true
				call delFile(filepath)
			else
				Checkrw = false
			end if
		end if
		else
			Checkrw = "未检查"
		end if
		err.clear()
	end function
		
	'创建文件夹	
	Function NewFolder(ByVal folderPath)
		dim mapPath,subFolder,sParent
		subFolder=setfolder(folderPath)		
		if isfolder(subFolder) then exit function		
		sParent = FSO.GetParentFolderName(subFolder)		
		If sParent = "" Then Exit Function
		If Not FSO.FolderExists(sParent) Then NewParentFolder(sParent)
		If Not FSO.FolderExists(subFolder) Then FSO.CreateFolder(subFolder)		
		if err then
			if err.number<>70 and err.number<>58 then				
				errlog "文件夹创建失败："&subFolder&"<br>函数：newfolder<br>详情："&folderPath&err.description,0
			end if
			err.clear
		end if
	End Function
	
	Function NewParentFolder(ByVal subFolder)
		dim mapPath,sParent
		sParent = FSO.GetParentFolderName(subFolder)		
		If sParent = "" Then Exit Function
		If Not FSO.FolderExists(sParent) Then NewParentFolder(sParent)
		If Not FSO.FolderExists(subFolder) Then FSO.CreateFolder(subFolder)		
		if err then
			if err.number<>70 and err.number<>58 then				
				errlog "文件夹创建失败："&subFolder&"<br>函数：newfolder<br>详情："&folderPath&err.description,0
			end if
			err.clear
		end if
	End Function
	
		
	'复制文件夹
	Function copyFolder(oldFolder,newFolder)
		call checkFSOInstalled()
		dim voldFolder,vnewFolder
		voldFolder=oldFolder
		vnewFolder=newFolder
		on error resume next
		if voldFolder <> vnewFolder then
			voldFolder=setfolder(oldFolder)
			vnewFolder=setfolder(newFolder)
			if not fso.FolderExists(vnewFolder) then NewFolder newFolder,"folderdir" 
			if  fso.FolderExists(voldFolder)  then  fso.CopyFolder voldFolder,vnewFolder
			if Err Then  copyFolder=false : errid=err.number : errdes=err.description:Err.Clear : echoErr err_14,errid,errdes else moveFolder=true
		end if
	End Function
	
	'移动编辑文件夹
	Function moveFolder(oldFolder,newFolder)
		call checkFSOInstalled()
		dim voldFolder,vnewFolder
		voldFolder=oldFolder
		vnewFolder=newFolder
		on error resume next
		if voldFolder <> vnewFolder then
			voldFolder=setfolder(oldFolder)
			vnewFolder=setfolder(newFolder)
			if not fso.FolderExists(vnewFolder) then NewFolder newFolder,"folderdir" 
			if  fso.FolderExists(voldFolder)  then  fso.CopyFolder voldFolder,vnewFolder : fso.DeleteFolder(voldFolder)
			if Err Then  moveFolder=false : errid=err.number : errdes=err.description:Err.Clear : echoErr err_14,errid,errdes else moveFolder=true
		end if
	End Function
	
	'删除文件夹
	sub delfolder(byval Folder)
		call checkFSOInstalled()
		on error resume next
		if not isnul(Folder) then
		  Folder=setfolder(Folder)
		  fso.DeleteFolder(Folder)
		  if err then errlog "文件名："&Folder&"<br>函数：delfolder<br>详情："&err.description,1		
		end if
	end sub
	
	'读取文件
	function loadfile(byval strs)
		call checkFSOInstalled()
		if isnul(strs) then exit function
		on error resume next
		dim text
		with stm
			.type=2
			.mode=3 
			.charset="utf-8"
			.open
			.loadfromfile setfolder(strs)
			text=.readtext
			.close
		end with
		if err then
			errlog "文件名："&strs&"<br>函数：loadfile<br>详情："&err.description,1
			err.clear
		else			
			loadfile=text
		end if
	end function	
	
	sub copyfile(byval files,byval newfiles)
		on error resume next
		if fso.fileexists(setfolder(files)) then
			fso.Copyfile setfolder(files),setfolder(newfiles)
		end if
		if err then
			errlog "文件名："&files&"<br>新文件名"&newfiles&"<br>函数：Copyfile<br>详情："&err.description,1
			err.clear		
		end if
	end sub
	
	'编辑重命名文件
	sub editfile(byval files,byval newfiles)
		on error resume next
		if isfile(newfiles) then delfile(newfiles) 
		if isfile(files) then fso.movefile setfolder(files),setfolder(newfiles)
		if err then
			errlog "文件名："&setfolder(files)&"<br>函数：editfile<br>详情："&err.description,1
			err.clear
		end if
	end sub
	
	'删除文件
	sub delfile(byval files)
		on error resume next
		if isfile(files) then fso.deletefile setfolder(files)
		if err then
			errlog "文件名："&setfolder(files)&"<br>函数：delfile<br>详情："&err.description,1
			err.clear		
		end if
	end sub
	
		'取得文件路径
	 function GetFilePath(Path)
	 dim FullPath : FullPath=Path
	  If FullPath <> "" Then
	  	FullPath=setfolder(FullPath)		
		GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
		Else
		GetFilePath = ""
	  End If	 
	End function
	
	'取得文件名
	 Function GetFileName(Path)
	 dim FullPath : FullPath=Path
	  If FullPath <> "" Then
	  	if ifstrin(FullPath,"/") then FullPath=mid(FullPath,InStrRev(FullPath, "/")+1)
		GetFileName = LCase(left(FullPath,InStrRev(FullPath, ".")-1))
		Else
		GetFileName = ""
	  End If
	End function
	
	'取得文件的后缀名
	 Function GetFileExt(Path)
	 dim FullPath : FullPath=Path
	  If FullPath <> "" and ifstrin(FullPath,".") Then
		GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))	
	  Else
		GetFileExt = ""
	  End If
	End function

	Function getFolderList(Byval cDir)
		On Error Resume Next
	  dim filePath,objFolder,objSubFolder,objSubFolders,i
	  i=0
	  redim  folderList(0)
	  filePath=setfolder(cDir)
	 ' echop filePath
	  set objFolder=fso.GetFolder(filePath)
	  set objSubFolders=objFolder.Subfolders
	  for each objSubFolder in objSubFolders
		  ReDim Preserve folderList(i)
		  With objSubFolder
			  folderList(i)=.name&",文件夹,"&.size/1000&"KB,"&.DateLastModified&","&cDir&.name&"/"
		  End With
		  i=i + 1 
	  next 
	  set objFolder=nothing
	  set objSubFolders=nothing
	  getFolderList=folderList
	End Function
	
	Function getFileList(Byval cDir)
		On Error Resume Next
		dim filePath,objFolder,objFile,objFiles,i,fileList
		i=0
		redim  fileList(0)
		filePath=setfolder(cDir)
		set objFolder=fso.GetFolder(filePath)
		set objFiles=objFolder.Files
		for each objFile in objFiles
			ReDim Preserve fileList(i)
			With objFile
				fileList(i)=.name&","&Mid(.name, InStrRev(.name, ".") + 1)&","&.size/1000&"KB,"&.DateLastModified&","&cDir&.name
			End With
			i=i + 1 
		next 
		set objFiles=nothing
		set objFolder=nothing
		getFileList=fileList
	End Function
	
	sub folder_list(folder,num)
	  on error resume next
		  dim i,fileList,fileAttr,folderico,delbutton
			fileList= getFolderList(folder)				  
			if instr(fileList(0),",")>0 then				  
				for  i = 0 to ubound(fileList)
					fileAttr=split(fileList(i),",")					 
					 if parentPath=fileAttr(4) then folderico="<i class='fa fa-folder-open'></i>" else folderico="<i class='fa fa-folder'></i>"
					  if ifstrin(fileAttr(4),"backups") or ifstrin(getFileList(fileAttr(4))(0),",")  then delbutton= "<i class='fa fa-times' onclick=delfolder('"&fileAttr(4)&"')></i>" else delbutton=""
					echo "<li id='folder"&num&"'><a title='"&fileAttr(2)&"' href=""?parentPath="&fileAttr(4)&""">"&folderico&fileAttr(0)&"</a> <span>"&delbutton&"<i class='fa fa-plus'  onclick=creatfolder('"&fileAttr(4)&"')></i></span></li>"&vbcrlf
				   if instr(getFolderList(fileAttr(4))(0),",")>0 then  					 	
					  call folder_list(fileAttr(4),num+1)	
					end if			  
				next
			end if	
	end sub	
	
	
	'********************************************************************
		'判断模板缓存是否有效
	public function CheckCache(byval cacheName)
	dim fs,cachePath,file,result,ctime
		cacheName = lcase(cacheName)
		result    = false
		if isNul(cacheName) then CheckCache = result : exit function
		cachePath  =ABSPath(cacheName)
		if isfile(cachePath) then
			Set file=fso.GetFile(setfolder(cachePath)) 
			if dateDiff("s",cDate(file.dateLastModified),now()) < (cacheTime*60) then
				result = true
			end if
			set file = nothing
		end if
		CheckCache = result
	end function
	
			'判断静态文件是否有效
	public function Checkhtml(byval htmlName)
	dim fs,htmlPath,file,result,ctime
		htmlName = lcase(htmlName)
		result    = false
		if isNul(htmlName) then Checkhtml = result : exit function
		htmlPath  =ABSPath(htmlName)
		if isfile(htmlPath) then
			Set file=fso.GetFile(setfolder(htmlPath)) 
			if dateDiff("s",cDate(file.dateLastModified),now()) < (cacheTime*60) then
				result = true
			end if
			set file = nothing
		end if
		Checkhtml = result
	end function
		
	'获取html缓存
    public function getHtmlCache(byval cacheName)
		dim s
		cacheName = lcase(cacheName)
		if cacheName<>"" then
			s = loadfile(cacheName)
		end if
		getHtmlCache = s
	end function
	
		
	'保存文本文件(直接覆盖保存)[会改变文件的读写权限]，如果文件不存在则自动创建
	public function SaveFile(byval filepath, byval fileContent)
		on error resume next
		if isNul(filepath) then SaveFile=false : exit function
		'echop setfolder(filepath)
		dim ado,folderPath,result	
		folderPath=GetFilePath(filepath)
		'die folderPath&"[402]"
		NewFolder folderPath
		filepath=setfolder(filepath)		
		'开始写入文件
		set ado = server.createObject("ADODB.Stream")		
		With ado
			.Mode = 3
			.Type = 2
			.Open
			.CharSet   = "utf-8"
			.Position  = 0
			.WriteText = fileContent
			.SaveToFile filepath,2
			.Flush
			.Close
		end With
		set ado = nothing
		result = true
		if err.number<>0 then
			errlog "文件创建失败："&filepath&"<br>函数：newfolder<br>详情："&filepath&err.description,0
		end if
		err.clear()
		SaveFile = result
	end function
	'================================================== 
	'过程名：SaveRemoteFile 
	'作 用：保存远程的文件到本地 
	'参 数：LocalFileName ------ 本地文件名 
	'参 数：RemoteFileUrl ------ 远程文件URL 
	'================================================== 
	function SaveRemoteFile(LocalFileName,RemoteFileUrl) 
		On Error Resume Next	
		dim Ads,Retrieval,GetRemoteData 	
		if not isnul(CheckURL(RemoteFileUrl)) then SaveRemoteFile=RemoteFileUrl : exit function
		Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") 
		With Retrieval 
		.Open "Get", RemoteFileUrl, False, "", "" 
		.Send 
		GetRemoteData = .ResponseBody 
		End With 
		Set Retrieval = Nothing 
		Set Ads = Server.CreateObject("Adodb.Stream") 
		With Ads 
		.Type = 1 
		.Open 
		.Write GetRemoteData 
		.SaveToFile server.MapPath(LocalFileName),2 
		.Cancel() 
		.Close() 
		End With 
		Set Ads=nothing 
		SaveRemoteFile=LocalFileName
	end function 
	
	'判断远程图片是否存在
	function CheckURL(byval A_strUrl)
		On Error Resume Next
		set XMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")
		XMLHTTP.open "HEAD",A_strUrl,false
		XMLHTTP.send()
		CheckURL=(XMLHTTP.status=200)
		set XMLHTTP = nothing
	end function
	
	Function smallimg(oldfile,newfile)
	  On Error Resume Next
	  dim jpegObj,jpegdate
	  if smallMark=0 then exit function
	  If Not isObjInstalled("Persits.Jpeg") Then exit function
	  set jpegObj = Server.CreateObject("Persits.Jpeg")	
		jpegdate=jpegObj.Expires
	  if datediff("d",now(),jpegdate)<0 then alert ("您的aspjpeg组件已过期，建议请关闭自动缩略图功能，到期时间"&jpegdate) : exit function
	  if isfile(oldfile) then jpegObj.Open setfolder(oldfile) else exit function
	  If  jpegObj is nothing then exit function	
	  jpegObj.PreserveAspectRatio = True
	  jpegObj.Quality = smallquality
	  
	  select case smallMode
	  case "0"	'居中裁切
	  If jpegObj.OriginalWidth > jpegObj.OriginalHeight Then '判断图片形状
		  jpegObj.Height = smallheight '图片高度等于缩略图高度
		  jpegObj.Crop (jpegObj.Width-smallwidth)/2, 0,(jpegObj.Width-smallwidth)/2+smallwidth,jpegObj.Height '按照缩略图尺寸切图
	  Else
		   jpegObj.Width = smallwidth'图片宽度等于缩略图高度
		   jpegObj.Crop 0, (jpegObj.Height-smallheight)/2,jpegObj.Width,(jpegObj.Height-smallheight)/2+smallheight '按照缩略图尺寸切图
	  End If
	  case "1"     '左上裁切
	  If jpegObj.OriginalWidth > jpegObj.OriginalHeight Then '判断图片形状
		  jpegObj.Height = smallheight '图片高度等于缩略图高度
		  jpegObj.Crop 0, 0,smallwidth,jpegObj.Height '按照缩略图尺寸切图
	  Else
		   jpegObj.Width = smallwidth'图片宽度等于缩略图高度
		   jpegObj.Crop 0, 0,jpegObj.Width,smallheight '按照缩略图尺寸切图
	  End If
	  case "2":jpegObj.Width = smallWidth   '宽等比缩放
	  case "3":jpegObj.Height = smallheight   '高等比缩放
	  end select
	  jpegObj.Save Server.MapPath(newfile)  
	  'smallimg= newfile
	End Function

	Function waterMarkImg(saveImgPath)
		On Error Resume Next
		if waterMark=0 then exit function
		if saveImgPath="" then exit function
		dim Logobox,ImageWidth,ImageHeight,ImageMode,LogoPath,oldwidth,oldheight,maxwidth,maxheight
		dim sAllowMarkExt:sAllowMarkExt = ".jpg,.png,.gif,.jpeg,.bmp"
		If InStr(sAllowMarkExt, Mid(saveImgPath, InStrRev(saveImgPath, "."), Len(saveImgPath))) = 0 Then Exit Function
		If Not isObjInstalled("Persits.Jpeg") Then exit function
		dim jpegObj,jpegdate
		set jpegObj = Server.CreateObject("Persits.Jpeg")	
		jpegdate=jpegObj.Expires
	    if datediff("d",sqltime,jpegdate)<0 then die "您的aspjpeg组件已过期，建议请关闭缩略图功能，到期时间"&jpegdate : exit function
		jpegObj.Open setfolder(saveImgPath)
		If jpegObj is nothing then exit function	
		if jpegObj.width <200 or jpegObj.height<200 then exit function
		oldwidth	=	cint(jpegObj.OriginalWidth)
		oldheight	=	cint(jpegObj.Originalheight)
		maxwidth	=	cint(markPicWidth)
		maxheight	=	cint(markPicHeight)
		if maxwidth > 500 then
		  if oldwidth > maxwidth then 
			  jpegObj.Height = cint((maxwidth / oldwidth) * oldheight)
			  jpegObj.Width = maxwidth
		  end if
		end if
		if maxheight> 500 then
		  if oldheight > maxheight then 
			  jpegObj.Width = cint((maxheight / oldheight) * oldwidth)
			  jpegObj.Height = maxheight
		  end if
		End If	
		'echop maxwidth&maxheight&"<br>"&oldwidth&oldheight&"<br>"&jpegObj.Width&jpegObj.Height
		dim location : location=waterMarkLocation
	 if waterType = 0 then  '文字水印		
	 	if isnul(waterMarkFont) then  exit function
	 	dim strWidth,strHeight,MyJpeg,TextLogo,fontsize,fontlen
			fontlen=lenstr(waterMarkFont)
			fontsize=cint(jpegObj.width /fontlen )
			strWidth=(fontsize*fontlen)/2.6
			strHeight=fontsize
			jpegObj.Canvas.Font.Color = &HEEEEEE ' 颜色,这里是设置成:黑 
			jpegObj.Canvas.Font.Family = "微软雅黑"  ' 设置字体 
			jpegObj.Canvas.Font.Bold = True '是否设置成粗体
			jpegObj.Canvas.Font.Quality = 10 ' 文字清晰度					
			jpegObj.Canvas.Font.ShadowColor = &H000000
			jpegObj.Canvas.Font.ShadowXOffset = 0
			jpegObj.Canvas.Font.ShadowYOffset = 0
			jpegObj.Canvas.Brush.Solid = True		
			jpegObj.Canvas.Font.Size = fontsize		
			select case location
			  case "1" : jpegObj.Canvas.Print 5 , strHeight, waterMarkFont
			  case "2" : jpegObj.Canvas.Print (jpegObj.width-strWidth) / 2, strHeight, waterMarkFont
			  case "3" : jpegObj.Canvas.Print jpegObj.width-strWidth-5, strHeight, waterMarkFont
			  case "4" : jpegObj.Canvas.Print 5 , (jpegObj.height-strHeight)/2, waterMarkFont
			  case "5" : jpegObj.Canvas.Print (jpegObj.width-strWidth) / 2, (jpegObj.height-strHeight)/2, waterMarkFont
			  case "6" : jpegObj.Canvas.Print jpegObj.width-strWidth-5, (jpegObj.height-strHeight)/2, waterMarkFont
			  case "7" : jpegObj.Canvas.Print 5 , jpegObj.height-40, waterMarkFont
			  case "8" : jpegObj.Canvas.Print (jpegObj.width-strWidth) / 2, jpegObj.height-40, waterMarkFont
			  case else : jpegObj.Canvas.Print jpegObj.width-strWidth-5, jpegObj.height-40, waterMarkFont
			end select		
			jpegObj.Quality = 80 
			jpegObj.Sharpen 1, 120
			jpegObj.Save Server.MapPath(saveImgPath)    ' 保存文件
	  else '图片水印
	  	if isnul(waterMarkPic) then  exit function
		   Set Logobox = Server.CreateObject("Persits.Jpeg")
			  LogoPath = Server.MapPath(waterMarkPic)
			  Logobox.Open LogoPath
		   If jpegObj.Width<Cint(Logobox.Width)*2 or jpegObj.height<Cint(Logobox.Height)*2 Then
			   Set jpegObj = Nothing
			   Exit Function
		   Else
			  jpegObj.Canvas.Pen.Width  = 1   
			  jpegObj.Canvas.Brush.Solid = False
			  if GetFileExt(waterMarkPic)="png" then
			   select case location
				  case "1" : jpegObj.Canvas.DrawPNG 5 ,5, LogoPath
				  case "2" : jpegObj.Canvas.DrawPNG (jpegObj.width-Logobox.Width) / 2, 5, LogoPath
				  case "3" : jpegObj.Canvas.DrawPNG jpegObj.width-Logobox.Width-5, 5, LogoPath
				  case "4" : jpegObj.Canvas.DrawPNG 5 , (jpegObj.height-Logobox.Height)/2, LogoPath
				  case "5" : jpegObj.Canvas.DrawPNG (jpegObj.width-Logobox.Width) / 2, (jpegObj.height-Logobox.Height)/2, LogoPath
				  case "6" : jpegObj.Canvas.DrawPNG jpegObj.width-Logobox.Width-5, (jpegObj.height-Logobox.Height)/2, LogoPath
				  case "7" : jpegObj.Canvas.DrawPNG 5 , jpegObj.height-Logobox.Height-5, LogoPath
				  case "8" : jpegObj.Canvas.DrawPNG (jpegObj.width-Logobox.Width) / 2, jpegObj.height-Logobox.Height-5, LogoPath
				  case else : jpegObj.Canvas.DrawPNG jpegObj.width-Logobox.Width-5, jpegObj.height-Logobox.Height-5, LogoPath
			   end select
			  else
			    Logobox.Width=iif(jpegObj.Width/4<100,100,jpegObj.Width/4)
				Logobox.height=Logobox.Originalheight* Logobox.Width/Logobox.OriginalWidth
			   select case location
				  case "1" : jpegObj.Canvas.DrawImage 5 ,5, Logobox,markPicAlpha
				  case "2" : jpegObj.Canvas.DrawImage (jpegObj.width-Logobox.Width) / 2, 5, Logobox,markPicAlpha
				  case "3" : jpegObj.Canvas.DrawImage jpegObj.width-Logobox.Width-5, 5, Logobox,markPicAlpha
				  case "4" : jpegObj.Canvas.DrawImage 5 , (jpegObj.height-Logobox.Height)/2, Logobox,markPicAlpha
				  case "5" : jpegObj.Canvas.DrawImage (jpegObj.width-Logobox.Width) / 2, (jpegObj.height-Logobox.Height)/2, Logobox,markPicAlpha
				  case "6" : jpegObj.Canvas.DrawImage jpegObj.width-Logobox.Width-5, (jpegObj.height-Logobox.Height)/2, Logobox,markPicAlpha
				  case "7" : jpegObj.Canvas.DrawImage 5 , jpegObj.height-Logobox.Height-5, Logobox,markPicAlpha
				  case "8" : jpegObj.Canvas.DrawImage (jpegObj.width-Logobox.Width) / 2, jpegObj.height-Logobox.Height-5, Logobox,markPicAlpha
				  case else : jpegObj.Canvas.DrawImage jpegObj.width-Logobox.Width-5, jpegObj.height-Logobox.Height-5, Logobox,markPicAlpha
			   end select
			  end if
			  jpegObj.Quality = 80 '图片输出质量100为最佳
			  jpegObj.Sharpen 1, 120
			  jpegObj.Save Server.MapPath(saveImgPath)  
		   End If
		  Set Logobox=Nothing	
	  end if
	  set jpegObj=Nothing
	End Function
	
	function DateFormat(strDate,fstr)
		if isdate(strDate) then
			dim i,temp
			temp=replace(fstr,"yyyy",DatePart("yyyy",strDate))
			temp=replace(temp,"yy",mid(DatePart("yyyy",strDate),3))
			temp=replace(temp,"y",DatePart("y",strDate))
			temp=replace(temp,"w",DatePart("w",strDate))
			temp=replace(temp,"ww",DatePart("ww",strDate))
			temp=replace(temp,"q",DatePart("q",strDate))
			temp=replace(temp,"mm",iif(len(DatePart("m",strDate))>1,DatePart("m",strDate),"0"&DatePart("m",strDate)))
			temp=replace(temp,"dd",iif(len(DatePart("d",strDate))>1,DatePart("d",strDate),"0"&DatePart("d",strDate)))
			temp=replace(temp,"hh",iif(len(DatePart("h",strDate))>1,DatePart("h",strDate),"0"&DatePart("h",strDate)))
			temp=replace(temp,"nn",iif(len(DatePart("n",strDate))>1,DatePart("n",strDate),"0"&DatePart("n",strDate)))
			temp=replace(temp,"ss",iif(len(DatePart("s",strDate))>1,DatePart("s",strDate),"0"&DatePart("s",strDate)))
			DateFormat=temp
		else
			DateFormat=false
		end if
	end function

	public function clearFileCache(byval cachePath)
		on error resume next
		dim file,fso,folder,mapPath,subFolder
		mapPath    = serverMapPath(sitePATH & cachePath)
		set fso    = objectFSO
		set folder = getFolder(mapPath)
		for each subFolder in folder.subFolders
			call deleteFolder(ABSPath(cachePath & subFolder.name))
		next
		for each file in folder.files
			call deleteFile(ABSPath(cachePath & file.name))
		next
		if err then
			clearFileCache = false
		else
			clearFileCache = true
		end if
	end function
	public function clearTplCache()
		dim result : result = false
		if clearFileCache(pcTplCachePath) then
			result = clearFileCache(mobTplCachePath)
		end if
		clearTplCache = result
	end function
	public function clearHtmlCache()
		dim result : result = false
		if clearFileCache(pcHtmlCachePath) then
			result = clearFileCache(mobHtmlCachePath)
		end if
		clearHtmlCache = result
	end function
	public function clearSysCache()
		dim result : result = false
		result = clearFileCache(sysCachePath)
		clearSysCache = result
	end function
	
	public function getRamCache(byval cacheName)
		dim cacheData
		on error resume next
		cacheName = lcase(cacheFlag & cacheName)
		cacheData = application(cacheName)
		if isArray(cacheData) then
			if isObject(cacheData(0)) then
				set getRamCache = cacheData(0)
			else
				getRamCache = cacheData(0)
			end if
		end If
		if err.number<>0 then err.clear
	end function 
	
	public function saveRamCache(byval cacheName,byval cacheValue)
		on error resume next
		dim cacheData
		cacheName = lcase(cacheFlag & cacheName)
		cacheData = application(cacheName)
		if isArray(cacheData) then
			if isObject(cacheValue) then set cacheData(0)=cacheValue else cacheData(0)=cacheValue
			cacheData(1) = SYS_TIME
		else
			redim cacheData(1)
			if isObject(cacheValue) then set cacheData(0)=cacheValue else cacheData(0)=cacheValue
			cacheData(1) = SYS_TIME
		end if
		application.lock
		application(cacheName)= cacheData
		application.unLock
		if err.number<>0 then err.clear
	end function
	public function ramCheckCache(byval cacheName)
		on error resume next
		dim cacheData,result
		result    = false
		cacheName = lcase(cacheFlag & cacheName)
		cacheData = application(cacheName)
		if not isArray(cacheData) then ramCheckCache = false : exit function
		if dateDiff("s",cDate(cacheData(1)),now()) < (cacheTime*60) then
			result = true
		end If
		if err.number<>0 then err.clear
		ramCheckCache = result
	end function
	public sub clearRamCache(byval cacheName)
		cacheName = lcase(cacheFlag & cacheName)
		application.lock
		application(cacheName) = empty
		application.unLock
	end sub
	public function clearAllRamCache()
		on error resume next
		application.lock()
		application.contents.removeAll()
		application.unLock()
		if err.number<>0 then
			err.clear
			clearAllRamCache = false
		else
			clearAllRamCache = true
		end if
	end function

	public function showAllRamCache()
		dim app
		for each app in application.Contents

			echo app &"<br>"
		next
		'call clearAllRamCache()
	end function
	public function getRamCacheNum()
		getRamCacheNum = application.contents.count
	end function
	public function createCacheNum()
		createCacheNum = iCreateCacheNum
	end function
	public function clearOtherCache()
		dim i,appl,num
		num = getRamCacheNum - iCacheNum
		i = 0
		for each appl in application.Contents
			application.Lock()
			application.contents.remove(appl)
			application.UnLock()
			i = i + 1
			if i = num then exit for
		next
	end function

Class XmlClass
	Public xmlDocument,xmlPath,xmlDomObj,xmlstr
	Private xmlDomVer,xmlFileSavePath

	Public Sub Class_Initialize()
		xmlDomVer=getXmlDomVer()
		createXmlDomObj
	End Sub

	Public Sub Class_Terminate()
		If IsObject(xmlDomObj) Then Set xmlDomObj=Nothing
	End Sub

	Public Function getXmlDomVer()
		dim i,xmldomVersions,xmlDomVersion
		getXmlDomVer=false
		xmldomVersions=Array("Microsoft.2MLDOM","MSXML2.DOMDocument","MSXML2.DOMDocument.3.0","MSXML2.DOMDocument.4.0","MSXML2.DOMDocument.5.0")
		for i=0 to ubound(xmldomVersions)
			xmlDomVersion=xmldomVersions(i)
			if isObjInstalled(xmlDomVersion) then getXmlDomVer=xmlDomVersion : Exit Function
		next
	End Function

	Private Sub createXmlDomObj
		set xmlDomObj=server.CreateObject(xmlDomVer)
		xmlDomObj.validateonparse=true 
		xmlDomObj.async=false 
	End Sub

	Public Function load(Byval xml,Byval xmlType)
		dim xmlUrl,xmlfilePath
		select case xmlType 
			case "xmlfile"
				xmlfilePath=server.mappath(xml)   
		 		xmlDomObj.load(xmlfilePath)   
			case "xmldocument"
				xmlUrl=xml
				xmlstr=getRemoteContent(xmlUrl,"text")
				If left(xmlstr, 5) <> "<?xml" then die err_xml else xmlDomObj.loadXML(xmlstr)
			case "transfer"
				xmlUrl=xml
				xmlstr=bytesToStr(getRemoteContent(xmlUrl,"body"),"gbk")
				If left(xmlstr, 5) <> "<?xml" then die err_xml else xmlDomObj.loadXML(xmlstr)
		end select
	End Function

	Public Function isExistNode(nodename)
        dim node
        isExistNode=True
        set node=xmlDomObj.getElementsByTagName(nodename)
        If node.Length=0 Then isExistNode=False : set node=nothing
    End Function

	Public Function getNodeValue(nodename, itemId)
	on error resume next
		if isNul(itemId) then  itemId=0
		getNodeValue=xmlDomObj.getElementsByTagName(nodename).Item(itemId).Text
	End Function

	Public Function getNodeLen(nodename)
		getNodeLen=xmlDomObj.getElementsByTagName(nodename).Length
	End Function
	
	Public Function getNodes(nodename)
		Set getNodes=xmlDomObj.getElementsByTagName(nodename)
	End Function
	
	Public Function getNode(nodename, itemId)
		Set getNode=xmlDomObj.getElementsByTagName(nodename).Item(itemId)
	End Function

	Public Function getAttributes(nodeName, attrName, itemId)
	dim xmlAttributes, i
		if isNul(itemId) then  itemId=0
		err.clear:on error resume next
		getAttributes=xmlDomObj.getElementsByTagName(nodeName).Item(itemId).getAttributeNode(attrName).nodevalue
		if err then getAttributes="":err.clear
	End Function

	Public Function getAttributesByNode(node, attrName)
		err.clear:on error resume next
		getAttributesByNode=node.getAttributeNode(attrName).nodevalue
		if err then getAttributesByNode="":err.clear
	End Function

	Public Function setXmlNodeValue(Byval nodename, Byval itemId, Byval str,Byval savePath)
	dim node
		xmlFileSavePath=savePath
		Set node=xmlDomObj.getElementsByTagName(nodename).Item(itemId)
		node.childNodes(0).text=str
		xmlDomObj.save Server.MapPath(xmlFileSavePath)
		set node=nothing
	End Function
End Class
%>