IdHttp 資料

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

IdHttp 資料 網上找了些不過很很差找.今天找了些收藏在一塊兒.以便他人查閱,

 

idhttp上傳

 

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

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

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

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

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

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

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

調用方法：

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

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

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

    end;

finally
    mpfSource.free;
    responseStream.free;

 

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

 

idHTTP最簡潔的修改和取得Cookie例子

 

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

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

unit Unit1;

interface

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

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

var
Form1: TForm1;

implementation

{$R *.dfm}

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

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

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

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

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

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

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

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

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

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

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

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

saveit('hhh.html');

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

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

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

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

end.

 

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

 

IdHTTP形成程序假死的解決辦法

 

在程序中使用了IdHTTP的話，在執行Get或Post過程的時候，程序界面會沒法響應，形成程序假死，但在任務管理器中又能看到程序正在運行。

這是由於Indy系統組件都使用了阻塞式Sock，阻塞式Sock的缺點就是使客戶程序的用戶界面「凍結」。當在程序的主線程中進行阻塞式Socket調用時，因爲要等待Socket調用完成並返回，這段時間就不能處理用戶界面消息，使得Update、Repaint以及其它消息得不到及時響應，從而致使用戶界面被「凍結」，就是常說的「程序假死」。

解決辦法有兩種：

1.在程序中放一個IdAntiFreeze控件，我的使用中發現把IdAntiFreeze控件的OnlyWhenIdle置爲False，效果會更好。

2.將IdHTTP放進線程，在線程中動態創建IdHTTP控件來使用。

第一種辦法使用簡單，但程序界面的響應仍是會有些延遲感。

第二種辦法使用後，程序的表現十分好，感受不到延遲。不過由於涉及到線程的操做，使用起來比第一種辦法要麻煩一點。

 

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

 

用idhttp提交cookie

 

之前無論是作什麼軟件，只要是關於網頁post提交cookie的，我都是用TcpClient，爲何呢？
由於我一直找不到idhttp提交Cookie的方法，今天終於有告終果。

在Idhttp中，要想修改Cookie的代碼，就要用到Request的RawHeaders中的Values值。
這個值怎麼用呢？
Values接受一個string的值，該值指定了所訪問的變量。
如HTTP頭是這樣定義的(其中一些)：
Accept-Language: zh-cn
Content-Type: application/x-www-form-urlencoded
Accept-Encoding: gzip, deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; 
Cookie: JSESSIONID=aoOYvjM-IKzh 
而Values的值就能夠是Cookie，User-Agent，Accept-Encoding……等等。

因此，代碼應該是這樣：
try
idhttp1.Request.RawHeaders.Values['Cookie'] := '這裏是cookie的值'; //
memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
idhttp1.Post('/webmail/login.jsp',data1,data2);
memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
idhttp1.Request.RawHeaders.Values['Cookie'] := 'asdfasdf';
memo1.Lines.Add(idhttp1.Request.RawHeaders.Text);
except
idhttp1.Get(idhttp1.Response.Location, data1);
end; 
初一看，這代碼是沒有什麼問題的。但，memo1的第一次ADD並無任何值，奇怪。
而第三次ADD就被改成了'asdfasdf'，正是咱們所但願的。
我正是卡在了這裏。爲何第一次idhttp1.Request.RawHeaders.Values['Cookie'] := '這裏是cookie的值'; 沒有結果呢？

搞了好久。我才發現，在第一次傳值的時候，RawHeaders跟本沒有被初始化。而第三次通過Post之後，RawHeaders被初始化了，因此獲得了咱們所要的結果。
也就是說，在寫漏洞上傳程序這些的時候，若是先Post讓RawHeaders初始化，那就沒什麼意義了，由於Post的時候，Cookie就不能被帶上了。

正確的代碼應該是這樣：
try
idhttp1.Request.SetHeaders; //最重要的初始化。
idhttp1.Request.RawHeaders.Values['Cookie'] := '這裏是cookie的值';
idhttp1.Post('/webmail/login.jsp',data1,data2);
except
idhttp1.Get(idhttp1.Response.Location, data1);
end; 


這裏，最重要的初始化是必需的。
idhttp1.Request.SetHeaders
這個過程若是沒有。就會出錯。

 

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

 

Delphi中使用IdHTTP來訪問基於SSL協議的網站

 

