delphi版淘小宝图片下载工具

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 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/