delphi做的idhttp下载具体某个网站资源的程序(希望大家多看看,多给小弟指点指点,有利于小弟学习)
2009-12-29 18:17
567 查看
今天由于需要下载具体某个网站的资源,手动下载很累,所以我就想写个下载的程序来让程序下载
由于初学Delphi,不怕大家笑话,有很多地方都不会或者都写不好,
可以说是写的很垃圾(限于知识面有限,各方面都考虑不到),
所以我把代码发上来,希望各位大侠帮忙给指出程序不足之处,
希望大家多多评论评论,以便有利于小弟学习。
代码如下:
代码
由于初学Delphi,不怕大家笑话,有很多地方都不会或者都写不好,
可以说是写的很垃圾(限于知识面有限,各方面都考虑不到),
所以我把代码发上来,希望各位大侠帮忙给指出程序不足之处,
希望大家多多评论评论,以便有利于小弟学习。
代码如下:
代码
procedure TForm5.Button1Click(Sender: TObject); var reg,reg1,reg2,reg3,reg4,reg5:TPerlRegEx; mystream1,mystream2:TMemoryStream; regstr,reg5str,reg4str,thesql:string; a,s:Arrayofstring; begin reg1:=TPerlRegEx.Create(nil); reg1.Subject:=IdHTTP1.get('http://www.sssccc.net/other/caizhi.shtml'); reg1.RegEx:= 'http://www.sssccc.net/class/[^\s]*_1.shtml'; while reg1.MatchAgain do //遍历每个二级类 begin //ShowMessage(reg1.SubExpressions[0]); reg:=TPerlRegEx.Create(nil); reg.Subject:=IdHTTP1.get(reg1.SubExpressions[0]); reg.RegEx:='<TITLE>(.|\n)*</TITLE>';//取标题 while reg.MatchAgain do begin regstr:=reg.SubExpressions[0]; regstr:=Copy(regstr,8,Pos('-',regstr)-8);//获取类别名称 reg2:=TPerlRegEx.Create(nil); reg2.Subject:=IdHTTP1.get(reg1.SubExpressions[0]); reg2.RegEx:= 'http://www.sssccc.net/source/[^\s]*.shtml'; while reg2.MatchAgain do //遍历每个具体资源 begin mystream1:=TMemoryStream.Create; mystream2:=TMemoryStream.Create; reg5:=TPerlRegEx.Create(nil); // reg5.Subject:=IdHTTP1.get(reg2.SubExpressions[0]); reg5.RegEx:= '<TITLE>(.|\n)*</TITLE>'; while reg5.MatchAgain do begin reg5str:= reg5.SubExpressions[0]; reg5str:=Copy(reg5str,8,Pos('-',reg5str)-8); //获取资源名称 reg3:=TPerlRegEx.Create(nil); reg3.Subject:=IdHTTP1.get(reg2.SubExpressions[0]); reg3.RegEx:= 'http://[^\s]*.jpg'; while reg3.MatchAgain do // 查找图片地址 begin if not DirectoryExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))) then if not CreateDir('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))) then raise Exception.Create('创建目录出错!'); if not DirectoryExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))) then if not CreateDir('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))) then raise Exception.Create('创建目录出错!'); if not FileExists('e:\材质贴图'+'\'+mymd5(Trim(regstr))+mymd5(trim(reg5str))+'\'+mymd5(trim(reg5str))+'.jpg') then begin try IdHTTP1.Get(reg3.SubExpressions[0],mystream1); finally mystream1.Free; ShowMessage('网络出错'); end; mystream1.SaveToFile('e:\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))+'\'+mymd5(trim(reg5str))+'.jpg'); end; end; reg4:=TPerlRegEx.Create(nil); //获取下载地址 reg4.Subject:=IdHTTP1.get(reg2.SubExpressions[0]); reg4.RegEx:= 'href="http://www.sssccc.net/download.asp?[^\s]*'; while reg4.MatchAgain do begin if not DirectoryExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))) then if not CreateDir('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))) then raise Exception.Create('创建目录出错!'); if not DirectoryExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))) then if not CreateDir('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))) then raise Exception.Create('创建目录出错!'); reg4str:=Copy(reg4.SubExpressions[0],7,Length(reg4.SubExpressions[0])-7); if not FileExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))+'\'+mymd5(trim(reg5str))+'.zip') then begin try IdHTTP1.Get(reg4str,mystream2); finally mystream2.Free; ShowMessage('网络出错'); end; mystream2.SaveToFile('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))+'\'+mymd5(trim(reg5str))+'.zip'); thesql:=' insert into storage2 (dir1,dir2,dir3,eng_dir2,eng_dir3,filename) '; thesql:=thesql+' values (''材质贴图'','''+trim(regstr)+''','''+trim(reg5str)+''','''+mymd5(Trim(regstr))+''','''+mymd5(Trim(reg5str))+''','''+mymd5(Trim(reg5str))+''' ) '; a:=excsql(thesql,g_mydbcenterName); end; end; reg3.Free; reg4.Free; end; reg5.Free; mystream1.Free; mystream2.Free; end; reg2.Free; end; reg.Free; end; reg1.Free; end;
相关文章推荐
- 给大家推荐一个很好的免费学习资源下载网站—软实力资源网
- DELPHI IDHTTP下载
- 2011年我的php学习心得,希望大家指点
- linux资源网站和ftp站点!(linux软件下载及学习)
- 给大家推荐一个python的学习网站 http://www.codecademy.com
- java学习_小程序(四线程断点网络资源下载,即时进度反馈)
- 小弟和同学的作品大家给评价评价 《交警移动警务》-awaken团队 济南职业学院 2012齐鲁软件设计大赛作品,http://v.youku.com/v_show/id_XNDY2MTY1ODc2.
- 学习计算机一个很好的免费资料下载网站地址(大家学习网论坛)
- delphi idHttp下载文件
- delphi idHttp下载文件
- Delphi传奇之 Delphi/Pascal程序设计教程及学习资源下载汇总
- 闭包有那么难?小弟的一点认识,希望和大家一起学习
- 一个失败的程序,希望大家指点
- 下载各种工具系统程序资源的网站
- 小弟花了两个小时整理了Php方面的一些热门资料,汇总了资料下载地址,有专题,有文档,有源码,希望大家喜欢~
- 想做一个手机点歌的程序,希望大家进来指点
- 苹果优秀软件下载网站推荐 http://www.amegaz.com MAC 软件 游戏 源码 资源 破解 激活
- linux命令学习网站---http://man.linuxde.net/ssh-copy-id
- [DELPHI]idHTTP设置VContinue不能中断下载的原因
- delphi idHttp下载文件