'此脚本以32位方式运行，此脚本需要一些高级权限，如shell
'本脚本中的参数，需要运行[建站助手]计划任务中配置，计划任务名为iistool_usertask

Dim iisVersion,isNewIIS,strComputer,Softpath,syslogfile,sysmdbfile
Dim fso,sysdays,system32 : init : GetAllSystemVar

WriteLog "iistool_usertask BEGIN..."

If isopt_backiis="1" Then
	Call startBackiis()
End If

If isopt_backmysql="1" Then
	Call startBackmysql(rate_backmysql,isopt_dumpmysql)
End If

If isopt_backmssql="1" Then
	Call startBackmssql(rate_backmssql,isopt_sharkmssql)
End If

Set sitedic = GetLocalDataDic("host")
For Each sysid In sitedic.keys
	intid = Int(sysid)
	If 1=1 or (sysid Mod rate_backwww)=(sysdays Mod rate_backwww) Then
		sitename = sitedic(sysid)
		writelog "备份网站 " & sitename
		If isopt_backwww="1" Then Call startBackwww(sitename)
		If isopt_scanmuma="1" Then Call startScanMuma(sitename ,(isopt_scancache="1"))
		If isopt_clearwwwlog="1" Then Call startClearwwwlog(sitename,rate_clearwwwlog)
	End If
Next

If isopt_runclearbat="1" Then
	Call ClearTempFile(rate_runclearbat)
End If

Call everydayclearback()

WriteLog "iistool_usertask END..."









Sub everydayclearback()
	Dim oFolders, oFolder, oFile
	If rate_backiis_keep>0 Then
		Set oFolders = fso.getfolder("E:\bkup\config")
		For Each oFolder In oFolders.subfolders
			If InStr(ofolder.name,"iisback_")=1 Then
				If DateDiff("d",ofolder.DateCreated,Date)>CLng(rate_backiis_keep) Then
					WScript.Echo "删除 " & ofolder.Path
					Call ofolder.Delete(True)			
				End If
			End If
		Next
	End If

	If rate_backmysql_keep>0 Then
		Set oFolder = fso.getfolder("E:\bkup\mysql")
		For Each oFile In oFolder.Files
			If InStr(oFile.Name,"_" & Year(Date))>0 And Right(ofile.Name,4)=".sql" Then
				If DateDiff("d",oFile.DateCreated,Date)>CLng(rate_backmysql_keep) Then
					WScript.Echo "删除 " & oFile.Path
					Call oFile.Delete(True)
				End If
			End If
		Next
	End If

	If rate_backmssql_keep>0 Then
		Set oFolder = fso.getfolder("E:\bkup\mssql")
		For Each oFile In oFolder.Files
			If InStr(oFile.Name,"_" & Year(Date))>0 And Right(ofile.Name,4)=".bak" Then
				If DateDiff("d",oFile.DateCreated,Date)>CLng(rate_backmssql_keep) Then
					WScript.Echo "删除 " & oFile.Path
					Call oFile.Delete(True)
				End If
			End If
		Next
	End If
End Sub

Sub startScanMuma(sitename,isscancache)
	webroot = GetHostVar(sitename,"s_webroot")
	webroot = webroot & "\wwwroot"
	If Not fso.FolderExists(webroot) Then Exit Sub
	Dim muma : Set muma=New scanmuma_class
	'muma.virfile="_"
	muma.scanpath = webroot
	muma.isscancache = isscancache
	muma.start
	WScript.Echo muma.errstr
End Sub

Function startClearwwwlog(sitename,rateday)
	If Not IsNumeric(rateday & "") Then rateday = 3 Else rateday = CLng(rateday)'3天前的
	Dim siteid,logfolder,oFiles,ofile
	siteid = GetHostVar(sitename,"s_siteid")
	logfolder = weblogpath & "\W3SVC" & siteid
	If Not fso.FolderExists(logfolder) Then Exit Function

	Set oFiles = fso.GetFolder(logfolder).Files
	For Each ofile In oFiles
		If DateDiff("d", ofile.DateCreated, Date)> CLng(rateday) Then
			Call ofile.Delete
		End If
	Next
