inc.asp

Google近日收录查询系统

<!-- #include file="LCache_Class.asp" -->
<!-- #include file="md5.asp" -->
<%




Function GetPage(url) 
On Error Resume Next
    Dim Retrieval
	Set Retrieval = CreateObject("Msxml2.XMLHTTP") 
	'Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
	With Retrieval 
	.Open "Get", url, False, "", "" 
	.Send
	if .readyState = 4 then
		if len(.ResponseBody)=0 then
			Response.Write("<h1>服务器故障~！~~~~</h1>")
		else
			GetPage = BytesToBstr(.ResponseBody)
		end if
	end if
	End With 
	Set Retrieval = Nothing
On Error GoTo 0
End Function

Function BytesToBstr(body)
	dim objstream
	set objstream = Server.CreateObject("adodb.stream")
	objstream.Type = 1
	objstream.Mode =3
	objstream.Open
	objstream.Write body
	objstream.Position = 0
	objstream.Type = 2
	objstream.Charset = "UTF-8"
	'objstream.Charset = "UTF-8"
	BytesToBstr = objstream.ReadText 
	objstream.Close
	set objstream = nothing
End Function

Function GetContent(str,start,last,n)

	If Instr(lcase(str),lcase(start))>0 and Instr(lcase(str),lcase(last))>0 then
		select case n
		case 0	'左右都截取（都取前面）（去处关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1) 
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
		case 1	'左右都截取（都取前面）（保留关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
		case 2	'只往右截取（取前面的）（去除关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		case 3	'只往右截取（取前面的）（包含关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		case 4	'只往左截取（取后面的）（包含关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
		case 5	'只往左截取（取后面的）（去除关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
		case 6	'只往左截取（取前面的）（包含关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
		case 7	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
		case 8	'只往左截取（取前面的）（去除关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
		case 9	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
		end select
	Else
		GetContent=""
	End if
	
End function
'过滤空格 回车 制表符
Function filtrate(str)
	str=replace(str,chr(13),"")
	str=replace(str,chr(10),"")
	str=replace(str,chr(9),"")
	filtrate=str
End Function


Function toUTF8(szInput)
Dim wch, uch, szRet
Dim x
Dim nAsc, nAsc2, nAsc3

If szInput = "" Then
toUTF8 = szInput
Exit Function
End If
For x = 1 To Len(szInput)
  wch = Mid(szInput, x, 1)
  nAsc = AscW(wch)
  If nAsc < 0 Then nAsc = nAsc + 65536

  If (nAsc And &HFF80) = 0 Then
     szRet = szRet & wch
  Else
      If (nAsc And &HF000) = 0 Then
         uch = "%" & Hex(((nAsc \ 2 ^ 6)) or &HC0) & Hex(nAsc And &H3F or &H80)
         szRet = szRet & uch
       Else
          uch = "%" & Hex((nAsc \ 2 ^ 12) or &HE0) & "%" & _
          Hex((nAsc \ 2 ^ 6) And &H3F or &H80) & "%" & _
          Hex(nAsc And &H3F or &H80)
          szRet = szRet & uch
       End If
  End If
Next

toUTF8 = szRet
End Function


%>