url vb 正則表示式。vb從檔案中提取所有url，顯示到文字框中
url vb 正則表示式
VB6引用：Microsoft VBScript Regular Exdivssions 5.5
==================================
Public Function IsUrl(ByVal strTmp As String) As Boolean
On Error GoTo Z
Dim objIntPattern
IsUrl = False
Set objIntPattern = New RegExp
objIntPattern.Pattern = "^(http://|https://){0,1}[A-Za-z0-9][A-Za-z0-9\-\.]+[A-Za-z0-9]\.[A-Za-z]{2,}[\43-\176]*$"
objIntPattern.Global = True
IsUrl = objIntPattern.Test(strTmp)
Set objIntPattern = Nothing
Z:
End Function
Private Sub Command1_Click()
MsgBox IsUrl( "http://www.sohu.com")
End Sub
VB.Net：
=============================================================
Public Shared Function IsUrl(ByVal strTmp As String) As Boolean
On Error GoTo Z
Dim objIntPattern As New System.Text.RegularExdivssions.Regex( "^(http://|https://){0,1}[A-Za-z0-9][A-Za-z0-9\-\.]+[A-Za-z0-9]\.[A-Za-z]{2,}[\43-\176]*$")
Return objIntPattern.IsMatch(strTmp)
Z:
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
MsgBox (IsUrl( "http://www.sohu.com"))
End Sub
=====================================================================================
vb從檔案中提取所有url，顯示到文字框中
Private Sub Command1_Click()
Dim F As String
F = "D:\新建資料夾\新建資料夾\自動郵箱提取傳送系統\temp_file\email_web.txt"
Call GetAllStr(F, " href=" & Chr(34), Chr(34))
End Sub
Private Sub GetAllStr(F As String, Find1 As String, Find2 As String)
Dim nStr As String, H As Long, B() As Byte, S As Long
Dim FindStart As Long, IsFond As Boolean, Str1 As String, nFond As String
On Error GoTo Cuo
S = FileLen(F)
ReDim B(1 To S)
H = FreeFile
Open F For Binary As #H
Get #H, , B
Close #H
nStr = StrConv(B, vbUnicode)
FindStart = 1
Do
Str1 = GetStr(nStr, FindStart, Find1, Find2, IsFond)
If Not IsFond Then Exit Do
If Str1 <> "" Then nFond = nFond & Str1 & vbCrLf
XiaS:
Loop
Text1.Text = F & vbCrLf & "查詢結果：" & vbCrLf & nFond
Exit Sub
Cuo:
MsgBox "檔案沒有找到：" & vbCrLf & F, vbInformation
End Sub
Private Function GetStr(nStr As String, FindStart As Long, StrQ As String, StrH As String, Optional IsFond As Boolean) As String
Dim sQ As Long, sH As Long, LongQ As Long, LongH As Long
IsFond = False
LongQ = Len(StrQ): LongH = Len(StrH)
If LongQ > 0 Then sQ = InStr(FindStart, nStr, StrQ, vbTextCompare) Else sQ = FindStart
If sQ = 0 Then Exit Function
If LongH > 0 Then sH = InStr(sQ + LongQ, nStr, StrH, vbTextCompare) Else sH = 1 + Len(nStr)
If sH = 0 Then Exit Function
GetStr = Mid(nStr, sQ + LongQ, sH - sQ - LongQ)
FindStart = sH + LongH
IsFond = True
End Function
說明：此函式對 HREF=' 和 HREF= 不起做用