<%@language=vbscript codepage=936 %>
<%
'|-----------------------------------------------------------------------|
'|---------飞越软件信息采集器v1.0 for 动易网站管理系统2005/2006 ---------|
'|-------------------------- 作者:科技创造自由 --------------------------|
'|------------------ 飞越快乐家园  http://www.fy66.net/ -----------------|
'|--动易版主Top在本插件的编写过程中给予了大力支持,特此表示诚恳的感谢!----|
'|------ 本插件多处代码参考了SNA新闻采集系统for动易4.03,特此声明! -------|
'|----- 转载请保留版权信息,手下留情,留下的是对别人的尊重,谢谢! ----------|
'|-----------------------------------------------------------------------|
option explicit
response.buffer=true	
Const PurviewLevel=1
Server.ScriptTimeOut=999999999
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1 
Response.Expires = 0 
Response.CacheControl = "no-cache"
%>
<!--#include file="../conn.asp"-->
<!--#include file="../inc/Function.asp"-->
<!--#include file="Admin_ChkPurview.asp"-->
<!--#include file="Admin_ST_Conn.asp"-->
<!--#include file="Admin_ST_Function.asp"-->
<html>
<head>
<title>软件采集系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

<link rel="stylesheet" type="text/css" href="Admin_Style.css">
</head>
<body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr class='topbg'> 
    <td height="22" colspan="2" align="center" ><strong>采 集 系 统 项 目 管 理</strong></td>
  </tr>
</table>

<%
'基本参数
Dim SqlItem,RsItem,ItemNum,ItemStr,ItemStr1,ListNum,SuccNum,FailNum,ItemID,ItemEnd,ListUrl,ListCode,LinksArray,ListArray,OrderTemp,Arr_j,CollecTest,ListEnd,LinksCode,LinksUrl,Larri,Larrj,Larrz,tDownloadUrls,sDownLoadUrls,XsStringbtxt,tXsStringbtxt,dd
Dim Url_i,Urlstr1,Urlstr2,Urlstr3,stChannelDir
Dim sUploadDir
Dim SaveDir
Dim FileExt,FileName,InputType,ListPaingNext,StartTime,tKeyword
Dim SoftPicName,SoftPicExt,SoftPictemp,ttKeyword,Yearnow,Monthnow,Daynow

Dim Arr_Filters

'采集入库变量
Dim SoftIntro,SoftID
Dim SoftName,DownloadUrls,SoftVersion,Author,CopyFrom,DemoUrl,RegUrl,UpdateTime,Keyword,OperatingSystem,SoftType,SoftLanguage
Dim CopyrightType,SoftSize,SoftPicUrl,DecompressPassword

'错误参数
Dim stFoundErr,stErrMsg,isRepeat

'项目信息
Dim ItemName,stChannelID,stClassID,stSpecialID,WebName,WebUrl,ItemDemo,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse
Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3
Dim HsString,HoString,HttpUrlType,HttpUrlStr,TsString,ToString,CsString,CoString,AuthorType,AsString,AoString,AuthorStr
Dim UpdateTimeType,UsString,UoString,UpdateTimeStr,CopyFromType,FsString,FoString,CopyFromStr,KeyType,KsString,KoString,KeyStr
Dim NewsPaingType,NPsString,NPoString,NewsPaingStr1,NewsPaingStr2,Flag,DsStringbType,DsStringb,DoStringb,DsStringbb,DoStringbb
Dim XsStringbType,XsStringb,XoStringb,XsStringbb,XoStringbb,BsStringbType,BsStringb,BoStringb,BoStringbstr,YsStringbType,YsStringb,YoStringb,YoStringbstr
Dim PsStringbType,PsStringb,PoStringb,PoStringbstr,HsStringbType,HsStringb,HoStringb,HoStringbstr,JsStringbType,JsStringb,JoStringb,JoStringbstr
Dim SsStringbType,SsStringb,SoStringb,SoStringbstr,ZsStringbType,ZsStringb,ZoStringb,ZoStringbstr,LsStringbType,LsStringb,LoStringb,LoStringbstr
Dim MsStringbType,MsStringb,MoStringb,MoStringbstr,QsStringbType,QsStringb,QoStringb,QoStringbstr
Dim Script_IFRAME,Script_OBJECT,Script_SCRIPT,Script_Div,Script_CLASS,Script_Span,Script_IMG,Script_FONT,Script_A,Script_HTML
Dim CollectionNum,CollectionType,SkinID,TemplateID,OnTop,Hot,Elite,Hits,Stars,ShowCommentLink,Script_Table,Script_Tr,Script_Td
Dim CollecOrder,Passed,CreateImmediate,SaveFiles,lasttimestr,FileSavebType,FileSavebNum,FileSavebstr,SaveNameTypeb,SoftPoint

ItemNum=Clng(Trim(Request("ItemNum")))		'第N个项目
ItemStr=Trim(Request("ItemStr"))			'项目数组
ListNum=Clng(Trim(Request("ListNum")))		'第N个列表
SuccNum=Clng(Trim(Request("SuccNum")))		'成功数
FailNum=Clng(Trim(Request("FailNum")))		'失败数
ListPaingNext=Trim(Request("ListPaingNext"))'下一页地址
CollecTest=Clng(Trim(Request("CollecTest")))'是否仅为测试采集
InputType=Trim(Request("InputType"))'下一页地址

if InputType="" then
	InputType=1'默认是否为更新模式,1为是,0为否
End if
'判断并获取项目ID和项目信息,当前列表地址
If ItemStr="" Then
	stFoundErr=True
	stErrMsg="<br><li>参数错误，请选择项目！</li>"
Else
	ItemStr1=Split(ItemStr,",")
	If (ItemNum-1)>Ubound(ItemStr1) then
		ItemEnd=True
		stFoundErr=True
		stErrMsg="<br><li>全部项目采集任务完成</li>"&"<br><li>成功采集： "&SuccNum&"  条,失败： "&FailNum&"  条</li>"
		%>
		
						<meta http-equiv="refresh" content="3;url=Admin_ST_Collectino.asp">

		<%
	Else
		ItemID=Clng(ItemStr1(ItemNum-1))
		Call GetItemDate(ItemID)			'获取项目信息
		if stFoundErr<>True then
			Call GetNowUrl()				'获取当前列表页地址
			If CollectionNum="" or CollectionNum=0 then
			Elseif CollectionType=0 and Clng(CollectionNum)=SuccNum and CollectionNum<>""   then
				ListEnd=True
			Elseif CollectionType=1 and Clng(CollectionNum)<ListNum and Clng(CollectionNum)>0 and CollectionNum<>"" then
				ListEnd=True
			End if
			if ListEnd=True then
				stFoundErr=True
				ItemNum=ItemNum+1
				ListNum=1
				stErrMsg="<br><li>该项目采集任务完成</li>"
				stErrMsg=stErrMsg&"<br><li>此项目共采集 "&SuccNum+FailNum&" 个下载，成功 "&SuccNum&" 个，失败 "&FailNum&" 个。</li>"
