<%
'=====================================================================
' 软件名称：w163采集管理系统
' 当前版本：1.0
' 更新日期：2006-11-6
' 官方网站：w163建站(www.w163.cn)

''QQ：85651782



'=====================================================================
Dim sk,SKThumb
Set sk = New w163_cj
Set SKThumb=New Thumb
Class w163_cj
Private PicUrls_i,NewsUrlPaing_s,NewsUrlPaing_o,NewsPaingNext_Code,TypeArray_Url,TypeNews_Url  
Public sub item_sql(sqllx)
dim sqltiem
if sqllx <> "" and sqllx="edit" or sqllx="add" then
if sqllx="add" then 
SqlItem="Select top 1 * from Item"
else
SqlItem="select top 1 * from Item where ItemID="& ItemID
end if
   Set RsItem=server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,1,3
   if sqllx="add" then RsItem.AddNew
       	RsItem("ItemName")=ItemName
		RsItem("ClassID")=ClassID
	   	'RsItem("SpecialID")=SpecialID
		RsItem("selEncoding")=selEncoding
	   	RsItem("WebUrl")=WebUrl
	   	RsItem("ListStr")= ListStr
		RsItem("ListPaingType")=ListPaingType
		RsItem("LPsString")=LPsString
		RsItem("LPoString")=LPoString
		RsItem("ListPaingStr2")=ListPaingStr2
	    Select Case ListPaingType
		   Case 0 
				  ListUrl=ListStr
		   Case 1
			  RsItem("ListPaingStr2")=ListPaingStr2
			  RsItem("ListPaingID1")=ListPaingID1
			  RsItem("ListPaingID2")=ListPaingID2
			  ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1))
		   Case 2
			  RsItem("ListPaingStr3")=ListPaingStr3
			  If  Instr(ListPaingStr3,"|")>0  Then
					ListUrl=Left(ListPaingStr3,Instr(ListPaingStr3,"|")-1)
			  Else
					ListUrl=ListPaingStr3
			  End  If
		End Select
	   	RsItem("Colleclx")=3
		If Passed="yes" Then
			 RsItem("Passed")=1
		Else
			 RsItem("Passed")=0
		End If
		If SaveFiles="yes" Then
			 RsItem("SaveFileUrl")=SaveFileUrl
			 RsItem("SaveFiles")=1
		Else
			 RsItem("SaveFiles")=0
		End If
		if Thumb_WaterMark="yes" then  RsItem("Thumb_WaterMark")=1 else  RsItem("Thumb_WaterMark")=0 end if	
		If CollecOrder="yes" Then
			 RsItem("CollecOrder")=1
		Else
			 RsItem("CollecOrder")=0
		End If
		      If Script_Iframe="yes" Then
         RsItem("Script_Iframe")=1
      Else
         RsItem("Script_Iframe")=0
      End If
      If Script_Object="yes" Then
         RsItem("Script_Object")=1
      Else
         RsItem("Script_Object")=0
      End If
      If Script_Script="yes" Then
         RsItem("Script_Script")=1
      Else
         RsItem("Script_Script")=0
      End If
      If Script_Div="yes" Then
         RsItem("Script_Div")=1
      Else
         RsItem("Script_Div")=0
      End If
      If Script_Class="yes" Then
         RsItem("Script_Class")=1
      Else
         RsItem("Script_Class")=0
      End If
      If Script_Span="yes" Then
         RsItem("Script_Span")=1
      Else
         RsItem("Script_Span")=0
      End If
      If Script_Img="yes" Then
         RsItem("Script_Img")=1
      Else
         RsItem("Script_Img")=0
      End If
      If Script_Font="yes" Then
         RsItem("Script_Font")=1
      Else
         RsItem("Script_Font")=0
      End If
      If Script_A="yes" Then
         RsItem("Script_A")=1
      Else
         RsItem("Script_A")=0
      End If
      If Script_Html="yes" Then
         RsItem("Script_Html")=1
      Else
         RsItem("Script_Html")=0
      End If
	  If Script_Table="yes" Then
         RsItem("Script_Table")=1
      Else
         RsItem("Script_Table")=0
      End If
	  If Script_Tr="yes" Then
         RsItem("Script_Tr")=1
      Else
         RsItem("Script_Tr")=0
      End If
	  If Script_Td="yes" Then
         RsItem("Script_Td")=1
      Else
         RsItem("Script_Td")=0
      End If	  	  
	  RsItem("Stars")=Stars
      RsItem("ReadPoint")=ReadPoint
      RsItem("Hits")=Hits
	  if CollecNewsNum="" then  CollecNewsNum=0
	  RsItem("CollecNewsNum")=CollecNewsNum
	  RsItem("Colleclx")=cint(Colleclx)

	  if sqllx="add" then ItemID=RsItem("ItemID")
   RsItem.UpDate
   RsItem.Close
   Set RsItem=Nothing
end if
end sub
Public sub Article_Err_msg(erron)
select case erron
case 1
ItemName=Trim(Request.Form("ItemName"))
ChannelID=Trim(Request.Form("ChannelID"))
ClassID=Trim(Request.Form("ClassID"))
SpecialID=Trim(Request.Form("SpecialID"))
selEncoding=Trim(Request.Form("selEncoding"))
WebUrl=Trim(Request.Form("WebUrl"))
Colleclx=Trim(Request.Form("Colleclx"))
ListStr=Trim(Request.Form("ListStr"))
ListPaingType=Trim(Request.Form("ListPaingType"))
ListPaingStr2=Trim(Request.Form("ListPaingStr2"))
ListPaingID1=Trim(Request.Form("ListPaingID1"))
ListPaingID2=Trim(Request.Form("ListPaingID2"))
ListPaingStr3=Trim(Request.Form("ListPaingStr3"))
Passed=Trim(Request.Form("Passed"))
SaveFiles=Trim(Request.Form("SaveFiles"))
Thumb_WaterMark=Request.Form("Thumb_WaterMark")
SaveFileUrl=Trim(Request.Form("SaveFileUrl"))
Script_Iframe=Trim(Request.Form("Script_Iframe"))
Script_Object=Trim(Request.Form("Script_Object"))
Script_Script=Trim(Request.Form("Script_Script"))
Script_Div=Trim(Request.Form("Script_Div"))
Script_Class=Trim(Request.Form("Script_Class"))
Script_Span=Trim(Request.Form("Script_Span"))
Script_Img=Trim(Request.Form("Script_Img"))
Script_Font=Trim(Request.Form("Script_Font"))
Script_A=Trim(Request.Form("Script_A"))
Script_Html=Trim(Request.Form("Script_Html"))
Script_Table=Trim(Request.Form("Script_Table"))
Script_Tr=Trim(Request.Form("Script_Tr"))
Script_Td=Trim(Request.Form("Script_Td"))
Stars=Trim(Request.Form("Stars"))
ReadPoint=Trim(Request.Form("ReadPoint"))
Hits=Trim(Request.Form("Hits"))
Colleclx=Request.Form("Colleclx")
CollecNewsNum=Request.Form("CollecNewsNum")
If ItemName="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>项目名称不能为空</li>"
End If
If WebUrl="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>网站网址不能为空</li>" 
End If
If ClassID=0 Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>未指定栏目分类</li>"
End if
If ListStr="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>远程列表URL不能为空</li>" 
End If
If ListPaingType="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
Else
   ListPaingType=Clng(ListPaingType)
   Select Case ListPaingType
   Case 0
   Case 1
      If ListPaingStr2="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成字符不能为空</li>"
      End If
      If isNumeric(ListPaingID1)=False or isNumeric(ListPaingID2)=False Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成的范围只能是数字</li>"
      Else
         ListPaingID1=Clng(ListPaingID1)
         ListPaingID2=Clng(ListPaingID2)
         If ListPaingID1=0 And ListPaingID2=0 Then
            FoundErr=True
            ErrMsg=ErrMsg & "<br><li>批量生成范围设置不正确</li>"
         End If
      End If
   Case 2
      If ListPaingStr3="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>列表索引分页不能为空，请手动添加</li>"
      Else
         ListPaingStr3=Replace(ListPaingStr3,CHR(13),"|") 
      End If
   Case Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
   End Select
End if
If Stars="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请选择文章评分等级！</li>"
Else
   Stars=Clng(Stars)
End If
If ReadPoint="" Then
   ReadPoint=0
Else
   ReadPoint=Clng(ReadPoint)
End if
If Hits="" Then
   Hits=0
Else
   Hits=Clng(Hits)
End if
case 2 
if Action1="" and Action="s2" then
Set RsItem=ConnItem.execute("select * from Item where ItemID=" & ItemID)
	  LsString=RsItem("LsString")
   	  LoString=RsItem("LoString")
	  HsString=RsItem("HsString")
  	  HoString=RsItem("HoString")
  	  ListUrl=RsItem("ListStr")
	  imhstr=RsItem("imhstr")
      imostr=RsItem("imostr")
	  x_tp=RsItem("x_tp")
	  RsItem.close
	  set RsItem=nothing
	  action1="edit"
else
LsString=Request.Form("LsString")
LoString=Request.Form("LoString")
HsString=Request.Form("HsString")
HoString=Request.Form("HoString")
imhstr=Request.Form("imhstr")
imostr=Request.Form("imostr")
x_tp=Request.Form("x_tp")	
Colleclx=Request.Form("Colleclx")  
end if
If ItemID="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>参数错误，请从有效链接进入</li>"
Else
   ItemID=Clng(ItemID)
End If
If LsString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>列表开始代码不能为空</li>"
End If
If LoString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>列表结束代码不能为空</li>" 
End If
If HsString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>链接开始代码不能为空</li>"
End If
If HoString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>链接结束代码不能为空</li>" 
End If
if FoundErr<>True Then
   SqlItem="Select * from Item Where ItemID=" & ItemID 
   Set RsItem=server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,1,3
  	  RsItem("LsString")=LsString
   	  RsItem("LoString")=LoString
	  RsItem("HsString")=HsString
  	  RsItem("HoString")=HoString
  	  ListUrl=RsItem("ListStr")
	  RsItem("x_tp")=x_tp
	  if x_tp=1 then
	  RsItem("imhstr")=imhstr
      RsItem("imostr")=imostr
	  
	  end if
   RsItem.UpDate
   RsItem.Close
   Set RsItem=Nothing
end if   
case 3
if Action1="add" or Action1="edit"  then
call SaveEdit
end if
If FoundErr<>True And Request.Form("ShowCode")="checkbox" Then
call GetTest()
End if
end select
End Sub 
Public sub Err_msg(erron)
select case erron
case 1
ItemName=Trim(Request.Form("ItemName"))
ChannelID=Trim(Request.Form("ChannelID"))
ClassID=Trim(Request.Form("ClassID"))
SpecialID=Trim(Request.Form("SpecialID"))
selEncoding=Trim(Request.Form("selEncoding"))
WebUrl=Trim(Request.Form("WebUrl"))
Colleclx=Trim(Request.Form("Colleclx"))
ListStr=Trim(Request.Form("ListStr"))
ListPaingType=Trim(Request.Form("ListPaingType"))
ListPaingStr2=Trim(Request.Form("ListPaingStr2"))
ListPaingID1=Trim(Request.Form("ListPaingID1"))
ListPaingID2=Trim(Request.Form("ListPaingID2"))
ListPaingStr3=Trim(Request.Form("ListPaingStr3"))
Passed=Trim(Request.Form("Passed"))
SaveFiles=Trim(Request.Form("SaveFiles"))
Thumb_WaterMark=Request.Form("Thumb_WaterMark")
SaveFileUrl=Trim(Request.Form("SaveFileUrl"))
Script_Iframe=Trim(Request.Form("Script_Iframe"))
Script_Object=Trim(Request.Form("Script_Object"))
Script_Script=Trim(Request.Form("Script_Script"))
Script_Div=Trim(Request.Form("Script_Div"))
Script_Class=Trim(Request.Form("Script_Class"))
Script_Span=Trim(Request.Form("Script_Span"))
Script_Img=Trim(Request.Form("Script_Img"))
Script_Font=Trim(Request.Form("Script_Font"))
Script_A=Trim(Request.Form("Script_A"))
Script_Html=Trim(Request.Form("Script_Html"))
Script_Table=Trim(Request.Form("Script_Table"))
Script_Tr=Trim(Request.Form("Script_Tr"))
Script_Td=Trim(Request.Form("Script_Td"))
Stars=Trim(Request.Form("Stars"))
ReadPoint=Trim(Request.Form("ReadPoint"))
Hits=Trim(Request.Form("Hits"))
Colleclx=Request.Form("Colleclx")
CollecNewsNum=Request.Form("CollecNewsNum")
If ItemName="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>项目名称不能为空</li>"
End If
If WebUrl="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>网站网址不能为空</li>" 
End If
If ClassID=0 Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>未指定栏目分类</li>"
End if
If ListStr="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>远程列表URL不能为空</li>" 
End If
If ListPaingType="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
Else
   ListPaingType=Clng(ListPaingType)
   Select Case ListPaingType
   Case 0
   Case 1
      If ListPaingStr2="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成字符不能为空</li>"
      End If
      If isNumeric(ListPaingID1)=False or isNumeric(ListPaingID2)=False Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成的范围只能是数字</li>"
      Else
         ListPaingID1=Clng(ListPaingID1)
         ListPaingID2=Clng(ListPaingID2)
         If ListPaingID1=0 And ListPaingID2=0 Then
            FoundErr=True
            ErrMsg=ErrMsg & "<br><li>批量生成范围设置不正确</li>"
         End If
      End If
   Case 2
      If ListPaingStr3="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>列表索引分页不能为空，请手动添加</li>"
      Else
         ListPaingStr3=Replace(ListPaingStr3,CHR(13),"|") 
      End If
   Case Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
   End Select
End if
If Stars="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请选择文章评分等级！</li>"
Else
   Stars=Clng(Stars)
End If
If ReadPoint="" Then
   ReadPoint=0
Else
   ReadPoint=Clng(ReadPoint)
End if
If Hits="" Then
   Hits=0
Else
   Hits=Clng(Hits)
End if
case 2
if Action1="" and Action="s2" then
Set RsItem=ConnItem.execute("select * from Item where ItemID=" & ItemID)
	  LsString=RsItem("LsString")
   	  LoString=RsItem("LoString")
	  HsString=RsItem("HsString")
  	  HoString=RsItem("HoString")
  	  ListUrl=RsItem("ListStr")
	  imhstr=RsItem("imhstr")
      imostr=RsItem("imostr")
	  x_tp=RsItem("x_tp")
	  x_tpUrl=RsItem("x_tpUrl")
	  RsItem.close
	  set RsItem=nothing
	  action1="edit"
else
LsString=Request.Form("LsString")
LoString=Request.Form("LoString")
HsString=Request.Form("HsString")
HoString=Request.Form("HoString")
imhstr=Request.Form("imhstr")
imostr=Request.Form("imostr")
x_tp=Request.Form("x_tp")
x_tpUrl=Request.Form("x_tpUrl")
Colleclx=Request.Form("Colleclx")  
end if
If ItemID="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>参数错误，请从有效链接进入</li>"
Else
   ItemID=Clng(ItemID)
End If
If LsString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>列表开始代码不能为空</li>"
End If
If LoString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>列表结束代码不能为空</li>" 
End If
If HsString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>链接开始代码不能为空</li>"
End If
If HoString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>链接结束代码不能为空</li>" 
End If
if FoundErr<>True Then
   SqlItem="Select * from Item Where ItemID=" & ItemID 
   Set RsItem=server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,1,3
  	  RsItem("LsString")=LsString
   	  RsItem("LoString")=LoString
	  RsItem("HsString")=HsString
  	  RsItem("HoString")=HoString
  	  ListUrl=RsItem("ListStr")
	  RsItem("x_tp")=x_tp
	  if x_tp=1 then
	  RsItem("imhstr")=imhstr
      RsItem("imostr")=imostr
	  RsItem("x_tpUrl")=x_tpUrl
	  end if
   RsItem.UpDate
   RsItem.Close
   Set RsItem=Nothing