今天有人問我使用idhttp如何去訪問ssl協議的網站

很簡單

在界面上放一個TIdHTTP控件，命名爲IdHTTP1

再放一個TIdSSLIOHandlerSocket控件，命名爲IdSSLIOHandlerSocket1

將IdHTTP1的IOHandler屬性設爲IdSSLIOHandlerSocket1

這樣就能夠隨意的Get,Post那些地址爲https開頭的網站了

不過這樣仍然不行，當運行程序時，會報錯「Could not load SSL library」

這是由於TIdSSLIOHandlerSocket控件須要OpenSSL Library來配合

OpenSSL Library包含有兩個動態連接庫libeay32.dll和ssleay32.dll

聽說由於OpenSSL Library中包含有安全方面的一些加密算法，因此美國政府把它列爲禁止出口的產品，因此indy中並無帶上這兩個文件

到網上搜索一下，不少地方都有下載，下回來放在程序目錄裏，就能夠正常的使用IdHTTP來訪問基於SSL協議的網站了

下面是網上找到的相關資料：

SSL (Secure Socket Layer)
爲Netscape所研發，用以保障在Internet上數據傳輸之安全，利用數據加密(Encryption)技術，可確保數據在網絡
上之傳輸過程當中不會被截取及竊聽。目前通常通用之規格爲40 bit之安全標準，美國則已推出128 bit之更高安全
標準，但限制出境。只要3.0版本以上之I.E.或Netscape瀏覽器便可支持SSL。 
當前版本爲3.0。它已被普遍地用於Web瀏覽器與服務器之間的身份認證和加密數據傳輸。
SSL協議位於TCP/IP協議與各類應用層協議之間，爲數據通信提供安全支持。SSL協議可分爲兩層： SSL記錄協議（SSL Record Protocol）：它創建在可靠的傳輸協議（如TCP）之上，爲高層協議提供數據封裝、壓縮、加密等基本功能的支持。 SSL握手協議（SSL Handshake Protocol）：它創建在SSL記錄協議之上，用於在實際的數據傳輸開始前，通信雙方進行身份認證、協商加密算法、交換加密密鑰等。

SSL協議提供的服務主要有：
1）認證用戶和服務器，確保數據發送到正確的客戶機和服務器；
2）加密數據以防止數據中途被竊取；
3）維護數據的完整性，確保數據在傳輸過程當中不被改變。

SSL協議的工做流程：
服務器認證階段：1）客戶端向服務器發送一個開始信息「Hello」以便開始一個新的會話鏈接；2）服務器根據客戶的信息肯定是否須要生成新的主密鑰，如須要則服務器在響應客戶的「Hello」信息時將包含生成主密鑰所需的信息；3）客戶根據收到的服務器響應信息，產生一個主密鑰，並用服務器的公開密鑰加密後傳給服務器；4）服務器恢復該主密鑰，並返回給客戶一個用主密鑰認證的信息，以此讓客戶認證服務器。
用戶認證階段：在此以前，服務器已經經過了客戶認證，這一階段主要完成對客戶的認證。經認證的服務器發送一個提問給客戶，客戶則返回（數字）簽名後的提問和其公開密鑰，從而向服務器提供認證。
從SSL 協議所提供的服務及其工做流程能夠看出，SSL協議運行的基礎是商家對消費者信息保密的承諾，這就有利於商家而不利於消費者。在電子商務初級階段，因爲運做電子商務的企業大可能是信譽較高的大公司，所以這問題尚未充分暴露出來。但隨着電子商務的發展，各中小型公司也參與進來，這樣在電子支付過程當中的單一認證問題就愈來愈突出。雖然在SSL3.0中經過數字簽名和數字證書可實現瀏覽器和Web服務器雙方的身份驗證，可是SSL協議仍存在一些問題，好比，只能提供交易中客戶與服務器間的雙方認證，在涉及多方的電子交易中，SSL協議並不能協調各方間的安全傳輸和信任關係。在這種狀況下，Visa和 MasterCard兩大信用卡公組織制定了SET協議，爲網上信用卡支付提供了全球性的標準。