%>
				<meta http-equiv="refresh" content="3;url=Admin_ST_Collecting.asp?ItemNum=<%=ItemNum%>&ListNum=<%=ListNum%>&SuccNum=<%=SuccNum%>&FailNum=<%=FailNum%>&ListPaingNext=<%=ListPaingNext%>&ItemStr=<%=ItemStr%>&InputType=<%=InputType%>&CollecTest=<%=CollecTest%>">
<%
			End if
		End if
	End If
End If
If stFoundErr=True then
	Call WriteSuccMsg1(stErrMsg)
	Response.end
End if

'采集登录
If stFoundErr<>True And LoginType=1 then
	'登录网站
	LoginData=UrlEncoding(LoginUser & "&" & LoginPass)
	LoginResult=PostHttpPage(LoginUrl,LoginPostUrl,LoginData)
	If Instr(LoginResult,LoginFalse)>0 Then
		stFoundErr=True
		stErrMsg=stErrMsg & "<br><li>在登录网站时发生错误，请确保登录信息的正确性！</li>"
	End If
End If

'截取列表
If stFoundErr<>True then
	'编码转换
	ListCode=GetHttpPage(ListUrl)
	if weburl=0 then
	elseif weburl=1 then
		ListCode=UTF2GB(ListCode)
	elseif weburl=2 then
	
	End if
	Call GetNextUrl()
	If ListCode="$False$" Then
		stFoundErr=True
		stErrMsg=stErrMsg & "<br><li>在获取：" & ListUrl & "网页源码时发生错误！</li>"
	Else
		ListCode=GetBody(ListCode,LsString,LoString,False,False)
		If ListCode="$False$" Or ListCode="" Then
			stFoundErr=True
			stErrMsg=stErrMsg & "<br><li>在截取：" & ListUrl & "列表时发生错误！</li>"
		End If
	End If
End If


'获取链接列表
If stFoundErr<>True Then
	LinksArray=GetArray(ListCode,HsString,HoString,False,False)
	If LinksArray="$False$" Then
		stFoundErr=True
		stErrMsg=stErrMsg & "<br><li>在分析：" & ListUrl & "软件列表时发生错误！</li>"
	Else
		LinksArray=Split(LinksArray,"$Array$")
		For Arr_j=0 to Ubound(LinksArray)
			If HttpUrlType=1 Then
				LinksArray(Arr_j)=Trim(Replace(HttpUrlStr,"{$ID}",LinksArray(Arr_j)))
			Else
				LinksArray(Arr_j)=Trim(DefiniteUrl(LinksArray(Arr_j),ListUrl))
			End If
		Next
		If CollecOrder=True Then
			For Arr_j=0 to Fix(Ubound(LinksArray)/2)
				OrderTemp=LinksArray(Arr_j)
				LinksArray(Arr_j)=LinksArray(Ubound(LinksArray)-Arr_j)
				LinksArray(Ubound(LinksArray)-Arr_j)=OrderTemp
			Next
		End If
	End If
End If

If stFoundErr=True then
	Call WriteErrMsg1(stErrMsg)
	Response.End
ELse%>

	<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" >
	    <tr><td height="22" colspan="2" class="tdbg" align="left">&nbsp;&nbsp;采集需要一定的时间，请耐心等待，如果网站出现暂时无法访问的情况这是正常的，采集过程正常结束后即可恢复。&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button"  name="Stop"  value="停止采集"  onCLICK="location.href='Admin_ST_Collectino.asp'"></td></tr>
	    <tr><td height="22" colspan="2" class="tdbg" align="left">&nbsp;&nbsp;本次运行：1 个项目,正在采集第 <font color=red><%=ItemNum%></font> 个项目  <font color=red><%=ItemName%></font>  的第   <font color=red><%=ListNum%></font> 页列表,该列表待采集软件  <font color=red><%=Ubound(LinksArray)+1%></font> 条。</tr>
	    <tr><td height="22" colspan="2" class="tdbg" align="left">&nbsp;&nbsp;采集统计：成功采集--<%=SuccNum%>  个软件，失败--<%=FailNum%>  个</td></tr>
	</table><br>
<%	Response.Flush()'刷新
StartTime=Timer()
End if

