自己写个从网页里下载图片的程序[1]

当你打开某个网页发现上面有很多好看的图片是会怎么办？一个个点另存为？保存网页再慢慢处理？还是跑到IE缓存目录里慢慢COPY呢？由于我经常会遇到这样的问题，所以自己做了个程序下载网页里的图片，代码写的较烂..高手们别笑话哦。

 点键击点另存为下载程序

主窗口单元：

{==========================================}

{=======================================}
{     By Lanyus                                                                   }
{     QQ:231221                                                                 }
{     Email:greathjw [at] 163.com                                   }
{=======================================}
unit UtMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, ComCtrls, PsAPI,shellapi,FileCtrl;

type
  TFmMain = class(TForm)
    BitBtn1: TBitBtn;
    LE1: TLabeledEdit;
    IdHTTP1: TIdHTTP;
    StatusBar1: TStatusBar;
    LE2: TLabeledEdit;
    SpeedButton1: TSpeedButton;
    BitBtn2: TBitBtn;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
 //   procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    PicCount,DownCount:integer;
    ThreadQty:Integer;
    DnQty:Integer;
    { Public declarations }
  end;

var
  FmMain: TFmMain;

implementation

uses UtGetThread;

{$R *.dfm}

procedure TFmMain.BitBtn1Click(Sender: TObject);
var
T:TGetThread;
a:TMemoryStream;
savepath:string;
begin
  Le1.Text:=Trim(Le1.Text);
  SavePath:=FmMain.LE2.Text;
  if SavePath[Length(SavePath)]<>'/' then SavePath:=SavePath+'/';
  if not DirectoryExists(SavePath) then
  begin
    try
      if not ForceDirectories(savepath) then
      begin
        showmessage('保存路径非法');
        EXIT;
      end;
    except
       showmessage('保存路径非法');
       EXIT;
    end;
   // showmessage('保存目录不存在');

  end;
  PicCount:=0;
  DownCount:=0;
  Memo1.Clear;
  T:=TGetThread.Create(False);
end;

procedure TFmMain.SpeedButton1Click(Sender: TObject);
var
dir :string;
begin
if selectDirectory('请选择保存目录','',dir) then le2.Text:=dir;
end;

end.

{====================================}

下载线程单元

{===================================}

{===================================}
{     By Lanyus                                                          }