End Function

Function ClearTempFile(rate)
	If sysdays Mod rate<>0 Then Exit Function
	file1 = Softpath & "\rewrite\cleartemp.bat"
	If Not fso.FileExists(file1) Then Exit Function
	WriteLog "运行cleartemp.bat"
	shell file1, False
End Function

Function startBackmssql(rate,isShark)
	If sysdays Mod rate<>0 Then Exit Function
	Dim objdic,sysid,dbname,toFile
	If Not MkDir_("E:\bkup\mssql") Then Exit Function

	Set objdic = GetLocalDataDic("mssql")
	WriteLog IIF(isShark,"开始备份并收缩mssql","开始备份mssql")
	'如果目录无sqluser权限将会失败
	For Each sysid In objdic.keys
		dbname = objdic(sysid)
		WriteLog "--> " & dbname
		toFile = "E:\bkup\mssql\" & dbname & "_" & GetIntDay() & ".bak"
		ExecMssql "BACKUP DATABASE [" & dbname & "] TO DISK = '" & toFile & "' with init"
		If isShark Then	
			ExecMssql "ALTER DATABASE [" & dbname & "] SET RECOVERY SIMPLE" & vbCrLf &_
		"USE [" & dbname & "];DBCC SHRINKFILE(N'" & dbname & "_data',0);DBCC SHRINKFILE(N'" & dbname & "_log',0)" & vbCrLf &_
		"ALTER DATABASE [" & dbname & "] SET RECOVERY Full"
		End If
	Next
	WriteLog "mssql备份完成"
End Function

Function testmysqlroot(ipath, strPwd)
	testmysqlroot=False
	Dim cmdline
	cmdline = ipath & "\bin\mysql.exe" & " -uroot -p" & strPwd
    cmdline = cmdline & " -e""use mysql;"""
    If DosRun(cmdline) = "" Then testmysqlroot = True
End Function

