vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Variablen/Strings · String-Operationen   |   VB-Versionen: VB617.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 ZirngiblBewertung:     [ Jetzt bewerten ]Views:  17.775 
www.masterbootrecord.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 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

Dieser Tipp wurde bereits 17.775 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel