今天由于需要下载具体某个网站的资源,手动下载很累,所以我就想写个下载的程序来让程序下载
由于初学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
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