admin_itemdatabase.asp

用ASP开发环境写出来的新闻采集系统

   Dim rsCount,sqlCount,aCount,bCount,Arr_Channel,i_Channel,sqlItem
   Set Rs=Conn.execute("Select ChannelID,ChannelDir,ChannelName from PE_Channel Where ModuleType=1")
   If Not Rs.Eof Then
      Arr_Channel=Rs.GetRows()
   End If
   Set Rs=Nothing
   If IsArray(Arr_Channel)=True Then
      For i_Channel=0 To Ubound(Arr_Channel,2)
         If Trim(Request("ChannelData"))="yes" Then
            Set rsCount= Server.CreateObject("ADODB.Recordset")
            sqlCount="select count(ArticleID) from PE_Article where ChannelID=" & Arr_Channel(0,i_Channel) & " And Passed=-1 and deleted=0"
            rsCount.open sqlCount,conn,1,1
            If rsCount.Eof Then
               aCount=0
            Else
               aCount=rsCount(0)
            End If
            rsCount.Close

            sqlCount="select count(ArticleID) from PE_Article where ChannelID=" & Arr_Channel(0,i_Channel) & " And Passed=0 and deleted=0"
            rsCount.open sqlCount,conn,1,1
            If rsCount.Eof Then
               bCount=0
            Else
               bCount=rsCount(0)
            End If
            rsCount.Close
            set rsCount=Nothing
            Conn.execute("Update [PE_Channel] Set ItemCount=" & aCount+bCount & " where ChannelID=" & Arr_Channel(0,i_Channel))
            ErrMsg=ErrMsg & "<br><b>" & Arr_Channel(2,i_Channel) & "</b> 文章总数：" & aCount+bCount & " 已审核数：" & aCount & " 未审核数：" & bCount
         End If
         SqlItem="Update [Item] Set ChannelDir='" & Arr_Channel(1,i_Channel) & "'"
         If ObjInstalled=False Then
            SqlItem=SqlItem & ",SaveFiles=False"
         End If
         SqlItem=SqlItem & " where ChannelID=" & Arr_Channel(0,i_Channel)
         ConnItem.Execute(SqlItem)
      Next
      If Request("ChannelData")="yes" Then
         ErrMsg=ErrMsg & "<br>频道数据更新完毕"
      End If
   End If
