newssoftindatabase_1.asp

blue space 蓝色空间下载系统精简版---大家分享

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
Server.ScriptTimeOut = 300	'脚本超时时间（秒）
Response.Buffer = True
Const IsUpdate = False		'是否进行强制更新数据库并重新生成静态文件
%>
<!--#include file="Check.asp" -->
<!--#include file="../inc/HeadDH.asp" -->
<!--#include file="../inc/oConn.asp" -->
<!--#include file="../inc/function.asp" -->
<!--#include file="../Soft/Function.asp" -->
<%
Call PrintHead("多多软件园最新更新软件信息采集入库")
Print "<br><p align='center'>"
For i = 1 to 2
	Response.Write "<a href='NewsSoftInDataBase_1.asp?ClassID="&i&"'>第 "&i&" 页</a> &nbsp;"
Next
%>
</p>
<TABLE align='center' width='550' cellpadding='4' cellspacing='1' bgcolor='#f5f5f5' style="border:1 solid #b8b8b8">
<TR>
	<TD align='center' style="background:#ffffff;border:1 solid #cccccc">多多软件园软件资料入库</TD>
</TR>
<TR>
	<TD height="60" style="background:#ffffff;border:1 solid #cccccc">状态：<span id='UpdateText'></span></TD>
</TR>
<TR>
	<TD height="30" style="background:#ffffff;border:1 solid #cccccc"><span id='UpdateTime'></span></TD>
</TR>
</TABLE>
<script language='JavaScript'>UpdateTime.innerHTML="请等待..."</script>
<%
Response.Flush()
Call NewsSoftList()
Call PrintFoot()

Response.Flush()

Call CLoseCOnn()

Sub NewsSoftList()
	Dim strUrl,strList,strTmp,strID,i,ClassID
	ClassID = Request.QueryString("ClassID")
	If ClassID = "" Then ClassID = 1
	strUrl = "http://www.ddooo.com/Softnew/"&Year(Date)&"_"&Month(Date)&"_"&Day(Date)&"_"&ClassID&".htm"
	strList = getHTTPPage(strUrl)
	'取得下载文件列表
	strTmp = strCut(strList,"<!--软件列表循环开始-->","</table>",2)
	'Response.Write strTmp
	'Response.End
	strArray = Split(strTmp,"<a href=""/softdown")
	For i = 2 to Ubound(strArray)
		strID = strCut(strArray(i),"/",".htm",2)
		Call PageIfEnd()
		Call SoftInfoInData(strID,ClassID)
	Next
	Response.Write "<script language='JavaScript'>UpdateTime.innerHTML=""更新完成，共更新"&i&"个软件，用时"&Timer-PageStart&"秒...""</script>"
End Sub

Function GetHtml(SoftID)
	Dim strUrl,strHtml
	strUrl = "http://www.ddooo.com/softdown/"&SoftID&".htm"
	strHtml = GetHttpPage(strUrl)

	GetHtml = strHtml
End Function

