IdHttp 资料

http://blog.csdn.net/delphizhou/article/details/3085704

IdHttp 资料 网上找了些不过很不好找.今天找了些收藏在一起.以便他人查阅,

idhttp上传

先引用MsMultiPartFormData单元，在f:/code/delphi/component/下

通用的函数
{*******************************************************************************
使用INDY IDHTTP上传
idHTTP   TIdHTTP
URL      URL of upload file address
FiledName,FieldValues,FieldnFiles,FieldvFiles array of string
returnvalue 用于比较返回值以比较返回正确性
}
function HttpUpload(idHTTP:TIdHTTP;URL:String;FieldNames, FieldValues,
FieldnFiles, FieldvFiles: array of string;ReturnValue:String='1'):Boolean;
var
responseStream: TStringStream;
mpfSource: TMsMultiPartFormDataStream;

i:integer;
n, v:String;
begin
result:=false;

mpfSource := TMsMultiPartFormDataStream.Create;
responseStream := TStringStream.Create('');
try

idHTTP.Request.ContentType := mpfSource.RequestContentType;
    //解析字段名
    for i := Low(FieldNames) to High(FieldNames) do
    begin
      n := FieldNames[i];
      v := FieldValues[i];
      mpfSource.AddFormField(n, v);
    end;

//解析需要上传的文件名和文件地址
    for i := Low(FieldnFiles) to High(FieldnFiles) do
    begin
      n := FieldnFiles[i];
      v := FieldvFiles[i];
      mpfSource.AddFile(n,v, 'Content-Type: image/pjpeg');
    end;
    mpfSource.PrepareStreamForDispatch;
    mpfSource.Position := 0;
    try
      idHTTP.Post(URL, mpfSource, responseStream);
      result:=returnvalue=trim(responseStream.DataString);
    except

end;
finally
    mpfSource.free;
    responseStream.free;
end;
end;

调用方法：

HttpUpload(idhttp1,'http://192.168.50.98:9999/tmpuploadpic.do',['username','resource'],['oranje','gocom'],['file'],['c:/123.bmp'],'1');

procedure TForm1.TntBitBtn1Click(Sender: TObject);
const
BaseURL   = 'http://192.168.50.98:9999/tmpuploadpic.do';      //论坛所在地址
var
responseStream: TStringStream;
mpfSource: TMsMultiPartFormDataStream;
a:String;
begin
mpfSource := TMsMultiPartFormDataStream.Create;
responseStream := TStringStream.Create('');
try

IdHTTP.Request.ContentType := mpfSource.RequestContentType;
    mpfSource.AddFormField('username', 'oranje');
    mpfSource.AddFormField('resource', 'xxxx');
    //mpfSource.AddFormField('file', 'C:/Documents and Settings/Administrator/My Documents/GoCom/image/wow3/Water lilies.jpg');
    mpfSource.AddFile('file','C:/Documents and Settings/Administrator/My Documents/GoCom/image/wow3/Water lilies.jpg', 'Content-Type: image/pjpeg');
    mpfSource.PrepareStreamForDispatch;
    mpfSource.Position := 0;
    try
      IdHTTP.Post(BaseURL, mpfSource, responseStream);
      //这里a是返回值，即页面上打出来的值
      a:=trim(responseStream.DataString);
      showmessage(a);
    except

end;

finally
    mpfSource.free;
    responseStream.free;

=============================================================================================

idHTTP最简洁的修改和取得Cookie例子

procedure TForm1.Button1Click(Sender: TObject);
var
HTTP: TidHTTP;
html, s: string;
i: integer;
begin
HTTP := TidHTTP.Create(nil);
try
HTTP.HandleRedirects := True;
HTTP.AllowCookies := True;
HTTP.Request.CustomHeaders.Values['Cookie'] := 'abcd';//修改Cookie 抓包可见
html := HTTP.Get('http://www.baidu.com/');

s := 'Cookies: ';
if HTTP.CookieManager.CookieCollection.Count > 0 then
for i := 0 to HTTP.CookieManager.CookieCollection.Count - 1 do
s := s + HTTP.CookieManager.CookieCollection.Items[i].CookieText;
Memo1.Lines.Add(s);//取得Cookie
finally
FreeAndNil(HTTP);
end;
end;
//------------------------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdCookieManager, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP;

type
TForm1 = class(TForm)
IdHTTP1: TIdHTTP;
IdCookieManager1: TIdCookieManager;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
Params: TStringList;
HTML, loginurl, myuser: String;
count,i:integer;
_cookies, cookies:tstringlist;
ll:boolean;
name,value:String;

procedure setcookies;
var j:integer; s:string;
begin
count:=cookies.count;
s:='';
for j:=1 to count do
begin
IdCookieManager1.AddCookie(cookies[j-1],IdHTTP1.url.Host);
s:=s+'; '+cookies[j-1];
end;
if s<>'' then
begin
delete(s,1,2);
s:=s+';';
IdHTTP1.Request.CustomHeaders.Values['Cookie']:=s;
IdHTTP1.Request.RawHeaders.Values['Cookie']:=s;
//('Cookie'+IdHTTP1.Request.RawHeaders.NameValueSeparator+s);
end;{}
end;

procedure extractcookie(cookie:string; var name,value:string);
var i,k:integer;
begin
i:=pos('=',cookie);
k:=pos(';',cookie);
if k=0 then k:=length(cookie);
if i>0 then
begin
name:=copy(cookie,1,i-1);
value:=copy(cookie,i+1,k-i-1);
end else
begin
name:='';
value:='';
end;
end;

procedure savecookies;
var j:integer;
begin
count:=IdCookieManager1.CookieCollection.count;
for j:=1 to count do
begin
extractcookie(IdCookieManager1.CookieCollection.Items[j-1].CookieText,name,value);
cookies.Values[name]:=value;
end;
// IdCookieManager1.CookieCollection.Clear;
end;

procedure saveit(name:string);
begin
with tfilestream.create(name,fmcreate) do
try
write(pansichar(html)^,length(html));
finally
free;
end;
end;

begin
ll:=false;
loginurl:='http://feedmelinks.com/login';
Params := TStringList.Create;
try
cookies:=tstringlist.Create;
// cookies.Duplicates:=dupIgnore;
// cookies.Sorted:=true;

idhttp1.Host:='feedmelinks.com';
html:=idhttp1.Get('http://feedmelinks.com/');// first get; get first cookie(s)
savecookies;

setcookies;
html:=idhttp1.Get(loginUrl);// next get; this is clean: used for retrieving the viewstate
savecookies;

myuser:='crystyignat';
Params.Values['userId'] := myuser;
Params.Values['password'] := 'mypassword';
Params.Values['op'] := 'login';

IdHTTP1.HandleRedirects:=false;// now this made the buzz, because the cookies were not set when following the redirect
try
setcookies;
HTML := IdHTTP1.Post(loginurl, Params);// now do the log in

_Cookies := TStringList.Create;
IdHTTP1.Response.RawHeaders.Extract('Set-cookie', _Cookies);
for i := 0 to _Cookies.Count - 1 do
begin
// IdCookieManager1.AddCookie(_Cookies[i], IdHTTP1.URL.Host);
extractcookie(_Cookies[i],name,value);
cookies.Values[name]:=value;
end;
_cookies.free;
// savecookies;

if pos('<div class="welcome">Welcome, <b>'+myuser+'</b>',html)>0 then
begin
setCookies;
html:=idhttp1.Get('http://feedmelinks.com/'); // software redirect
savecookies;

