jvurllistgrabber.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: JvUrlListGrabber.Pas, released on 2003-08-04.

The Initial Developer of the Original Code is Olivier Sannier [obones att altern dott org]
Portions created by Olivier Sannier are Copyright (C) 2003 Olivier Sannier.
All Rights Reserved.

Contributor(s): -

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:
-----------------------------------------------------------------------------}
// $Id: JvUrlListGrabber.pas,v 1.39 2005/02/17 10:21:17 marquardt Exp $

unit JvUrlListGrabber;

interface

{$I jvcl.inc}

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

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Classes, SysUtils, Contnrs,
  JvComponent, JvTypes;

type
  // early declarations
  TJvUrlListGrabber = class;
  TJvCustomUrlGrabber = class;
  TJvUrlGrabberList = class;
  TJvUrlGrabberDefaultPropertiesList = class;

  // A Grabber index, defined as a new type to allow to give it
  // a specific property editor
  TJvUrlGrabberIndex = type Integer;

  // The type of the events triggered when one of the grabbers
  // has triggered its own event to indicate a change in its state
  TJvGrabberNotifyEvent = procedure(Sender: TJvUrlListGrabber; Grabber: TJvCustomUrlGrabber) of object;

  // Set of type of events triggered by TJvUrlListGrabber to indicate that
  // one of its grabbers has triggered the corresponding event
  TJvGrabberDoneFileEvent = procedure(Sender: TJvUrlListGrabber; Grabber: TJvCustomUrlGrabber; FileName: string;
    FileSize: Integer; Url: string) of object;
  TJvGrabberDoneStreamEvent = procedure(Sender: TJvUrlListGrabber; Grabber: TJvCustomUrlGrabber; Stream: TStream;
    StreamSize: Integer; Url: string) of object;
  TJvGrabberProgressEvent = procedure(Sender: TJvUrlListGrabber; Grabber: TJvCustomUrlGrabber; Position, TotalSize:
    Int64; Url: string; var Continue: Boolean) of object;
  TJvGrabberErrorEvent = procedure(Sender: TJvUrlListGrabber; Grabber: TJvCustomUrlGrabber; ErrorMsg: string) of object;

  // The exception raised by TJvUrlListGrabber when no grabber claimed it was capable
  // of handling a given URL. This is only raised if DefaultGrabberIndex is -1
  ENoGrabberForUrl = class(Exception);

  // This component allows the user to specify a list of URLs to be
  // grabbed and then start grabbing. All the grab operations will be done
  // in parallel in the background, leaving the user's application free
  // to continue its operations
  TJvUrlListGrabber = class(TJvComponent)
  private
    FOnDoneFile: TJvGrabberDoneFileEvent;
    FOnDoneStream: TJvGrabberDoneStreamEvent;
    FOnError: TJvGrabberErrorEvent;
    FOnProgress: TJvGrabberProgressEvent;
    FOnConnectionClosed: TJvGrabberNotifyEvent;
    FOnReceivingResponse: TJvGrabberNotifyEvent;
    FOnRequestComplete: TJvGrabberNotifyEvent;
    FOnResponseReceived: TJvGrabberNotifyEvent;
    FOnConnectingToServer: TJvGrabberNotifyEvent;
    FOnResolvingName: TJvGrabberNotifyEvent;
    FOnClosingConnection: TJvGrabberNotifyEvent;
    FOnConnectedToServer: TJvGrabberNotifyEvent;
    FOnRedirect: TJvGrabberNotifyEvent;
    FOnNameResolved: TJvGrabberNotifyEvent;
    FOnSendingRequest: TJvGrabberNotifyEvent;
    FOnRequestSent: TJvGrabberNotifyEvent;
    FOnStatusChange: TJvGrabberNotifyEvent;

    FCleanupThreshold: Cardinal;
    FGrabbers: TJvUrlGrabberList;
    FURLs: TStringList;
    FDefaultGrabberIndex: TJvUrlGrabberIndex;
    FDefaultGrabbersProperties: TJvUrlGrabberDefaultPropertiesList;

    // gets/sets the URLs property, assigning the given strings
    // to the internal FURLs field
    function GetURLs: TStrings;
    procedure SetURLs(const Value: TStrings);
    // sets the Default Grabber value, ensuring that it doesn't go
    // below -1 or above the number of registered grabber classes
    // if you try to set the value above the last index in the
    // JvUrlGrabberClassList, then the value will be set to -1.
    // The same goes if you set a value below -1.
    procedure SetDefaultGrabberIndex(const Value: TJvUrlGrabberIndex);
    // returns the grabber associated with the given index
    function GetGrabbers(const Index: Integer): TJvCustomUrlGrabber;
    // Called whenever the list of Urls has changed
    procedure URLsChange(Sender: TObject);
    // Sets the events of the given grabber to call the internal
    // event handlers indicated below. This way, the events of
    // TJvUrlListGrabber will be triggered properly
    procedure SetGrabberEvents(Grabber: TJvCustomUrlGrabber);
    // The event handlers for the grabbers, to propagate them to the
    // user through the events of this class
    procedure GrabberDoneFile(Grabber: TObject; FileName: string; FileSize: Integer; Url: string);
    procedure GrabberDoneStream(Grabber: TObject; Stream: TStream; StreamSize: Integer; Url: string);
    procedure GrabberProgress(Grabber: TObject; Position, TotalSize: Int64; Url: string; var Continue: Boolean);
    procedure GrabberError(Grabber: TObject; ErrorMsg: string);
    procedure GrabberConnectionClosed(Grabber: TObject);
    procedure GrabberReceivingResponse(Grabber: TObject);
    procedure GrabberRequestComplete(Grabber: TObject);
    procedure GrabberResponseReceived(Grabber: TObject);
    procedure GrabberConnectingToServer(Grabber: TObject);
    procedure GrabberResolvingName(Grabber: TObject);
    procedure GrabberClosingConnection(Grabber: TObject);
    procedure GrabberConnectedToServer(Grabber: TObject);
    procedure GrabberRedirect(Grabber: TObject);
    procedure GrabberNameResolved(Grabber: TObject);
    procedure GrabberSendingRequest(Grabber: TObject);
    procedure GrabberRequestSent(Grabber: TObject);
    procedure GrabberStatusChange(Grabber: TObject);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    // cleans up the internal list of grabbers
    procedure Cleanup;
    // starts all the grabbers
    procedure StartAll;
    // stops all the grabbers
    procedure StopAll;
    // the Grabber objects associated with the Urls
    property Grabbers[const Index: Integer]: TJvCustomUrlGrabber read GetGrabbers;
  published
    // the index of the default grabber to use, if any
    property DefaultGrabberIndex: TJvUrlGrabberIndex read FDefaultGrabberIndex write SetDefaultGrabberIndex default -1;

    // the cleanup threshold. When the difference between Urls.Count
    // and the internal Grabber count is greater than this value
    // the process of cleaning if launched. This can take some time
    // and this is why it's not done every time
    property CleanupThreshold: Cardinal read FCleanupThreshold write FCleanupThreshold default 10;

    // The Urls to grab
    property URLs: TStrings read GetURLs write SetURLs;
    // The default properties for each family of grabber
    property DefaultGrabbersProperties: TJvUrlGrabberDefaultPropertiesList read FDefaultGrabbersProperties;

    // Events
    property OnDoneFile: TJvGrabberDoneFileEvent read FOnDoneFile write FOnDoneFile;
    property OnDoneStream: TJvGrabberDoneStreamEvent read FOnDoneStream write FOnDoneStream;
    property OnError: TJvGrabberErrorEvent read FOnError write FOnError;
    property OnProgress: TJvGrabberProgressEvent read FOnProgress write FOnProgress;
    property OnResolvingName: TJvGrabberNotifyEvent read FOnResolvingName write FOnResolvingName;
    property OnNameResolved: TJvGrabberNotifyEvent read FOnNameResolved write FOnNameResolved;
    property OnConnectingToServer: TJvGrabberNotifyEvent read FOnConnectingToServer write FOnConnectingToServer;
    property OnConnectedToServer: TJvGrabberNotifyEvent read FOnConnectedToServer write FOnConnectedToServer;
    property OnSendingRequest: TJvGrabberNotifyEvent read FOnSendingRequest write FOnSendingRequest;
    property OnRequestSent: TJvGrabberNotifyEvent read FOnRequestSent write FOnRequestSent;
    property OnRequestComplete: TJvGrabberNotifyEvent read FOnRequestComplete write FOnRequestComplete;
    property OnReceivingResponse: TJvGrabberNotifyEvent read FOnReceivingResponse write FOnReceivingResponse;
    property OnResponseReceived: TJvGrabberNotifyEvent read FOnResponseReceived write FOnResponseReceived;
    property OnClosingConnection: TJvGrabberNotifyEvent read FOnClosingConnection write FOnClosingConnection;
    property OnConnectionClosed: TJvGrabberNotifyEvent read FOnConnectionClosed write FOnConnectionClosed;
    property OnRedirect: TJvGrabberNotifyEvent read FOnRedirect write FOnRedirect;
    property OnStatusChange: TJvGrabberNotifyEvent read FOnStatusChange write FOnStatusChange;
  end;

  // forward declarations
  TJvCustomUrlGrabberThread = class;
  TJvCustomUrlGrabberThreadClass = class of TJvCustomUrlGrabberThread;
  TJvCustomUrlGrabberDefaultProperties = class;

  // a trick for the Delphi editor that allows to have a sub object
  // for each member of the a TJvUrlGrabberDefaultPropertiesList
  // Because an indexed property cannot be published, the editor
  // for TJvUrlGrabberDefaultPropertiesList enumerates all the
  // items in the list, and passes the EditorTrick property of
  // each of its TJvUrlGrabberDefaultProperties members. The
  // trick contains only one published property that gets displayed
  // and this property points to the TJvUrlGrabberDefaultPropertiesList
  // object to which the trick belongs, thus allowing to publish
  // the indexed property. The only drawback is that the name
  // in the property editor for each object is the same, DefaultProperties
  // Hence, the need for an editor for TJvUrlGrabberDefPropEdTrick that
  // displays a meaningful name instead
  TJvUrlGrabberDefPropEdTrick = class(TPersistent)
  private
    FDefaultProperties: TJvCustomUrlGrabberDefaultProperties;
  public
    constructor Create(GrabberDefaults: TJvCustomUrlGrabberDefaultProperties); reintroduce; virtual;
  published
    property DefaultProperties: TJvCustomUrlGrabberDefaultProperties read FDefaultProperties;
  end;

  // A container for Default properties, and a list of such
  // containers
  TJvCustomUrlGrabberDefaultProperties = class(TPersistent)
  private
    FEditorTrick: TJvUrlGrabberDefPropEdTrick;
    // agent to impersonate
    FAgent: string;
    // Port to connect to
    FPort: Cardinal;
    // user information
    FUserName: string;
    FPassword: string;
    // filename to use
    FFileName: TFileName;
    // output mode (stream or file)
    FOutputMode: TJvOutputMode;
  protected
    // The user-friendly name of the supported URL type
    function GetSupportedURLName: string; virtual; abstract;
    // The agent to impersonate
    property Agent: string read FAgent write FAgent;
    // The port to connect to
    property Port: Cardinal read FPort write FPort;
    // the user name and password to use for authentication
    property UserName: string read FUserName write FUserName;
    property Password: string read FPassword write FPassword;
  public
    constructor Create(AOwner: TJvUrlGrabberDefaultPropertiesList); reintroduce; virtual;
    destructor Destroy; override;
    // for some odd reason, Assign needs to be overriden
    procedure Assign(Source: TPersistent); override;
    property EditorTrick: TJvUrlGrabberDefPropEdTrick read FEditorTrick;
    property SupportedURLName: string read GetSupportedURLName;
  published
    // the name of the file to write to if OutputMode is omFile
    property FileName: TFileName read FFileName write FFileName;
    // The output mode
    property OutputMode: TJvOutputMode read FOutputMode write FOutputMode default omStream;
  end;

  TJvCustomUrlGrabberDefaultPropertiesClass = class of TJvCustomUrlGrabberDefaultProperties;

  TJvUrlGrabberDefaultPropertiesList = class(TPersistent)
  private
    FItems: TObjectList;
    function GetItemsNamed(Name: string): TJvCustomUrlGrabberDefaultProperties;
    function GetCount: Integer;
    function GetItems(Index: Integer): TJvCustomUrlGrabberDefaultProperties;
    procedure SetItems(Index: Integer; const Value: TJvCustomUrlGrabberDefaultProperties);
  public
    constructor Create(AOwner: TJvUrlListGrabber); reintroduce; virtual;
    destructor Destroy; override;
    procedure Read(Reader: TReader);
    procedure Write(Writer: TWriter);
    procedure Clear;
    procedure Add(Item: TJvCustomUrlGrabberDefaultProperties);
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TJvCustomUrlGrabberDefaultProperties read GetItems write SetItems;
    property ItemsNamed[Name: string]: TJvCustomUrlGrabberDefaultProperties read GetItemsNamed; default;
  end;

  // the status of a grabber
  TJvGrabberStatus = (gsStopped, gsConnecting, gsGrabbing, gsStopping);

  // The exception triggered if someone tries to set the Url property while the
  // grabber is not stopped
  EGrabberNotStopped = class(Exception);

  // The event type used when a grabbing has had some progress
  TJvUrlGrabberProgressEvent = procedure(Sender: TObject; Position, TotalSize: Int64;
    Url: string; var Continue: Boolean) of object;

  // The ancestor of all the Url Grabbers that declares the required
  // methods that a grabber must provide.
  // Do not instanciate a TJvCustomUrlGrabber directly, simply use one
  // of its descendants. This family of classes is used by
  // TJvUrlListGrabber to allow downloading a list of URLs but can
  // also be used on their own to grad one URL of a given type.
  TJvCustomUrlGrabber = class(TJvComponent)
  private
    FId: Integer;
    // the thread that will grab for us
    FUrlGrabberThread: TJvCustomUrlGrabberThread;
    // events
    FOnDoneFile: TJvDoneFileEvent; // file is done
    FOnDoneStream: TJvDoneStreamEvent; // stream is done
    FOnError: TJvErrorEvent; // error occured
    FOnProgress: TJvUrlGrabberProgressEvent; // download progressed a bit
    FOnClosed: TNotifyEvent; // connection is closed
    FOnReceiving: TNotifyEvent; // beginning to receive
    FOnReceived: TNotifyEvent; // end of reception
    FOnConnecting: TNotifyEvent; // beginning of connection
    FOnResolving: TNotifyEvent; // beginning of resolving URL
    FOnRedirect: TNotifyEvent; // redirection happened
    FOnConnected: TNotifyEvent; // now connected to host
    //FOnStateChange: TNotifyEvent; // state of connection changed
    FOnResolved: TNotifyEvent; // name has been resolved
    FOnClosing: TNotifyEvent; // beginning of close of connection
    FOnRequest: TNotifyEvent; // sending a request
    FOnSent: TNotifyEvent; // data sent
    FOnSending: TNotifyEvent; // beginning to send data
    FOnStatusChange: TNotifyEvent; // Status changed
    // current status of the grabber
    FStatus: TJvGrabberStatus;
    // URL to grab
    FUrl: string;
    // the stream to grab into.
    FStream: TMemoryStream;
    // agent to impersonate
    FAgent: string;
    // port to connect to
    FPort: Cardinal;
    // user information
    FUserName: string;
    FPassword: string;
    // filename to use
    FFileName: TFileName;
    // output mode (stream or file)
    FOutputMode: TJvOutputMode;
    // size of the file to grab
    FSize: Int64;
    // What has been read so far
    FBytesRead: Int64;