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.Get
http://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
我不知道的是：如果把自己构造过的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;
=============================================================================================