unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,PerlRegEx,StrUtils;
type TForm1 = class(TForm) Memo1: TMemo; ProgressBar1: TProgressBar; Button1: TButton; IdHTTP1: TIdHTTP; Button2: TButton; OpenDialog1: TOpenDialog; Label1: TLabel; procedure Button1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1; hHand1:THandle; threadID1:DWORD; strList1:TStringList; function downpic(p:Pointer):integer;stdcall;
implementation
{$R *.dfm} //{$APPTYPE CONSOLE}
function downpic(p:Pointer):integer;stdcall; var myStream1:TMemoryStream; I: Integer; picname:string; filepath:string; pi1:Integer; begin //down image filepath:=ExtractFilePath(Application.ExeName);
//初始化idhttp form1.IdHTTP1:=TIdHTTP.Create(nil); form1.IdHTTP1.ReadTimeout:=24000; form1.IdHTTP1.ConnectTimeout:=24000; form1.IdHTTP1.Request.UserAgent:='Mozilla/4.0 '+ '(compatible;MSIE 6.0; Windows NT 5.0; '+ '.NET CLR 1.1.4322)'; //初始化进度条 Form1.ProgressBar1.Max:=strList1.Count;
myStream1:=TMemoryStream.Create; for I := 0 to strList1.Count - 1 do begin
try
Form1.IdHTTP1.Get(strList1[i],myStream1); //http://www21.tx8.cn/photo/youran362/2010120171717387.jpg pi1:=LastDelimiter('/',strList1[i]); picname:=RightStr(strList1[i],Length(strList1[i])-pi1); //Writeln(picname); form1.Label1.Caption:=picname; myStream1.SaveToFile(filepath+'\'+picname); except on E:Exception do begin form1.Label1.Caption:=e.Message; end;
end; form1.ProgressBar1.Position:=I; end; form1.IdHTTP1.Disconnect; form1.IdHTTP1.Free; myStream1.Free; form1.Label1.Caption:= '所有图片下载完成!';
end;
procedure TForm1.Button1Click(Sender: TObject); var reg:TPerlRegEx;
begin strList1:=TStringList.Create; //down img if(length(memo1.Text)<5) then exit; //正则分析链接 reg:=TPerlRegEx.Create(nil); reg.Subject:=form1.Memo1.Text; reg.RegEx:='<img\s+src=([\w:/\.]+)';
while reg.MatchAgain do begin //writeln(reg.SubExpressions[1]); strList1.Add(reg.SubExpressions[1]); end; //启动下载线程 hHand1:=CreateThread(nil,0,@downpic,nil,0,threadID1);
end;
procedure TForm1.Button2Click(Sender: TObject); var //opendialog1:TOpenDialog; str1:string;
begin opendialog1.Filter:='文本文件|*.txt'; opendialog1.InitialDir:=ExtractFilePath(Application.ExeName); if opendialog1.Execute then begin
form1.Memo1.Lines.LoadFromFile(form1.OpenDialog1.FileName); end;
end;
procedure TForm1.FormShow(Sender: TObject); begin form1.Memo1.Text:=''; end;
end.
源代码下载: http://www.rayfile.com/files/5934e20a-1440-11df-8449-0015c55db73d/
hackpig 标签: 开发手记, delphi代码
|
请发表评论