end if   
case 3
if Action1="add" or Action1="edit"  then
call SaveEdit
end if
If FoundErr<>True And Request.Form("ShowCode")="checkbox" Then
call GetTest()
End if
end select
end sub 
Public sub CollPhoto_Show()
If ItemEnd<>True Then
   If (ItemNum-1)>Ubound(Arr_Item,2) then
      ItemEnd=True
   Else
      Call SetItems()
   End If
End If
If ItemEnd<>True Then
   If ListPaingType=0 Then
      If ListNum=1 Then
        ListUrl=ListStr
      Else
         ListEnd=True
      End If
   ElseIf ListPaingType=1 Then
    if listnum=1 and ListPaingID1<>1 and  ListPaingID2<>1 then 
		ListUrl=ListStr
	   else
		  If ListPaingID1>ListPaingID2 then
			 If (ListPaingID1-ListNum+1)<ListPaingID2 or (ListPaingID1-ListNum+1)<0 Then
				Listend=True
			 Else
				ListUrl=Replace(ListPaingStr2,"{$ID}",Cstr(ListpaingID1-ListNum+1))
			 End if
		  Else
			 If (ListPaingID1+ListNum-1)>ListPaingID2 Then
				ListEnd=True
			 Else
				ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1+ListNum-1))
			 End If
		  End If   
	 end if   
   ElseIf ListPaingType=2 Then
      ListArray=Split(ListPaingStr3,"|")
      If (ListNum-1)>Ubound(ListArray) Then
         ListEnd=True
      Else
         ListUrl=ListArray(ListNum-1)
      End If       
   End If
   If ListNum>CollecListNum And CollecListNum<>0 Then
      ListEnd=True
   End if
End If

If ItemEnd=True Then
   ErrMsg= "<br>采集任务全部完成"
   ErrMsg=ErrMsg & "<br>成功采集： "  &  NewsSuccesNum  &  "  条,失败： "    &  NewsFalseNum  &  "  条,图片：" & ImagesNumAll & "  张"
   Call DelCache()
   If Colleclx=1 Then ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""4;url=w163_ArticleCollection.asp"">"
   If Colleclx=2 Then ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""4;url=w163_GETphoto.asp"">"
   If Colleclx=3 Then ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""4;url=w163_GETphoto.asp"">"
Else
   If ListEnd=True Then
      ItemNum=ItemNum+1
      ListNum=1
      ErrMsg="<br>" & ItemName & "  项目所有列表采集完成，正在整理数据请稍后..."
      ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""4;url=w163_GETphoto.asp"">"
   End If
End If

Call TopItem()
  If ItemEnd=True Or ListEnd=True Then
    If ItemEnd<>True Then
	  Call SetCache_His()
    End If
    Call WriteSucced(ErrMsg)
Else
   FoundErr=False
   ErrMsg=""
   Call StartCollection()
   Call FootItem2()
End  If
end sub
Public Sub SaveEdit
Colleclx=Request.Form("Colleclx")
TsString=Request.Form("TsString")
ToString=Request.Form("ToString")
CsString=Request.Form("CsString")
CoString=Request.Form("CoString")
photourls=Request.Form("photourls")
photourlo=Request.Form("photourlo")

 NewsPaingType=Trim(Request.Form("NewsPaingType"))
   NPsString=Trim(Request.Form("NPsString"))
   NPoString=Trim(Request.Form("NPoString"))
   NewsUrlPaing_s=Trim(Request.Form("NewsUrlPaing_s"))
   NewsUrlPaing_o=Trim(Request.Form("NewsUrlPaing_o"))

PhotoPaingType=Trim(Request.Form("PhotoPaingType"))
PhotoType_s=Request.Form("PhotoType_s")
PhotoType_o=Request.Form("PhotoType_o")
PhotoLurl_s=Request.Form("PhotoLurl_s")
PhotoLurl_o=Request.Form("PhotoLurl_o")
Phototypefy_s=Request.Form("Phototypefy_s")
Phototypefy_o=Request.Form("Phototypefy_o")
Phototypefyurl_s=Request.Form("Phototypefyurl_s")
Phototypefyurl_o=Request.Form("Phototypefyurl_o")
Phototypeurl_s=Request.Form("Phototypeurl_s")
Phototypeurl_o=Request.Form("Phototypeurl_o")
IF Colleclx=5 then
   Downlist_s=Request.Form("Downlist_s")'下载地址设置
   Downlist_o=Request.Form("Downlist_o")
   DownUrl_s=Request.Form("DownUrl_s")
   DownUrl_o=Request.Form("DownUrl_o")

   DownNewType=Request.Form("DownNewType")'新窗口打开下载连接
   DownNewlist_s=Request.Form("DownNewlist_s")
   DownNewlist_o=Request.Form("DownNewlist_o")
   DownNewUrl_s=Request.Form("DownNewUrl_s")
   DownNewUrl_o=Request.Form("DownNewUrl_o")
   
   ZdType_001=Request.Form("ZdType_001")'软件大小设置
   Zds_001=Request.Form("Zds_001")
   Zdo_001=Request.Form("Zdo_001")
   
   ZdType_002=Request.Form("ZdType_002")'软件语言设置
   Zds_002=Request.Form("Zds_002")
   Zdo_002=Request.Form("Zdo_002")
   
   ZdType_003=Request.Form("ZdType_003")'授权方式设置
   Zds_003=Request.Form("Zds_003")
   Zdo_003=Request.Form("Zdo_003")
   
   ZdType_004=Request.Form("ZdType_004")'运行环境设置
   Zds_004=Request.Form("Zds_004")
   Zdo_004=Request.Form("Zdo_004")
   
   ZdType_005=Request.Form("ZdType_005")'演示地址设置
   Zds_005=Request.Form("Zds_005")
   Zdo_005=Request.Form("Zdo_005")
   
   ZdType_006=Request.Form("ZdType_006")'注册地址设置
   Zds_006=Request.Form("Zds_006")
   Zdo_006=Request.Form("Zdo_006")
   
   ZdType_007=Request.Form("ZdType_007")'软件图片设置
   Zds_007=Request.Form("Zds_007")
   Zdo_007=Request.Form("Zdo_007")
   
   LinkUrlYn=Request.Form("LinkUrlYn")
   if LinkUrlYn="" then LinkUrlYn=0
End if
HttpUrlStr=Request.Form("HttpUrlStr")
DateType=Trim(Request.Form("DateType"))
DsString=Request.Form("DsString")
DoString=Request.Form("DoString")

AuthorType=Trim(Request.Form("AuthorType"))
AsString=Request.Form("AsString")
AoString=Request.Form("AoString")
AuthorStr=Request.Form("AuthorStr")

CopyFromType=Trim(Request.Form("CopyFromType"))
FsString=Request.Form("FsString")
FoString=Request.Form("FoString")
CopyFromStr=Request.Form("CopyFromStr")

KeyType=Trim(Request.Form("KeyType"))
KsString=Request.Form("KsString")
KoString=Request.Form("KoString")
KeyStr=Request.Form("KeyStr")

UrlTest=Trim(Request.Form("UrlTest"))
If TsString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>标题开始标记不能为空</li>"
End If
If ToString="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>标题结束标记不能为空</li>" 
End If
If NewsPaingType="" Then

Else
   NewsPaingType=Clng(NewsPaingType)
   If NewsPaingType=0 Then
   ElseIf NewsPaingType=1 Then
		If NPsString="" or NPoString="" Then
				 FoundErr=True
				 ErrMsg=ErrMsg & "<br><li>正文分页列表开始/结束标不能为空！</li>" 
		End If
		If NewsUrlPaing_s="" or NewsUrlPaing_o="" Then
				 FoundErr=True
				 ErrMsg=ErrMsg & "<br><li>正文分页链接开始/结束标不能为空！！</li>" 
		End If
   Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>参数错误，正文分类设置</li>" 
   End If 
End If

If DateType="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请设置时间类型</li>" 
Else
   DateType=Clng(DateType)
   If DateType=0 Then
   ElseIf DateType=1 Then
      If DsString="" or DoString="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>请将时间的开始/结束标记填写完整</li>" 
      End If
   Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>参数错误，请从有效链接进入</li>" 
   End If
End If

If AuthorType="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请设置作者类型</li>" 
Else
   AuthorType=Clng(AuthorType)
   If AuthorType=0 Then
   ElseIf AuthorType=1 Then
      If AsString="" or AoString="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>请将作者开始/结束标记填写完整！</li>" 
      End If
   ElseIf AuthorType=2 Then
      If AuthorStr="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>请指定作者</li>" 
      End If
   Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>参数错误，请从有效链接进入</li>" 
   End If 
End If
if Colleclx=5 then'下载地址设置
	If Downlist_s="" or  Downlist_o="" or DownUrl_s="" or DownUrl_o="" then
    	FoundErr=True
    	ErrMsg=ErrMsg & "<br><li>下载地址设置不能为空</li>" 
	End if
	IF DownNewType=1 then
		if DownNewlist_s="" or DownNewlist_o="" or DownNewUrl_s="" or DownNewUrl_o="" then
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>新窗口打开下载连接不能为空</li>"
		end if 
	End if   
	IF ZdType_001=1  then
		if Zds_001="" or Zdo_001="" then
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>软件大小设置不能为空</li>"
		end if 
	End if
	IF ZdType_002=1  then
		if Zds_002="" or Zdo_002="" then
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>软件语言设置不能为空</li>" 
		end if
	End if
	IF ZdType_003=1 then
		if Zds_003="" or Zdo_003="" then
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>授权方式设置不能为空</li>" 
		end if	
	End if
	IF ZdType_004=1 then
		if Zds_004="" or Zdo_004="" then
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>运行环境设置不能为空</li>" 
		End if
	End if
	IF ZdType_005=1 then
		if Zds_005="" or Zdo_005="" then
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>演示地址设置不能为空</li>" 
		end if
	End if
	IF ZdType_006=1 then
		if Zds_006="" or Zdo_006="" then
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>注册地址设置不能为空</li>" 
		end if	
	End if
	IF ZdType_007=1 then
		if Zds_007="" or Zdo_007="" then
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>软件图片设置不能为空</li>" 
		end if	
	End if
end if
If CopyFromType="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请设置来源类型</li>" 
Else
   CopyFromType=Clng(CopyFromType)
   If CopyFromType=0 Then
   ElseIf CopyFromType=1 Then
      If FsString="" or FoString="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>请将来源开始/结束标记填写完整！</li>" 
      End If
   ElseIf CopyFromType=2 Then
      If CopyFromStr="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>请指定来源</li>" 
      End If
   Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>参数错误，请从有效链接进入</li>" 
   End If 
End If

If KeyType="" Then
   FoundErr=True
   ErrMsg=ErrMsg & "<br><li>请设置关键字类型</li>" 
Else
   KeyType=Clng(KeyType)
   If KeyType=0 Then
   ElseIf KeyType=1 Then
      If KsString="" or KoString="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>关键字开始/结束标记不能为空</li>" 
      End If
   ElseIf KeyType=2 Then
      If KeyStr="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>请指定关键字</li>" 
      End If
   Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>参数错误，请从有效链接进入</li>" 
   End If
End If

If FoundErr<>True Then
   SqlItem="Select * from Item Where ItemID=" & ItemID
   Set RsItem=server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,2,3
   RsItem("TsString")=TsString
   RsItem("ToString")=ToString
   RsItem("CsString")=CsString
   RsItem("CoString")=CoString
   
   RsItem("photourls")=photourls
   RsItem("photourlo")=photourlo
   if NewsPaingType<>"" then 
   		RsItem("NewsPaingType")=NewsPaingType
   		if NewsPaingType=1 then
   		RsItem("NPsString")=NPsString
  		RsItem("NPoString")=NPoString
   		RsItem("NewsUrlPaing_s")=NewsUrlPaing_s
   		RsItem("NewsUrlPaing_o")=NewsUrlPaing_o
   		end if
   end if
   
   if PhotoPaingType<>"" then 
   RsItem("PhotoPaingType")=PhotoPaingType
	   If PhotoPaingType=1 Then
		  RsItem("PhotoType_s")=PhotoType_s
          RsItem("PhotoType_o")=PhotoType_o
		  
		  RsItem("PhotoLurl_s")=PhotoLurl_s
		  RsItem("PhotoLurl_o")=PhotoLurl_o
		 
		  RsItem("Phototypefy_s")=Phototypefy_s
		  RsItem("Phototypefy_o")=Phototypefy_o
		  
		  RsItem("Phototypefyurl_s")=Phototypefyurl_s
		  RsItem("Phototypefyurl_o")=Phototypefyurl_o
		  
		  RsItem("Phototypeurl_s")=Phototypeurl_s
		  RsItem("Phototypeurl_o")=Phototypeurl_o
	   end if  
   End If
   RsItem("HttpUrlStr")=HttpUrlStr
   RsItem("DateType")=DateType
   if Colleclx=5 then  
   RsItem("Downlist_s")=Downlist_s'下载地址设置
   RsItem("Downlist_o")=Downlist_o
   RsItem("DownUrl_s")=DownUrl_s
   RsItem("DownUrl_o")=DownUrl_o
   
   RsItem("DownNewType")=DownNewType'新窗口打开下载连接
   RsItem("DownNewlist_s")=DownNewlist_s
   RsItem("DownNewlist_o")=DownNewlist_o
   RsItem("DownNewUrl_s")=DownNewUrl_s
   RsItem("DownNewUrl_o")=DownNewUrl_o
   
   RsItem("ZdType_001")=ZdType_001'软件大小设置
   RsItem("Zds_001")=Zds_001
   RsItem("Zdo_001")=Zdo_001
   
   RsItem("ZdType_002")=ZdType_002'软件语言设置
   RsItem("Zds_002")=Zds_002
   RsItem("Zdo_002")=Zdo_002
   
   RsItem("ZdType_003")=ZdType_003'授权方式设置
   RsItem("Zds_003")=Zds_003
   RsItem("Zdo_003")=Zdo_003
   
   RsItem("ZdType_004")=ZdType_004'运行环境设置
   RsItem("Zds_004")=Zds_004
   RsItem("Zdo_004")=Zdo_004
   
   RsItem("ZdType_005")=ZdType_005'演示地址设置
   RsItem("Zds_005")=Zds_005
   RsItem("Zdo_005")=Zdo_005
   
   RsItem("ZdType_006")=ZdType_006'注册地址设置
   RsItem("Zds_006")=Zds_006
   RsItem("Zdo_006")=Zdo_006
   
   RsItem("ZdType_007")=ZdType_007'注册地址设置
   RsItem("Zds_007")=Zds_007
   RsItem("Zdo_007")=Zdo_007
   RsItem("LinkUrlYn")= LinkUrlYn
   end if
   If DateType=1 Then
      RsItem("DsString")=DsString
      RsItem("DoString")=DoString
   End If

   RsItem("AuthorType")=AuthorType
   If AuthorType=1 Then
      RsItem("AsString")=AsString
      RsItem("AoString")=AoString
   ElseIf AuthorType=2 Then
      RsItem("AuthorStr")=AuthorStr
   End If

   RsItem("CopyFromType")=CopyFromType
   If CopyFromType=1 Then
      RsItem("FsString")=FsString
      RsItem("FoString")=FoString
   ElseIf CopyFromType=2 Then
      RsItem("CopyFromStr")=CopyFromStr
   End If

   RsItem("KeyType")=KeyType
   If KeyType=1 Then
      RsItem("KsString")=KsString
      RsItem("KoString")=KoString
   ElseIf KeyType=2 Then
      RsItem("KeyStr")=KeyStr
   End If

   RsItem.UpDate
   RsItem.Close
   Set RsItem=Nothing
