config.asp

狗狗影视搜索小偷

<%
'==========================================
'文 件 名：Config.asp
'文件用途：系统配置
'系统名称：开良狗狗影视搜索小偷
'系统版本：V1.2
'系统开发：开良网络
'技术支持：http://www.klcode.com.cn/
'技 术 QQ：973573137
'联系邮箱：[e-mail]
'==========================================

'定义系统参数
Option Explicit
Dim SiteName,SiteUrl,SiteOpen,SiteCloseStr,i,ii
Dim PageCode,PageCodes
Dim TempArr,Codes2,Temp
Dim Xunlei_Id
SiteName="开良影视搜索" '站点名称
SiteUrl="http://www.klcode.com.cn/ggmovie/" '站点路径
SiteOpen=True '站点是否开放，Ture为开放，False为关闭
SiteCloseStr="站点升级中！请稍候访问。。。" '站点关闭时显示的提示
Xunlei_Id=10000001

On Error Resume Next

'==========================================
'判断站点是否开启
'==========================================
If SiteOpen=False Then
	Response.Write(SiteCloseStr)
	Response.End()
End If

'==========================================
'数据处理函数区
'==========================================

'列表数据基础处理
Function List_Process1(Codes)
	Codes=Split(Codes,"<td class=""op"" id=""pic1"">")(1) '去除前部无用代码
	Codes=Split(Codes,"<ul class=""ggPager"">")(0) '去除后部无用代码
	Codes=Replace(Codes,"<font color=""RED"">","")
	Codes=Replace(Codes,"</font>","")
	List_Process1=Codes
End Function

'获取列表标题
Function List_Process2(Codes)
	Codes=RegExpTest("target='_blank'>.*?</td>", Codes)
	Codes=Replace(Codes,"target='_blank'>","")
	Codes=Replace(Codes,"</td>","")
	TempArr=Split(Codes,"||")
	Codes2=""
	For Each Temp In TempArr
		If Temp<>"" And Instr(Temp,"条")=0 Then
			If Codes2="" Then
				Codes2=Temp
			Else
				Codes2=Codes2&"||"&Temp
			End If
		End If
	Next
	List_Process2=Codes2
End Function

