📄 admin_areacollection.asp
字号:
Next
ReplaceNum = ReplaceNum + 1
For i = ReplaceNum To 9
Response.Write " <tr class=""tdbg"" onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">" & vbCrLf
Response.Write " <td class=""tdbg"" id=""objFiles" & i & """ valign='top' style=""display:'none'"">" & vbCrLf
Response.Write i
Response.Write " 将字符：<TEXTAREA NAME='ReplaceQuilt" & i & "' ROWS='' COLS='' style='width:250px;height:50px'></TEXTAREA>"
Response.Write " 替换为：<TEXTAREA NAME='ReplaceWith" & i & "' ROWS='' COLS='' style='width:250px;height:50px'></TEXTAREA>"
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Next
End If
Response.Write " </table>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class=""tdbg""> " & vbCrLf
Response.Write " <td width=""150"" class=""tdbg"" align=""right""><strong> 截取内容链接的后缀名： </strong></td>" & vbCrLf
Response.Write " <td class=""tdbg""> <input name=""UpFileType"" type=""text"" id=""UpFileType"" size=""50"" maxlength=""50"" value=" & UpFileType & "> <font color=red> * </font> <font color='blue'>注：用|分割</font><br>" & vbCrLf
Response.Write " <font color='blue'>说明:将采集链接的相对地址转换为绝对地址,请在上面输入要转换链接的后缀。</td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Script_Property = Split(FilterProperty, "|")
Response.Write " <tr class='tdbg'>"
Response.Write " <td width=""150"" class=""tdbg"" align=""right""><strong>过 滤 选 项： </strong></td>"
Response.Write " <td height=""22"">"
Response.Write " <input name=""Script_Iframe"" type=""checkbox"" id=""Script_Iframe"" value=""1"" "
If Script_Property(0) = "1" Then Response.Write " checked"
Response.Write ">Iframe" & vbCrLf
Response.Write " <input name=""Script_Object"" type=""checkbox"" id=""Script_Object"" value=""1"" "
If Script_Property(1) = "1" Then Response.Write " checked"
Response.Write ">Object" & vbCrLf
Response.Write " <input name=""Script_Script"" type=""checkbox"" id=""Script_Script"" value=""1"" "
If Script_Property(2) = "1" Then Response.Write " checked"
Response.Write ">Script" & vbCrLf
Response.Write " <input name=""Script_Class"" type=""checkbox"" id=""Script_Class"" value=""1"" "
If Script_Property(3) = "1" Then Response.Write " checked"
Response.Write ">Style" & vbCrLf
Response.Write " <input name=""Script_Div"" type=""checkbox"" id=""Script_Div"" value=""1"" "
If Script_Property(4) = "1" Then Response.Write " checked"
Response.Write ">Div" & vbCrLf
Response.Write " <input name=""Script_Table"" type=""checkbox"" id=""Script_Table"" value=""1"" "
If Script_Property(5) = "1" Then Response.Write " checked"
Response.Write ">Table" & vbCrLf
Response.Write " <input name=""Script_Tr"" type=""checkbox"" id=""Script_tr"" value=""1"" "
If Script_Property(6) = "1" Then Response.Write " checked"
Response.Write ">Tr" & vbCrLf
Response.Write " <input name=""Script_td"" type=""checkbox"" id=""Script_td"" value=""1"" "
If Script_Property(7) = "1" Then Response.Write " checked"
Response.Write ">Td" & vbCrLf
Response.Write " <br>" & vbCrLf
Response.Write " <input name=""Script_Span"" type=""checkbox"" id=""Script_Span"" value=""1"" "
If Script_Property(8) = "1" Then Response.Write " checked"
Response.Write ">Span" & vbCrLf
Response.Write " <input name=""Script_Img"" type=""checkbox"" id=""Script_Img"" value=""1"" "
If Script_Property(9) = "1" Then Response.Write " checked"
Response.Write ">Img " & vbCrLf
Response.Write " <input name=""Script_Font"" type=""checkbox"" id=""Script_Font"" value=""1"" "
If Script_Property(10) = "1" Then Response.Write " checked"
Response.Write ">FONT " & vbCrLf
Response.Write " <input name=""Script_A"" type=""checkbox"" id=""Script_A"" value=""1"" "
If Script_Property(11) = "1" Then Response.Write " checked"
Response.Write ">A " & vbCrLf
Response.Write " <input name=""Script_Html"" type=""checkbox"" id=""Script_Html"" value=""1"" "
If Script_Property(12) = "1" Then Response.Write " checked"
Response.Write ">Html" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class=""tdbg"">" & vbCrLf
Response.Write " <td class=""tdbg"" align=""middle"" colSpan=""2"" height=""50"">" & vbCrLf
Response.Write " <INPUT id=""AreaID"" type=""hidden"" value=" & AreaID & " name=AreaID>" & vbCrLf
Response.Write " <INPUT id=""SaveType"" type=""hidden"" value=""" & Action & """ name=SaveType>" & vbCrLf
Response.Write " <INPUT id=""Action"" type=""hidden"" value=""AreaCollectionSave"" name=Action>" & vbCrLf
Response.Write " <INPUT type=submit value="" 确 定 "" name=""Submit"" onclick=""javascript:esave.style.visibility='visible';""> " & vbCrLf
Response.Write " <INPUT id=Cancel type=button value="" 取 消 "" name=Cancel></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </FORM>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " <div id=""esave"" style=""position:absolute; top:350px; left:200px; z-index:1;visibility:hidden""> " & vbCrLf
Response.Write " <TABLE WIDTH=400 BORDER=0 CELLSPACING=0 CELLPADDING=0>" & vbCrLf
Response.Write " <TR><td width=""20%""></td>" & vbCrLf
Response.Write " <TD width=""60%""> " & vbCrLf
Response.Write " <TABLE WIDTH=100% height=100 BORDER=0 CELLSPACING=1 CELLPADDING=0>" & vbCrLf
Response.Write " <TR> " & vbCrLf
Response.Write " <td bgcolor=""#0033FF"" align=center><b><marquee align=""middle"" behavior=""alternate"" scrollamount=""5""><font color=#FFFFFF>正在加载采集项目,请稍候...</font></marquee></b></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " </td><td width='20%'></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " </div>" & vbCrLf
Response.Write " <table WIDTH=400 height=130 BORDER=0 CELLSPACING=0 CELLPADDING=0><tr><td></td></tr></table>" & vbCrLf
Call CloseConn
End Sub
'**************************************************
'方法名：AreaCollectionSave
'作 用：保存区域采集数据
'**************************************************
Sub AreaCollectionSave()
Dim rsArea, mrs, SaveType, FoundErr
Dim AreaID, AreaName, AreaFile, AreaIntro, Code, StringReplace, AreaUrl
Dim LableStart, LableEnd, UpFileType, FilterProperty, AreaPassed
Dim Script_Property, ReplaceNum, i, strTemplate
Dim Script_Iframe, Script_Object, Script_Script, Script_Class
Dim Script_Div, Script_Span, Script_Img, Script_Font, Script_A, Script_Html
Dim Script_Table, Script_Tr, Script_Td
FoundErr = False
AreaID = PE_CLng(Request.Form("AreaID"))
AreaName = Trim(Request.Form("AreaName"))
AreaFile = Trim(Request.Form("AreaFile"))
AreaIntro = Trim(Request.Form("AreaIntro"))
Code = PE_CLng(Request.Form("Code"))
StringReplace = Trim(Request.Form("StringReplace"))
AreaUrl = Request.Form("AreaUrl")
LableStart = Trim(Request.Form("LableStart"))
LableEnd = Trim(Request.Form("LableEnd"))
UpFileType = Trim(Request.Form("UpFileType"))
Script_Iframe = Trim(Request.Form("Script_Iframe"))
Script_Object = Trim(Request.Form("Script_Object"))
Script_Script = Trim(Request.Form("Script_Script"))
Script_Class = Trim(Request.Form("Script_Class"))
Script_Div = Trim(Request.Form("Script_Div"))
Script_Span = Trim(Request.Form("Script_Span"))
Script_Img = Trim(Request.Form("Script_Img"))
Script_Font = Trim(Request.Form("Script_Font"))
Script_A = Trim(Request.Form("Script_A"))
Script_Html = Trim(Request.Form("Script_Html"))
Script_Table = Trim(Request.Form("Script_Table"))
Script_Tr = Trim(Request.Form("Script_Tr"))
Script_Td = Trim(Request.Form("Script_Td"))
FilterProperty = Script_Iframe & "|" & Script_Object & "|" & Script_Script & "|" & Script_Class & "|" & Script_Div & "|" & Script_Table & "|" & Script_Tr & "|" & Script_Td & "|" & Script_Span & "|" & Script_Img & "|" & Script_Font & "|" & Script_A & "|" & Script_Html
SaveType = Trim(Request.Form("SaveType"))
ReplaceNum = PE_CLng(Trim(Request.Form("ReplaceNum")))
If SaveType <> "AreaCollectionModify" Then
If AreaID = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>请指定AreaID！</li>"
Else
AreaID = PE_CLng(AreaID)
End If
End If
If AreaName = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>区域采集项目标题不能为空</li>"
End If
If AreaFile = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>区域采集项目JS文件名不能为空</li>"
End If
If AreaIntro = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>区域采集项目简介不能为空</li>"
End If
If Code = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>区域项目采集编码不能为空</li>"
End If
If AreaUrl = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>采集网站页不能为空</li>"
End If
If LableStart = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>截取代码开始不能为空</li>"
End If
If LableEnd = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>截取代码结束不能为空</li>"
End If
If UpFileType = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>截取内容链接的后缀名不能为空</li>"
End If
If CheckUrl(AreaUrl) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>您好,您输入的网址不是绝对路径的网站,请用http:// 开头使用绝对路径。</li>"
End If
If FoundErr = True Then
Call WriteErrMsg(ErrMsg, ComeUrl)
Exit Sub
End If
If GetHttpPage(AreaUrl, PE_CLng(Code)) = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>在获取:" & AreaUrl & "网页源码时发生错误。</li>"
End If
If FoundErr = True Then
Call WriteErrMsg(ErrMsg, ComeUrl)
Exit Sub
End If
Dim AreaCode
If FoundErr <> True Then
AreaCode = GetHttpPage(AreaUrl, PE_CLng(Code)) '获得列表源代码
If AreaCode <> "" Then
AreaCode = GetBody(AreaCode, LableStart, LableEnd, True, True) '获得列表代码
AreaCode = ReplaceStringPath(AreaCode, AreaUrl, UpFileType)
If AreaCode = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>在截取区域代码的时发生错误。</li>"
End If
Else
FoundErr = True
ErrMsg = ErrMsg & "<li>在获取:" & AreaUrl & "网页源码时发生错误。</li>"
End If
End If
If ReplaceNum <> 0 Then
For i = 1 To ReplaceNum
If i <> 1 Then
StringReplace = StringReplace & "$$$"
End If
AreaCode = Replace(AreaCode, Trim(Request("ReplaceQuilt" & i)), Trim(Request("ReplaceWith" & i)))
StringReplace = StringReplace & Trim(Request("ReplaceQuilt" & i)) & "|||" & Trim(Request("ReplaceWith" & i))
Next
End If
AreaCode = FilterScript(AreaCode, FilterProperty)
strTemplate = "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.0 Transitional//EN'>" & vbCrLf
strTemplate = strTemplate & "<html>" & vbCrLf
strTemplate = strTemplate & "<head>" & vbCrLf
strTemplate = strTemplate & "<title> New Document </title>" & vbCrLf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -