<%
Class Class_QingTian_FSO
	Private C_G_FSO,G_Stream
	
	Private Sub Class_Initialize()
		C_G_FSO="Scripting.FileSystemObject"
		G_Stream="adodb."&""&"stream"
	End Sub
	
	Private Sub Class_Terminate()
	End Sub
	
	'========是否支持组件================
	Function isInstallObj(objname)
		dim isInstall,obj
		On Error Resume Next
		set obj=server.CreateObject(objname)
		if Err then 
			isInstallObj=false : err.clear 
		else 
			isInstallObj=true:set obj=nothing
		end if
	End Function	

	'========获取采集的组件===============
	Function getXmlHttpVer()
		dim i,xmlHttpVersions,xmlHttpVersion
		getXmlHttpVer=false
		xmlHttpVersions=Array("Microsoft.XMLHTTP", "MSXML2.XMLHTTP", "MSXML2.XMLHTTP.3.0","MSXML2.XMLHTTP.4.0","MSXML2.XMLHTTP.5.0")
		for i=0 to ubound(xmlHttpVersions)
			xmlHttpVersion=xmlHttpVersions(i)
			if isInstallObj(xmlHttpVersion) then getXmlHttpVer=xmlHttpVersion : Exit Function
		next	
	End Function
	
	'========截取字符======================
	Function GetContent(str,start,last,n)
		If Instr(lcase(str),lcase(start))>0 and Instr(lcase(str),lcase(last))>0 then
			select case n
			case 0	'左右都截取（都取前面）（去处关键字）
			GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
			GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
			case 1	'左右都截取（都取前面）（保留关键字）
			GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
			GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
			case 2	'只往右截取（取前面的）（去除关键字） 保留右边
			GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
			case 3	'只往右截取（取前面的）（包含关键字） 保留左边
			GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
			case 4	'只往左截取（取后面的）（包含关键字）
			GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
			case 5	'只往左截取（取后面的）（去除关键字）
			GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
			case 6	'只往左截取（取前面的）（包含关键字）
			GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
			case 7	'只往右截取（取后面的）（包含关键字）
			GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
			case 8	'只往左截取（取前面的）（去除关键字）
			GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
			case 9	'只往右截取（取后面的）（包含关键字）
			GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
			end select
		Else
			GetContent=""
		End if
	End function
	
	'==========截取数组====================================
	'全部，开始，结束,分割符，替换，前缀
	Function body2s(wstr,start,over,str,tag,fstr)
		Dim start1,over1
		start1=replace(replace(replace(replace(replace(replace(start,"(","\("),")","\)"),"?","\?"),"$","\$"),"[","\["),"]","\]")
		over1=replace(replace(replace(replace(replace(over,"(","\("),")","\)"),"?","\?"),"[","\["),"]","\]")
		Set soojs = New Regexp'设置配置对象
		soojs.IgnoreCase = True'忽略大小写
		soojs.Global = True'设置为全文搜索
		soojs.Pattern =  ""&start1&"(\n|.)*?"&over1'正则表达式 
		Set Matches =soojs.Execute(wstr)'开始执行配置
		set  soojs=nothing 
		body2s=""
		For Each Match in Matches
		body2s=body2s&fstr&Match.Value&str '循环匹配
		Next
		IF tag Then
			body2s=replace(body2s,start,"")
			body2s=replace(body2s,over,"")
		End IF
	End Function	

	'===========编码重组===================
	Function bytesToStr(Byval responseBody,Byval strCharSet)
		Dim objstream
		set objstream = Server.CreateObject(G_Stream)
		with objStream
			.Type=1
			.Mode =3
			.Open
			.Write responseBody
			.Position=0
			.Type=2
			.Charset=strCharSet
			bytesToStr=objstream.ReadText
			objstream.Close
		End With
	End Function	
	
	'==============获取文件内容===============
	Function Qingtiandy_getfilecontent(EditFile)
		EditFile=Server.MapPath(EditFile)
		Dim FsoObj,FileObj,FileStreamObj
		Set FsoObj = Server.CreateObject(C_G_FSO)
		IF FsoObj.fileExists(EditFile) Then	
			Set FileObj = FsoObj.GetFile(EditFile)
			Set FileStreamObj = FileObj.OpenAsTextStream(1)
			if Not FileStreamObj.AtEndOfStream then
				Qingtiandy_getfilecontent = FileStreamObj.ReadAll
			else
				Qingtiandy_getfilecontent = ""
			end if
		Else
			Qingtiandy_getfilecontent = ""
		End IF
	End Function	
	
	'==============
	Function getRemoteContent(Byval url,Byval returnType)
		dim xmlHttpObj
		set xmlHttpObj=server.CreateObject(getXmlHttpVer())
		xmlHttpObj.open "GET",url,False 
		xmlHttpObj.send
		select case returnType
			case "text"
				getRemoteContent=xmlHttpObj.responseText
			case "body"
				getRemoteContent=xmlHttpObj.responseBody
		end select
		set xmlHttpObj=nothing
	End Function	
	
	'==============根据数组获取字符============
	
	Function Get_cj_allname(v1,str_temp,flag,tChongfu)
		Dim p_m_name_a,p_m_name_1,p_m_name_2_a,p_m_name_2_1,p_m_name_2_2
		Dim np_a,np_1,np_2
		'v1类别 str_temp采集主体 ,flag是否替换，是否去重复
		IF str_temp="" or isnull(str_temp) Then
			Get_cj_allname=""
			Exit Function
		End IF
		p_m_name_a=split(v1,Chr(10))
		For i=Lbound(p_m_name_a) To Ubound(p_m_name_a)
			p_m_name_1=p_m_name_a(i)
			p_m_name_1=replace(p_m_name_1,CHR(13),"")
			IF p_m_name_1<>"" And Not isnull(p_m_name_1)  Then
				IF Instr(p_m_name_1,"{###}")>0 Then
					np_a=split(p_m_name_1,"{###}")
					np_1=np_a(0)
					np_2=np_a(1)
					p_m_name_1=np_2
					p_m_name_2_a=split(p_m_name_1,"{!!!}")
					p_m_name_2_1=p_m_name_2_a(0)
					p_m_name_2_2=p_m_name_2_a(1)
					str_temp=np_1&GetContent(str_temp,p_m_name_2_1,p_m_name_2_2,0)
				ElseIF Instr(p_m_name_1,"{@@@}")>0 Then
					np_a=split(p_m_name_1,"{@@@}")
					np_1=np_a(0)
					np_2=np_a(1)
					p_m_name_1=np_2			
					p_m_name_2_a=split(p_m_name_1,"{!!!}")
					p_m_name_2_1=p_m_name_2_a(0)
					p_m_name_2_2=p_m_name_2_a(1)
					str_temp=np_1&GetContent(str_temp,p_m_name_2_1,p_m_name_2_2,1)	
				ElseiF Instr(p_m_name_1,"{%%%}")>0 Then	
					np_a=split(p_m_name_1,"{%%%}")
					np_1=np_a(0)
					np_2=np_a(1)
					p_m_name_1=np_2							
					p_m_name_2_a=split(p_m_name_1,"{!!!}")
					p_m_name_2_1=p_m_name_2_a(0)
					p_m_name_2_2=p_m_name_2_a(1)
					str_temp=body2s(str_temp,p_m_name_2_1,p_m_name_2_2,"{##@##}",true,np_1)	
					IF tChongfu Then str_temp=PrintArray(str_temp,"{##@##}")	
				ElseiF Instr(p_m_name_1,"{***}")>0 Then	
					np_a=split(p_m_name_1,"{***}")
					np_1=np_a(0)
					np_2=np_a(1)
					p_m_name_1=np_2							
					p_m_name_2_a=split(p_m_name_1,"{!!!}")
					p_m_name_2_1=p_m_name_2_a(0)
					p_m_name_2_2=p_m_name_2_a(1)
					str_temp=body2s(str_temp,p_m_name_2_1,p_m_name_2_2,"{##@##}",false,np_1)	
					IF tChongfu Then str_temp=PrintArray(str_temp,"{##@##}")							
				Else
					str_temp=str_temp&p_m_name_1
				End IF	
			End IF		
		Next
		IF flag Then
			Get_cj_allname=Trim(LoseeeHtml(str_temp))
		Else
			Get_cj_allname=str_temp
		End IF
		Get_cj_allname=Arr_ss(Get_cj_allname)
	End Function	
	
	'========清除所有html标签
	Function LoseeeHtml(ContentStr)
	IF ContentStr="" or Isnull(ContentStr) Then LoseeeHtml="" :Exit Function
	 Dim ClsTempLoseStr,regEx
	 ClsTempLoseStr = Cstr(ContentStr)
	 Set regEx = New RegExp
	 regEx.Pattern = "<\/*[^<>]*>"       ' 设置模式
	 regEx.IgnoreCase = True         ' 设置是否区分字符大小写。
	 regEx.Global = True             ' 设置全局可用性。
	 ClsTempLoseStr = regEx.Replace(ClsTempLoseStr," ")        '意思是在ClsTempLoseStr中凡是有regEx.Pattern标签的全部用“”代替
	 LoseeeHtml = ClsTempLoseStr
	End Function
	
	'===========清除24个日文卡片=========
	Function Arr_ss(str)
		 F=array("ゴ","ガ","ギ","グ","ゲ","ザ","ジ","ズ","ヅ","デ",_
				 "ド","ポ","ベ","プ","ビ","パ","ヴ","ボ","ペ","ブ","ピ","バ",_
				 "ヂ","ダ","ゾ","ゼ")
		Dim temp:temp=""
		str=trim(str)
		IF str<>"" Then
			For i=0 to ubound(F)
				IF instr(str,F(i))>0 Then
					str=replace(str,F(i),"")	
				End IF
			Next
		End IF	
		Arr_ss=str
	End Function
	
	'格式化-字符串-ForMatStr(",1,1,",",")
	Function ForMatStr(str,s)
		Dim str_i,str_t,str_a,i
		str=trim(str)
		str=replace(str,s&s,s)
		IF  str=s Then
			ForMatStr=""
			Exit Function
		Else
			ForMatStr=str
			IF left(ForMatStr,len(s))=s Then
				ForMatStr=mid(ForMatStr,len(s)+1)			
			End IF
			IF right(ForMatStr,len(s))=s Then
				ForMatStr=mid(ForMatStr,1,len(ForMatStr)-len(s))			
			End IF	
		End IF 
	End Function
	
	'输出数组,去掉重复的字段
	Function PrintArray(str,s)
		Dim str2,i,str3,str3_t
		str=ForMatStr(str,s)
		str2=split(str,s)
		For i=Lbound(str2) To Ubound(str2)
			str3_t=str2(i)
			IF instr(str3,str3_t&s)=0 Then
				str3=str3&str3_t&s
			End IF
		Next
		PrintArray=ForMatStr(str3,s)
	End Function
	
	'过滤一些特殊字符=============
	Function Qingtiandy_cj_fiter(str)
		str=REPLACE(str,space(1),"")
		str=REPLACE(str,CHR(32),"")
		str=REPLACE(str,vbcrlf,"")
		str=REPLACE(str,chr(13),"")
		str=REPLACE(str,chr(10),"")	
		str=REPLACE(str,"'","")
		str=REPLACE(str,vbTab,"")
		str=REPLACE(str,vbLf,"")
		str=REPLACE(str,vbCr,"")
		str=REPLACE(str,vbCrLf,"")
		Qingtiandy_cj_fiter=str
	End Function
	
	'========清楚左右字符===============
	Function trimOuterStr(Byval str,Byval flag)
		dim vstr,m : vstr=str : m=len(flag)
		if left(vstr,m)=flag then vstr=right(vstr,len(vstr)-m) 
		if right(vstr,m)=flag then  vstr=left(vstr,len(vstr)-m)
		trimOuterStr=vstr
	End Function
	
	'========时间格式===============
	Function FormatDate(DT,tp)
		dim Y,M,D,hour_,minute_,second_
		Y=Year(DT)
		M=month(DT)
		D=Day(DT)
		hour_=hour(DT)
		minute_=minute(DT)
		second_=second(DT)
		if M<10 then M="0"&M
		if D<10 then D="0"&D
		if hour_<10 then hour_="0"&hour_
		if minute_<10 then minute_="0"&minute_
		if second_<10 then second_="0"&second_
		select case tp
		case 1 FormatDate=Y&"年"&M&"月"&D&"日"
		case 2 FormatDate=Y&"/"&M&"/"&D
		case 3 FormatDate=M&"/"&D
		case 4 FormatDate=Y&"\"&M&"\"&D
		case 5 FormatDate=Y&"-"&M&"-"&D
		case 6 FormatDate=M&"-"&D
		case 11 FormatDate=Y&"年"&M&"月"&D&"日"&" "&hour_&"时"&minute_&"分"&second_&"秒"
		case 22 FormatDate=Y&"/"&M&"/"&D&" "&hour_&"/"&minute_&"/"&second_
		case 44 FormatDate=Y&"\"&M&"\"&D&" "&hour_&"\"&minute_&"\"&second_
		case 55 FormatDate=Y&"-"&M&"-"&D&" "&hour_&":"&minute_&":"&second_
		case 66 FormatDate=right(Y,2)&"-"&M&"-"&D&" "&hour_&":"&minute_&":"&second_	
		Case Else FormatDate=Y&"-"&M&"-"&D
		end select
	End Function
	
	'==========强制数字类型============
	Function Bint(Str)
		Str = Trim(Str)
		If Str = "" Or IsNull(Str) Or Not IsNumeric(Str) Then Str = "0"
		Bint = Round(Str, 0)
	End Function
	
	'==========替换<!--中间内容-->===
	Function Replace_Middle(str)
		On error resume next
		Dim ClsTempLoseStr,regEx
		IF Trim(str)="" Then
			Replace_Middle=""
			Exit Function
		Else
			ClsTempLoseStr = Cstr(str)
			Set regEx = New RegExp
			regEx.IgnoreCase = True         ' 设置是否区分字符大小写。
			regEx.Global = True             ' 设置全局可用性。			
			regEx.Pattern = "<SCRIPT*[^<>]*>"       ' 设置模式
			ClsTempLoseStr = regEx.Replace(ClsTempLoseStr," ")
			regEx.Pattern = "<!--(.*)?-->"       ' 设置模式
			ClsTempLoseStr = regEx.Replace(ClsTempLoseStr," ")	
			regEx.Pattern = "<a[^>]+>(.+?)<\/a>" 
			ClsTempLoseStr = regEx.replace(ClsTempLoseStr,"$1") 				
			Replace_Middle = ClsTempLoseStr 
		End IF			
	End Function

	Function Get_Ynull(v)
		IF v="" or isnull(v) Then
			Get_Ynull=False
		Else
			Get_Ynull=True
		End IF
	End Function	
	
	'=======================替换，格式a{$}b a替换b
	Function Get_Replace_C(v,v2)
		IF Not Get_Ynull(v2) or Not Get_Ynull(v) Then
			Get_Replace_C=v2
			Exit Function
		End IF
		Dim p_a,p_1,p_2,p_3,p_4
		p_a=split(v,chr(13))
		For i=0 To Ubound(p_a)
			p_1=p_a(i)
			IF Instr(p_1,"{$}")>0 Then
				p_2=split(p_1,"{$}")
				p_3=p_2(0)
				p_4=p_2(1)
			Else
				p_3=""
				p_4=p_1
			End IF
			p_4=Trim(replace(p_4,CHR(10),""))
			v2=replace(Lcase(v2),Lcase(p_4),p_3)
		Next
		Get_Replace_C=v2
	End Function	
	
	'======================获取图片正则============
	Function oflink_lcasetag(imgstrng)
		'将内容html代码里的标签大写转换成小写
		Dim regEx, Match, Matches '建立变量。 
		Set regEx = New RegExp '建立正则表达式。 
		regEx.Pattern = "<.+?\>" '设置模式。 
		regEx.IgnoreCase = true '设置是否区分字符大小写。 
		regEx.Global = True '设置全局可用性。 
		Set Matches = regEx.Execute(imgstrng) '执行搜索。 
		imgstrng=imgstrng
		For Each Match in Matches '遍历匹配集合。 
			imgstrng=replace(imgstrng,Match.Value,lcase(Match.Value))
		Next
		oflink_lcasetag = imgstrng 
	End Function
	
	Function Get_pic(strng) 
		'批量获取图片路径
		strng=oflink_lcasetag(strng)
		Dim regEx, Match, Matches,values,if_add '建立变量。 
		Set regEx = New RegExp '建立正则表达式。 
		regEx.Pattern = "src\=.+?\.(gif|jpg|jpeg|jpe|png)" 
		regEx.IgnoreCase = true '设置是否区分字符大小写。 
		regEx.Global = True '设置全局可用性。 
		Set Matches = regEx.Execute(strng) '执行搜索。 
		if_add=0
		For Each Match in Matches '遍历匹配集合。 
			values=values&Match.Value&"|" 
			if_add=1
		Next 
		values=replace(values,"src=""","")
		values=replace(values,"src='","")
		values=replace(values,"src=","")
		if if_add=1 then values=left(values,len(values)-1)
		Get_pic = values 
	End Function 	
	
	'========================以下是FSO操作===============================
	'文件夹-同时创建多级文件夹 CreateFolders Add_Root_Dir("/1/1/1/1")
	Public Function C_N_CreateFolders(fldr)
		Dim sfldr,i
		sfldr = split(fldr,"/")
		Dim fso, f, Tmp
		For i = 0 To Ubound(sfldr)
			If sfldr(i)<>"" then
				If i = 0 then
					Tmp = sfldr(i)
				Else
					Tmp = Tmp & "/"&sfldr(i)
				End if
				If Not C_N_IsFolderExists(Tmp) then
					Set fso = CreateObject(C_G_FSO)
					Set f = fso.CreateFolder(Server.MapPath(Tmp))
				End if
			End if
		Next
		Set f=nothing
		Set fso=nothing
	End Function
	'文件夹-是否存在 IsFolderExists Add_Root_Dir("/1")
	Function C_N_IsFolderExists(spec) 
		Dim fso
		Set fso = CreateObject(C_G_FSO)
		If (fso.FolderExists(server.MapPath(spec))) Then
		C_N_IsFolderExists = True
		Else
		C_N_IsFolderExists = False
		End If
	End Function	
	
	'文件-覆盖式写入-没有自动创建 WriteToFile Add_Root_Dir("/inc/"),"content" 
	Function WriteToFile(fil,wstr)
		Dim fso, f
		Set fso = Server.CreateObject(G_FSO)
		Set f = fso.CreateTextFile(Server.MapPath(fil),True)
		f.Write wstr
		Set f = nothing
		Set fso = nothing
	End function
	
	'文件-结尾写入-没有自动创建 WriteToFile Add_Root_Dir("/inc/"),"content"
	Function WriteToFileToEnd(fil,wstr)
		Dim fs,txt
		Set fs = CreateObject(G_FSO)
		Set txt=fs.OpenTextFile(Server.MapPath(fil),8,True) 
		txt.Write wstr
		txt.Close
		Set txt=nothing
		Set fs=nothing
	End Function	
	
	'创建文件--覆盖式写入-没有自动创建 CreateFolderFile Add_Root_Dir("/1/1/1/1.txt"),"content"
	Function CreateFolderFile(fil,wstr)
		Dim a,a1,a2
		a=Instrrev(fil,"/")
		a1=left(fil,a-1)
		C_N_CreateFolders a1
		WriteToFile fil,wstr
	End Function
	
	Function CopyFiles(TempSource,TempEnd) 
		TempSource=Server.MapPath(TempSource)
		TempEnd=Server.MapPath(TempEnd)
		Dim FSO 
		Set FSO = Server.CreateObject("Scripting.FileSystemObject") 
		IF FSO.FileExists(TempSource) Then 
			FSO.CopyFile TempSource,TempEnd
		End If 
		Set FSO = Nothing 
	End Function	
	
	'文件-是否存在 C_N_IsExists Add_Root_Dir("/1/1.txt")
	Function C_N_IsExists(filespec) 
		Dim fso
		Set fso = CreateObject(G_FSO)
		If (fso.FileExists(server.MapPath(filespec))) Then
		C_N_IsExists = True
		Else
		C_N_IsExists = False
		End If
	End Function	
	
	'文件修改日期的判断
	Function IsExistIndexPage(HowSecond,t_saveurl) 	
		if HowSecond="" then HowSecond=6
		Dim Fso,MyFile,PhFileName,isTrue,G_FS_FSO
		G_FS_FSO="Scripting.FileSystemObject"
		PhFileName = t_saveurl
		isTrue = False
		Set Fso = CreateObject(C_G_FSO)
		If Fso.FileExists(server.MapPath(PhFileName)) Then
			set MyFile = Fso.GetFile(server.MapPath(PhFileName))
			if MyFile.Size > 10 and datediff("h",MyFile.DateLastModified,now()) < HowSecond then 
					isTrue = True
			else
				MyFile.Delete(True)
				isTrue = False
			end if
			set MyFile = nothing 
		End If
		Set Fso = Nothing 
		IsExistIndexPage = isTrue
	End Function	
	
	Function Add_Root_Dir(JS_Path)
		Dim JS_All_Path
		If Left(JS_Path,3)="../" Then
			Add_Root_Dir=JS_Path
			Exit Function
		End IF	
		If Left(JS_Path,1)="/" Then
			JS_All_Path = G_VIRTUAL_ROOT_DIR & JS_Path
		Else
			JS_All_Path = G_VIRTUAL_ROOT_DIR & "/" & JS_Path
		End If
		If Trim(G_VIRTUAL_ROOT_DIR) <> "" Then
			JS_All_Path = "/" & JS_All_Path
		End If
		Add_Root_Dir = JS_All_Path
	End Function	
End Class
%>