正規とxmlHttpで実現したasp泥棒プログラムです。

<%  
'========================================  
class EngineerSearch  
'  :[email protected]  
':  XML  http    （          XML  ：））  
'      (                               ，     xmlHttp,  
'            )  
'---------------------------------------------------------------  
private oReg,oxmlHttp'    ，    xmlhttp  
'---------------------------------------------------------------  
public sub class_initialize()'        
set oReg=new regExp  
oReg.Global=true  
oReg.IgnoreCase=true  
set oXmlHttp=server.createobject("Microsoft.XmlHttp")  
end sub  
'---------------------------------------------------------------  
public sub class_terminate()'        
set oReg=nothing'      class      ，asp      class       
set oXmlHttp=nothing  
If typename(tempReg)<>"nothing" then'             
set tempReg=nothing  
end if  
end sub  
'---------------------------------------------------------------  
'       
public function engineer(url,EngineerReg)  
'    ：  url     (        )，     EngineerReg     ，  matches     
'   。  url    ,    engineerReg       ,    matches  ,  
'               （vbscript）,         ，           
dim strConent  
strContent=oXmlHttp.open("get",url,false)  
on error resume next  
oXmlHttp.send()  
if err.number<>0 then  
exit function  
end if  
strContent=bytes2BSTR(oXmlHttp.responseBody)  
if isnull(EngineerReg) then  
engineer=AbsoluteURL(strContent,url)  
else  
oReg.Pattern=EngineerReg  
set engineer=oReg.Execute(AbsoluteURL(strContent,url))   
end if  
end function  
'---------------------------------------------------------------  
'    ,(  )  
public Function bytes2BSTR(vIn)   
strReturn = ""   
For i = 1 To LenB(vIn)   
ThisCharCode = AscB(MidB(vIn,i,1))   
If ThisCharCode < &H80 Then   
strReturn = strReturn & Chr(ThisCharCode)   
Else   
NextCharCode = AscB(MidB(vIn,i+1,1))   
strReturn = strReturn & Chr (CLng(ThisCharCode) * &H100 + CInt(NextCharCode))   
i = i + 1   
End If   
Next   
bytes2BSTR = strReturn   
End Function  
'---------------------------------------------------------------  
public Function SearchReplace(strContent,ReplaceReg,ResultReg)  
'  ， strContent  replaceReg       resultReg     ，   searchReplace   
'    replace   。  
oReg.Pattern=ReplaceReg  
SearchReplace=oReg.replace(strContent,ResultReg)  
End Function  
'---------------------------------------------------------------  
public Function AbsoluteURL(strContent,byval url)  
' strContent    URL  oXmlHttp    url     (http/https/ftp/mailto:)  
'        。  
dim tempReg  
set tempReg=new RegExp  
tempReg.IgnoreCase=true  
tempReg.Global=true  
tempReg.Pattern="(^.*\/).*$"'         http://www.wrclub.net/default.aspx  
Url=tempReg.replace(url,"$1")  
tempReg.Pattern="((?:src|href).*?=[\'\u0022](?!ftp|http|https|mailto))"  
AbsoluteURL=tempReg.replace(strContent,"$1"+Url)  
set tempReg=nothing  
end Function  
'---------------------------------------------------------------  
end class  
'========================================  
%>  
<%'    
Response.CharSet = "GB2312"   
dim mySearch   
set mySearch=new EngineerSearch  
'URL               ,     ，           ,         :myMatches(0).subMatches(0)  
set myMatches=mySearch.engineer("http://www.wrclub.net/default.aspx","<img.*?>")  
if myMatches.count=0 Then  
response.write "         "  
end if  
if myMatches.count>0 then  
response.write myMatches.count&"<br>"  
for each key in myMatches  
response.write key.firstindex&":"&cstr(key.value)&"<br>"  
next  
end if  
%>