'开始采集
If stFoundErr<>True Then
	Call GetFilters()
	For Arr_j=0 to Ubound(LinksArray)
	'For Arr_j=0 to 0
		stFoundErr=False
		stErrMsg=""
		DownLoadUrls=""
		Larrz=0
		If CollecTest=1 And Arr_j=10 Then
			Exit For
		End If
		if CollectionNum="" or CollectionNum=0 then
		Elseif clng(CollectionNum)<=SuccNum and CollectionType=0 Then
			Exit For
		End If

		LinksUrl=LinksArray(Arr_j)		
      '……………………………………………… 
      If Response.IsClientConnected Then 
         Response.Flush 
      Else 
         Response.End 
      End If
      '………………………………………………

      If CollecTest<>1 Then
         SqlItem ="select top 1 HistrolyNewsID,SoftID,Title,NewsCollecDate,NewsUrl,Result from HistrolyNews where NewsUrl='" & LinksUrl & "'"
         Set RsItem=ConnItem.Execute(SqlItem)
         If Not RsItem.Eof And Not RsItem.Bof Then
          if InputType=1 then
          Else
            'His_Repeat=True
            stFoundErr=True
            stErrMsg=stErrMsg & "<br><li>目标软件：<a href='Admin_ArticleShow.asp?ArticleID=" & RsItem("SoftID") & "' target=_blank><font color=red>"
            If RsItem("Title")="" then
               stErrMsg=stErrMsg & LinksUrl
            Else
               stErrMsg=stErrMsg & RsItem("Title")
            End If
            stErrMsg=stErrMsg & "</font></a>  已存在，不予采集。"
            stErrMsg=stErrMsg & "<br><li>采集时间：" & RsItem("NewsCollecDate") & "</li>"
            stErrMsg=stErrMsg & "<br><li>软件来源：<a href='" & LinksUrl & "' target=_blank>"&LinksUrl&"</a>"
            stErrMsg=stErrMsg & "<br><li>提示信息：如想再次采集，请先将该软件的历史记录<font color=red>"&RsItem("HistrolyNewsID")&"删除</font></li>"
            If RsItem("Result")=True  Then
                  stErrMsg=stErrMsg &  "<br><li>以及主数据库中的软件删除</li>"
            End  If
           End if
         End If
         RsItem.Close
         Set RsItem=Nothing
      End If
		
		
		'获取内容页面源代码
		If stFoundErr<>True Then
			LinksCode=GetHttpPage(LinksUrl)			
			If LinksCode="$False$" Then
				stFoundErr=True
				stErrMsg=stErrMsg & "<li>在获取：" & LinksUrl & "新闻源码时发生错误！</li><br>"
			End If
		End If
		
		'LinksCode=dvhtmlencode1(LinksCode)
		
		'获取软件标题
		If stFoundErr<>True Then
			SoftName=GetBody(LinksCode,TsString,ToString,False,False)
			If SoftName="$False$" or SoftName="" then
				stFoundErr=True
				stErrMsg=stErrMsg & "<li>在采集：" & LinksUrl & "软件标题时发生错误</li><br>"
				'写入历史记录
				If CollecTest<>1 Then
					SqlItem="INSERT INTO HistrolyNews(HistrolyID,ItemID,ChannelID,ClassID,NewsCollecDate,NewsUrl,Result) VALUES ('1','"&ItemID&"','"&stChannelID&"','"&stClassID&"','"&now()&"','"&LinksUrl&"',False)"
					ConnItem.Execute(SqlItem)
				End if
			Else
				SoftName=FpHtmlEnCode(SoftName)
				SoftName=dvhtmlencode(SoftName)
			End if
		End If
		
		'获取下载地址
		If stFoundErr<>True Then
			if DsStringbType=0 then
				DownLoadUrls="下载地址1|"&LinksUrl
			Else		
				sDownLoadUrls=GetArray(GetBody(LinksCode,DsStringb,DoStringb,False,False),DsStringbb,DoStringbb,False,False)
				sDownLoadUrls=Split(sDownLoadUrls,"$Array$")
				For Larri=0 to Ubound(sDownloadUrls)
					if Larrz=Clng(FileSavebNum) and Clng(FileSavebNum)>0 then'最多采集多少个下载地址
						Exit for
					End if
					tDownloadUrls=Trim(DefiniteUrl(sDownloadUrls(Larri),LinksUrl))
					if XsStringbType=1 then					
         				XsStringbtxt=GetBody(GetHttpPage(tDownloadUrls),XsStringb,XoStringb,False,False)
         				XsStringbtxt=GetArray(XsStringbtxt,XsStringbb,XoStringbb,False,False)
         				XsStringbtxt=Split(XsStringbtxt,"$Array$")
         				For Larrj=0 to Ubound(XsStringbtxt)
         					If Larrz=Clng(FileSavebNum) and Clng(FileSavebNum)>0 then'新页面最多采集多少个下载地址
         						Exit For
         					End if
         					tXsStringbtxt= Trim(DefiniteUrl(XsStringbtxt(Larrj),tDownloadUrls))         					
         					if tXsStringbtxt<>"$False$" and tXsStringbtxt<>"" then
         						if Larri>0 or Larrj>0 then DownloadUrls=DownloadUrls&"$$$"
         						Larrz=Larrz+1
								DownloadUrls=DownloadUrls&"下载地址"&Larrz&"|"&tXsStringbtxt
							End if
						Next
					Else
						tXsStringbtxt=Trim(DefiniteUrl(sDownloadUrls(Larri),LinksUrl))
						if tXsStringbtxt<>"$False$" and tXsStringbtxt<>"" then
							if Larri>0 then DownloadUrls=DownloadUrls&"$$$"
							Larrz=Larrz+1
							DownloadUrls=DownloadUrls&"下载地址"&Larrz&"|"&tXsStringbtxt
						End if
					End if
				Next
			End if
			If DownLoadUrls="$False$" or DownLoadUrls="" then
				stFoundErr=True
				stErrMsg=stErrMsg & "<li>在采集：" & LinksUrl & "软件下载地址时发生错误</li><br>"
				'写入历史记录
				If CollecTest<>1 Then
					SqlItem="INSERT INTO HistrolyNews(HistrolyID,ItemID,ChannelID,ClassID,NewsCollecDate,NewsUrl,Result) VALUES ('1','"&ItemID&"','"&stChannelID&"','"&stClassID&"','"&now()&"','"&LinksUrl&"',False)"
					ConnItem.Execute(SqlItem)
				End if
			End if			
		End if
		
		'获取软件添加时间
		If UpdateTimeType=1 Then
			UpdateTime=GetBody(LinksCode,UsString,UoString,False,False)
		ElseIf UpdateTimeType=2 Then
			UpdateTime=UpdateTimeStr
		Else
			UpdateTime=Now()
		End If
		if UpdateTime<>"" and IsDate(UpdateTime)=true then
			UpdateTime=CDate(UpdateTime)
		else
			UpdateTime=now()
		end if
		
		'获取软件简介
		If stFoundErr<>True Then
			SoftIntro=GetBody(LinksCode,CsString,CoString,False,False)
			If SoftIntro="$False$" or SoftIntro="" then
				SoftIntro=SoftName
			Else
				'SoftIntro=dvhtmlencode(SoftIntro)
			End if
			Call Filters
			Call FilterScript
		End If
		
		If stFoundErr<>True Then
			'获取软件版本
			if BsStringbType=1 then				
				SoftVersion=GetBody(LinksCode,BsStringb,BoStringb,False,False)
			Elseif BsStringbType=2 then
				SoftVersion=BoStringbstr
			Else
				SoftVersion=""
			End if
			SoftVersion=FpHtmlEncode(SoftVersion)
    	    SoftVersion=dvhtmlencode(SoftVersion)
    	    If SoftVersion="" or SoftVersion="$False$" Then
				SoftVersion=""
			Else
				If Len(SoftVersion)>100 Then 
					SoftVersion=Left(SoftVersion,100)
				End If
			End If
		
			'获取软件作者
			if AuthorType=1 then				
				Author=GetBody(LinksCode,AsString,AoString,False,False)
			Elseif AuthorType=2 then
				Author=AuthorStr
			Else
				Author="不详"
			End if
			Author=FpHtmlEncode(Author)
         	Author=dvhtmlencode(Author)
         	If Author="" or Author="$False$" Then
				Author="不详"
			Else
				If Len(Author)>30 Then 
				Author=Left(Author,30)
				End If
			End If
		
			'获取软件解压密码
			if JsStringbType=1 then				
				DecompressPassword=GetBody(LinksCode,JsStringb,JoStringb,False,False)
			Elseif JsStringbType=2 then
				DecompressPassword=JoStringbstr
			Else
				DecompressPassword=""
			End if
			DecompressPassword=FpHtmlEncode(DecompressPassword)
    	    DecompressPassword=dvhtmlencode(DecompressPassword)
    	    If DecompressPassword="" or DecompressPassword="$False$" Then
				DecompressPassword=""
			Else
				If Len(DecompressPassword)>50 Then 
					DecompressPassword=Left(DecompressPassword,50)
				End If
			End If
		
			'获取软件来源
			if CopyFromType=1 then				
				CopyFrom=GetBody(LinksCode,FsString,FoString,False,False)
			Elseif CopyFromType=2 then
				CopyFrom=CopyFromStr
			Else
				CopyFrom="不详"
			End if
			CopyFrom=FpHtmlEncode(CopyFrom)
         	CopyFrom=dvhtmlencode(CopyFrom)
         	If CopyFrom="" or CopyFrom="$False$" Then
				CopyFrom="不详"
			Else
				If Len(CopyFrom)>255 Then 
				CopyFrom=Left(CopyFrom,255)
				End If
			End If
			
			'获取软件演示地址
			if SsStringbType=1 then				
				DemoUrl=GetBody(LinksCode,SsStringb,SoStringb,False,False)
			Elseif SsStringbType=2 then
				DemoUrl=SoStringbstr
			Else
				DemoUrl="http://"
			End if
			DemoUrl=FpHtmlEncode(DemoUrl)
         	DemoUrl=dvhtmlencode(DemoUrl)
         	If DemoUrl="" or DemoUrl="$False$" Then
				DemoUrl="http://"
			Else
				If Len(CopyFrom)>200 Then 
				DemoUrl=Left(DemoUrl,200)
				End If
			End If
			
			'获取软件注册地址
			if ZsStringbType=1 then				
				RegUrl=GetBody(LinksCode,ZsStringb,ZoStringb,False,False)
			Elseif ZsStringbType=2 then
				RegUrl=ZoStringbstr
			Else
				RegUrl="http://"
			End if
			RegUrl=FpHtmlEncode(RegUrl)
         	RegUrl=dvhtmlencode(RegUrl)
         	If RegUrl="" or RegUrl="$False$" Then
				RegUrl="http://"
			Else
				If Len(RegUrl)>200 Then 
				RegUrl=Left(RegUrl,200)
				End If
			End If
			
			'获取软件关键字
			Keyword=""
			tKeyword=""
			if KeyType=1 then				
				Keyword="|"&GetBody(LinksCode,KsString,KoString,False,False)&"|"
			Elseif KeyType=2 then
				ttKeyword=ReplaceKeyChar(SoftName)
				For dd=1 to len(ttKeyword)-1
					tKeyword=tKeyword&"|"&mid(ttKeyword,dd,2)
				Next
				Keyword="|"&Replace(KeyStr,"{$SoftName$}",SoftName)
				Keyword=Replace(Keyword,"{$tKeyword$}",tKeyword)
				Keyword="|"&Keyword&"|"
			Else
				ttKeyword=ReplaceKeyChar(SoftName)
				if ttKeyword>20 then
					ttKeyword=Left(ttKeyword,20)
				End if
				For dd=1 to len(ttKeyword)-1
					Keyword=Keyword&"|"&mid(ttKeyword,dd,2)
				Next
				Keyword="|"&Keyword&"|"
			End if
			Keyword=FpHtmlEncode(Keyword)
         		Keyword=dvhtmlencode(Keyword)
         		If Keyword="" or Keyword="$False$" Then
				For dd=1 to len(SoftName)-1
					Keyword=Keyword&"|"&mid(SoftName,dd,2)
				Next
				Keyword="|"&Keyword&"|"				
			Else
				If Len(Keyword)>255 Then
				Keyword=Left(Keyword,254)&"|"
				End If
			End If
		
			'获取软件运行环境(操作系统)
			if HsStringbType=1 then				
				OperatingSystem=GetBody(LinksCode,HsStringb,HoStringb,False,False)
			Elseif HsStringbType=2 then
				OperatingSystem=HoStringbstr
			Else
				OperatingSystem="Win9x/NT/2000/XP/2003"
			End if
			OperatingSystem=FpHtmlEncode(OperatingSystem)
    	    OperatingSystem=dvhtmlencode(OperatingSystem)
    	    If OperatingSystem="" or OperatingSystem="$False$" Then
				OperatingSystem="Win9x/NT/2000/XP/2003"
			Else
				If Len(OperatingSystem)>100 Then 
					OperatingSystem=Left(OperatingSystem,100)
				End If
			End If
			
			'获取软件类别
			if LsStringbType=1 then				
				SoftType=GetBody(LinksCode,LsStringb,LoStringb,False,False)
			Elseif LsStringbType=2 then
				SoftType=LoStringbstr
			Else
				SoftTyp="通用"
			End if
			SoftType=FpHtmlEncode(SoftType)
    	    SoftType=dvhtmlencode(SoftType)
    	    If SoftType="" or SoftType="$False$" Then
				SoftType="通用"
			Else
				If Len(SoftType)>50 Then 
					SoftType=Left(SoftType,50)
				End If
			End If
			
			'获取软件语言
			if YsStringbType=1 then				
				SoftLanguage=GetBody(LinksCode,YsStringb,YoStringb,False,False)
			Elseif YsStringbType=2 then
				SoftLanguage=YoStringbstr
			Else
				SoftLanguage="中文"
			End if
			SoftLanguage=FpHtmlEncode(SoftLanguage)
    	    SoftLanguage=dvhtmlencode(SoftLanguage)
    	    If SoftLanguage="" or SoftLanguage="$False$" Then
				SoftLanguage="中文"
			Else
				If Len(SoftLanguage)>50 Then 
					SoftLanguage=Left(SoftLanguage,50)
				End If
			End If
			
			'获取软件授权形式
			if QsStringbType=1 then				
				CopyrightType=GetBody(LinksCode,QsStringb,QoStringb,False,False)
			Elseif QsStringbType=2 then
				CopyrightType=QoStringbstr
			Else
				CopyrightType="免费"
			End if
			CopyrightType=FpHtmlEncode(CopyrightType)
    	    CopyrightType=dvhtmlencode(CopyrightType)
    	    If CopyrightType="" or CopyrightType="$False$" Then
				CopyrightType="免费"
			Else
				If Len(CopyrightType)>50 Then 
					CopyrightType=Left(CopyrightType,50)
				End If
			End If
			
			'获取软件大小
			if MsStringbType=1 then				
				SoftSize=GetBody(LinksCode,MsStringb,MoStringb,False,False)
			Elseif MsStringbType=2 then
				SoftSize=MoStringbstr
			Else
				SoftSize=0
			End if
			SoftSize=FpHtmlEncode(SoftSize)
    	    SoftSize=Clng(dvhtmlencode(SoftSize))
    	    If SoftSize="" or SoftSize="$False$" Then
				SoftSize=0
			Else
				SoftSize=FormatNum(SoftSize)
				If Len(SoftSize)>20 Then 
					SoftSize=Left(SoftSize,20)
				End If
			End If
			
			'获取软件图片
			Yearnow=Year(now)
			Monthnow=Month(now)
			Daynow=Day(now)
			if Monthnow<10 then Monthnow="0"&Monthnow
			if Daynow<10 then Daynow="0"&Daynow
			if PsStringbType=1 then				
				SoftPicUrl=GetBody(LinksCode,PsStringb,PoStringb,False,False)
				SoftPicUrl=Trim(DefiniteUrl(SoftPicUrl,LinksUrl))
			Elseif PsStringbType=2 then
				SoftPicUrl=PoStringbstr
			Else
				SoftPicUrl=""
			End if
			SoftPicUrl=FpHtmlEncode(SoftPicUrl)
    	    SoftPicUrl=dvhtmlencode(SoftPicUrl)
    	    If SoftPicUrl="" or SoftPicUrl="$False$" Then
				SoftPicUrl=""
			Else
				If Len(SoftPicUrl)>255 Then 
					SoftPicUrl=Left(SoftPicUrl,255)
				End If
				'保存图片
				if SaveFiles=1 or SaveFiles=2 then
					SoftPicName = LCase(Mid(SoftPicUrl, InStrRev(SoftPicUrl, "/")+1))
					SoftPictemp=SaveDir
					SoftPictemp=Replace(SoftPictemp,"{$Year$}",Yearnow)
					SoftPictemp=Replace(SoftPictemp,"{$Month$}",Monthnow)
					SoftPictemp=Replace(SoftPictemp,"{$Day$}",Daynow)
					if SaveFiles=2 then
						SoftPicExt = LCase(Mid(SoftPicName, InStrRev(SoftPicName, ".")+1))
						if SoftPicExt="" then
							SoftPicExt="st!"
						End if
						SoftPicName="UploadSoftPic/"&SoftPictemp&"/"&Yearnow&monthnow&daynow&hour(now)&minute(now)&second(now)&int(999*rnd)&"."&SoftPicExt
					Elseif SaveFiles=1 then
						SoftPicName="UploadSoftPic/"&SoftPictemp&"/"&SoftPicName
					End if
					if CollecTest<>1 then
						Call GetChannelDir(stChannelID)
						Call CZdir(InstallDir&stChannelDir&"/UploadSoftPic/"&SoftPictemp&"/")
						Call SaveRemoteFile(InstallDir&stChannelDir&"/"&SoftPicName,SoftPicUrl)'保存
					End if
					SoftPicUrl=SoftPicName
				End if
			End If
		End If
		If stFoundErr<>True then
			if FileSavebType=1 then
				'远程保存文件
				Urlstr1=Split(DownloadUrls,"$$$")	'分解地址列表
				DownloadUrls=""						'地址列表初始化
				for Url_i=0 to Ubound(Urlstr1)
					Urlstr2=Split(Urlstr1(Url_i),"|")
					FileName = LCase(Mid(Urlstr2(1), InStrRev(Urlstr2(1), "/")+1))
					FileExt = LCase(Mid(FileName, InStrRev(FileName, ".")+1))
					Call GetChannelDir(2)
					Call CZdir(InstallDir,stChannelDir,sUploadDir,SaveDir)
					if SaveNameTypeb=1 then
						Urlstr3=SaveDir&"/"&yearnow&monthnow&daynow&hour(now)&minute(now)&second(now)&int(999*rnd)&"."&FileExt
					else
						Urlstr3=SaveDir&"/"&FileName
					End if
					If CollecTest<>1 then
						'Call SaveRemoteFile(stChannelDir&"/"&sUploadDir&"/"&Urlstr3,Urlstr2(1))'保存文件列表	
					End if
								
					'重新组合地址列表
					if Url_i>0 then
						DownloadUrls=DownloadUrls&"$$$"
					End if
					DownloadUrls=DownloadUrls&Urlstr2(0)&"|"&Urlstr3				
				Next
			Elseif FileSavebType=2 then			
				'远程保存文件
				Urlstr1=Split(DownloadUrls,"$$$")	'分解地址列表
				DownloadUrls=""					'地址列表初始化
				for Url_i=0 to Ubound(Urlstr1)
					Urlstr2=Split(Urlstr1(Url_i),"|")
					FileName = LCase(Mid(Urlstr2(1), InStrRev(Urlstr2(1), "/")+1))
					FileExt = LCase(Mid(FileName, InStrRev(FileName, ".")+1))
					Call GetChannelDir(stChannelID)
					SaveDir=Replace(SaveDir,"{$Year$}",Yearnow)
					SaveDir=Replace(SaveDir,"{$Month$}",Monthnow)
					SaveDir=Replace(SaveDir,"{$Day$}",Daynow)
					Response.write format(day(now),"dd")
					if SaveNameTypeb=1 then
						Urlstr3=yearnow&monthnow&daynow&hour(now)&minute(now)&second(now)&int(999*rnd)&"."&FileExt
					else
						Urlstr3=FileName
					End if
					Call CZdir(InstallDir&stChannelDir&"/"&sUploadDir&"/"&SaveDir&"/")
					If CollecTest<>1 then
						Call SaveRemoteFile(InstallDir&stChannelDir&"/"&sUploadDir&"/"&SaveDir&"/"&Urlstr3,Urlstr2(1))'保存文件	
					End if
								
					'重新组合地址列表
					if Url_i>0 then
						DownloadUrls=DownloadUrls&"$$$"
					End if
					DownloadUrls=DownloadUrls&Urlstr2(0)&"|"&SaveDir&"/"&Urlstr3				
				Next
			End if
		If CollecTest<>1 then
			Call InputDate()'入库
			'写入历史记录
			If isRepeat=True and InputType=1 then
			Else
				SqlItem="INSERT INTO HistrolyNews(HistrolyID,ItemID,ChannelID,ClassID,SoftID,Title,NewsCollecDate,NewsUrl,Result) VALUES ('1','"&ItemID&"','"&stChannelID&"','"&stClassID&"','"&SoftID&"','"&SoftName&"','"&now()&"','"&LinksUrl&"',True)"
				ConnItem.Execute(SqlItem)
			End if

		End if
			stErrMsg=stErrMsg& "软件标题：<font color=red>"&SoftName&"</font><br>"
			stErrMsg=stErrMsg& "下载地址："&DownloadUrls&"<br>"
			stErrMsg=stErrMsg& "添加时间："&UpdateTime&"<br>"
			stErrMsg=stErrMsg& "关 键 字："&Keyword&"<br>"
			stErrMsg=stErrMsg& "软件作者："&Author&"<br>"
			stErrMsg=stErrMsg& "软件来源："&CopyFrom&"<br>"
			'stErrMsg=stErrMsg& "软件版本："&SoftVersion&"<br>"
			'stErrMsg=stErrMsg& "运行环境："&OperatingSystem&"<br>"
			'stErrMsg=stErrMsg& "软件类别："&SoftType&"<br>"
			'stErrMsg=stErrMsg& "软件语言："&SoftLanguage&"<br>"			
			'stErrMsg=stErrMsg& "授权形式："&CopyrightType&"<br>"
			stErrMsg=stErrMsg& "软件大小："&SoftSize&" K <br>"
			stErrMsg=stErrMsg& "软件图片："&SoftPicUrl&"<br>"			
			'stErrMsg=stErrMsg& "软件解压密码："&DecompressPassword&"<br>"			
			'stErrMsg=stErrMsg& "软件演示地址："&DemoUrl&"<br>"
			'stErrMsg=stErrMsg& "软件注册地址："&RegUrl&"<br>"
			stErrMsg=stErrMsg& "软件简介："&Left(SoftIntro,40)&"...<br>"
			SuccNum=SuccNum+1
		Else
			FailNum=FailNum+1
		End if
		Call WriteMsg(stErrMsg)
		Response.Flush()'刷新(如不刷新,则需要该页软件采集完才显示出来)
		
	Next
