dnsquery.asp

<%
    ' This file is provided as part of  ASP Power Widgets Samples
    '
    ' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT
    ' WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
    ' INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
    ' OF MERCHANTABILITY AND/OR FITNESS FOR A  PARTICULAR
    ' PURPOSE.

    ' Copyright 1999-2000. All rights reserved.
    ' Dalun Software Inc. ASP Power Widgets
    ' http://www.dalun.com/register.asp
    ' email: techsupport@dalun.com
    ' Revision History: 
    '       1.1.1  ASP changes.                           May 14, 99
    '       1.1.2  Added RegistrationCode property.       Jun 15, 99          
    '              Added Timeout Property.
    '       1.1.3  Modified for Internic changes.         Jul 27, 99
    '       1.1.4  Minor changes.                         Jul 10, 00
    '       1.1.5  Changed to be free threading for NT5.  Aug 27, 00
    '       1.1.6  Changed error reporting, added DNS     Sep 27, 01
    '              cache for better performance.
    '       2.0.0  Updated for performance, security.     Apr 01, 02
    '
    ' Note: 
    '       You have only 30 days to evaluate the component. 
    '       Windows 2K user: Remove IUSR_MachineName from Guest group.
    '
    '       This component is built for high performance and reliability. Ideally 
    '       you should create a COM+ application to host this object in memory to 
    '       achieve better performance.
         
    Option Explicit 

    Server.ScriptTimeOut = 150 
    Response.Buffer = True
    On error resume next    

    const ASPPW_E_DNSQUERY_WINSOCK_STARTFAILURE               &H80400020
    const ASPPW_E_DNSQUERY_WINSOCK_CANNOTCONNECT              &H80400021
    const ASPPW_E_DNSQUERY_WINSOCK_CANNOTSEND                 &H80400022
    const ASPPW_E_DNSQUERY_WINSOCK_CANNOTREV                  &H80400023
    const ASPPW_E_DNSQUERY_WINSOCK_CANNOTCREATESOCKET         &H80400024
    const ASPPW_E_DNSQUERY_WINSOCK_CANNOTRESOLVEADDRESS       &H80400025

    Const  NOMATCH = "NO MATCH: This domain is available"

%>

<HTML>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</HEAD>

<BODY bgColor=#ffcc00 link=#006699 text=#000000 vLink=#666633>

<TABLE bgColor=#ffcc00 border=0 cellPadding=0 cellSpacing=0 width=427>
<TBODY>
    <TR>
        <TD colSpan=3 width=344>
        <IMG height=23 width=344 src="images/register_a_web_address.gif">
        </TD>

        <TD rowSpan=4 width=73><A href="http://www.networksolutions.com/purchase/index.html">
            <IMG alt="Seach for a domain name" border=0 height=48 width=73 src="images/search_for_it.gif" 
            hspace=0 vspace=23></A>
        </TD>
        <TD rowSpan=5 width=10></TD>
    </TR>
        
