VBA 函数连接到 WHOIS 服务器并返回 .com.au 域的可用性

Question

我正在为希望一次快速检查数十个域的可用性的客户创建一个模板。模板必须保留为 excel 文件。

我已经安装并使用了 SEOToolsForExcel，它允许我使用 isdomainregistered() 函数查询服务器并检查特定域是否可用。然而不幸的是，该函数将始终为向其抛出的所有澳大利亚 ('.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 不断返回错误结果（仅在 '.com.au' 域上，'.com' 域工作正常）。

因此，我的下一个尝试是在 excel 中编写一个自定义函数来获取域并将其发送到 Ausregistry.com.au 服务器的域可用性工具。

Ausregistry 在他们的页面中解释了如何做到这一点：http://www.ausregistry.com.au/tools/domain-availability

他们解释：

然后，服务将根据域名的可用性返回字符串“可用”或“不可用”。

举例

要检查 ausregistry.net.au 的可用性，请按以下步骤操作：

• 连接到：地址：whois-check.ausregistry.net.au，端口：43

• 将字符串“ausregistry.net.au\r\n”发送到服务器

• 服务器将响应“不可用”，然后关闭连接。

上述程序与标准 WHOIS 协议兼容；因此，为使用 WHOIS 而构建的任何经销商界面也将能够使用该系统。 或者，可以使用标准的 *nix whois 命令，如下所示： whois -h

我之前在 VBA 中编写了很多代码，但我不知道如何实现与服务器的连接以及如何将其放入域字符串然后读取结果。我将不胜感激有关如何使用 VBA 实现这一目标的任何信息。

Answer 1

更新。我几个月前解决了这个问题，并想我会发布我的解决方案，以防有人偶然发现这个问题。 @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