今天由于需要下载具体某个网站的资源,手动下载很累,所以我就想写个下载的程序来让程序下载

由于初学Delphi,不怕大家笑话,有很多地方都不会或者都写不好,

可以说是写的很垃圾(限于知识面有限,各方面都考虑不到),

所以我把代码发上来,希望各位大侠帮忙给指出程序不足之处,

希望大家多多评论评论,以便有利于小弟学习。

 

 

代码如下:

 

代码
1 procedure TForm5.Button1Click(Sender: TObject);
2  var
3 reg,reg1,reg2,reg3,reg4,reg5:TPerlRegEx;
4 mystream1,mystream2:TMemoryStream;
5 regstr,reg5str,reg4str,thesql:string;
6 a,s:Arrayofstring;
7  begin
8 reg1:=TPerlRegEx.Create(nil);
9 reg1.Subject:=IdHTTP1.get('http://www.sssccc.net/other/caizhi.shtml');
10 reg1.RegEx:= 'http://www.sssccc.net/class/[^\s]*_1.shtml';
11 while reg1.MatchAgain do //遍历每个二级类
12 begin
13 //ShowMessage(reg1.SubExpressions[0]);
14
15 reg:=TPerlRegEx.Create(nil);
16 reg.Subject:=IdHTTP1.get(reg1.SubExpressions[0]);
17 reg.RegEx:='<TITLE>(.|\n)*</TITLE>';//取标题
18 while reg.MatchAgain do
19 begin
20 regstr:=reg.SubExpressions[0];
21 regstr:=Copy(regstr,8,Pos('-',regstr)-8);//获取类别名称
22
23 reg2:=TPerlRegEx.Create(nil);
24 reg2.Subject:=IdHTTP1.get(reg1.SubExpressions[0]);
25 reg2.RegEx:= 'http://www.sssccc.net/source/[^\s]*.shtml';
26 while reg2.MatchAgain do //遍历每个具体资源
27 begin
28 mystream1:=TMemoryStream.Create;
29 mystream2:=TMemoryStream.Create;
30
31 reg5:=TPerlRegEx.Create(nil); //
32 reg5.Subject:=IdHTTP1.get(reg2.SubExpressions[0]);
33 reg5.RegEx:= '<TITLE>(.|\n)*</TITLE>';
34 while reg5.MatchAgain do
35 begin
36
37
38 reg5str:= reg5.SubExpressions[0];
39 reg5str:=Copy(reg5str,8,Pos('-',reg5str)-8); //获取资源名称
40
41 reg3:=TPerlRegEx.Create(nil);
42 reg3.Subject:=IdHTTP1.get(reg2.SubExpressions[0]);
43 reg3.RegEx:= 'http://[^\s]*.jpg';
44 while reg3.MatchAgain do // 查找图片地址
45 begin
46 if not DirectoryExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))) then
47 if not CreateDir('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))) then
48 raise Exception.Create('创建目录出错!');
49 if not DirectoryExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))) then
50 if not CreateDir('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))) then
51 raise Exception.Create('创建目录出错!');
52
53 if not FileExists('e:\材质贴图'+'\'+mymd5(Trim(regstr))+mymd5(trim(reg5str))+'\'+mymd5(trim(reg5str))+'.jpg') then
54 begin
55 try
56 IdHTTP1.Get(reg3.SubExpressions[0],mystream1);
57 finally
58 mystream1.Free;
59 ShowMessage('网络出错');
60
61 end;
62 mystream1.SaveToFile('e:\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))+'\'+mymd5(trim(reg5str))+'.jpg');
63 end;
64 end;
65
66 reg4:=TPerlRegEx.Create(nil); //获取下载地址
67 reg4.Subject:=IdHTTP1.get(reg2.SubExpressions[0]);
68 reg4.RegEx:= 'href="http://www.sssccc.net/download.asp?[^\s]*';
69 while reg4.MatchAgain do
70 begin
71 if not DirectoryExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))) then
72 if not CreateDir('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))) then
73 raise Exception.Create('创建目录出错!');
74 if not DirectoryExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))) then
75 if not CreateDir('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))) then
76 raise Exception.Create('创建目录出错!');
77
78 reg4str:=Copy(reg4.SubExpressions[0],7,Length(reg4.SubExpressions[0])-7);
79
80 if not FileExists('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))+'\'+mymd5(trim(reg5str))+'.zip') then
81 begin
82 try
83 IdHTTP1.Get(reg4str,mystream2);
84 finally
85 mystream2.Free;
86 ShowMessage('网络出错');
87
88 end;
89 mystream2.SaveToFile('e:'+'\材质贴图'+'\'+mymd5(Trim(regstr))+'\'+mymd5(trim(reg5str))+'\'+mymd5(trim(reg5str))+'.zip');
90
91 thesql:=' insert into storage2 (dir1,dir2,dir3,eng_dir2,eng_dir3,filename) ';
92 thesql:=thesql+' values (''材质贴图'','''+trim(regstr)+''','''+trim(reg5str)+''','''+mymd5(Trim(regstr))+''','''+mymd5(Trim(reg5str))+''','''+mymd5(Trim(reg5str))+''' ) ';
93 a:=excsql(thesql,g_mydbcenterName);
94 end;
95 end;
96
97 reg3.Free;
98 reg4.Free;
99
100 end;
101 reg5.Free;
102 mystream1.Free;
103 mystream2.Free;
104
105 end;
106
107 reg2.Free;
108 end;
109  reg.Free;
110 end;
111
112 reg1.Free;
113
114
115  end;
116  

 

posted on 2009-12-29 18:17  FreeSpider  阅读(2020)  评论(1编辑  收藏  举报