End If
End Sub
Public Sub GetTest()
   SqlItem="Select * from Item Where ItemID=" & ItemID
   Set RsItem=server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,1,1
   If  RsItem.Eof  And  RsItem.Bof  Then
         FoundErr=True
      ErrMsg=ErrMsg  &  "<br><li>参数错误，找不到该项目</li>"
   Else
         
      ListStr=RsItem("ListStr")
      LsString=RsItem("LsString")
      LoString=RsItem("LoString")
      ListPaingType=RsItem("ListPaingType")
      LPsString=RsItem("LPsString")
      LPoString=RsItem("LPoString")
      ListPaingStr2=RsItem("ListPaingStr2")
      ListPaingID1=RsItem("ListPaingID1")
      ListPaingID2=RsItem("ListPaingID2")
      ListPaingStr3=RsItem("ListPaingStr3")
      
      HsString=RsItem("HsString")
      HoString=RsItem("HoString")
	  imhstr=RsItem("imhstr")
      imostr=RsItem("imostr")
	  photourls=RsItem("photourls")
	  photourlo=RsItem("photourlo")
	  PhotoPaingType=RsItem("PhotoPaingType")
      PhotoType_s=RsItem("PhotoType_s")
      PhotoType_o=RsItem("PhotoType_o")
	  PhotoLurl_s=RsItem("PhotoLurl_s")
	  PhotoLurl_o=RsItem("PhotoLurl_o")
	  Phototypefy_s=RsItem("Phototypefy_s")
	  Phototypefy_o=RsItem("Phototypefy_o")
	  Phototypefyurl_s=RsItem("Phototypefyurl_s")
	  Phototypefyurl_o=RsItem("Phototypefyurl_o")
	  Phototypeurl_s=RsItem("Phototypeurl_s")
	  Phototypeurl_o=RsItem("Phototypeurl_o")
	  
	  HttpUrlStr=RsItem("HttpUrlStr")
   	  If  Colleclx=5 then
	   Downlist_s=RsItem("Downlist_s")'下载地址设置
	   Downlist_o=RsItem("Downlist_o")
	   DownUrl_s=RsItem("DownUrl_s")
	   DownUrl_o=RsItem("DownUrl_o")
	   
	   DownNewType=RsItem("DownNewType")'新窗口打开下载连接
   	   DownNewlist_s=RsItem("DownNewlist_s")
   	   DownNewlist_o=RsItem("DownNewlist_o")
   	   DownNewUrl_s=RsItem("DownNewUrl_s")
   	   DownNewUrl_o=RsItem("DownNewUrl_o")
	   
	   ZdType_001=RsItem("ZdType_001")'软件大小设置
	   Zds_001=RsItem("Zds_001")
	   Zdo_001=RsItem("Zdo_001")
	   
	   ZdType_002=RsItem("ZdType_002")'软件语言设置
	   Zds_002=RsItem("Zds_002")
	   Zdo_002=RsItem("Zdo_002")
	   
	   ZdType_003=RsItem("ZdType_003")'授权方式设置
	   Zds_003=RsItem("Zds_003")
	   Zdo_003=RsItem("Zdo_003")
	   
	   ZdType_004=RsItem("ZdType_004")'运行环境设置
	   Zds_004=RsItem("Zds_004")
	   Zdo_004=RsItem("Zdo_004")
	   
	   ZdType_005=RsItem("ZdType_005")'演示地址设置
	   Zds_005=RsItem("Zds_005")
	   Zdo_005=RsItem("Zdo_005")
	   
	   ZdType_006=RsItem("ZdType_006")'注册地址设置
	   Zds_006=RsItem("Zds_006")
	   Zdo_006=RsItem("Zdo_006")
	   
	   ZdType_007=RsItem("ZdType_007")'软件图片设置
	   Zds_007=RsItem("Zds_007")
	   Zdo_007=RsItem("Zdo_007") 
	  end if
	  
      TsString=RsItem("TsString")
      ToString=RsItem("ToString")
      CsString=RsItem("CsString")
      CoString=RsItem("CoString")
      
      DateType=RsItem("DateType")
      DsString=RsItem("DsString")
      DoString=RsItem("DoString")

      AuthorType=RsItem("AuthorType")
      AsString=RsItem("AsString")
      AoString=RsItem("AoString")
      AuthorStr=RsItem("AuthorStr")

      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")
      NewsUrlPaing_s=RsItem("NewsUrlPaing_s")
      NewsUrlPaing_o=RsItem("NewsUrlPaing_o")
	  
	  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")	  
      
      UpDateType=RsItem("UpDateType")
	  Colleclx=RsItem("Colleclx")
   End  If   
   RsItem.Close
   Set RsItem=Nothing
   CAll Collec_lx
   If LsString="" Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>列表开始标记不能为空！</li>"
   End If
   If LoString="" Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>列表结束标记不能为空！</li>"
   End If
   ListPaingType=Clng(ListPaingType)
   Select Case ListPaingType
   Case 0
   Case 1
      If ListPaingStr2="" Then
         FoundErr=True
		 
         ErrMsg=ErrMsg & "<br><li>批量生成字符不能为空</li>"
      End If
      If isNumeric(ListPaingID1)=False or isNumeric(ListPaingID2)=False Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>批量生成的范围只能是数字</li>"
      Else
         ListPaingID1=Clng(ListPaingID1)
         ListPaingID2=Clng(ListPaingID2)
         If ListPaingID1=0 And ListPaingID2=0 Then
            FoundErr=True
            ErrMsg=ErrMsg & "<br><li>批量生成范围设置不正确</li>"
         End If
      End If
   Case 2
      If ListPaingStr3="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>列表索引分页不能为空，请手动添加</li>"
      Else
         ListPaingStr3=Replace(ListPaingStr3,CHR(13),"|") 
      End If
   Case Else
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
   End Select
  
 If  HsString=""  or  HoString=""  Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>链接开始/结束标记不能为空！</li>"
      End  If

   If FoundErr<>True  Then
      Select Case ListPaingType
      Case 0
            ListUrl=ListStr
      Case 1
         ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1))
      Case 2
         If Instr(ListPaingStr3,"|")> 0 Then
            ListUrl=Left(ListPaingStr3,Instr(ListPaingStr3,"|")-1)
         Else
            ListUrl=ListPaingStr3
         End If
      End Select
   End If
   
   If  FoundErr<>True   Then
         ListCode=GetHttpPage(ListUrl,"GB2312")
         If ListCode<>"$False$" Then
            ListCode=GetBody(ListCode,LsString,LoString,False,False)
            If ListCode<>"$False$" Then
               NewsArrayCode=GetArray(ListCode,HsString,HoString,False,False)
               If NewsArrayCode<>"$False$" Then
                  If Instr(NewsArrayCode,"$Array$")>0 Then
                     NewsArray=Split(NewsArrayCode,"$Array$")
                     If HttpUrlType=1 Then
                        NewsUrl=Trim(Replace(HttpUrlStr,"{$ID}",NewsArray(0)))
                     Else
                        NewsUrl=Trim(DefiniteUrl(NewsArray(0),ListUrl))
						
                     End If
                  Else
                     FoundErr=True
                     ErrMsg=ErrMsg & "<br><li>只发现一个有效链接？：" & NewsArrayCode & "</li>"
                 End If
              Else
                 FoundErr=True
                 ErrMsg=ErrMsg & "<br><li>在获取链接列表时出错。</li>"
              End If   
           Else
               FoundErr=True
              ErrMsg=ErrMsg & "<br><li>在截取列表时发生错误。</li>"
           End If
        Else
            FoundErr=True
           ErrMsg=ErrMsg & "<br><li>在获取:" & ListUrl & "网页源码时发生错误。</li>"
        End If
		
     End If
	
        
If FoundErr<>True Then
   NewsCode=GetHttpPage(NewsUrl,"GB2312")
   If NewsCode<>"$False$" Then
      Title=GetBody(NewsCode,TsString,ToString,False,False)
	  if CsString<>"" or CoString<>"" then
		  if CsString<>"0" or  CoString<>"0" then
			  Content=GetBody(NewsCode,CsString,CoString,False,False)
		  Else
			  Content=""
		  end if
	  end if
      If Title="$False$"  Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>在截取"& ErrMsg_lx &"标题/正文的时候发生错误：" & NewsUrl & "</li>"
      Else
         Title=FpHtmlEnCode(Title)
         Title=dvhtmlencode(Title)
		 Call FilterScript()
         Content=Ubbcode(Content)
         If NewsPaingType=1 Then
            NewsPaingNext=GetPaing(NewsCode,NPsString,NPoString,False,False)
			   If NewsPaingNext<>"$False$" Then
			   		 NewsPaingNext_Code=GetArray(NewsPaingNext,NewsUrlPaing_s,NewsUrlPaing_o,False,False)
					 TypeArray_Url=Split( NewsPaingNext_Code,"$Array$")
					 if Ubound(TypeArray_Url)<>0 Then
						 For i=0 to Ubound(TypeArray_Url)
							 TypeNews_Url=Trim(DefiniteUrl(TypeArray_Url(i),NewsUrl))
							 NewsPaingNextCode=GetHttpPage(TypeNews_Url,"GB2312") 
							 ContentTemp=GetBody(NewsPaingNextCode,CsString,CoString,False,False)
							 Content=Content & "{$News_Paing_Next}" & ContentTemp
						 Next
					 End if	 	 
               End If
         End If
		If PhotoPaingType=1 Then 
			ListTypeCode=GetBody(NewsCode,PhotoType_s,PhotoType_o,False,False)
			If ListTypeCode<>"$False$" Then 
				ListTypeUrlCode=GetArray(ListTypeCode,PhotoLurl_s,PhotoLurl_o,False,False)
				If ListTypeUrlCode<>"$False$" and Instr(NewsArrayCode,"$Array$")>0  Then 
					TypeUrlArray=Split(ListTypeUrlCode,"$Array$")
					TypeNewsUrl=Trim(DefiniteUrl(TypeUrlArray(0),NewsUrl))
					if TypeNewsUrl<>"$False$" then
						if Phototypeurl_s<>"0" or Phototypeurl_o<>"0" then
							NewsTypeCode=GetHttpPage(TypeNewsUrl,"GB2312")
							PicUrls=GetBody(NewsTypeCode,Phototypeurl_s,Phototypeurl_o,False,False)
							if HttpUrlStr<>"" then
							PicUrls=Trim(DefiniteUrl(PicUrls,HttpUrlStr))
							else
							PicUrls=Trim(DefiniteUrl(PicUrls,TypeNewsUrl))
							end if
							if HttpUrlStr<>"" then PicUrls=HttpUrlStr & PicUrls'重定 
						else
							PicUrls=TypeNewsUrl
						end if
					end if
				else
					FoundErr=True
					ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "2级分类链接源码时发生错误。</li>"	
				end if
			else
				FoundErr=True
				ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "2级分类列表源码时发生错误。</li>"
			End if
		else
			PicUrls=GetBody(NewsCode,photourls,photourlo,False,False)
			PicUrls=Trim(DefiniteUrl(PicUrls,NewsUrl))
			if HttpUrlStr<>"" then PicUrls=HttpUrlStr & PicUrls 
        End If		
If Colleclx=5 then '下载
  	If Downlist_s="" or  Downlist_o="" or DownUrl_s="" or DownUrl_o="" then'下载地址设置
    	FoundErr=True
    	ErrMsg=ErrMsg & "<br><li>下载地址设置不能为空</li>" 
	Else	
		DownUrls=GetBody(NewsCode,Downlist_s,Downlist_o,False,False)
		If DownUrls<>"$False$" then
			DownUrls=GetBody(DownUrls,DownUrl_s,DownUrl_o,False,False)
			IF DownUrls<>"$False$" then
				 	DownUrls=Trim(DefiniteUrl(DownUrls,NewsUrl))
			Else
				FoundErr=True
				ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "下载地址链接源码时发生错误。</li>"
			End if
		Else
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "下载地址列表源码时发生错误。</li>"
		End if
	End if
	
	If DownNewType=1 then'新窗口打开下载连接
		If DownNewlist_s<>"" or  DownNewlist_o<>"" or DownNewUrl_s<>"" or DownNewUrl_o<>"" then
			DownUrls=GetHttpPage(DownUrls,"GB2312")
			DownUrls=GetBody(DownUrls,DownNewlist_s,DownNewlist_o,False,False)
			If DownUrls<>"$False$" then 
				DownUrls=GetBody(DownUrls,DownNewUrl_s,DownNewUrl_o,False,False)
				IF DownUrls<>"$False$" then
					DownUrls=Trim(DefiniteUrl(DownUrls,NewsUrl)) 
				Else
					FoundErr=True
    				ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "(新窗口)下载地址列表源码时发生错误</li>" 
				End if
			Else
				FoundErr=True
    			ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "(新窗口)下载地址列表源码时发生错误</li>" 
			End if
		Else
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>下载地址设置不能为空</li>" 
		End if
	End if 
	
	If ZdType_001=0 then'软件大小设置
   		DownSize=""
	Else
		If  Zds_001="0" and Zdo_001<>"" then
			DownSize=Zdo_001
		Else
			DownSize=GetBody(NewsCode,Zds_001,Zdo_001,False,False)
		End If
	End If
	If ZdType_002=0 then'软件语言设置
   		DownYY=""
	Else
		If  Zds_002="0" and Zdo_002<>"" then
			DownYY=Zdo_002
		Else
			DownYY=GetBody(NewsCode,Zds_002,Zdo_002,False,False)
		End If
	End If
 	If ZdType_003=0 then'授权方式设置
   		DownSQ=""
	Else
		If  Zds_003="0" and Zdo_003<>"" then
			DownSQ=Zdo_003
		Else
			DownSQ=GetBody(NewsCode,Zds_003,Zdo_003,False,False)
		End If
	End If
 	If ZdType_004=0 then'运行环境设置
   		DownPT=""
	Else
		If  Zds_004="0" and Zdo_004<>"" then
			DownPT=Zdo_004
		Else
			DownPT=GetBody(NewsCode,Zds_004,Zdo_004,False,False)
		End If
	End If
 	If ZdType_005=0 then'演示地址设置
   		YSDZ=""
	Else
		If  Zds_005="0" and Zdo_005<>"" then
			YSDZ=Zdo_005
		Else
			YSDZ=GetBody(NewsCode,Zds_005,Zdo_005,False,False)
		End If
	End If
 	If ZdType_006=0 then'注册地址设置
   		ZCDZ=""
	Else
		If  Zds_006="0" and Zdo_006<>"" then
			ZCDZ=Zdo_006
		Else
			ZCDZ=GetBody(NewsCode,Zds_006,Zdo_006,False,False)
		End If
	End If	
 	If ZdType_007=0 then'软件图片设置
   		PhotoUrl=""
	Else
		If  Zds_007="0" and Zdo_007<>"" then
			PhotoUrl=Zdo_007
		Else
			PhotoUrl=GetBody(NewsCode,Zds_007,Zdo_007,False,False)
			PhotoUrl=Trim(DefiniteUrl(PhotoUrl,NewsUrl))
		End If
	End If  