saveit('hhh.html');

// setCookies;
// html:=idhttp1.Get('http://feedmelinks.com/portal'); // another software redirect
//savecookies;

ll:=pos('<a class="tn" href="logout">log out',html)>0;
end;
except on e: EIdHTTPProtocolException do
begin
if e.ReplyErrorCode<>302 then
raise e;
// now this is the redirect
count:=IdCookieManager1.CookieCollection.count;// get the next cookie (this will be the userid)
for i:=1 to count do
cookies.Add(IdCookieManager1.CookieCollection.Items[i-1].CookieText);

setcookies;
html:=idhttp1.Get(IdHTTP1.Response.Location);// follow redirect
end;
end;

cookies.free;
except on e: EIdHTTPProtocolException do
begin
showmessage(idHTTP1.response.ResponseText);
end;
end;
Params.Free;
showmessage('logged in? : '+booltostr(ll,true));
end;

end.

=============================================================================================

IdHTTP造成程序假死的解决办法

在程序中使用了IdHTTP的话，在执行Get或Post过程的时候，程序界面会无法响应，造成程序假死，但在任务管理器中又能看到程序正在运行。

这是因为Indy系统组件都使用了阻塞式Sock，阻塞式Sock的缺点就是使客户程序的用户界面“冻结”。当在程序的主线程中进行阻塞式Socket调用时，由于要等待Socket调用完成并返回，这段时间就不能处理用户界面消息，使得Update、Repaint以及其它消息得不到及时响应，从而导致用户界面被“冻结”，就是常说的“程序假死”。

解决办法有两种：

1.在程序中放一个IdAntiFreeze控件，个人使用中发现把IdAntiFreeze控件的OnlyWhenIdle置为False，效果会更好。

2.将IdHTTP放进线程，在线程中动态建立IdHTTP控件来使用。

第一种办法使用简单，但程序界面的响应还是会有些延迟感。

第二种办法使用后，程序的表现十分好，感觉不到延迟。不过因为涉及到线程的操作，使用起来比第一种办法要麻烦一点。

=============================================================================================

用idhttp提交cookie

以前不管是做什么软件，只要是关于网页post提交cookie的，我都是用TcpClient，为什么呢？
因为我一直找不到idhttp提交Cookie的方法，今天终于有了结果。

在Idhttp中，要想修改Cookie的代码，就要用到Request的RawHeaders中的Values值。
这个值怎么用呢？
Values接受一个string的值，该值指定了所访问的变量。
如HTTP头是这样定义的(其中一些)：
Accept-Language: zh-cn
Content-Type: application/x-www-form-urlencoded
Accept-Encoding: gzip, deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; 
Cookie: JSESSIONID=aoOYvjM-IKzh 
而Values的值就可以是Cookie，User-Agent，Accept-Encoding……等等。

所以，代码应该是这样：
try
idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值'; //
memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
idhttp1.Post('/webmail/login.jsp',data1,data2);
memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
idhttp1.Request.RawHeaders.Values['Cookie'] := 'asdfasdf';
memo1.Lines.Add(idhttp1.Request.RawHeaders.Text);
except
idhttp1.Get(idhttp1.Response.Location, data1);
end; 
初一看，这代码是没有什么问题的。但，memo1的第一次ADD并没有任何值，奇怪。
而第三次ADD就被改为了'asdfasdf'，正是我们所希望的。
我正是卡在了这里。为什么第一次idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值'; 没有结果呢？

搞了很久。我才发现，在第一次传值的时候，RawHeaders跟本没有被初始化。而第三次经过Post以后，RawHeaders被初始化了，所以得到了我们所要的结果。
也就是说，在写漏洞上传程序这些的时候，如果先Post让RawHeaders初始化，那就没什么意义了，因为Post的时候，Cookie就不能被带上了。

正确的代码应该是这样：
try
idhttp1.Request.SetHeaders; //最重要的初始化。
idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值';
idhttp1.Post('/webmail/login.jsp',data1,data2);
except
idhttp1.Get(idhttp1.Response.Location, data1);
end;

这里，最重要的初始化是必需的。
idhttp1.Request.SetHeaders
这个过程如果没有。就会出错。

=============================================================================================

Delphi中使用IdHTTP来访问基于SSL协议的网站

今天有人问我使用idhttp如何去访问ssl协议的网站

很简单

在界面上放一个TIdHTTP控件，命名为IdHTTP1

再放一个TIdSSLIOHandlerSocket控件，命名为IdSSLIOHandlerSocket1

将IdHTTP1的IOHandler属性设为IdSSLIOHandlerSocket1

这样就可以随意的Get,Post那些地址为https开头的网站了

不过这样仍然不行，当运行程序时，会报错“Could not load SSL library”

这是因为TIdSSLIOHandlerSocket控件需要OpenSSL Library来配合

OpenSSL Library包含有两个动态链接库libeay32.dll和ssleay32.dll

据说因为OpenSSL Library中包含有安全方面的一些加密算法，所以美国政府把它列为禁止出口的产品，所以indy中并没有带上这两个文件

到网上搜索一下，很多地方都有下载，下回来放在程序目录里，就可以正常的使用IdHTTP来访问基于SSL协议的网站了

下面是网上找到的相关资料：

SSL (Secure Socket Layer)
为Netscape所研发，用以保障在Internet上数据传输之安全，利用数据加密(Encryption)技术，可确保数据在网络
上之传输过程中不会被截取及窃听。目前一般通用之规格为40 bit之安全标准，美国则已推出128 bit之更高安全
标准，但限制出境。只要3.0版本以上之I.E.或Netscape浏览器即可支持SSL。 
当前版本为3.0。它已被广泛地用于Web浏览器与服务器之间的身份认证和加密数据传输。
SSL协议位于TCP/IP协议与各种应用层协议之间，为数据通讯提供安全支持。SSL协议可分为两层： SSL记录协议（SSL Record Protocol）：它建立在可靠的传输协议（如TCP）之上，为高层协议提供数据封装、压缩、加密等基本功能的支持。 SSL握手协议（SSL Handshake Protocol）：它建立在SSL记录协议之上，用于在实际的数据传输开始前，通讯双方进行身份认证、协商加密算法、交换加密密钥等。

SSL协议提供的服务主要有：
1）认证用户和服务器，确保数据发送到正确的客户机和服务器；
2）加密数据以防止数据中途被窃取；
3）维护数据的完整性，确保数据在传输过程中不被改变。

SSL协议的工作流程：
服务器认证阶段：1）客户端向服务器发送一个开始信息“Hello”以便开始一个新的会话连接；2）服务器根据客户的信息确定是否需要生成新的主密钥，如需要则服务器在响应客户的“Hello”信息时将包含生成主密钥所需的信息；3）客户根据收到的服务器响应信息，产生一个主密钥，并用服务器的公开密钥加密后传给服务器；4）服务器恢复该主密钥，并返回给客户一个用主密钥认证的信息，以此让客户认证服务器。
用户认证阶段：在此之前，服务器已经通过了客户认证，这一阶段主要完成对客户的认证。经认证的服务器发送一个提问给客户，客户则返回（数字）签名后的提问和其公开密钥，从而向服务器提供认证。
从SSL 协议所提供的服务及其工作流程可以看出，SSL协议运行的基础是商家对消费者信息保密的承诺，这就有利于商家而不利于消费者。在电子商务初级阶段，由于运作电子商务的企业大多是信誉较高的大公司，因此这问题还没有充分暴露出来。但随着电子商务的发展，各中小型公司也参与进来，这样在电子支付过程中的单一认证问题就越来越突出。虽然在SSL3.0中通过数字签名和数字证书可实现浏览器和Web服务器双方的身份验证，但是SSL协议仍存在一些问题，比如，只能提供交易中客户与服务器间的双方认证，在涉及多方的电子交易中，SSL协议并不能协调各方间的安全传输和信任关系。在这种情况下，Visa和 MasterCard两大信用卡公组织制定了SET协议，为网上信用卡支付提供了全球性的标准。

