unit1.~pas

获得网站html

unit Unit1;

interface

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

type
  MTHtml = class(TThread)
    procedure ieWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure ieWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    protected
      { Private declarations }
      MWebURL: String;
      MMemo1, MMemo2: TMemo;
      SkyG: TSkyGuage;
      MSD: TSaveDialog;
      procedure Execute;OverRide;
    private
      Mhtml: String;
      ACMax, AWCount: integer;
      ie: TIdHTTP;
      Procedure updateMemo;
      Procedure updatemax;
      Procedure updateCount;
      { Private declarations }
    public
      { Public declarations }
      Constructor Create(WebUrl: String; sMemo1, sMemo2: TMemo; MSkyG: TSkyGuage; MTSD: TSaveDialog);
    end;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Panel1: TPanel;
    Label1: TLabel;
    Splitter1: TSplitter;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    Memo2: TMemo;
    StatusBar1: TStatusBar;
    Panel2: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    SkyGuage1: TSkyGuage;
    SaveDialog1: TSaveDialog;
    Label2: TLabel;
    website: TComboBox;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  SGThread: MTHtml;

implementation

{$R *.dfm}

procedure MTHtml.Execute;
begin
  Mhtml := '';
  ie:=TIdHTTP.Create(nil);
  Synchronize(updateMemo);
  try
    Mhtml := ie.Get(MWebURL);
  finally
    if pos('text', LowerCase(ie.Response.ContentType)) = 0 then
    begin
      Mhtml:='下载是二进制文件！';
{        if MessageDlg('下载是二进制文件'+#13+#10+'是否保存？', mtConfirmation,
        [mbOk, mbCancel], 0) = mrOk then
        begin
          if SaveDialog1.Execute then
          begin
            if IdHTTP1.Response.ContentType='application/x-gzip' then
              fileExt := 'zip'
            else if IdHTTP1.Response.ContentType='image/x-icon' then
              fileExt := 'ico'
            else if IdHTTP1.Response.ContentType='image/gif' then
              fileExt := 'gif'
            else if IdHTTP1.Response.ContentType='application/x-shockwave-flash' then
              fileExt := 'swf'
            else if IdHTTP1.Response.ContentType='image/jpeg' then
              fileExt := 'jpg';
//            SaveDialog1
            savefile.SaveToFile(SaveDialog1.FileName);
          end;
        end;   }
    end;
  Synchronize(updateMemo);
  end;
  FreeAndNil(ie);
end;

Procedure MTHtml.updateMemo;
begin
  MMemo1.Text:=Mhtml;
  MMemo2.Text:=ie.Response.RawHeaders.Text;
end;

Constructor MTHtml.Create(WebUrl: String; sMemo1, sMemo2: TMemo; MSkyG: TSkyGuage; MTSD: TSaveDialog);
begin
  FreeOnTerminate:=True;
  MWebURL:=WebUrl;
  MMemo1:=sMemo1;
  MMemo2:=sMemo2;
  SkyG:=MSkyG;
  MSD:=MTSD;
  Inherited Create(False);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure MTHtml.ieWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  AWCount:=AWorkCount;
  Synchronize(updateCount);
end;

procedure MTHtml.updateCount;
begin
  SkyG.Progress:=AWCount;
end;

procedure MTHtml.ieWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  ACMax:=AWorkCountMax;
  Synchronize(updatemax);
end;

procedure MTHtml.updatemax;
begin
  SkyG.Max:= ACMax;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if website.Text <> '' then
  begin
    Memo1.Clear;
    Memo2.Clear;
    SGThread:=MTHtml.Create(website.Text,Memo1,Memo2,SkyGuage1,SaveDialog1);
    if website.Items.IndexOf(website.Text)>=0 then
      website.Items.Move(website.Items.IndexOf(website.Text),0)
    else website.Items.Add(website.Text);
    website.ItemIndex:=0;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  website.Items.SaveToFile('.\urls.txt');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  website.Items.LoadFromFile('.\urls.txt');
  website.ItemIndex:=0;
end;

end.