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;

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

IdHttp 资料的更多相关文章

  1. Delphi Idhttp Post提交 Aspx/Asp.net 时 500错误的解决办法。

    一直使用Delphi写程序,因为习惯了,用起来方便. 但是有一个问题困扰了我半年了.就是使用Idhttp Post提交时候总会有莫名其妙的错误,大部分网站没问题,但是一遇到Asp.net就报错500. ...

  2. Delphi的idhttp报508 Loop Detected错误的原因

    一般是访问https时才出现“508 Loop Detected”,idhttp+IdSSLIOHandlerSocketOpenSSL,这个在上篇文章中讲过了. 由于该问题网上资料极少,连外文资料也 ...

  3. Android实例-IdHTTP下载(并实现自动安装)(XE10+小米2)

    相关资料: 1.群号 383675978 2.运行时提示"connection closed gracefully"错误原因与解决 http://www.delphifans.co ...

  4. IdHTTP设置SSL证书,乱码问题也解决了

    要跟银行做接口,需要使用delphi来post数据,但对方提供的是https开头的网址,需要使用证书,对方已提供证书了,但是还是调用不成功,使用的是idhttp和TIdSSLIOHandlerSock ...

  5. Vim新手入门资料和一些Vim实用小技巧

    一些网络上质量较高的Vim资料 从我07年接触Vim以来,已经过去了8个年头,期间看过很多的Vim文章,我自己觉得非常不错,而且创作时间也比较近的文章有如下这些. Vim入门 目前为阿里巴巴高级技术专 ...

  6. Git入门资料汇总

    Git是一个非常好用的版本控制工具,同时,它也是一个相对比较复杂的工具,想要掌握它还是需要花一番功夫的.网络上关于Git的入门资料已经很多了,我就不再重复了,直接把我学习的文章放在这里. Git详解 ...

  7. MVC5 网站开发之七 用户功能 3用户资料的修改和删除

    这次主要实现管理后台界面用户资料的修改和删除,修改用户资料和角色是经常用到的功能,但删除用户的情况比较少,为了功能的完整性还是坐上了.主要用到两个action "Modify"和& ...

  8. webapi的学习资料

    猿教程_-webapi教程-WebAPI教程 猿教程_-webapi教程-Web API概述 猿教程_-webapi教程-新建Web Api项目 猿教程_-webapi教程-测试Web API 猿教程 ...

  9. 人工智能AI-机器视觉CV-数据挖掘DM-机器学习ML-神经网络-[资料集合贴]

    说明:这个贴用于收集笔者能力范围内收集收藏并认为有用的资料,方便各方参考,免去到处找寻之苦,提升信息的交叉引用价值.仅供参考,不作为必然的推荐倾向.如涉及版权等问题请相关人员联系笔者,谢谢. |博客| ...

随机推荐

  1. 【HEVC帧间预测论文】P1.8 Complexity Control of High Efficiency Video Encoders for Power-Constrained Devices

    参考:Complexity Control of High Efficiency Video Encoders for Power-Constrained Devices <HEVC标准介绍.H ...

  2. JS正则匹配待重命名文件名

    <script>var str = "123 - Copy(2).csv";var regExp = /^123( - Copy(\(\d+\))?)?.csv$/;d ...

  3. 四次元新浪微博客户端Android源码

    四次元新浪微博客户端Android源码 源码下载:http://code.662p.com/list/11_1.html [/td][td] [/td][td] [/td][td] 详细说明:http ...

  4. ubuntu系统apache日志文件的位置

    Debian,Ubuntu或Linux Mint上的Apache错误日志位置 默认的错误日志 在基于Debian的Linux上,系统范围的Apache错误日志默认位置是/var/log/apache2 ...

  5. SSAS 系列01- DAX公式常用公式

    计算第一次购买时间 CALCULATE(FIRSTDATE(FactInternetSales[OrderDate]),ALLEXCEPT(FactInternetSales,FactInternet ...

  6. ubuntu命令行转换图片像素大小

    convert -resize 512x256 00433.png 00001.png 1.512和256之间是x(就是字母那个x),用' * '反而会报错 2.这个命令会按照原图的比例进行转换 3. ...

  7. ideal取消按下两次shift弹出搜索框 修改idea,webstrom,phpstrom 快捷键double shift 弹出search everywhere

    因为经常需要在中英文之间切换,所以时常使用shift键,一不小心就把这个Searchwhere 对话框调出来了,很是麻烦. 因此痛定思痛, 我决定将这个按两下shift键就弹出搜索框的快捷键禁用了! ...

  8. PHP21 MVC

    学习目标 MVC设计模式 单一入口机制 MVC的实现 MVC设计模式 Model(模型) 是应用程序中用于处理应用程序数据逻辑的部分.通常模型对象负责在数据库中存取数据. View(视图) 是应用程序 ...

  9. 在Foxmail邮件客户端登录263企业邮箱

    一.问题描述 首次用Foxmail登录263企业,输入账号和密码,创建 二.问题分析 客户端配置地址: 协议类型 服务器地址 默认端 加密端(SSL) POP pop.263.net 110 1995 ...

  10. SMTP error 554 !!

    哇,我真的amazing, incredible!! 我只是想写一个简单的邮件,结果他一直报554错误!!! 期间,通过百度,我发现了可能导致 此,讨厌至极的错误,有N多原因: 但我的原因 谜之离谱! ...