_proxy.asp

来自「一个用asp编写的搜索代码,可以分类搜索google,baidu等网站,也可以自」· ASP 代码 · 共 107 行

<%
'''''''''''''''''''''''''''''''''''''''''''
'XMLHTTP Porxy Class By Lilo/2006-4
'''''''''''''''''''''''''''''''''''''''''''
Class ProxyClass
	Private xmlDoc,xStream
	Private t_Stream,t_XMLHTTP  '控件名称
	Private t_Debug,t_Result
	
	Private Sub Class_Initialize()
		t_Debug  = 0                        '等于1时为调试模式，输出错误信息
		t_Stream = "ADODB.Stream"           '初始化控件名称
		t_XMLHTTP = "Msxml2.XMLHTTP.6.0"    '初始化控件名称
	End Sub
	
	Private Sub Class_Terminate()
		Set xmlDoc=Nothing
		Set xStream=Nothing
	End Sub

	Public Property Let IsDebug(n)
		t_Debug = n
	End Property
	
	Public Property Let SetStreamName(ObjName)
		t_Stream = ObjName
	End Property
	Public Property Let SetXMLHttpName(ObjName)
		t_XMLHTTP = ObjName
	End Property
	
	Public Property Get PorxyReturn()
		PorxyReturn = t_Result
	End Property
	
	Public Function Create()
		On Error Resume Next
		Create = False
		Set xmlDoc = CreateObject(t_XMLHTTP)
		Set xStream = CreateObject(t_Stream)
		If t_Debug = 1 And Not Err.Number = 0 Then Call PutLastError(Err.Number,Err.Source,Err.Description)
		Create = True
	End Function
	
	Private Sub PutLastError(Number,Source,Description)
		Response.Clear
		Response.write "<font style='font-size:9pt'>Number: "& Number &"<BR>"& vbCrLf &"Source: "& Source &"<BR>"& vbCrLf &"Description: "& Description
		Response.End
	End Sub
	
	Private Function ToChar(xConn,xChar)
		On Error Resume Next
		With xStream
			.Type     = 1
			.Mode     = 3
			.Open
			.Position = 0
			.Write      xConn
			.Position = 0
			.Type     = 2
			.Charset  = xChar
			ToChar    = .ReadText
			.Close
		End With
		If t_Debug = 1 And Not Err.Number = 0 Then Call PutLastError(Err.Number,Err.Source,Err.Description)
	End Function
	
	Public Function RemoteRead(xPath)
		On Error Resume Next
		RemoteRead = False
		xmlDoc.Open "GET",xPath,False
		xmlDoc.Send
		If xmlDoc.readyState <> 4 Then Exit Function
		t_Result = ToChar(xmlDoc.responseBody,"GB2312")
		If t_Debug = 1 And Not Err.Number = 0 Then
			Call PutLastError(Err.Number,Err.Source,Err.Description)
		Else
			RemoteRead = True
		End If
	End Function
	
	Public Function RemotePost(xPath,xPost)
		On Error Resume Next
		RemotePost = False
		xmlDoc.Open "post",xPath,False
		xmlDoc.setRequestHeader "content-length",Len(xPost)
		xmlDoc.setRequestHeader "content-type","application/x-www-form-urlencoded"
		xmlDoc.Send xPost
		If xmlDoc.readyState<>4 Then Exit Function
		t_Result = ToChar(xmlDoc.responseBody,"GB2312")
		If t_Debug = 1 And Not Err.Number = 0 Then
			Call PutLastError(Err.Number,Err.Source,Err.Description)
		Else
			RemotePost = True
		End If
	End Function
End Class

Public Function ReplaceValue(Value, Match, ReValue)
	Set RegEx = New RegExp
	RegEx.Pattern = Match
	RegEx.MultiLine = True
	RegEx.Global = True
	RegEx.IgnoreCase = False
	ReplaceValue = RegEx.Replace(Value, ReValue)
End Function
%>