https介绍
HTTPS（Secure Hypertext Transfer Protocol）安全超文本传输协议 
它是由Netscape开发并内置于其浏览器中，用于对数据进行压缩和解压操作，并返回网络上传送回的结果。HTTPS实际上应用了Netscape的完全套接字层（SSL）作为HTTP应用层的子层。（HTTPS使用端口443，而不是象HTTP那样使用端口80来和TCP/IP进行通信。）SSL使用40 位关键字作为RC4流加密算法，这对于商业信息的加密是合适的。HTTPS和SSL支持使用X.509数字认证，如果需要的话用户可以确认发送者是谁。。
https是以安全为目标的HTTP通道，简单讲是HTTP的安全版。即HTTP下加入SSL层，https的安全基础是SSL，因此加密的详细内容请看SSL。
它是一个URI scheme(抽象标识符体系)，句法类同http:体系。用于安全的HTTP数据传输。https:URL表明它使用了HTTP，但HTTPS存在不同于HTTP的默认端口及一个加密/身份验证层（在HTTP与TCP之间）。这个系统的最初研发由网景公司进行，提供了身份验证与加密通讯方法，现在它被广泛用于万维网上安全敏感的通讯，例如交易支付方面。
限制
它的安全保护依赖浏览器的正确实现以及服务器软件、实际加密算法的支持.
一种常见的误解是“银行用户在线使用https:就能充分彻底保障他们的银行卡号不被偷窃。”实际上，与服务器的加密连接中能保护银行卡号的部分，只有用户到服务器之间的连接及服务器自身。并不能绝对确保服务器自己是安全的，这点甚至已被攻击者利用，常见例子是模仿银行域名的钓鱼攻击。少数罕见攻击在网站传输客户数据时发生，攻击者尝试窃听数据于传输中。
商业网站被人们期望迅速尽早引入新的特殊处理程序到金融网关，仅保留传输码(transaction number)。不过他们常常存储银行卡号在同一个数据库里。那些数据库和服务器少数情况有可能被未授权用户攻击和损害。

=============================================================================================

Delphi编程中Http协议应用 -- idhttp

Delphi编程中Http协议应用

来源：大富翁

Http协议的通信遵循一定的约定.例如,请求一个文件的时候先发送Get请求,然后服务器会返回请求的数据.如果需要进行断点传输,那么先发送HEAD /请求,其中返回的Content-Length: 就是文件实际大小.将其和我们本地需要断点下载的文件大小比较,发送GET请求和发送需要下载的文件开始位置RANGE: bytes=+inttostr(iFilePos)+-+#13#10;服务器如果支持断点下载的话就会接着发送余下的数据了.因为这方面的文章比较多,我在这里就不详细讲述了.感兴趣的朋友可以自行查阅相关资料或者RFC文档。

当然,如果你是个懒人,也可以直接采用Delphi自带的控件.以Delphi6的INDY组件为例.新建一个工程,放上一个TIdHTTP控件,一个TIdAntiFreeze控件,一个TProgressBar用于显示下载进度.最后放上一个TButton用于开始执行我们的命令.代码如下:

procedure TForm1.Button1Click(Sender: TObject);//点击按钮的时候开始下载我们的文件
var
MyStream:TMemoryStream;
begin
IdAntiFreeze1.OnlyWhenIdle:=False;//设置使程序有反应.
MyStream:=TMemoryStream.Create;
try
IdHTTP1.Gethttp://www.138soft.com/download/Mp3ToExe.zip,MyStream);//下载我站点的一个ZIP文件
except//INDY控件一般要使用这种try..except结构.
Showmessage(网络出错!);
MyStream.Free;
Exit;
end;
MyStream.SaveToFile(c:/Mp3ToExe.zip);
MyStream.Free;
Showmessage(OK);
end;

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.
begin
ProgressBar1.Max:=AWorkCountMax;
ProgressBar1.Min:=0;
ProgressBar1.Position:=0;
end;

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);//接收数据的时候,进度将在ProgressBar1显示出来.
begin
ProgressBar1.Position:=ProgressBar1.Position+AWorkCount;
end;

IdHTTP1的Get还有一种形式就是获取字符串:例如,上面的程序可以改写成:

procedure TForm1.Button1Click(Sender: TObject);
var
MyStr:String;
begin
IdAntiFreeze1.OnlyWhenIdle:=False;//设置使程序有反应.
try
MyStr:=IdHTTP1.Gethttp://www.138soft.com/default.htm);
except
Showmessage(网络出错!);
Exit;
end;
Showmessage(MyStr);
end;

应用:现在很多程序都有自动升级功能,实际上就是应用了GET.先在自己站点放一个文本文件注明程序版本号,当检查升级的时候,取文本内容与当前版本号比较,然后决定升级与否.

转的目的是为了试试进度条的效果.

=============================================================================================

IDHttp的基本用法

IDHttp和WebBrowser一样，都可以实现抓取远端网页的功能，但是http方式更快、更节约资源，缺点是需要手动维护cook，连接等

IDHttp的创建，需要引入IDHttp