%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" >
  <tr>   <td height="22" align="left" class="tdbg">&nbsp;&nbsp;数据整理中，3 秒后继续......3秒后如果还没反应请点击 <a href='Admin_ST_Collecting.asp?ItemNum=<%=ItemNum%>&ListNum=<%=ListNum+1%>&SuccNum=<%=SuccNum%>&FailNum=<%=FailNum%>&ListPaingNext=<%=ListPaingNext%>&ItemStr=<%=ItemStr%>&InputType=<%=InputType%>&CollecTest=<%=CollecTest%>'><font color=red>这里</font></a> 继续<br>    &nbsp;&nbsp;执行时间：<%=CStr(FormatNumber((Timer()-StartTime)*1000,2))%> 毫秒    </td>  </tr>  <tr> 
    <td height="22"  class="tdbg" align="left">&nbsp;&nbsp;采集需要一定的时间，请耐心等待，如果网站出现暂时无法访问的情况这是正常的，采集过程正常结束后即可恢复。
      &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button"  name="Stop"  value="停止采集"  onCLICK="location.href='Admin_ST_Collectino.asp'">
    </td>
  </tr>
</table>
<meta http-equiv="refresh" content="3;url=Admin_ST_Collecting.asp?ItemNum=<%=ItemNum%>&ListNum=<%=ListNum+1%>&SuccNum=<%=SuccNum%>&FailNum=<%=FailNum%>&ListPaingNext=<%=ListPaingNext%>&ItemStr=<%=ItemStr%>&InputType=<%=InputType%>&CollecTest=<%=CollecTest%>">
<%
   'Response.Write "<meta http-equiv=""refresh"" content=""5;url=www.fy66.net>"