https介紹
HTTPS（Secure Hypertext Transfer Protocol）安全超文本傳輸協議 
它是由Netscape開發並內置於其瀏覽器中，用於對數據進行壓縮和解壓操做，並返回網絡上傳送回的結果。HTTPS實際上應用了Netscape的徹底套接字層（SSL）做爲HTTP應用層的子層。（HTTPS使用端口443，而不是象HTTP那樣使用端口80來和TCP/IP進行通訊。）SSL使用40 位關鍵字做爲RC4流加密算法，這對於商業信息的加密是合適的。HTTPS和SSL支持使用X.509數字認證，若是須要的話用戶能夠確認發送者是誰。。
https是以安全爲目標的HTTP通道，簡單講是HTTP的安全版。即HTTP下加入SSL層，https的安全基礎是SSL，所以加密的詳細內容請看SSL。
它是一個URI scheme(抽象標識符體系)，句法類同http:體系。用於安全的HTTP數據傳輸。https:URL代表它使用了HTTP，但HTTPS存在不一樣於HTTP的默認端口及一個加密/身份驗證層（在HTTP與TCP之間）。這個系統的最初研發由網景公司進行，提供了身份驗證與加密通信方法，如今它被普遍用於萬維網上安全敏感的通信，例如交易支付方面。
限制
它的安全保護依賴瀏覽器的正確實現以及服務器軟件、實際加密算法的支持.
一種常見的誤解是「銀行用戶在線使用https:就能充分完全保障他們的銀行卡號不被偷竊。」實際上，與服務器的加密鏈接中能保護銀行卡號的部分，只有用戶到服務器之間的鏈接及服務器自身。並不能絕對確保服務器本身是安全的，這點甚至已被攻擊者利用，常見例子是模仿銀行域名的釣魚攻擊。少數罕見攻擊在網站傳輸客戶數據時發生，攻擊者嘗試竊聽數據於傳輸中。
商業網站被人們指望迅速儘早引入新的特殊處理程序到金融網關，僅保留傳輸碼(transaction number)。不過他們經常存儲銀行卡號在同一個數據庫裏。那些數據庫和服務器少數狀況有可能被未受權用戶攻擊和損害。

 

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

 

Delphi編程中Http協議應用 -- idhttp

 

Delphi編程中Http協議應用 

來源：大富翁

 

Http協議的通訊遵循必定的約定.例如,請求一個文件的時候先發送Get請求,而後服務器會返回請求的數據.若是須要進行斷點傳輸,那麼先發送HEAD /請求,其中返回的Content-Length: 就是文件實際大小.將其和咱們本地須要斷點下載的文件大小比較,發送GET請求和發送須要下載的文件開始位置RANGE: bytes=+inttostr(iFilePos)+-+#13#10;服務器若是支持斷點下載的話就會接着發送餘下的數據了.由於這方面的文章比較多,我在這裏就不詳細講述了.感興趣的朋友能夠自行查閱相關資料或者RFC文檔。

固然,若是你是個懶人,也能夠直接採用Delphi自帶的控件.以Delphi6的INDY組件爲例.新建一個工程,放上一個TIdHTTP控件,一個TIdAntiFreeze控件,一個TProgressBar用於顯示下載進度.最後放上一個TButton用於開始執行咱們的命令.代碼以下:

procedure TForm1.Button1Click(Sender: TObject);//點擊按鈕的時候開始下載咱們的文件
var
MyStream:TMemoryStream;
begin
IdAntiFreeze1.OnlyWhenIdle:=False;//設置使程序有反應.
MyStream:=TMemoryStream.Create;
try
IdHTTP1.Gethttp://www.138soft.com/download/Mp3ToExe.zip,MyStream);//下載我站點的一個ZIP文件
except//INDY控件通常要使用這種try..except結構.
Showmessage(網絡出錯!);
MyStream.Free;
Exit;
end;
MyStream.SaveToFile(c:/Mp3ToExe.zip);
MyStream.Free;
Showmessage(OK);
end;

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);//開始下載前,將ProgressBar1的最大值設置爲須要接收的數據大小.
begin
ProgressBar1.Max:=AWorkCountMax;
ProgressBar1.Min:=0;
ProgressBar1.Position:=0;
end;

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);//接收數據的時候,進度將在ProgressBar1顯示出來.
begin
ProgressBar1.Position:=ProgressBar1.Position+AWorkCount;
end;

IdHTTP1的Get還有一種形式就是獲取字符串:例如,上面的程序能夠改寫成:

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

應用:如今不少程序都有自動升級功能,實際上就是應用了GET.先在本身站點放一個文本文件註明程序版本號,當檢查升級的時候,取文本內容與當前版本號比較,而後決定升級與否.

 