procedure InitHttp();
begin
    http := TIdHTTP.Create(nil);
    http.ReadTimeout := 30000;
    http.OnRedirect := OnRedirect;
    http.Request.Accept := 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, */*';
    http.Request.AcceptLanguage := 'zh-cn';
    http.Request.ContentType := 'application/x-www-form-urlencoded';
    http.Request.UserAgent := 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; Maxthon; .NET CLR 1.1.4322)';

http.ProxyParams.ProxyServer := '代理服务器地址';
    http.ProxyParams.ProxyPort := '代理服务器端口';
end;

如何取得服务端返回的cookie信息，并添加到http的request对象中

procedure Setcookie;
var
i: Integer;
tmp, cookie: String;
begin
cookie := '';
for i := 0 to http.Response.RawHeaders.Count - 1 do
begin
    tmp := http.Response.RawHeaders[i];
    if pos('set-cookie: ', LowerCase(tmp)) = 0 then Continue;
    tmp := Trim(Copy(tmp, Pos('Set-cookie: ', tmp) + Length('Set-cookie: '), Length(tmp)));
    tmp := Trim(Copy(tmp, 0, Pos(';', tmp) - 1));
    if cookie = '' then cookie := tmp else cookie := cookie + '; ' + tmp;
end;
if cookie <> '' then
begin
    for i := 0 to http.Request.RawHeaders.Count - 1 do
    begin
      tmp := http.Request.RawHeaders[i];
      if Pos('cookie', LowerCase(tmp)) = 0 then Continue;
      http.Request.RawHeaders.Delete(i);
      Break;
    end;
    http.Request.RawHeaders.Add('cookie: ' + cookie);
end;
end;

如何取得网页中的所有连接，对代码做修改你也可以实现查找所有图片等等， QStrings.rar(79K) (点击下载)在这里推荐使用QString来实现文本替换、查找等功能，附件里有下载。

function GetURLList(Data: String): TStringList;
var
i: Integer;
List: TStringList;
tmp: String;

function Split(Data, Node: String): TStringList;
var
   Count, i, j: Integer;
    function GetFieldCount(Data, Node: String): Integer;
    var
     i: Integer;
   begin
    Result := -1;
     i := Pos(Node, Data);
      if i = 0 then Exit;
     Result := 0;
    while i <> 0 do
     begin
      Inc(Result);
       Delete(Data, 1, i + Length(Node) - 1);
      i := Pos(Node, Data);
    end;
   end;
begin
Result := TStringList.Create;
Count := GetFieldCount(Data, Node);
for i := 0 to Count - 1 do
begin
    j := Pos(Node, Data);
    Result.Add(Copy(Data, 1, j - 1));
    Delete(Data, 1, j + Length(Node) - 1);
end;
Result.Add(Data);
end;
begin
Result := TStringList.Create;
try
    List := split(Data, 'href=');
    for i := 1 to List.Count - 1 do
    begin
      tmp := List[i];
      tmp := Copy(tmp, 0, Pos('</a>', tmp) - 1);
      tmp := Copy(tmp, 0, Pos('>', tmp) - 1);
      if Pos(' ', tmp) <> 0 then tmp := Copy(tmp, 0, Pos(' ', tmp) - 1);
      tmp := Q_ReplaceStr(tmp, Char(34), '');
      tmp := Q_ReplaceStr(tmp, Char(39), '');
      if not Compare(CI.Key, tmp) then Continue;
      if Copy(tmp, 1, 7) <> 'http://' then
      begin
        if Copy(tmp, 1, 1) = '.' then tmp := StringReplace(tmp, '.', '', []);
        if Copy(tmp, 1, 1) = '.' then tmp := StringReplace(tmp, '.', '', []);
        try
          tmp := 'http://' + http.URL.Host + ':' + http.URL.Port + http.URL.Path + tmp;
        except
        end;
      end;
      if Result.IndexOf(tmp) <> -1 then Continue;
      Result.Add(tmp);
    end;
    FreeAndNil(List);
except

end;
end;

如何模拟http的get方法打开一个网页

function GetMethod(http: TIDhttp; URL: String; Max: Integer): String;
var
RespData: TStringStream;
begin
RespData := TStringStream.Create('');
try
    try
      Http.Get(URL, RespData);
      Http.Request.Referer := URL;
      Result := RespData.DataString;
    except
      Dec(Max);
      if Max = 0 then
      begin
        Result := '';
        Exit;
      end;
      Result := GetMethod(http, URL, Max);
    end;
finally
    FreeAndNil(RespData);
end;
end;

如何模拟http的post方法提交一个网页

function PostMethod(URL, Data: String; max: Integer): String;
var
PostData, RespData: TStringStream;
begin
RespData := TStringStream.Create('');
PostData := TStringStream.Create(Data);
try
    try
      if http = nil then Exit;
      Http.Post(URL, PostData, RespData);
      Result := RespData.DataString;
      http.Request.Referer := URL;
    except
      Dec(Max);
      if Max = 0 then
      begin
        Result := '';
        Exit;
      end;
      Result := PostMethod(URL, Data, Max);
    end;
finally
    http.Disconnect;
    FreeAndNil(RespData);
    FreeAndNil(PostData);
end;
end;

程序写好了，如何调试？这里推荐一个小工具 httplook.part1.rar(782K) (点击下载)httplook.part2.rar(243K) (点击下载)，可以监视你的流程是否正确

总结：IDHttp的基本用法已经讲解完毕，其实通过IDHttp返回的就是2个东西，网页的header和网页的body，网页的header中包含了cookie、跳转等信息，body中就包含了内容，我们写程序就是通过查找、拷贝、替换等方式把其中的关键数据找出来，然后做处理，说简单了就是考验你的字符串操作能力。

=============================================================================================

IdHTTP多线程下载

IdHTTP多线程下载
unit Unit1;

interface

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

type
TThread1 = class(TThread)

private
    fCount, tstart, tlast: integer;
    tURL, tFile, temFileName: string;
    tResume: Boolean;
    tStream: TFileStream;
protected
    procedure Execute; override;
public
    constructor create1(aURL, aFile, fileName: string; bResume: Boolean; Count,
      start, last: integer);
    procedure DownLodeFile(); //下载文件
end;

type
TForm1 = class(TForm)
    IdAntiFreeze1: TIdAntiFreeze;
    IdHTTP1: TIdHTTP;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    IdThreadComponent1: TIdThreadComponent;
    Label1: TLabel;
    Label2: TLabel;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;

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 IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure Button3Click(Sender: TObject);
private
public
    nn, aFileSize, avg: integer;
    MyThread: array[1..10] of TThread;
    procedure GetThread();
    procedure AddFile();
    function GetURLFileName(aURL: string): string;
    function GetFileSize(aURL: string): integer;
end;

var
Form1: TForm1;

implementation
var
AbortTransfer: Boolean;
aURL, aFile: string;

tcount: integer; //检查文件是否全部下载完毕
{$R *.dfm}

//get FileName

function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin //返回下载地址的文件名

s := aURL;
i := Pos('/', s);
while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了
begin
    Delete(s, 1, i);
    i := Pos('/', s);
end;
Result := s;
end;

//get FileSize

function TForm1.GetFileSize(aURL: string): integer;
var
FileSize: integer;
begin
IdHTTP1.Head(aURL);
FileSize := IdHTTP1.Response.ContentLength;
IdHTTP1.Disconnect;
Result := FileSize;
end;

//执行下载

procedure TForm1.Button1Click(Sender: TObject);
var
j: integer;
begin
tcount := 0;
Showmessage('OK!主线程在执行，获得文件名并显示在Edit2中');
aURL := Edit1.Text; //下载地址
aFile := GetURLFileName(Edit1.Text); //得到文件名
nn := StrToInt(Edit2.Text); //线程数
j := 1;
aFileSize := GetFileSize(aURL);
avg := trunc(aFileSize / nn);
begin
    try
      GetThread();
      while j <= nn do
      begin
        MyThread[j].Resume; //唤醒线程
        j := j + 1;
      end;
    except
      Showmessage('创建线程失败!');
      Exit;
    end;
end;
end;

//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.

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

//接收数据的时候,进度将在ProgressBar1显示出来.

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin
    IdHTTP1.Disconnect; //中断下载
end;
ProgressBar1. AWorkCount;
//ProgressBar1.; //*******显示速度极快
Application.ProcessMessages;
//***********************************这样使用不知道对不对

end;

//中断下载

procedure TForm1.Button2Click(Sender: TObject);
begin
AbortTransfer := True;
IdHTTP1.Disconnect;
end;

//状态显示

procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
end;

//退出程序

procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;

end;

//循环产生线程

procedure TForm1.GetThread();
var
i: integer;
start: array[1..100] of integer;
last: array[1..100] of integer;   //改用了数组，也可不用
fileName: string;
begin
i := 1;
while i <= nn do
begin
    start[i] := avg * (i - 1);
    last[i] := avg * i -1; //这里原先是last:=avg*i;
    if i = nn then
    begin
      last[i] := avg*i + aFileSize-avg*nn; //这里原先是aFileSize
    end;
    fileName := aFile + IntToStr(i);
    MyThread[i] := TThread1.create1(aURL, aFile, fileName, false, i, start[i],
      last[i]);
    i := i + 1;
end;
end;

procedure TForm1.AddFile(); //合并文件
var
mStream1, mStream2: TMemoryStream;
i: integer;
begin
i := 1;
mStream1 := TMemoryStream.Create;
mStream2 := TMemoryStream.Create;

mStream1.loadfromfile('设备工程进度管理前期规划.doc' + '1');
while i < nn do
begin
    mStream2.loadfromfile('设备工程进度管理前期规划.doc' + IntToStr(i + 1));
    mStream1.seek(mStream1.size, soFromBeginning);
    mStream1.copyfrom(mStream2, mStream2.size);
    mStream2.clear;
    i := i + 1;
end;
mStream2.free;
mStream1.SaveToFile('设备工程进度管理前期规划.doc');
mStream1.free;
//删除临时文件
i:=1;
   while i <= nn do
begin
    deletefile('设备工程进度管理前期规划.doc' + IntToStr(i));
    i := i + 1;
end;
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功');

end;

//构造函数

constructor TThread1.create1(aURL, aFile, fileName: string; bResume: Boolean;
Count, start, last: integer);
begin
inherited create(true);
FreeOnTerminate := true;
tURL := aURL;
tFile := aFile;
fCount := Count;
tResume := bResume;
tstart := start;
tlast := last;
temFileName := fileName;
end;
//下载文件函数

procedure TThread1.DownLodeFile();
var
temhttp: TIdHTTP;
begin

temhttp := TIdHTTP.Create(nil);
temhttp.onWorkBegin := Form1.IdHTTP1WorkBegin;
temhttp.onwork := Form1.IdHTTP1work;
temhttp.onStatus := Form1.IdHTTP1Status;
Form1.IdAntiFreeze1.OnlyWhenIdle := False; //设置使程序有反应.
if FileExists(temFileName) then //如果文件已经存在
    tStream := TFileStream.Create(temFileName, fmOpenWrite)
else
    tStream := TFileStream.Create(temFileName, fmCreate);

if tResume then //续传方式
begin
    exit;
end
else //覆盖或新建方式
begin
    temhttp.Request.ContentRangeStart := tstart;
    temhttp.Request.ContentRangeEnd := tlast;
end;

try
    temhttp.Get(tURL, tStream); //开始下载
    Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName +
      'download');

finally
    //tStream.Free;
    freeandnil(tstream);
    temhttp.Disconnect;
end;

end;

procedure TThread1.Execute;
begin
if Form1.Edit1.Text <> '' then
    //synchronize(DownLodeFile)
    DownLodeFile
else
    exit;
inc(tcount);
if tcount = Form1.nn then //当tcount=nn时代表全部下载成功
begin
    //Showmessage('全部下载成功!');
    Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合并删除临时文件');
    Form1.AddFile;
end;
end;

end.

=============================================================================================

在idhttp中如何实现多线程

unit1:
       unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Memo1: TMemo;
    ADOQuery1: TADOQuery;
    ADOConnection1: TADOConnection;
    IdHTTP1: TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  Count : Integer;
  procedure ThreadDone(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses Unit2;

var
  gt : array[1..4] of gethtml;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i : Integer;
  str_url : string;
begin
  Count := 0;
  str_url := 'http://www.newjobs.com.cn/qiuzhiguwen/job.jsp?num=60347';
  for i := 1 to 4 do
  begin
      gt[i]:=gethtml.Create(str_url);
      gt[i].OnTerminate := ThreadDone;
  end;
end;

procedure TForm1.ThreadDone(Sender: TObject);
begin
  Inc(Count);
  Memo1.Lines.Add('当前完成线程数：'+IntToStr(Count));
end;

end.

--------------------------------------------------------------------------------------------------------------------------
============================================================================
unit2：
unit Unit2;

interface

uses
  IdHTTP, IdTCPConnection, IdTCPClient, Classes, Dialogs, Graphics, Controls,
  SysUtils, Windows, Messages, Variants, StdCtrls;

type
  gethtml = class(TThread)
  private
    { Private declarations }
    furl:string;
  protected
    procedure Execute; override;
  public
    constructor Create(url:string);
  end;

implementation

uses Unit1;

constructor gethtml.Create(url:string);
begin
  inherited Create(FALSE);
  furl:= url;
end;

procedure gethtml.Execute;
var
  st: TStringStream;
  IdHTTP: TIdHTTP;
begin
  st := TStringStream.Create('');
  ReturnValue := 10000;
  IdHTTP := TIdHTTP.Create(nil);
  IdHTTP.HandleRedirects := True;
  IdHTTP.ReadTimeout := 60000;
  try
    IdHTTP.Get(furl,st);
    Form1.Memo1.Text := st.DataString;//这里操作方法有错误，么有同步，多线程等着出错吧
    //FiState^ := True;
  except
    //FiState^ := False;
  end;  
  IdHTTP.Free;
  st.Free;
  inherited;
end;

end.

=============================================================================================

相对完整的多线程idhttp文件下载代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze,
  IdThreadComponent, IdFTP ,IdException;
type
  MyException1 = class(exception)//自定义的异常类
end;

type
  TThread1 = class(TThread)

private
    fCount, tstart, tlast: integer;
    tURL, tFile, temFileName: string;
    tResume: Boolean;
    tStream: TFileStream;
  protected
    procedure Execute; override;
  public
    constructor create1(aURL, aFile, fileName: string; bResume: Boolean; Count,
      start, last: integer);
    procedure DownLodeFile(); //下载文件
  end;

type
  TForm1 = class(TForm)
    IdAntiFreeze1: TIdAntiFreeze;
    IdHTTP1: TIdHTTP;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    SaveDialog1: TSaveDialog;

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 IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure Button3Click(Sender: TObject);
  private
  public
    nn, aFileSize, avg: integer;
    time1, time2: TDateTime;
    MyThread: array[1..10] of TThread;
    procedure GetThread();
    procedure AddFile();
    procedure NewAddFile();
    function GetURLFileName(aURL: string): string;
    function GetFileSize(aURL: string): integer;
  end;

var
  Form1: TForm1;

implementation
var
  AbortTransfer: Boolean;
  aURL, aFile: string;
  tcount: integer; //检查文件是否全部下载完毕
{$R *.dfm}

//get FileName

function TForm1.GetURLFileName(aURL: string): string;
var
  i: integer;
  s: string;
begin //返回下载地址的文件名

s := aURL;
  i := Pos('/', s);
  while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了
  begin
    Delete(s, 1, i);
    i := Pos('/', s);
  end;
  Result := s;
end;

//get FileSize

function TForm1.GetFileSize(aURL: string): integer;
var
  FileSize: integer;
begin
  IdHTTP1.Head(aURL);
  FileSize := IdHTTP1.Response.ContentLength;
  IdHTTP1.Disconnect;
  Result := FileSize;
end;

//执行下载

procedure TForm1.Button1Click(Sender: TObject);
var
  j: integer;
begin
    //savedialog1.
  try
    time1 := Now;
    tcount := 0;
    aURL := Edit1.Text; //下载地址
    if aURL = '' then
    begin
       MessageDlg('请输入下载地址！',mtError,[mbOK],0);
       Exit;
    end;
    aFile := GetURLFileName(Edit1.Text); //得到文件名
    savedialog1.FileName :=afile;
    if savedialog1.Execute then

if Edit2.Text = '' then
    begin
      case MessageDlg('请输入线程数，最大支持10个线程，默认为单线程下载！', mtConfirmation, [mbYes, mbNo], 0) of
        mrYes: nn:=1; //默认
        mrNo: Exit; //重新输入
      end;
    end
    else
      nn := StrToInt(Edit2.Text); //线程数
      if nn > 10 then
      begin
        raise MyException1.Create('输入超过线程限制数，请重新输入！');
      end;
      j := 1;
      aFileSize := GetFileSize(aURL);
      avg := trunc(aFileSize / nn);
      begin
        try
          GetThread();
          while j <= nn do
          begin
            MyThread[j].Resume; //唤醒线程
            j := j + 1;
          end;
        except
          Showmessage('创建线程失败!');
          Exit;
        end;
      end;
  except
    on E:EConvertError do//捕捉内建的Econverterror异常
    begin
      //ShowMessage('请输入数字');
      MessageDlg('请输入数字'+#13,mtError,[mbOK],0);
      Exit;
    end;
    on E:MyException1 do//捕捉自定义的MyException异常
    begin
      MessageDlg(E.Message,mtError,[mbOK],0);
      Edit2.Text:= '';
      Exit;
    end;
    on E:EIdSocketError do//捕捉内建的EIdSocketError异常
    begin
      MessageDlg('连接不上服务器，或服务起未开启！',mtError,[mbOK],0);
      Exit;
    end;
    on E:EIdConnectException do//捕捉内建的EIdSocketError异常
    begin
      MessageDlg('连接不上服务器，或服务起未开启！',mtError,[mbOK],0);
      Exit;
    end;
    on E:EIdHTTPProtocolException do//捕捉内建的EIdSocketError异常
    begin
      MessageDlg('目标文件找不到！',mtError,[mbOK],0);
      Exit;
    end;
  else
    raise //reraise其他异常

end;
end;

//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.

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

//接收数据的时候,进度将在ProgressBar1显示出来.

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  if AbortTransfer then
  begin
    //IdHTTP1.Disconnect; //中断下载
  end;

ProgressBar1.Position := AWorkCount;
  //ProgressBar1.Position:=ProgressBar1.Position+AWorkCount; //*******显示速度极快
  Application.ProcessMessages;
  //***********************************这样使用不知道对不对

end;

//中断下载

procedure TForm1.Button2Click(Sender: TObject);
var
  i : integer;
begin
  try
    if AbortTransfer then
      begin
        i:=1;
        while i <= nn do
          begin
          MyThread[i].Suspend;
          i := i + 1;
           end;
       AbortTransfer := false;
       button2.Caption:='开始';
   end else
     begin
     i:=1;
     while i <= nn do
       begin
       MyThread[i].Resume;
       i := i + 1;
       end;
      AbortTransfer := True;
     button2.Caption:='暂停';
    end;
  except
    on E:EThread do
    begin
    end;
  else
    raise //reraise其他异常
end;
  //IdHTTP1.Disconnect;
end;

//状态显示

procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
end;

//退出程序

procedure TForm1.Button3Click(Sender: TObject);
begin
  //application.Terminate;
  IdHTTP1.DisconnectSocket;
  Form1.close;

end;

//循环产生线程

procedure TForm1.GetThread();
var
  i: integer;
  start: array[1..100] of integer;
  last: array[1..100] of integer;   //改用了数组，也可不用
  fileName: string;
begin
  i := 1;
  while i <= nn do
  begin
    start[i] := avg * (i - 1);
    last[i] := avg * i -1; //这里原先是last:=avg*i;
    if i = nn then
    begin
      last[i] := avg*i + aFileSize-avg*nn; //这里原先是aFileSize
    end;
    fileName := aFile + IntToStr(i);
    MyThread[i] := TThread1.create1(aURL, aFile, fileName, false, i, start[i],
      last[i]);
    i := i + 1;
  end;
end;

procedure TForm1.AddFile(); //合并文件
var
  mStream1, mStream2: TMemoryStream;
  i: integer;
begin
try
  i := 1;
  mStream1 := TMemoryStream.Create;
  mStream2 := TMemoryStream.Create;

mStream1.loadfromfile(afile + '1');
  while i < nn do
  begin
    mStream2.loadfromfile(afile + IntToStr(i + 1));
    mStream1.seek(mStream1.size, soFromBeginning);
    mStream1.copyfrom(mStream2, mStream2.size);
    mStream2.clear;
    i := i + 1;
  end;
  FreeAndNil(mStream2);
  mStream1.SaveToFile(afile);
  FreeAndNil(mStream1);
  //删除临时文件
  i:=1;
   while i <= nn do
  begin
    deletefile(afile + IntToStr(i));
    i := i + 1;
  end;
  Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下载成功');
except
    i:=1;
    while i <= nn do
    begin
    if FileExists(aFile+inttostr(i)) then
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;
    ShowMessage('下载文件出错，临时文件已删除，请重新下载！')
  end;

end;

procedure TForm1.NewAddFile(); //合并文件
var
  i: Integer;
  InStream, OutStream : TFileStream;
  SourceFile : String;
begin
  try
    i := 1;
    OutStream:=TFileStream.Create(aFile,fmCreate);
    //OutStream:=TFileStream.Create(('D/1/'+aFile),fmCreate); //此句与savedialog冲突，发生异常，使savedialog指定路径无效。
    while i <= nn do
    begin
      SourceFile := afile + IntToStr(i);
      InStream:=TFileStream.Create(SourceFile, fmOpenRead);
      OutStream.CopyFrom(InStream,0);
      FreeAndNil(InStream);
      i:= i+1;
    end;
    FreeAndNil(OutStream);
    //删除临时文件
    i:=1;
    while i <= nn do
    begin
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;

except
    i:=1;
    while i <= nn do
    begin
    if FileExists(aFile+inttostr(i)) then
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;
  end;
  if FileExists(aFile) then
  begin
    FreeAndNil(OutStream);
    InStream := TFileStream.Create(aFile, fmOpenWrite);
    if InStream.Size < aFileSize then
    begin
      FreeAndNil(InStream);
      deletefile(afile);
      //ShowMessage('下载文件出错，临时文件已删除，请重新下载！')
      Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下载文件出错，临时文件已删除，请重新下载！');
    end
    else
    begin
      FreeAndNil(InStream);
      Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功');
    end;
  end;

end;

//构造函数

constructor TThread1.create1(aURL, aFile, fileName: string; bResume: Boolean;
  Count, start, last: integer);
begin
  inherited create(true);
  FreeOnTerminate := true;
  tURL := aURL;
  tFile := aFile;
  fCount := Count;
  tResume := bResume;
  tstart := start;
  tlast := last;
  temFileName := fileName;
end;
//下载文件函数

procedure TThread1.DownLodeFile();
var
  temhttp: TIdHTTP;
begin

temhttp := TIdHTTP.Create(nil);
  temhttp.onWorkBegin := Form1.IdHTTP1WorkBegin;
  temhttp.onwork := Form1.IdHTTP1work;
  temhttp.onStatus := Form1.IdHTTP1Status;
  Form1.IdAntiFreeze1.OnlyWhenIdle := False; //设置使程序有反应.
  if FileExists(temFileName) then //如果文件已经存在
    tStream := TFileStream.Create(temFileName, fmOpenWrite)
  else
    tStream := TFileStream.Create(temFileName, fmCreate);

if tResume then //续传方式
  begin
    exit;
  end
  else //覆盖或新建方式
  begin
    temhttp.Request.ContentRangeStart := tstart;
    temhttp.Request.ContentRangeEnd := tlast;
  end;

try
    ///try
      temhttp.Get(tURL, tStream); //开始下载
    except
      if FileExists(temFileName) then
      begin
      freeandnil(tstream);
      deletefile(temFileName);//本来想用来删除未下完的文件，可惜不成功，有的线程没有删除，只有部分删除了，
                              //不过这样导致后面合并文件时出错，同样也可以把临时文件删除。
      //ShowMessage('下载文件出错，临时文件已删除，请重新下载！');/
      end;
      temhttp.Disconnect;
    end;

Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName +
      'download');

//finally
    freeandnil(tstream);
    temhttp.Disconnect;
  //end;

end;

procedure TThread1.Execute;
begin

if Form1.Edit1.Text <> '' then
    //synchronize(DownLodeFile)
    DownLodeFile
  else
    exit;
  inc(tcount);
  if tcount = Form1.nn then //当tcount=nn时代表全部下载成功
  begin
    Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合并删除临时文件');
    Form1.NewAddFile;
    form1.time2 := Now;
    Form1.Label5.Caption := FormatDateTime ('n:ss', form1.Time2-Form1.Time1) + ' seconds';
  end;

end;

end.

=============================================================================================

idhttp下载html的代码(含错误处理)

IdHTTP_Thread := TIDHTTP.Create;
     IdHTTP_Thread.ReadTimeout  := 240000;
     IdHTTP_Thread.ConnectTimeout := 240000;
     IdHTTP_Thread.Request.UserAgent :='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322)';
     try
       try
         TStmHtml := TStringStream.Create('');
         IdHTTP_Thread.Get(FGetURL,TStmHtml);
         strHtml := TStmHtml.DataString   ;
         //strHtml :=  FParameter;
       except
          on E:EIdSocketError  do
          begin
            FImpInfo := IntToStr(iLoop)+' 获得'+FGetURL+'职位信息时出现错误丢失一页 错误原因: '+SysErrorMessage(E.LastError );
            FErrCode := E.LastError;
            ReGetHtml := True;
          end;
          else
          begin
            FImpInfo := IntToStr(iLoop)+' 获得'+FGetURL+'职位信息时出现错误丢失一页 错误原因: 打开网页失败';
            FErrCode := 1 ;
            ReGetHtml := True;
          end;
       end;
     finally
        IdHTTP_Thread.Disconnect ;
        IdHTTP_Thread.Free  ;
        TStmHtml.Free  ;
     end;

=============================================================================================

用idhttp提交自己构造过的Cookie

如何用idhttp提交自己构造过的Cookie

我不知道的是：如果把自己构造过的Cookie传给idhttp让它提交。

比如站点 http://www.aaa.com 是要cookie的。
我已经在程序上放了idhttp和IdCookieManager。
我get http://www.aaa.com 后，idhttp通过IdCookieManager已经得到当前站点的Cookie了。
我可以用
for i := 0 to IdCookieManager1.CookieCollection.Count - 1 do
memo1.Lines.Add(IdCookieManager1.CookieCollection.Items[i].CookieText);
得到。

现在，如果我想更改这个cookie，或者说我想按这个Cookie的格式重新写一个，再用idhttp进行post。我应该怎么做？
用途是Cookie欺骗等。
如：
得到的Cookie为：skin=2; ASPSESSIONIDSQTSABQD=IEMKPIDBKKMEEKEHLLOIJJON; UserCode=3CA001D63984E6115FE55681%2E95
我更改为：skin=123; ASPSESSIONIDSQTSABQD=IEMKPIDBKKMEEKEHLLOIJJON; UserCode=3CA001D63984E6115FE55681%2E95
我再post  

今天忙了一个下午，终于研究出答案了。

以前不管是做什么软件，只要是关于网页post提交cookie的，我都是用TcpClient，为什么呢？
因为我一直找不到idhttp提交Cookie的方法，今天终于有了结果。

在Idhttp中，要想修改Cookie的代码，就要用到Request的RawHeaders中的Values值。
这个值怎么用呢？
Values接受一个string的值，该值指定了所访问的变量。
如HTTP头是这样定义的(其中一些)：
[color=royalblue]Accept-Language: zh-cn
Content-Type: application/x-www-form-urlencoded
Accept-Encoding: gzip, deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; 
Cookie: JSESSIONID=aoOYvjM-IKzh[/color]
而Values的值就可以是Cookie，User-Agent，Accept-Encoding……等等。

所以，代码应该是这样：
[color=royalblue] try
idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值'; //
memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
idhttp1.Post('/webmail/login.jsp',data1,data2);
memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
idhttp1.Request.RawHeaders.Values['Cookie'] := 'asdfasdf';
memo1.Lines.Add(idhttp1.Request.RawHeaders.Text);
except
idhttp1.Get(idhttp1.Response.Location, data1);
end;[/color]
初一看，这代码是没有什么问题的。但，memo1的第一次ADD并没有任何值，奇怪。
而第三次ADD就被改为了'asdfasdf'，正是我们所希望的。
我正是卡在了这里。为什么第一次idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值'; 没有结果呢？

搞了很久。我才发现，在第一次传值的时候，RawHeaders跟本没有被初始化。而第三次经过Post以后，RawHeaders被初始化了，所以得到了我们所要的结果。

正确的代码应该是这样：
[color=royalblue]try
idhttp1.Request.SetHeaders; //最重要的初始化。
idhttp1.Request.RawHeaders.Values['Cookie'] := '这里是cookie的值';
idhttp1.Post('/webmail/login.jsp',data1,data2);
except
idhttp1.Get(idhttp1.Response.Location, data1);
end;[/color]

=============================================================================================

Idhttp自动发贴 for Discuz

先是自动登录函数，登录后再GET一下取得发贴时要的formhash值，存入全局变量。

function TForm1.LoginOn(strUser, strPass: string): Boolean;
var
Param:TStringList;
url,HTML:String;
begin
Result:=False;
idhtp1.AllowCookies:=True;
idhtp1.HandleRedirects:=True;
idhtp1.Request.ContentType:='application/x-www-form-urlencoded' ;
idhtp1.Request.UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 2.0.50727)';
Param:=TStringList.Create;
//Param.Add('formhash=6a68324b');
//Param.Add('cookietime=2592000');
Param.Add('loginfield=username');
Param.Add('username='+strUser);
Param.Add('password='+strPass);
Param.Add('userlogin=%E7%99%BB%E5%BD%95');
url:='http://localhost/bbs/logging.php?action=login&loginsubmit=true';
try
    HTML:=idhtp1.Post(Url,Param);
    HTML:=UTF8Decode(HTML);
finally
    Param.Free;
end;
Result:= (Pos('退出',HTML)>0);
HTML:=idhtp1.Get('http://localhost/bbs/index.php');
formhash:=Copy(HTML,Pos('formhash=',HTML)+9,100);
formhash:=Copy(formhash,1,Pos('"',formhash)-1);

end;

发一个新主题。fid为板块序号

function TForm1.NewSubject(fid,Subject, Content: string): String;
var
Param:TStringList;
url,HTML:String;
begin
Param:=TStringList.Create;
Param.Add('formhash='+formhash);
Param.Add('frombbs=1');
Param.Add('subject='+Subject);
Param.Add('message='+Content);
url:='http://localhost/bbs';
url:=url+'/post.php?action=newthread&fid=';
url:=url+fid;
url:=url+'&extra=page%3D1&topicsubmit=yes';
try
    HTML:=idhtp1.Post(Url,Param);
    HTML:=UTF8Decode(HTML);
finally
    Param.Free;
end;
result:=copy(HTML,Pos('tid=',HTML)+4,50);
result:=Copy(Result,1,Pos('&',result)-1);
end;

回复主题。tid为主题序号。

function TForm1.ReSubject(fid,tid,Subject, Content: string):String;
var
Param:TStringList;
url,HTML:string;
begin
Param:=TStringList.Create;
Param.Add('formhash='+formhash);
Param.Add('frombbs=1');
Param.Add('subject='+Subject);
Param.Add('message='+Content);
url:='http://localhost/bbs';
url:=url+'/post.php?action=reply&fid=';
url:=url+fid+'&tid='+tid;
url:=url+'&extra=page%3D1&replysubmit=yes';
try
    HTML:=idhtp1.Post(Url,Param);
    //HTML:=UTF8Decode(HTML);
finally
    Param.Free;
end;
result:=HTML;
end;

=============================================================================================

使用Indy9+D7实现CSDN论坛的登录，回复，发贴，发短信功能

代码片断：
　　const
　　 LoginUrl='http://www.csdn.net/member/logon.asp';
　　 PostUrl='http://community.csdn.net/Expert/PostNew_SQL.asp';
　　 ReplyUrl='http://community.csdn.net/Expert/reply.asp';
　　 MsgUrl='http://community.csdn.net/message_board/postsend.asp';
　　MyCookList：全局变量，取得当前用户的Cookie
　　IdHTTP1: TIdHTTP;
　　登录：
　　function Logon(UserName, PassWord, CookieTime: string):boolean;
　　var
　　 LoginInfo: TStrings;
　　 Response: TStringStream;
　　 i: Integer;
　　 Cookie:string;
　　begin
　　 Result :=False;
　　 Cookie:='';
　　 MyCookList :='';
　　 Response := TStringStream.Create('');
　　 LoginInfo := TStringList.Create;
　　 try
　　 LoginInfo.Clear;
　　 LoginInfo.Add('login_name='+UserName);
　　 LoginInfo.Add('password='+PassWord);
　　 LoginInfo.Add('from=http://community.csdn.net/Expert/Forum.asp');
　　 LoginInfo.Add('cookietime='+CookieTime);
　　 LoginInfo.Add('x=0');
　　 LoginInfo.Add('y=0'); 
　　 IdHTTP1.Request.Referer:='http://www.csdn.net/member/logon.asp';
　　 IdHTTP1.Request.From :='http://community.csdn.net/Expert/Forum.asp';
　　 try
　　 IdHTTP1.Post(LoginUrl,LoginInfo,Response);
　　 except
　　 showmessage('登陆失败');
　　 end;
　　 showmessage(Response.DataString);
　　 //从返回的页面中找出cookie
　　 for i :=0 to IdHTTP1.Response.RawHeaders.Count-1 do
　　 begin
　　 if UpperCase(Copy(IdHTTP1.Response.RawHeaders[i],1,10)) = 'SET-COOKIE' then
　　 begin
　　 Cookie :=Trim(Copy(IdHTTP1.Response.RawHeaders[i],12,MAXINT));
　　 Cookie :=Copy(Cookie,1,Pos(';',Cookie));
　　 MyCookList :=MyCookList+Cookie;
　　 // showmessage(Cookie);
　　 end;
　　 end;
　　 IdHTTP1.Request.RawHeaders.Add('Cookie: '+MyCookList);
　　 finally
　　 LoginInfo.Free;
　　 Response.Free;
　　 end;
　　 if length(MyCookList)>200 then
　　 result:=True;
　　end;
　　//回复
　　function Reply(TopicID, Content: string): boolean;
　　var
　　 ReplyInfo: TStrings;
　　 Response: TStringStream;
　　begin
　　 Result :=False;
　　 ReplyInfo := TStringList.Create;
　　 Response :=TStringStream.Create(''); 
　　 try
　　 begin
　　 //取回复页面
　　 ReplyInfo.Clear;
　　 ReplyInfo.Add('Topicid='+TopicID);
　　 ReplyInfo.Add('xmlReply=aaaaa');
　　 ReplyInfo.Add('csdnname='); 
　　 ReplyInfo.Add('csdnpassword=');
　　 ReplyInfo.Add('ReplyContent='+Content);
　　 IdHTTP1.Request.CustomHeaders.Add('Cookie: '+copy(MyCookList,1,length(MyCookList)-1)); 
　　 IdHTTP1.Request.Referer :='http://community.csdn.net/Expert/xsl/Reply_Xml.asp Topicid='+TopicID;
　　 IdHTTP1.Request.UserAgent:='Redhat/9.0';
　　 try
　　 IdHTTP1.Post(ReplyUrl,ReplyInfo,Response);
　　 except
　　 showmessage('回复失败');
　　 exit;
　　 end;
　　 // showmessage(Response.DataString);
　　 if pos('添加完成，正在生成静态页面，请稍候',Response.DataString)>0 then
　　 Result :=true;
　　 end;
　　 finally
　　 ReplyInfo.Free;
　　 Response.Free;
　　 end;
　　end;
　　//发贴
　　function PostNew(RoomID, Point, TopicName,
　　 Content: string): boolean;
　　var
　　 PostInfo: TStrings;
　　 Response: TStringStream;
　　begin
　　 Result :=False;
　　 PostInfo := TStringList.Create;
　　 Response :=TStringStream.Create(''); 
　　 try
　　 begin
　　 //取发贴页面
　　 //typestate=1&Point=20&TopicName=test&Room=1404&Content=111222
　　 PostInfo.Clear;
　　 PostInfo.Add('typestate=1');
　　 PostInfo.Add('Point='+Point);
　　 PostInfo.Add('TopicName='+TopicName);
　　 PostInfo.Add('Room='+RoomID);
　　 PostInfo.Add('Content='+Content);
　　 IdHTTP1.Request.CustomHeaders.Add('Cookie: '+copy(MyCookList,1,length(MyCookList)-1));
　　 IdHTTP1.Request.CacheControl:='no-cache'; 
　　 IdHTTP1.Request.UserAgent:='Windows Advanced Server/5.0';
　　 try
　　 IdHTTP1.Post(PostUrl,PostInfo,Response);
　　 except
　　 showmessage('发帖失败');
　　 exit;
　　 end;
　　 // showmessage(Response.DataString);
　　 if pos('增加成功，请稍候，正在生成静态页面',Response.DataString)>0 then
　　 Result :=true;
　　 end;
　　 finally
　　 PostInfo.Free;
　　 Response.Free;
　　 end;
　　end;
　　//发短信
　　function SendMsg(SendTo, Content: string): boolean;
　　var
　　 PostInfo: TStrings;
　　 Response: TStringStream;
　　begin
　　 Result :=False;
　　 PostInfo := TStringList.Create;
　　 Response :=TStringStream.Create(''); 
　　 try
　　 begin
　　 PostInfo.Clear;
　　 PostInfo.Add('Sendto='+SendTo);
　　 PostInfo.Add('Content='+Content);
　　 IdHTTP1.Request.CustomHeaders.Add('Cookie: '+copy(MyCookList,1,length(MyCookList)-1));
　　 try
　　 IdHTTP1.Post(MsgUrl,PostInfo,Response);
　　 except
　　 showmessage('发送失败');
　　 exit;
　　 end;
　　 // showmessage(Response.DataString);
　　 if pos('发送成功',Response.DataString)>0 then
　　 Result :=true;
　　 end;
　　 finally
　　 PostInfo.Free;
　　 Response.Free;
　　 end;
　　end;

=============================================================================================