利用VB提取HTML文件中的EMAIL地址

->电子邮件(EMAIL)是INTERNET上应用最广泛的一种服务之一。我们每天都在使用电子邮件，有时为了宣传我们的产品、网站等，更是离不开电子邮件，这就需要收集很多的EMAIL地址。下面我们将向大家介绍用VB自编一个EMAIL地址提取器，用来提取保存在我们硬盘中的HTML文件中所包含的EMAIL地址。->->一设计界面->->进入VB，选择“标准EXE”新建一工程，选择“工程”菜单下的“引用”，选中MicrosoftscriptingRuntime”，然后再选择“工程”菜单中的“部件”，在弹出的对话框中选择“Microsoftcommondialogcontrol6.0”，在工具箱中加入通用对话框控件。接下来在默认窗体FORM1上添加三个标签控件，一个文本框控件text1，一个列表框控件LIST1，并命名为lstemail，三个命令command1~command3,其Caption属性分别设置为“提取”、“整理”、“保存”，设置完成的界面如下图所示：->->

->->　->->二输入源程序->->DimX,Y,St1,St2,tmpYAsInteger->->'提取EMAIL地址子程序->->PrivateSubStripEmail(FilePathAsString)->->DimtmpEmail1,tmpEmail2AsString->->OpenFilePathForInputAs#1->->DoUntilEOF(1)->->OnErrorResumeNext->->Input#1,tmpEmail1->->ForX=1ToLen(tmpEmail1)->->tmpEmail2=Mid(tmpEmail1,X,7)->->'查找EMAIL标志->->IftmpEmail2="mailto:"Then->->St1=X->->tmpY=X 1->->ForY=1ToLen(tmpEmail1)->->tmpEmail2=Mid(tmpEmail1,tmpY,1)->->IftmpEmail2=Chr(34)OrtmpEmail2="?"Then->->St2=tmpY->->tmpEmail2=Mid(tmpEmail1,St1 7,((St2-St1)-7))->->If(Left(tmpEmail2,2)<>"//")And(Left(tmpEmail2,1)<>"")Then->->lstEmail.AddItemtmpEmail2->->ExitFor->->EndIf->->EndIf->->tmpY=tmpY 1->->NextY->->EndIf->->NextX->->Loop->->Close#1->->EndSub->->PrivateSubCommand1_Click()->->DimfsAsNewFileSystemObject'建立FileSystemObject->->DimfdAsFolder'定义Folder对象->->DimsfdAsFolder->->Setfd=fs.GetFolder(Text1)->->Command1.Enabled=False->->Screen.MousePointer=vbHourglass->->FindFilefd,"*.htm"'Text1.Text->->Command1.Enabled=True->->Screen.MousePointer=vbDefault->->EndSub->->SubFindFile(fdAsFolder,FileNameAsString)->->DimsfdAsFolder,fAsFile->->'PartI查找该文件夹的所有文件->->ForEachfInfd.Files->->IfUCase(f.Name)LikeUCase(FileName)Then->->Label2=f.Path->->StripEmail(f.Path)->->lblEmail="已查找到的地址数为:"&lstEmail.ListCount->->EndIf->->DoEvents->->Next->->'PartII循环查找所有子文件夹->->ForEachsfdInfd.SubFolders->->FindFilesfd,FileName'循环查找->->Next->->EndSub->->　->->PrivateSubCommand2_Click()->->'去掉重复的EMAIL地址->->Fori=0TolstEmail.ListCount-1->->ForX=0TolstEmail.ListCount-1->->Ifi=XThenGoToNextx->->IfLCase(lstEmail.List(X))=LCase(lstEmail.List(i))Then->->OnErrorResumeNext->->lstEmail.RemoveItemX->->EndIf->->Nextx:->->NextX->->Nexti->->lblEmail="共有"&lstEmail.ListCount&"个地址"->->EndSub->->'保存->->PrivateSubCommand3_Click()->->'设置文件名->->DimstrnameAsString->->commondialog1.Filter="文本文件(*.txt)|*.txt"->->commondialog1.ShowSave->->Ifcommondialog1.FileName<>""Then->->strname=commondialog1.FileName->->Else->->strname=App.Path&"\emailaddress.txt"->->EndIf->->'保存文件->->OpenstrnameForOutputAs#1->->OnErrorResumeNext->->Fori=0TolstEmail.ListCount-1->->Print#1,lstEmail.List(i)->->Next->->Close#1->->EndSub->->本程序在WINDOWSME、VB6.0中文企业版中运行通过。以上程序稍加修改即可实现提取其他类型文件中的EMAIL地址。->