admin_collectionmanage.asp
来自「本程序系统完全实现了医院网站程序的全部功能的前台和后台程序」· ASP 代码 · 共 1,202 行 · 第 1/5 页
ASP
1,202 行
Response.Write " <td class=""tdbg"">"
Response.Write " <FONT color='#0099FF'>例如：列表中的链接代码形如：<a href='Article/Class1/1358.html' target='_blank'><br>则链接开始代码应该设置为：</font><font color=red><a href='</font><FONT color='#0099FF'>，链接结束代码设置为：</font><font color=red>' target='_blank'></font>"
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td width=""120"" class=""tdbg5"" align='right'> 特殊处理：</td>" & vbCrLf
Response.Write " <td class=""tdbg"" >" & vbCrLf
Response.Write " <input type=""radio"" value=""0"" name=""HttpUrlType"""
If HttpUrlType = 0 Then Response.Write "checked"
Response.Write " onClick=""javascript:HttpUrl1.style.display='none'"">关闭 " & vbCrLf
Response.Write " <input type=""radio"" value=""1"" name=""HttpUrlType"""
If HttpUrlType = 1 Then Response.Write "checked"
Response.Write " onClick=""javascript:HttpUrl1.style.display=''"">启用" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class=""tdbg"" id=""HttpUrl1"" style=""display:'"
If HttpUrlType = 0 Then Response.Write "none"
Response.Write "'"">" & vbCrLf
Response.Write " <td width=""120"" class=""tdbg5"" align='right' valign='top'>重定向URL：</td>" & vbCrLf
Response.Write " <td class=""tdbg"" >" & vbCrLf
Response.Write " <input name=""HttpUrlStr"" type=""text"" size=""49"" maxlength=""200"" value=" & HttpUrlStr & ">" & vbCrLf
Response.Write " <br><font color='#0099FF'>当链接代码是一些非常特殊的JS函数调用代码时，请设置此选项。<br>例如：列表中的链接代码形如：<a href='#' onclick='opennews(137)'>，对应的opennews(id)函数的代码为：<br> window.open('http://www.xxxx.com/xxx/news.asp?id='+id,'','****')。<br>则链接开始代码设置为：</font><font color=red> <a href='#' onclick='opennews(</font><font color='#0099FF'>，链接结束代码为：<font color=red>)'></font><font color='#0099FF'>，<br>此处“重定向URL”设置为：</font><font color=red>http://www.xxxx.com/xxx/news.asp?id={$ID}</font><font color='#0099FF'>（{$ID}是系统规定的标签）</font>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </tbody>" & vbCrLf
Response.Write " <tbody id='Tabs' style='display:none'>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td width=""120"" class=""tdbg5"" align=""right""> 选择分页类型：</td>" & vbCrLf
Response.Write " <td class=""tdbg"" width=""600"">" & vbCrLf
Response.Write " <input type=""radio"" value=""0"" name=""ListPaingType""" & IsRadioChecked(ListPaingType, 0) & " onClick=""javascript:ListPaing1.style.display='none';ListPaing2.style.display='none';ListPaing3.style.display='none'"">不采集列表分页 " & vbCrLf
Response.Write " <input type=""radio"" value=""1"" name=""ListPaingType""" & IsRadioChecked(ListPaingType, 1) & " onClick=""javascript:ListPaing1.style.display='';ListPaing2.style.display='none';ListPaing3.style.display='none'"">从源代码中获取下一页的URL " & vbCrLf
Response.Write " <input type=""radio"" value=""2"" name=""ListPaingType""" & IsRadioChecked(ListPaingType, 2) & " onClick=""javascript:ListPaing1.style.display='none';ListPaing2.style.display='';ListPaing3.style.display='none'"">批量指定分页URL代码 " & vbCrLf
Response.Write " <input type=""radio"" value=""3"" name=""ListPaingType""" & IsRadioChecked(ListPaingType, 3) & " onClick=""javascript:ListPaing1.style.display='none';ListPaing2.style.display='none';ListPaing3.style.display=''"">手动添加分页URL代码 " & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class=""tdbg"" id=""ListPaing1"" style=""display:'"
If ListPaingType <> 1 Then Response.Write "none"
Response.Write "'"">" & vbCrLf
Response.Write " <td width=""120"" class=""tdbg5"" align=""right"">“下一页”<br>URL开始代码：<br><br><br><br><br><br>" & vbCrLf
Response.Write " “下一页”<br>URL结束代码：</font>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " <td class=""tdbg"" width=""600"">" & vbCrLf
Response.Write " <textarea name=""LPsString"" style='width:450px;height:100px'>"
If Trim(LPsString) <> "" Then Response.Write Server.HTMLEncode(LPsString & "")
Response.Write "</textarea> <input TYPE='button' value='测试代码' onCLICK='ceshi(3)' ><br>" & vbCrLf
Response.Write " <textarea name=""LPoString"" style='width:450px;height:100px'>"
If Trim(LPoString) <> "" Then Response.Write Server.HTMLEncode(LPoString & "")
Response.Write "</textarea> <input TYPE='button' value='测试代码' onCLICK='ceshi(4)' >" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
'Response.Write " <tr class=""tdbg"" id=""ListPaing12"" style=""display:'"
'If ListPaingType <> 1 Then Response.Write "none"
'Response.Write "'"">" & vbCrLf
'Response.Write " <td width=""120"" class=""tdbg5"" align=""right"">索引分页重定向：</td>" & vbCrLf
'Response.Write " <td class=""tdbg"" width=""600"">" & vbCrLf
'Response.Write " <input name=""ListPaingStr1"" type=""text"" size=""60"" maxlength=""200"" value=" & ListPaingStr1 & ">" & vbCrLf
'Response.Write " <br><font color=#0099FF>一般不会用到,如果采集分页很纵深,并且下一页代码是相对路径。" & vbCrLf
'Response.Write " <br>在下一步链接设置分析到的下一页列表的URL和实际不符,应用此功能。" & vbCrLf
'Response.Write " <br>在列表设置捕获相对路径,如果是动态页捕获ID。" & vbCrLf
'Response.Write " <br>例：在索引分页中填写实际路径 http://www.xxxxx.com/xxx/xx/xxx/news/{$ID} {$ID}就是列表捕获的相对路径或动态ID。</font>" & vbCrLf
'Response.Write " <br>系统能智能分析网站的相对路径,如果特殊情况分析不对,请按上述步骤使用此功能。"
'Response.Write " </td>" & vbCrLf
'Response.Write " </tr>" & vbCrLf
Response.Write " <tr class=""tdbg"" id=""ListPaing2"" style=""display:'"
If ListPaingType <> 2 Then Response.Write "none"
Response.Write "'"">" & vbCrLf
Response.Write " <td width=""120"" class=""tdbg5"" align=""right"">URL字符串：<br><br><br>ID范围：</td>" & vbCrLf
Response.Write " <td class=""tdbg"" width=""600""><input name=""ListPaingStr2"" type=""text"" size=""80"" maxlength=""200"" value=" & ListPaingStr2 & "><br>" & vbCrLf
Response.Write " <font color=#0099FF>例：http://www.xxxxx.com/news/index_{$ID}.html {$ID}代表分页数</font><br>" & vbCrLf
Response.Write " <br>" & vbCrLf
Response.Write " <input name=""ListPaingID1"" type=""text"" size=""8"" maxlength=""200"" value=" & ListPaingID1 & "><span lang=""en-us""> To </span><input name=""ListPaingID2"" type=""text"" size=""8"" maxlength=""200"" value=" & ListPaingID2 & ">" & vbCrLf
Response.Write " <font color=#0099FF>例： 1 ~ 9 或 9 ~ 1 升序或倒序采集</font><br>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class=""tdbg"" id=""ListPaing3"" style=""display:'"
If ListPaingType <> 3 Then Response.Write "none"
Response.Write "'"">" & vbCrLf
Response.Write " <td width=""120"" class=""tdbg5"" align=""right"">URL列表： </td>" & vbCrLf
Response.Write " <td class=""tdbg"" >" & vbCrLf
Response.Write " <textarea name=""ListPaingStr3"" style='width:500px;height:100px'>"
If Trim(ListPaingStr3) <> "" Then Response.Write Server.HTMLEncode(ListPaingStr3 & "")
Response.Write "</textarea>" & vbCrLf
Response.Write " <br><font color=#0099FF>注：一行写一个网页地址</font>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </tbody>" & vbCrLf
Response.Write " <tbody id='Tabs' style='display:none'>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td width=""120"" class=""tdbg5"" align=""right""> 缩略图设置：</td>" & vbCrLf
Response.Write " <td class=""tdbg"" width=""600"">" & vbCrLf
Response.Write " <input type=""radio"" value=""0"" name=""ThumbnailType""" & IsRadioChecked(ThumbnailType, 0) & " onClick=""javascript:ThumbnailPaing.style.display='none';"">不启用 " & vbCrLf
Response.Write " <input type=""radio"" value=""1"" name=""ThumbnailType""" & IsRadioChecked(ThumbnailType, 1) & " onClick=""javascript:ThumbnailPaing.style.display='';"">启用 <FONT style='font-size:12px' color='blue'>注：适用于截取一些列表页有缩略图的网站</FONT> " & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class=""tdbg"" id=""ThumbnailPaing"" style=""display:'"
If ThumbnailType <> 1 Then Response.Write "none"
Response.Write "'"">" & vbCrLf
Response.Write " <td width=""120"" class=""tdbg5"" align=""right""><br>缩略图开始代码：<br><br><br><br><br><br>" & vbCrLf
Response.Write " <br>缩略图结束代码：</font>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " <td class=""tdbg"" width=""600"">" & vbCrLf
Response.Write " <textarea name=""ThsString"" style='width:450px;height:100px'>"
If Trim(ThsString) <> "" Then Response.Write Server.HTMLEncode(ThsString & "")
Response.Write "</textarea><br>" & vbCrLf
Response.Write " <textarea name=""ThoString"" style='width:450px;height:100px'>"
If Trim(ThoString) <> "" Then Response.Write Server.HTMLEncode(ThoString & "")
Response.Write "</textarea>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </tbody>" & vbCrLf
Response.Write " <tbody id='Tabs' style='display:none'>" & vbCrLf
Response.Write " <tr>" & vbCrLf
Response.Write " <td class=""tdbg"" >" & vbCrLf
Response.Write " <textarea name=""Content"" style='width:785px;height:400px'>" & Server.HTMLEncode(strPageContent & "") & "</textarea>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </tbody>" & vbCrLf
Response.Write " <tbody id='Tabs' style='display:none'>" & vbCrLf
Response.Write " <tr class=""tdbg""> " & vbCrLf
Response.Write " <td align='center' id='objFiles'></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table>" & vbCrLf
Response.Write " <br>" & vbCrLf
Response.Write " <center>" & vbCrLf
Response.Write " <input name=""ListStr"" type=""hidden"" id=""ListStr"" value=""" & ListStr & """>" & vbCrLf
Response.Write " <input name=""ItemID"" type=""hidden"" id=""ItemID"" value=""" & ItemID & """>" & vbCrLf
Response.Write " <input name=""Action"" type=""hidden"" id=""Action"" value=""Step3"">" & vbCrLf
Response.Write " <input name=""NeedSave"" type=""hidden"" id=""NeedSave"" value=""True"">" & vbCrLf
Response.Write " <input TYPE='button' value='返回上一步' onCLICK='history.back(-1)'> " & vbCrLf
Response.Write " <input type=""submit"" name=""Submit"" value=""下 一 步"" onClick='CheckForm()'>" & vbCrLf
Response.Write " </center>" & vbCrLf
Response.Write "</FORM>" & vbCrLf
Response.Write "<b>注意：</b><br> 开始代码或结束代码<font color=red>至少有一个在网页中是唯一的</font>，才能保证可以正确采集到相关内容。因为每个列表页的代码都可能不同，所以需要您分析多个列表页并找到相同的开始代码和结束代码，才能保证可以从所有列表页中准确采集到所需内容。" & vbCrLf
Call CloseConn
End Sub
'=================================================
'过程名：Step3
'作 用：正文设置
'=================================================
Sub Step3()
Dim LoginResult, LoginData
Dim LoginType, LoginUrl, LoginPostUrl, LoginUser, LoginPass, LoginFalse
Dim ListStr, LsString, LoString, ListPaingType, LPsString, LPoString, ListPaingStr1, ListPaingStr2, ListPaingID1, ListPaingID2, ListPaingStr3, HsString, HoString, HttpUrlType, HttpUrlStr
Dim TsString, ToString, CsString, CoString, AuthorType, AsString, AoString, AuthorStr, CopyFromType, FsString, FoString, CopyFromStr, KeyType, KsString, KoString, KeyStr, KeyScatterNum, NewsPaingType, NPsString, NPoString, NewsPaingStr1, NewsPaingStr2
Dim PsString, PoString, PhsString, PhoString
Dim IsString, IoString, IntroType, IntroStr, IntroNum
Dim WebUrl, ListUrl, ListCode, NewsArrayCode, NewsArray, UrlTest, Testi, testUrl
Dim DateType, DsString, DoString
Dim IsField, Field, i, iField, iFieldNum
Dim arrField, arrField2, FieldID, FieldName, FieldType, FisSting, FioSting, FieldStr
'列表缩略图
Dim ThumbnailType, ThsString, ThoString
Dim ThumbnailArrayCode, ThumbnailArray, ThumbnailUrl
testUrl = Trim(Request("testUrl"))
FoundErr = False
If ItemID = 0 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>请指定要设置的采集项目</li>"
Call WriteErrMsg(ErrMsg, ComeUrl)
Exit Sub
End If
'保存
If NeedSave = "True" Then
'列表变量
ListStr = Trim(Request.Form("ListStr"))
LsString = Request.Form("LsString")
LoString = Request.Form("LoString")
ListPaingType = Request.Form("ListPaingType")
LPsString = Request.Form("LPsString")
LPoString = Request.Form("LPoString")
ListPaingStr1 = Trim(Request.Form("ListPaingStr1"))
ListPaingStr2 = Trim(Request.Form("ListPaingStr2"))
ListPaingID1 = Request.Form("ListPaingID1")
ListPaingID2 = Request.Form("ListPaingID2")
ListPaingStr3 = Request.Form("ListPaingStr3")
'链接变量
HsString = Request.Form("HsString")
HoString = Request.Form("HoString")
HttpUrlType = Trim(Request.Form("HttpUrlType"))
HttpUrlStr = Trim(Request.Form("HttpUrlStr"))
'列表缩略图变量
ThumbnailType = PE_CLng(Trim(Request.Form("ThumbnailType")))
ThsString = Trim(Request.Form("ThsString"))
ThoString = Trim(Request.Form("ThoString"))
If LsString = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>列表开始标记不能为空</li>"
End If
If LoString = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>列表结束标记不能为空</li>"
End If
If ListPaingType = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>请选择列表索引分页类型</li>"
Else
ListPaingType = CLng(ListPaingType)
Select Case ListPaingType '加载列表,判断列表类型
Case 0, 1 '0 无分页,1 代码分页
If ListStr = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>列表索引页不能为空</li>"
Else
ListStr = Trim(ListStr)
End If
If ListPaingType = 1 Then
If LPsString = "" Or LPoString = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>索引分页开始/结束标记不能为空</li>"
End If
'If ListPaingStr1 <> "" And Len(ListPaingStr1) < 15 Then
' FoundErr = True
' ErrMsg = ErrMsg & "<li>索引分页重定向设置不正确(至少15个字符)</li>"
'End If
End If
Case 2 '批量数字分页
If ListPaingStr2 = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>批量生成字符不能为空</li>"
End If
If IsNumeric(ListPaingID1) = False Or IsNumeric(ListPaingID2) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>批量生成的范围只能是数字</li>"
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?