End IF%>












<%
'读取项目信息,参数:ItemID
Sub GetItemDate(ItemID)
	Dim SqlItem,RsItem
	SqlItem ="select * from Item where ItemID="&ItemID
	Set RsItem=Server.CreateObject("adodb.recordset")
	RsItem.Open SqlItem,ConnItem,1,1
	If RsItem.eof or RsItem.bof then
		stFoundErr=True
		stErrMsg="<br><li>参数错误，请选择项目！</li>"
	Else
		ItemName=RsItem("ItemName")
		stChannelID=RsItem("ChannelID")
		stClassID=RsItem("ClassID")
		stSpecialID=RsItem("SpecialID")
		WebName=RsItem("WebName")
		WebUrl=RsItem("WebUrl")
		ItemDemo=RsItem("ItemDemo")
		LoginType=RsItem("LoginType")
		LoginUrl=RsItem("LoginUrl")
		LoginPostUrl=RsItem("LoginPostUrl")
		LoginUser=RsItem("LoginUser")
		LoginPass=RsItem("LoginPass")
		LoginFalse=RsItem("LoginFalse")
		ListStr=RsItem("ListStr")
		LsString=RsItem("LsString")
		LoString=RsItem("LoString")
		ListPaingType=RsItem("ListPaingType")
		LPsString=RsItem("LPsString")
		LPoString=RsItem("LPoString")
		ListPaingStr1=RsItem("ListPaingStr1")
		ListPaingStr2=RsItem("ListPaingStr2")
		ListPaingID1=RsItem("ListPaingID1")
		ListPaingID2=RsItem("ListPaingID2")
		ListPaingStr3=RsItem("ListPaingStr3")
		HsString=RsItem("HsString")
		HoString=RsItem("HoString")
		HttpUrlType=RsItem("HttpUrlType")
		HttpUrlStr=RsItem("HttpUrlStr")
		TsString=RsItem("TsString")
		ToString=RsItem("ToString")
		CsString=RsItem("CsString")
		CoString=RsItem("CoString")
		AuthorType=RsItem("AuthorType")
		AsString=RsItem("AsString")
		AoString=RsItem("AoString")
		AuthorStr=RsItem("AuthorStr")
		UpdateTimeType=RsItem("UpdateTimeType")
		UsString=RsItem("UsString")
		UoString=RsItem("UoString")
		UpdateTimeStr=RsItem("UpdateTimeStr")
		CopyFromType=RsItem("CopyFromType")
		FsString=RsItem("FsString")
		FoString=RsItem("FoString")
		CopyFromStr=RsItem("CopyFromStr")
		KeyType=RsItem("KeyType")
		KsString=RsItem("KsString")
		KoString=RsItem("KoString")
		KeyStr=RsItem("KeyStr")
		NewsPaingType=RsItem("NewsPaingType")
		NPsString=RsItem("NPsString")
		NPoString=RsItem("NPoString")
		NewsPaingStr1=RsItem("NewsPaingStr1")
		NewsPaingStr2=RsItem("NewsPaingStr2")
		Flag=RsItem("Flag")
		DsStringbType=RsItem("DsStringbType")
		DsStringb=RsItem("DsStringb")
		DoStringb=RsItem("DoStringb")
		DsStringbb=RsItem("DsStringbb")
		DoStringbb=RsItem("DoStringbb")
		XsStringbType=RsItem("XsStringbType")
		XsStringb=RsItem("XsStringb")
		XoStringb=RsItem("XoStringb")
		XsStringbb=RsItem("XsStringbb")
		XoStringbb=RsItem("XoStringbb")
		BsStringbType=RsItem("BsStringbType")
		BsStringb=RsItem("BsStringb")
		BoStringb=RsItem("BoStringb")
		BoStringbstr=RsItem("BoStringbstr")
		YsStringbType=RsItem("YsStringbType")
		YsStringb=RsItem("YsStringb")
		YoStringb=RsItem("YoStringb")
		YoStringbstr=RsItem("YoStringbstr")
		PsStringbType=RsItem("PsStringbType")
		PsStringb=RsItem("PsStringb")
		PoStringb=RsItem("PoStringb")
		PoStringbstr=RsItem("PoStringbstr")
		HsStringbType=RsItem("HsStringbType")
		HsStringb=RsItem("HsStringb")
		HoStringb=RsItem("HoStringb")
		HoStringbstr=RsItem("HoStringbstr")
		JsStringbType=RsItem("JsStringbType")
		JsStringb=RsItem("JsStringb")
		JoStringb=RsItem("JoStringb")
		JoStringbstr=RsItem("JoStringbstr")
		SsStringbType=RsItem("SsStringbType")
		SsStringb=RsItem("SsStringb")
		SoStringb=RsItem("SoStringb")
		SoStringbstr=RsItem("SoStringbstr")
		ZsStringbType=RsItem("ZsStringbType")
		ZsStringb=RsItem("ZsStringb")
		ZoStringb=RsItem("ZoStringb")
		ZoStringbstr=RsItem("ZoStringbstr")
		LsStringbType=RsItem("LsStringbType")
		LsStringb=RsItem("LsStringb")
		LoStringb=RsItem("LoStringb")
		LoStringbstr=RsItem("LoStringbstr")
		MsStringbType=RsItem("MsStringbType")
		MsStringb=RsItem("MsStringb")
		MoStringb=RsItem("MoStringb")
		MoStringbstr=RsItem("MoStringbstr")
		QsStringbType=RsItem("QsStringbType")
		QsStringb=RsItem("QsStringb")
		QoStringb=RsItem("QoStringb")
		QoStringbstr=RsItem("QoStringbstr")
		Script_IFRAME=RsItem("Script_IFRAME")
		Script_OBJECT=RsItem("Script_OBJECT")
		Script_SCRIPT=RsItem("Script_SCRIPT")
		Script_Div=RsItem("Script_Div")
		Script_CLASS=RsItem("Script_CLASS")
		Script_Span=RsItem("Script_Span")
		Script_IMG=RsItem("Script_IMG")
		Script_FONT=RsItem("Script_FONT")
		Script_A=RsItem("Script_A")
		Script_HTML=RsItem("Script_HTML")
		CollectionNum=RsItem("CollectionNum")
		CollectionType=RsItem("CollectionType")
		SkinID=RsItem("SkinID")
		TemplateID=RsItem("TemplateID")
		OnTop=RsItem("OnTop")
		Hot=RsItem("Hot")
		Elite=RsItem("Elite")
		Hits=RsItem("Hits")
		Stars=RsItem("Stars")
		ShowCommentLink=RsItem("ShowCommentLink")
		Script_Table=RsItem("Script_Table")
		Script_Tr=RsItem("Script_Tr")
		Script_Td=RsItem("Script_Td")
		CollecOrder=RsItem("CollecOrder")
		Passed=RsItem("Passed")
		CreateImmediate=RsItem("CreateImmediate")
		SaveFiles=RsItem("SaveFiles")
		lasttimestr=RsItem("lasttimestr")
		FileSavebType=RsItem("FileSavebType")
		FileSavebNum=RsItem("FileSavebNum")
		FileSavebstr=RsItem("FileSavebstr")
		SaveNameTypeb=RsItem("SaveNameTypeb")
		SaveDir=RsItem("SaveDir")
		SoftPoint=RsItem("SoftPoint")
		

		
	End if	
	RsItem.Close
	Set RsItem=Nothing
