分享
 
 
 

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

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

-电子邮件(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地址。--

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有