End if
         If UpDateType=0 Then
            UpDateTime=Now()
         ElseIf UpDateType=1 Then
            If DateType=0 then
               UpDateTime=Now()
            Else
               UpDateTime=GetBody(NewsCode,DsString,DoString,False,False)
               UpDateTime=FpHtmlEncode(UpDateTime)
               If IsDate(UpDateTime)=True Then
                  UpDateTime=CDate(UpDateTime)
               Else
                  UpDateTime=Now()
               End If
            End If
         ElseIf UpDateType=2 Then  
         Else
            UpDateTime=Now()
         End If
         If AuthorType=1 Then
            Author=GetBody(NewsCode,AsString,AoString,False,False)
         ElseIf AuthorType=2 Then
            Author=AuthorStr
         End If
         If Author="$False$" Or Trim(Author)="" Then
            Author="佚名"
         Else
            Author=FpHtmlEnCode(Author)
         End If
         If CopyFromType=1 Then
            CopyFrom=GetBody(NewsCode,FsString,FoString,False,False)
         ElseIf CopyFromType=2 Then
            CopyFrom=CopyFromStr
         End If
         If CopyFrom="$False$" Or Trim(CopyFrom)="" Then
            CopyFrom="不详"
         Else
            CopyFrom=FpHtmlEnCode(CopyFrom)
         End If

         If KeyType=0 Then
            Key=Title
            Key=CreateKeyWord(Key,2)
         ElseIf KeyType=1 Then
            Key=GetBody(NewsCode,KsString,KoString,False,False)
            Key=FpHtmlEnCode(Key)
            Key=CreateKeyWord(Key,2)
         ElseIf KeyType=2 Then
            Key=FpHtmlEnCode(Key)
         End If
         If Key="$False$" Or Trim(Key)="" Then
            Key=KeyStr
         End If
     End  If    
   Else
     FoundErr=True
     ErrMsg=ErrMsg & "<br><li>在获取源码时发生错误："& NewsUrl &"</li>"
   End If 
End If
if PicUrls="$False$" then 
PicUrls=""
end if

If FoundErr<>True Then
   Call GetFilters
   Call Filters
   Content=ReplaceSaveRemoteFile(Content,strInstallDir,strChannelDir,False,NewsUrl)
End If

if FoundErr<>True then
set RsItem=ConnItem.execute("update Item set Flag=True where ItemID="& ItemID)
end if
End Sub
Sub SetItems()
      Dim ItemNumTemp
      ItemNumTemp=ItemNum-1
      ItemID=Arr_Item(0,ItemNumTemp)
      ItemName=Arr_Item(1,ItemNumTemp)
      ChannelID=Arr_Item(2,ItemNumTemp)'频道ID
      strChannelDir=Arr_Item(3,ItemNumTemp)'频道目录
      ClassID=Arr_Item(4,ItemNumTemp)            '栏目
      SpecialID=Arr_Item(5,ItemNumTemp)        '专题
      LoginType=Arr_Item(9,ItemNumTemp)
      LoginUrl=Arr_Item(10,ItemNumTemp)          '登录
      LoginPostUrl=Arr_Item(11,ItemNumTemp)
      LoginUser=Arr_Item(12,ItemNumTemp)
      LoginPass=Arr_Item(13,ItemNumTemp)
      LoginFalse=Arr_Item(14,ItemNumTemp)
      ListStr=Arr_Item(15,ItemNumTemp)            '列表地址
      LsString=Arr_Item(16,ItemNumTemp)          '列表
      LoString=Arr_Item(17,ItemNumTemp)
      ListPaingType=Arr_Item(18,ItemNumTemp)
      LPsString=Arr_Item(19,ItemNumTemp)          
      LPoString=Arr_Item(20,ItemNumTemp)
      ListPaingStr1=Arr_Item(21,ItemNumTemp)
      ListPaingStr2=Arr_Item(22,ItemNumTemp)
      ListPaingID1=Arr_Item(23,ItemNumTemp)
      ListPaingID2=Arr_Item(24,ItemNumTemp)
      ListPaingStr3=Arr_Item(25,ItemNumTemp)
      HsString=Arr_Item(26,ItemNumTemp)  
      HoString=Arr_Item(27,ItemNumTemp)
      HttpUrlType=Arr_Item(28,ItemNumTemp)
      HttpUrlStr=Arr_Item(29,ItemNumTemp)
      TsString=Arr_Item(30,ItemNumTemp)          '标题
      ToString=Arr_Item(31,ItemNumTemp)
      CsString=Arr_Item(32,ItemNumTemp)          '正文
      CoString=Arr_Item(33,ItemNumTemp)
      DateType=Arr_Item(34,ItemNumTemp)      '作者
      DsString=Arr_Item(35,ItemNumTemp)          
      DoString=Arr_Item(36,ItemNumTemp)
      AuthorType=Arr_Item(37,ItemNumTemp)      '作者
      AsString=Arr_Item(38,ItemNumTemp)          
      AoString=Arr_Item(39,ItemNumTemp)
      AuthorStr=Arr_Item(40,ItemNumTemp)
      CopyFromType=Arr_Item(41,ItemNumTemp)  '来源
      FsString=Arr_Item(42,ItemNumTemp)          
      FoString=Arr_Item(43,ItemNumTemp)
      CopyFromStr=Arr_Item(44,ItemNumTemp)
      KeyType=Arr_Item(45,ItemNumTemp)            '关键词
      KsString=Arr_Item(46,ItemNumTemp)          
      KoString=Arr_Item(47,ItemNumTemp)
      KeyStr=Arr_Item(48,ItemNumTemp)
      NewsPaingType=Arr_Item(49,ItemNumTemp)            '关键词
      NPsString=Arr_Item(50,ItemNumTemp)          
      NPoString=Arr_Item(51,ItemNumTemp)
      NewsUrlPaing_s=Arr_Item(52,ItemNumTemp)
      NewsUrlPaing_o=Arr_Item(53,ItemNumTemp)
      PaginationType=Arr_Item(55,ItemNumTemp)
      MaxCharPerPage=Arr_Item(56,ItemNumTemp)
      ReadLevel=Arr_Item(57,ItemNumTemp)
      Stars=Arr_Item(58,ItemNumTemp)
      ReadPoint=Arr_Item(59,ItemNumTemp)
      Hits=Arr_Item(60,ItemNumTemp)
      UpDateType=Arr_Item(61,ItemNumTemp)
      UpDateTime=Arr_Item(62,ItemNumTemp)
      IncludePicYn=Arr_Item(63,ItemNumTemp)
      DefaultPicYn=Arr_Item(64,ItemNumTemp)
      OnTop=Arr_Item(65,ItemNumTemp)
      Elite=Arr_Item(66,ItemNumTemp)
      Hot=Arr_Item(67,ItemNumTemp)
      SkinID=Arr_Item(68,ItemNumTemp)
      TemplateID=Arr_Item(69,ItemNumTemp)
      Script_Iframe=Arr_Item(70,ItemNumTemp)
      Script_Object=Arr_Item(71,ItemNumTemp)
      Script_Script=Arr_Item(72,ItemNumTemp)
      Script_Div=Arr_Item(73,ItemNumTemp)
      Script_Class=Arr_Item(74,ItemNumTemp)
      Script_Span=Arr_Item(75,ItemNumTemp)
      Script_Img=Arr_Item(76,ItemNumTemp)
      Script_Font=Arr_Item(77,ItemNumTemp)
      Script_A=Arr_Item(78,ItemNumTemp)
      Script_Html=Arr_Item(79,ItemNumTemp)
      CollecListNum=Arr_Item(80,ItemNumTemp)
      CollecNewsNum=Arr_Item(81,ItemNumTemp)
      Passed=Arr_Item(82,ItemNumTemp)
      SaveFiles=Arr_Item(83,ItemNumTemp)
      CollecOrder=Arr_Item(84,ItemNumTemp)
      LinkUrlYn=Arr_Item(85,ItemNumTemp)
      InputerType=Arr_Item(86,ItemNumTemp)
      Inputer=Arr_Item(87,ItemNumTemp)
      EditorType=Arr_Item(88,ItemNumTemp)
      Editor=Arr_Item(89,ItemNumTemp)
      ShowCommentLink=Arr_Item(90,ItemNumTemp)
      Script_Table=Arr_Item(91,ItemNumTemp)
      Script_Tr=Arr_Item(92,ItemNumTemp)
      Script_Td=Arr_Item(93,ItemNumTemp)
	  imhstr=Arr_Item(94,ItemNumTemp)
      imostr=Arr_Item(95,ItemNumTemp)
	  photourls=Arr_Item(96,ItemNumTemp)
      photourlo=Arr_Item(97,ItemNumTemp)
	  PhotoPaingType=Arr_Item(98,ItemNumTemp)
	  PhotoType_s=Arr_Item(99,ItemNumTemp)
	  PhotoType_o=Arr_Item(100,ItemNumTemp)
	  PhotoLurl_s=Arr_Item(101,ItemNumTemp)
	  PhotoLurl_o=Arr_Item(102,ItemNumTemp)
	  Phototypefy_s=Arr_Item(103,ItemNumTemp)
	  Phototypefy_o=Arr_Item(104,ItemNumTemp)
	  Phototypefyurl_s=Arr_Item(105,ItemNumTemp)
	  Phototypefyurl_o=Arr_Item(106,ItemNumTemp)
	  Phototypeurl_s=Arr_Item(107,ItemNumTemp)
	  Phototypeurl_o=Arr_Item(108,ItemNumTemp)
	  Colleclx=Arr_Item(109,ItemNumTemp)
	  x_tp=Arr_Item(110,ItemNumTemp)
	  selEncoding=Arr_Item(111,ItemNumTemp)
	  SaveFileUrl=Arr_Item(112,ItemNumTemp)
	  x_tpUrl=Arr_Item(113,ItemNumTemp)
	  if Colleclx=5 then
		  Downlist_s=Arr_Item(114,ItemNumTemp)
		  Downlist_o=Arr_Item(115,ItemNumTemp)
		  DownUrl_s=Arr_Item(116,ItemNumTemp)
		  DownUrl_o=Arr_Item(117,ItemNumTemp)
		  DownNewType=Arr_Item(118,ItemNumTemp)
		  DownNewlist_s=Arr_Item(119,ItemNumTemp)
		  DownNewlist_o=Arr_Item(120,ItemNumTemp)
		  DownNewUrl_s=Arr_Item(121,ItemNumTemp)
		  DownNewUrl_o=Arr_Item(122,ItemNumTemp)
		  ZdType_001=Arr_Item(123,ItemNumTemp)
		  Zds_001=Arr_Item(124,ItemNumTemp)
		  Zdo_001=Arr_Item(125,ItemNumTemp)
		  ZdType_002=Arr_Item(126,ItemNumTemp)
		  Zds_002=Arr_Item(127,ItemNumTemp)
		  Zdo_002=Arr_Item(128,ItemNumTemp)
		  ZdType_003=Arr_Item(129,ItemNumTemp)
		  Zds_003=Arr_Item(130,ItemNumTemp)
		  Zdo_003=Arr_Item(131,ItemNumTemp)
		  ZdType_004=Arr_Item(132,ItemNumTemp)
		  Zds_004=Arr_Item(133,ItemNumTemp)
		  Zdo_004=Arr_Item(134,ItemNumTemp)
		  ZdType_005=Arr_Item(135,ItemNumTemp)
		  Zds_005=Arr_Item(136,ItemNumTemp)
		  Zdo_005=Arr_Item(137,ItemNumTemp)
		  ZdType_006=Arr_Item(138,ItemNumTemp)
		  Zds_006=Arr_Item(139,ItemNumTemp)
		  Zdo_006=Arr_Item(140,ItemNumTemp)
		  ZdType_007=Arr_Item(141,ItemNumTemp)
		  Zds_007=Arr_Item(142,ItemNumTemp)
		  Zdo_007=Arr_Item(143,ItemNumTemp)	  
		  ZdType_008=Arr_Item(144,ItemNumTemp)
		  Zds_008=Arr_Item(145,ItemNumTemp)
		  Zdo_008=Arr_Item(146,ItemNumTemp)		  
	  End if
	  Thumb_WaterMark=Arr_Item(147,ItemNumTemp)
	  Thumbs_Create=Arr_Item(148,ItemNumTemp)
      If InputerType=1 Then
         Inputer=FpHtmlEnCode(Inputer)
      Else
         Inputer=session("AdminName")
      End If
      If EditorType=1 Then
         Editor=FpHtmlEnCode(Editor)
      Else
         Editor=session("AdminName")
      End If
      If IsObjInstalled("Scripting.FileSystemObject")=False or strChannelDir="" Then
         SaveFiles=False
      End if
	 CAll Collec_lx 
End Sub

Sub StartCollection
If NewsSuccesNum>=CollecNewsNum And CollecNewsNum<>0 then 
	   	response.write("<script>location.href='w163_Collection.asp?ItemID="& ItemID &"&ItemNum=" & ItemNum & "&ListNum=" & ListNum +1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext &"&NewsNum_i="& 0 &"';</script>")'到页面 
End if
If FoundErr<>True then
   ListCode=GetHttpPage(ListUrl,"GB2312")
   Call GetListPaing()
   If ListCode="$False$" Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>在获取列表：" & ListUrl & "网页源码时发生错误！</li>"
   Else
      ListCode=GetBody(ListCode,LsString,LoString,False,False)
      If ListCode="$False$" Or ListCode="" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>在截取：" & ListUrl & "的"& ErrMsg_lx &"列表时发生错误！</li>"
      End If
   End If
End If

If FoundErr<>True Then
   NewsArrayCode=GetArray(ListCode,HsString,HoString,False,False)
   If NewsArrayCode="$False$" Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>在分析：" & ListUrl & ""& ErrMsg_lx &"列表时发生错误！</li>"
   Else
      NewsArray=Split(NewsArrayCode,"$Array$")
      For Arr_i=0 to Ubound(NewsArray)
         If HttpUrlType=1 Then
            NewsArray(Arr_i)=Trim(Replace(HttpUrlStr,"{$ID}",NewsArray(Arr_i)))
         Else
            NewsArray(Arr_i)=Trim(DefiniteUrl(NewsArray(Arr_i),ListUrl))           
         End If
         NewsArray(Arr_i)=CheckUrl(NewsArray(Arr_i))
      Next
      If CollecOrder=1 Then
         For Arr_i=0 to Fix(Ubound(NewsArray)/2)
            OrderTemp=NewsArray(Arr_i)
            NewsArray(Arr_i)=NewsArray(Ubound(NewsArray)-Arr_i)
            NewsArray(Ubound(NewsArray)-Arr_i)=OrderTemp
         Next
      End If
   End If
End If
if x_tp=1  then
If FoundErr<>True Then
   NewsimageCode=GetArray(ListCode,imhstr,imostr,False,False)
   If NewsimageCode="$False$" Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>在分析：" & ListUrl & "小图片列表时发生错误！</li>"
   Else
      Newsimage=Split(NewsimageCode,"$Array$")
      For Arr_i=0 to Ubound(Newsimage)
         If HttpUrlType=1 Then
            Newsimage(Arr_i)=Trim(Replace(HttpUrlStr,"{$ID}",Newsimage(Arr_i)))
         Else
            Newsimage(Arr_i)=Trim(DefiniteUrl(Newsimage(Arr_i),ListUrl))           
         End If
		 if x_tpUrl<>"" then Newsimage(Arr_i)= x_tpUrl & Newsimage(Arr_i) 
         Newsimage(Arr_i)=CheckUrl(Newsimage(Arr_i))
		 
      Next
      If CollecOrder=True Then
         For Arr_i=0 to Fix(Ubound(Newsimage)/2)
            OrderTemp=Newsimage(Arr_i)
            Newsimage(Arr_i)=Newsimage(Ubound(Newsimage)-Arr_i)
            Newsimage(Ubound(Newsimage)-Arr_i)=OrderTemp
         Next
      End If
   End If
End If
end if