<FORM action="DnsQuery.asp" method="post" name="form1">
        <TR>
          <TD colSpan=2 noWrap vAlign=center><FONT face="Arial, Helvetica, sans-serif" size=2>www.</FONT>
            <INPUT maxLength=26 name=STRING size=22 value="<%=Request("String")%>">
            <SELECT name=TLD size=1>
              <OPTION <%If Request("TLD")="" then%>selected<%End if%><%If Request("TLD")=".com" then%>selected<%End if%>  value=.com>.com</OPTION>
              <OPTION <%If Request("TLD")=".net" then%>selected<%End if%> value=.net>.net</OPTION> 
              <OPTION <%If Request("TLD")=".org" then%>selected<%End if%> value=.org>.org</OPTION>
              <OPTION <%If Request("TLD")=".edu" then%>selected<%End if%> value=.edu>.edu</OPTION>
             </SELECT>
          </TD>
          <TD noWrap vAlign=center>
                <INPUT type=image name=Submit src="images/go.gif" value="SUBMIT" border=0 height=21 width=29 >
           </TD>
         </TR>
 </FORM>

        <TR>
            <TD noWrap vAlign=center><FONT 
                face="Arial, Helvetica, sans-serif" size=1><B>1.</B>enter a name, word or phrase</FONT>
            </TD>
            <TD noWrap vAlign=center><FONT 
                face="Arial, Helvetica, sans-serif" size=1><B>2.</B>choose a domain</FONT>
            </TD>
            <TD noWrap vAlign=center><FONT 
                face="Arial, Helvetica, sans-serif" size=1><B>3.</B>click GO!</FONT>
            </TD>
        </TR>
        <TR>
            <TD colSpan=3 noWrap><FONT color=#333333 
                face="Arial, Helvetica, sans-serif" size=1>Search for a Web Address (domain name) with no obligation!</FONT></TD></TR>
        <TR></TR>
 </TBODY>
 </TABLE>


 <% 

    Dim oQuery, sRetVal, sDn, sRet, pos, strSig
    
    If Trim(Request("String")) <> "" Then
        strSig = Application("MY_APP_SIG")    
        If strSig = "" Then
            Application.Lock
            Set oQuery = Server.CreateObject("asppw.dnsquery")
            Set Application("oQuery") = oQuery 
            Application("MY_APP_SIG") = "COOL"
            Application.Unlock
            Response.write "Application initialized."
        Else
            Set oQuery = Application("oQuery")  
        End if

        sDn = Trim(Request("String")) & Request("TLD")
        Response.write "<pre>"

        '
        ' PROPERTIES 
        '
        oQuery.WhoisPort = 43                           'default is 43.
        oQuery.WhoisServer = "www.networksolutions.com" 'default is www.networksolutions.com
        oQuery.TimeOut = 60                             'default is 30 seconds.   
        'oQuery.RegistrationCode = "???"                'Put your registration code here.

        ' 
        ' METHODS
        '
        ' Method:  SendQuery
        Err.clear
        sRetVal = oQuery.SendQuery(sDn)                 'Using default: www.networksolutions.com:43 or properties set.

        If Err <> 0 Then
            Response.Write "Failed to connect to networksolutions. " & "Error: 0x" & Hex(Err) & " " & Err.Description
        Else
            Response.Write "[]----------------------------------------------------------------------[]" & vbCrlf
            Response.Write  oQuery.WhoisServer & ":" & oQuery.WhoisPort & vbCrlf
            Response.Write  sRetVal 
            
            If Instr(sRetVal, NOMATCH) > 0 Then
                Response.Write vbCrlf & "---> "
                Response.Write "This domain is available!"
            Else
         
                pos = 1

                If GetContentBetweenTags(sRet, sRetVal, pos, "Registrant:", "Domain"  ) Then
                    Response.Write ">>>>>Registrant: " &  sRet & vbCrlf
                Else
                   Response.Write "Registrant was not found." & vbCrlf
                End if

                If GetContentBetweenTags(sRet, sRetVal, pos, "Record expires on", ".") Then
                   Response.Write ">>>>>Record expires on: " & sRet & vbCrlf
                End if   
           End if
        End if

        Response.Write vbCrLf & vbCrlf
        Response.flush

        ' Method:  SendQuery
        sRetVal  = oQuery.SendQueryEx("rs.internic.net", 43, sDn)    'Note: This call changes default !!!
                                                                     '      WHOIS server and port.                                                                            

        If Err <> 0 Then
            Response.Write "Failed to connect to rs.internic.net. "  & "Error: 0x" & Hex(Err) & " " & Err.Description
        Else
            Response.Write "[]----------------------------------------------------------------------[]" & vbCrlf
            Response.Write  oQuery.WhoisServer & ":" & oQuery.WhoisPort & vbCrlf
            Response.Write  sRetVal 
        End if

        Response.write "</pre>"
        Set oQuery = Nothing    
    End if
    
%>        
            
 
<p align="right"><a href="http://www.dalun.com"><font face="Verdana, Arial" size="1">Dalun Software, Inc. </font></a>

</BODY></HTML>

<%    
'+-----------------------------------------------------------------------------
' Function:
'     GetContentBetweenTags 
' 
' Synopsis:
'      parses a string and returns a portion between two tags.
' 
' Arguments:
'        sReturn   [IN OUT]     returns " QUICK "
'        sInput    [IN]         "The QUICK brown dog jumps over the lazy fox"
'        lPosition [IN OUT]     returns 16      ^   
'        sTag1     [IN]         "The"
'        sTag2     [IN]         "brown"
' 
' Returns:
'      true on success, false on failure
'      
' History:
'      andrew    3/2/2000    Created
'------------------------------------------------------------------------------
Function GetContentBetweenTags(sReturn,sInput,lPosition,sTag1,sTag2) ' as boolean

    Dim i,j,len1,len2,l 
    
    GetContentBetweenTags = false
    sReturn = ""
    len1 = len(sTag1)
    len2 = len(sTag2)
    l = CLng(lPosition)
    if l<1 then l=1

    If len1 = 0  Then
        i = l
    Else
        i = InStr(l, sInput, sTag1)
    End If
    If i = 0 Then  Exit Function
    If len(sInput) < i Then Exit Function 

    If len2 = 0 then      
        j = len(sInput) + 1
    Else
        j = InStr(i + len1, sInput, sTag2)
        If j = 0 Then  Exit Function
    End if

    sReturn = Mid(sInput, i + len1, j - i - len1)       'returns the string between sTag1 and sTag2
    lPosition = j + len2                                'returns the postion for next search 
    GetContentBetweenTags = true                        'true or false

End Function



%>


Click here to go back.