📄 admin_mov_collecting.asp
字号:
RsItem("ClassID")=stClassID
if Edition<>2006 then
RsItem("SpecialID")=stSpecialID
End if
RsItem("Keyword")=Keyword
RsItem("SoftName")=SoftName
RsItem("SoftIntro")=SoftIntro
RsItem("SoftVersion")=SoftVersion
RsItem("OperatingSystem")=OperatingSystem
RsItem("Author")=Author
RsItem("CopyFrom")=CopyFrom
RsItem("DemoUrl")=DemoUrl
RsItem("Hits")=Hits
RsItem("DayHits")=Hits
RsItem("WeekHits")=Hits
RsItem("MonthHits")=Hits
RsItem("UpdateTime")=UpdateTime
RsItem("SoftType")=SoftType
RsItem("SoftLanguage")=SoftLanguage
RsItem("CopyrightType")=CopyrightType
RsItem("SoftSize")=SoftSize
RsItem("RegUrl")=RegUrl
RsItem("OnTop")=OnTop
RsItem("Elite")=Elite
if Edition=2006 then
if Passed=true then RsItem("status")=3
else
RsItem("Passed")=Passed
End if
RsItem("SoftPicUrl")=SoftPicUrl
RsItem("DownloadUrl")=DownloadUrls
RsItem("Stars")=Stars
if Edition=2006 then
RsItem("InfoPoint")=SoftPoint
else
RsItem("SoftPoint")=SoftPoint
End if
RsItem("Inputer")=AdminName
RsItem("Editor")=AdminName
RsItem("TemplateID")=TemplateID
RsItem("SkinID")=SkinID
RsItem("LastHitTime")=now()
RsItem("DecompressPassword")=DecompressPassword
RsItem.Update
RsItem.Close
Set RsItem=Nothing
End sub
%>
<%
'获取当前分析列表页地址
'输出参数:ListUrl
Sub GetNowUrl()
If ListPaingType=0 Then
If ListNum=1 Then
ListUrl=ListStr
Else
ListEnd=True
End If
ElseIf ListPaingType=1 Then
If ListNum=1 Then
ListUrl=ListStr
Else
If ListPaingNext="" or ListPaingNext="$False$" Then
ListEnd=True
Else
If Instr(ListPaingNext,"{$ID}")>0 Then
ListPaingNext=Replace(ListPaingNext,"{$ID}","&")
End If
ListUrl=ListPaingNext
End If
End If
ElseIf ListPaingType=2 Then
If (ListPaingID1+ListNum-1)>ListPaingID2 Then
ListEnd=True
Else
ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1+ListNum-1))
End If
ElseIf ListPaingType=3 Then
ListArray=Split(ListPaingStr3,"|")
If (ListNum-1)>Ubound(ListArray) Then
ListEnd=True
Else
ListUrl=ListArray(ListNum-1)
End If
End If
End Sub
'获取下一页分析列表页地址
Sub GetNextUrl()
If ListPaingType=1 Then
' Response.write "-"
ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
If ListPaingNext<>"$False$" Then
If ListPaingStr1<>"" Then
ListPaingNext=Replace(ListPaingStr1,"{$ID}",ListPaingNext)
Else
ListPaingNext=DefiniteUrl(ListPaingNext,ListUrl)
End If
End If
If Instr(ListPaingNext,"&")>0 Then
ListPaingNext=Replace(ListPaingNext,"&","{$ID}")
End If
Else
ListPaingNext="$False$"
End If
End Sub
'获取频道上传目录
'参数 ChannelID
Sub GetChannelDir(ChannelID)
dim rrs,rsql
set rrs=server.createobject("adodb.recordset")
rsql="select UploadDir,ChannelDir from PE_Channel where ChannelID="&ChannelID&""
rrs.open rsql,Conn,1,1
stChannelDir=rrs("ChannelDir")
sUploadDir=rrs("UploadDir")
rrs.close
set rrs=nothing
End Sub
Sub CZdir(Dirstr)
Dim FSO,Dirstrtemp,Dirstritem,i
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
'On Error Resume Next
Dirstr=Replace(Dirstr,"/","\")
Dirstr=Replace(Dirstr,"\\","\")
Dirstr=Replace(Dirstr,":","：")
Dirstr=Replace(Dirstr,"*","")
Dirstr=Replace(Dirstr,"?","？")
Dirstr=Replace(Dirstr,"""","")
Dirstr=Replace(Dirstr,"<","《")
Dirstr=Replace(Dirstr,">","》")
Dirstr=Replace(Dirstr,"|","")
if Left(Dirstr,1)<>"\" then Dirstr="\"&Dirstr
if fso.FolderExists(Server.MapPath(Dirstr))=False then
Dirstritem=Split(Dirstr, "\")
For i = 1 To UBound(Dirstritem)
If Dirstritem(i) <> "" Then
Dirstrtemp= Dirstrtemp& "\" & Dirstritem(i)
If fso.FolderExists(Server.MapPath(Dirstrtemp)) = False Then
fso.CreateFolder Server.MapPath(Dirstrtemp)
End If
End If
Next
End if
Set FSO = Nothing
End sub
'**************************************************
'过程名：WriteErrMsg1
'作 用：显示错误提示信息
'参 数：无
'**************************************************
Sub WriteErrMsg1(ErrMsg)
Dim strErr
strErr = strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
strErr = strErr & "<link href='Admin_Style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbCrLf
strErr = strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
strErr = strErr & " <tr align='center' class='title'><td height='22'><strong>错误信息</strong></td></tr>" & vbCrLf
strErr = strErr & " <tr class='tdbg'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & ErrMsg & "</td></tr>" & vbCrLf
strErr = strErr & " <tr align='center' class='tdbg'><td>"
strErr = strErr & "<a href='javascript:history.go(-1)'><< 返回上一页</a>"
strErr = strErr & "</td></tr></table></body></html>" & vbCrLf
Response.Write strErr
End Sub
'**************************************************
'过程名：WriteSuccMsg1
'作 用：显示错误提示信息
'参 数：无
'**************************************************
Sub WriteSuccMsg1(ErrMsg)
Dim strErr
strErr = strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
strErr = strErr & " <tr align='center' class='title'><td height='22'><strong>恭喜你!</strong></td></tr>" & vbCrLf
strErr = strErr & " <tr class='tdbg'><td height='100' valign='top'>" & ErrMsg & "</td></tr>" & vbCrLf
strErr = strErr & " <tr align='center' class='tdbg'><td>"
strErr = strErr & "<a href='javascript:history.go(-1)'><< 返回上一页</a>"
strErr = strErr & "</td></tr></table>" & vbCrLf
Response.Write strErr
End Sub
'**************************************************
'过程名：WriteMsg
'作 用：显示其他提示信息
'参 数：无
'**************************************************
Sub WriteMsg(Msg)
Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'><tr><td height='22' colspan='2' align='left' class='title'>No:<font color=red>"&SuccNum&"</font></td></tr><tr><td colspan='2' align='left' class='tdbg'>"
Response.Write Msg
Response.Write "</td></tr></table><br>"
End Sub
'==================================================
'过程名：GetFilters
'作 用：提取过滤信息
'参 数：无
'==================================================
Sub GetFilters()
Dim SqlF,RSF
SqlF ="Select * from Filters Where Flag=True and ItemID=" & ItemID & " or ItemID=0 order by FilterID ASC"
Set RSF=connItem.Execute(SqlF)
If RsF.Eof And RsF.Bof Then
Else
Arr_Filters=RsF.GetRows()
End If
RsF.Close
Set RsF=Nothing
End Sub
'==================================================
'过程名：Filters
'作 用：过滤
'参 数：ConStr ------ 要过滤的字符串
'参 数：ItemID ------ 项目ID
'参 数：FilterType -------- 过滤类型，1为标题，2为正文
'==================================================
Sub Filters()
Dim Filteri,FilterStr
If IsNull(Arr_Filters)=True or IsArray(Arr_Filters)=False Then
Exit Sub
End if
For Filteri=0 to Ubound(Arr_Filters,2)
If Arr_Filters(3,Filteri)=1 Then'标题过滤
If Arr_Filters(4,Filteri)=1 Then
SoftName=Replace(SoftName,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
ElseIf Arr_Filters(4,Filteri)=2 Then
FilterStr=GetBody(SoftName,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
Do While FilterStr<>"$False$"
SoftName=Replace(SoftName,FilterStr,Arr_Filters(8,Filteri))
FilterStr=GetBody(SoftName,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
Loop
End If
ElseIf Arr_Filters(3,Filteri)=2 Then'正文过滤
If Arr_Filters(4,Filteri)=1 Then
SoftIntro=Replace(SoftIntro,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
ElseIf Arr_Filters(4,Filteri)=2 Then
FilterStr=GetBody(SoftIntro,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
Do While FilterStr<>"$False$"
SoftIntro=Replace(SoftIntro,FilterStr,Arr_Filters(8,Filteri))
FilterStr=GetBody(SoftIntro,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
Loop
End If
ElseIf Arr_Filters(3,Filteri)=3 Then'地址过滤
If Arr_Filters(4,Filteri)=1 Then
DownloadUrls=Replace(DownloadUrls,Arr_Filters(5,Filteri),Arr_Filters(8,Filteri))
ElseIf Arr_Filters(4,Filteri)=2 Then
FilterStr=GetBody(DownloadUrls,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
Do While FilterStr<>"$False$"
DownloadUrls=Replace(DownloadUrls,FilterStr,Arr_Filters(8,Filteri))
FilterStr=GetBody(DownloadUrls,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
Loop
End If
End If
Next
End Sub
'==================================================
'过程名：FilterScript
'作 用：脚本过滤
'==================================================
Sub FilterScript()
If Script_Iframe=True Then
SoftIntro=ScriptHtml(SoftIntro,"Iframe",1)
End If
If Script_Object=True Then
SoftIntro=ScriptHtml(SoftIntro,"Object",2)
End If
If Script_Script=True Then
SoftIntro=ScriptHtml(SoftIntro,"Script",2)
End If
If Script_Font=True Then
SoftIntro=ScriptHtml(SoftIntro,"Font",3)
End If
If Script_A=True Then
SoftIntro=ScriptHtml(SoftIntro,"A",3)
End If
If Script_Table=True Then
SoftIntro=ScriptHtml(SoftIntro,"Table",3)
End If
If Script_Tr=True Then
SoftIntro=ScriptHtml(SoftIntro,"Tr",3)
End If
If Script_Td=True Then
SoftIntro=ScriptHtml(SoftIntro,"Td",3)
End If
If Script_Div=True Then
SoftIntro=ScriptHtml(SoftIntro,"Div",3)
End If
If Script_CLASS=True Then
SoftIntro=ScriptHtml(SoftIntro,"CLASS",3)
End If
If Script_Span=True Then
SoftIntro=ScriptHtml(SoftIntro,"Span",3)
End If
If Script_IMG=True Then
SoftIntro=ScriptHtml(SoftIntro,"IMG",3)
End If
If Script_HTML=True Then
SoftIntro=dvhtmlencode(SoftIntro)
End If
End Sub
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -