WHOIS - Prüfen, ob Domain belegt oder noch frei Dieses Beispiel zeigt, wie man einen Domain-Checker realisiert, der prüft, ob eine Domain noch frei ist oder bereits belegt.
Autor:   Dieter Otter	Bewertung:	Views:  18.195
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Sie möchten eine eigene Homepage ins Netz stellen? Dann brauchen Sie zunächst eine Domain (URL-Adresse), unter der man Ihre Homepage abrufen kann.

Und bevor man eine Domain bei der zuständigen DENIC anmelden kann, muss man prüfen, ob die Wunsch-Domain noch frei ist, oder schon belegt. So eine Domain-Abfrage nennt man auch WHOIS-Abfrage. WHOIS deshalb, weil man über die WHOIS-Datenbanken abfragen kann, wer sich hinter einer Domain "versteckt" oder besser gesagt, wer der Besitzer der Domain ist.

Für eine WHOIS-Abfrage gibt es unzählige CGI-, ASP und PHP-Skripte, um z.B. einen Domain-Checker direkt auf der eigenen Homepage anzubieten. Wie sieht es aber aus, wenn man eine solche Anfrage über ein VB-Programm realisieren will?

Genau das zeigt Ihnen das nachfolgende Codebeispiel.

Erstellen Sie ein neues Projekt und fügen gleich mal das Winsock-Control hinzu (Menü Projekt - Komponenten - "Microsoft Winsock-Control"). Plazieren Sie auf die Form folgende Steuerelemente:

1. TextBox: txtDomain
2. CommandButton: cmdWHOIS
3. MultiLine-TextBox: txtWHOIS
4. Label-Control: lblStatus
5. Winsock-Control: Winsock1

Die TextBox txtDomain dient zur Eingabe der zu prüfenden Domain. Über die Schaltfläche cmdWHOIS wird die WHOIS-Abfrage gestartet. Während des Abfrage-Vorgangs wird der aktuelle Status im Label lblStatus ausgegeben. Das Ergebnis der Abfrage wird abschließend in der MutliLine-TextBox txtWHOIS angezeigt.

Und hier der vollständige Code

Option Explicit
 
' Speichert das Ergebnis der WHOIS-Abfrage
Private sData As String

Private Sub Form_Load()
  ' Schaltfläche zunächst deaktivieren
  cmdWHOIS.Enabled = False
End Sub

Private Sub txtDomain_Change()
  ' CommandButton aktivieren
  cmdWHOIS.Enabled = (Trim$(txtDomain.Text) <> "")
End Sub

Private Sub cmdWHOIS_Click()
  ' WHOIS-Anfrage starten
  Screen.MousePointer = vbHourglass
  txtWHOIS.Text = ""
  With Winsock1
    .Close
    .LocalPort = 0
 
    ' Verbinden mit allwhois.com (Port 80)
    lblStatus.Caption = "Verbinden mit www.allwhois.com..."
    .Connect "www.allwhois.com", 80
  End With
End Sub

Private Sub Winsock1_Connect()
  ' Verbunden - jetzt Domainanfrage losschicken
  Dim sDomain As String
 
  ' ggf. "http://www." entfernen
  sDomain = Trim$(txtDomain.Text)
  If LCase$(Left$(sDomain, 7)) = "http://" Then _
    sDomain = Mid$(sDomain, 8)
  If LCase$(Left$(sDomain, 4)) = "www." Then _
    sDomain = Mid$(sDomain, 5)
 
  ' Ergebnisbuffer leeren
  sData = ""
 
  ' Abfrage abschicken
  lblStatus.Caption = "Verbunden... Domainabfrage wird gestartet"
  DoEvents
 
  Winsock1.SendData "GET /cgi-bin/allwhois3.cgi?dn=" & _
    sDomain & vbCrLf
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  ' Daten werden empfangen
  Dim sTemp As String
 
  On Error Resume Next
  Winsock1.GetData sTemp
  lblStatus.Caption = "Verbunden... Daten werden empfangen"
  DoEvents
 
  ' Chr(10) durch Chr(13)+Chr(10) ersetzen, da
  ' Zeilenumbrüche sonst nicht korrekt dargestellt
  ' werden (UNIX)
  sData = sData & Replace(sTemp, Chr$(10), vbCrLf) & vbCrLf
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, _
  Description As String, ByVal Scode As Long, _
  ByVal Source As String, ByVal HelpFile As String, _
  ByVal HelpContext As Long, _
  CancelDisplay As Boolean)
 
  ' Fehler
  lblStatus.Caption = "Fehler!"
  DoEvents
 
  Winsock1.Close
  Screen.MousePointer = vbNormal
End Sub

Private Sub Winsock1_Close()
  ' Winsock schließen
  Winsock1.Close
 
  ' nach den wirklichen Informationen suchen
  Dim sCheck As String
 
  sCheck = "<textarea NAME=""description"" rows=10 cols=55 wrap=physical>"
  If InStr(sData, sCheck) > 0 Then
    sData = Mid$(sData, InStr(sData, sCheck) + Len(sCheck))
    If InStr(sData, "</textarea></form>") > 0 Then
      sData = Mid(sData, 1, InStr(sData, "</textarea></form>") - 1)
    End If
  End If
 
  ' Ausgabe im Textfeld
  txtWHOIS.Text = sData & vbCrLf
 
  If InStr(sData, "[admin-c]") > 0 Then
    lblStatus.Caption = "Domain ist bereits belegt..."
  Else
    lblStatus.Caption = "Domain ist noch frei..."
  End If
 
  Screen.MousePointer = vbNormal
End Sub

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.