Codango: ASP Code Snippet

JSP

Share The Love

You are 1 of 21 Active ASP Visitors

ASP Home | Resources | Write a Review | My Favor-Its | Login

Link & Email SpiderCode Snippet

Read Reviews | Report Errors

[+][+]

1
Reviews

0
Favor-It

This tools grabs any Link, E-mail address, or images/scripts from a given URL. The script can be simply modified to read URL addresses from a database and extract thousands of requested values using a loop. Code: ASP 2.0 & VBScript


		Code Snippet

Code Written By: Cenk Yurtseven from www.yurtseven.com

<%@Language="VBScript" %>
<%
Option Explicit
Private Function CheckString(ByRef varValue)
On Error Resume Next
Dim varTemp
varTemp = varValue
If Len(varTemp) <> 0 Then
varTemp = Replace(varTemp, "'", "''")
varTemp = Replace(varTemp, "%", Chr(37))
varTemp = Replace(varTemp, "<", "")
varTemp = Trim(varTemp)
End If
CheckString = varTemp
End Function
Function LinkURLs(strPage, strHREF)
Dim objXMLHttp
Dim strInput
Dim iCurrentLocation
Dim iLinkStart
Dim iLinkEnd
Dim strLinkText
Dim strOutput
On Error Resume Next
Err.Clear
Set objXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP.4.0")
If (Err) Then
Err.Clear
Set objXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
End If
If (Err) Then
Err.Clear
Set objXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
End If
If (Err) Then
Err.Clear
Set objXMLHttp = Server.CreateObject("Microsoft.XMLHttp")
End If
objXMLHttp.Open "GET", strPage, False
objXMLHttp.setRequestHeader "Content-Type", "text/html"
objXMLHttp.Send
If Err.Number = 0 Then
If objXMLHttp.Status = 200 Then
strInput = LCase(objXMLHttp.ResponseText)
Else
strInput = "Incorrect URL"
End If
Else
strInput = Err.Description
End If
Set objXMLHttp = Nothing
iCurrentLocation = 1
Do While InStr(iCurrentLocation, strInput, strHREF, 1) <> 0
iLinkStart = InStr(iCurrentLocation, strInput, strHREF, 1)
If InStr(iLinkStart, strInput, " ", 1) Then
iLinkEnd = InStr(iLinkStart, strInput, " ", 1)
End If
If InStr(iLinkStart, strInput, """", 1) Then
iLinkEnd = InStr(iLinkStart, strInput, """", 1)
End If
If InStr(iLinkStart, strInput, ">", 1) Then
iLinkEnd = InStr(iLinkStart, strInput, ">", 1)
End If
If iLinkEnd = 0 Then
iLinkEnd = Len(strInput) + 1
End If
Select Case Mid(strInput, iLinkEnd - 1, 1)
Case ".", "!", "?", "&"
iLinkEnd = iLinkEnd - 1
End Select
strLinkText = Trim(Mid(strInput, iLinkStart, iLinkEnd - iLinkStart))
If Left(strLinkText, 7) <> "http://" And Left(strLinkText, 8) <> "https://" Then
strLinkText = Replace(strLinkText, strHREF, "")
End If
strLinkText = Replace(strLinkText, """", "")
strLinkText = Trim(strLinkText)
If InStr(strLinkText, " ") > 0 Then
strLinkText = Left(strLinkText, InStr(strLinkText, " ") - 1)
End If
If Len(strLinkText) <> 0 Then
strOutput = strOutput & strLinkText & "<BR>" & vbcrlf
End If
iCurrentLocation = iLinkEnd
Loop
LinkURLs = strOutput
End Function
Public Sub GetURLS()
If Len(CheckString(Request.Form("TheURL"))) <> 0 And Len(CheckString(Request.Form("TheHREF"))) <> 0 Then
Response.Write (LinkURLs(CheckString(Request.Form("TheURL")), CheckString(Request.Form("TheHREF"))))
End If
End Sub
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; Charset=windows-1254">
<TITLE>Get URLs</TITLE>
<STYLE TYPE="text/css">
	BODY { font-family: Arial, Helvetica, Verdana; font-size: 10pt }
</STYLE>
</HEAD>
<BODY BGCOLOR="#E6E6E0">
<FORM ACTION="GRABURL.ASP" METHOD="post">
<TABLE ALIGN="center" CELLSPACING="2" CELLPADDING="2" BORDER="0">
<TR>
    <TD><B>URL of Web Page:</B></TD>
    <TD><INPUT TYPE="text" NAME="TheURL" SIZE="60"></TD>
</TR>
<TR>
    <TD><B>Select Criteria:</B></TD>
    <TD>
	<SELECT NAME="TheHREF">
	<OPTION VALUE="href=" SELECTED>All Links and E-Mail Addresses</OPTION>
	<OPTION VALUE="http://">Link Addresses</OPTION>
	<OPTION VALUE="mailto:">E-Mail Addresses</OPTION>
	<OPTION VALUE="src=">Images</OPTION>
	</SELECT>
	</TD>
</TR>
<TR>
    <TD>&nbsp;</TD>
    <TD><INPUT TYPE="submit" VALUE="Get URLs"></TD>
</TR>
</TABLE>
</FORM>
	<%
	Call GetURLS
	%>
</BODY>
</HTML>


	Shopping Cart

To use the code above, click and drag your mouse over the code to highlight it. Then right click on the highlighted code and click "Copy." Now you may paste it into your code editor.

Submit Your Own Code to Codango


Link to Us \| About Us		Advertise \| Contact Us \| Website Help
Write a User Review Today! Its Fun, Fast, and Easy!	Codango Home \| PHP \| ASP.NET \| ASP \| JSP Advertise With Us \| About Us \| Terms of Use \| Privacy Policy


� 2013 ezd.com, All rights reserved