{******************************************************************}
{ InetUtil.pas                                                     }
{                                                                  }
{ Author    : A.Nasir Senturk                                      }
{ Home Page : http://www.shenturk.com                              }
{ Email     : shenturk@gmail.com                                   }
{                                                                  }
{ Date      : 22.12.2006                                           }
{                                                                  }
{ Sizden iki şey rica edicem:                                      }
{ 1. Lutfen bu baslik kismini kaldirmayiniz.                       }
{ 2. Mumkunse bagis yapiniz.                                       }
{ *****************************************************************}

unit InetUtil;

interface

uses Windows, Messages, SysUtils, Variants, Classes, WinInet;

const
  MAX_STRINGS = 12;
  
type

  TResponse = class;

  { TRequest }
  TRequest = class(TObject)
  private
    FResponse: TResponse;
    FContent: string;
    FVariables: array[0..MAX_STRINGS - 1] of string;
    FInetHandle: HINTERNET;
  protected
    function GetVariable(const Index: Integer): string;
    procedure SetVraiable(const Index: Integer; const Value: string);
  public
    constructor Create;
    destructor Destroy; override;
    property InternetHandle: HINTERNET read FInetHandle write FInetHandle;
    function SendRequest(InetHandle: HINTERNET): Integer;
    property Host: string index 0 read GetVariable write SetVraiable;
    property URL: string index 1 read GetVariable write SetVraiable;
    property Method: string index 2 read GetVariable write SetVraiable;
    property Cookie: string index 3 read GetVariable write SetVraiable;
    property Content: string read FContent write FContent;
    property ContentType: string index 4 read GetVariable write SetVraiable;
    property ContentLength: string index 5 read GetVariable write SetVraiable;
    property Accept: string index 6 read GetVariable write SetVraiable;
    property Connection: string index 7 read GetVariable write SetVraiable;
    property Version: string index 8 read GetVariable write SetVraiable;
    property Response: TResponse read FResponse;
  end;

  { TResponse }
  TResponse = class(TObject)
  private
    FRequestHandle: HINTERNET;
    FVariables: array[0..MAX_STRINGS - 1] of string;
    FContentStream: TMemoryStream;
    function GetVariable(const Index: Integer): string;
    procedure SetVraiable(const Index: Integer; const Value: string);
  protected

  public
    constructor Create(RequestHandle: HINTERNET);
    destructor Destroy; override;
    property SetCookie: string index 4 read GetVariable write SetVraiable;
    property ContentStream: TMemoryStream read FContentStream;
  end;


implementation

{ TRequest }

constructor TRequest.Create;
begin
  inherited Create;
  Method := 'GET';
  Version := 'HTTP/1.1';
  FResponse := TResponse.Create(nil);
end;

destructor TRequest.Destroy;
begin
  FResponse.Free;
  inherited Destroy;
end;

function TRequest.GetVariable(const Index: Integer): string;
begin
  if (Index >= 0) and (Index < MAX_STRINGS) then
    Result := FVariables[Index]
  else Result := '';
end;

function TRequest.SendRequest(InetHandle: HINTERNET): Integer;
var
  Headers: string;
  hConnect, hRequest: HINTERNET;
  Buffer: array[0..8191] of Char;
  dwNumberOfBytes, dwAvailable: DWORD;
  ReadResult: BOOL;

  procedure AddHeaderItem(const Item, FormatStr: string);
  begin
    if Item <> '' then
      Headers := Headers + Format(FormatStr, [Item]);
  end;

  function GetHttpVariable(Index: Integer): string;
  var
    Buffer: array[0..1023] of Char;
    dwLength, dwReserved: DWORD;
  begin
    Result := '';
    dwLength := SizeOf(Buffer);
    dwReserved := 0;
    if HttpQueryInfo(hRequest, Index, @Buffer, dwLength, dwReserved) then
    begin
      SetString(Result, Buffer, dwLength);
      Result := PChar(Result);
    end;
  end;

begin

  Result := -1;

  if not Assigned(InetHandle) then Exit;

  hConnect := InternetConnect(InetHandle, PChar(Host),
    INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);

  if hConnect <> nil then
  begin

    try
      hRequest := HttpOpenRequest(hConnect, PChar(Method), PChar(URL),
        PChar(Version), nil, nil, INTERNET_FLAG_HYPERLINK, 0);

      if hRequest <> nil then
      begin
        try

          AddHeaderItem(Accept, 'Accept: %s'#13#10);
          AddHeaderItem(Cookie, 'Cookie: %s'#13#10);
          AddHeaderItem(Connection, 'Connection: %s'#13#10);
          AddHeaderItem(ContentType, 'Content-Type: %s'#13#10);
          
          if HttpSendRequest(hRequest, PChar(Headers), Length(Headers),
            PChar(Content), Length(Content)) then
          begin

            Response.SetCookie := GetHttpVariable(HTTP_QUERY_SET_COOKIE);

            if InternetQueryDataAvailable(hRequest, dwAvailable, 0, 0) then
            begin
              repeat
                FillChar(Buffer, SizeOf(Buffer), 0);
                ReadResult := InternetReadFile(hRequest, @Buffer, SizeOf(Buffer),
                  dwNumberOfBytes);
                if not ReadResult then Break;
                Response.ContentStream.Write(Buffer, dwNumberOfBytes);
              until dwNumberOfBytes = 0;
              Result := 0;
            end;
          end;

        finally
          InternetCloseHandle(hRequest);
        end;
      end;
    finally
      InternetCloseHandle(hConnect);
    end;

  end;

end;

procedure TRequest.SetVraiable(const Index: Integer; const Value: string);
begin
  if (Index >= 0) and (Index < MAX_STRINGS) then
    FVariables[Index] := Value;
end;

{ TResponse }

constructor TResponse.Create(RequestHandle: HINTERNET);
begin
  inherited Create;
  FRequestHandle := RequestHandle;
  FContentStream := TMemoryStream.Create;
end;

destructor TResponse.Destroy;
begin
  FContentStream.Free;
  inherited Destroy;
end;

function TResponse.GetVariable(const Index: Integer): string;
begin
  if (Index >= 0) and (Index < MAX_STRINGS) then
    Result := FVariables[Index]
  else Result := '';
end;

procedure TResponse.SetVraiable(const Index: Integer; const Value: string);
begin
  if (Index >= 0) and (Index < MAX_STRINGS) then
    FVariables[Index] := Value;
end;

end.