'项目数据(未完成)
   ErrMsg=ErrMsg & "<br>检查项目数据"
   Set RsItem=server.createobject("adodb.recordset")         
   SqlItem="select * from Item"
   RsItem.open SqlItem,ConnItem,1,1    
   If Not RsItem.Eof Then
      Do While (Not RsItem.Eof) and (Not RsItem.Bof)
         FoundErr=False
         ErrMsg=ErrMsg & "<br><b>" & RsItem("ItemName") & "</b> 项目数据： "
         If RsItem("ItemName")="" or isnull(RsItem("ItemName")) Then
            FoundErr=True
            ErrMsg=ErrMsg & "项目名称"
         End If
         If RsItem("ChannelID")="" or RsItem("ChannelID")=0 or IsNull(RsItem("ChannelID")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 频道"
         else
            If RsItem("ClassID")="" or RsItem("ClassID")=0 Or IsNull(RsItem("ClassID")) Then
               FoundErr=True
               ErrMsg=ErrMsg & " 栏目"
            Else
               set tClass=conn.execute("select C.Child,C.LinkUrl From PE_Class C inner join PE_Channel D on C.ChannelID=D.ChannelID Where C.ChannelID="  & RsItem("ChannelID") & " and C.ClassID=" & RsItem("ClassID"))
               If tClass.bof and tClass.eof then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 栏目"
               Else
                  if tClass(0)>0 then
                     FoundErr=True
                     ErrMsg=ErrMsg & " 栏目"
                  End if
                  If tClass(1)<>"" then
                     FoundErr=True
                     ErrMsg=ErrMsg & " 栏目"
                  End if
               End If
               Set tClass=Nothing
            End If
            If IsNumeric(RsItem("SpecialID"))=False Then
               FoundErr=True
               ErrMsg=ErrMsg & " 专题"
            Else
               If RsItem("SpecialID")<>0 Then
                  set tSpecial=conn.execute("select SpecialID From PE_Special Where ChannelID="  & RsItem("ChannelID"))
                  If tSpecial.bof and tSpecial.eof then
                     FoundErr=True
                     ErrMsg=ErrMsg & " 专题"
                  End If
                  Set tSpecial=Nothing
               End If
            End If
         End If
         If RsItem("WebName")="" or IsNull(RsItem("WebName")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 网站名称"
         End If
         If RsItem("WebUrl")="" Or IsNull(RsItem("WebUrl")) Then
            FoundErr=True
            ErrMsg=ErrMsg & "、网站地址"
         End If
         If RsItem("LoginType")="" or IsNull(RsItem("LoginType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 网站登录类型"
         else
            If RsItem("LoginType")=1 Then
               If RsItem("LoginUrl")="" or RsItem("LoginPostUrl")="" or Instr(RsItem("LoginUser"),"=")=0 or Instr(RsItem("LoginPass"),"=")=0 or RsItem("LoginFalse")="" then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 网站登录参数"
               End If
            End If
         End If
         If RsItem("ListPaingType")="" or IsNull(RsItem("ListPaingType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 列表分页类型"
         Else
            If RsItem("ListPaingType")=0 Then
               If RsItem("ListStr")="" or IsNull(RsItem("ListStr"))=True Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表索引"
               End If
            ElseIf RsItem("ListPaingType")=1 Then
               If RsItem("ListStr")="" Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表索引"
               End If
               If RsItem("LPsString")="" or IsNull(RsItem("LPsString")) or RsItem("LPoString")="" Or IsNull(RsItem("LPoString")) then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表分页标记"
               end If
               If IsNull(RsItem("ListPaingStr1"))<>True and Len(RsItem("ListPaingStr1"))<15 Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 索引分页重定向"
               End If
            ElseIf RsItem("ListPaingType")=2 Then
               If Len(RsItem("ListPaingStr2"))<15 or Instr(RsItem("ListPaingStr2"),"{$ID}")=0 Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表原始字符"
               End If
               If IsNumeric(RsItem("ListPaingID1"))=False or IsNumeric(RsItem("ListPaingID2"))=False or (RsItem("ListPaingID1")=0 and RsItem("ListPaingID2")=0) Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表分页范围"
               End If
            ElseIf RsItem("ListPaingType")=3 Then
               If RsItem("ListPaingStr3")="" Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 列表手动分页标记"
               End If
            Else
               FoundErr=True
               ErrMsg=ErrMsg & " 列表分页类型"
            End If
         End If
         If RsItem("LsString")="" or IsNull(RsItem("LsString")) Or RsItem("LoString")="" Or IsNull(RsItem("LoString")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 列表标记设置"
         End If
         If RsItem("HsString")="" or IsNull(RsItem("HsString")) Or RsItem("HoString")="" Or IsNull(RsItem("HoString")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 链接标记设置"
         End If
         If IsNull(RsItem("HttpUrlType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 链接类型"
         Else
            If RsItem("HttpUrlType")=1 and Len(Rsitem("HttpUrlStr"))<15 Then
               FoundErr=True
               ErrMsg=ErrMsg & " 链接字符"
            End If
         End If
         If RsItem("TsString")="" or IsNull(RsItem("TsString")) Or RsItem("ToString")="" Or IsNull(RsItem("ToString")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 标题标记设置"
         End If
         If RsItem("CsString")="" or IsNull(RsItem("CsString")) Or RsItem("CoString")="" Or IsNull(RsItem("CoString")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 正文标记设置"
         End If
         If IsNull(RsItem("DateType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 时间标记设置"
         Else
            If RsItem("DateType")=1 Then
               If RsItem("DsString")="" or IsNull(RsItem("DsString")) Or RsItem("DoString")="" Or IsNull(RsItem("DoString")) Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 时间标记设置"
               End If
            End If
         End If
         If IsNull(RsItem("AuthorType")) Then
            FoundErr=True
            ErrMsg=ErrMsg & " 作者标记设置"
         Else
            If RsItem("AuthorType")=1 Then
               If RsItem("AsString")="" or IsNull(RsItem("AsString")) Or RsItem("AoString")="" Or IsNull(RsItem("AoString")) Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 作者标记设置"
               End If
            ElseIf RsItem("AuthorType")=2 Then
               If RsItem("AuthorStr")="" or IsNull(RsItem("AuthorStr")) Then
                  FoundErr=True
                  ErrMsg=ErrMsg & " 指定作者设置"
               End If 
            End If
         End If
         If RsItem("CopyFromType")=1 Then
            If RsItem("FsString")="" or RsItem("FoString")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 来源标记设置"
            End If
         ElseIf RsItem("CopyFromType")=2 Then
            If RsItem("CopyFromStr")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 指定来源设置"
            End If 
         End If
         If RsItem("KeyType")=1 Then
            If RsItem("KsString")="" or RsItem("KoString")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 关键字标记设置"
            End If
         ElseIf RsItem("KeyType")=2 Then
            If RsItem("KeyStr")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 指定关键字设置"
            End If 
         End If
         If RsItem("NewsPaingType")=1 Then
            If RsItem("NPsString")="" or RsItem("NPoString")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 正文分页标记设置"
            End If
            If RsItem("NewsPaingStr")<>"" And Len(RsItem("NewsPaingStr"))<15 Then
               FoundErr=True
               ErrMsg=ErrMsg & " 正文分页绝对链接"
            End If
         ElseIf RsItem("NewsPaingType")=2 Then
            FoundErr=True
            ErrMsg=ErrMsg & " 正文分页类型"
         End If
         If RsItem("PaginationType")=1 Then
            If RsItem("MaxCharPerPage")=0 Then
               FoundErr=True
               ErrMsg=ErrMsg & " 自动分页的每页字符数"
            End If
         End If
         If RsItem("ReadLevel")<>5 And RsItem("ReadLevel")<>9 And RsItem("ReadLevel")<>99 And RsItem("ReadLevel")<>999 And RsItem("ReadLevel")<>9999 Then
            FoundErr=True
            ErrMsg=ErrMsg & " 文章阅读等级"
         End If
         If RsItem("Stars")<>0 And RsItem("Stars")<>1 And RsItem("Stars")<>2 And RsItem("Stars")<>3 And RsItem("Stars")<>4 And RsItem("Stars")<>5 Then
            FoundErr=True
            ErrMsg=ErrMsg & " 文章评分等级"
         End if
         If IsNumeric(Rsitem("ReadPoint"))=False Then
            FoundErr=True
            ErrMsg=ErrMsg & " 文章阅读点数"
         end If
         If IsNumeric(Rsitem("Hits"))=False Then
            FoundErr=True
            ErrMsg=ErrMsg & " 点击数初始值"
         end If
         If RsItem("UpDateType")=2 Then
            If IsDate(RsItem("UpDateTime"))=False Then
               FoundErr=True
               ErrMsg=ErrMsg & " 自定义时间"
            End If
         End If
         If RsItem("InputerType")=1 Then
            If RsItem("Inputer")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 自定义录入者"
            End If
         End If
         If RsItem("EditorType")=1 Then
            If RsItem("Editor")="" Then
               FoundErr=True
               ErrMsg=ErrMsg & " 自定义编辑"
            End If
         End If
         If IsNumeric(RsItem("SkinID"))=False Then
            FoundErr=True
            ErrMsg=ErrMsg & " 配色风格"
         End If
         If IsNumeric(RsItem("TemplateID"))=False Then
            FoundErr=True
            ErrMsg=ErrMsg & " 设计模板"
         End If
         If IsNumeric(RsItem("CollecListNum"))=False Then
            FoundErr=True
            ErrMsg=ErrMsg & " 列表深度"
         End If
         If IsNumeric(RsItem("CollecNewsNum"))=False Then
            FoundErr=True
            ErrMsg=ErrMsg & " 新闻数量"
         End If
         If FoundErr=False Then
            ErrMsg=ErrMsg & " 状态--正常"
         Else
            ErrMsg=ErrMsg & " 设置不正确 状态--<font color=red>异常</font>"
         End If
         foundErr=False
         RsItem.movenext
      Loop
   end if
   rsItem.close
   set rsItem=nothing
   Call WriteSucced(ErrMsg)
End Sub
%>