End Sub

'数据入库
Sub InputDate()
	Dim SqlItem,RsItem
	isRepeat=False
	Set RsItem=Server.CreateObject("adodb.recordset")
	if InputType=1 then
		RsItem.Open "select * from PE_Soft order by SoftID desc",Conn,1,1
		If not(RsItem.eof or RsItem.bof)then
			SoftID=RsItem("SoftID")
		End if
		RsItem.close
		RsItem.Open "select * from PE_Soft where Deleted=False and SoftName='" & SoftName& "' order by SoftID desc",Conn,1,3
		If RsItem.eof or RsItem.bof then
			RsItem.addnew
			RsItem("SoftID")=SoftID+1
			SoftID=SoftID+1
		Else
			isRepeat=True
			SoftID=RsItem("SoftID")
		End if
	Else
		RsItem.Open "select * from PE_Soft order by SoftID desc",Conn,1,3
		if RsItem.eof or RsItem.bof then
			SoftID=SoftID+1
		Else
			SoftID=RsItem("SoftID")+1			
		End if
		RsItem.addnew
		RsItem("SoftID")=SoftID
	End if
	RsItem("ChannelID")=stChannelID
	RsItem("ClassID")=stClassID
	if Edition<>2006 then
		RsItem("SpecialID")=stSpecialID
	End if
	RsItem("Keyword")=Keyword
	RsItem("SoftName")=SoftName
	RsItem("SoftIntro")=SoftIntro
	RsItem("SoftVersion")=SoftVersion
	RsItem("OperatingSystem")=OperatingSystem
	RsItem("Author")=Author
	RsItem("CopyFrom")=CopyFrom
	RsItem("DemoUrl")=DemoUrl
	RsItem("Hits")=Hits
	RsItem("DayHits")=Hits
	RsItem("WeekHits")=Hits
	RsItem("MonthHits")=Hits
	RsItem("UpdateTime")=UpdateTime
	RsItem("SoftType")=SoftType
	RsItem("SoftLanguage")=SoftLanguage
	RsItem("CopyrightType")=CopyrightType
	RsItem("SoftSize")=SoftSize
	RsItem("RegUrl")=RegUrl
	RsItem("OnTop")=OnTop
	RsItem("Elite")=Elite
	if Edition=2006 then
		if Passed=true then	RsItem("status")=3
	else
		RsItem("Passed")=Passed
	End if
	RsItem("SoftPicUrl")=SoftPicUrl
	RsItem("DownloadUrl")=DownloadUrls
	RsItem("Stars")=Stars
	if Edition=2006 then
		RsItem("InfoPoint")=SoftPoint
	else
		RsItem("SoftPoint")=SoftPoint
	End if
	RsItem("Inputer")=AdminName
	RsItem("Editor")=AdminName
	
	RsItem("TemplateID")=TemplateID
	RsItem("SkinID")=SkinID
	RsItem("LastHitTime")=now()
	RsItem("DecompressPassword")=DecompressPassword
	
	RsItem.Update	
	RsItem.Close
	Set RsItem=Nothing