轉的目的是爲了試試進度條的效果.

 

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

 

IDHttp的基本用法

 

IDHttp和WebBrowser同樣，均可以實現抓取遠端網頁的功能，可是http方式更快、更節約資源，缺點是須要手動維護cook，鏈接等

IDHttp的建立，須要引入IDHttp

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

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

如何取得服務端返回的cookie信息，並添加到http的request對象中

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

如何取得網頁中的全部鏈接，對代碼作修改你也能夠實現查找全部圖片等等， QStrings.rar(79K) (點擊下載)在這裏推薦使用QString來實現文本替換、查找等功能，附件裏有下載。

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

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

end;
end;

如何模擬http的get方法打開一個網頁

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

如何模擬http的post方法提交一個網頁

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

程序寫好了，如何調試？這裏推薦一個小工具 httplook.part1.rar(782K) (點擊下載)httplook.part2.rar(243K) (點擊下載)，能夠監視你的流程是否正確

總結：IDHttp的基本用法已經講解完畢，其實經過IDHttp返回的就是2個東西，網頁的header和網頁的body，網頁的header中包含了cookie、跳轉等信息，body中就包含了內容，咱們寫程序就是經過查找、拷貝、替換等方式把其中的關鍵數據找出來，而後作處理，說簡單了就是考驗你的字符串操做能力。

 

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

 

IdHTTP多線程下載

 

IdHTTP多線程下載
unit Unit1;

interface

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

type
TThread1 = class(TThread)

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

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

    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure Button2Click(Sender: TObject);
    procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure Button3Click(Sender: TObject);
private
public
    nn, aFileSize, avg: integer;
    MyThread: array[1..10] of TThread;
    procedure GetThread();
    procedure AddFile();
    function GetURLFileName(aURL: string): string;
    function GetFileSize(aURL: string): integer;
end;

var
Form1: TForm1;

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

tcount: integer; //檢查文件是否所有下載完畢
{$R *.dfm}

//get FileName

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

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

//get FileSize

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

//執行下載

procedure TForm1.Button1Click(Sender: TObject);
var
j: integer;
begin
tcount := 0;
Showmessage('OK!主線程在執行，得到文件名並顯示在Edit2中');
aURL := Edit1.Text; //下載地址
aFile := GetURLFileName(Edit1.Text); //獲得文件名
nn := StrToInt(Edit2.Text); //線程數
j := 1;
aFileSize := GetFileSize(aURL);
avg := trunc(aFileSize / nn);
begin
    try
      GetThread();
      while j <= nn do
      begin
        MyThread[j].Resume; //喚醒線程
        j := j + 1;
      end;
    except
      Showmessage('建立線程失敗!');
      Exit;
    end;
end;
end;

//開始下載前,將ProgressBar1的最大值設置爲須要接收的數據大小.

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

//接收數據的時候,進度將在ProgressBar1顯示出來.

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin
    IdHTTP1.Disconnect; //中斷下載
end;
ProgressBar1. AWorkCount;
//ProgressBar1.; //*******顯示速度極快
Application.ProcessMessages;
//***********************************這樣使用不知道對不對

end;

//中斷下載

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

//狀態顯示

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

//退出程序

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

end;

//循環產生線程

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

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

mStream1.loadfromfile('設備工程進度管理前期規劃.doc' + '1');
while i < nn do
begin
    mStream2.loadfromfile('設備工程進度管理前期規劃.doc' + IntToStr(i + 1));
    mStream1.seek(mStream1.size, soFromBeginning);
    mStream1.copyfrom(mStream2, mStream2.size);
    mStream2.clear;
    i := i + 1;
end;
mStream2.free;
mStream1.SaveToFile('設備工程進度管理前期規劃.doc');
mStream1.free;
//刪除臨時文件
i:=1;
   while i <= nn do
begin
    deletefile('設備工程進度管理前期規劃.doc' + IntToStr(i));
    i := i + 1;
end;
Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功');

end;

//構造函數

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

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

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

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

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

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

end;

procedure TThread1.Execute;
begin
if Form1.Edit1.Text <> '' then
    //synchronize(DownLodeFile)
    DownLodeFile
else
    exit;
inc(tcount);
if tcount = Form1.nn then //當tcount=nn時表明所有下載成功
begin
    //Showmessage('所有下載成功!');
    Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合併刪除臨時文件');
    Form1.AddFile;
