Public Function CheckRealURL (ByVal URL As String, Optional foundin As String = "") As String

    
    Dim Pos As String
    Dim TrimLength As Integer
    Dim FilteredURL As String
    

    FilteredURL = LCase(Trim(URL))
    
    'Remove local files completely
    If Left(FilteredURL, 7) = "file://" Then
        CheckRealURL = ""
        Exit Function
    End If
        
    'Remove FTP files completely
    If SearchFirst(FilteredURL, "ftp://") Then
        CheckRealURL = ""
        Exit Function
    End If
    
    'Remove mailto: links completely
    If SearchFirst(FilteredURL, "mailto:") Then
        CheckRealURL = ""
        Exit Function
    End If
    
    'Remove directory references links completely
    If SearchFirst(FilteredURL, "..") Or _
        SearchFirst(FilteredURL, "/") Or _
        SearchFirst(FilteredURL, "\") Then
        
        CheckRealURL = ""
        Exit Function
    End If
    
    If Not (Search(FilteredURL, "http://") Or Search(FilteredURL, "https://")) Then
        If Not SearchFirst(FilteredURL, "www.") Then
            CheckRealURL = ""
            Exit Function
        End If
    End If
    
    'Remove HTTP from start
    If SearchFirst(FilteredURL, "http://") Then
        URL = TrimFrom(URL, 7, 0)
    End If
    
    'Remove HTTPs from start
    If SearchFirst(FilteredURL, "https://") Then
        URL = TrimFrom(URL, 8, 0)
    End If
    

    'Remove query text
    Pos = InStr(URL, "?")
    If Pos > 0 Then
        
        TrimLength = 1 + Len(URL) - Pos
            
        URL = TrimFrom(URL, 0, TrimLength)
            
    End If
    
    CheckRealURL = URL
End Function