摘要 对于一个网上销售商，如何获得客户的Email地址，是销售自己产品必不可少的途径。本文笔者通过程序实现了Email地址自动获得的方法，从而避免了枯燥无味的手工查找。
关键词 VB 转换控件 文本控件
1 引言
在当今竞争激烈的社会环境下，一个企业如想处于不败之地，尤其是对于从事销售方面的企业，如何快速地寻找符合自己产品的客户及联系的方式是非常必要的。本文就是根据某个销售商的要求，为了避免员工枯燥无味的手工查找对方Email地址，并且又费时又费力，提出了一种自动获得Email地址的想法，达到既省时又省力的效果，笔者根据该要求设计了一个软件达到了此目的。该软件是用Visual Basic编写的。
2 程序实现
在程序编写之前，员工必须知道符合自己产品的客户的具体网址，这一点有许多种方法可以做到，其中比较有名的是利用Google搜索引擎（88google88）,这里假设要获得Email的网址是“88durham-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_Str2Do 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 Sub4）再添加如下程序代码来控制程序执行：
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("88durham-duplex.co.uk/contact.html";)
End Sub
3 结束语
以上程序已在VB6.0企业版中通过。通过上面的例子，笔者希望有“抛砖引玉”的功效，让读者在工作中遇到类似问题时得到一些启发。

参考文献
[1] Evangelos Petroutsos . Visual Basic 6 从入门到精通[M].电子工业出版社,1999
[3] 王颖等. ActiveX:从Visual Basic 6.0调用Matlab的实现方法[J].机电工程, 1999, (5)
: 172页

[返回上一页] [打 印]