end;
end;

end.

 

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

 

在idhttp中如何實現多線程

 

unit1:
       unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation
uses Unit2;

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

{$R *.dfm}

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

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

end.

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

interface

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

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

implementation

uses Unit1;

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

procedure gethtml.Execute;
var
  st: TStringStream;
  IdHTTP: TIdHTTP;
begin
  st := TStringStream.Create('');
  ReturnValue := 10000;
  IdHTTP := TIdHTTP.Create(nil);
  IdHTTP.HandleRedirects := True;
  IdHTTP.ReadTimeout := 60000;
  try
    IdHTTP.Get(furl,st);
    Form1.Memo1.Text := st.DataString;//這裏操做方法有錯誤，麼有同步，多線程等着出錯吧
    //FiState^ := True;
  except
    //FiState^ := False;
  end;  
  IdHTTP.Free;
  st.Free;
  inherited;
end;

end.

 

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

 

相對完整的多線程idhttp文件下載代碼

 

unit Unit1;

interface

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

type
  TThread1 = class(TThread)

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


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

    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure Button2Click(Sender: TObject);
    procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure Button3Click(Sender: TObject);
  private
  public
    nn, aFileSize, avg: integer;
    time1, time2: TDateTime;
    MyThread: array[1..10] of TThread;
    procedure GetThread();
    procedure AddFile();
    procedure NewAddFile();
    function GetURLFileName(aURL: string): string;
    function GetFileSize(aURL: string): integer;
  end;

var
  Form1: TForm1;

implementation
var
  AbortTransfer: Boolean;
  aURL, aFile: string;
  tcount: integer; //檢查文件是否所有下載完畢
{$R *.dfm}

  //get FileName

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

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

//get FileSize

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

