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 19.566 mal aufgerufen.
Anzeige
![]() ![]() ![]() (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. |
sevZIP40 Pro DLL ![]() Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Tipp des Monats ![]() Dieter Otter sevTabStrip: Rechtsklick auf Reiter erkennen Eine Funktion, mit der sich prüfen lässt, auf welchen Tab-Reiter ein Mausklick erfolgte Access-Tools Vol.1 ![]() Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |