jvhttpgrabber.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvHTTPGrabber.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is S閎astien Buysse [sbuysse att buypin dott com]
Portions created by S閎astien Buysse are Copyright (C) 2001 S閎astien Buysse.
All Rights Reserved.

Contributor(s):
  Michael Beck [mbeck att bigfoot dott com],
  Michail Michaylov [[e-mail]].

Last Modified: 2003-06-11

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

{$I jvcl.inc}

{$HPPEMIT '#pragma link "wininet.lib"'}

unit JvHTTPGrabber;

interface

uses
  Windows, SysUtils, Classes, WinInet, SyncObjs,
  JvTypes, JvComponent;

type
  TJvHttpThread = class(TThread)
  private
    FStream: TMemoryStream;
    FUrl: string;
    FReferer: string;
    FUsername: string;
    FFileName: string;
    FPassword: string;
    FOutputMode: TJvOutputMode;
    FOnError: TJvErrorEvent;
    FOnDoneFile: TJvDoneFileEvent;
    FOnDoneStream: TJvDoneStreamEvent;
    FOnProgress: TJvHTTPProgressEvent;
    FAgent: string;
    FBytesRead: Integer;
    FTotalBytes: Integer;
    FErrorText: string;
    FOnStatus: TJvFTPProgressEvent;
    FContinue: Boolean;
    FCriticalSection: TCriticalSection;
    function GetLastErrorMsg: string;
  protected
    procedure Error;
    procedure Progress;
    procedure Ended;
    procedure Execute; override;
  public
    constructor Create(Url, Referer, Username, FileName, Password: string;
      OutPutMode: TJvOutputMode; AOnError: TJvErrorEvent;
      AOnDoneFile: TJvDoneFileEvent; AOnDoneStream: TJvDoneStreamEvent;
      AOnProgress: TJvHTTPProgressEvent; Agent: string;
      AOnStatus: TJvFTPProgressEvent);
    destructor Destroy; override;
  end;

  TJvHTTPGrabber = class(TJvComponent)
  private
    FThread: TJvHttpThread;
    FUrl: string;
    FReferer: string;
    FUsername: string;
    FFileName: TFileName;
    FPassword: string;
    FOutputMode: TJvOutputMode;
    FOnError: TJvErrorEvent;
    FOnDoneFile: TJvDoneFileEvent;
    FOnDoneStream: TJvDoneStreamEvent;
    FOnProgress: TJvHTTPProgressEvent;
    FAgent: string;
    FOnReceived: TNotifyEvent;
    FOnResolving: TNotifyEvent;
    FOnConnecting: TNotifyEvent;
    FOnConnected: TNotifyEvent;
    FOnResolved: TNotifyEvent;
    FOnRedirect: TNotifyEvent;
    FOnStateChange: TNotifyEvent;
    FOnSent: TNotifyEvent;
    FOnSending: TNotifyEvent;
    FOnReceiving: TNotifyEvent;
    FOnClosed: TNotifyEvent;
    FOnClosing: TNotifyEvent;
    FOnRequest: TNotifyEvent;
    procedure ThreadFinished(Sender: TObject);
    procedure Error(Sender: TObject; ErrorMsg: string);
    procedure DoneFile(Sender: TObject; FileName: string; FileSize: Integer; Url: string);
    procedure DoneStream(Sender: TObject; FStream: TStream; StreamSize: Integer; Url: string);
    procedure Progress(Sender: TObject; UserData, Position, TotalSize: Integer; Url: string; var Continue: Boolean);
    procedure Status(Sender: TObject; Position: Integer; Url: string);
    function GetWorking: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Execute;
    procedure Abort;
    property Working: Boolean read GetWorking;
  published
    property Url: string read FUrl write FUrl;
    property Username: string read FUsername write FUsername;
    property Password: string read FPassword write FPassword;
    property Referer: string read FReferer write FReferer;
    property FileName: TFileName read FFileName write FFileName;
    property OutputMode: TJvOutputMode read FOutputMode write FOutputMode default omStream;
    property Agent: string read FAgent write FAgent;
    property OnDoneFile: TJvDoneFileEvent read FOnDoneFile write FOnDoneFile;
    property OnDoneStream: TJvDoneStreamEvent read FOnDoneStream write FOnDoneStream;
    property OnError: TJvErrorEvent read FOnError write FOnError;
    property OnProgress: TJvHTTPProgressEvent read FOnProgress write FOnProgress;
    property OnResolvingName: TNotifyEvent read FOnResolving write FOnResolving;
    property OnResolvedName: TNotifyEvent read FOnResolved write FOnResolved;
    property OnConnectingToServer: TNotifyEvent read FOnConnecting write FOnConnecting;
    property OnConnectedToServer: TNotifyEvent read FOnConnected write FOnConnected;
    property OnSendingRequest: TNotifyEvent read FOnSending write FOnSending;
    property OnRequestSent: TNotifyEvent read FOnSent write FOnSent;
    property OnReceivingResponse: TNotifyEvent read FOnReceiving write FOnReceiving;
    property OnReceivedResponse: TNotifyEvent read FOnReceived write FOnReceived;
    property OnClosingConnection: TNotifyEvent read FOnClosing write FOnClosing;
    property OnClosedConnection: TNotifyEvent read FOnClosed write FOnClosed;
    property OnRequestComplete: TNotifyEvent read FOnRequest write FOnRequest;
    property OnRedirect: TNotifyEvent read FOnRedirect write FOnRedirect;
    property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  end;

resourcestring
  SURLIsEmpty = 'URL is empty';
  
implementation

uses
  JvResources;

//=== TJvHTTPGrabber =========================================================

constructor TJvHTTPGrabber.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUrl := '';
  FUsername := '';
  FPassword := '';
  FReferer := '';
  FFileName := '';
  FOutputMode := omStream;
  FAgent := RsAgent;
  FThread := nil;
end;

destructor TJvHTTPGrabber.Destroy;
begin
  if FThread <> nil then
  begin
    FThread.FreeOnTerminate := True;
    FThread.Terminate;
    FThread.WaitFor;
    FThread.Free;
  end;
  inherited Destroy;
end;

procedure TJvHTTPGrabber.Abort;
begin
  if FThread <> nil then
  begin
    FThread.Suspend;
    FThread.FOnError := nil;
    FThread.FOnDoneFile := nil;
    FThread.FOnDoneStream := nil;
    FThread.FOnProgress := nil;
    FThread.FContinue := False;
    FThread := nil;
  end;
end;

procedure TJvHTTPGrabber.DoneFile(Sender: TObject; FileName: string;
  FileSize: Integer; Url: string);
begin
  if Assigned(FOnDoneFile) then
    FOnDoneFile(Self, FileName, FileSize, Url);
  FThread := nil;
end;

procedure TJvHTTPGrabber.DoneStream(Sender: TObject; FStream: TStream;
  StreamSize: Integer; Url: string);
begin
  if Assigned(FOnDoneStream) then
    FOnDoneStream(Self, FStream, StreamSize, Url);
  FThread := nil;
end;

procedure TJvHTTPGrabber.Error(Sender: TObject; ErrorMsg: string);
begin
  if Assigned(FOnError) then
    FOnError(Self, ErrorMsg);
end;

procedure TJvHTTPGrabber.Execute;
begin
  //Download it
  if (FThread = nil) then
  begin
    FThread := TJvHttpThread.Create(Url, Referer, Username, FileName, Password,
      OutPutMode, Error, DoneFile, DoneStream, Progress, Agent, Status);
    FThread.OnTerminate := ThreadFinished;
    FThread.Resume;
    FThread.WaitFor;
  end;
end;

function TJvHTTPGrabber.GetWorking: Boolean;
begin
  Result := FThread <> nil;
end;

procedure TJvHTTPGrabber.Progress(Sender: TObject; UserData, Position,
  TotalSize: Integer; Url: string; var Continue: Boolean);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self, UserData, Position, TotalSize, Url, Continue);
end;

procedure TJvHTTPGrabber.Status(Sender: TObject; Position: Integer;
  Url: string);
begin
  case Position of
    INTERNET_STATUS_RESOLVING_NAME:
      if Assigned(FOnResolving) then
        FOnResolving(Self);
    INTERNET_STATUS_NAME_RESOLVED:
      if Assigned(FOnResolved) then
        FOnResolved(Self);
    INTERNET_STATUS_CONNECTING_TO_SERVER:
      if Assigned(FOnConnecting) then
        FOnConnecting(Self);
    INTERNET_STATUS_CONNECTED_TO_SERVER:
      if Assigned(FOnConnected) then
        FOnConnected(Self);
    INTERNET_STATUS_SENDING_REQUEST:
      if Assigned(FOnSending) then
        FOnSending(Self);
    INTERNET_STATUS_REQUEST_SENT:
      if Assigned(FOnSent) then
        FOnSent(Self);
    INTERNET_STATUS_RECEIVING_RESPONSE:
      if Assigned(FOnReceiving) then
        FOnReceiving(Self);
    INTERNET_STATUS_RESPONSE_RECEIVED:
      if Assigned(FOnReceived) then