<%
 '警告:如没有必要请禁止 调用 执行VB脚本 或 execute 函数 默认为禁止(true)有效防止非法脚本的执行
'禁止采集脚本通过execute执行VBSCRIPT: 禁止设为true 允许设为false
Dim tConn,tQuery,tDic,tTypeDic,tnTypeDic,gHttpObj,gMSControl:tConn=null:gMSControl=null
Const TEMPDATABASEFILENAME="tempdata.mdb"
'Const ESCDIR = "items/video/"
'Const ESCACHEDIR = "cache/"
Dim initStep:initStep=1
Function IsClientConnected()
  IsClientConnected=response.IsClientConnected
End Function
Function Object()
  SET Object = Server.CreateObject(OtT(7)):Object.CompareMode=1
End Function
'符值
Function SetValue(ByRef Var,ByVal Val)
  if isObject(val) then
	if isObject(Var) then:SET Var=nothing:end if
	SET Var=Val:SET SetValue=Val
  else
	Var=Val:SetValue=Val
  end if
End Function
'比较2个变量是否相同
Function varComp(ByVal var1,ByVal var2)
  if typename(var1)<>typename(var2) then:varComp=false:exit function:end if
  if typename(var1)="Object" then:varComp=var1 is var2:exit function:end if
  if typename(var1)="Variant()" then:varComp=join(var1,"$")=join(var2,"$"):else:varComp=var1=var2:end if
End Function
Function Random()
  Randomize():Random=Rnd
End Function
Sub Push(ByRef Arr,ByRef Val)
  on error resume next
  Dim l:l=UBound(Arr)+1:l=Fun.ifthen(err,0,l):ReDim Preserve Arr(l)
  if isObject(Val) then:SET Arr(l)=Val:else:Arr(l)=Val:end if
End Sub
Function Pop(ByRef Arr)
  dim l:l=UBound(Arr)
  on error resume next
  SetValue Pop,Arr(l)
  ReDim Preserve Arr(l-1)
End Function

Function unShift(ByRef Arr)
	dim i,t:t=array()
	on error resume next
	SetValue unShift,Arr(0)
	For i=1 to UBound(Arr):Push t,Arr(i):Next:ReDim Arr(-1):Arr=t
End Function

Function concat(ByVal Arr1,ByVal Arr2)
	dim i
	for i=0 to Ubound(Arr2)
		Push Arr1,Arr2(i)
	next
	concat = Arr1
End Function

'弹出成员	Start开始位置	弹出个数
Function Splice(ByRef Arr,ByVal Start,ByVal Length)
	Splice=jsSplice(Arr,Start,Length,null)
End Function

Function jsSplice(ByRef Arr,ByVal Start,ByVal Length,ByVal arg)
	Dim ret,i,t,al,iEnd:iEnd=Start+Length:al=Ubound(Arr):t=array():ret=array()
	for i=Start to iEnd-1:Push ret,Arr(i):next
	for i=iEnd to al:Push t,Arr(i):next
	ReDim Preserve Arr(Start-1)
	if IsArray(arg) then:for i=0 to UBound(arg):Push Arr,arg(0):next:end if
	for i=0 to UBound(t):Push Arr,t(i):next
	jsSplice=ret
End Function

Function array_unique(ByVal arr)
  dim i,j,ret,bol:ret=array()
  for i=0 to UBound(arr)
	bol=true
	for j=UBound(ret) to 0 step -1
	  if varComp(arr(i),ret(j)) then
		bol=false
		exit for
	  end if
	next
	if bol then
	  Push ret,arr(i)
	end if
  next
  array_unique=ret
End Function

Function array_reverse(ByVal arr)
	dim i,ret:ret=array()
	for i=UBound(arr) to 0 step -1
		Push ret,arr(i)
	next
	array_reverse=ret
End Function

Function getFileTime(Byval Path)
	Path=Server.MapPath(Path)
	if objFso.FileExists(Path) then
		Dim f:SET f=objFso.getFile(Path)
		getFileTime=f.DateLastModified:SEt f=nothing
	else
		getFileTime="N/A"
	end if
End Function

Function jsCharAt(ByVal Str,ByVal iIndex)
	jsCharAt=jsSubstr(Str,iIndex,1)
End Function

Function jsCharAtCode(ByVal Str,ByVal iIndex)
	jsCharAtCode=Asc(jsSubstr(Str,iIndex,1))
End Function


Function jsSubstr(ByVal Str,ByVal Start,ByVal Length)
	if Length<0 then:Length=0:end if:jsSubstr=Mid(Str,Start+1,Length)
End Function

Function jsSlice(ByVal Str,ByVal Start,ByVal iEnd)
	If Start<0 Then:Start=len(Str)+Start:end if:If iEnd<1 Then:iEnd=len(Str)+iEnd:end if:jsSlice=jsSubstr(Str,Start,iEnd-Start)
End Function

Function isString(ByVal Val)
	isString=typename(Val)="String"
End Function

Function isBool(ByVal Val)
	isBool=typename(Val)="Boolean"
End Function

Function IfThen(ByVal Bool, Byval A,ByVal B)
	if Bool=true then
		SetValue IfThen,A
	else
		SetValue IfThen,B
	end if
End Function

Sub SetRegExpAttribute(ByRef oRegExp,ByVal aAtt)
	dim e,pattern:pattern=aAtt(0):e=" "&aAtt(1):with oRegExp:.IgnoreCase=inStr(e,"i")>0:.Global=inStr(e,"g")>0:.Multiline=inStr(e,"m")>0:.Pattern=pattern:end with
End Sub

Function jsPattern(ByVal Pattern)
	Dim rp,mt:rp=InstrRev(Pattern,"/"):mt=right(Pattern,len(Pattern)-rp):Pattern=Mid(Pattern,2,rp-2)
	jsPattern=array(Pattern,mt)
End Function

Function jsRegExp(ByVal Pattern)
	SET jsRegExp=new RegExp:SetRegExpAttribute jsRegExp,jsPattern(Pattern)
End Function

Function RegExpExec(ByVal Str,ByVal Pattern)
	Dim i,m,ms:RegExpExec=array()
	on error resume next
	SET ms=getGRegExp(Pattern).execute(Str)
	for each m in ms
		for i=0 to m.submatches.count-1:Push RegExpExec,m.submatches(i):next
	next
End Function

Function RegMatchesCount(ByVal Str,ByVal Pattern)
	RegMatchesCount=getGRegExp(Pattern).execute(Str).count
End Function