Function startBackmysql(rate,isDump)
	If sysdays Mod rate<>0 Then Exit Function
	Dim objdic,sysid,dbname,toFile
	If Not MkDir_("E:\bkup\mysql") Then Exit Function
	Set objdic = GetLocalDataDic("mysql")
	WriteLog IIF(isDump,"开始备份并导出mysql","开始备份mysql")
	
	basedir  = GetSystemVar("mysqlpath")'mysql安装路径
	rootpass = GetSystemVar("rootpass")	'mysql root密码
	datadir = basedir & "\data"
	If Not fso.FolderExists(datadir) Then
		WriteLog "MYSQL目录错误，请到助手的系统配置中设置"
		Exit Function
	End If
	If Not testmysqlroot(basedir,rootpass) Then
		WriteLog "MySQL Root密码测试无效，请到助手的系统配置中设置"
		Exit Function
	End If

	For Each sysid In objDic.keys
		dbname = objDic(sysid)
		WriteLog "-=> " & dbname
		toFolder = "E:\bkup\mysql\" & dbname
		exedump  = basedir & "\bin\mysqldump.exe"
		dumpfile = "E:\bkup\mysql\" & dbname & "_" & GetIntDay() & ".sql"
		ssFolder = datadir & "\" & dbname
		
		If fso.FolderExists(ssFolder) Then
			Call CopyFolder(ssFolder,toFolder & "\")
			If isDump Then
				shell "cmd /c " & exedump & " -uroot -p" & rootpass & " " & dbname & ">" & dumpfile,True
			End If
		Else
			WriteLog "无此数据库"
		End If
	Next
	WriteLog "mysql备份完成"
End Function

Function startBackiis()
	WriteLog "开始备份iis配置"
	Const bkName = "iisback"
	toFoler = "E:\bkup\config\" & bkName & "_" & GetIntDay()
	If Not MkDir_(toFoler) Then Exit Function
    If Not isNewIIS Then
        Set w3svc = GetObject("IIS://" & strComputer)
        w3svc.BackupWithPassword bkName, 0, 3, bkName
        Set w3svc = Nothing
		backupdir = system32 & "\inetsrv\MetaBack"        
        file1 = backupdir & "\" & bkName & ".SC0"
        file2 = backupdir & "\" & bkName & ".MD0"
        If fso.FileExists(file1) And fso.FileExists(file2) Then
            Call CopyFileTo(file1, toFoler)
            Call CopyFileTo(file2, toFoler)
        End If
        file1 = toFoler & "\" & bkName & ".SC0"
        file2 = toFoler & "\" & bkName & ".MD0"
    Else
	    regiis = "C:\Windows\Microsoft.NET\Framework\v4.0.30319\aspnet_regiis.exe"
	    If Not fso.FileExists(regiis) Then regiis = "C:\Windows\Microsoft.NET\Framework\v2.0.50727\aspnet_regiis.exe"
	    
	    If fso.FileExists(regiis) Then
	    	file1 = toFoler & "\" & bkName & "_a.xml"
	        file2 = toFoler & "\" & bkName & "_b.xml"
			shell regiis & " -px iisConfigurationKey """ & file1 & """ -pri", True
			shell regiis & " -px iisWasKey """ & file2 & """ -pri", True
		End If
	
        shell "c:\windows\system32\inetsrv\appcmd.exe delete backup " & bkName, True
        shell "c:\windows\system32\inetsrv\appcmd.exe add backup " & bkName, True
        backupdir = system32 & "\inetsrv\backup\" & bkName
        shell "attrib -h -s -r /s /d " & backupdir & "\*", True
        Call CopyFolder(backupdir, toFoler)
        file1 = toFoler & "\applicationHost.config"
        file2 = toFoler & "\administration.config"
    End If
    
	regpath = "HKEY_LOCAL_MACHINE\SOFTWARE\Cat Soft\Serv-U"
	'if isnewiis then regpath=replace(regpath,"SOFTWARE\","SOFTWARE\Wow6432Node\")
	regfile = toFoler & "\servu.reg"
	shell "Regedit /e """ & regfile & """ """ & regpath & """",False

	If fso.FileExists( file1) And fso.FileExists(file2) Then startBackiis=True 
	WriteLog "iis备份完成"
End Function

Function startBackwww(sitename)
	Dim webroot
	webroot = GetHostVar(sitename,"s_webroot")
	If not fso.FolderExists(webroot) Or Not fso.FolderExists("E:\bkup\wwwroot") Then
		'WriteLog "网站路径不存在"
		Exit Function
	End If
	toFolder = "E:\bkup\wwwroot\" & sitename
	Call CopyFolder(webroot, toFolder & "\")
End Function



















Function GetConn(tp)
	On Error Resume Next : Err.Clear
	Dim Conn,constr :Set Conn = WScript.CreateObject("ADODB.Connection") 
	If tp="" Or tp="sys" Then
		constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sysmdbfile & ";Persist Security Info=False;Jet OLEDB:Database Password="
	ElseIf tp="mssql" Or tp="(local)" Then
		constr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=master;Data Source=."
	End If
	Conn.Open constr
	Set GetConn = Conn
	Set Conn = Nothing 
	If Err.Number<>0 Then WriteLog "中止，无法打开数据库" & Err.Description : Set GetConn = Nothing
End Function

Sub WriteLog(strng)
	WScript.Echo strng
	Dim f :	Set f=fso.OpenTextFile(syslogfile,8,True)
	f.WriteLine Now & Chr(9) & strng
	f.Close
End Sub

Sub die(strng)
	WScript.Echo strng
	WScript.Quit
End Sub

Sub init
	Set fso = CreateObject("scripting.filesystemobject")
	system32 = "c:\windows\system32"
	sysdays = DateDiff("d","2015-1-1",Date)
	iisVersion = fso.GetFileVersion(system32 & "\inetsrv\inetmgr.exe")
	isNewIIS = (CLng(Left(iisVersion,1))>6)
	strComputer = CreateObject("wscript.network").ComputerName
	Softpath = GetRegedit("SOFTWARE\iistool","softpath")
	If Softpath="" Then Softpath="D:\SOFT_PHP_PACKAGE"
	syslogfile = Softpath & "\rewrite\usertask_" & Year(Now) & Right("0" & Month(Date),2) & ".log"
	sysmdbfile = Softpath & "\iistool4.mdb"
	If isNewIIS Then system32=Replace(system32,"system32","sysNative")
End Sub

Function GetRegedit(keypath,valname)
	Dim oreg,retValue
	Const HKEY_LOCAL_MACHINE=&H80000002
	Set oReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
	oreg.GetStringValue HKEY_LOCAL_MACHINE, keypath, valname, retValue
	GetRegedit = retValue & ""
End Function

Sub GetAllSystemVar()
	Dim trs,varname,varValue,conn
	Set conn=GetConn("")
	if conn is nothing then writelog "无法连接数据库":exit sub
	Set trs = conn.Execute("select varname,varvalue from variable where varname like 'isopt_%' or varname like 'rate_%' or varname='weblogpath'")
	While Not trs.EOF
		varname = trs("varname")
		varValue = trs("varvalue")
		Execute varname & "=varValue"
		trs.MoveNext
	Wend
	conn.close
End Sub

Function GetSystemVar(varname)
	Dim trs,conn
	Set conn = GetConn("")
	Set trs = conn.Execute("select varname,varvalue from variable where varname='" & varname & "'")
	If Not trs.EOF Then GetSystemVar = trs("varvalue")
	conn.close
End Function

Function GetHostVar(sitename,varname)
	Dim trs,conn
	Set conn = GetConn("")
	Set trs=conn.Execute("select " & varname & " from siteinfo where s_sitename='" & sitename & "'")
	If Not trs.EOF Then GetHostVar = trs(0)
	conn.close
End Function

Function GetLocalDataDic(itype)
	Dim oDic,sql,trs,varname,varvalue,conn
	Set oDic = CreateObject("scripting.dictionary")
	Select Case itype
		Case "host"  : sql = "select s_id,s_sitename from siteinfo"
		Case "mssql" : sql = "select m_id,m_dbname from mssqlinfo"
		Case "mysql" : sql = "select m_id,m_sqlname from mysqlinfo"
	End Select
	If sql<>"" Then	
		Set conn = GetConn("")
		Set trs = conn.Execute(sql)
		While Not trs.EOF
			varname = trs(0)
			varValue = trs(1)
			oDic.Add varname,varValue
			trs.MoveNext
		Wend
	End If
	Set GetLocalDataDic = oDic
	conn.close
End Function

Function IIF(express, rYes, rNo)
	IIF = rNo
	If VarType(express)=11 Or VarType(express)=8 Or CStr(express)="True" Then
		If express Then IIF=rYes
	End If
End Function

Function shell(strCmd,iswait)
	Dim WshShell : Set WshShell = CreateObject("wscript.Shell")
	rethwd= WshShell.Run(strcmd,1,iswait)
	Set WshShell =Nothing 
	shell = (rethwd=0)
End Function

Function ExecMssql(sql)
	On Error Resume Next : Err.Clear
	Dim conn : Set conn = GetConn("mssql")
	If Not (conn Is Nothing) Then
		conn.Execute(sql)
		conn.Close
	End If
	If Err.Number<>0 Then WriteLog Err.Description
	ExecMssql = (Err.Number=0)
End Function

Function DosRun(strCmd)
	Dim WshShell, f
	set WshShell = CreateObject("wscript.Shell")
	Set f = WshShell.Exec(strCmd)
	DosRun = f.StdOut.ReadAll
	Set WshShell=Nothing
End Function

Function GetIntDay()
	GetIntDay=Year(Now) & Month(Now) & Day(Now)
End Function

Function CopyFileTo(ifile,savedir)
    If Not MkDir_(savedir) Then Exit Function
    fso.CopyFile ifile,savedir & Mid(ifile, InStrRev(ifile, "\")),True
    CopyFileTo = True
End Function

Function CopyFolder(iFolder,toFoler)
	shell "xcopy.exe " & iFolder & " " & toFoler & " /D /E /C /Q /H /R /Y",True
End Function

Function regTest(byval strng,byval patng)
	Dim oreg : Set oreg=New RegExp
	oreg.Global=True : oreg.IgnoreCase=True
	oreg.Pattern=patng : regTest=oreg.Test(strng)
	Set oreg=nothing
End Function

Function MkDir_(strpath)
	Dim P,i,nowpath : On Error Resume Next
    strpath = Replace(Replace(strpath, "/", "\"), "\\", "\")
    If Right(strpath, 1) = "\" Then strpath = Left(strpath, Len(strpath) - 1)
    If InStr(strpath, "..") > 0 Then Exit Function
    P = Split(strpath, "\")
    For i = 0 To UBound(P)
        nowpath = nowpath & CStr(P(i)) & "\"
        If Not fso.FolderExists(nowpath) Then fso.CreateFolder (nowpath)
    Next
    MkDir_ = (Err.Number=0)
End Function

Function ReadFile(sFile)
	Dim f : On Error Resume Next
	If fso.FileExists(sFile) Then
		Set f=fso.OpenTextFile(sFile,1,False)
		ReadFile = f.ReadAll
		f.Close
	End If
End Function


Function GetFileCounts(strpath,scansub,byref filecount)
	Dim folder
	Set folder=fso.GetFolder(strpath)
	filecount=filecount + folder.Files.Count
	If scansub Then
		For Each f In folder.SubFolders
			Call GetFileCounts(f.Path,scansub,filecount)
		Next
	End If
	Set folder=Nothing
	GetFileCounts=filecount
End Function


Class scanmuma_class
	Dim virfile,scanpath,isscancache
	Dim errstr
	Dim FileExts,  FileMaxsize, missfile, FileDeep, curDeep, curCount, maxCount, KeyWords
	
	Private Sub Class_Initialize
		FileExts = Array("php","asp","aspx")
		FileMaxsize = 300	'kb
		missfile = "west.txt"
		FileDeep = 7
		curDeep  = 0
		curCount = 0
		maxCount = 50000
		virfile = Softpath & "\rewrite\virus_Code.txt"
		isscancache = false
	End Sub

	Function start()
		Dim objDir
		KeyWords = ReadKeyWords(virfile)
		If UBound(KeyWords)<=0 Then
			errstr = "没有病毒关键字"
			WriteLog errstr & ";" & virfile
			Exit Function
		End If
		If scanpath="" Or Not fso.FolderExists(scanpath) Then
			errstr = "请设置正确扫描路径"
			Exit Function
		End If 

		Set objDir = fso.GetFolder(scanpath)
 		If fso.FileExists(objDir.Path & "\" & missfile) Then
 			errstr = "本站已设置忽略"
 			Exit Function
 		End If

		Call doCheck(objDir)
 		Call digui(objDir)
	End Function
	
	Sub doCheck(objDir)
		Dim oFile, strFile, strName
		
		If curCount>=maxcount Then
			WScript.Echo "超过最大文件扫描总数，退出" & objDir.Path
			Exit Sub
		'ElseIf curDeep>=FileDeep Then
		'	WScript.Echo "目录结构超过" & curdeep & "层，退出" & objDir.path
		'	Exit Sub
		ElseIf fso.FileExists(objDir.Path & "\" & missfile) Then
			WScript.Echo "发现排除文件，退出" & objDir.path
			Exit Sub
		End If
		
		Call ScanDotobject(objDir.path)

		For Each oFile In objDir.Files
 			If oFile.Size<=FileMaxsize*1000 And oFile.Size>1 Then
 				strFile = oFile.Path
				strName = LCase(oFile.Name)
 				If inArray(FileExts, LCase(fso.GetExtensionName(strFile))) Or strName="index.html" Or strName="index.htm" Then
					curCount = curCount+1
					Set ts = oFile.OpenAsTextStream(1)
					strbody = ts.ReadAll
					If findKeybody(strbody,KeyWords,badword) Then
						WriteLog "病毒文件 " & strFile
						Call ClonVirfile(oFile)				
					End If
				End If
			End If
		Next
	End Sub
	
 	Private Sub digui(objDir)
 		Dim oFolder
 		
 		If curCount>=maxcount Then
			WScript.Echo "超过最大文件扫描总数，退出" & objDir.Path
			Exit Sub
		ElseIf curDeep>=FileDeep Then
			WScript.Echo "目录结构超过" & curdeep & "层，退出" & objDir.path
			Exit Sub
		'ElseIf fso.FileExists(objDir.Path & "\" & missfile) Then
		'	WScript.Echo "发现排除文件，退出" & objDir.path
		'	Exit Sub
		End If
		
 		For Each oFolder In objDir.SubFolders
 			Call doCheck(oFolder)
			curDeep = curDeep+1
 			Call digui(oFolder)
			curDeep = curDeep-1
 		Next
	End Sub
	
	Private Function findKeybody(byval strbody,arr,ByRef badword)
		Dim strkey : badword="" : findKeybody=False : strbody=LCase(strbody)
		If InStr(strbody,"防误杀")>0 or InStr(strbody,"探针")>0 Then
			Exit Function			'忽略此文件检查
		End If
		For Each strkey In arr
			If strkey<>"" And InStr(strbody,LCase(strkey))>0 Then
				findKeybody = True
				badword = strkey	'找到一个关键字就退
				Exit For
			End If
		Next
	End Function
	
	Private Function inArray(arr,str)
		Dim str1 : inarray = False
		For Each str1 In arr
			If str1=str Then
				inarray = True
				Exit Function
			End If
		Next
	End Function

	Function haveDotName(byval filename,byref oType)
		'oType返回有 1带点文件 2命令空间 0普通文件夹 3禁用的字符
		If Right(filename,1)="." Then 
			oType=1
		ElseIf regTest(filename,"^\s+$") Or Right(filename,1)=" " Then
			oType=0
		ElseIf regTest(filename,"[\/|\:|\*|\?|\""|\<|\>|\|]") Then
			oType=3
		ElseIf regTest(filename,"(^|\\)((lpt|com)\d|(aux|nul|con|prn))($|\.)") Then
			oType=2
		Else
			haveDotName = False : Exit Function
		End If
		haveDotName = True
	End Function

	
	Sub ScanDotobject(byVal strPath)
		Dim shellApp : Set shellApp = CreateObject("shell.application")
		Set oItems=shellApp.NameSpace(strPath).Items
		If right(strPath,1) <> "\" Then strPath = strPath & "\"
		
		For Each oItem In oItems
			strName=lcase(oItem.name)
			If oItem.IsFolder And Right(LCase(strName),4)<>".zip" Then			
				If haveDotName(strName,oType) Then
					WriteLog "删除异常目录 " & strpath
					Call deleteDot(strPath & strName & "\",1,oType)
				End If
				If isscancache Then Call doScanCache(strPath, strName)
			Else
				If haveDotName(strName,oType) Then
					WriteLog "删除异常文件 " & strpath
					Call deleteDot(strPath & strName,2,oType)
				End If
			End If
		Next
	End Sub 
	
	Sub deleteDot(byval itempath, byval arrtib,byval deltype)
		Dim cm,cmd,strcmd
		If arrtib=1 Then
			cm="rd /s /q"
		ElseIf arrtib=2 Then
			cm="del /f /q"
		Else
			Exit Sub
		End If
		If deltype=1 Then
			itempath=left(itempath,len(itempath)-1)
			If isNewIIS Then
				cmd=cm & " """ & itempath & "\"""
			Else
				cmd=cm & " """ & itempath & ".\"""
			End If
		Elseif deltype=2 Then
			cmd=cm & " ""\\.\" & itempath & """"
		Else
			cmd=cm & " """ & itempath & """"
		End If
		strCmd="cmd.exe /c " & cmd
		shell strCmd,False
	End Sub
		
	Private Function checkmorecache(byval strpath)
		checkmorecache  = false
		strpath = lcase(strpath)
		for Each spath in array("\cache\api59miao_cache","\cache\tao_cache","\temp\query_caches","\youbian\cache","\includes\cache","\data\tpl\caches","\wp-includes\cache")
			if mid(strpath,Abs(Len(strpath)-len(spath))+1) = spath then
				checkmorecache = true : exit for
			end if
		next
	End Function

	Private Sub clonVirfile(oFile)
		On Error Resume Next
		shell "attrib -h -s -r """ & oFile.Path & """",False 
		wscript.sleep 200
		oFile.Copy oFile.Path & ".bak" ,True
		Dim f : Set f=oFile.OpenAsTextStream(2)
		f.Write "<!--提示：该文件怀疑是木马程序，已经被杀毒软件自动更名. " & Now() & "-->"
		f.close
	End Sub

	Sub doScanCache(byval strPath,byval strName)
		Dim strFolder,intFile,delmsg
		strFolder = strPath & strName
		
		If InStr(strName,"cache")>0 And Not fso.fileExists(strPath & "configs\versioin.php") Then
			Call GetFileCounts(strPath, True, intfile)
			If intfile>30000 Then
				delmsg=""
				If strName="apicache" or strName="tplcache" Then
					delmsg = "del1"		
					Call shell("cmd /c del /s /q /f """ & strFolder & "\*""",False)
	
				ElseIf strName="cache" Or strName="caches" Then
					count1=0
					For Each fname In fso.GetFolder(strFolder).SubFolders
						fname=LCase(fname)
						If fname="sql" Or fname="tpl" Or fname="sys" Then count1=count1+1'临时记数
							If InStr("/youbian/sheng/thumbnails/data/_data/_sessions/", "/" & fname & "/")>0 Then
							delmsg = "del2"
							Call shell("cmd /c del /s /q /f """ & strFolder & "\" & fname & "\*""",false)
						End If
					Next
					
					If fname="" Then
						delmsg = "del3"
						Call shell("cmd /c del /s /q /f """ & strFolder & "\*""",False)
						
					ElseIf count1>=2 Then
						delmsg = "del4"
						Call shell("cmd /c del /s /q /f """ & strFolder & "\sql\*""",False)
						Call shell("cmd /c del /s /q /f """ & strFolder & "\tpl\*""",False)
						Call shell("cmd /c del /s /q /f """ & strFolder & "\sys\*""",False)
					End If
		
				ElseIf checkmorecache(strFolder) Then
					delmsg = "del5"
					Call shell("cmd /c del /s /q /f """ & strFolder & "\*""",False)
				End If
				
				If delmsg<>"" Then
					writelog "自动删除(" & delmsg & ")目录 " & strFolder & "\" & fname
				Else
					writelog "忽略多文件目录" & strFolder
				End If
			End If
		End If
	End Sub

	Private Function ReadKeyWords(vfile)
		Dim txtinfo
		txtinfo = ReadFile(vfile)
		If Right(txtinfo,2)=vbCrLf Then txtinfo=Left(txtinfo,Len(txtinfo)-2)
		ReadKeyWords = Split(txtinfo,vbCrLf)
	End Function
End Class