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

📄 ks_collectcommoncls.asp

📁 SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.
💻 ASP
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
			strErr = strErr & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
			strErr = strErr & "<link href='../inc/Admin_STYLE.CSS' rel='stylesheet' type='text/css'></head><body>" & vbCrLf
			strErr = strErr & "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""sortbutton"">" & vbCrLf
			strErr = strErr & "<tr> " & vbCrLf
			strErr = strErr & "<td  height=""22"" align=""center"" nowrap><strong>成 功 信 息</strong></td>" & vbCrLf
			strErr = strErr & "</tr>" & vbCrLf
			strErr = strErr & "</table><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><td height='100' valign='top' align='center'>" & ErrMsg & "</td></tr>" & vbCrLf
			strErr = strErr & "  <tr align='center'><td><input type='button' onclick='location.href=""collect_main.asp"";' value='进入项目管理中心'></td></tr>" & vbCrLf
			strErr = strErr & "</table>" & vbCrLf
			strErr = strErr & "</body></html>" & vbCrLf
			Response.Write strErr
		End Sub
		Sub WriteCollectSucced(ErrMsg)
			Dim strErr
			strErr = strErr & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
			strErr = strErr & "<link href='../inc/Admin_STYLE.CSS' rel='stylesheet' type='text/css'></head><body>" & vbCrLf
			strErr = strErr & "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""sortbutton"">" & vbCrLf
			strErr = strErr & "</table><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><td height='100' valign='top' align='center'>" & ErrMsg & "</td></tr>" & vbCrLf
			strErr = strErr & "  <tr align='center'><td><input type='button' onclick='location.href=""Collect_ItemStart.asp"";parent.frames[""BottomFrame""].location.href=""../split.asp?OpStr=信息采集管理 >> <font color=red>数据采集</font>&ButtonSymbol=DataCollect"";' value='返回采集中心'></td></tr>" & vbCrLf
			strErr = strErr & "</table>" & vbCrLf
			strErr = strErr & "</body></html>" & vbCrLf
			Response.Write strErr
		End Sub
		Sub WriteCollectSuccedStart(ErrMsg)
			Dim strErr
			strErr = strErr & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
			strErr = strErr & "<link href='../inc/Admin_STYLE.CSS' rel='stylesheet' type='text/css'></head><body>" & vbCrLf
			strErr = strErr & "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""sortbutton"">" & vbCrLf
			strErr = strErr & "</table><br>" & vbCrLf
			strErr = strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
			strErr = strErr & "  <tr><td height='100' valign='top' align='center'>" & ErrMsg & "</td></tr>" & vbCrLf
			strErr = strErr & "</table>" & vbCrLf
			strErr = strErr & "</body></html>" & vbCrLf
			Response.Write strErr
		End Sub
		
		'**************************************************
		'函数名：JoinChar
		'作  用：向地址中加入 ? 或 &
		'参  数：strUrl  ----网址
		'返回值：加了 ? 或 & 的网址
		'**************************************************
		Function JoinChar(strUrl)
			If strUrl = "" Then
				JoinChar = ""
				Exit Function
			End If
			If InStr(strUrl, "?") < Len(strUrl) Then
				If InStr(strUrl, "?") > 1 Then
					If InStr(strUrl, "&") < Len(strUrl) Then
						JoinChar = strUrl & "&"
					Else
						JoinChar = strUrl
					End If
				Else
					JoinChar = strUrl & "?"
				End If
			Else
				JoinChar = strUrl
			End If
		End Function
		
		'**************************************************
		'函数名：CreateKeyWord
		'作  用：由给定的字符串生成关键字
		'参  数：Constr---要生成关键字的原字符串
		'返回值：生成的关键字
		'**************************************************
		Function CreateKeyWord(ByVal Constr, num)
		   If Constr = "" Or IsNull(Constr) = True Or Constr = "Error" Then
			  CreateKeyWord = "Error"
			  Exit Function
		   End If
		   If num = "" Or IsNumeric(num) = False Then
			  num = 2
		   End If
		   Constr = Replace(Constr, Chr(32), "")
		   Constr = Replace(Constr, Chr(9), "")
		   Constr = Replace(Constr, "&nbsp;", "")
		   Constr = Replace(Constr, " ", "")
		   Constr = Replace(Constr, "(", "")
		   Constr = Replace(Constr, ")", "")
		   Constr = Replace(Constr, "<", "")
		   Constr = Replace(Constr, ">", "")
		   Constr = Replace(Constr, """", "")
		   Constr = Replace(Constr, "?", "")
		   Constr = Replace(Constr, "*", "")
		   Constr = Replace(Constr, "|", "")
		   Constr = Replace(Constr, ",", "")
		   Constr = Replace(Constr, ".", "")
		   Constr = Replace(Constr, "/", "")
		   Constr = Replace(Constr, "\", "")
		   Constr = Replace(Constr, "-", "")
		   Constr = Replace(Constr, "@", "")
		   Constr = Replace(Constr, "#", "")
		   Constr = Replace(Constr, "$", "")
		   Constr = Replace(Constr, "%", "")
		   Constr = Replace(Constr, "&", "")
		   Constr = Replace(Constr, "+", "")
		   Constr = Replace(Constr, ":", "")
		   Constr = Replace(Constr, "：", "")
		   Constr = Replace(Constr, "‘", "")
		   Constr = Replace(Constr, "“", "")
		   Constr = Replace(Constr, "”", "")
		   Dim i, ConstrTemp
		   For i = 1 To Len(Constr)
			  ConstrTemp = ConstrTemp & Mid(Constr, i, num) & "|"
		   Next
		   If Len(ConstrTemp) < 254 Then
			  ConstrTemp = ConstrTemp
		   Else
			  ConstrTemp = Left(ConstrTemp, 254)
		   End If
		   CreateKeyWord = Left(ConstrTemp, Len(ConstrTemp) - 1)
		End Function
		
		Function CheckUrl(strUrl)
		   
		   '我发现了错误,暂时不运行
		   
		   CheckUrl = strUrl
		   
		   'Dim re
		   'Set re = New RegExp
		   're.IgnoreCase = True
		   're.Global = True
		   're.Pattern = "http://([\w-]+\.)+[\w-]+(/[\w-./?%&=]*)?"
		   'If re.Test(strUrl) = True Then
		   '   CheckUrl = strUrl
		   'Else
		   '   CheckUrl = "Error"
		   'End If
		
		End Function
		
		
		
		
		
		
		
		
		
		
		
		Function UBBCode(ByVal strContent, strInstallDir, strChannelDir)
			Dim ImagePath
			Dim emotImagePath
			
			ImagePath = strInstallDir & "images/"
			emotImagePath = strInstallDir & "guestbook/images/emot/"
			strContent = FilterJS(strContent)
			Dim re
			Dim po, ii
			Dim reContent
			Set re = New RegExp
			re.IgnoreCase = True
			re.Global = True
			po = 0
			ii = 0
		
			re.Pattern = "\[IMG\](.)\[\/IMG\]"
			strContent = re.Replace(strContent, "<img src='$1' border=0>")
				
			re.Pattern = "\[IMG\](http|https|ftp):\/\/(.[^\[]*)\[\/IMG\]"
			strContent = re.Replace(strContent, "<a onfocus=this.blur() href=""$1://$2"" target=_blank><IMG SRC=""$1://$2"" border=0 alt=按此在新窗口浏览图片 onload=""javascript:if(this.width>screen.width-333)this.width=screen.width-333""></a>")
			re.Pattern = "\[UPLOAD=(gif|jpg|jpeg|bmp|png)\](.[^\[]*)(gif|jpg|jpeg|bmp|png)\[\/UPLOAD\]"
			strContent = re.Replace(strContent, "<br><IMG SRC=""" & ImagePath & "$1.gif"" border=0>此主题相关图片如下：<br><A HREF=""$2$1"" TARGET=_blank><IMG SRC=""$2$1"" border=0 alt=按此在新窗口浏览图片 onload=""javascript:if(this.width>screen.width-333)this.width=screen.width-333""></A>")
		
			re.Pattern = "\[UPLOAD=(.[^\[]*)\](.[^\[]*)\[\/UPLOAD\]"
			strContent = re.Replace(strContent, "<br><IMG SRC=""" & ImagePath & "$1.gif"" border=0> <a href=""" & strInstallDir & strChannelDir & "/$2"">点击浏览该文件</a>")
		
			re.Pattern = "\[DIR=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/DIR]"
			strContent = re.Replace(strContent, "<object classid=clsid:166B1BCA-3F9C-11CF-8075-444553540000 codebase=http://download.macromedia.com/pub/shockwave/cabs/director/sw.cab#version=7,0,2,0 width=$1 height=$2><param name=src value=$3><embed src=$3 pluginspage=http://www.macromedia.com/shockwave/download/ width=$1 height=$2></embed></object>")
			re.Pattern = "\[QT=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/QT]"
			strContent = re.Replace(strContent, "<embed src=$3 width=$1 height=$2 autoplay=true loop=false controller=true playeveryframe=false cache=false scale=TOFIT bgcolor=#000000 kioskmode=false targetcache=false pluginspage=http://www.apple.com/quicktime/>")
			re.Pattern = "\[MP=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/MP]"
			strContent = re.Replace(strContent, "<object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=$1 height=$2 ><param name=ShowStatusBar value=-1><param name=Filename value=$3><embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=$3  width=$1 height=$2></embed></object>")
			re.Pattern = "\[RM=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/RM]"
			strContent = re.Replace(strContent, "<OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2><PARAM NAME=SRC VALUE=$3><PARAM NAME=CONSOLE VALUE=Clip1><PARAM NAME=CONTROLS VALUE=imagewindow><PARAM NAME=AUTOSTART VALUE=true></OBJECT><br><OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=$1><PARAM NAME=SRC VALUE=$3><PARAM NAME=AUTOSTART VALUE=-1><PARAM NAME=CONTROLS VALUE=controlpanel><PARAM NAME=CONSOLE VALUE=Clip1></OBJECT>")
		
			re.Pattern = "(\[FLASH\])(.[^\[]*)(\[\/FLASH\])"
			strContent = re.Replace(strContent, "<a href=""$2"" TARGET=_blank><IMG SRC=" & ImagePath & "swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><PARAM NAME=movie VALUE=""$2""><PARAM NAME=quality VALUE=high><embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed></OBJECT>")
		
			re.Pattern = "(\[FLASH=*([0-9]*),*([0-9]*)\])(.[^\[]*)(\[\/FLASH\])"
			strContent = re.Replace(strContent, "<a href=""$4"" TARGET=_blank><IMG SRC=" & ImagePath & "swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=$2 height=$3><PARAM NAME=movie VALUE=""$4""><PARAM NAME=quality VALUE=high><embed src=""$4"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=$2 height=$3>$4</embed></OBJECT>")
		
			re.Pattern = "(\[URL\])(.[^\[]*)(\[\/URL\])"
			strContent = re.Replace(strContent, "<A HREF=""$2"" TARGET=_blank>$2</A>")
			re.Pattern = "(\[URL=(.[^\[]*)\])(.[^\[]*)(\[\/URL\])"
			strContent = re.Replace(strContent, "<A HREF=""$2"" TARGET=_blank>$3</A>")
		
			re.Pattern = "(\[EMAIL\])(\S+\@.[^\[]*)(\[\/EMAIL\])"
			strContent = re.Replace(strContent, "<img align=absmiddle src=" & ImagePath & "email1.gif><A HREF=""mailto:$2"">$2</A>")
			re.Pattern = "(\[EMAIL=(\S+\@.[^\[]*)\])(.[^\[]*)(\[\/EMAIL\])"
			strContent = re.Replace(strContent, "<img align=absmiddle src=" & ImagePath & "email1.gif><A HREF=""mailto:$2"" TARGET=_blank>$3</A>")
		
			'自动识别网址
			're.Pattern = "^((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@':+!]+)"
			'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=$1>$1</a>")
			're.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@':+!]+)$"
			'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=$1>$1</a>")
			're.Pattern = "([^>=""])((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@':+!]+)"
			'strContent = re.Replace(strContent,"$1<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=$2>$2</a>")
		
			'自动识别www等开头的网址
			're.Pattern = "([^(http://|http:\\)])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)"
			'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=http://$2>$2</a>")
		
			'自动识别Email地址，如打开本功能在浏览内容很多的帖子会引起服务器停顿
			're.Pattern = "([^(=)])((\w)+[@]{1}((\w)+[.]){1,3}(\w)+)"
			'strContent = re.Replace(strContent,"<img align=absmiddle src=pic/url.gif border=0><a target=_blank href=""mailto:$2"">$2</a>")
		
			re.Pattern = "\[em(.[^\[]*)\]"
			strContent = re.Replace(strContent, "<img src=" & emotImagePath & "em$1.gif border=0 align=middle>")
		
			re.Pattern = "\[HTML\](.[^\[]*)\[\/HTML\]"
			strContent = re.Replace(strContent, "<table width='100%' border='0' cellspacing='0' cellpadding='6' class=tableborder1><td><b>以下内容为程序代码:</b><br>$1</td></table>")
			re.Pattern = "\[code\](.[^\[]*)\[\/code\]"
			strContent = re.Replace(strContent, "<table width='100%' border='0' cellspacing='0' cellpadding='6' class=tableborder1><td><b>以下内容为程序代码:</b><br>$1</td></table>")
		
			re.Pattern = "\[color=(.[^\[]*)\](.[^\[]*)\[\/color\]"
			strContent = re.Replace(strContent, "<font color=$1>$2</font>")
			re.Pattern = "\[face=(.[^\[]*)\](.[^\[]*)\[\/face\]"
			strContent = re.Replace(strContent, "<font face=$1>$2</font>")
			re.Pattern = "\[align=(center|left|right)\](.*)\[\/align\]"
			strContent = re.Replace(strContent, "<div align=$1>$2</div>")
		
			re.Pattern = "\[QUOTE\](.*)\[\/QUOTE\]"
			strContent = re.Replace(strContent, "<table style=""width:80%"" cellpadding=5 cellspacing=1 class=tableborder1><TR><TD class=tableborder1>$1</td></tr></table><br>")
			re.Pattern = "\[fly\](.*)\[\/fly\]"
			strContent = re.Replace(strContent, "<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
			re.Pattern = "\[move\](.*)\[\/move\]"
			strContent = re.Replace(strContent, "<MARQUEE scrollamount=3>$1</marquee>")
			re.Pattern = "\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/GLOW]"
			strContent = re.Replace(strContent, "<table width=$1 style=""filter:glow(color=$2, strength=$3)"">$4</table>")
			re.Pattern = "\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]"
			strContent = re.Replace(strContent, "<table width=$1 style=""filter:shadow(color=$2, strength=$3)"">$4</table>")
		
			re.Pattern = "\[i\](.[^\[]*)\[\/i\]"
			strContent = re.Replace(strContent, "<i>$1</i>")
			re.Pattern = "\[u\](.[^\[]*)(\[\/u\])"
			strContent = re.Replace(strContent, "<u>$1</u>")
			re.Pattern = "\[b\](.[^\[]*)(\[\/b\])"
			strContent = re.Replace(strContent, "<b>$1</b>")
			re.Pattern = "\[size=([1-7])\](.[^\[]*)\[\/size\]"
			strContent = re.Replace(strContent, "<font size=$1>$2</font>")
			strContent = Replace(strContent, "<I></I>", "")
			Set re = Nothing
			UBBCode = strContent
		End Function
		
		Function FilterJS(ByVal v)
			If IsNull(v) Or Trim(v) = "" Then
				FilterJS = ""
				Exit Function
			End If
		
			Dim t
			Dim re
			Dim reContent
			Set re = New RegExp
			re.IgnoreCase = True
			re.Global = True
			re.Pattern = "(javascript)"
			t = re.Replace(v, "&#106avascript")
			re.Pattern = "(jscript:)"
			t = re.Replace(t, "&#106script:")
			re.Pattern = "(js:)"
			t = re.Replace(t, "&#106s:")
			're.Pattern="(value)"
			't=re.Replace(t,"&#118alue")
			re.Pattern = "(about:)"
			t = re.Replace(t, "about&#58")
			re.Pattern = "(file:)"
			t = re.Replace(t, "file&#58")
			re.Pattern = "(document.cookie)"
			t = re.Replace(t, "documents&#46cookie")
			re.Pattern = "(vbscript:)"
			t = re.Replace(t, "&#118bscript:")
			re.Pattern = "(vbs:)"
			t = re.Replace(t, "&#118bs:")
			're.Pattern="(on(mouse|exit|error|click|key))"
			't=re.Replace(t,"&#111n$2")
			're.Pattern="(&#)"
			't=re.Replace(t,"＆#")
			FilterJS = t
			Set re = Nothing
		End Function
		
		Function dvHTMLEncode(ByVal fString)
			If IsNull(fString) Or Trim(fString) = "" Then
				dvHTMLEncode = ""
				Exit Function
			End If
			fString = Replace(fString, ">", "&gt;")
			fString = Replace(fString, "<", "&lt;")
		
			fString = Replace(fString, Chr(32), "&nbsp;")
			fString = Replace(fString, Chr(9), "&nbsp;")
			fString = Replace(fString, Chr(34), "&quot;")
			fString = Replace(fString, Chr(39), "&#39;")
			fString = Replace(fString, Chr(13), "")
			fString = Replace(fString, Chr(10) & Chr(10), "</P><P> ")
			fString = Replace(fString, Chr(10), "<BR> ")
		
			dvHTMLEncode = fString
		End Function
		
		Function dvHTMLCode(ByVal fString)
			If IsNull(fString) Or Trim(fString) = "" Then
				dvHTMLCode = ""
				Exit Function
			End If
			fString = Replace(fString, "&gt;", ">")
			fString = Replace(fString, "&lt;", "<")
		
			fString = Replace(fString, "&nbsp;", " ")
			fString = Replace(fString, "&quot;", Chr(34))
			fString = Replace(fString, "&#39;", Chr(39))
			fString = Replace(fString, "</P><P> ", Chr(10) & Chr(10))
			fString = Replace(fString, "<BR> ", Chr(10))
		
			dvHTMLCode = fString
		End Function
		
		Function nohtml(ByVal str)
			If IsNull(str) Or Trim(str) = "" Then
				nohtml = ""
				Exit Function
			End If
			Dim re
			Set re = New RegExp
			re.IgnoreCase = True
			re.Global = True
			re.Pattern = "(\<.[^\<]*\>)"
			str = re.Replace(str, "")
			re.Pattern = "(\<\/[^\<]*\>)"
			str = re.Replace(str, "")
			Set re = Nothing
			str = Replace(str, Chr(34), "")
			str = Replace(str, "'", "")
			nohtml = str
		End Function
		'===============================================================================
		'函数名: CheckTheChar
		'作 用: 检查某一子串出现的次数
		'参 数:TheChar="要检测的字符串",TheString="待检测的字符串"
		'================================================================================
		Function CheckTheChar(TheChar, TheString)
		  Dim n
		  If InStr(TheString, TheChar) Then
			For n = 1 To Len(TheString)
			  If Mid(TheString, n, Len(TheChar)) = TheChar Then
			  CheckTheChar = CheckTheChar + 1
			  End If
			Next
			  CheckTheChar = CheckTheChar
		  Else
			  CheckTheChar = 0
		  End If
		End Function

End Class
%>
1234

⌨️ 快捷键说明

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