refreshhtmlsave.asp

SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.

		Sub RefreshContentDownLoad()
		With Response
		Dim AlreadyRefreshByID, NowNum, RefreshSql, RefreshRS, TotalNum,DownID
		Dim StartDate, EndDate, FolderID, RefreshTotalNum, TotalRS
		AlreadyRefreshByID = Request.QueryString("AlreadyRefreshByID")
		RefreshTotalNum = Request.QueryString("RefreshTotalNum")
		NowNum = Request.QueryString("NowNum") '正在刷新第几个下载
		If NowNum = "" Then NowNum = 0
		  Select Case RefreshFlag
		     Case "ID"
			    DownID=KSCMS.G("DownID")
				If DownID<>"" Then
                 RefreshSql = "Select top 1 * from KS_DownLoad where DownID='" & DownID & "' And Verific=1 and  DelTF=0 Order By ID Desc"	
				Else
				 RefreshSql = ""
				End If
				RefreshTotalNum=1
			Case "New"
			  TotalNum = Request("TotalNum")
			  If TotalNum = "" Then TotalNum = 50
			  RefreshTotalNum = TotalNum
			  If CInt(NowNum) < CInt(RefreshTotalNum) Then
			  If AlreadyRefreshByID = "" Then
				RefreshSql = "Select top 1 * from [KS_DownLoad] where Verific=1 and  DelTF=0 Order By ID Desc"
			  Else
				RefreshSql = "Select top 1 * from [KS_DownLoad] where ID<" & AlreadyRefreshByID & " And Verific=1 and  DelTF=0 Order By ID Desc"
			  End If
			  Else
				RefreshSql = ""
			  End If
		   Case "Date"
			  StartDate = Request("StartDate")
			  EndDate = DateAdd("d", 1, Request("EndDate"))
			  '判断数据库类型
			 If CInt(Application("DataBaseType")) = 1 Then         'Sql
				 If AlreadyRefreshByID = "" Then
					RefreshSql = "Select top 1 * from [KS_DownLoad] where Verific=1 and  DelTF=0 And AddDate>= '" & StartDate & "' And  AddDate <='" & EndDate & "' Order By ID Desc"
				 Else
					RefreshSql = "Select top 1 * from [KS_DownLoad] where ID<" & AlreadyRefreshByID & " And Verific=1 and  DelTF=0 And AddDate >= '" & StartDate & "' And AddDate <='" & EndDate & "' Order By ID Desc"
				 End If
				If RefreshTotalNum = "" Then
				 Set TotalRS = Server.CreateObject("Adodb.RecordSet")
					TotalRS.Open "Select count(*) from [KS_DownLoad] where Verific=1 and  DelTF=0 And AddDate >= '" & StartDate & "' And  AddDate <= '" & EndDate & "'", Conn, 1, 1
					RefreshTotalNum = TotalRS(0)
					TotalRS.Close
					 Set TotalRS = Nothing
				End If
			Else                                                   'Access
				 If AlreadyRefreshByID = "" Then
					RefreshSql = "Select top 1 * from [KS_DownLoad] where Verific=1 and  DelTF=0 And AddDate>= #" & StartDate & "# And  AddDate <=#" & EndDate & "# Order By ID Desc"
				 Else
					RefreshSql = "Select top 1 * from [KS_DownLoad] where ID<" & AlreadyRefreshByID & " And Verific=1 and  DelTF=0 And AddDate >= #" & StartDate & "# And AddDate <=#" & EndDate & "# Order By ID Desc"
				 End If
				If RefreshTotalNum = "" Then
				 Set TotalRS = Server.CreateObject("Adodb.RecordSet")
					TotalRS.Open "Select count(*) from [KS_DownLoad] where Verific=1 and  DelTF=0 And AddDate >= #" & StartDate & "# And  AddDate <=#" & EndDate & "#", Conn, 1, 1
					RefreshTotalNum = TotalRS(0)
					TotalRS.Close
					 Set TotalRS = Nothing
				End If
			End If
		   Case "All"
			  If AlreadyRefreshByID = "" Then
				 RefreshSql = "Select top 1 * from [KS_DownLoad] where Verific=1 and  DelTF=0 Order By ID Desc"
			  Else
				 RefreshSql = "Select top 1 * from [KS_DownLoad] where ID<" & AlreadyRefreshByID & " And Verific=1 and  DelTF=0 Order By ID Desc"
			  End If
			  If RefreshTotalNum = "" Then
			  Set TotalRS = Server.CreateObject("Adodb.RecordSet")
			   TotalRS.Open "Select count(*) from [KS_DownLoad] where Verific=1 and  DelTF=0", Conn, 1, 1
			   RefreshTotalNum = TotalRS(0)
			   TotalRS.Close
			   Set TotalRS = Nothing
			  End If
		  Case "Folder"
			 FolderID = Trim(Request("FolderID"))
			 If RefreshTotalNum = "" And FolderID <> "" Then
			  Set TotalRS = Server.CreateObject("Adodb.RecordSet")
			  TotalRS.Open "Select count(*) from [KS_DownLoad] where Verific=1 and  DelTF=0 And Tid IN (" & FolderID & ")", Conn, 1, 1
			  RefreshTotalNum = TotalRS(0)
			  TotalRS.Close
			  Set TotalRS = Nothing
			End If
			If CInt(NowNum) < CInt(RefreshTotalNum) And FolderID <> "" Then
			 If AlreadyRefreshByID = "" Then
				RefreshSql = "Select top 1 * from [KS_DownLoad] where Verific=1 and  DelTF=0 And Tid IN(" & FolderID & ") Order By ID Desc"
			 Else
				RefreshSql = "Select top 1 * from [KS_DownLoad] where ID<" & AlreadyRefreshByID & " And Verific=1 and  DelTF=0 And Tid in(" & FolderID & ") Order By ID Desc"
			 End If
			Else
				RefreshSql = ""
			End If
		Case Else
			RefreshSql = ""
			RefreshTotalNum = 0
		End Select
		If RefreshSql <> "" Then
			Set RefreshRS = Server.CreateObject("ADODB.RecordSet")
			RefreshRS.Open RefreshSql, Conn, 1, 1
			If RefreshRS.EOF And RefreshRS.BOF Then
				Call Main
				If NowNum <> 0 Then
				 .Write "<script>img2.width=" & Fix((NowNum / RefreshTotalNum) * 400) & ";" & vbCrLf
				.Write "txt2.innerHTML=""生成下载结束！" & FormatNumber(NowNum / RefreshTotalNum * 100, 0, -1) & """;" & vbCrLf
				.Write "txt3.innerHTML=""总共生成了 <font color=red><b>" & RefreshTotalNum & "</b></font> 个下载,总费时:<font color=red>" & Left((Timer() - StartRefreshTime), 4) & "</font> 秒<br><br><input name='button1' type='button' onclick=javascript:location='RefreshHtml.asp?ChannelID=3'; class='buttonstyle' value=' 返 回 '>"";" & vbCrLf
				.Write "img2.title=""(" & NowNum & ")"";</script>" & vbCrLf
				Else
				.Write "<script>img2.width=""0"";" & vbCrLf
				.Write "txt2.innerHTML=""没有可生成的下载！<br><br><input name='button1' type='button' onclick=javascript:location='RefreshHtml.asp?ChannelID=3'; class='buttonstyle' value=' 返 回 '>"";" & vbCrLf
				.Write "txt3.innerHTML="""";" & vbCrLf
				.Write "txt4.innerHTML="""";" & vbCrLf
				.Write "document.all.BarShowArea.style.display='none';" & vbCrLf
				.Write "</script>" & vbCrLf
				End If
				.Flush
				Exit Sub
			Else
				On Error Resume Next
				If KSCMS.GetChannelConfig(ChannelID,"FsoHtmlTF")=0 Then
				FsoHtmlList="<table border=""0"">"_
								& "<tr><td><li><strong>ID号为：</strong></li></td><td> <font color=red>"  & RefreshRS("ID") & "</font> 的下载没有生成!</td></tr>"_
								& "<tr><td><li><strong>原  因：</strong></li></td><td>下载频道没有启用生成静态HTML生成功能；<br>"_
						& "</table>"		
				Else
					Dim FsoHtmlPath:FsoHtmlPath=KSCMS.GetFolderPath(RefreshRS("Tid"), False) & RefreshRS("Fname")
					FsoHtmlList="<table border=""0"">"_
								& "<tr><td><li><strong>ID 号为：</strong></li></td><td> <font color=red>"  & RefreshRS("ID") & "</font> 的下载已生成</td></tr>"_
								& "<tr><td><li><strong>下载标题：</strong></li></td><td><font color=red>" & RefreshRS("Title") & "</font></li></td><tr>" _
								& "<tr><td><li><strong>生成路径：</strong></li></td><td><a href=""" & FsoHtmlPath & """ target=""_blank"">" & FsoHtmlPath & "</a></li></td><tr>" _
								& "</table>"				
				   Call KSRObj.RefreshDownLoadContent(RefreshRS)
				End If
				If RefreshFlag="ID" Then
				  Call Main
				  .End
				End If
				NowNum = NowNum + 1
				AlreadyRefreshByID = RefreshRS("ID")
				If Err.Number <> 0 Then
				 ReturnInfo = "操作失败!<br><font color=red>" & Err.Description & "</font>"
				 Call Main
				 Exit Sub
				End If
				.Write ("<meta http-equiv=""refresh"" content=""0;url='RefreshHtmlSave.asp?Types=Content&ChannelID=3&RefreshTotalNum=" & RefreshTotalNum & "&StartRefreshTime=" & Server.URLEncode(StartRefreshTime) & "&NowNum=" & NowNum & "&TotalNum=" & TotalNum & "&StartDate=" & Server.URLEncode(StartDate) & "&EndDate=" & Server.URLEncode(EndDate) & "&FolderID=" & Server.URLEncode(FolderID) & "&AlreadyRefreshByID=" & AlreadyRefreshByID & "&RefreshFlag=" & RefreshFlag & "'"">")
				
				Call Main
				.Write "<script>img2.width=" & Fix((NowNum / RefreshTotalNum) * 400) & ";" & vbCrLf
				.Write "txt2.innerHTML=""生成进度:" & FormatNumber(NowNum / RefreshTotalNum * 100, 2, -1) & """;" & vbCrLf
				.Write "txt3.innerHTML=""总共需要生成 <font color=red><b>" & RefreshTotalNum & "</b></font> 个下载,<font color=red><b>在此过程中请勿刷新此页面！！！</b></font> 系统正在生成第 <font color=red><b>" & NowNum & "</b></font> 个下载"";" & vbCrLf
				.Write "img2.title=""(" & NowNum & ")"";</script>" & vbCrLf
				.Flush
				
			End If
			Set RefreshRS = Nothing
		Else
				Call Main
				If NowNum <> 0 Then
				 .Write "<script>img2.width=" & Fix((NowNum / RefreshTotalNum) * 400) & ";" & vbCrLf
				.Write "txt2.innerHTML=""生成下载结束！" & FormatNumber(NowNum / RefreshTotalNum * 100, 0, -1) & """;" & vbCrLf
				.Write "txt3.innerHTML=""总共生成了 <font color=red><b>" & RefreshTotalNum & "</b></font> 个下载,总费时:<font color=red>" & Left((Timer() - StartRefreshTime), 4) & "</font> 秒<br><br><input name='button1' type='button' onclick=javascript:location='RefreshHtml.asp?ChannelID=3'; class='buttonstyle' value=' 返 回 '>"";" & vbCrLf
				.Write "img2.title=""(" & NowNum & ")"";</script>" & vbCrLf
				Else
				.Write "<script>img2.width=""0"";" & vbCrLf
				.Write "txt2.innerHTML=""没有可生成的下载！<br><br><input name='button1' type='button' onclick=javascript:location='RefreshHtml.asp?ChannelID=3'; class='buttonstyle' value=' 返 回 '>"";" & vbCrLf
				.Write "txt3.innerHTML="""";" & vbCrLf
				.Write "txt4.innerHTML="""";" & vbCrLf
				.Write "document.all.BarShowArea.style.display='none';" & vbCrLf
				.Write "</script>" & vbCrLf
				End If
				.Flush
				Exit Sub
		End If
		End With
		End Sub
		
		'生成下载栏目页的处理过程
		Sub RefreshFolderDownLoad()
		With Response
		Dim FolderID, RefreshSql, RefreshTotalNum, RefreshRS, NewsTotalNum, NewsNo
		  RefreshSql = Trim(Request("RefreshSql"))
		  NewsNo = Request("NewsNo")
		 If NewsNo = "" Then NewsNo = 0
		 If RefreshSql = "" Then
		  Select Case RefreshFlag
		      Case "ID"
			   FolderID = Trim(Request("FolderID"))
			   If FolderID <> "" Then
			    RefreshSql = "Select * from KS_Class where ChannelID=3 and  DelTF=0 And ID ='" & FolderID & "'"
			   Else
			    RefreshSql = "Select * From KS_Class Where 1=0"
			   End If
			Case "Folder"
				FolderID = Trim(Request("FolderID"))
				If FolderID <> "" Then
				RefreshSql = "Select * from KS_Class where ChannelID=3 and  DelTF=0 And ID IN (" & FolderID & ") Order By FolderOrder ASC"
				Else
				RefreshSql = "Select * From KS_Class Where 1=0"
				End If
		   Case "All"
				RefreshSql = "Select * from KS_Class where ChannelID=3 and  DelTF=0 Order By FolderOrder ASC"
		   Case Else
			RefreshSql = ""
			RefreshTotalNum = 0
		  End Select
		End If
		If RefreshSql <> "" Then
			Set RefreshRS = Server.CreateObject("ADODB.RecordSet")
			RefreshRS.Open RefreshSql, Conn, 1, 1
			NewsTotalNum = RefreshRS.RecordCount
			If RefreshRS.EOF Then
				Call Main
				If NewsNo <> 0 Then
				.Write "<script>img2.width=" & Fix((NewsNo / NewsTotalNum) * 400) & ";" & vbCrLf
				.Write "txt2.innerHTML=""生成下载栏目结束！" & FormatNumber(NewsNo / NewsTotalNum * 100, 0, -1) & """;" & vbCrLf
				.Write "txt3.innerHTML=""总共生成了 <font color=red><b>" & NewsTotalNum & "</b></font> 个下载栏目,总费时:<font color=red>" & Left((Timer() - StartRefreshTime), 4) & "</font> 秒<br><br><input name='button1' type='button' onclick=javascript:location='RefreshHtml.asp?ChannelID=3'; class='buttonstyle' value=' 返 回 '>"";" & vbCrLf
				.Write "img2.title=""(" & NewsNo & ")"";</script>" & vbCrLf
				Else
				.Write "<script>img2.width=""0"";" & vbCrLf
				.Write "txt2.innerHTML=""没有可生成的下载栏目！<br><br><input name='button1' type='button' onclick=javascript:location='RefreshHtml.asp?ChannelID=3'; class='buttonstyle' value=' 返 回 '>"";" & vbCrLf
				.Write "txt3.innerHTML="""";" & vbCrLf
				.Write "txt4.innerHTML="""";" & vbCrLf
				.Write "document.all.BarShowArea.style.display='none';" & vbCrLf
				.Write "</script>" & vbCrLf
				End If
				.Flush
				Exit Sub
				Set RefreshRS = Nothing
			Else
				RefreshRS.Move NewsNo
				If Not RefreshRS.EOF Then
					If RefreshRS("ClassPurview")=2 Then
				     FsoHtmlList="<table border=""0"">"_
								& "<tr><td><li><strong>ID号为：</strong></li></td><td> <font color=red>"  & RefreshRS("ID") & "</font> 的栏目没有生成!</td></tr>"_
								& "<tr><td><li><strong>原 因：</strong></li></td><td>该栏目设置为认证栏目"_
							& "</table>"		
					Else
						Dim FsoHtmlPath:FsoHtmlPath=KSCMS.GetFolderPath(RefreshRS("ID"), true)
						FsoHtmlList="<table border=""0"">"_
									& "<tr><td><li><strong>ID 号 为：</strong></li></td><td> <font color=red>"  & RefreshRS("ID") & "</font> 的栏目</td></tr>"_
									& "<tr><td><li><strong>栏目名称：</strong></li></td><td><font color=red>" & RefreshRS("FolderName") & "</font></li></td><tr>" _
									& "<tr><td><li><strong>生成路径：</strong></li></td><td><a href=""" & FsoHtmlPath & """ target=""_blank"">" & FsoHtmlPath & "</a></li></td><tr>" _
									& "</table>"				
					Call KSRObj.RefreshDownLoadFolder(RefreshRS)   '调用下载栏目刷新函数
					End If