{*******************************************************}
{                                                       }
{       InterThr.pas                                    }
{                                                       }
{                                                       }
{       Author  : A. Nasir Senturk                      }
{       Website : http://www.shenturk.com               }
{       E-Mail  : freedelphi@shenturk.com               }
{       Create  : 07.12.2006                            }
{       Update  : 21.03.2008                            }
{                                                       }
{*******************************************************}

unit InterThr;

interface

uses Windows, Messages, Classes, Forms;

const
  WM_WEATHERDONE  = WM_USER + 10;
  WM_IPADDRDONE   = WM_USER + 12;
  WM_CHECKVERDONE = WM_USER + 13;

const
  { v1.50 }
  { Jadelax Massage Ranges }
  CM_JADELAXBASE   = WM_USER + 1331;
  CM_RESTOREAPP    = CM_JADELAXBASE + 1;
  CM_EXITAPP       = CM_JADELAXBASE + 2;
  CM_RESTARTAPP    = CM_JADELAXBASE + 3;
  CM_INSTTHEME     = CM_JADELAXBASE + 4;
  CM_STARTSERVER   = CM_JADELAXBASE + 5;
  CM_STOPSERVER    = CM_JADELAXBASE + 6;
  CM_RESTARTSERVER = CM_JADELAXBASE + 7;

  CM_BASE        = CM_JADELAXBASE + 100;

type
  TInternetThread = class(TThread)
  private
    FControl: TForm;
    FURL: string;
    FResponseText: string;
    FStatus: Integer;
    FMessageCode: Cardinal;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean; AControl: TForm;
      const URL: string; const AMessageCode: Cardinal);
    property ResponseText: string read FResponseText;
    property Status: Integer read FStatus;
    property Terminated;
  end;

implementation

uses WinInet;

constructor TInternetThread.Create(CreateSuspended: Boolean; AControl: TForm;
  const URL: string; const AMessageCode: Cardinal);
begin
  inherited Create(CreateSuspended);
  FURL := URL;
  FControl := AControl;
  FMessageCode := AMessageCode;
  FResponseText := '';
end;

procedure TInternetThread.Execute;

  function GetXMLPage(const URL: string; out XMLPage: string): Integer;
  var
    hRootHandle, hUrlDump: HINTERNET;
    Buffer: array[0..8192] of Char;
    dwNumberOfBytes: DWORD;
    Stream: TStringStream;
    ReadResult: BOOL;
  begin

    Result := -1;

    hRootHandle := InternetOpen('FreeDelphi Weather XML',
      INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

    if hRootHandle = nil then Exit;

    hUrlDump := InternetOpenUrl(hRootHandle, PChar(URL), nil, 0,
      INTERNET_FLAG_RESYNCHRONIZE, 0);

    if hUrlDump <> nil then
    begin
      Stream := TStringStream.Create('');
      try
        repeat
          FillChar(Buffer, SizeOf(Buffer), 0);
          ReadResult := InternetReadFile(hUrlDump, @Buffer, SizeOf(Buffer), dwNumberOfBytes);
          if not ReadResult then Break;
          Stream.Write(Buffer, dwNumberOfBytes);
        until dwNumberOfBytes = 0;
        XMLPage := Stream.DataString;
        Result := 0;
      finally
        Stream.Free;
      end;
      InternetCloseHandle(hUrlDump);
    end;

    InternetCloseHandle(hRootHandle);

  end;

begin
  FStatus := GetXMLPage(FURL, FResponseText);
  PostMessage(FControl.Handle, FMessageCode, 0, FStatus);
end;

end.