If FoundErr<>True Then
dim PicUrls_i
   Call TopItem2()
   CollecNewsAll=0
	  Arr_i=NewsNum_i
      CollecNewsAll=CollecNewsAll+1
      UploadFiles=""
      DefaultPicUrl=""
      IncludePic=0
      ImagesNum=0
      NewsCode=""
      FoundErr=False
      ErrMsg=""
      His_Repeat=False
	  if x_tp=1 then
	  	picpath=Newsimage(arr_i)
	  	iF SaveFiles=1 then picpath=w163_SaveFile(Colleclx,picpath)	
	  end if
	  NewsUrl=NewsArray(Arr_i)
      Title=""
      PaingNum=1
      If Response.IsClientConnected Then 
         Response.Flush 
      Else 
         Response.End 
      End If
      If CollecTest=False Then
         His_Repeat=CheckRepeat(NewsUrl)
      Else
         His_Repeat=False
      End If
      If His_Repeat=True Then
         FoundErr=True
      End If

      If FoundErr<>True Then
         NewsCode=GetHttpPage(NewsUrl,"GB2312")
         If NewsCode="$False$" Then
            FoundErr=True
			ErrMsg=ErrMsg & "<br>在获取：" & NewsUrl & "网页源码时发生错误！"
			Title="获取网页源码失败"
         End If
      End If

      If FoundErr<>True Then
         Title=GetBody(NewsCode,TsString,ToString,False,False)
         If Title="$False$" or Title="" then
            FoundErr=True
            ErrMsg=ErrMsg & "<br>在分析：" & NewsUrl & "的"& ErrMsg_lx &"标题时发生错误"
			Title="<br>标题分析错误" 
         End If
         If FoundErr<>True Then
		 	if CsString<>"0" or CoString<>"0" then
            Content=GetBody(NewsCode,CsString,CoString,False,False)
            else
			Content=""
			end if
			If Content="$False$" Then
               FoundErr=True
               ErrMsg=ErrMsg & "<br>在分析：" & NewsUrl & "的"& ErrMsg_lx &"正文时发生错误"
               Title=Title & "<br>正文分析错误" 
            End If
         End If
         If FoundErr<>True Then
         If NewsPaingType=1 Then
            NewsPaingNext=GetBody(NewsCode,NPsString,NPoString,False,False)
			   If NewsPaingNext<>"$False$" Then
			   		 NewsPaingNext_Code=GetArray(NewsPaingNext,NewsUrlPaing_s,NewsUrlPaing_o,False,False)
					 TypeArray_Url=Split( NewsPaingNext_Code,"$Array$")
					 if Ubound(TypeArray_Url)<>0 Then
						 For i=0 to Ubound(TypeArray_Url)
							 TypeNews_Url=Trim(DefiniteUrl(TypeArray_Url(i),NewsUrl))
							 NewsPaingNextCode=GetHttpPage(TypeNews_Url,"GB2312") 
							 ContentTemp=GetBody(NewsPaingNextCode,CsString,CoString,False,False)
							 Content=Content & "[NextPage]" & ContentTemp
						 Next
					 End if
			   Else	 
			   	 FoundErr=True
               	 ErrMsg=ErrMsg & "<br>在分析：" & NewsUrl & "的正文分页时发生错误"
               	 Title=Title & "<br>正文分页分析错误" 	 	 	 
               End If
         End If
		 	'过滤
            Call FilterScript()
			Call GetFilters
            Call Filters()
            Title=FpHtmlEnCode(Title)
            
            Content=Ubbcode(Content)
         End If
      End If
  
If Colleclx=5 then '下载
dim DownUrls_i
  	If Downlist_s="" or  Downlist_o="" or DownUrl_s="" or DownUrl_o="" then'下载地址设置
    	FoundErr=True
    	ErrMsg=ErrMsg & "<br><li>下载地址设置不能为空</li>" 
	Else	
		DownUrls=GetBody(NewsCode,Downlist_s,Downlist_o,False,False)
		If DownUrls<>"$False$" then
			IF LinkUrlYn=1 then
				DownUrls=GetArray(DownUrls,DownUrl_s,DownUrl_o,False,False)
			else
				DownUrls=GetBody(DownUrls,DownUrl_s,DownUrl_o,False,False)
			end if
			IF DownUrls<>"$False$" then
					if LinkUrlYn=1 then
						i=1	
						TypeUrlArray=Split(DownUrls,"$Array$")
						For Arr_ii=0 to Ubound(TypeUrlArray)
							DownUrls=Trim(DefiniteUrl(TypeUrlArray(Arr_ii),NewsUrl))
							If arr_ii=0  then
								DownUrls_i="下载地址1|" & DownUrls
								i=i+1
							Else
								DownUrls_i= DownUrls_i & "|||下载地址" & i  & "|" & DownUrls
								i=i+1
							End if
						Next
						DownUrls=DownUrls_i
					Else
						DownUrls=Trim(DefiniteUrl(DownUrls,NewsUrl))
						DownUrls="下载地址1|" & DownUrls
					End if	 
			Else
				FoundErr=True
				ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "下载地址链接源码时发生错误。</li>"
			End if
		Else
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "下载地址列表源码时发生错误。</li>"
		End if
	End if
	
	If DownNewType=1 then'新窗口打开下载连接
		If DownNewlist_s<>"" or  DownNewlist_o<>"" or DownNewUrl_s<>"" or DownNewUrl_o<>"" then
			DownUrls=GetHttpPage(DownUrls,"GB2312")
			DownUrls=GetBody(DownUrls,DownNewlist_s,DownNewlist_o,False,False)
			If DownUrls<>"$False$" then 
				DownUrls=GetArray(DownUrls,DownNewUrl_s,DownNewUrl_o,False,False)
				IF DownUrls<>"$False$" then
					i=1	
					TypeUrlArray=Split(DownUrls,"$Array$")
					For Arr_ii=0 to Ubound(TypeUrlArray)
						DownUrls=Trim(DefiniteUrl(TypeUrlArray(Arr_ii),NewsUrl))
						If arr_ii=0  then
							DownUrls_i="下载地址1|" & DownUrls
							i=i+1
						Else
							DownUrls_i= DownUrls_i & "|||下载地址" & i  & "|" & DownUrls
							i=i+1
						End if
					Next
					DownUrls=DownUrls_i 
				Else
					FoundErr=True
    				ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "(新窗口)下载地址列表源码时发生错误</li>" 
				End if
			Else
				FoundErr=True
    			ErrMsg=ErrMsg & "<br><li>在获取:" & NewsUrl & "(新窗口)下载地址列表源码时发生错误</li>" 
			End if
		Else
			FoundErr=True
    		ErrMsg=ErrMsg & "<br><li>下载地址设置不能为空</li>" 
		End if
	End if 
	
	If ZdType_001=0 then'软件大小设置
   		DownSize=""
	Else
		If  Zds_001="0" and Zdo_001<>"" then
			DownSize=Zdo_001
		Else
			DownSize=FpHtmlEncode(GetBody(NewsCode,Zds_001,Zdo_001,False,False))
		End If
	End If
	If ZdType_002=0 then'软件语言设置
   		DownYY=""
	Else
		If  Zds_002="0" and Zdo_002<>"" then
			DownYY=Zdo_002
		Else
			DownYY=FpHtmlEncode(GetBody(NewsCode,Zds_002,Zdo_002,False,False))
		End If
	End If
 	If ZdType_003=0 then'授权方式设置
   		DownSQ=""
	Else
		If  Zds_003="0" and Zdo_003<>"" then
			DownSQ=Zdo_003
		Else
			DownSQ=FpHtmlEncode(GetBody(NewsCode,Zds_003,Zdo_003,False,False))
		End If
	End If
 	If ZdType_004=0 then'运行环境设置
   		DownPT=""
	Else
		If  Zds_004="0" and Zdo_004<>"" then
			DownPT=Zdo_004
		Else
			DownPT=FpHtmlEncode(GetBody(NewsCode,Zds_004,Zdo_004,False,False))
		End If
	End If
 	If ZdType_005=0 then'演示地址设置
   		YSDZ=""
	Else
		If  Zds_005="0" and Zdo_005<>"" then
			YSDZ=Zdo_005
		Else
			YSDZ=FpHtmlEncode(GetBody(NewsCode,Zds_005,Zdo_005,False,False))
		End If
	End If
 	If ZdType_006=0 then'注册地址设置
   		ZCDZ=""
	Else
		If  Zds_006="0" and Zdo_006<>"" then
			ZCDZ=Zdo_006
		Else
			ZCDZ=FpHtmlEncode(GetBody(NewsCode,Zds_006,Zdo_006,False,False))
		End If
	End If	
 	If ZdType_007=0 then'软件图片设置
   		PhotoUrl=""
	Else
		If  Zds_007="0" and Zdo_007<>"" then
			PhotoUrl=Zdo_007
		Else
			PhotoUrl=GetBody(NewsCode,Zds_007,Zdo_007,False,False)
			PhotoUrl=Trim(DefiniteUrl(PhotoUrl,NewsUrl))
		End If
	End If  
End if
	  
      If FoundErr<>True Then
         If UpDateType=0 Then
            UpDateTime=Now()
         ElseIf UpDateType=1 Then
            If DateType=0 then
               UpDateTime=Now()
            Else
               UpDateTime=GetBody(NewsCode,DsString,DoString,False,False)
               UpDateTime=FpHtmlEncode(UpDateTime)
               UpDateTime=Trim(Replace(UpDateTime,"&nbsp;"," "))
               If IsDate(UpDateTime)=True Then
                  UpDateTime=CDate(UpDateTime)
               Else
                  UpDateTime=Now()
               End If
            End If
         ElseIf UpDateType=2 Then  
         Else
            UpDateTime=Now()
         End If
                  
         If AuthorType=1 Then
            Author=GetBody(NewsCode,AsString,AoString,False,False)
         ElseIf AuthorType=2 Then
            Author=AuthorStr
         Else
            Author="佚名"
         End If
         Author=FpHtmlEncode(Author)
         If Author="" or Author="$False$" then
            Author="佚名"
         Else
            If Len(Author)>255 then
               Author=Left(Author,255)
            End If
         End If
           
         If CopyFromType=1 Then
            CopyFrom=GetBody(NewsCode,FsString,FoString,False,False)
         ElseIf CopyFromType=2 Then
            CopyFrom=CopyFromStr
         Else
            CopyFrom="不详"
         End If
         CopyFrom=FpHtmlEncode(CopyFrom)
         If CopyFrom="" or CopyFrom="$False$" Then
	            CopyFrom="不详"
         Else
            If Len(CopyFrom)>255 Then 
               CopyFrom=Left(CopyFrom,255)
            End If
         End If
         If KeyType=0 Then
            Key=Title
            Key=CreateKeyWord(Key,2)
         ElseIf KeyType=1 Then
            Key=GetBody(NewsCode,KsString,KoString,False,False)
            Key=FpHtmlEncode(Key)
            Key=CreateKeyWord(Key,2)
         ElseIf KeyType=2 Then
            Key=KeyStr
            Key=FpHtmlEncode(Key)
            If Len(Key)>253 Then
               Key= Left(Key,253)
            Else
               Key=Key
            End If
         End If
         If Key="" or Key="$False$" Then
            Key=KeyStr
         End If
         If UploadFiles<>"" Then
            If Instr(UploadFiles,"|")>0 Then
               Arr_Images=Split(UploadFiles,"|") 
               ImagesNum=Ubound(Arr_Images)+1
               DefaultPicUrl=Arr_Images(0)
            Else
               ImagesNum=1
               DefaultPicUrl=UploadFiles
            End If

            If DefaultPicYn=False then
               DefaultPicUrl=""
            End If
            If IncludePicYn=True Then
               IncludePic=-1
            Else
               IncludePic=0
            End If
            If SaveFiles<>True Then
               UploadFiles=""
            End If
         Else
            ImagesNum=0
            DefaultPicUrl=""
            IncludePic=0         
         End If
         ImagesNumAll=ImagesNumAll+ImagesNum
      End If	  
      If FoundErr<>True Then
	  	If CollecTest=False Then
            SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,ArticleID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & ArticleID & "','" & Title & "','" & Now() & "','" & NewsUrl & "',True)"
            ConnItem.Execute(SqlItem)
            Content=Replace(Content,"[InstallDir_ChannelDir]",strInstallDir & strChannelDir & "/")
         End If
         NewsSuccesNum=NewsSuccesNum+1
        ErrMsg=ErrMsg & "No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font><br>"
		 ErrMsg=ErrMsg & ErrMsg_lx &"标题："
         ErrMsg=ErrMsg & "<font color=red>" & Title & "</font><br>"
         ErrMsg=ErrMsg & "更新时间：" & UpDateTime & "<br>"
		 If Colleclx=1 then ErrMsg=ErrMsg & "新闻标题：" : ErrMsg=ErrMsg & "新闻作者：" & Author & "<br>" : ErrMsg=ErrMsg & "新闻来源：" & CopyFrom & "<br>"
         ErrMsg=ErrMsg & "采集页面：<a href=" & NewsUrl & " target=_blank>" & NewsUrl & "</a><br>"
		 if x_tp =1 then ErrMsg=ErrMsg & "采集小图片：<a href=" & picpath & " target=_blank>" & picpath & "</a><br>"
		 If NewsPaingType=1 then ErrMsg=ErrMsg & "其它信息：分页--" & Ubound(TypeArray_Url)+1 & " 页"
         ErrMsg=ErrMsg & "正文预览："
         If Content_View=True Then
            ErrMsg=ErrMsg & "<br>" & Content
         Else
            ErrMsg=ErrMsg & "您没有启用正文预览功能"
         End If
         ErrMsg=ErrMsg & "<br><br>关 键 字：" & Key & ""
      Else
         NewsFalseNum=NewsFalseNum+1
         If His_Repeat=True Then
            ErrMsg=ErrMsg & "No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font><br>"
			ErrMsg=ErrMsg & "目标"& ErrMsg_lx &"：<font color=red>"
            If His_Result=True Then
               ErrMsg=ErrMsg & His_Title
            Else
               ErrMsg=ErrMsg & NewsUrl
            End If
            ErrMsg=ErrMsg & "</font> 的记录已存在，不给予采集。<br>"
            ErrMsg=ErrMsg & "采集时间：" & His_CollecDate & "<br>"
			ErrMsg=ErrMsg & ""& ErrMsg_lx &"来源：<a href='" & NewsUrl & "' target=_blank>"&NewsUrl&"</a><br>"
            ErrMsg=ErrMsg & "采集结果："
            If His_Result=False Then
               ErrMsg=ErrMsg & "失败"
               ErrMsg=ErrMsg & "<br>失败原因：" & Title
            Else
               ErrMsg=ErrMsg & "成功"
            End If            
            ErrMsg=ErrMsg & "<br>提示信息：如想再次采集，请先将该新闻的历史记录<font color=red>删除</font><br>"
         End If
         If CollecTest=False And His_Repeat=False Then
            SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & Title & "','" & Now() & "','" & NewsUrl & "',False)"
            ConnItem.Execute(SqlItem)
         End If
      End If
	   Response.Flush()
	   Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" class=""tableBorder""  cellspacing=""1"">"
	   Response.Write "   <tr class='tdbg'>"          
	   Response.Write "      <td height=""22"" colspan=""2"" align=""left"">"
	   Response.Write ErrMsg
	   Response.Write "      </td>"
	   Response.Write "   </tr><br>"
	   Response.Write "</table>"
	  	 '--
		 If  FoundErr<>True and His_Repeat=False Then
		 	  '--新闻图片或文件保存
		  if  Colleclx =1 then 
			set rs = ConnItem.execute("select top 1 ArticleDir,flashdir,photoDir,AllDir from w163_Config")
				IF SaveFiles=1 then
					Content=ReplaceSaveRemoteFile(Content,"/",rs("ArticleDir"),True,NewsUrl)
				Else
					Content=ReplaceSaveRemoteFile(Content,"/",rs("ArticleDir"),False,NewsUrl) 
				End if 
			rs.close
			set rs=nothing
		  End if
		 If PhotoPaingType=1 Then
				i=1
					ListTypeCode=GetBody(NewsCode,PhotoType_s,PhotoType_o,False,False)
					If ListTypeCode<>"$False$" Then 
						ListTypeUrlCode=GetArray(ListTypeCode,PhotoLurl_s,PhotoLurl_o,False,False)
						If Phototypefy_s<>"0" AND Phototypefy_o<>"0" AND Phototypefyurl_s<>"0" AND Phototypefyurl_o<>"0" Then
						ListTypeCode_2=GetBody(NewsCode,Phototypefy_s,Phototypefy_o,False,False)
							If ListTypeCode_2<>"$False$"   Then 
								ListTypeUrlCode_2=GetArray(ListTypeCode_2,Phototypefyurl_s,Phototypefyurl_o,False,False)
								TypeUrlArray_2=Split(ListTypeUrlCode_2,"$Array$")
								For Arr_ii_2=0 to Ubound(TypeUrlArray_2)
								TypeNewsUrl=Trim(DefiniteUrl(TypeUrlArray_2(Arr_ii_2),NewsUrl))
									NewsTypeCode=GetHttpPage(TypeNewsUrl,"GB2312")
									ListTypeCode=GetBody(NewsTypeCode,PhotoType_s,PhotoType_o,False,False)
									If ListTypeCode<>"$False$" Then 
										ListTypeUrlCode=GetArray(ListTypeCode,PhotoLurl_s,PhotoLurl_o,False,False)
										TypeUrlArray=Split(ListTypeUrlCode,"$Array$")
										For Arr_ii=0 to Ubound(TypeUrlArray)
											TypeNewsUrl=Trim(DefiniteUrl(TypeUrlArray(Arr_ii),NewsUrl))
											If TypeNewsUrl<>"$False$" Then 
												
												if Phototypeurl_s<>"0" or Phototypeurl_o<>"0" then
													NewsTypeCode=GetHttpPage(TypeNewsUrl,"GB2312")
													PicUrls=GetBody(NewsTypeCode,Phototypeurl_s,Phototypeurl_o,False,False)
													PicUrls=Trim(DefiniteUrl(PicUrls,TypeNewsUrl))
													if HttpUrlStr<>"" then PicUrls=HttpUrlStr & PicUrls'重定地址
												Else
													PicUrls=TypeNewsUrl
												end if
												IF SaveFiles=1 then 
													PicUrls=w163_SaveFile(Colleclx,PicUrls)
													if PicUrls=False then
													Response.Write "&nbsp;----" & PicUrls & " 保存失败<br>"
													Else
													Response.Write "&nbsp;" & ErrMsg_lx & I &"--" & PicUrls & " 保存成功<br>"
													End if
													Response.Flush()
												End IF
												if PicUrls<>False then
													If arr_ii=0 and Arr_ii_2=0 then
															PicUrls_i=ErrMsg_lx & "1|" & PicUrls 
															i=i+1
													Else
															PicUrls_i= PicUrls_i & "|||" & ErrMsg_lx & i  & "|" & PicUrls 
															i=i+1
													End if
												End if
											End If
										Next
									End If
								Next
								PicUrls=PicUrls_i
								Call SaveArticle
							Else
							Call Coll_ListType_2	
							End if
						Else
							Call Coll_ListType_2
						End If
					Else
						FoundErr=True
						Response.Write "<br><li>在获取:" & NewsUrl & "2级分类列表源码时发生错误。</li>"	
						Response.end
					End If
				Else
						if Colleclx =3 or Colleclx=5 then
							PicUrls=GetBody(NewsCode,photourls,photourlo,False,False)
							PicUrls=Trim(DefiniteUrl(PicUrls,NewsUrl))
							if HttpUrlStr<>"" then PicUrls=HttpUrlStr & PicUrls'重定地址			
								IF SaveFiles=1 then 
									PicUrls=w163_SaveFile(Colleclx,PicUrls)
									Response.Write  "&nbsp;" & ErrMsg_lx & "--" & PicUrls & " 保存成功<br>"
								End IF
								if Colleclx=3 then PicUrls=ErrMsg_lx & "1|" & PicUrls
								if Colleclx=5 then PicUrls="下载地址1|" & PicUrls
						end if
						Call SaveArticle
					Response.Flush()
				End If
		 end if
		 '--
	   if NewsNum_i = Ubound(NewsArray) then
	    response.write("<script>location.href='w163_Collection.asp?ItemID="& ItemID &"&ItemNum=" & ItemNum & "&ListNum=" & ListNum +1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext &"&NewsNum_i="& 0 &"';</script>")'到页面 
	   else
	   response.write "<meta http-equiv=""refresh"" content=""0;url=w163_Collection.asp?ItemID="& ItemID &"&ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext &"&NewsNum_i="& NewsNum_i + 1 &""">"
	   end if
