unit1.pas

用来进行基于Delphi开发语言的HTTP网络通讯的基础模块

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, IdAntiFreezeBase, IdAntiFreeze,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public

  function GetInfoByYearNetHtm1(const str:string):String;
  function GetInfoByYearNetHtm2(const Str:String):String;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
MyStream:TMemoryStream;
begin
IdAntiFreeze1.OnlyWhenIdle:=False;//设置使程序有反应.
MyStream:=TMemoryStream.Create;
try
IdHTTP1.Get('http://www.zhuicha.com/soft/index.htm',MyStream);//下载我站点的一个文件
except//INDY控件一般要使用这种try..except结构.
Showmessage('网络出错!');
MyStream.Free;
Exit;
end;
MyStream.SaveToFile('c:\index.htm');
MyStream.Free;
Showmessage('OK');
end;


procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
ProgressBar1.Max:=AWorkCountMax;
ProgressBar1.Min:=0;
ProgressBar1.Position:=0;
end;


procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
ProgressBar1.Position:=ProgressBar1.Position+AWorkCount;
end;

function TForm1.GetInfoByYearNetHtm1(const str: string): String;
const
SubColor='<font color=red>';
SubCenter1='<center>';
SubCenter2='</center>';
var
S:String;
i,j,k:integer;
begin
Result:='';
S:=str;

j:=0;
repeat
i:=Pos(SubColor,LowerCase(S));
if i=0 then break;
if Length(s)<(i+Length(SubColor)-1) then Break;
Delete(S,1,i+Length(SubColor)-1);

i:=Pos(SubCenter1,LowerCase(S));
if i=0 then break else if i<=10 then j:=-1;
until j=-1;

k:=Pos(SubCenter2,LowerCase(S));
S:=Copy(S,i+Length(SubCenter1),k-i-Length(SubCenter1));

k:=0;
repeat
i:=pos('<',s);
j:=pos('>',s);
if (i=0) or (j=0) then Break;
Delete(s,i,j-i+1);
Insert(' ', S, i);
until k=-1;
s:=s+'.';
Result:=s;
end;
function TForm1.GetInfoByYearNetHtm2(const Str: String): String;
var i,j,k:integer;
begin
Result:=''; 
i:=Pos('url=',Str); 
if i=0 then Exit;
i:=i+4; 
j:=Pos('',Str); 
if i=0 then Exit;
j:=j-2; k:=j-i; 
Result:=copy(Str,i,k); 
end; 


procedure TForm1.Button2Click(Sender: TObject);
var
StrRecive:String;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('正在申请域名!');
try
StrRecive:=IdHTTP1.Get('http://my.yeah.net/cgi-bin/register?username='+Edit1.Text//注册名称
+'&domain=yeah.net'
+'&password='+Edit2.Text//密码1
+'&password2='+Edit3.Text//密码2
+'&email='+Edit4.Text//注册人Email地址
+'&url=http://'+Edit4.Text);//该域名指向的URL
Memo1.Lines.Add(GetInfoByYearNetHtm1(StrRecive));
except
Memo1.Lines.Add('申请域名错误!请检查网络!');
end;
end;


procedure TForm1.Button3Click(Sender: TObject);
var
StrRecive:String;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('正在更新域名!');
try
StrRecive:=IdHTTP1.Get('http://my.yeah.net/cgi-bin/modify?username='+Edit1.Text//注册名称
+'&domain=yeah.net'
+'&password='+Edit2.Text//密码1
+'&url=http://'+Edit4.Text);//该域名指向的URL
Memo1.Lines.Add(GetInfoByYearNetHtm1(StrRecive));
except
Memo1.Lines.Add('更新IP错误!请检查网络!');
end;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin 
try
Memo1.Lines.Add(GetInfoByYearNetHtm2(IdHTTP1.Get(Edit4.Text)));//eg:http://lovejingtao.yeah.net/
except
Memo1.Lines.Add('更新IP错误!请检查网络!');
end;
end;


end.