Http Get Winsock Delphi

2012-08-07

執筆：2012.08.07
編集：2012.08.07

こんな時に使えます。
・Indyを使いたくないとき
サイズが大きくなる。
・Indyのライセンスが嫌い
・Indyのバグにつきあいたくない

Indyだと
s := IdHTTP1.Get(URL);
の１行で済みます。
※文字コードが破壊される場合は、
別記事の「Win32 SJISで、Idhttp.Getすると壊れる理由」
を参照のこと

Wininet.dllの
InternetOpenUrl
でも、似たようなことはできますが
今回は割愛します。

簡易の Http 取得関数を作ってみましょう

TTcpClientを使うと受信できないことがあるので
TClientWinSocketを使うのがミソです。

下記のサンプルをuses節に加えて
s := HttpGetContents(Hostname , URI);
の１行で済みます。

ただし、サンプルは、
https通信未対応です。
リダイレクトやエラー処理も入っていません

また、 HTTP/1.1でリクエストすると
Contents取得部の処理が面倒なので
HTTP/1.0でリクエストしています。

unit Unit1;

interface

uses
SysUtils, Classes
, WinSock , ScktComp // TClientWinSocket
;

function HttpGetContents(AHost , AURI : string;
            TimeOut : Integer = 1500) : string;

implementation

function HttpGetContents(AHost , AURI : string;
            TimeOut : Integer = 1500) : string;
var
    AClient : TClientWinSocket;
    AClientIOStream : TWinSocketStream;
    RequestHeader : string;
    User_Agent : string;
    ResponseHeader : string;

    ContentsStream : TMemoryStream;

function SendRequest : Boolean;
    var
      tmp_i : Integer;
begin
    Result := False;
    RequestHeader :=
        'GET '   + AURI + ' HTTP/1.0' + sLineBreak
      + 'Host: ' + AHost + sLineBreak
      + 'Accept: text/html, */*' + sLineBreak
      + 'Accept-Encoding: identity' + sLineBreak
      + 'User-Agent: ' + User_Agent + sLineBreak
//       + 'Referer: ' + sLineBreak
      + sLineBreak;

    tmp_i := AClientIOStream.Write(
               RequestHeader[1]
             , Length(RequestHeader)
               );
    if (tmp_i = Length(RequestHeader)) then
      Result := True;
end;
{   CGI-Response = *( CGI-Header | HTTP-Header ) NL [ Entity-Body ] }
function ReceiveHeader : boolean;
var
    c : Char;
    i : Integer;
    empty_line : Boolean;
begin
    Result := False;
    empty_line := True;
    repeat
      AClientIOStream.WaitForData(TimeOut);
      i := AClientIOStream.Read(c , 1);
      if (i <= 0) then
        Exit;
      ResponseHeader := ResponseHeader + c;
      case c of
        #10 :
         begin
           if empty_line then
            begin
              Result := True;
              Exit;
            end;
            empty_line := True;
         end;
        #13 :
           begin
           end;
        else
           empty_line := False;
      end; // case
    until Not( i > 0);
end;

function ReceiveContents : boolean;
    var
     buf : array[0..256] of Char;
     ret : Integer;
     bufSize : Integer;
begin
    bufSize := SizeOf(buf);
    repeat
      Result := AClientIOStream.WaitForData(TimeOut);
      // TimeOut
      if Result = False then
        begin
//        Raise Exception.Create('Time Out');
          Exit;
        end;
      ret := AClientIOStream.Read( buf[0] , bufSize);
      if (ret <= 0) then
         Break;
      ContentsStream.Write( buf[0] , ret);
    until Not (ret > 0);
end;
begin
Result := '';
ResponseHeader := '';

User_Agent := 'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1)';

AClient := TClientWinSocket.Create(WinSock.INVALID_SOCKET);

try
    AClient.ClientType := ctBlocking;
//    AClient.Open(AHost,'','',80); // Host，Address，Service，Port
    AClient.Open(AHost,'','http', 0); // Host，Address，Service，Port

//    if Not AClient.Connected then
//       Raise Exception.Create('Can not connect to '+AHost);

    if AClient.Connected then
     try
       AClientIOStream := TWinSocketStream.Create(AClient, TimeOut);
       try
         ContentsStream := TMemoryStream.Create;
         try
           if SendRequest() and ReceiveHeader()
              and ReceiveContents() then
            begin
              // 受信成功
              if ContentsStream.Size > 0 then
              begin
                SetLength(Result , ContentsStream.Size);
                Move(PChar(ContentsStream.Memory)^
                     , Result[1]
                     , ContentsStream.Size);
              end;
            end;
         finally
           ContentsStream.Free;
         end;
       finally
         AClientIOStream.Free;
       end;
     finally
       AClient.Close;
     end;
finally
    AClient.Free;
end;
end;

end.

キーワード：
・Http Get
・Winsock
・Delphi
・TClientWinSocket
・Timeout
・HTTP/1.0

Amazon search for: C#

　関連記事はありません。

ブログ内　関連記事: Http Get Winsock

　無料などオンラインゲーム一覧表　

このページの上へ▲

ブログ内　関連記事: Http Get Winsock

Amazon search for: C#

　関連記事はありません。

トラックバック

トラックバックはありません。

タイトル

Sidebar