Else
   Call ShowMsg(ErrMsg)
End If
End Sub

Sub  Coll_ListType_2()
i=1
	If ListTypeUrlCode<>"$False$" and Instr(NewsArrayCode,"$Array$")>0  Then 
			TypeUrlArray=Split(ListTypeUrlCode,"$Array$")
			For Arr_ii=0 to Ubound(TypeUrlArray)
				TypeNewsUrl=Trim(DefiniteUrl(TypeUrlArray(Arr_ii),NewsUrl))
				If TypeNewsUrl<>"$False$" Then
					if Phototypeurl_s<>"0" or Phototypeurl_o<>"0" then
						NewsTypeCode=GetHttpPage(TypeNewsUrl,"GB2312")
						PicUrls=GetBody(NewsTypeCode,Phototypeurl_s,Phototypeurl_o,False,False)
						PicUrls=Trim(DefiniteUrl(PicUrls,TypeNewsUrl))
						if HttpUrlStr<>"" then PicUrls=HttpUrlStr & PicUrls'重定地址
					else
						PicUrls=TypeNewsUrl
					end if
					IF SaveFiles=1 then 
                    	PicUrls=w163_SaveFile(Colleclx,PicUrls)
						If PicUrls=False then
                    		Response.Write "&nbsp;----" & PicUrls & " 保存失败<br>"
						Else 
							Response.Write "&nbsp;" & ErrMsg_lx & i &"--" & PicUrls & " 保存成功<br>"
						End if
						Response.Flush()
                    End IF
					If PicUrls<>False then
						If i=1 then 
							PicUrls_i=ErrMsg_lx & "1|" & PicUrls
							i=i+1
						Else
							PicUrls_i= PicUrls_i & "|||" & ErrMsg_lx & i & "|" & PicUrls
							i=i+1 
						End if
					End if
				End If
			Next
			PicUrls=PicUrls_i
			Call SaveArticle
	Else
			FoundErr=True
			Response.Write "<br><li>在获取:" & NewsUrl & "2级分类链接源码时发生错误。</li>"	
			Response.end
	End If
End Sub
Sub ShowMsg(Msg)
   Dim strTemp
   strTemp= "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" class=""tableBorder""  cellspacing=""1"">"
   strTemp=strTemp & "   <tr class='tdbg'>"          
   strTemp=strTemp & "      <td height=""22"" colspan=""2"" align=""left"">"
   strTemp=strTemp & Msg
   strTemp=strTemp & "      </td>"
   strTemp=strTemp & "   </tr><br>"
   strTemp=strTemp & "</table>"
   Response.Write StrTemp     
End Sub
Sub GetListPaing()
   If ListPaingType=1 Then
      ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
      ListPaingNext=FpHtmlEnCode(ListPaingNext)
      If ListPaingNext<>"$False$" And ListPaingNext<>"" Then
         If ListPaingStr1<>""  Then  
            ListPaingNext=Replace(ListPaingStr1,"{$ID}",ListPaingNext)
         Else
            ListPaingNext=DefiniteUrl(ListPaingNext,ListUrl)
         End If
         ListPaingNext=Replace(ListPaingNext,"&","{$ID}")
      End If
   Else
      ListPaingNext="$False$"
   End If
End Sub
Sub Foot_Item()
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" class=""tableBorder""  cellspacing=""1"">"
Response.Write "<tr>"
Response.write "<td height=""22"" colspan=""2"" align=""left"" class=""tdbg"">"
If CollecTest=False Then
   Response.Write "数据整理中，5秒后继续......5秒后如果还没反应请点击 <a href='w163_Collection.asp?ItemID="& ItemID &"&ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & "'><font color=red>这里</font></a> 继续<br>"
   Response.Write "<meta http-equiv=""refresh"" content=""5;url=w163_Collection.asp?ItemID="& ItemID &"&ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext  & """>"
Else
   Response.Write "<a href='w163_Collection.asp?ItemID="& ItemID &"&ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & "'><font color=red>请 继 续</font></a>"
End If
Response.Write "</td></tr>"
Response.Write "</table>"
end Sub
Sub FootItem2()
   Dim strTemp
   OverTime=Timer()
   strTemp= "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"       
   strTemp=strTemp & "<tr>"          
   strTemp=strTemp & "<td height=""22"" colspan=""2"" align=""left"" class=""tdbg"">"
   strTemp=strTemp & "执行时间：" & CStr(FormatNumber((OverTime-StartTime)*1000,2)) & " 毫秒"
   strTemp=strTemp & "</td></tr><br>"
   strTemp=strTemp & "</table>"
   Response.write strTemp
End Sub
Sub SetCache_His()
   
   SqlItem ="select NewsUrl,Title,CollecDate,Result from Histroly"
   Set RsItem=Server.CreateObject("adodb.recordset")
   RsItem.Open SqlItem,ConnItem,1,1
   If Not RsItem.Eof Then
      Arr_Histrolys=RsItem.GetRows()
   End If
   RsItem.Close
   Set RsItem=Nothing

   Dim myCache
   Set myCache=new clsCache
   myCache.name=CacheTemp & "histrolys"
   Call myCache.clean()
   If IsArray(Arr_Histrolys)=True Then   
      myCache.add Arr_Histrolys,Dateadd("n",1000,now)
   End If
End Sub
Public Sub GetFilters()
dim SqlF,rsf
   SqlF ="Select * from Filters Where Flag=True And (PublicTf=True Or ItemID=" & ItemID & ") order by FilterID ASC"
   Set RSF=connItem.Execute(SqlF)
   If RsF.Eof And RsF.Bof Then
      Arr_Filters=""
   Else
      Arr_Filters=RsF.GetRows()
   End If
   RsF.Close
   Set RsF=Nothing
End Sub
Sub DelCache()
   Dim myCache

   Set myCache=new clsCache
   myCache.name=CacheTemp & "items"
   Call myCache.clean()
   myCache.name=CacheTemp & "filters"
   Call myCache.clean()
   myCache.name=CacheTemp & "histrolys"
   Call myCache.clean()
   myCache.name=CacheTemp & "collectest"
   Call myCache.clean()
   myCache.name=CacheTemp & "contentview"
   Call myCache.clean()
   Set myCache=Nothing
