www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\adminadmin\article\collection.asp
<% Const UnsealHttpLog=False Dim stopGather, RepeatDeal, MaxPicSize, AllowPicExt, setInterval Dim ItemID,ListID,InfoID,downid,ItemTitle,classid,specialid,showcode,strHtmlCode,ArticleID Dim ListTitle,FindListArea,FindListLink,FindReplace,IsRedirect,RedirectUrl Dim InfoTitle,FindTitle,FindContent,FindCategory,FindDateTime,FindOthers,Pagination,FindPagination,TitleReplace,ContentReplace,AppendUrl,sourceReplace Dim Encoding,RemoteListUrl,NamedDemourl,RemoveCode Dim m_strHtmlCode,m_strHtmlList,m_strLinkArry,m_strFindLink Dim m_strClassHtml,m_strParent,m_strChild Dim AutoClass,RetuneClass,strReplace Dim DownlistHtml,DownlistCode,m_strDownHtml,m_strDownList,m_strDownArry Dim m_strTitle,m_strContent,m_strSubTitle,m_strDateTime,m_intAllHits,m_strAlphaTitle Dim m_strAuthor,m_strComeFrom,m_strStar,m_intStar If Not IsObject(CJ_Conn) Then CJ_ConnectionDatabase Sub LoadItemSetting(MYID) Dim Rs,SQL,TempXmlDoc SQL = "SELECT TOP 1 * FROM NC_NewsItem WHERE ItemID=" & MYID Set Rs = cmHttp.Execute(SQL) Set TempXmlDoc = NewAsp.RecordsetToxml(Rs,"row","xml") Rs.Close Set Rs = Nothing Application.Lock Set Application(NewAsp.CacheName&"_newsitem_"&ChannelID&"_"&MYID) = TempXmlDoc Application.unLock End Sub Sub LoadInfoTemplate(MYID) Dim Rs,SQL,TempXmlDoc SQL = "SELECT TOP 1 * FROM NC_TPL_Info WHERE InfoID=" & MYID Set Rs = cmHttp.Execute(SQL) Set TempXmlDoc = NewAsp.RecordsetToxml(Rs,"row","xml") Rs.Close Set Rs = Nothing Application.Lock Set Application(NewAsp.CacheName&"_infotemplate_"&ChannelID&"_"&MYID) = TempXmlDoc Application.unLock End Sub Sub LoadListTemplate(MYID) Dim Rs Set Rs = cmHttp.Execute("SELECT TOP 1 * FROM NC_TPL_List WHERE listid="&MYID) If Not(Rs.BOF And Rs.EOF) Then IsRedirect=Rs("IsRedirect") RedirectUrl=Rs("RedirectUrl") FindListArea=Split(Rs("FindListArea")&"||||||||||||", "|||") FindListLink=Split(Rs("FindListLink")&"||||||||||||", "|||") FindReplace=Split(Rs("FindReplace")&"||||||||||||", "|||") End If Rs.Close:Set Rs = Nothing End Sub Sub LoadNewsConfig() Dim Rs,SQL,TempXmlDoc SQL = "SELECT TOP 1 * FROM NC_NewsConfig" Set Rs = cmHttp.Execute(SQL) Set TempXmlDoc = NewAsp.RecordsetToxml(Rs,"row","xml") Rs.Close Set Rs = Nothing Application.Lock Set Application(NewAsp.CacheName&"_newsconfig") = TempXmlDoc Application.unLock End Sub Function getArticleID(ByVal URL) On Error Resume Next Dim oRs,SQL URL = Trim(LCase(URL)) SQL="SELECT id,ArticleID FROM [NC_Newslog] WHERE ChannelID="&ChannelID&" And url='"&Replace(URL, "'", "")&"'" Set oRs=cmHttp.Execute(SQL) If oRs.BOF And oRs.EOF Then getArticleID=0 Else getArticleID=oRs("softid") End If oRs.Close: Set oRs = Nothing End Function Sub UpdateHttpLog(ByVal URL, ByVal itemsid, ByVal sid, ByVal title, ByVal cid, ByVal star) Dim oRs,SQL URL=Trim(LCase(URL)) Set oRs=NewAsp.CreateAXObject("ADODB.Recordset") SQL="SELECT * FROM [NC_Newslog] WHERE ChannelID="&ChannelID&" And url='"&Replace(URL, "'", "")&"'" oRs.Open SQL, CJ_Conn, 1, 3 If oRs.BOF And oRs.EOF Then Exit Sub Else oRs("ItemID").Value = itemsid oRs("ArticleID").Value = sid oRs("classid").Value = cid oRs("title").Value = Trim(title) oRs("addtime").Value = Now() oRs("records").Value = 1 If oRs("star") = 0 Then oRs("star").Value = star End If oRs.Update End If oRs.Close: Set oRs = Nothing End Sub Sub AddHttpLog(ByVal m_url, ByVal itemsid) If Len(m_url) < 10 Then Exit Sub Dim Rs,SQL m_url = Trim(LCase(m_url)) Set Rs=NewAsp.CreateAXObject("ADODB.Recordset") SQL="SELECT * FROM [NC_Newslog] WHERE ChannelID="&ChannelID&" And url='"&Replace(m_url, "'", "")&"'" Rs.Open SQL, CJ_Conn, 1, 3 If Rs.BOF And Rs.EOF Then Rs.AddNew Rs("ChannelID").Value = ChannelID Rs("ItemID").Value = itemsid Rs("ArticleID").Value = 0 If AutoClass = 0 Then Rs("classid").Value = classid Else Rs("classid").Value = 0 End If Rs("title").Value = "" Rs("url").Value = Replace(m_url, "'", "") Rs("star").Value = 0 Rs("addtime").Value = Now() Rs("hits").Value = 0 Rs("records").Value = 0 Rs("islock").Value = 0 Rs.Update Else Rs("ItemID").Value = itemsid Rs("addtime").Value = Now() Rs.Update End If Rs.Close Set Rs = Nothing End Sub %>