//執行下載

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


    if Edit2.Text = '' then
    begin
      case MessageDlg('請輸入線程數，最大支持10個線程，默認爲單線程下載！', mtConfirmation, [mbYes, mbNo], 0) of
        mrYes: nn:=1; //默認
        mrNo: Exit; //從新輸入
      end;
    end
    else
      nn := StrToInt(Edit2.Text); //線程數
      if nn > 10 then
      begin
        raise MyException1.Create('輸入超過線程限制數，請從新輸入！');
      end;
      j := 1;
      aFileSize := GetFileSize(aURL);
      avg := trunc(aFileSize / nn);
      begin
        try
          GetThread();
          while j <= nn do
          begin
            MyThread[j].Resume; //喚醒線程
            j := j + 1;
          end;
        except
          Showmessage('建立線程失敗!');
          Exit;
        end;
      end;
  except
    on E:EConvertError do//捕捉內建的Econverterror異常
    begin
      //ShowMessage('請輸入數字');
      MessageDlg('請輸入數字'+#13,mtError,[mbOK],0);
      Exit;
    end;
    on E:MyException1 do//捕捉自定義的MyException異常
    begin
      MessageDlg(E.Message,mtError,[mbOK],0);
      Edit2.Text:= '';
      Exit;
    end;
    on E:EIdSocketError do//捕捉內建的EIdSocketError異常
    begin
      MessageDlg('鏈接不上服務器，或服務起未開啓！',mtError,[mbOK],0);
      Exit;
    end;
    on E:EIdConnectException do//捕捉內建的EIdSocketError異常
    begin
      MessageDlg('鏈接不上服務器，或服務起未開啓！',mtError,[mbOK],0);
      Exit;
    end;
    on E:EIdHTTPProtocolException do//捕捉內建的EIdSocketError異常
    begin
      MessageDlg('目標文件找不到！',mtError,[mbOK],0);
      Exit;
    end;
  else
    raise //reraise其餘異常

  end;
end;

//開始下載前,將ProgressBar1的最大值設置爲須要接收的數據大小.

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

//接收數據的時候,進度將在ProgressBar1顯示出來.

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

  ProgressBar1.Position := AWorkCount;
  //ProgressBar1.Position:=ProgressBar1.Position+AWorkCount; //*******顯示速度極快
  Application.ProcessMessages;
  //***********************************這樣使用不知道對不對

end;

//中斷下載

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

//狀態顯示

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

//退出程序

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

end;

//循環產生線程

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

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

  mStream1.loadfromfile(afile + '1');
  while i < nn do
  begin
    mStream2.loadfromfile(afile + IntToStr(i + 1));
    mStream1.seek(mStream1.size, soFromBeginning);
    mStream1.copyfrom(mStream2, mStream2.size);
    mStream2.clear;
    i := i + 1;
  end;
  FreeAndNil(mStream2);
  mStream1.SaveToFile(afile);
  FreeAndNil(mStream1);
  //刪除臨時文件
  i:=1;
   while i <= nn do
  begin
    deletefile(afile + IntToStr(i));
    i := i + 1;
  end;
  Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下載成功');
except
    i:=1;
    while i <= nn do
    begin
    if FileExists(aFile+inttostr(i)) then
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;
    ShowMessage('下載文件出錯，臨時文件已刪除，請從新下載！')
  end;

end;

procedure TForm1.NewAddFile(); //合併文件
var
  i: Integer;
  InStream, OutStream : TFileStream;
  SourceFile : String;
begin
  try
    i := 1;
    OutStream:=TFileStream.Create(aFile,fmCreate);
    //OutStream:=TFileStream.Create(('D/1/'+aFile),fmCreate); //此句與savedialog衝突，發生異常，使savedialog指定路徑無效。
    while i <= nn do
    begin
      SourceFile := afile + IntToStr(i);
      InStream:=TFileStream.Create(SourceFile, fmOpenRead);
      OutStream.CopyFrom(InStream,0);
      FreeAndNil(InStream);
      i:= i+1;
    end;
    FreeAndNil(OutStream);
    //刪除臨時文件
    i:=1;
    while i <= nn do
    begin
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;

  except
    i:=1;
    while i <= nn do
    begin
    if FileExists(aFile+inttostr(i)) then
    deletefile(afile + IntToStr(i));
    i := i + 1;
    end;
  end;
  if FileExists(aFile) then
  begin
    FreeAndNil(OutStream);
    InStream := TFileStream.Create(aFile, fmOpenWrite);
    if InStream.Size < aFileSize then
    begin
      FreeAndNil(InStream);
      deletefile(afile);
      //ShowMessage('下載文件出錯，臨時文件已刪除，請從新下載！')
      Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下載文件出錯，臨時文件已刪除，請從新下載！');
    end
    else
    begin
      FreeAndNil(InStream);
      Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功');
    end;
  end;

 
  
end;


//構造函數

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

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

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

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

  try
    ///try
      temhttp.Get(tURL, tStream); //開始下載
    except
      if FileExists(temFileName) then
      begin
      freeandnil(tstream);
      deletefile(temFileName);//原本想用來刪除未下完的文件，惋惜不成功，有的線程沒有刪除，只有部分刪除了，
                              //不過這樣致使後面合併文件時出錯，一樣也能夠把臨時文件刪除。
      //ShowMessage('下載文件出錯，臨時文件已刪除，請從新下載！');/
      end;
      temhttp.Disconnect;
    end;

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

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

end;

procedure TThread1.Execute;
begin

  if Form1.Edit1.Text <> '' then
    //synchronize(DownLodeFile)
    DownLodeFile
  else
    exit;
  inc(tcount);
  if tcount = Form1.nn then //當tcount=nn時表明所有下載成功
  begin
    Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合併刪除臨時文件');
    Form1.NewAddFile;
    form1.time2 := Now;
    Form1.Label5.Caption := FormatDateTime ('n:ss', form1.Time2-Form1.Time1) + ' seconds';
  end;

end;

end. 

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

 

idhttp下載html的代碼(含錯誤處理)

 

IdHTTP_Thread := TIDHTTP.Create;
     IdHTTP_Thread.ReadTimeout  := 240000;
     IdHTTP_Thread.ConnectTimeout := 240000;
     IdHTTP_Thread.Request.UserAgent :='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322)';
     try
       try
         TStmHtml := TStringStream.Create('');
         IdHTTP_Thread.Get(FGetURL,TStmHtml);
         strHtml := TStmHtml.DataString   ;
         //strHtml :=  FParameter;
       except
          on E:EIdSocketError  do
          begin
            FImpInfo := IntToStr(iLoop)+' 得到'+FGetURL+'職位信息時出現錯誤丟失一頁 錯誤緣由: '+SysErrorMessage(E.LastError );
            FErrCode := E.LastError;
            ReGetHtml := True;
          end;
          else
          begin
            FImpInfo := IntToStr(iLoop)+' 得到'+FGetURL+'職位信息時出現錯誤丟失一頁 錯誤緣由: 打開網頁失敗';
            FErrCode := 1 ;
            ReGetHtml := True;
          end;
       end;
     finally
        IdHTTP_Thread.Disconnect ;
        IdHTTP_Thread.Free  ;
        TStmHtml.Free  ;
     end;

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

 

用idhttp提交本身構造過的Cookie

 

如何用idhttp提交本身構造過的Cookie

我不知道的是：若是把本身構造過的Cookie傳給idhttp讓它提交。

好比站點  http://www.aaa.com 是要cookie的。
我已經在程序上放了idhttp和IdCookieManager。
我get  http://www.aaa.com 後，idhttp經過IdCookieManager已經獲得當前站點的Cookie了。
我能夠用
for i := 0 to IdCookieManager1.CookieCollection.Count - 1 do
memo1.Lines.Add(IdCookieManager1.CookieCollection.Items[i].CookieText);
獲得。

如今，若是我想更改這個cookie，或者說我想按這個Cookie的格式從新寫一個，再用idhttp進行post。我應該怎麼作？
用途是Cookie欺騙等。
如：
獲得的Cookie爲：skin=2; ASPSESSIONIDSQTSABQD=IEMKPIDBKKMEEKEHLLOIJJON; UserCode=3CA001D63984E6115FE55681%2E95
我更改成：skin=123; ASPSESSIONIDSQTSABQD=IEMKPIDBKKMEEKEHLLOIJJON; UserCode=3CA001D63984E6115FE55681%2E95
我再post  

今天忙了一個下午，終於研究出答案了。

之前無論是作什麼軟件，只要是關於網頁post提交cookie的，我都是用TcpClient，爲何呢？
由於我一直找不到idhttp提交Cookie的方法，今天終於有告終果。

在Idhttp中，要想修改Cookie的代碼，就要用到Request的RawHeaders中的Values值。
這個值怎麼用呢？
Values接受一個string的值，該值指定了所訪問的變量。
如HTTP頭是這樣定義的(其中一些)：
[color=royalblue]Accept-Language: zh-cn
Content-Type: application/x-www-form-urlencoded
Accept-Encoding: gzip, deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; 
Cookie: JSESSIONID=aoOYvjM-IKzh[/color]
而Values的值就能夠是Cookie，User-Agent，Accept-Encoding……等等。

因此，代碼應該是這樣：
[color=royalblue] try
idhttp1.Request.RawHeaders.Values['Cookie'] := '這裏是cookie的值'; //
memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
idhttp1.Post('/webmail/login.jsp',data1,data2);
memo1.Lines.Add(idhttp1.Request.RawHeaders.Values['Cookie']);
idhttp1.Request.RawHeaders.Values['Cookie'] := 'asdfasdf';
memo1.Lines.Add(idhttp1.Request.RawHeaders.Text);
except
idhttp1.Get(idhttp1.Response.Location, data1);
end;[/color]
初一看，這代碼是沒有什麼問題的。但，memo1的第一次ADD並無任何值，奇怪。
而第三次ADD就被改成了'asdfasdf'，正是咱們所但願的。
我正是卡在了這裏。爲何第一次idhttp1.Request.RawHeaders.Values['Cookie'] := '這裏是cookie的值'; 沒有結果呢？

搞了好久。我才發現，在第一次傳值的時候，RawHeaders跟本沒有被初始化。而第三次通過Post之後，RawHeaders被初始化了，因此獲得了咱們所要的結果。

正確的代碼應該是這樣：
[color=royalblue]try
idhttp1.Request.SetHeaders; //最重要的初始化。
idhttp1.Request.RawHeaders.Values['Cookie'] := '這裏是cookie的值';
idhttp1.Post('/webmail/login.jsp',data1,data2);
except
idhttp1.Get(idhttp1.Response.Location, data1);
end;[/color]

 

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

 

Idhttp自動發貼 for Discuz

 

先是自動登陸函數，登陸後再GET一下取得發貼時要的formhash值，存入全局變量。

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

end;

發一個新主題。fid爲板塊序號

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

回覆主題。tid爲主題序號。

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

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

 

使用Indy9+D7實現CSDN論壇的登陸，回覆，發貼，發短信功能

 

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

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