⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 admin_itemdatabase.asp

📁 用ASP开发环境写出来的新闻采集系统
💻 ASP
📖 第 1 页 / 共 4 页
字号:
End  Sub%>

<%Sub ShowUpData
If Action="ShowUpData" Then
%>
<br>
<form method="post" action="Admin_ItemDatabase.asp?Action=UpData">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr>
	<td colspan="2" align="center" class="title" height=22><b>检查更新数据</b></td>
	</tr>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
  <tr>
	<td height="34" align='left' class="tdbg">请选择要更新的数据</td>
  </tr>
  <tr>
	<td align='left' class="tdbg">
        <input type="checkbox" name="ChannelData" value="yes">频道部分数据&nbsp;&nbsp;
        <input type="checkbox" name="ItemData" value="yes" checked disabled>项目数据
        </td>
  </tr>
  <tr align='center'>
        <td height='40' colspan='3' class="tdbg"><input name='submit' type=submit value=' 开始更新 '></td>
  </tr>
</table>
</form>
<%Else
   Call UpData()
End If
End Sub%>

<%
sub CompactData()
        '关闭数据库链接
        Call CloseConnItem() 
	Dim fso, Engine,strDBPath,DBPath,DbTemp
	DBPath = server.mappath(DbItem)'数据库文件
        Randomize timer
	DbTemp = CStr(Clng(8999999*Rnd+1000000))
	if instr(DBPath,"/") then 
		strDBPath = left(DBPath,instrrev(DBPath,"/"))
	else
		strDBPath = left(DBPath,instrrev(DBPath,"\"))
	end if
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	If fso.FileExists(DBPath) Then
		Set Engine = CreateObject("JRO.JetEngine")
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath," Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & DbTemp & ".asa"
		fso.CopyFile strDBPath & DbTemp & ".asa",DBPath
		fso.DeleteFile(strDBPath & DbTemp & ".asa")
		ErrMsg="<br>数据库压缩成功!"
	Else
                FoundErr=True
		ErrMsg="<br><li>数据库没有找到!</li>"
	End If
	Set fso = nothing
	Set Engine = nothing
        If FoundErr=True Then
           Call WriteErrMsg(ErrMsg)
        else
           Call WriteSucced(ErrMsg)
        End If
end sub

sub BackUpData()
	Dim fso,BackPath,BackMdb
        BackPath=Trim(Request("BackPath"))
        BackMdb=Trim(Request("BackMdb"))
        If BackPath="" Then
           FoundErr=True
           ErrMsg="<br><li>请指定备份目录!</li>"
        else
           BackPath=Replace(BackPath," ","")
        End If
        If BackMdb="" Then
           FoundErr=True
           ErrMsg=ErrMsg & "<br><li>请指定备份文件名</li>"
        Else
           BackMdb=Replace(BackMdb," ","")
        End If
        If FoundErr<>True Then
           Set fso = Server.CreateObject("Scripting.FileSystemObject")
	   If fso.FolderExists(server.mappath(BackPath))=False Then
              fso.CreateFolder(server.mappath(BackPath))
           End If
           If fso.FileExists(server.mappath(BackPath & "/" & BackMdb & ".asa"))=True then
              fso.DeleteFile(server.mappath(BackPath & "/" & BackMdb & ".asa"))
           End If
           fso.copyfile server.mappath(DbItem),server.mappath(BackPath & "/" & BackMdb & ".asa")
	   If fso.FileExists(server.mappath(BackPath & "/" & BackMdb & ".asa"))=True Then
              ErrMsg="<br>数据库备份成功!"
              ErrMsg=ErrMsg & "<br>数据库备份为:" & BackPath & "/" & BackMdb & ".asa"
           Else
              FoundErr=True
              ErrMsg="<br><li>数据库备份失败!</li>"
	   End If
	   Set fso = nothing
	End If
        If FoundErr=True Then
           Call WriteErrMsg(ErrMsg)
        Else
           Call WriteSucced(ErrMsg)
        End If
end sub


sub RestoreData()
	Dim fso,RestorePath
        RestorePath=Trim(Request("RestorePath"))
        If RestorePath="" Then
           FoundErr=True
           ErrMsg="<br><li>请指定原备份的数据库文件名!</li>"
        else
           RestorePath=Replace(RestorePath," ","")
        End If

        If FoundErr<>True Then
           Set fso = Server.CreateObject("Scripting.FileSystemObject")
           If fso.FileExists(server.mappath(RestorePath))=True then
              fso.copyfile server.mappath(RestorePath),server.mappath(DbItem)
              ErrMsg="<br>数据库恢复成功!"
           Else
              FoundErr=True
              ErrMsg=ErrMsg & "<br><li>数据库:" & RestorePath & " 不存在!"
           End If
	   Set fso = nothing
	End If
        If FoundErr=True Then
           Call WriteErrMsg(ErrMsg)
        Else
           Call WriteSucced(ErrMsg)
        End If
end sub

Sub LeadOutData
   Dim fso,ItemMdb,ItemMdbPath,LeadOutMdb,RsF,SqlF,RsLead,SqlLead,ItemIDTemp
   LeadOutMdb=trim(request.form("LeadOutMdb"))
   ItemID=trim(request.form("ItemID"))
   ItemMdb=DbItem
   ItemMdbPath=Left(DbItem,Instrrev(DbItem,"/")-1)
   If Instr(ItemMdb,"/")>0 Then
      ItemMdbPath=Left(ItemMdb,InstrRev(ItemMdb,"/"))
   End If
   If LeadOutMdb="" then
      FoundErr=True
      ErrMsg="<br><li>数据库地址不能为空!</li>"
   End If
   If ItemID="" Then
      FoundErr=True
      ErrMsg=ErrMsg & "<br><li>请选择要导出的项目</li>"
   Else
      ItemID=Replace(ItemID," ","")
   End If
   If FoundErr<>True And ObjInstalled<>False Then
      Set fso = Server.CreateObject("Scripting.FileSystemObject")
      If fso.FileExists(Server.MapPath(LeadOutMdb)) Then
      Else
         '不存在则创建
         If fso.FileExists(Server.MapPath(ItemMdbPath & "ItemTemp.mdb")) Then
            fso.CopyFile Server.MapPath(ItemMdbPath & "ItemTemp.mdb"),Server.MapPath(LeadOutMdb)
         Else
            FoundErr=True
            ErrMsg=ErrMsg& "<br>用于导出项目的数据库:ItemTemp.mdb不存在!"
         End If
      End If
      set fso=nothing
   End If

   If FoundErr<>True Then
      dim connstrLead,connLead
      Set connLead = Server.CreateObject("ADODB.Connection")
      connstrLead="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(LeadOutMdb)
      connLead.Open connstrLead
      If Err Then
         err.Clear
         FoundErr=True
	 ErrMsg=ErrMsg & "<br>数据库连接出错,请确认数据库是否存在。"
      End If

      If FoundErr<>True Then
         ConnLead.execute("Delete From Item")
         ConnLead.execute("Delete From Filters")
         Set RsItem=server.createobject("adodb.recordset")         
         SqlItem="select * from Item where ItemID in(" & ItemID & ") order by ItemID DESC"         
         RsItem.open SqlItem,ConnItem,1,1
         If Not RsItem.Eof then
            Do while Not RsItem.Eof
               '打开数据库
               Set RsLead=server.createobject("adodb.recordset")         
               SqlLead="select * from Item"         
               RsLead.open SqlLead,ConnLead,1,3
               RsLead.AddNew
               RsLead("ItemName")=RsItem("ItemName")
               RsLead("ChannelID")=RsItem("ChannelID")
               RsLead("ChannelDir")=RsItem("ChannelDir")
               RsLead("ClassID")=RsItem("ClassID")
               RsLead("SpecialID")=RsItem("SpecialID")
               RsLead("WebName")=RsItem("WebName")
               RsLead("WebUrl")=RsItem("WebUrl")
               RsLead("ItemDemo")=RsItem("ItemDemo")
               RsLead("LoginType")=RsItem("LoginType")
               RsLead("LoginUrl")=RsItem("LoginUrl")
               RsLead("LoginPostUrl")=RsItem("LoginPostUrl")
               RsLead("LoginUser")=RsItem("LoginUser")
               RsLead("LoginPass")=RsItem("LoginPass")
               RsLead("LoginFalse")=RsItem("LoginFalse")
               RsLead("ListStr")=RsItem("ListStr")
               RsLead("LsString")=RsItem("LsString")
               RsLead("LoString")=RsItem("LoString")
               RsLead("ListPaingType")=RsItem("ListPaingType")
               RsLead("LPsString")=RsItem("LPsString")
               RsLead("LPoString")=RsItem("LPoString")
               RsLead("ListPaingStr1")=RsItem("ListPaingStr1")
               RsLead("ListPaingStr2")=RsItem("ListPaingStr2")
               RsLead("ListPaingID1")=RsItem("ListPaingID1")
               RsLead("ListPaingID2")=RsItem("ListPaingID2")
               RsLead("ListPaingStr3")=RsItem("ListPaingStr3")
               RsLead("HsString")=RsItem("HsString")
               RsLead("HoString")=RsItem("HoString")
               RsLead("HttpUrlType")=RsItem("HttpUrlType")
               RsLead("HttpUrlStr")=RsItem("HttpUrlStr")
               RsLead("TsString")=RsItem("TsString")
               RsLead("ToString")=RsItem("ToString")
               RsLead("CsString")=RsItem("CsString")
               RsLead("CoString")=RsItem("CoString")
               RsLead("DateType")=RsItem("DateType")
               RsLead("DsString")=RsItem("DsString")
               RsLead("DoString")=RsItem("DoString")
               RsLead("AuthorType")=RsItem("AuthorType")
               RsLead("AsString")=RsItem("AsString")
               RsLead("AoString")=RsItem("AoString")
               RsLead("AuthorStr")=RsItem("AuthorStr")
               RsLead("CopyFromType")=RsItem("CopyFromType")
               RsLead("FsString")=RsItem("FsString")
               RsLead("FoString")=RsItem("FoString")
               RsLead("CopyFromStr")=RsItem("CopyFromStr")
               RsLead("KeyType")=RsItem("KeyType")
               RsLead("KsString")=RsItem("KsString")
               RsLead("KoString")=RsItem("KoString")
               RsLead("KeyStr")=RsItem("KeyStr")
               RsLead("NewsPaingType")=RsItem("NewsPaingType")
               RsLead("NPsString")=RsItem("NPsString")
               RsLead("NPoString")=RsItem("NPoString")
               RsLead("NewsPaingStr")=RsItem("NewsPaingStr")
               RsLead("NewsPaingHtml")=RsItem("NewsPaingHtml")
               RsLead("PaginationType")=RsItem("PaginationType")
               RsLead("MaxCharPerPage")=RsItem("MaxCharPerPage")
               RsLead("ReadLevel")=RsItem("ReadLevel")
               RsLead("Stars")=RsItem("Stars")
               RsLead("ReadPoint")=RsItem("ReadPoint")
               RsLead("Hits")=RsItem("Hits")
               RsLead("UpDateType")=RsItem("UpDateType")
               RsLead("UpDateTime")=RsItem("UpDateTime")
               RsLead("IncludePicYn")=RsItem("IncludePicYn")
               RsLead("DefaultPicYn")=RsItem("DefaultPicYn")
               RsLead("OnTop")=RsItem("OnTop")
               RsLead("Elite")=RsItem("Elite")
               RsLead("Hot")=RsItem("Hot")
               RsLead("SkinID")=RsItem("SkinID")
               RsLead("TemplateID")=RsItem("TemplateID")
               RsLead("Script_Iframe")=RsItem("Script_Iframe")
               RsLead("Script_Object")=RsItem("Script_Object")
               RsLead("Script_Script")=RsItem("Script_Script")
               RsLead("Script_Div")=RsItem("Script_Div")
               RsLead("Script_Class")=RsItem("Script_Class")
               RsLead("Script_Span")=RsItem("Script_Span")
               RsLead("Script_Img")=RsItem("Script_Img")
               RsLead("Script_Font")=RsItem("Script_Font")
               RsLead("Script_A")=RsItem("Script_A")
               RsLead("Script_Html")=RsItem("Script_Html")
               RsLead("CollecListNum")=RsItem("CollecListNum")
               RsLead("CollecNewsNum")=RsItem("CollecNewsNum")
               RsLead("Passed")=RsItem("Passed")
               RsLead("SaveFiles")=RsItem("SaveFiles")
               RsLead("CollecOrder")=RsItem("CollecOrder")
               RsLead("LinkUrlYn")=RsItem("LinkUrlYn")
               RsLead("InputerType")=RsItem("InputerType")
               RsLead("Inputer")=RsItem("Inputer")
               RsLead("EditorType")=RsItem("EditorType")
               RsLead("Editor")=RsItem("Editor")
               RsLead("ShowCommentLink")=RsItem("ShowCommentLink")
               RsLead("Script_Table")=RsItem("Script_Table")
               RsLead("Script_Tr")=RsItem("Script_Tr")
               RsLead("Script_Td")=RsItem("Script_Td")
               RsLead("Flag")=RsItem("Flag")
               ItemIDTemp=RsLead("ItemID")
               RsLead.Update
               RsLead.Close
               Set RsLead=Nothing

               '过滤信息
               Set RsF=server.createobject("adodb.recordset")         
               SqlF="select * from Filters Where ItemID=" & RsItem("ItemID") & " order by ItemID DESC"         
               RsF.open SqlF,ConnItem,1,1              
               If Not RsF.Eof then
                  Do While Not RsF.Eof
                     Set RsLead=server.createobject("adodb.recordset")         
                     SqlLead="select * from Filters"         
                     RsLead.open SqlLead,ConnLead,1,3
                     RsLead.AddNew
                     RsLead("ItemID")=ItemIDTemp
                     RsLead("FilterName")=RsF("FilterName")
                     RsLead("FilterObject")=RsF("FilterObject")
                     RsLead("FilterType")=RsF("FilterType")
                     RsLead("FilterContent")=RsF("FilterContent")
                     RsLead("FisString")=RsF("FisString")
                     RsLead("FioString")=RsF("FioString")
                     RsLead("FilterRep")=RsF("FilterRep")
                     RsLead("Flag")=RsF("Flag")
                     RsLead("PublicTf")=RsF("PublicTf")

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -