VBA 连接到 WHOIS 服务器的功能和 return .com.au 域的可用性
VBA Function to connect to WHOIS server and return availability of a .com.au domain
我正在为希望一次快速检查几十个域的可用性的客户创建一个模板。模板必须保留为 excel 文件。
我已经安装并使用了 SEOToolsForExcel,它允许我查询服务器并使用 isdomainregistered() 函数检查特定域是否可用。然而不幸的是,该函数将始终 return 'true' (即域被占用)对于所有抛给它的澳大利亚('.com.au')域。我已尝试按照此页面中的建议更改 xml 配置文件中的 TLD 查找:http://seotoolsforexcel.com/how-to-setup-tlds-in-seotools-config-xml/
我尝试了以下方法:
<Tld Name="au" WhoIsServer="whois.aunic.net" WhoIsNotFoundRegex="(no match)|(no data found)|(not found)|(no entries found)|(error for)|(invalid pattern)|(illegal question)" WhoIsCreatedRegex="" WhoIsUpdatedRegex="(?:Last Modified:\s*(\d{2}-[A-z]{3}-)\d{4})" WhoIsExpiresRegex="" WhoIsDelayMs="1000" />
还有这个:
<Tld Name="au" WhoIsServer="whois-check.ausregistry.net.au" WhoIsNotFoundRegex="is free" WhoIsCreatedRegex="" WhoIsUpdatedRegex="" WhoIsExpiresRegex="" WhoIsDelayMs="1000" />
但似乎都没有用。我已经检查了其他服务,这些服务清楚地表明域可用,但 SEOTool 保持 returning 错误结果(仅在 '.com.au' 域上,'.com' 域工作正常)。
因此,我的下一次尝试是在 excel 中编写自定义函数以获取域并将其发送到 Ausregistry。com.au 服务器的域可用性工具。
Ausregistry 在他们的页面上解释了如何做到这一点:http://www.ausregistry.com.au/tools/domain-availability
他们解释说:
The service will then respond with either the string 'Available' or 'Not Available' depending upon the availability of the Domain Name.
For Example
To check the availability of ausregistry.net.au follow these steps:
Connect to: Address: whois-check.ausregistry.net.au, Port: 43
Send the string `ausregistry.net.au\r\n' to the server
- The server will respond with `Not Available' and then close the connection.
The above procedure is compatible with standard WHOIS protocol; hence any reseller interface that is built to use WHOIS will be able to use this system as well.
Alternatively, the standard *nix whois command can be used as follows:
whois -h
我以前在 VBA 中编写过很多代码,但我不知道如何实现与服务器的连接以及如何将域字符串传递给它然后读取结果。如果能提供有关如何使用 VBA.
实现此目的的任何信息,我将不胜感激
更新。我几个月前解决了这个问题,并认为我会 post 我的解决方案,以防有人偶然发现这个问题。 @Lumigraphics,幸运的是我不必学习 PERL。我使用了 OstroSoft Winsock 组件(你可以得到它 here)。
以及以下 UDF:
Function AusRegDomainAvailable(DomainUrl As String) As Boolean
Dim sPage As String
Dim sServer As String
Dim nPort As Long
Dim AusRegistryServer As String
Dim ReturningData As String
Dim wsTCP As OSWINSCK.Winsock
Dim FixedDomain As String
Dim Timelimit As Date
QueryTimeOut = False
FixedDomain = Replace(DomainUrl, "www.", "")
FixedDomain = Replace(FixedDomain, "http://", "")
FixedDomain = Replace(FixedDomain, "https://", "")
AusRegistryServer = "whois-check.ausregistry.net.au"
nPort = 43
sServer = Trim(AusRegistryServer)
If InStr(sServer, "://") > 0 Then sServer = Mid(sServer, InStr(sServer, "://") + 3)
If InStr(sServer, "/") > 0 Then
sPage = Mid(sServer, InStr(sServer, "/") + 1)
sServer = Left(sServer, InStr(sServer, "/") - 1)
End If
If InStr(sServer, ":") > 0 Then
nPort = Mid(sServer, InStr(sServer, ":") + 1)
sServer = Left(sServer, InStr(sServer, ":") - 1)
End If
If sServer = "" Then Err.Raise 12001, , "Invalid URL"
Set wsTCP = CreateObject("OSWINSCK.Winsock")
wsTCP.Connect sServer, nPort
Do Until wsTCP.State = 7
DoEvents
If wsTCP.State = sckError Then
Exit Function
End If
Loop
wsTCP.SendData FixedDomain & vbCrLf
Timelimit = (Now + TimeValue("0:00:02"))
Do Until wsTCP.Status = "Data Arrival" Or Now > Timelimit
DoEvents
If wsTCP.State = sckClosed Then
QueryTimeOut = True
Exit Function
End If
Loop
wsTCP.GetData ReturningData
ReturningData = Replace(ReturningData, vbLf, "")
ReturningData = Replace(ReturningData, vbCr, "")
ReturningData = Trim(ReturningData)
If ReturningData = "Available" Then
AusRegDomainAvailable = True
ElseIf ReturningData = "Not Available" Then
AusRegDomainAvailable = False
Else
QueryTimeOut = True
AusRegDomainAvailable = Null
End If
DoEvents
Debug.Print FixedDomain & " " & ReturningData
wsTCP.CloseWinsock
Exit Function
ErrHandler:
AusRegDomainAvailable = "Error " & Err.Number & ": " & Err.Description
End Function
我正在为希望一次快速检查几十个域的可用性的客户创建一个模板。模板必须保留为 excel 文件。
我已经安装并使用了 SEOToolsForExcel,它允许我查询服务器并使用 isdomainregistered() 函数检查特定域是否可用。然而不幸的是,该函数将始终 return 'true' (即域被占用)对于所有抛给它的澳大利亚('.com.au')域。我已尝试按照此页面中的建议更改 xml 配置文件中的 TLD 查找:http://seotoolsforexcel.com/how-to-setup-tlds-in-seotools-config-xml/
我尝试了以下方法:
<Tld Name="au" WhoIsServer="whois.aunic.net" WhoIsNotFoundRegex="(no match)|(no data found)|(not found)|(no entries found)|(error for)|(invalid pattern)|(illegal question)" WhoIsCreatedRegex="" WhoIsUpdatedRegex="(?:Last Modified:\s*(\d{2}-[A-z]{3}-)\d{4})" WhoIsExpiresRegex="" WhoIsDelayMs="1000" />
还有这个:
<Tld Name="au" WhoIsServer="whois-check.ausregistry.net.au" WhoIsNotFoundRegex="is free" WhoIsCreatedRegex="" WhoIsUpdatedRegex="" WhoIsExpiresRegex="" WhoIsDelayMs="1000" />
但似乎都没有用。我已经检查了其他服务,这些服务清楚地表明域可用,但 SEOTool 保持 returning 错误结果(仅在 '.com.au' 域上,'.com' 域工作正常)。
因此,我的下一次尝试是在 excel 中编写自定义函数以获取域并将其发送到 Ausregistry。com.au 服务器的域可用性工具。
Ausregistry 在他们的页面上解释了如何做到这一点:http://www.ausregistry.com.au/tools/domain-availability
他们解释说:
The service will then respond with either the string 'Available' or 'Not Available' depending upon the availability of the Domain Name.
For Example
To check the availability of ausregistry.net.au follow these steps:
Connect to: Address: whois-check.ausregistry.net.au, Port: 43
Send the string `ausregistry.net.au\r\n' to the server
- The server will respond with `Not Available' and then close the connection.
The above procedure is compatible with standard WHOIS protocol; hence any reseller interface that is built to use WHOIS will be able to use this system as well. Alternatively, the standard *nix whois command can be used as follows: whois -h
我以前在 VBA 中编写过很多代码,但我不知道如何实现与服务器的连接以及如何将域字符串传递给它然后读取结果。如果能提供有关如何使用 VBA.
实现此目的的任何信息,我将不胜感激更新。我几个月前解决了这个问题,并认为我会 post 我的解决方案,以防有人偶然发现这个问题。 @Lumigraphics,幸运的是我不必学习 PERL。我使用了 OstroSoft Winsock 组件(你可以得到它 here)。
以及以下 UDF:
Function AusRegDomainAvailable(DomainUrl As String) As Boolean
Dim sPage As String
Dim sServer As String
Dim nPort As Long
Dim AusRegistryServer As String
Dim ReturningData As String
Dim wsTCP As OSWINSCK.Winsock
Dim FixedDomain As String
Dim Timelimit As Date
QueryTimeOut = False
FixedDomain = Replace(DomainUrl, "www.", "")
FixedDomain = Replace(FixedDomain, "http://", "")
FixedDomain = Replace(FixedDomain, "https://", "")
AusRegistryServer = "whois-check.ausregistry.net.au"
nPort = 43
sServer = Trim(AusRegistryServer)
If InStr(sServer, "://") > 0 Then sServer = Mid(sServer, InStr(sServer, "://") + 3)
If InStr(sServer, "/") > 0 Then
sPage = Mid(sServer, InStr(sServer, "/") + 1)
sServer = Left(sServer, InStr(sServer, "/") - 1)
End If
If InStr(sServer, ":") > 0 Then
nPort = Mid(sServer, InStr(sServer, ":") + 1)
sServer = Left(sServer, InStr(sServer, ":") - 1)
End If
If sServer = "" Then Err.Raise 12001, , "Invalid URL"
Set wsTCP = CreateObject("OSWINSCK.Winsock")
wsTCP.Connect sServer, nPort
Do Until wsTCP.State = 7
DoEvents
If wsTCP.State = sckError Then
Exit Function
End If
Loop
wsTCP.SendData FixedDomain & vbCrLf
Timelimit = (Now + TimeValue("0:00:02"))
Do Until wsTCP.Status = "Data Arrival" Or Now > Timelimit
DoEvents
If wsTCP.State = sckClosed Then
QueryTimeOut = True
Exit Function
End If
Loop
wsTCP.GetData ReturningData
ReturningData = Replace(ReturningData, vbLf, "")
ReturningData = Replace(ReturningData, vbCr, "")
ReturningData = Trim(ReturningData)
If ReturningData = "Available" Then
AusRegDomainAvailable = True
ElseIf ReturningData = "Not Available" Then
AusRegDomainAvailable = False
Else
QueryTimeOut = True
AusRegDomainAvailable = Null
End If
DoEvents
Debug.Print FixedDomain & " " & ReturningData
wsTCP.CloseWinsock
Exit Function
ErrHandler:
AusRegDomainAvailable = "Error " & Err.Number & ": " & Err.Description
End Function