VB开发——如何快速地从网页中获得Email地址

如何快速地从网页中获得Email地址
欧金成   朱治国   林德杰  
(广东工业大学自动化学院)
 摘要  对于一个网上销售商,如何获得客户的Email地址,是销售自己产品必不可少的途径。本文笔者通过程序实现了Email地址自动获得的方法,从而避免了枯燥无味的手工查找。
关键词 VB   转换控件   文本控件
1       引言
在当今竞争激烈的社会环境下,一个企业如想处于不败之地,尤其是对于从事销售方面的企业,如何快速地寻找符合自己产品的客户及联系的方式是非常必要的。本文就是根据某个销售商的要求,为了避免员工枯燥无味的手工查找对方Email地址,并且又费时又费力,提出了一种自动获得Email地址的想法,达到既省时又省力的效果,笔者根据该要求设计了一个软件达到了此目的。该软件是用Visual Basic编写的。
2  程序实现
在程序编写之前,员工必须知道符合自己产品的客户的具体网址,这一点有许多种方法可以做到,其中比较有名的是利用Google搜索引擎(http://www.google.com),这里假设要获得Email的网址是“http://www.durham-duplex.co.uk/contact.html”。具体程序编写如下:
1)打开VB建立一个新工程(工程1)及一个新窗体(Form1),同时添加“Microsoft Internet Transfer Control 6.0”(Inet1)[利用该控件的OpenURL方法获取HTML源码]和“Microsoft Rich Textbox Control 6.0(SP4)”(RichTextBox1,RichTextBox2)[介绍该控件的文章很多,笔者使用RichTextBox1存放HTML源码,RichTextBox2存放获取的EMail结果。]两个VB自带部件。
2)窗体Form1上手工加入控件RichTextBox1,RichTextBox2,Inet1,Command1(CommandButton控件),Command2。
3)写EMAIL的截取方法,程序代码如下:
Private Sub EMail_Rich(Rich1 As RichTextBox, Rich2 As RichTextBox)
'以下是定义变量,整型变量因为考虑到Email长度会超出Integer型的65535界限,所以使用Long型
     Dim EmailStr As String  '存放取得的Email地址
     Dim Str_Temp1 As String  '存放取得的“@”前面的某个字符
     Dim Str_Temp2 As String  '存放取得的“@”后面的某个字符
     Dim Where_Str  As Long  '存放“@”所在的位置
     Dim Where_Str1 As Long  '存放“@”前截取字符所在位置
     Dim Where_Str2 As Long  '存放“@”后截取字符所在位置
     Dim Start_Number As Long   '存放该EMAIL的长度
     Dim Start_Number1 As Long  '存放该EMAIL的“@”前的字符数
     Dim Start_Number2 As Long  '存放该EMAIL的“@”后的字符数
     Dim Start_No As Long  '存放开始查找“@”的起始位置
     Dim Logic_1 As Boolean  '存放判断“@”前面字符的条件准则
     Dim Logic_2 As Boolean  '存放判断“@”后面字符的条件准则
         
     '给变量赋初值
     EmailStr = ""
     Str_Temp1 = ""
     Str_Temp2 = ""
     Where_Str = 0
     Where_Str1 = 0
     Where_Str2 = 0
     Start_Number = 0
     Start_Number1 = 0
     Start_Number2 = 0
     Start_No = 1  '一开始当然从第一位开始搜索
     Logic_1 = False
     Logic_2 = False
         
     '控件初始化
     Rich2.Text = ""  '先清空控件Rich2中的Text值
         
     '程序开始
     Do While 1 = 1  '给一个永远真值的循环,该循环控制整个HTML页
       Where_Str = Rich1.Find("@", Start_No)  '开始查找第一个“@”位置
           
       If Where_Str <= 0 Then  '该值小于等于0代表没有找到
          Exit Do  '满足了以上条件,说明所有查找结束,退出循环
       End If
           
       Where_Str1 = Where_Str  '把“@”的位置赋给Where_Str1
       Where_Str2 = Where_Str  '把“@”的位置赋给Where_Str2

       Do While 1 = 1 '给一个永远真值的循环,该循环控制一个EMAIL中“@”前面内容
         Where_Str1 = Where_Str1 - 1  '逐个对“@”前内容进行比较,该变量控制位置
         Rich1.SelStart = Where_Str1  '设置控件Rich1中选择字符串的起始位置
         Rich1.SelLength = 1  '设置Rich1中选择字符串的长度,因为是单个比较,所以赋“1”
         Str_Temp1 = Rich1.SelText  '取得该字符
         '根据ASCII码表设置EMAIL字符串的规则,从而取得EMAIL地址,因为太长,所以分断写
         Logic_1 = (Asc(Str_Temp1) > 44 And Asc(Str_Temp1) < 47)
         Logic_1 = Logic_1 Or (Asc(Str_Temp1) > 47 And Asc(Str_Temp1) < 57)
         Logic_1 = Logic_1 Or (Asc(Str_Temp1) > 63 And Asc(Str_Temp1) < 91)
         Logic_1 = Logic_1 Or (Asc(Str_Temp1) > 96 And Asc(Str_Temp1) < 123)
         If Logic_1 = False Then '如果该字符不规则,说明已经不是Email地址的内容
           Exit Do  '满足了以上条件,退出循环
         End If
         Start_Number1 = Start_Number1 + 1 '说明符合规则,需要继续查看下一个字符
       Loop
           
       Do While 1 = 1  '该循环与前一个判断“@”前的字符意思相同,不再加入注释
         Where_Str2 = Where_Str2 + 1
         Rich1.SelStart = Where_Str2
         Rich1.SelLength = 1
         Str_Temp2 = Rich1.SelText
         Logic_2 = (Asc(Str_Temp2) > 44 And Asc(Str_Temp2) < 47)
         Logic_2 = Logic_2 Or (Asc(Str_Temp2) > 47 And Asc(Str_Temp2) < 57)
         Logic_2 = Logic_2 Or (Asc(Str_Temp2) > 63 And Asc(Str_Temp2) < 91)
         Logic_2 = Logic_2 Or (Asc(Str_Temp2) > 96 And Asc(Str_Temp2) < 123)
         If Logic_2 = False Then
           Exit Do
         End If
         Start_Number2 = Start_Number2 + 1
       Loop
       'EMAIL的总长度就是“@”前、后符合规则的字符的长度加上“@”的长度
       Start_Number = Start_Number1 + Start_Number2 + 1
           
       Rich1.SelStart = Where_Str1 + 1  '该EMAIL起始位置,正好是“@”前面字符最终位置
       Rich1.SelLength = Start_Number  '该EMAIL的总长度
       EmailStr = Rich1.SelText
       Rich2.Text = Rich2.Text & Chr(10) & EmailStr  '获得该EMAIL
       Start_No = Where_Str + Start_Number2  '继续定义下一重循环要查找“@”的起始位置
           
       '重新初始化一些中间变量
       EmailStr = ""
       Str_Temp1 = ""
       Str_Temp2 = ""
       Start_Number = 0
       Start_Number1 = 0
       Start_Number2 = 0
    Loop
End Sub
4)再添加如下程序代码来控制程序执行:
Private Sub Command1_Click()
   EMail_Rich RichTextBox1, RichTextBox2  '使用3中的方法
 End Sub
        
 Private Sub Command2_Click()
    End  '终止程序
 End Sub
        
Private Sub Form_Load()
 '初始化控件
  Command1.Caption = "截取"
  Command2.Caption = "退出"
  '获取网页中的HTML代码,并放到RichTextBox1中
RichTextBox1.Text = Inet1.OpenURL("http://www.durham-duplex.co.uk/contact.html";)
End Sub
3  结束语
以上程序已在VB6.0企业版中通过。通过上面的例子,笔者希望有“抛砖引玉”的功效,让读者在工作中遇到类似问题时得到一些启发。

展开阅读全文

没有更多推荐了,返回首页