End Sub
Sub SaveArticle
  	dim rslb,DownID
	if  Colleclx =1 then'--文章数据库
	   set rs=server.createobject("adodb.recordset")
	   sql="select top 1 * from w163_Article" 
	   rs.open sql,ConnItem,1,3
	   rs.addnew
	   rs("ChannelID")=1
	   rs("ClassID")=ClassID
	   rs("SpecialID")=SpecialID
	   rs("Title")=Title
       rs("Content")=Content
	   rs("Keyword")=Key
	   rs("Hits")=Hits
	   rs("Author")=Author
	   rs("CopyFrom")=CopyFrom
	   rs("IncludePic")=IncludePic
	   rs("Passed")=0
	   rs("OnTop")=OnTop
	   rs("Hot")=Hot
	   rs("Elite")=Elite
	   rs("Stars")=Stars
	   rs("UpdateTime")=UpDateTime
	   rs("PaginationType")=PaginationType
	   rs("MaxCharPerPage")=MaxCharPerPage
	   rs("ReadLevel")=ReadLevel
	   rs("ReadPoint")=ReadPoint
	   rs("SkinID")=SkinID
	   rs("TemplateID")=TemplateID
	   rs("DefaultPicUrl")=DefaultPicUrl
	   rs("UploadFiles")=UploadFiles
	   rs("ShowCommentLink")=ShowCommentLink
	   rs("Inputer")=Inputer
	   if Editor="" then Editor="sk"
	   rs("Editor")=Editor
	   rs("picpath")=picpath 
	   rs.update
	   rs.close
	   set rs=nothing
   end if
   if  Colleclx =2 then '动漫采集
	   	set rs=server.createobject("adodb.recordset")
	   	sql="select top 1 * from w163_flash" 
	   	rs.open sql,ConnItem,1,3
	   	rs.addnew
	 	rs("flashID")=GetInfoID(3) : rs("Tid")=ClassID : rs("KeyWords")=Key : rs("Title")=Title
		if x_tp =1 then rs("PhotoUrl")=picpath
		rs("flashUrl")=Coll_DefiniteUrl : rs("flashContent")=Content : rs("Author")=Author : rs("Origin")=CopyFrom 
		rs("Rank")=Stars  
		rs("LastHitsTime")=UpdateTime :rs("Hits")=Hits :rs("HitsByDay")=makeRandom(3) 
		rs("HitsByWeek")=makeRandom(3) : rs("HitsByMonth")=makeRandom(3) : rs("AddDate")=UpdateTime
		rs("FlashFsoType")=9
		rs("Fname")=ArticleID & MakeRandom(10) &".htm"
		rs("flashInput")=Inputer
		rs("RefreshTF")=0
		rs("Recommend")=0
		rs("Rolls")=0
		rs("Strip")=0
		rs("Popular")=0
		rs("Verific")=0
		rs("Comment")=1
		rs("Score")=MakeRandom(3)
		rs("Slide")=0
		rs("BeyondSavePic")=0
		rs("DelTF")=0
		rs("OrderID")=1
	   	rs.update
	   	rs.close
	   	set rs=nothing
   end if
    if  Colleclx =5 then'--软件
   		'set rslb=ConnItem.Execute("select top 1 * from w163_Class Where ClassID=" & ClassID ) 
	    set rs=server.createobject("adodb.recordset")
	    sql="select top 1 * from w163_download" 
	    rs.open sql,ConnItem,1,3
	    rs.addnew
		DownID=GetInfoID_CMS(3)
		rs("DownID")=DownID
		rs("Tid")=ClassID
		rs("KeyWords")=Key
		rs("Title")=Title
		'DownSize,DownYY,DownSQ,DownPT,YSDZ,ZCDZ,PhotoUrl,DownUrls
		'rs("DownVersion")= '版本信息
		'rs("DownLB")=      '下载类别
		rs("DownYY")=DownYY     '下载语言
		rs("DownSQ")=DownSQ     '下载授权
		rs("DownPT")=DownPT     '下载平台
		rs("DownSize")=DownSize    '大小
		rs("YSDZ")=YSDZ       '演示地址
		rs("ZCDZ")=ZCDZ      '注册地址
		'rs("JYMM")=       '解压密码
			rs("PhotoUrl")=PhotoUrl
		'rs("BigPhoto")=    '软件大图
		'rs("FlagUrl")=            '0、默认方式 1、镜像服务器方式
		rs("DownUrls")=DownUrls     '下载地址，若是默认方式，则以|||隔开
		rs("DownContent")=Content '下载简介
		rs("Author")=Author       '下载作者
		rs("Origin")=CopyFrom     '下载来源
		rs("Rank")=Stars         '阅读等级
		rs("Hits")=Hits           '总浏览数
		rs("HitsByDay")=MakeRandom(3)  '日浏览数
		rs("HitsByWeek")=MakeRandom(3)  '周浏览数
		rs("HitsByMonth")=MakeRandom(3)  '月浏览数
		rs("AddDate")=UpdateTime        '更新时间
		rs("TemplateID")=1             '模板ID
		rs("DownFsoType")=9        '
		rs("Fname")=DownID &".htm"
		rs("DownInput")=Inputer
		rs("RefreshTF")=0
		rs("Recommend")=0
		rs("Popular")=0
		rs("Verific")=0
		rs("Comment")=0
		rs("DelTF")=0
		rs("OrderID")=1
		rs("InfoPurview")=0'查看权限0继承栏目权限,1所有会员,2指定会员组
		rs("ArrGroupID")="" '指定会员组的查看权限
		rs("ReadPoint")=0  '阅读点数
		rs("ChargeType")=0  '重复收费方式
		rs("PitchTime")=24   '重复收费小时数
		rs("ReadTimes")=10    '重复收费查看次数
		rs("DividePercent")=0   '与投稿者的分成比例
		rs.update
	   	rs.close
	   	set rs=nothing
   end if
   if  Colleclx =3 then '图片采集
	    set rs=server.createobject("adodb.recordset")
	    sql="select top 1 * from w163_Photo" 
	    rs.open sql,ConnItem,1,3
	    rs.addnew
		rs("PicID")=GetInfoID_CMS(2)
		rs("Tid")=ClassID
		rs("KeyWords")=Key
		rs("Title")=Title
		if x_tp =1 then
			rs("PhotoUrl")=picpath
		else
			TypeUrlArray_2=Split(PicUrls,"|||")
			picpath=Replace(TypeUrlArray_2(0),"图片1|","")
			if x_tp =2 then '自动缩略图
				dim picpath_1,picpath_2,picpath_3 : picpath_1=Split(picpath,"/")
				picpath_2=w163_GetSaveDir(Colleclx) & "small" & picpath_1(Ubound(picpath_1)) : picpath_3=picpath_2
				call SKThumb.CreateThumbs(picpath,picpath_2) : picpath=picpath_3 
			end if				
			rs("PhotoUrl")=picpath
		end if
		If PhotoPaingType=1 Then
			rs("PicUrls")=PicUrls
		Else
			rs("PicUrls")=PicUrls
		End if
		rs("PictureContent")=Content
		rs("Author")=Author
		rs("Origin")=CopyFrom
		rs("Rank")=Stars
		rs("Hits")=Hits
		rs("HitsByDay")=MakeRandom(3)
		rs("HitsByWeek")=MakeRandom(3)
		rs("HitsByMonth")=MakeRandom(3)
		rs("AddDate")=UpdateTime
		rs("PictureFsoType")=9
		rs("Fname")=ArticleID & MakeRandom(10) &".htm"
		rs("PictureInput")=Inputer
		rs("RefreshTF")=0
		rs("Recommend")=0
		rs("Rolls")=0
		rs("Strip")=0
		rs("Popular")=0
		rs("Verific")=0
		rs("Comment")=1
		rs("Score")=MakeRandom(3)
		rs("Slide")=0
		rs("BeyondSavePic")=0
		rs("DelTF")=0
		rs("OrderID")=1
		rs.update
	   	rs.close
	   	set rs=nothing
   end if
       if  Colleclx =6 then'--文章数据库
	   set rs=server.createobject("adodb.recordset")
	   sql="select top 1 * from w163_Article" 
	   rs.open sql,ConnItem,1,3
	   rs.addnew
	   rs("ChannelID")=1
	   rs("ClassID")=ClassID
	   rs("SpecialID")=SpecialID
	   rs("Title")=Title
	   	If PhotoPaingType=1 Then
			rs("FileUrls")=PicUrls
		Else
			rs("FileUrls")=Coll_DefiniteUrl
		End if
		  rs("Content")=Content
	   rs("Keyword")=Key
	   rs("Hits")=Hits
	   rs("Author")=Author
	   rs("CopyFrom")=CopyFrom
	   rs("IncludePic")=IncludePic
	   rs("Passed")=0
	   rs("OnTop")=OnTop
	   rs("Hot")=Hot
	   rs("Elite")=Elite
	   rs("Stars")=Stars
	   rs("UpdateTime")=UpDateTime
	   rs("PaginationType")=PaginationType
	   rs("MaxCharPerPage")=MaxCharPerPage
	   rs("ReadLevel")=ReadLevel
	   rs("ReadPoint")=ReadPoint
	   rs("SkinID")=SkinID
	   rs("TemplateID")=TemplateID
	   rs("DefaultPicUrl")=DefaultPicUrl
	   rs("UploadFiles")=UploadFiles
	   rs("ShowCommentLink")=ShowCommentLink
	   rs("Inputer")=Inputer
	   if Editor="" then Editor="sk"
	   rs("Editor")=Editor
	    if x_tp = 1 then
	   rs("picpath")=picpath 
	   	end if
	   rs.update
	   rs.close
	   set rs=nothing
   end if
   CollecTest=False
End Sub
Sub TopItem()%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder">
  <tr> 
    <td height="22" colspan="2" align="center" class="topbg"><strong>采 集 系 统 采 集 管 理</strong></td>
  </tr>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder">
  <tr class="tdbg"> 
    <td width="65" height="30"><strong>管理导航：</strong></td>
	<% set rs=ConnItem.execute("select top 1 Colleclx,ItemID from Item where ItemID="& ItemID)
	Colleclx=rs("Colleclx")
	if Colleclx=1 then Response.Write "<td height=""30""><a href=""w163_GetArticle.asp"">管理首页</a> >> 新闻采集</td>"  
	if Colleclx=2 then Response.Write "<td height=""30""><a href=""w163_Getphoto.asp"">管理首页</a> >> 新闻采集</td>"  
	if Colleclx=3 then Response.Write "<td height=""30""><a href=""w163_Getphoto.asp"">管理首页</a> >> 新闻采集</td>"
	rs.close
	set rs=nothing
	 %>
  </tr>  
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder">       
  <tr> 
    <td height="22" colspan="2" class="tdbg" aling="center">采集需要一定的时间，请耐心等待，如果网站出现暂时无法访问的情况这是正常的，采集正常结束后即可恢复。
    </td>
  </tr>
</table>
<%
End Sub
Sub TopItem2
%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1"  class="tableBorder" >
    <tr>
      <td height="22" colspan="2" class="tdbg" aling="left">本次运行：<%=Ubound(Arr_Item,2)+1%> 个项目,正在采集第 <font color=red><%= ItemNum%></font> 个项目  <font color=red><%=ItemName%></font>  的第   <font color=red><%=ListNum%></font> 页列表,该列表待采集记录  <font color=red><%=Ubound(NewsArray)+1%></font> 条。
      <%if CollecNewsNum<>0 Then Response.Write "限制 <font color=red>" & CollecNewsNum & "</font> 条。"%>
      <br>采集统计：成功采集--<%=NewsSuccesNum%>  条记录，失败--<%=NewsFalseNum%>  条，图片--<%=ImagesNumAll%>　张。
	<%
	set rs=ConnItem.execute("select top 1 Colleclx,ItemID from Item where ItemID="& ItemID)
	Colleclx=rs("Colleclx")
	if Colleclx=1 then Response.Write "<a href=""w163_GetArticle.asp"">停止采集</a>"  
	if Colleclx=2 then Response.Write "<a href=""w163_GetPhoto.asp"">停止采集</a>"  
	if Colleclx=3 then Response.Write "<a href=""w163_GetPhoto.asp"">停止采集</a>"
	if Colleclx=5 then Response.Write "<a href=""w163_GetSoft.asp"">停止采集</a>"
	rs.close
	set rs=nothing %>
      </td>
    </tr>
</table>
<%StartTime=Timer()
End Sub
Public Sub Filters()
dim Filteri,FilterStr
If IsArray(Arr_Filters)=False Then
   Exit Sub
