vb@rchiv · Tipps & Tricks · Web-Adresse auf Gültigkeit prüfen

Rubrik: Variablen/Strings · String-Operationen | VB-Versionen: VB6

17.02.01

Web-Adresse auf Gültigkeit prüfen Dieser Tipp prüft eine Web-Adresse auf korrekte Syntax (korrektes Protokoll, IP-Adresse oder Domainname?, gültige TopLevelDomain?)
Autor: Matthias Zirngibl	Bewertung:	Views: 19.275
www.masterbootrecord.de	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Dieser Tipp prüft eine Web-Adresse auf Gütligkeit. Zunächst wird geprüft, ob es sich um eines der Protokolle http, ftp, new, gopher oder telnet handelt (otpional). Dann wird geprüft, ob es sich um einen Alias-Domainnamen oder um eine IP-Adresse handelt (xxx.xxx.xxx.xxx). Handelt es sich um einen Domainnamen (z.B. www.vbarchiv.de) wird die TopLevel-Domain anhand einer umfangreichen Vorgabeliste geprüft.

' Prüft eine Web-Adresse auf Gültigkeit
Public Function Check_Web_Adress(sWebAdress As String, _
  Optional bCheckForProtocol As Boolean = False) As Boolean
 
  Dim bGoodAdress As Boolean
  Dim sTopLevelDomainsArray() As String
  Dim sTopLevelDomains As String
  Dim sProtocolsArray() As String
  Dim sProtocols As String
  Dim i As Long
  Dim myProtocol As String
  Dim Splices() As String
  Dim Splices2() As String
  Dim Splices3() As String
  Dim Splices4() As String
  Dim myServer As String
  Dim isIPAdress As Boolean
 
  sWebAdress = LCase(sWebAdress)    
  bGoodAdress = False
 
  sTopLevelDomains = "com,net,edu,arpa,org,gov,museum," + _
    "biz,info,pro,name,aero,coop,ac,ad,ae,af,ag,ai,al," + _
    "am,an,ao,aq,ar,as,at,au,aw,az,ba,bb,bd,be,bf,bg," + _
    "bh,bi,bj,bm,bn,bo,br,bs,bt,bv,bw,by,bz,ca,cc,cd," + _
    "cf,cg,ch,ci,ck,cl,cm,cn,co,cr,cu,cv,cx,cy,cz,de," + _
    "dj,dk,dm,do,dz,ec,ee,eg,eh,er,es,et,fi,fj,fk,fm," + _
    "fo,fr,ga,gd,ge,gf,gg,gh,gi,gl,gm,gn,gp,gq,gr,gs," + _
    "gt,gu,gw,gy,hk,hm,hn,hr,ht,hu,id,ie,il,im,in,io," + _
    "iq,ir,is,it,je,jm,jo,jp,ke,kg,kh,ki,km,kn,kp,kr," + _
    "kw,ky,kz,la,lb,lc,li,lk,lr,ls,lt,lu,lv,ly,ma,mc," + _
    "md,mg,mh,mk,ml,mm,mn,mo,mp,mq,mr,ms,mt,mu,mv,mw," + _
    "mx,my,mz,na,nc,ne,nf,ng,ni,nl,no,np,nr,nu,nz,om," + _
    "pa,pe,pf,pg,ph,pk,pl,pm,pn,pr,ps,pt,pw,py,qa,re," + _
    "ro,ru,rw,sa,sb,sc,sd,se,sg,sh,si,sj,sk,sl,sm,sn," + _
    "so,sr,st,sv,sy,sz,tc,td,tf,tg,th,tj,tk,tm,tn,to," + _
    "tp,tr,tt,tv,tw,tz,ua,ug,uk,um,us,uy,uz,va,vc,ve," + _
    "vg,vi,vn,vu,wf,ws,ye,yt,yu,za,zm,zr,zw"
 
  sTopLevelDomainsArray = Split(sTopLevelDomains, ",")    
  sProtocols = "http,ftp,news,gopher,telnet"
  sProtocolsArray = Split(sProtocols, ",")    
 
  Splices = Split(sWebAdress, "://")
  If UBound(Splices) > 0 Then
    myProtocol = Splices(0)
  End If
 
  ' Protkokoll prüfen
  If bCheckForProtocol = True Then
    For i = 0 To UBound(sProtocolsArray)
      If myProtocol = sProtocolsArray(i) Then
        bGoodAdress = True
        Exit For
      End If
    Next
 
    If bGoodAdress = False Then
      Check_Web_Adress = False
      Exit Function
    End If
  End If    
 
  If UBound(Splices) > 0 Then
    myProtocol = myProtocol + "   "
  End If
  sWebAdress = Mid(sWebAdress, Len(myProtocol) + 1, _
    Len(sWebAdress))
 
  Splices2 = Split(sWebAdress, "/")
  Splices3 = Split(Splices2(0), ":")
  myServer = Splices3(0)
  Splices4 = Split(myServer, ".")
 
  If UBound(Splices4) = 3 Then
    ' Prüfen, ob IP-Adresse
    isIPAdress = True
    For i = 0 To 3
      If IsNumeric(Splices4(i)) Then
        If Splices4(i) > 255 Then
          isIPAdress = False
        End If
      Else
        isIPAdress = False
      End If
    Next
 
    If isIPAdress = True Then
      Check_Web_Adress = True
      Exit Function
    End If
  End If
 
  ' TopLevel-Domain prüfen
  For i = 0 To UBound(sTopLevelDomainsArray)
    If Splices4(UBound(Splices4)) = _
     sTopLevelDomainsArray(i) Then
      bGoodAdress = True
      Exit For
    End If
  Next
 
  Check_Web_Adress = bGoodAdress   
End Function