End sub








%><%
'获取当前分析列表页地址
'输出参数:ListUrl
Sub GetNowUrl()
	If ListPaingType=0 Then
		If ListNum=1 Then
			ListUrl=ListStr
		Else
			ListEnd=True
		End If
	ElseIf ListPaingType=1 Then
		If ListNum=1 Then
			ListUrl=ListStr
		Else
			If ListPaingNext="" or ListPaingNext="$False$" Then
				ListEnd=True
			Else
				If Instr(ListPaingNext,"{$ID}")>0  Then
					ListPaingNext=Replace(ListPaingNext,"{$ID}","&")
				End  If
				ListUrl=ListPaingNext
			End If
		End If
	ElseIf ListPaingType=2 Then
		If (ListPaingID1+ListNum-1)>ListPaingID2  Then
			ListEnd=True
		Else
			ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1+ListNum-1))
		End If
	ElseIf ListPaingType=3  Then
		ListArray=Split(ListPaingStr3,"|")
		If (ListNum-1)>Ubound(ListArray) Then
			ListEnd=True
		Else
			ListUrl=ListArray(ListNum-1)
		End If    
	End If
End Sub

'获取下一页分析列表页地址
Sub GetNextUrl()

   If ListPaingType=1 Then
'   Response.write "-"
      ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
      If ListPaingNext<>"$False$"  Then
         If ListPaingStr1<>""  Then  
            ListPaingNext=Replace(ListPaingStr1,"{$ID}",ListPaingNext)
         Else
            ListPaingNext=DefiniteUrl(ListPaingNext,ListUrl)
         End If
      End If
      If  Instr(ListPaingNext,"&")>0  Then
            ListPaingNext=Replace(ListPaingNext,"&","{$ID}")
      End  If
   Else
      ListPaingNext="$False$"
   End If
End Sub