End if
   For Filteri=0 to Ubound(Arr_Filters,2)
      FilterStr=""
      If Arr_Filters(1,Filteri)=ItemID Or Arr_Filters(10,Filteri)=True Then
         If Arr_Filters(3,Filteri)=1 Then
            If Arr_Filters(4,Filteri)=1 Then
               Title=Replace(Title,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
            ElseIf Arr_Filters(4,Filteri)=2 Then
               FilterStr=GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
               Do While FilterStr<>"$False$"
                  Title=Replace(Title,FilterStr,Arr_Filters(8,Filteri))
                  FilterStr=GetBody(Title,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
               Content=Replace(Content,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
            ElseIf Arr_Filters(4,Filteri)=2 Then
               FilterStr=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
               Do While FilterStr<>"$False$"
                  Content=Replace(Content,FilterStr,Arr_Filters(8,Filteri))
                  FilterStr=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
               Loop
            End If
         End If
      End If
   Next
End Sub
Sub  FilterScript()
   If Script_Iframe=1 Then
      Content=ScriptHtml(Content,"Iframe",1)
   End If
   If Script_Object=1 Then
      Content=ScriptHtml(Content,"Object",2)
   End If
   If Script_Script=1 Then
      Content=ScriptHtml(Content,"Script",2)
   End If
   If Script_Div=1 Then
      Content=ScriptHtml(Content,"Div",3)
   End If
   If Script_Table=1 Then
      Content=ScriptHtml(Content,"table",3)
   End If
   If Script_Tr=1 Then
      Content=ScriptHtml(Content,"tr",3)
   End If
   If Script_Td=1 Then
      Content=ScriptHtml(Content,"td",3)
   End If
   If Script_Span=1 Then
      Content=ScriptHtml(Content,"Span",3)
   End If
   If Script_Img=1 Then
      Content=ScriptHtml(Content,"Img",3)
   End If
   If Script_Font=1 Then
      Content=ScriptHtml(Content,"Font",3)
   End If
   If Script_A=1 Then
      Content=ScriptHtml(Content,"A",3)
   End If
   If Script_Html=1 Then
      Content=noHtml(Content)
   End If
End  Sub
Function CheckRepeat(strUrl)
   CheckRepeat=False
   If IsArray(Arr_Histrolys)=True then
      For His_i=0 to Ubound(Arr_Histrolys,2)
         If Arr_Histrolys(0,His_i)=strUrl Then
            CheckRepeat=True
            His_Title=Arr_Histrolys(1,His_i)
            His_CollecDate=Arr_Histrolys(2,His_i)
            His_Result=Arr_Histrolys(3,His_i)
            Exit For
         End If
      Next
   End If
End Function
	Public Function ChkNumeric(ByVal CHECK_ID)
		If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
			CHECK_ID = CLng(CHECK_ID)
		Else
			CHECK_ID = 0
		End If
		ChkNumeric = CHECK_ID
	End Function
'采集类型
Sub Collec_lx()
   select case Colleclx
   case 1
	 ErrMsg_lx="新闻"
   case 2
 	 ErrMsg_lx="Flash"
   case 3
 	 ErrMsg_lx="图片"
   case 4	 
   	 ErrMsg_lx="音乐"
   case 5
   	 errMSg_lx="软件"		 
   case 6
 	 ErrMsg_lx="自定"
   end select
End sub
Public Function IsObjInstalled(strClassString)
		On Error Resume Next
		IsObjInstalled = False
		Err = 0
		Dim xTestObj:Set xTestObj = Server.CreateObject(strClassString)
		If 0 = Err Then IsObjInstalled = True
		Set xTestObj = Nothing
		Err = 0
End Function
Public Function IsExpired(strClassString)
		On Error Resume Next
		IsExpired = True
		Err = 0
		Dim xTestObj:Set xTestObj = Server.CreateObject(strClassString)
	
		If 0 = Err Then
			Select Case strClassString
				Case "Persits.Jpeg"
					If xTestObjResponse.Expires > Now Then
						IsExpired = False
					End If
				Case "wsImage.Resize"
					If InStr(xTestObj.errorinfo, "已经过期") = 0 Then
						IsExpired = False
					End If
				Case "SoftArtisans.ImageGen"
					xTestObj.CreateImage 500, 500, RGB(255, 255, 255)
					If Err = 0 Then
						IsExpired = False
					End If
			End Select
		End If
		Set xTestObj = Nothing
		Err = 0
End Function  
End Class
'SK采集通用添加水印及生成缩略图类
'-----------------------------------------------------------------------------------------------
Class Thumb
		'为图片添加水印
		Function AddWaterMark(FileName)
			Dim strMarkSettingSql, MarkSettingRs, objFileSystem, strFileExtName, objImage
			If InStr(FileName, ":") = 0 Then                                            
				FileName = Server.MapPath(FileName)
			End If
			If FileName <> "" And Not IsNull(FileName) Then                           
				strFileExtName = ""
				If InStr(FileName, ".") <> 0 Then
					strFileExtName = LCase(Trim(Mid(FileName, InStrRev(FileName, ".") + 1)))
				End If
				If strFileExtName <> "jpg" And strFileExtName <> "gif" And strFileExtName <> "bmp" And strFileExtName <> "png" Then 
					Exit Function
				End If
				Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject")
				If objFileSystem.FileExists(FileName) Then             
					strMarkSettingSql = "select * from w163_Config"
					Set MarkSettingRs = connItem.Execute(strMarkSettingSql)
					If MarkSettingRs("MarkComponent") <> "0" Then                   
						Select Case MarkSettingRs("MarkComponent")
							Case "1"                                                           
								If SK.IsObjInstalled("Persits.Jpeg") Then                    
									If SK.IsExpired("Persits.Jpeg") Then
										Response.Write ("对不起，Persits.Jpeg组件已过期!")
										Response.End
									End If
									If MarkSettingRs("MarkType") = "1" Then             
										AddWordMark 1, MarkSettingRs("MarkText"), MarkSettingRs("MarkFontColor"), MarkSettingRs("MarkFontName"), MarkSettingRs("MarkFontBond"), MarkSettingRs("MarkFontSize"), MarkSettingRs("MarkPosition"), FileName
									Else                                               
										AddPhotoMark 1, MarkSettingRs("MarkWidth"), MarkSettingRs("MarkHeight"), MarkSettingRs("MarkPicture"), MarkSettingRs("MarkOpacity"), MarkSettingRs("MarkTranspColor"), MarkSettingRs("MarkPosition"), FileName
									End If
								End If
							Case "2"                                                  
								If strFileExtName = "png" Then                        
									Exit Function
								End If
								If sk.IsObjInstalled("wsImage.Resize") Then             
									If sk.IsExpired("wsImage.Resize") Then
										Response.Write ("对不起，sImage.Resize组件已过期!")
										Response.End
									End If
									If MarkSettingRs("MarkType") = "1" Then             
										AddWordMark 2, MarkSettingRs("MarkText"), MarkSettingRs("MarkFontColor"), MarkSettingRs("MarkFontName"), MarkSettingRs("MarkFontBond"), MarkSettingRs("MarkFontSize"), MarkSettingRs("MarkPosition"), FileName
									Else                                               
										AddPhotoMark 2, MarkSettingRs("MarkWidth"), MarkSettingRs("MarkHeight"), MarkSettingRs("MarkPicture"), MarkSettingRs("MarkOpacity"), MarkSettingRs("MarkTranspColor"), MarkSettingRs("MarkPosition"), FileName
									End If
								End If
							Case "3"                                                    
								If sk.IsObjInstalled("SoftArtisans.ImageGen") Then           
									If sk.IsExpired("SoftArtisans.ImageGen") Then
										Response.Write ("对不起，SoftArtisans.ImageGen组件已过期!")
										Response.End
									End If
									If MarkSettingRs("MarkType") = "1" Then             
										AddWordMark 3, MarkSettingRs("MarkText"), MarkSettingRs("MarkFontColor"), MarkSettingRs("MarkFontName"), MarkSettingRs("MarkFontBond"), MarkSettingRs("MarkFontSize"), MarkSettingRs("MarkPosition"), FileName
									Else                                               
										AddPhotoMark 3, MarkSettingRs("MarkWidth"), MarkSettingRs("MarkHeight"), MarkSettingRs("MarkPicture"), MarkSettingRs("MarkOpacity"), MarkSettingRs("MarkTranspColor"), MarkSettingRs("MarkPosition"), FileName
									End If
								End If
						End Select
					End If
					Set MarkSettingRs = Nothing
				End If
				Set objFileSystem = Nothing
			End If
		End Function
		'为图片添加文字水印函数
		Function AddWordMark(MarkComponentID, MarkText, MarkFontColor, MarkFontName, MarkFontBond, MarkFontSize, MarkPosition, FileName)
			Dim objImage, x, y, Text, TextWidth, FontColor, FontName, FondBond, FontSize, OriginalWidth, OriginalHeight
			If InStr(FileName, ":") = 0 Then                                                            
				FileName = Server.MapPath(FileName)
			End If
				
			Text = Trim(MarkText)
			If Text = "" Then
				Exit Function
			End If
			FontColor = Replace(MarkFontColor, "#", "&H")
			FontName = MarkFontName
			If MarkFontBond = "1" Then
				FondBond = True
			Else
				FondBond = False
			End If
			   
			FontSize = CInt(MarkFontSize)
		
			Select Case MarkComponentID
				Case 1
					If Not SK.IsObjInstalled("Persits.Jpeg") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("Persits.Jpeg")
					objImage.Open FileName
					objImage.Canvas.Font.Color = FontColor
					objImage.Canvas.Font.Family = FontName
					objImage.Canvas.Font.Bold = FondBond
					objImage.Canvas.Font.size = FontSize
					TextWidth = objImage.Canvas.GetTextExtent(Text)                                    
					
					If objImage.OriginalWidth < TextWidth Or objImage.OriginalHeight < FontSize Then    
						Exit Function
					End If
					GetPostion CInt(MarkPosition), x, y, objImage.OriginalWidth, objImage.OriginalHeight, TextWidth, FontSize
					
					With objImage.Canvas
					  .Print x, y, Text
					End With
					objImage.Save FileName
		
				Case 2
					If Not sk.IsObjInstalled("wsImage.Resize") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("wsImage.Resize")
					objImage.LoadSoucePic CStr(FileName)
					objImage.TxtMarkFont = CStr(FontName)
					objImage.TxtMarkBond = FondBond
					objImage.TxtMarkHeight = FontSize
					FontColor = "&H" & Mid(FontColor, 7) & Mid(FontColor, 5, 2) & Mid(FontColor, 3, 2)  
					objImage.AddTxtMark CStr(FileName), CStr(Text), CLng(FontColor), 1, 1
				Case 3
					If Not sk.IsObjInstalled("SoftArtisans.ImageGen") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("SoftArtisans.ImageGen")
					objImage.LoadImage FileName
					objImage.Font.Height = FontSize
					objImage.Font.name = FontName
					FontColor = "&H" & Mid(FontColor, 7) & Mid(FontColor, 5, 2) & Mid(FontColor, 3, 2)  
					objImage.Font.Color = CLng(FontColor)
					objImage.Text = Text
					GetPostion CInt(MarkPosition), x, y, objImage.Width, objImage.Height, objImage.TextWidth, objImage.TextHeight 
					objImage.DrawTextOnImage x, y, objImage.TextWidth, objImage.TextHeight
					objImage.SaveImage 0, objImage.ImageFormat, FileName
			End Select
			Set objImage = Nothing
		End Function

		Function AddPhotoMark(MarkComponentID, MarkWidth, MarkHeight, MarkPicture, MarkOpacity, MarkTranspColor, MarkPosition, FileName)
			Dim objImage, objMark, x, y, OriginalWidth, OriginalHeight, Position
			If InStr(FileName, ":") = 0 Then                                                            
				FileName = Server.MapPath(FileName)
			End If
			If IsNull(MarkWidth) Or MarkWidth = "" Then
				MarkWidth = 0
			Else
				MarkWidth = CInt(MarkWidth)
			End If
			If IsNull(MarkHeight) Or MarkHeight = "" Then
				MarkHeight = 0
			Else
				MarkHeight = CInt(MarkHeight)
			End If
			If Trim(MarkPicture) = "" Or IsNull(MarkPicture) Then
				Exit Function
			End If
			If IsNull(MarkOpacity) Or MarkOpacity = "" Then
				MarkOpacity = 1
			Else
				MarkOpacity = CSng(MarkOpacity)
			End If
			If MarkTranspColor <> "" Then                                                              
				MarkTranspColor = Replace(MarkTranspColor, "#", "&H")
			Else
			End If
			Select Case MarkComponentID
				Case 1
					If Not sk.IsObjInstalled("Persits.Jpeg") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("Persits.Jpeg")
					Set objMark = Server.CreateObject("Persits.Jpeg")
					objImage.Open FileName
					If objImage.OriginalWidth < MarkWidth Or objImage.OriginalHeight < MarkHeight Then 
						Exit Function
					End If
					objMark.Open Server.MapPath(MarkPicture)
					GetPostion CInt(MarkPosition), x, y, objImage.OriginalWidth, objImage.OriginalHeight, MarkWidth, MarkHeight 
					If MarkTranspColor <> "" Then
						objImage.DrawImage x, y, objMark, MarkOpacity, MarkTranspColor
					Else
						objImage.DrawImage x, y, objMark, MarkOpacity
					End If
					objImage.Save FileName
				Case 2
					If Not IsObjInstalled("wsImage.Resize") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("wsImage.Resize")
					objImage.LoadSoucePic CStr(FileName)
					objImage.LoadImgMarkPic Server.MapPath(MarkPicture)
					objImage.GetSourceInfo OriginalWidth, OriginalHeight
					GetPostion CInt(MarkPosition), x, y, OriginalWidth, OriginalHeight, MarkWidth, MarkHeight
					If MarkTranspColor = "" Then
						MarkTranspColor = 0
					Else
						MarkTranspColor = "&H" & Mid(MarkTranspColor, 7) & Mid(MarkTranspColor, 5, 2) & Mid(MarkTranspColor, 3, 2)
					End If
					objImage.AddImgMark CStr(FileName), Int(x), Int(y), CLng(MarkTranspColor), Int(CSng(MarkOpacity) * 100)
				Case 3
					If Not sk.IsObjInstalled("SoftArtisans.ImageGen") Then
						Exit Function
					End If
					Set objImage = Server.CreateObject("SoftArtisans.ImageGen")
					objImage.LoadImage FileName
					Select Case CInt(MarkPosition)
						Case 1
							Position = 3
						Case 2
							Position = 5
						Case 3
							Position = 1
						Case 4
							Position = 6
						Case 5
							Position = 8
					End Select
					If MarkTranspColor <> "" Then
						MarkTranspColor = "&H" & Mid(MarkTranspColor, 7) & Mid(MarkTranspColor, 5, 2) & Mid(MarkTranspColor, 3, 2)
						objImage.AddWaterMark Server.MapPath(MarkPicture), Position, CSng(MarkOpacity), CLng(MarkTranspColor)
					Else
						objImage.AddWaterMark Server.MapPath(MarkPicture), Position, CSng(MarkOpacity)
					End If
					objImage.SaveImage 0, objImage.ImageFormat, FileName
			End Select
			Set objImage = Nothing
			Set objMark = Nothing
		End Function
		Function GetPostion(MarkPosition, x, y, ImageWidth, ImageHeight, MarkWidth, MarkHeight)
			Select Case CInt(MarkPosition)
				Case 1
					x = 1
					y = 1
				Case 2
					x = 1
					y = Int(ImageHeight - MarkHeight - 1)
				Case 3
					x = Int((ImageWidth - MarkWidth) / 2)
					y = Int((ImageHeight - MarkHeight) / 2)
				Case 4
					x = Int(ImageWidth - MarkWidth - 1)
					y = 1
				Case 5
					x = Int(ImageWidth - MarkWidth - 1)
					y = Int(ImageHeight - MarkHeight - 1)
			End Select
		End Function
		'由原图片根据数据里保存的设置生成缩略图
		Function CreateThumbs(FileName,ThumbFileName)
			Dim strSql, RsThumbSetting
			strSql = "Select ThumbComponent,RateTF,ThumbWidth,ThumbHeight,ThumbRate From w163_config"
			Set RsThumbSetting = connItem.Execute(strSql)
			CreateThumbs = False
			If RsThumbSetting("ThumbComponent") <> "0" And (Not IsNull(RsThumbSetting("ThumbComponent"))) Then
				If RsThumbSetting("RateTF") = "0" Then
					CreateThumbs = CreateThumb(FileName, CInt(RsThumbSetting("ThumbWidth")), CInt(RsThumbSetting("ThumbHeight")), 0, ThumbFileName)
				Else
					CreateThumbs = CreateThumb(FileName, 0, 0, CSng(RsThumbSetting("ThumbRate")), ThumbFileName)
				End If
			End If
			Set RsThumbSetting = Nothing
		End Function
		'由原图片生成指定宽度和高度的缩略图
		Function CreateThumb(FileName, Width, Height, Rate, ThumbFileName)
			Dim strSql, RsSetting, objImage, iWidth, iHeight, strFileExtName
			CreateThumb = False
			If IsNull(FileName) Then                                    '如果原图片未指定直接退出
				Exit Function
			ElseIf FileName = "" Then
				Exit Function
			End If
			If InStr(FileName, ".") <> 0 Then
				strFileExtName = LCase(Trim(Mid(FileName, InStrRev(FileName, ".") + 1)))
			End If
			If strFileExtName <> "jpg" And strFileExtName <> "gif" And strFileExtName <> "bmp" And strFileExtName <> "png" Then '文件不是可用图片则退出
				Exit Function
			End If
			If IsNull(ThumbFileName) Then                          
				Exit Function
			ElseIf ThumbFileName = "" Then
				Exit Function
			End If
			If IsNull(Width) Then                                
				Width = 0
			ElseIf Width = "" Then
				Width = 0
			End If
			If IsNull(Rate) Then                                   
				Rate = 0
			ElseIf Rate = "" Then
				Rate = 0
			End If
			If IsNull(Height) Then                               
				Height = 0
			ElseIf Height = "" Then
				Height = 0
			End If
			If InStr(FileName, ":") = 0 Then      
				FileName = Server.MapPath(FileName)
			End If
			If InStr(ThumbFileName, ":") = 0 Then
				ThumbFileName = Server.MapPath(ThumbFileName)
			End If
			Width = CInt(Width)
			Height = CInt(Height)
			Rate = CSng(Rate)
			
			strSql = "Select ThumbComponent From w163_config"
			Set RsSetting = connItem.Execute(strSql)
			Select Case CInt(RsSetting("ThumbComponent"))
				Case 0                                               
					Exit Function
				Case 1
					If Not sk.IsObjInstalled("Persits.Jpeg") Then
						Exit Function
					End If
					If sk.IsExpired("Persits.Jpeg") Then
						Response.Write ("对不起，Persits.Jpeg组件已过期！")
						Response.End
					End If
					Set objImage = Server.CreateObject("Persits.Jpeg")
					objImage.Open FileName
					If Rate = 0 And (Width <> 0 Or Height <> 0) Then
						If Width < objImage.OriginalWidth And Height < objImage.OriginalHeight Then
							If Width = 0 And Height <> 0 Then
								objImage.Width = objImage.OriginalWidth / objImage.OriginalHeight * Height
								objImage.Height = Height
							ElseIf Width <> 0 And Height = 0 Then
								objImage.Width = Width
								objImage.Height = objImage.OriginalHeight / objImage.OriginalWidth * Width
							ElseIf Width <> 0 And Height <> 0 Then
								objImage.Width = Width
								objImage.Height = Height
							End If
						End If
					ElseIf Rate <> 0 Then
						objImage.Width = objImage.OriginalWidth * Rate
						objImage.Height = objImage.OriginalHeight * Rate
					End If
					objImage.Save ThumbFileName
				Case 2
					If Not sk.IsObjInstalled("wsImage.Resize") Then  
						Exit Function
					End If
					If sk.IsExpired("wsImage.Resize") Then
						Response.Write ("对不起，wsImage.Resize组件已过期！")
						Response.End
					End If
					If strFileExtName = "png" Then   
						Exit Function
					End If
					Set objImage = Server.CreateObject("wsImage.Resize")
					objImage.LoadSoucePic CStr(FileName)
					If Rate = 0 And (Width <> 0 Or Height <> 0) Then
						objImage.GetSourceInfo iWidth, iHeight
						If Width < iWidth And Height < iHeight Then
							If Width = 0 And Height <> 0 Then
								objImage.OutputSpic CStr(ThumbFileName), 0, Height, 2
							ElseIf Width <> 0 And Height = 0 Then
								objImage.OutputSpic CStr(ThumbFileName), Width, 0, 1
							ElseIf Width <> 0 And Height <> 0 Then
								objImage.OutputSpic CStr(ThumbFileName), Width, Height, 0
							Else
								objImage.OutputSpic CStr(ThumbFileName), 1, 1, 3
							End If
						Else
							objImage.OutputSpic CStr(ThumbFileName), 1, 1, 3
						End If
					ElseIf Rate <> 0 Then
						objImage.OutputSpic CStr(ThumbFileName), Rate, Rate, 3
					Else
						objImage.OutputSpic CStr(ThumbFileName), 1, 1, 3
					End If
				Case 3
					If Not sk.IsObjInstalled("SoftArtisans.ImageGen") Then
						Exit Function
					End If
					If sk.IsExpired("SoftArtisans.ImageGen") Then
						Response.Write ("对不起，SoftArtisans.ImageGen组件已过期！")
						Response.End
					End If
					Set objImage = Server.CreateObject("SoftArtisans.ImageGen")
					objImage.LoadImage FileName
					If Rate = 0 And (Width <> 0 Or Height <> 0) Then
						If Width < objImage.Width And Height < objImage.Height Then
							If Width = 0 And Height <> 0 Then
								objImage.CreateThumb , CLng(Height), 0, True
							ElseIf Width <> 0 And Height = 0 Then
								objImage.CreateThumb CLng(Width), objImage.Height / objImage.Width * Width, 0, False
							ElseIf Width <> 0 And Height <> 0 Then
								objImage.CreateThumb CLng(Width), CLng(Height), 0, False
							End If
						End If
					ElseIf Rate <> 0 Then
						objImage.CreateThumb CLng(objImage.Width * Rate), CLng(objImage.Height * Rate), 0, False
					End If
					objImage.SaveImage 0, objImage.ImageFormat, ThumbFileName
				Case 4
					If Not sk.IsObjInstalled("CreatePreviewImage.cGvbox") Then       
						Exit Function
					End If
					Set objImage = Server.CreateObject("CreatePreviewImage.cGvbox")
					objImage.SetImageFile = FileName                           
					If Rate = 0 And (Width <> 0 Or Height <> 0) Then
						objImage.SetPreviewImageSize = Width                  
					ElseIf Rate <> 0 Then
						objImage.SetPreviewImageSize = objImage.SetPreviewImageSize * Rate            
					End If
					objImage.SetSavePreviewImagePath = ThumbFileName            
					If objImage.DoImageProcess = False Then                    
						Exit Function
					End If
			End Select
			CreateThumb = True
		End Function
End Class
 %>