'获取列表链接
Function List_Process3(Codes)
	Codes=RegExpTest(""" href=.*?target=", Codes)
	Codes=Replace(Codes,""" href=","")
	Codes=Replace(Codes,"target=","")
	Codes=Replace(Codes,"""","")
	Codes=Replace(Codes," ","")
	TempArr=Split(Codes,"||")
	Codes2=""
	For Each Temp In TempArr
		If Temp<>"" And Instr(Temp,"content.gougou.com")=0 Then
			If Codes2="" Then
				Codes2="MovieDown.asp?Url="&Server.URLEncode(Temp)
			Else
				Codes2=Codes2&"||"&"MovieDown.asp?Url="&Server.URLEncode(Temp)
			End If
		End If
	Next
	List_Process3=Codes2
End Function

'获取其他信息
Function List_Process4(Codes)
	Codes=RegExpTest("<td>.*?</td>", Codes)
	Codes=Replace(Codes,"<td>","")
	Codes=Replace(Codes,"</td>","")
	TempArr=Split(Codes,"||")
	Codes2=""
	For Each Temp In TempArr
		If Temp<>"" Then
			If Codes2="" Then
				Codes2=Temp
			Else
				Codes2=Codes2&"||"&Temp
			End If
		End If
	Next
	Codes2=Replace(Codes2,"</a>||","$##$")
	List_Process4=Codes2
End Function

'获取数量
Function List_Process5(Codes)
	Codes=RegExpTest("找到.*?个影视搜索结果", Codes)
	Codes=Replace(Codes,"找到","")
	Codes=Replace(Codes,"个影视搜索结果||","")
	List_Process5=Codes
End Function

'获取标题
Function Down_Process1(Codes)
	Codes=RegExpTest("<title>.*?</title>", Codes)
	Codes=Replace(Codes,"<title>","")
	Codes=Replace(Codes,"</title>||","")
	Down_Process1=Codes
End Function

'获取下载链接
Function Down_Process2(Codes)
	Codes=RegExpTest("<span class=""s1"" title="".*?""", Codes)
	Codes=Replace(Codes,"<span class=""s1"" title=""","")
	Codes=Replace(Codes,"""||","")
	Down_Process2=Codes
End Function

'==========================================
'正则表达式函数区
'==========================================	
Function RegExpTest(patrn, strng)
	Dim regEx, Matchs, Matches, RetStr
	Set regEx = New RegExp 
	regEx.Pattern = patrn 
	regEx.IgnoreCase = True
	regEx.Global = True
	Set Matches = regEx.Execute(strng) 
	For Each Matchs in Matches
		RetStr = RetStr & Matchs.Value & "||"
	Next 
	RegExpTest = RetStr 
End Function 


'==========================================
'采集函数区
'==========================================

'获取页面源代码函数
Function GetHttpPage(HttpUrl)
	If IsNull(HttpUrl)=True Then
		Response.Write("请输入网址！")
		Exit Function
	End If
	On Error Resume Next
	Dim Http
	Set Http=server.createobject("MSX"&"ML2.XML"&"HTTP")
	Http.open "GET",HttpUrl,False
	Http.Send()
	If Err Then
		Err.clear
		Response.Write(SiteCloseStr)
		Response.End()
	End If
	If Http.Readystate<>4 then
		Set Http=Nothing
		response.Write("该网页无法访问！")
		Exit function
	End if
	GetHttpPage=BytesToBSTR(Http.responseBody,"GB2312")
	Set Http=Nothing
	If Err.number<>0 then
		Err.Clear
	End If
End Function

'转换编码函数
Function BytesToBstr(Body,Cset)
	Dim Objstream
	Set Objstream = Server.CreateObject("adod"&"b.stream")
	Objstream.Type = 1
	Objstream.Mode =3
	Objstream.Open
	Objstream.Write body
	Objstream.Position = 0
	Objstream.Type = 2
	Objstream.Charset = Cset
	BytesToBstr = Objstream.ReadText 
	Objstream.Close
	set Objstream = nothing
End Function

'==========================================
'转迅雷链
'==========================================

Function ThunderEncode(url)
	//将Unicode编码的字符串进行Base64编码
	Dim thunderPrefix, thunderPosix, thunderTitle, thunderUrl

	thunderPrefix = "AA"
	thunderPosix = "ZZ"
	thunderTitle = "thunder://"

	thunderUrl = thunderTitle & strAnsi2Unicode(Base64encode(strUnicode2Ansi(thunderPrefix & url & thunderPosix)))

	ThunderEncode = thunderUrl 
End Function 

Function strUnicodeLen(asContents)
//计算unicode字符串的Ansi编码的长度
	Dim asContents1, len1, k, i
	asContents1="a"&asContents
	len1=len(asContents1)
	k=0
	for i=1 to len1
		Dim asc1
		asc1=asc(mid(asContents1,i,1))
		if asc1<0 then asc1=65536+asc1
		if asc1>255 then
			k=k+2
		else
			k=k+1
		end if
	next
	strUnicodeLen=k-1
End Function

Function strUnicode2Ansi(asContents)
//将Unicode编码的字符串，转换成Ansi编码的字符串
	Dim len1, i
	strUnicode2Ansi=""
	len1=len(asContents)
	for i=1 to len1
		Dim varchar, varasc, varHex, varlow, varhigh
		varchar=mid(asContents,i,1)
		varasc=asc(varchar)
		if varasc<0 then varasc=varasc+65536
		if varasc>255 then
			varHex=Hex(varasc)
			varlow=left(varHex,2)
			varhigh=right(varHex,2)
			strUnicode2Ansi=strUnicode2Ansi & chrb("&H" & varlow ) & chrb("&H" & varhigh )
		else
			strUnicode2Ansi=strUnicode2Ansi & chrb(varasc)
		end if
	next
End function

Function strAnsi2Unicode(asContents)
//将Ansi编码的字符串，转换成Unicode编码的字符串
	Dim len1, i
	strAnsi2Unicode = ""
	len1=lenb(asContents)
	if len1=0 then exit function
	for i=1 to len1
		dim varchar, varasc
		varchar=midb(asContents,i,1)
		varasc=ascb(varchar)
		if varasc > 127 then 
			strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
			i=i+1
		else
			strAnsi2Unicode = strAnsi2Unicode & chr(varasc)
		end if
	next
End function

Function Base64encode(asContents)
//将Ansi编码的字符串进行Base64编码
//asContents应当是ANSI编码的字符串（二进制的字符串也可以）
	Dim sBASE_64_CHARACTERS
	sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 
	sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
	Dim lnPosition 
	Dim lsResult 
	Dim Char1 
	Dim Char2 
	Dim Char3 
	Dim Char4 
	Dim Byte1 
	Dim Byte2 
	Dim Byte3 
	Dim SaveBits1 
	Dim SaveBits2 
	Dim lsGroupBinary 
	Dim lsGroup64 
	Dim m3,m4,len1,len2

	len1=Lenb(asContents)
	if len1<1 then 
		Base64encode=""
		exit Function
	end if

	m3=Len1 Mod 3 
	If m3 > 0 Then 
	//补足位数是为了便于计算
		asContents = asContents & String(3-m3, chrb(0)) 
		len1=len1+(3-m3)
		len2=len1-3
	else
		len2=len1
	end if

	lsResult = ""

	For lnPosition = 1 To len2 Step 3 
		lsGroup64 = "" 
		lsGroupBinary = Midb(asContents, lnPosition, 3) 
		Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3 
		Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15 
		Byte3 = Ascb(Midb(lsGroupBinary, 3, 1)) 
		Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252)/4) + 1, 1)
		Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240)/16) Or (SaveBits1 * 16) And &HFF) + 1, 1) 
		Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192)/64) Or (SaveBits2 * 4) And &HFF) + 1, 1) 
		Char4 = Midb(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1) 
		lsGroup64 = Char1 & Char2 & Char3 & Char4
		lsResult = lsResult & lsGroup64
	Next 
	
	//处理最后剩余的几个字符
	if M3 > 0 then
		lsGroup64 = "" 
		lsGroupBinary = Midb(asContents, len2+1, 3) 
		Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3 
		Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15 
		Byte3 = Ascb(Midb(lsGroupBinary, 3, 1)) 
		Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252)/4) + 1, 1) 
		Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240)/16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
		Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192)/64) Or (SaveBits2 * 4) And &HFF) + 1, 1) 
		if M3=1 then
			lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61) //用=号补足位数
		else
			lsGroup64 = Char1 & Char2 & Char3 & ChrB(61) //用=号补足位数
		end if
		lsResult = lsResult & lsGroup64 
	end if

	Base64encode = lsResult 
End Function 

Function Base64decode(asContents) 
//将Base64编码字符串转换成Ansi编码的字符串
//asContents应当也是ANSI编码的字符串（二进制的字符串也可以）
Dim sBASE_64_CHARACTERS 
sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 
sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
	Dim lsResult 
	Dim lnPosition 
	Dim lsGroup64, lsGroupBinary 
	Dim Char1, Char2, Char3, Char4 
	Dim Byte1, Byte2, Byte3 
	Dim M4,len1,len2

	len1= Lenb(asContents) 
	M4 = len1 Mod 4

	if len1 < 1 or M4 > 0 then
	//字符串长度应当是4的倍数
		Base64decode = "" 
		exit Function 
	end if

	//判断最后一位是不是 = 号
	//判断倒数第二位是不是 = 号
	//这里m4表示最后剩余的需要单独处理的字符个数
	if midb(asContents, len1, 1) = chrb(61) then m4=3 
	if midb(asContents, len1-1, 1) = chrb(61) then m4=2

	if m4 = 0 then
		len2=len1
	else
		len2=len1-4
	end if

	For lnPosition = 1 To Len2 Step 4 
		lsGroupBinary = "" 
		lsGroup64 = Midb(asContents, lnPosition, 4) 
		Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1 
		Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1 
		Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1 
		Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1 
		Byte1 = Chrb(((Char2 And 48)*16) Or (Char1 * 4) And &HFF) 
		Byte2 = lsGroupBinary & Chrb(((Char3 And 60)*4) Or (Char2 * 16) And &HFF) 
		Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63)) 
		lsGroupBinary = Byte1 & Byte2 & Byte3 
		lsResult = lsResult & lsGroupBinary 
	Next


	//处理最后剩余的几个字符
	if M4 > 0 then 
		lsGroupBinary = "" 
		lsGroup64 = Midb(asContents, len2+1, m4) & chrB(65) //chr(65)=A，转换成值为0
		if M4=2 then
		//补足4位，是为了便于计算 
			lsGroup64 = lsGroup64 & chrB(65) 
		end if
		Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1 
		Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1 
		Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1 
		Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1 
		Byte1 = Chrb(((Char2 And 48)*16) Or (Char1 * 4) And &HFF) 
		Byte2 = lsGroupBinary & Chrb(((Char3 And 60)*4) Or (Char2 * 16) And &HFF) 
		Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63)) 

		if M4=2 then
			lsGroupBinary = Byte1
		elseif M4=3 then
			lsGroupBinary = Byte1 & Byte2
		end if

		lsResult = lsResult & lsGroupBinary 
	end if

	Base64decode = lsResult 
End Function
%>