📄 admin_itemdatabase.asp
字号:
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">频道部分数据
<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 + -