'附加功能函数
'斜杠转义
Function addcslashes(ByVal str)
	addcslashes=adminFun.RegReplace(str,"/([\(\)\[\]\""\'\.\?\+\-\*\/\\\^\$])/ig","\$1")
End Function

Function stripcslashes(ByVal str)
	stripcslashes=adminFun.RegReplace(str,"/\\([\(\)\[\]\""\'\.\?\+\-\*\/\\\^\$])/ig","$1")
End Function

Function TrimAll(ByVal Str)
	TrimAll=adminFun.RegReplace(Str,"/(\s*)/g","")
End Function

Function Trim(ByVal Str)
	Trim=adminFun.RegReplace(Str,"/(^\s*)|(\s*$)/g","")
End Function

Function LTrim(ByVal Str)
	LTrim=adminFun.RegReplace(Str,"/(^\s*)/g","")
End Function

Function RTrim(ByVal Str)
	RTrim=adminFun.RegReplace(Str,"/(\s*$)/g","")
End Function
'比较文本
Function StrComp(ByVal Str1,ByVal Str2,ByVal bool)
	Str1=Fun.ifthen(CBool(bool)<>true,UCase(Str1),Str1):Str2=Fun.ifthen(CBool(bool)<>true,UCase(Str2),Str2)
	StrComp=Fun.ifthen(Str1>Str2,1,IfThen(Str1<Str2,-1,0))
End Function

'截取文本中间
Function StrSlice(ByVal Str,ByVal sStr,ByVal eStr)
	if eStr="" then:StrSlice="":exit function:end if
	Dim tStr,iPos,sLen:tStr=LCase(Str):iPos=Fun.JsIndexOf(tStr,LCase(sStr)):sLen=Len(sStr):StrSlice=""
	if iPos=-1 then exit function:end if
	iPos=Fun.ifthen(sLen>0,iPos+sLen,1):StrSlice=jsSubstr(Str,iPos-1,Fun.JsIndexOf(jsSlice(tStr,iPos-1,0),LCase(eStr))-1)
End Function

'截取文本中间B 最大范围
Function StrSliceB(ByVal Str,ByVal sStr,ByVal eStr)
	if sStr&eStr="" then:StrSliceB=Str:exit function:end if
	Dim tStr,iPos,sLen:tStr=LCase(Str):iPos=Fun.JsIndexOf(tStr,LCase(sStr)):sLen=Len(sStr):StrSliceB=""
	if iPos=-1 then exit function:end if
	iPos=Fun.ifthen(sLen>0,iPos+sLen,1)
	if eStr="" then
		StrSliceB=jsSlice(Str,iPos-1,0)
	else
		tStr=jsSlice(tStr,iPos,0):StrSliceB=jsSubstr(Str,iPos-1,InstrRev(tStr,LCase(eStr)))
	end if
End Function

'分割文本段
Function StrSplits(ByVal Str,ByVal sStr,ByVal eStr)
	if eStr="" OR Str="" then:StrSplits=array():exit function:end if
	Dim ret,iPos,ePos,sLen,eLen,tStr:ret=array()
	tStr=LCase(Str)
	sStr=LCase(sStr)
	eStr=LCase(eStr)
	sLen=Len(sStr)
	eLen=Len(eStr)
	do while true
		iPos=Fun.JsIndexOf(tStr,sStr):if iPos=-1 then:exit do:end if
		iPos=Fun.ifthen(sLen>0,iPos+sLen,1):tStr=jsSlice(tStr,iPos-1,0)
		ePos=Fun.JsIndexOf(tStr,eStr):if ePos=-1 then:exit do:end if
		Push ret,jsSubstr(Str,iPos-1,ePos-1):tStr=jsSlice(tStr,ePos+eLen-1,0):Str=jsSlice(Str,iPos+ePos+eLen-2,0)
	loop
	StrSplits=ret
End Function

Function HTMLEncode(ByVal HTMLStr)
	HTMLEncode = Server.HTMLEncode(HTMLStr)
ENd Function

Function paseAbsURI(ByVal Links,ByVal currUrl)
  Links=Fun.ifthen(isArray(Links),Links,Array(Links))
  on error resume next
  Dim t,H,i,j,k,rg,ab,qt,Pb,siteUrl
  SET rg=jsRegExp("/^\s*[\/\\]/i"):SET ab=jsRegExp("/^http:\/\//i"):SET qt=jsRegExp("/\\([\\\/])/ig"):
  currUrl=qt.replace(trim(currUrl),"/"):siteUrl=adminFun.RegReplace(currUrl,"/(https?\:\/\/)((\w+)(\.\w+)*(:\d+)?)\/.*/i","$1$2"):currUrl=replace(currUrl,siteUrl,"")
  for i=0 to Ubound(Links)
	  H=CStr(Links(i))
	  if not ab.test(H) then
		  if rg.test(H) then:Links(i)=siteUrl&H:else:j=UBound(split(H,"../"))+1:t=Split(currUrl,"/"):k=Ubound(t)+1:j=Fun.ifthen(j<k,k-j,0)-1:ReDim Preserve t(j):Links(i)=siteUrl&Join(t,"/")&"/"&adminFun.RegReplace(H,"/([\.]{2}\/)/g",""):end if
	  end if
  next
  paseAbsURI=Links
  SET rg=nothing:SET ab=nothing:SET pb=nothing:SET qt=nothing
End Function
Function stepBatchUrl(ByVal Url,Byval ValStr, ByVal iStart, ByVal iEnd, ByVal iSize, ByVal iPage, ByVal Order, ByVal iStep)
  '1=http://picture.2hua.com/list_641_2_1.html?all=2050&start={$ID}
  '2={$ID}   3=1   4=2040    5=10   6=0   7=False
  dim i,j,ret:iPage=iSize*iPage:ret=array()
  if Order = true then'升序或降序
	for i=iEnd-iPage to iStart step -iStep
		Push ret,Replace(Url,ValStr,i)
		j=j+1:if j>=iSize then:exit for:end if
	next
  else
	for i=iStart+iPage to iEnd step iStep
		Push ret,Replace(Url,ValStr,i)
		j=j+1:if j>=iSize then:exit for:end if
	next
  end if
  stepBatchUrl=ret
End Function
Function SpecialLink(ByVal sLink,ByVal fLink,ByVal rLink)'特殊链接
  Dim t,i:t=split(fLink,"[变量]")
  if UBound(t)<1 then
	SpecialLink=sLink
  else
	rLink=join(split(rLink,"[变量]"),"$1")
	For i=0 to UBound(t):t(i)=addcslashes(t(i)):Next
	SpecialLink=adminFun.RegReplace(sLink,"/"&Join(t,"([\w\W]+)")&"/ig",rLink)
  end if
End Function
Function SpecialLinks(ByVal aLinks,ByVal fLink,ByVal rLink)
  Dim t,i:t=split(fLink,"[变量]")
  if UBound(t)<1 then
	SpecialLinks=aLinks
  else
	rLink=Join(split(rLink,"[变量]"),"$1")
	For i=0 to UBound(t):t(i)=addcslashes(t(i)):Next
	fLink=Join(t,"([\w\W]+)")
	for i=0 to UBound(aLinks)
		aLinks(i)=adminFun.RegReplace(aLinks(i),"/"&fLink&"/ig",rLink)
	next
	SpecialLinks=aLinks
  end if
End Function
Function RemoveHTMLCode(ByVal Str,ByVal cHas)
  Str=""&Str:if cHas="" OR Str="" then:RemoveHTMLCode=Cstr(Str):exit function:end if
  Dim i:cHas=split(trimall(UCASE(cHas)),"|")
  for i=0 to UBound(cHas)
	SELECT CASE cHas(i)
	  CASE "TABLE":Str=adminFun.RegReplace(Str,"/<\/?(table|thead|tbody|tr|th|td).*>/ig","")
	  CASE "OBJECT":Str=adminFun.RegReplace(Str,"/<\/?(object|param|embed).*>/ig","")
	  CASE "SCRIPT":Str=adminFun.RegReplace(Str,"/<script.*>[\w\W]*?<\/script>/ig",""):Str=adminFun.RegReplace(Str,"/on[\w]+=[\'\""].+?[\'\""](\s|>)/ig","$1")	  
	  CASE "STYLE":Str=adminFun.RegReplace(Str,"/<style.*>[\w\W]+?<\/style>/ig","")
	  CASE "CLASS":Str=adminFun.RegReplace(Str,"/\sclass=.+?(\s|>)/ig","")
	  CASE "*":Str=RemoveHTMLCode(Str,"SCR"&"IPT|STYLE"):Str=adminFun.RegReplace(Str,"/<.*?>/ig",""):Str=Replace(Replace(Str,"<","&lt;"),">","&gt;")
	  CASE ELSE:Str=adminFun.RegReplace(Str,"/<\/?"&addcslashes(cHas(i))&".*?>/ig","")
	End SELECT
  next
  RemoveHTMLCode=Str
End Function
Function ConnectTempDataBase
  dim tPath,dbType:tPath=accessFilePath
  accessFilePath=accessFilePath'ENGINEDIR&TEMPDATABASEFILENAME
  SET ConnectTempDataBase=server.CreateObject("admin_admin_inc.template")
  if databaseType=0 then  dbType="acc" else dbType="sql"
  ConnectTempDataBase.dbType=dbType
  'ConnectTempDataBase.connect()
  accessFilePath=tPath
End Function
Function LoadWord()
  LoadWord=""
End Function
Function filterQuote(Byval Str)
  filterQuote=replace(""&Str,"'","")
End Function
Function filterWord(Byval Str,ByVal rCol)
  dim i:Str=""&Str
  if Str="" then:filterWord=Str:exit function:end if
  if NOT IsArray(tDic) then
	  if NOT isObject(tConn) then:SET tConn=ConnectTempDataBase():end if
	  tDic=Conn.db("SELECT {pre}rColumn,{pre}uesMode,{pre}sFind,{pre}sReplace,{pre}sStart,{pre}sEnd FROM {pre}fWord WHERE {pre}Flag=1","array")
  end if
  if IsArray(tDic) then
	  for i=0 to UBound(tDic,2)
		  if tDic(0,i)=rCol then
			  if tDic(1,i)=1 then
				  if tDic(4,i)&tDic(5,i) <> "" then:Str=adminFun.RegReplace(Str,"/"&addcslashes(tDic(4,i))&"([\w\W]+?)"&addcslashes(tDic(5,i))&"/ig",tDic(3,i)):end if
			  else
				  if tDic(2,i)<>"" then:Str=replace(Str,tDic(2,i),tDic(3,i)):end if
			  end if
		  end if
	  next
  end if
  filterWord=Str
End Function
Function ClassID2Name(ByVal iClsID)
  if NOT isObject(tTypeDic) then
	dim t,i:SET tTypeDic=Object()
	t = conn.db("select {pre}id,{pre}name from {pre}type WHERE {pre}type=1 order by {pre}id asc","array")
	if IsArray(t) then
	  for i=0 to UBound(t,2)
		tTypeDic(CStr(t(0,i)))=t(1,i)
	  next
	end if
  end if
  ClassID2Name=tTypeDic(CStr(iClsID))
End Function
Function NewsClassID2Name(ByVal iClsID,ByVal m_type)
  if NOT isObject(tnTypeDic) then
	dim t,i:SET tnTypeDic=Object()
	t = conn.db("select {pre}id,{pre}name from {pre}type WHERE {pre}type="&m_type&" order by {pre}id asc","array")
	if IsArray(t) then
	  for i=0 to UBound(t,2)
		tnTypeDic(CStr(t(0,i)))=t(1,i)
	  next
	end if
  end if
  NewsClassID2Name=tnTypeDic(CStr(iClsID))
End Function
Function findIsExistFrom(array1,from)
  dim i,m:m=ubound(array1):findIsExistFrom=""
  for i=0 to m
	if trim(split(array1(i),"$$")(0))=trim(from) then
	  findIsExistFrom=i:Exit Function
	end if
  next
End Function
Function smartGeneralize(ByVal sClsName,ByVal mName)'智能归类(sClsName 类名,mName 视频名)
  dim i,aTitle,Q_WHERE,tRs,kPre:sClsName=filterQuote(trim(sClsName)):mName=filterQuote(filterWord(trim(mName),0)):Q_WHERE=array():kPre="SG.":smartGeneralize=0
  if sClsName="" AND mName="" then:exit function:end if
  if NOT isObject(tQuery) then:SET tQuery=Object():end if
  if tQuery.Exists(kPre&sClsName) then:smartGeneralize=tQuery(kPre&sClsName):exit function:end if
  if tQuery.Exists(kPre&mName) then:smartGeneralize=tQuery(kPre&mName):exit function:end if
  if NOT isObject(tConn) then:SET tConn=ConnectTempDataBase():end if
  if sClsName<>"" then
	SET tRs=tConn.db("SELECT TOP 1 sysClsID FROM {pre}cls WHERE clsName='"&sClsName&"'","execute")
	if not tRs.eof then:smartGeneralize=tRs("sysClsID"):end if
	tRs.Close:SET tRs=Nothing
  end if
  if smartGeneralize>0 then:tQuery(kPre&sClsName)=smartGeneralize:exit function:end if
  aTitle=split(mName,"/")
  for i=0 to UBound(aTitle)
	if not isNULL(aTitle(i)) then:Push Q_WHERE,"'/'+m_name+'/' LIKE '%/"&aTitle(i)&"/%'":end if
  next
  if Ubound(Q_WHERE)>-1 then
	Q_WHERE=Join(Q_WHERE," OR ")
	SET tRs=tConn.db("SELECT TOP 1 m_type FROM {pre}tempdata WHERE "&Q_WHERE,"execute")
	if not tRs.eof then:smartGeneralize=tRs("m_type"):end if
	tRs.Close:SET tRs=Nothing
	if smartGeneralize=0 then
	  SET tRs=Conn.db("SELECT TOP 1 m_type FROM {pre}video WHERE "&Q_WHERE,"execute")
	  if not tRs.eof then:smartGeneralize=tRs("m_type"):end if
	  tRs.Close:SET tRs=Nothing
	end if
  end if
  if smartGeneralize=0 AND sClsName<>"" then
	SET tRs=Conn.db("SELECT TOP 1 m_id FROM {pre}type WHERE m_type=0 AND m_name LIKE '"&sClsName&"%'","execute")
	if not tRs.eof then:smartGeneralize=tRs("m_id"):end if
	tRs.Close:SET tRs=Nothing
  end if
  tQuery(kPre&mName)=smartGeneralize
End Function
Function newssmartGeneralize(ByVal sClsName)'智能归类(sClsName 类名)
  dim i,aTitle,Q_WHERE,tRs,kPre:sClsName=filterQuote(trim(sClsName)):Q_WHERE=array():kPre="SG.":smartGeneralize=0
  if sClsName="" then:exit function:end if
  if NOT isObject(tQuery) then:SET tQuery=Object():end if
  if tQuery.Exists(kPre&sClsName) then:newssmartGeneralize=tQuery(kPre&sClsName):exit function:end if
  if NOT isObject(tConn) then:SET tConn=ConnectTempDataBase():end if
  if sClsName<>"" then
	SET tRs=tConn.db("SELECT TOP 1 sysClsID FROM {pre}newscls WHERE clsName='"&sClsName&"'","execute")
	if not tRs.eof then:newssmartGeneralize=tRs("sysClsID"):end if
	tRs.Close:SET tRs=Nothing
  end if
  if newssmartGeneralize>0 then:tQuery(kPre&sClsName)=newssmartGeneralize:exit function:end if
  if newssmartGeneralize=0 AND sClsName<>"" then
	SET tRs=Conn.db("SELECT TOP 1 m_id FROM {pre}type WHERE m_type=1 AND m_name LIKE '"&sClsName&"%'","execute")
	if not tRs.eof then:newssmartGeneralize=tRs("m_id"):end if
	tRs.Close:SET tRs=Nothing
  end if
  tQuery(kPre&mName)=newssmartGeneralize
End Function
Function repairDownUrl(vstr,formstr)
  dim strlen,formlen,str,fstr,rstr,i
  str = split(Fun.trimOuterStr(vstr,","),", ") : strlen = ubound(str)
  fstr = split(Fun.trimOuterStr(formstr,","),", ") : formlen  = ubound(fstr)
  if strlen <> formlen then
	Fun.die "未为每个下载项选择数据来源"
  else
	for i=0 to strlen
	  if  trim(str(i))<>"" then:rstr = rstr&repairStr(str(i),"down")&", " else rstr = rstr&", ":end if
	next
  end if
  repairDownUrl = Fun.trimOuterStr(rstr,", ")
End Function
'视频入库(mCls Object,iMode 入库方式,eMode 引擎当前模式)
' mCls 约定好影片信息字段名:	"来自",	"影片地址数组",	"来源",			"名称",		"演员",		"分类ID",	"分类名",		"日期",			"地区",			"备注",		"图片",	"介绍",		"连载状态",	"初始点击数",	"关键字",	"初始顶次数",	"年份",			"标题颜色",	"星级",		"初始踩次数",	"专题ID"

Function movieStorage(ByVal mdCls,ByVal iMode,ByVal eMode)
  dim l,Q_WHERE,dConn,tRs,sql,tablename,hFid,tFid,i,aTitle,moviesrcs,partnames,playfrom,iArr,jArr,bool:Q_WHERE=array()
  if UCASE(typename(mdCls)) <>"DICTIONARY" then:Err.Raise 13,"","类型不匹 第一个参数请传递 由 创建影片信息类() 返回的值":exit Function:end if
  iMode=Fun.Str2Num(iMode):eMode=Fun.Str2Num(eMode)
  hFid=Array("来自","影片地址","影片集名","来源","名称","演员","分类ID","分类名","日期","地区","备注","图片","介绍","连载状态",	"初始点击数","关键词","初始顶次数","年份","标题颜色","星级","初始踩次数","专题ID","语言","导演","中文分类")
  tFid=Array("fromurl","moviesrcs","partnames","playfrom","name","actor","type","typename","addtime","publisharea","note",		"pic","des","state","hit","keyword","digg","publishyear","color","commend","tread","topic","lang","director","cntype")
  dim mCls:SET mCls=Object()
  for i=0 to UBound(tFid)
	if mdCls.Exists(hFid(i)) then
	  mCls(tFid(i))=mdCls(hFid(i))
	else
	  if mdCls.Exists(tFid(i)) then:mCls(tFid(i))=mdCls(tFid(i)):end if
	end if
  next
  playfrom = replace(replace(filterQuote(mCls("playfrom")),"##",""),"$",""):mCls.Remove("playfrom")
  mCls("name")= replace(replace(filterQuote(replace(trim(mCls("name")),"\","/")),"[","【"),"]","】")
  if not isNumeric(mCls("type")) then:mCls("type")=smartGeneralize(mCls("type"),mCls("name")):end if
  tFid=Array("typename","from","addtime","publisharea","note","pic","lang","color","keyword","director")
  for i=0 to UBound(tFid)
	if mCls.Exists(tFid(i)) then:mCls(tFid(i)) = trim(mCls(tFid(i))):end if
  next
  tFid=Array("state","hit","digg","publishyear","tread","topic","commend")
  for i=0 to UBound(tFid)
	if mCls.Exists(tFid(i)) then:mCls(tFid(i)) = Fun.Str2Num(mCls(tFid(i))):end if
  next
  if mCls.Exists("actor") then
	mCls("actor") = adminFun.RegReplace(trim(mCls("actor")),"/\s+/g","[,]")
  end if
  if mCls.Exists("director") then
	mCls("director") = adminFun.RegReplace(trim(mCls("director")),"/\s+/g","[,]")
  end if
  if mCls.Exists("cntype") then
	mCls("cntype") = adminFun.RegReplace(trim(mCls("cntype")),"/\s+/g","[,]")
  end if
  if Fun.computeStrLen(mCls("name"))>115 then:mCls("name")=Fun.getStrByLen(mCls("name"),115):end if
  if Fun.computeStrLen(mCls("typename"))>50 then:mCls("typename")=Fun.getStrByLen(mCls("typename"),50):end if
  if eMode<2 then:movieStorage=true:exit function:end if
  aTitle=split(mCls("name"),"/")
  for i=0 to UBound(aTitle)
	if not isNULL(aTitle(i)) then:Push Q_WHERE,"'/'+{pre}name+'/' LIKE '%/"&aTitle(i)&"/%'":end if
  next
  if Ubound(Q_WHERE)=-1 then:movieStorage=false:exit function:end if
  Q_WHERE=Join(Q_WHERE," OR ")
  if iMode=1 AND Fun.Str2Num(mCls("type"))<>0 then
	tablename="{pre}video":SET dConn=conn
  else
	if NOT isObject(tConn) then:SET tConn=ConnectTempDataBase():end if
	iMode=0:tablename="{pre}tempvideo":Q_WHERE=Fun.ifthen(not isNull(mCls("fromurl")),"{pre}fromurl='"&mCls("fromurl")&"' OR ","")&Q_WHERE:SET dConn=tConn
  end if
  if iMode<>0 then
	'mCls.remove("from")
	mCls.remove("typename")
  else
	mCls("inbase")=0
  end if
  moviesrcs=mCls("moviesrcs"):mCls.remove("moviesrcs")
  partnames=mCls("partnames"):mCls.remove("partnames")
  if isArray(moviesrcs) then
	  l=UBound(moviesrcs)
	  if l<>-1 then
		  if isArray(partnames) then
			  if UBound(partnames)<>l then:ReDim Preserve partnames(l):end if
			  for i=0 to l:moviesrcs(i)=Fun.ifthen(Fun.JsIndexOf(moviesrcs(i),"$")=-1,Replace(""&partnames(i),",","")&"$"&moviesrcs(i),moviesrcs(i)):next
		  end if
		  moviesrcs=repairUrlForm(join(moviesrcs,vbcrlf),playfrom)
	  else
		  moviesrcs=""
	  end if
  else
	  moviesrcs=Fun.ifthen(not isNULL(moviesrcs),moviesrcs,"")
  end if
  if moviesrcs<>"" then:mCls("playdata")= transferUrl(playfrom,moviesrcs):end if
  mCls("enname")	= MoviePinYin(mCls("name"))
  mCls("letter")	= Left(mCls("enname"),1)
  SET tRs=dConn.db("SELECT TOP 1 {pre}id,{pre}playdata,{pre}state,{pre}type,{pre}pic FROM "&tablename&" WHERE "&Q_WHERE,"execute")
  if tRs.eof then
	  mCls("datetime") = mCls("addtime")
	  sql="INSERT INTO "&tablename&" "&mCls2SQL(mCls,0)
  else
	  Dim ADDSET:ADDSET=""
	  if gatherSet<>4 then
		  if mCls.Exists("state") then:ADDSET=",{pre}state="&ifthen(mCls("state")>tRs(2),mCls("state"),tRs(2)):mCls.remove("state"):end if
		  if mCls.Exists("inbase") then:ADDSET=ADDSET&",{pre}inbase=0":mCls.remove("inbase"):end if
		  if mCls.Exists("note") then:ADDSET=ADDSET&",{pre}note='"&filterQuote(mCls("note"))&"'":mCls.remove("note"):end if
		  if playfrom="土豆" then
			if mCls.Exists("keyword") then:ADDSET=ADDSET&",{pre}keyword='"&filterQuote(mCls("keyword"))&"'":mCls.remove("keyword"):end if
			if mCls.Exists("actor") then:ADDSET=ADDSET&",{pre}actor='"&filterQuote(mCls("actor"))&"'":mCls.remove("actor"):end if
			if mCls.Exists("director") then:ADDSET=ADDSET&",{pre}director='"&filterQuote(mCls("director"))&"'":mCls.remove("director"):end if
			if mCls.Exists("cntype") then:ADDSET=ADDSET&",{pre}cntype='"&filterQuote(mCls("cntype"))&"'":mCls.remove("cntype"):end if
			if mCls.Exists("publisharea") then:ADDSET=ADDSET&",{pre}publisharea='"&filterQuote(mCls("publisharea"))&"'":mCls.remove("publisharea"):end if
			if mCls.Exists("formurl") then:ADDSET=ADDSET&",{pre}formurl='"&filterQuote(mCls("formurl"))&"'":mCls.remove("fromurl"):end if
			bool=true
			if mCls.Exists("pic") then'图片
			  iArr=split(tRs(4),"{rendie:###}")
			  jArr=split(iArr(0),"{rendie:##}")
			  if instr(jArr(1),"{rendie:#}")<>0 then
				jArr(1)=filterQuote(split(mCls("pic"),"{rendie:##}")(1))
			  else
				bool=false
			  end if
			  if not bool then jArr(1)=""
			  iArr(0)=join(jArr,"{rendie:##}")'第一组组
			  ADDSET=ADDSET&",{pre}pic='"&join(iArr,"{rendie:###}")&"'"
			  mCls.remove("pic")
			end if
		  end if
	  end if
	  select case gatherSet
		  case 0,1,2,3
		    dim playdata
			  playdata=gatherIntoLibTransfer(tRs(1)&"$$$"&mCls("playdata"))
			  if Fun.isNul(playdata) then playdata=gatherIntoLibTransfer(mCls("playdata"))
			  mCls("playdata")=playdata
			  sql="UPDATE "&tablename&" SET {pre}name='"&filterQuote(mCls("name"))&"',{pre}type="&mCls("type")&",{pre}playdata='"&filterQuote(mCls("playdata"))&"'"&ifthen(isDate(mCls("addtime")),",{pre}addtime='"&mCls("addtime")&"'","")&ADDSET&" WHERE {pre}id="&tRs(0)
		  case 4
			  mCls("datetime") = mCls("addtime")
			  sql="INSERT INTO "&tablename&" "&mCls2SQL(mCls,0)
		  case 5
			  mCls.remove("hit"):mCls.remove("playdata"):sql="UPDATE "&tablename&" SET "&mCls2SQL(mCls,1)&ADDSET&" WHERE {pre}id="&tRs("m_id")
	  end select
  end if
  tRs.close : SET tRs=nothing
  dConn.db sql,"execute"
End Function

Function ClientStorage(ByVal mdCls,ByVal iMode,ByVal eMode)'客户入库(mCls Object,iMode 入库方式,eMode 引擎当前模式)
  dim tablename,tRs,sql,mCls,hFid,tFid,i
  SET mCls=Object():tablename="{pre}TempClient"
  hFid=Array("来自","联系人","电子邮箱","公司网址","固定电话","移动电话")
  tFid=Array("fromurl","contact","Email","CompanyWeb","Fixed","mobile")
  for i=0 to UBound(tFid)
	if mdCls.Exists(hFid(i)) then
	  mCls(tFid(i))=mdCls(hFid(i))
	else
	  if mdCls.Exists(tFid(i)) then:mCls(tFid(i))=mdCls(tFid(i)):end if
	end if
	if Fun.computeStrLen(mCls(tFid(i)))>215 then:mCls(tFid(i))=Fun.getStrByLen(mCls(tFid(i)),215):end if
  next
  SET tRs=Conn.db("SELECT TOP 1 {pre}id FROM "&tablename&" WHERE {pre}fromurl='"&mCls("fromurl")&"'","execute")
  if tRs.eof then
	sql="INSERT INTO "&tablename&" "&nCls2SQL(mCls,0)
    Conn.db sql,"execute"
  else
	sql="UPDATE "&tablename&" SET "&nCls2SQL(mCls,1)&" WHERE {pre}id="&tRs(0)
  end if
  tRs.close : SET tRs=nothing
End Function
'文章入库(mCls Object,iMode 入库方式,eMode 引擎当前模式)
' mCls 约定好信息字段名:	"来自",		"来源",			"标题",		"作者",		"分类ID",	"分类名",		"日期",			"简述",		"图片",	"正文",	"初始点击数",	"关键字",	"初始顶次数",		"标题颜色",	"星级",		"初始踩次数",	"专题ID"
Function newsStorage(ByVal mdCls,ByVal iMode,ByVal eMode)
  dim l,Q_WHERE,dConn,tRs,sql,tablename,hFid,tFid,i,aTitle,moviesrcs,partnames,playfrom:Q_WHERE=array()
  if UCASE(typename(mdCls)) <>"DICTIONARY" then:Err.Raise 13,"","类型不匹 第一个参数请传递 由 创建影片信息类() 返回的值":exit Function:end if
  iMode=Fun.Str2Num(iMode):eMode=Fun.Str2Num(eMode)
  hFid=Array("来自",	"来源",			"标题",		"作者",		"分类ID",	"分类名",		"日期",			"简述",		"图片",	"正文",	"初始点击数",	"关键字",	"初始顶次数",		"标题颜色",	"星级",		"初始踩次数",	"专题ID")
  tFid=Array("fromurl",	"from",		"title",		"author",	"type",		"typename",		"addtime",	"outline",		"pic",	"content",	"hit",			"keyword",	"digg",	"color",	"commend",	"tread",	"topic")
  dim mCls:SET mCls=Object()
  for i=0 to UBound(tFid)
	  if mdCls.Exists(hFid(i)) then
		  mCls(tFid(i))=mdCls(hFid(i))
	  else
		  if mdCls.Exists(tFid(i)) then:mCls(tFid(i))=mdCls(tFid(i)):end if
	  end if
  next
  mCls("title")= replace(replace(filterQuote(replace(trim(mCls("title")),"\","/")),"[","【"),"]","】")
  if not isNumeric(mCls("type")) then:mCls("type")=newssmartGeneralize(mCls("type"),mCls("title")):end if
  tFid=Array("typename","fromurl","from","author","addtime","outline","color","keyword")
  for i=0 to UBound(tFid)
	  if mCls.Exists(tFid(i)) then:mCls(tFid(i)) =trim(mCls(tFid(i))):end if
  next
  mCls("pic") =trim(mCls("pic"))
  tFid=Array("hit","digg","tread","topic","commend")
  for i=0 to UBound(tFid)
	  if mCls.Exists(tFid(i)) then:mCls(tFid(i)) = Fun.Str2Num(mCls(tFid(i))):end if
  next
  if Fun.computeStrLen(mCls("title"))>115 then:mCls("title")=Fun.getStrByLen(mCls("title"),115):end if
  if Fun.computeStrLen(mCls("typename"))>50 then:mCls("typename")=Fun.getStrByLen(mCls("typename"),50):end if
  if eMode<2 then:newsStorage=true:exit function:end if
  Push Q_WHERE,"{pre}name='"&mCls("title")&"'"
  Q_WHERE=Join(Q_WHERE," OR ")
  if iMode=1 AND Fun.Str2Num(mCls("type"))<>0 then
	  tablename="{pre}news":SET dConn=conn
  else
	  if NOT isObject(tConn) then:SET tConn=ConnectTempDataBase():end if
	  iMode=0:tablename="{pre}tempnews":Q_WHERE=Fun.ifthen(not isNull(mCls("fromurl")),"{pre}fromurl='"&mCls("fromurl")&"' OR ","")&Q_WHERE:SET dConn=tConn
  end if
  if iMode<>0 then
	  mCls.remove("fromurl"):mCls.remove("typename")
  else
	  mCls("inbase")=0
  end if
  mCls("enname")	= MoviePinYin(mCls("title"))
  mCls("letter")	= Left(mCls("enname"),1)
  SET tRs=Conn.db("SELECT TOP 1 {pre}id,{pre}type FROM "&tablename&" WHERE "&Q_WHERE,"execute")
  if tRs.eof then
	  mCls("datetime") = mCls("addtime")
	  sql="INSERT INTO "&tablename&" "&nCls2SQL(mCls,0)
  else
	  mCls("type")=Fun.Str2Num(mCls("type"))
	  sql="UPDATE "&tablename&" SET "&nCls2SQL(mCls,1)&" WHERE {pre}id="&tRs(0)
  end if
  tRs.close : SET tRs=nothing
  Conn.db sql,"execute"
End Function
'图片入库(mCls Object,iMode 入库方式,eMode 引擎当前模式)
' mCls 约定好信息字段名:	"来自",		"来源",			"标题",		"作者",		"分类ID",	"分类名",		"日期",			"简述",		"图片",	"正文",	"初始点击数",	"关键字",	"初始顶次数",		"标题颜色",	"星级",		"初始踩次数",	"专题ID"
Function PhotoStorage(ByVal mdCls,ByVal iMode,ByVal eMode)
  dim l,Q_WHERE,dConn,tRs,sql,tablename,hFid,tFid,i,aTitle,moviesrcs,partnames,playfrom:Q_WHERE=array()
  if UCASE(typename(mdCls)) <>"DICTIONARY" then:Err.Raise 13,"","类型不匹 第一个参数请传递 由 创建影片信息类() 返回的值":exit Function:end if
  iMode=Fun.Str2Num(iMode):eMode=Fun.Str2Num(eMode)
  hFid=Array("来自","来源","标题","作者","分类ID","分类名","日期","图片","正文","初始点击数","关键字","星级")
  tFid=Array("fromUrl","Origin","Title","Author","type","typename","Datetime","PhotoUrl","PictureContent","Hit","KeyWord","commend")
  dim mCls:SET mCls=Object()
  for i=0 to UBound(tFid)
	if mdCls.Exists(hFid(i)) then
	  mCls(tFid(i))=mdCls(hFid(i))
	else
	  if mdCls.Exists(tFid(i)) then:mCls(tFid(i))=mdCls(tFid(i)):end if
	end if
  next
  mCls("title")= replace(replace(filterQuote(replace(trim(mCls("title")),"\","/")),"[","【"),"]","】")
  if not isNumeric(mCls("type")) then:mCls("type")=newssmartGeneralize(mCls("type"),mCls("title")):end if
  if Fun.computeStrLen(mCls("title"))>115 then:mCls("title")=Fun.getStrByLen(mCls("title"),115):end if
  if Fun.computeStrLen(mCls("typename"))>50 then:mCls("typename")=Fun.getStrByLen(mCls("typename"),50):end if
  if eMode<2 then:PhotoStorage=true:exit function:end if
  Push Q_WHERE,"{pre}name='"&mCls("title")&"'"
  Q_WHERE=Join(Q_WHERE," OR ")
  if iMode=1 AND Fun.Str2Num(mCls("type"))<>0 then
	tablename="{pre}Photo":SET dConn=conn
  else
	if NOT isObject(tConn) then:SET tConn=ConnectTempDataBase():end if
	iMode=0:tablename="{pre}TempPhoto":Q_WHERE=Fun.ifthen(not isNull(mCls("fromurl")),"{pre}fromurl='"&mCls("fromurl")&"' OR ","")&Q_WHERE:SET dConn=tConn
  end if
  if iMode<>0 then
	  mCls.remove("fromurl"):mCls.remove("typename")
  else
	  mCls("inbase")=0
  end if
  mCls("enname")	= MoviePinYin(mCls("title"))
  mCls("letter")	= Left(mCls("enname"),1)
  SET tRs=Conn.db("SELECT TOP 1 {pre}id,{pre}type FROM "&tablename&" WHERE "&Q_WHERE,"execute")
  if tRs.eof then
	  mCls("Datetime") = mCls("Datetime")
	  sql="INSERT INTO "&tablename&" "&nCls2SQL(mCls,0)
  else
	  mCls("type")=Fun.ifthen(tRs(1)<>0,tRs(1),Str2Num(mCls("type")))
	  sql="UPDATE "&tablename&" SET "&nCls2SQL(mCls,1)&" WHERE {pre}id="&tRs(0)
  end if
  tRs.close:SET tRs=nothing
  Conn.db sql,"execute"
End Function
'商品入库(mCls Object,iMode 入库方式,eMode 引擎当前模式)
' mCls 约定好信息字段名:	"来自",		"来源",			"标题",		"作者",		"分类ID",	"分类名",		"日期",			"简述",		"图片",	"正文",	"初始点击数",	"关键字",	"初始顶次数",		"标题颜色",	"星级",		"初始踩次数",	"专题ID"
Function ProductStorage(ByVal mdCls,ByVal iMode,ByVal eMode)
  dim l,Q_WHERE,dConn,tRs,sql,tablename,hFid,tFid,i,aTitle,moviesrcs,partnames,playfrom:Q_WHERE=array()
  if UCASE(typename(mdCls)) <>"DICTIONARY" then:Err.Raise 13,"","类型不匹 第一个参数请传递 由 创建影片信息类() 返回的值":exit Function:end if
  iMode=Fun.Str2Num(iMode):eMode=Fun.Str2Num(eMode)
  hFid=Array("来自","标题","分类ID","正文","图片","价格","商品属性")
  tFid=Array("fromUrl","name","type","des","pic","price","attribute")
  dim mCls:SET mCls=Object()
  for i=0 to UBound(tFid)
	if mdCls.Exists(hFid(i)) then
	  mCls(tFid(i))=mdCls(hFid(i))
	else
	  if mdCls.Exists(tFid(i)) then:mCls(tFid(i))=mdCls(tFid(i)):end if
	end if
  next
  if mCls("price")="" then mCls("price")=0
  mCls("name")= replace(replace(filterQuote(replace(trim(mCls("name")),"\","/")),"[","【"),"]","】")
  'if not isNumeric(mCls("type")) then:mCls("type")=newssmartGeneralize(mCls("type"),mCls("title")):end if
  if Fun.computeStrLen(mCls("name"))>115 then:mCls("name")=Fun.getStrByLen(mCls("name"),115):end if
  if eMode<2 then:ProductStorage=true:exit function:end if
  Push Q_WHERE,"{pre}name='"&mCls("name")&"'"
  Q_WHERE=Join(Q_WHERE," OR ")
  if iMode=1 AND Fun.Str2Num(mCls("type"))<>0 then
	tablename="{pre}Product":SET dConn=conn
  else
	if NOT isObject(tConn) then:SET tConn=ConnectTempDataBase():end if
	iMode=0:tablename="{pre}TempProduct":Q_WHERE=Fun.ifthen(not isNull(mCls("fromurl")),"{pre}fromurl='"&mCls("fromurl")&"' OR ","")&Q_WHERE:SET dConn=tConn
  end if
  if iMode<>0 then
    mCls.remove("fromurl"):mCls.remove("typename")
  else
    mCls("inbase")=0
  end if
  mCls("enname")	= MoviePinYin(mCls("name"))
  mCls("letter")	= Left(mCls("enname"),1)
  SET tRs=Conn.db("SELECT TOP 1 {pre}id,{pre}type FROM "&tablename&" WHERE "&Q_WHERE,"execute")
  if tRs.eof then
	 'mCls("Datetime") = mCls("Datetime")
	  sql="INSERT INTO "&tablename&" "&nCls2SQL(mCls,0)
  else
	  mCls("type")=Fun.ifthen(tRs(1)<>0,tRs(1),Str2Num(mCls("type")))
	  sql="UPDATE "&tablename&" SET "&nCls2SQL(mCls,1)&" WHERE {pre}id="&tRs(0)
  end if
  tRs.close:SET tRs=nothing
  Conn.db sql,"execute"
End Function
Function mCls2SQL(ByVal mCls,ByVal iType)
	Dim i,Keys,Vals:Keys=mCls.Keys:Vals=array()
	for i=0 to UBound(Keys)
		if Keys(i)<>"type" AND Keys(i)<>"hit" AND Keys(i)<>"state" AND Keys(i)<>"digg" AND Keys(i)<>"tread" AND Keys(i)<>"publishyear" AND Keys(i)<>"commend" AND Keys(i)<>"wrong" AND Keys(i)<>"topic" then
			Push Vals,"'"&filterQuote(mCls(Keys(i)))&"'"
		else
			Push Vals,mCls(Keys(i))
		end if
		Keys(i)=trim("{pre}"&filterQuote(Keys(i)))
	next
	if iType=0 then
		mCls2SQL="("&Join(Keys,", ")&")VALUES("&Join(Vals,", ")&")"
	else
		for i=0 to UBound(Keys)
			Vals(i)=Keys(i)&"="&Vals(i)
		next
		mCls2SQL = Join(Vals,", ")
	end if
End Function
Function nCls2SQL(ByVal mCls,ByVal iType)
	Dim i,Keys,Vals:Keys=mCls.Keys:Vals=array()
	for i=0 to UBound(Keys)
		if Keys(i)<>"type" AND Keys(i)<>"hit" AND Keys(i)<>"digg" AND Keys(i)<>"tread" AND Keys(i)<>"commend" AND Keys(i)<>"topic" AND Keys(i)<>"price" then
			Push Vals,"'"&filterQuote(mCls(Keys(i)))&"'"
		else
			Push Vals,mCls(Keys(i))
		end if
		Keys(i)=trim("{pre}"&filterQuote(Keys(i)))
	next
	if iType=0 then
		nCls2SQL="("&Join(Keys,", ")&")VALUES("&Join(Vals,", ")&")"
	else
		for i=0 to UBound(Keys)
			Vals(i)=Keys(i)&"="&Vals(i)
		next
		nCls2SQL=Join(Vals,", ")
	end if
End Function
Function GatherTask()
	SET GatherTask=New TGatherTask
End Function
Class TGatherTask
  Private fDATA,fEvent
  Private Sub Class_Initialize()
	SET fEvent=Object():redim fDATA(-1)
  End Sub
  Private Sub Class_Terminate()
	SET fEvent=nothing
  End Sub
  Private Sub add2(Byval url)
	dim i:url=trim(url)
	for i=0 to UBound(fDATA)
	  if not isString(url) OR fDATA(i)=url then
		exit Sub
	  end if
	next
	if url<>"" AND url<>Empty then:Push fDATA,url:end if
  End Sub
  Public Sub add(ByVal vUrl)
	dim i
	if isArray(vUrl) then
	  for i=0 to UBound(vUrl)
		add2 vUrl(i)
	  next
	else
	  add2 vUrl
	end if
  End Sub
  Public Function PopURL()
	if UBound(fDATA)<>-1 then:PopURL=unShift(fDATA):else:PopURL=Empty:end if
  End Function
  Public Function getUrls()
	getUrls = fDATA
  End Function
  Public Function Count()
	Count=UBound(fDATA)+1
  End Function
  Public Property LET onSuccess(ByVal OnFunName)
	fEvent.item("ONSUCCESS")=OnFunName
  End Property
  Public Property GET onSuccess()
	onSuccess=fEvent.item("ONSUCCESS")
  End Property
  Public Sub success(vHTML,vUrl)
	if NOT onSuccess=Empty then:execute("CALL "&Replace(onSuccess,"[arguments]","vHTML, vUrl")):end if
  End Sub
  Public Sub error(num,msg,url)
	if NOT onError=Empty then:execute("CALL "&Replace(onError,"[arguments]","num, msg, url")):end if
  End Sub
  Public Property LET onError(ByVal OnFunName)
	fEvent.item("ONERROR")=OnFunName
  End Property
  
  Public Property GET onError()
	onError=fEvent.item("ONERROR")
  End Property
End Class
Function GatHerProcess(ByVal ID,ByVal Mode)
  SET GatHerProcess=New TGatHerProcess
  SET GatHerProcess.this=GatHerProcess
  GatHerProcess.id=ID
  GatHerProcess.mode = Mode
  if initStep>1 then
	GatHerProcess.fstep = initStep
  end if
End Function
Class TGatHerProcess
	Public Charset,this,fStep,Count,startTime,ID,iPage
	Private prefix,fENV,fInit,Inited,fonprogress,foncomplete,fMode,fMFile,fMfed,fPos,fItemSize,fIgnoreCount
	Private Sub Class_Initialize()
	  prefix="TGATHERPROCESS.":SET fENV = Object():Inited=false:fMode=false:fStep=1:fonprogress=Empty:foncomplete=Empty:fPos=0:Count=0:fItemSize=1:fIgnoreCount=0:StartTime="":iPage=0
	End Sub
	Private Sub Class_Terminate()
	End Sub
	Private Sub writeCache(ByVal mode)
	  on error resume next
	  dim i,t,keys,b:OpenMFile:keys=fENV.keys:b=false
	  for i=0 to UBound(keys)
		  t=fENV(keys(i)).getUrls
		  if UBound(t)>-1 then
			  b=true:fMFile.item(keys(i))=t
		  else
			  fMFile.remove(keys(i))
		  end if
		  if mode=true then:fENV.remove(keys(i)):end if
	  next
	  fMFile.item("GT_INITED")=b:fMFile.item("GT_POS")=readPos:fMFile.item("GT_STARTTIME")=startTime:fMFile.item("GT_COUNT")=Count:fMFile.item("GT_ITEMSIZE")=fItemSize:fMFile.item("GT_IGNORECOUNT")=fIgnoreCount:fMFile.item("GT_IPAGE")=iPage
	  conn.createTextFile Json().var2json(fMFile),getJsonFilePath,"":if err then err.clear:end if
	End Sub
	Private Sub readCache()
	  if Inited then:exit sub:end if:OpenMFile
	  if fMFile.item("GT_INITED")=true then
		  dim i,keys:keys=fENV.keys
		  for i=0 to UBound(keys)
			  if fMFile.Exists(keys(i)) then
				  fENV.item(keys(i)).add(fMFile.item(keys(i)))
			  end if
		  next
		  startTime=fMFile.item("GT_STARTTIME"):writePos fMFile.item("GT_POS"):Count=Fun.Str2Num(fMFile.item("GT_COUNT")):fItemSize=Fun.Str2Num(fMFile.item("GT_ITEMSIZE")):fIgnoreCount=Fun.Str2Num(fMFile.item("GT_IGNORECOUNT")):iPage=fMFile.item("GT_IPAGE"):Inited=true
	  end if
	End Sub
	Private Sub OpenMFile()
	  if fMfed<>true then
		fMfed=true:if not isObject(fMFile) then:SetValue fMFile,ParseJsonFile(getJsonFilePath):end if
		if not isObject(fMFile) then:SET fMFile=Object():end if
	  end if
	End Sub
	Private Function readPos()
		readPos=fPos
	End Function
	Private Sub writePos(Byval Val)
		fPos=Fun.Str2Num(Val)
	End Sub
	Public Property GET itemSize()
		itemSize=fItemSize
	End Property
	Public Property LET itemSize(ByVal iSize)
	  if iSize<>fItemSize AND fItemSize<>1 then:fIgnoreCount=fIgnoreCount+(fItemSize-iSize):end if:if iSize>fItemSize then:fItemSize=iSize:end if
	End Property
	Public Function CreateTask()
	  dim i:i="#"&fENV.Count:SET CreateTask=GatHerTask():SET fENV.item(i)=CreateTask
	End Function
	Public Property GET getJsonFilePath()
	  getJsonFilePath=ENGINEDIR&ESCACHEDIR&ID&".json"
	End Property
	Public Property LET onprogress(ByVal OnFunName)
	  fonprogress=OnFunName
	End Property
	Public Property GET onprogress()
	  onprogress=fonprogress
	End Property
	Public Sub progress(url)
	  writePos readPos+1
	  if mode>=2 then
		writeCache(false)
	  end if
	  if NOT onprogress=Empty then:execute("CALL "&Replace(onprogress,"[arguments]","fIgnoreCount,readPos,url")):end if
	End Sub
	Public Property LET oncomplete(ByVal OnFunName)
	  foncomplete=OnFunName
	End Property
	Public Property GET oncomplete()
	  oncomplete=foncomplete
	End Property
	Public Sub complete()
	  if NOT oncomplete=Empty then:execute("CALL "&Replace(oncomplete,"[arguments]","")):end if
	End Sub
	Public Property LET Init(ByVal FunName)
	  fInit=FunName
	  if not conn.isExistFile(ENGINEDIR&ESCDIR&ID) then:Fun.die "无效的 进程.ID	必需值 #进程标识ID":end if
	  if varComp(mode,false) then:Fun.die "未设置执行模式 进程.mode	必需值(#当前模式)":end if
	  if mode=1 then:exit Property:end if
	  if mode>=2 then:readCache:end if
	  if NOT Inited AND NOT fInit=Empty then:execute("CALL "&Replace(fInit,"[arguments]","this")):end if
	  if NOT Inited then:writePos(0):end if
	  Start()
	  if mode>=2 then:writeCache(true):end if
	End Property
	Public Property GET Init()
	  Init=fInit
	End Property
	Public Property LET mode(Byval Val)
	  dim msg:msg="进程.mode 无效的执行模式 可选值: #当前模式	#演示模式	#不执行	#执行模式"
	  '0.演示模式	1.不执行	2.执行模式
	  if not isNumeric(Val) then:Fun.die msg:end if
	  if Val<0 OR Val > 3 then:Fun.die msg:else:fMode=Val:end if
	End Property
	Public Property GET mode()
	  mode=fMode
	End Property
	Private Sub Start()
	  on error resume next
	  if fENV.count<1 then:exit Sub:end if
	  dim item,Url,Keys,Key:Keys=fENV.Keys:Url=Empty
	  do while IsClientConnected
		Key=Pop(Keys)
		if Key<>Empty then
		  SET item=fENV.item(key):Url=item.PopUrl
		end if
		if Url<>Empty OR UBound(Keys)=-1 then:exit do:end if
	  loop
	  if Url=Empty then:exit Sub:end if
	  progress(Url)
	  Dim txt
	  if gES("pageset")=4 then
		txt=PostHttpTextFile(Url,Charset,gES("pageurl3"))
	  else
		txt=GetHttpTextFile(Url,Charset)
	  end if
	  if err.number=0 then
		item.success txt,Url
	  else
		item.error err.number,err.description,Url:err.clear
	  end if
	  if mode=0 then:fENV.Remove(key):end if
	  SET item=nothing
	  if mode<>0 then:dim i,items,count:items=fENV.items:count=0:for i=0 to UBound(items):if isObject(items(i)) then:count=count+items(i).count:end if:next:if count=0 then:complete:end if:end if
	  fStep=fStep-1:if fStep>0 OR mode=0 then:Start():end if
	End Sub
	Public Sub ExitRun(ByVal Msg)
		Msg=Fun.ifthen(Msg="","采集完成",Msg)
		if Msg<>"" then:Fun.echo "<script>alert('"&EnJsonString(Msg)&"');location.href='../admin_collectnews.asp?main-"&StrSliceB(ID,"","/")&"/.html';</script>":end if
	End Sub
End Class
Function Max(ByVal Num1,ByVal Num2)
	Max=Fun.ifthen(Str2Num(Num1)>Str2Num(Num2),Num1,Num2)
End Function
Function Json()
	Set Json=New JsonCls
End Function
Function ParseJsonFile(ByVal sJsonFile)
  SetValue ParseJsonFile,Json().parseFile(sJsonFile)
End Function

Function ParseJson(ByVal sJson)
	SetValue ParseJson,Json().json2var(sJson)
End Function

Function ReCrlf(ByVal txt)
	ReCrlf=Fun.replaceStr(Fun.replaceStr(txt,chr(10),"\n"),chr(13),"\r")
End Function

Function DeCrlf(ByVal txt)
	DeCrlf=Fun.replaceStr(Fun.replaceStr(txt,"\n",chr(10)),"\r",chr(13))
End Function

Function DeJsonString(ByVal txt)
  if Fun.isNul(txt) OR Len(txt)=0 then:DeJsonString="":exit function:end if
  if Fun.JsIndexOf(txt,"\\")<>-1 then:txt=Replace(txt,"\\","\u005c"):end if
  if Fun.JsIndexOf(txt,"\'")<>-1 then:txt=Replace(txt,"\'","'"):end if
  if Fun.JsIndexOf(txt,"\""")<>-1 then:txt=Replace(txt,"\""",""""):end if
  if Fun.JsIndexOf(txt,"\r")<>-1 then:txt=Replace(txt,"\r",chr(13)):end if
  if Fun.JsIndexOf(txt,"\n")<>-1 then:txt=Replace(txt,"\n",chr(10)):end if
  if Fun.JsIndexOf(txt,"\t")<>-1 then:txt=Replace(txt,"\t",chr(9)):end if
  if Fun.JsIndexOf(txt,"\u")<>-1 then:txt=QUnEscape(txt):end if
  DeJsonString=txt
End Function

Function EnJsonString(ByVal txt)
  if Fun.isNul(txt) OR Len(txt)=0 then:EnJsonString="":exit function:end if
  if Fun.JsIndexOf(txt,"\")<>-1 then:txt=Replace(txt,"\","\\"):end if
  if Fun.JsIndexOf(txt,"'")<>-1 then:txt=Replace(txt,"'","\'"):end if
  'if Fun.JsIndexOf(txt,"""")<>-1 then:txt=Replace(txt,"""","\"""):end if
  if Fun.JsIndexOf(txt,chr(13))<>-1 then:txt=Replace(txt,chr(13),"\r"):end if
  if Fun.JsIndexOf(txt,chr(10))<>-1 then:txt=Replace(txt,chr(10),"\n"):end if
  if Fun.JsIndexOf(txt,chr(9))<>-1 then:txt=Replace(txt,chr(9),"\t"):end if
  EnJsonString=txt'QEscape(txt)
End Function
Function QEscape(ByVal txt)
  if Fun.isNul(txt) OR Len(txt)=0 then:QEscape="":exit function:end if
  QEscape=Unescape(Replace(escape(txt),"%u","\u"))
End Function
Function QUnEscape(ByVal txt)
  if Fun.isNul(txt) OR Len(txt)=0 then:QUnEscape="":exit function:end if
  QUnEscape=Unescape(Replace(txt,"\u","%u"))
End Function
Class JsonCls
	Private Inited,oRg,aRg,dRg,sRg,sRg2,bRg,vRg,fjson

	Private Sub Class_Initialize()
		'echo "JsonCls.Class_Initialize();<br>"
	End Sub

	Private Sub Class_Terminate()
		'echo "JsonCls.Class_Terminate();<br>"
	End Sub

	Private Sub Init()
	  if Inited<>true then
		  Inited=true:SET oRg=jsRegExp("/^\s*\{([\w\W]*)\}/i"):SET aRg=jsRegExp("/^\s*\[([\w\W]*)\]/i"):SET dRg=jsRegExp("/^\s*([\-\+\.0-9]+)[\w\W]*/i"):SET sRg=jsRegExp("/^\s*\""(.*)\""/i"):SET sRg2=jsRegExp("/^\s*(\'(.*)\')/i"):SET bRg=jsRegExp("/^\s*(true|false)[,\s!=]?[\w\W]*/i"):SET vRg=jsRegExp("/^\s*([a-zA-Z\$\_][\w\$\_]*)[,\s!=]?[\w\W]*/i")
	  end if
	End Sub
	Public Function parseFile(ByVal sPath)
	  if conn.isExistFile(sPath) then:fjson=adminFun.LoadFile(sPath):else:fjson="":end if
	  SetValue parseFile,json2var(fjson)
	End Function
	Private Function findSentence(ByVal x)
	  dim sChr,eChr,isStr,sLen,iPos,iCount:x=LTrim(x):iPos=0:iCount=0:isStr=false
	  if x="" then:findSentence="":exit function:end if
	  if dRg.test(x) then
		  iPos=Len(dRg.Replace(x,"$1"))
	  else
		  if bRg.test(x) then
			  iPos=Len(bRg.Replace(x,"$1"))
		  elseif vRg.test(x) then
			  iPos=Len(vRg.Replace(x,"$1"))
		  else
			  sLen=len(x)
			  do while iPos<sLen
				  sChr=jsCharAt(x,iPos):iPos=iPos+1
				  if sChr = "{" OR sChr = "[" then
					  iCount=iCount+1
				  else
					  if sChr = "}" OR sChr = "]" then
						  iCount=iCount-1:if iCount=0 then:exit do:end if
					  else
						  if sChr="""" OR sChr="'" then
							  isStr=iPos=1
							  do while true
								  if IsClientConnected=false then:response.end:end if
								  iPos=iPos+InStr(jsSlice(x,iPos,0),sChr)-1:eChr=jsCharAt(x,iPos):iPos=iPos+1
								  if sChr=eChr AND jsCharAt(x,iPos-2)<>"\" then
									  exit do
								  end if
							  loop
							  if isStr then
								  exit do
							  end if
						  end if
					  end if
				  end if
			  loop
		  end if
	  end if
	  findSentence=array(jsSubstr(x,0,iPos),jsSlice(x,iPos,0))
	End Function
	Private Function ParseObject(ByVal x)
	  Dim key,t,fs:SET t = Object():x=trim(x)
	  if x<>"" then
		  do while true
			  fs=findSentence(x):key=Json2Var(fs(0)):x=jsSlice(fs(1),Fun.JsIndexOf(fs(1),":"),0)
			  fs=findSentence(x):t(key)=Json2Var(fs(0))
			  if fs(1)="" then
				  exit do
			  else
				  x=jsSlice(LTrim(fs(1)),1,0)
			  end if
		  loop
	  end if
	  SET ParseObject=t
	End Function
	Private Function ParseArray(ByVal x)
	  dim fs:ParseArray = Array():if x="" then:exit function:end if
	  do while true
		fs=findSentence(x):Push ParseArray,Json2Var(fs(0))
		if fs(1)="" then
			exit do
		else
			x=jsSlice(LTrim(fs(1)),1,0)
		end if
	  loop
	End Function
	Public Function Json2Var(ByVal x)
	  Init
	  if oRg.test(x) then:SET Json2Var = ParseObject(StrSliceB(x,"{","}")):exit function:end if
	  if aRg.test(x) then:Json2Var = ParseArray(StrSliceB(x,"[","]")):exit function:end if
	  if dRg.test(x) then:Json2Var=Fun.Str2Num(x):exit function:end if
	  if sRg.test(x) then:Json2Var=DeJsonString(StrSliceB(x,"""","""")):exit function:end if
	  if sRg2.test(x) then:Json2Var=DeJsonString(StrSliceB(x,"'","'")):exit function:end if
	  if bRg.test(x) then:Json2Var=CBool(x):exit function:end if
	  Json2Var=x
	End Function
	Public Function Var2Json(ByVal x)
	  Init:on error resume next
	  dim i
	  if isObject(x) then
		if UCASE(typename(x)) = "DICTIONARY" then
		  Dim Keys,ValTxt,key:Keys=x.keys
		  for i=0 to UBound(Keys)
			key = Var2Json(EnJsonString(Keys(i)))
			ValTxt = Var2Json(x.item(Keys(i)))
			Keys(i)=chr(9)&key&": "&ifthen(ValTxt<>"",ValTxt,"""""")
		  next
		  Var2Json="{"&vbcrlf&join(Keys,","&vbcrlf)&vbcrlf&"}"
		else
		  Var2Json="{}"
		end if
		exit function
	  end if
	  if isArray(x) then
		for i=0 to UBound(x):x(i)=Var2Json(x(i)):next
		Var2Json="["&Join(x,",")&"]":exit function
	  end if
	  if isBool(x) then:Var2Json=Fun.ifthen(x=true,"true","false"):exit function:end if
	  if isNumeric(x) then:Var2Json= x:else:Var2Json= "'"&EnJsonString(x)&"'":end if
	End Function
End Class
Function CreateMappingFile(ByVal MarkID)
	SET CreateMappingFile=New TMappingFile:CreateMappingFile.open MarkID,false
End Function
Sub FreeMappingFile(ByVal MarkID)
	CreateMappingFile(MarkID).RemoveAll
End Sub
Class TMappingFile
	Public isCache
	Private fENV,fOpened,fPath,fFName
	Private Sub Class_Initialize()
		SET fENV=Object():fOpened=false:fPath=ENGINEDIR&ESCACHEDIR:isCache=false
	End Sub

	Private Sub Class_Terminate()
		SaveToFile:fENV.Removeall():SET fENV=Nothing
	End Sub

	Private Function getPath()
		if isCache then
			getPath=fPath&fFName&".tmp"
		else
			getPath=StrSliceB(fPath&fFName,"",".")&".json"
		end if
	end function

	Public Sub Open(ByVal MarkID,ByVal bMode)
		if not conn.isExistFile(ENGINEDIR&ESCDIR&MarkID) then:Fun.die "无效的 进程.ID	必需值 #进程标识ID":end if
		fFName=MarkID:fOpened=true
		if bMode = false then
			if conn.isExistFile(getPath) then
				on error resume next
				SET fENV=nothing:SetValue fENV,ParseJsonFile(getPath)
				if err.number>0 then
					delFile getPath
					Fun.die "映象文件已损坏: "&getPath
				end if
			end if
		end if
	End Sub

	Private Function toString()
		toString=Json().Var2Json(fENV)
	End Function

	Public Sub SaveToFile()
		if not fOpened then:exit Sub:end if
		if fENV.Count=0 then
			delFile getPath
		else
			if not conn.createTextFile(toString,getPath,"gb2312") then:Fun.echo"创建或写入“"&getPath&"”映象文件失败，请检查目录(读/写)权限，检查空间是不是满了":end if
		end if
	End Sub

	Public Sub Remove(ByVal Key)
		fENV.Remove(Key)
	End Sub

	Public Sub RemoveAll()
		fENV.RemoveAll
	End Sub

	Public Default Property GET Item(ByVal Key)
		Item=fENV(Key)
	End Property

	Public Property LET Item(ByVal Key,ByVal Val)
		fENV(Key)=Val
	End Property

	Public Function Exists(ByVal keyName)
		Exists=fENV.Exists(keyName)
	End Function

	Public Property GET Items()
		Items=fENV.Items
	End Property

	Public Property GET Keys()
		Keys=fENV.Keys
	End Property

	Public Function Count()
		Count=fENV.Count
	End Function
End Class
%>