Sub SoftInfoInData(SoftID,ClassID)
	On Error Resume Next
	Dim strHtml
	strHtml = GetHtml(SoftID)
	Dim strTmp,strSQL,objRs
	Dim SoftName,SoftSize,SoftLanguage,SoftClass,SoftOperation,SoftType,SoftUpdateTime,SoftBigClass
	Dim SoftLinkMan,SoftRemark,SoftAboutID,ArticleAboutID,SoftClassBigName,SoftClassSmallName
	Dim SOftDownUrlList,SoftDownUrlArray,i,strTmp1,strTmp2,strTmp3,strTmp4

	strList = strHtml
	strTmp			= strHtml
	'SoftName		= strCut(strTmp,"<font color='#004FC6' size='3'>","</font>",2)
	SoftSize		= strCut(strTmp,"<B>软件大小：</B>","<br>",2)
	SoftLanguage	= strCut(strTmp,"<B>软件语言：</B>","<br>",2)
	SoftType		= strCut(strTmp,"<B>软件类别：</B>","<br>",2)
	SoftOperation	= strCut(strTmp,"<B>运行环境：</B>","<br>",2)
	SoftUpdateTime	= strCut(strTmp,"<B>更新时间：</B>","<br>",2)
	SoftLinkMan		= strCut(strTmp,"<B>联 系 人：</B>","<br>",2)
	SoftLinkMan		= strCut(SoftLinkMan,""">","</a>",2)
	SoftChangShang	= strCut(strTmp,"<B>开 发 商：</b>","</a>",2)
	SoftChangShang	= strCut(SoftChangShang,"target=_blank>","</a>",2)
	SoftRemark		= strCut(strTmp,"<td><B>软件简介：","<SCRIPT LANGUAGE=""JavaScript1.1"" SRC=""/js/down9.js""></SCRIPT>",2)
	SoftRemark		= strCut(SoftRemark,"<td>","</td>",2)
	SoftRemark = HTMLEncode(SoftRemark)
	

	SoftDownUrl = strCut(strTmp,"<td><img src=""/images/d_download.gif"" align=""absmiddle"" border=""0"">","target=_blank>",2)
	SoftDownUrl = strCut(SoftDownUrl,"<a href=""/SoftDownx.asp?SoftID="&SoftID&"&url=","""",2)

	Dim AddDownUrlArray(1)
	AddDownUrlArray(0) = "Delete From "&DownUrlTable&" Where SkySoftID = "&SoftID&""
	AddDownUrlArray(1) = "Insert into "&DownUrlTable&" (SkySoftID,SoftDownUrl) values ("&SoftID&",'"&SoftDownUrl&"')"

	'相关软件
	strTmp = strHtml
	strTmp1 = strCut(strTmp,"相关软件:</b></td>","</table>",2)
	strTmpArray = Split(strTmp1,"<tr>")
	strTmp3 = ""
	For i = 1 to UBound(strTmpArray)
		strID = strCut(strTmpArray(i),"href=""/softdown/",".htm"">",2)
		SoftAboutID = SoftAboutID & strID & ","
	Next
	Erase strTmpArray

	If InStr(SoftAboutID,",")>0 Then
		SoftAboutID = Left(SoftAboutID,Len(SoftAboutID)-1)
	End If


	strTmp = strCut(strHtml,"<td width=""643"">您的位置：<a href=""/"">下载首页</a>","<SCRIPT",2)
	strArray = Split(strTmp,"→")

	SoftClassBigName = strCut(strArray(1),"'>","</a>",2)
	strSQL = "Select SoftBigClassID From "&BigClassTable&" Where SoftBigCLassName='"&SoftClassBigName&"'"
	Set objRs = oConn.Execute(strSQL)
	If Not objRs.Eof Then
		SoftBigClass = objRs(0)
	Else
		oConn.Execute("Insert into "&BigClassTable&" (SoftBigClassName) values ('"&SoftClassBigName&"')")
		SoftBigClass = oConn.Execute(strsQL)(0)
	End If
	Set objRs = Nothing
	SoftClassSmallName = strCut(strArray(2),"'>","</A>",2)
	SoftName = strArray(UBound(strArray))
	Erase strArray

	Print "<br><table align='center' width='"&MaxTableWidth&"' style='border:1 solid #cccccc;background:#f5f5f5'><tr><td>"
	Print "软件名称："&SoftName&"<br>"
	Print "软件尺寸："&SoftSize&"<br>"
	Print "软件语言："&SoftLanguage&"<br>"
	Print "软件类型："&SoftType&"<br>"
	Print "软件平台："&SoftOperation&"<br>"
	Print "更新时间："&SoftUpdateTime&"<br>"
	Print "软件作者："&SoftLinkMan&"<br>"
	Print "软件厂商："&SoftChangShang&"<br>"
	Print "软件介绍："&SoftRemark&"<br>"
	Print "下载地址："&SoftDownUrl&"<hr>"
	Print "</td></tr></table><br>"
	
	strSQL = "Select SoftClassID From "&ClassTable&" Where SoftClassBigName = '"&SoftClassBigName&"' And SoftClassSmallName = '"&SoftClassSmallName&"'"
	Set objRs = oConn.Execute(strSQL)
	If Not objRs.Eof Then
		SoftClass = objRs(0)
	Else
		Set objRs = Nothing
		strSQL = "Insert into "&ClassTable&" (SoftClassBigName,SoftClassSmallName,SoftBigClassID) values ('"&SoftClassBigName&"','"&SoftCLassSmallName&"',"&SoftBigClass&")"
		oConn.Execute(strSQL)
		SoftClass = oConn.Execute("Select SoftClassID From "&ClassTable&" Where SoftClassBigName = '"&SoftClassBigName&"' And SoftClassSmallName = '"&SoftClassSmallName&"'")(0)
	End If
	Set objRs = Nothing

	
	strSQL = "Select SoftUpdateTime,SoftID From "&InfoTable&" Where SkySoftID = "&SoftID&""
	Set objRs = oConn.Execute(strSQL)
	If objRs.Eof Then
		strSQL = "Insert Into "&InfoTable&" (SkySoftID,SoftName,SoftCLass,SoftSize"&_
		",SoftLanguage,SoftType,SoftOperation,SoftUpdateTime,SoftLinkMan,SoftChangShang"&_
		",SoftRemark,SoftAboutID,ArticleAboutID,SoftBigClass) values ("&SoftID&",'"&SoftName&"'"&_
		","&SoftClass&",'"&SoftSize&"','"&SoftLanguage&"','"&SoftType&"'"&_
		",'"&SoftOperation&"','"&SoftUpdateTime&"','"&SoftLinkMan&"','"&SoftChangShang&"'"&_
		",'"&SoftRemark&"','"&SoftAboutID&"','"&ArticleAboutID&"',"&SoftBigClass&")"
		oConn.Execute(strSQL)
		'------------插入软件下载地址
		oConn.Execute(AddDownUrlArray(1))
		'---------------------
		Response.Write "<script language='JavaScript'>UpdateText.innerHTML=""插入软件ID["&SoftID&"]资料成功....""</script>"
	Else
		If CDate(SoftUpdateTime)>CDate(objRs(0)) Or IsUpdate Then
			strSQL = "Update "&InfoTable&" Set SoftName = '"&SoftName&"'"&_
			",SoftClass = "&SoftClass&""&_
			",SoftBigClass = "&SoftBigClass&""&_
			",SoftSize = '"&SoftSize&"'"&_
			",SoftLanguage = '"&SoftLanguage&"'"&_
			",SoftType = '"&SoftType&"'"&_
			",SoftOperation = '"&SoftOperation&"'"&_
			",SoftUpdateTime = '"&SoftUpdateTime&"'"&_
			",SoftLinkMan = '"&SoftLinkMan&"'"&_
			",SoftChangShang = '"&SoftChangShang&"'"&_
			",SoftRemark = '"&SoftRemark&"'"&_
			",SoftAboutID = '"&SoftAboutID&"'"&_
			",ArticleAboutID = '"&ArticleAboutID&"'"&_
			" Where SoftID = "&objRs(1)&""
			oConn.Execute(strSQL)
			'--------更新软件下载地址
			For i = 0 to UBound(AddDownUrlArray)
				oConn.Execute(AddDownUrlArray(i))
			Next
			'---------------------------
			Response.Write "<script language='JavaScript'>UpdateText.innerHTML=""更新软件ID["&SoftID&"]资料成功....""</script>"
		Else
			Response.Write "<script language='JavaScript'>UpdateText.innerHTML=""软件ID["&SoftID&"]的资料已经存在，且为最新，没有进行更新操作....""</script>"
		End If
	End If
	Set objRs = Nothing
	If Err Then
		Err.Clear
		Response.Write "<script language='JavaScript'>UpdateText.innerHTML=""更新软件ID["&SoftID&"]的资料时错误，没有进行更新操作....""</script>"
	End If

	Response.Flush()
End Sub

'------ 过滤HTML代码
Function HTMLEncode(fString)
	If Not IsNull(fString) Then
		fString = Replace(fString, CHR(39), "&#39;")	'单引号过滤
	End If
	HTMLEncode = fString
End Function
%>