{******************************************************************}
{ 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;

var
  CallbackProc: INTERNET_STATUS_CALLBACK = nil;

type

  { Forward declaration }
  TInetResponse = class;

  { TInetRequest }
  TInetRequest = class(TObject)
  private
    FResponse: TInetResponse;
    FContent: string;
    FVariables: array[0..MAX_STRINGS - 1] of string;
    FContext: Pointer;
  protected
    function GetVariable(const Index: Integer): string;
    procedure SetVraiable(const Index: Integer; const Value: string);
  public
    constructor Create;
    destructor Destroy; override;
    property Context: Pointer read FContext write FContext;
    function SendRequest: 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: TInetResponse read FResponse;
  end;

  { TInetResponse }
  TInetResponse = 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);
    function GetString: string;
  protected

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

{ OpenInternet }
function OpenInternet: Boolean;

{ CloseInternet }
procedure CloseInternet;

implementation

var
  Internet: HINTERNET = nil;

{ OpenInternet }
function OpenInternet: Boolean;
begin
  if Internet = nil then
  begin
    Internet := InternetOpen('Exploit Explorer v1.0',
      INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    Result := Internet <> nil;
    if Result and Assigned(CallbackProc) then
      InternetSetStatusCallback(Internet, CallbackProc);
  end;
end;

{ CloseInternet }
procedure CloseInternet;
begin
  if Internet <> nil then
    if InternetCloseHandle(Internet) then
      Internet := nil;
end;

{ TInetRequest }

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

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

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

function TInetRequest.SendRequest: 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(Internet) then Exit;

  hConnect := InternetConnect(Internet, PChar(Host),
    INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, Cardinal(FContext));

  if hConnect <> nil then
  begin

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

      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);

            repeat
              if InternetQueryDataAvailable(hRequest, dwAvailable, 0, Cardinal(FContext)) then
              begin
                FillChar(Buffer, SizeOf(Buffer), 0);
                ReadResult := InternetReadFile(hRequest, @Buffer, SizeOf(Buffer), dwNumberOfBytes);
                if (not ReadResult) and (GetLastError() <> ERROR_IO_PENDING) then
                begin
                  Result := -1;
                  Break;
                end;
                Response.ContentStream.Write(Buffer, dwNumberOfBytes);
              end
              else begin
                if GetLastError() <> ERROR_IO_PENDING then
                begin
                  Result := -1;
                  Break;
                end;
              end;
            until dwNumberOfBytes = 0;
            Result := 0;
          end;
        {
        HttpEndRequest(hRequest, nil, 0, 0);
        }
        finally
          InternetCloseHandle(hRequest);
        end;
      end;
    finally
      InternetCloseHandle(hConnect);
    end;

  end;

end;

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

{ TInetResponse }

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

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

function TInetResponse.GetString: string;
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create('');
  try
    ContentStream.SaveToStream(Stream);
    Result := Stream.DataString;
  finally
    Stream.Free;
  end;
end;

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

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

initialization
  OpenInternet;

finalization
  CloseInternet;

end.