'获取频道上传目录
'参数 ChannelID
Sub GetChannelDir(ChannelID)
	dim rrs,rsql
	set rrs=server.createobject("adodb.recordset")
	rsql="select UploadDir,ChannelDir from PE_Channel where ChannelID="&ChannelID&""
	rrs.open rsql,Conn,1,1
	stChannelDir=rrs("ChannelDir")
	sUploadDir=rrs("UploadDir")
	rrs.close
	set rrs=nothing
End Sub

Sub CZdir(Dirstr)
	Dim FSO,Dirstrtemp,Dirstritem,i
	Set FSO = Server.CreateObject("Scripting.FileSystemObject")
		'On Error Resume Next
	Dirstr=Replace(Dirstr,"/","\")
	Dirstr=Replace(Dirstr,"\\","\")
	Dirstr=Replace(Dirstr,":","：")
	Dirstr=Replace(Dirstr,"*","")
	Dirstr=Replace(Dirstr,"?","？")
	Dirstr=Replace(Dirstr,"""","")
	Dirstr=Replace(Dirstr,"<","《")
	Dirstr=Replace(Dirstr,">","》")
	Dirstr=Replace(Dirstr,"|","")
	if Left(Dirstr,1)<>"\" then Dirstr="\"&Dirstr
	if fso.FolderExists(Server.MapPath(Dirstr))=False then
		Dirstritem=Split(Dirstr, "\")

		For i = 1 To UBound(Dirstritem)
			If Dirstritem(i) <> "" Then
				Dirstrtemp= Dirstrtemp& "\" & Dirstritem(i)
				If fso.FolderExists(Server.MapPath(Dirstrtemp)) = False Then
					fso.CreateFolder Server.MapPath(Dirstrtemp)
				End If
			End If
		Next
	End if
	Set FSO = Nothing
End sub


'**************************************************
'过程名：WriteErrMsg1
'作  用：显示错误提示信息
'参  数：无
'**************************************************
Sub WriteErrMsg1(ErrMsg)
    Dim strErr
    strErr = strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
    strErr = strErr & "<link href='Admin_Style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbCrLf
    strErr = strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
    strErr = strErr & "  <tr align='center' class='title'><td height='22'><strong>错误信息</strong></td></tr>" & vbCrLf
    strErr = strErr & "  <tr class='tdbg'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & ErrMsg & "</td></tr>" & vbCrLf
    strErr = strErr & "  <tr align='center' class='tdbg'><td>"
    strErr = strErr & "<a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a>"
    strErr = strErr & "</td></tr></table></body></html>" & vbCrLf
    Response.Write strErr
End Sub

'**************************************************
'过程名：WriteSuccMsg1
'作  用：显示错误提示信息
'参  数：无
'**************************************************
Sub WriteSuccMsg1(ErrMsg)
    Dim strErr
    strErr = strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
    strErr = strErr & "  <tr align='center' class='title'><td height='22'><strong>恭喜你!</strong></td></tr>" & vbCrLf
    strErr = strErr & "  <tr class='tdbg'><td height='100' valign='top'>" & ErrMsg & "</td></tr>" & vbCrLf
    strErr = strErr & "  <tr align='center' class='tdbg'><td>"
    strErr = strErr & "<a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a>"
    strErr = strErr & "</td></tr></table>" & vbCrLf
    Response.Write strErr
End Sub


'**************************************************
'过程名：WriteMsg
'作  用：显示其他提示信息
'参  数：无
'**************************************************
Sub WriteMsg(Msg)
	Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'><tr><td height='22' colspan='2' align='left' class='title'>No:<font color=red>"&SuccNum&"</font></td></tr><tr><td colspan='2' align='left' class='tdbg'>"
	Response.Write Msg
	Response.Write "</td></tr></table><br>"
End Sub


'==================================================
'过程名：GetFilters
'作  用：提取过滤信息
'参  数：无
'==================================================
Sub GetFilters()
Dim SqlF,RSF
   SqlF ="Select * from Filters Where Flag=True and ItemID=" & ItemID & " or ItemID=0 order by FilterID ASC"
   Set RSF=connItem.Execute(SqlF)
   If RsF.Eof And RsF.Bof Then
   Else
      Arr_Filters=RsF.GetRows()
   End If
   RsF.Close
   Set RsF=Nothing
End Sub

'==================================================
'过程名：Filters
'作  用：过滤
'参  数：ConStr ------ 要过滤的字符串
'参  数：ItemID ------ 项目ID
'参  数：FilterType -------- 过滤类型，1为标题，2为正文
'==================================================
Sub Filters()
Dim Filteri,FilterStr
If IsNull(Arr_Filters)=True or IsArray(Arr_Filters)=False Then
   Exit Sub
End if

   For Filteri=0 to Ubound(Arr_Filters,2)
      If Arr_Filters(3,Filteri)=1 Then'标题过滤
         If Arr_Filters(4,Filteri)=1 Then
            SoftName=Replace(SoftName,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
         ElseIf Arr_Filters(4,Filteri)=2 Then
            FilterStr=GetBody(SoftName,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
            Do While FilterStr<>"$False$"
               SoftName=Replace(SoftName,FilterStr,Arr_Filters(8,Filteri))
               FilterStr=GetBody(SoftName,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
            Loop
         End If
      ElseIf Arr_Filters(3,Filteri)=2 Then'正文过滤
         If Arr_Filters(4,Filteri)=1 Then
            'Do While Instr(SoftIntro,Arr_Filters(5,Filteri))=True
               SoftIntro=Replace(SoftIntro,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
            'Loop
         ElseIf Arr_Filters(4,Filteri)=2 Then
            FilterStr=GetBody(SoftIntro,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
            Do While FilterStr<>"$False$"
               SoftIntro=Replace(SoftIntro,FilterStr,Arr_Filters(8,Filteri))
               FilterStr=GetBody(SoftIntro,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
            Loop
         End If
      End If
   Next
End Sub

'==================================================
'过程名：FilterScript
'作  用：脚本过滤
'==================================================

Sub  FilterScript()
   If Script_Iframe=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Iframe",1)
   End If
   If Script_Object=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Object",2)
   End If
   If Script_Script=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Script",2)
   End If
   If Script_Font=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Font",3)
   End If
   If Script_A=True Then
      SoftIntro=ScriptHtml(SoftIntro,"A",3)
   End If
   
   If Script_Table=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Table",3)
   End If
   If Script_Tr=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Tr",3)
   End If
   If Script_Td=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Td",3)
   End If
   If Script_Div=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Div",3)
   End If
   If Script_CLASS=True Then
      SoftIntro=ScriptHtml(SoftIntro,"CLASS",3)
   End If
   If Script_Span=True Then
      SoftIntro=ScriptHtml(SoftIntro,"Span",3)
   End If
   If Script_IMG=True Then
      SoftIntro=ScriptHtml(SoftIntro,"IMG",3)
   End If
   If Script_HTML=True Then
	  SoftIntro=dvhtmlencode(SoftIntro)
   End If   
   
End  Sub
%>