您的位置:首页 > 理论基础 > 计算机网络

delphi做的idhttp下载具体某个网站资源的程序(希望大家多看看,多给小弟指点指点,有利于小弟学习)

2009-12-29 18:17 567 查看
今天由于需要下载具体某个网站的资源,手动下载很累,所以我就想写个下载的程序来让程序下载

由于初学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;
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: