jvqurllistgrabber.pas

East make Tray Icon in delphi

  protected
    // Event callers
    procedure DoError(ErrorMsg: string);
    procedure DoProgress(Position: Integer; var Continue: Boolean);
    procedure DoStatus; virtual;
    procedure DoEnded;
    procedure DoClosed;
    procedure SetSize(Value: Int64);
    procedure SetBytesRead(Value: Int64);
    function GetGrabberThreadClass: TJvCustomUrlGrabberThreadClass; virtual; abstract;
    procedure SetUrl(Value: string); virtual;
    property UrlGrabberThread: TJvCustomUrlGrabberThread read FUrlGrabberThread;
    property Stream: TMemoryStream read FStream write FStream;
  public
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AOwner: TComponent; AUrl: string;
      DefaultProperties: TJvCustomUrlGrabberDefaultProperties); reintroduce; overload;
    destructor Destroy; override;
    // this function must return True if the given URL can be grabbed
    // by the class being asked. It returns False otherwise
    // It MUST be overriden in the derived classes but cannot be abstract
    // because of BCB compatibility issues (no support for abstract
    // - pure virtual - class functions in the C++ language)
    class function CanGrab(const Url: string): Boolean; virtual;
    // This function returns the class of a property holder to
    // be displayed in the object inspector. This property holder
    // will be used by TJvUrlListGrabber to let the user specify default
    // properties and will be passed to this class when created to
    // handle a specific URL.
    // It MUST be overriden in the derived classes but cannot be abstract
    // because of BCB compatibility issues (no support for abstract
    // - pure virtual - class functions in the C++ language)
    class function GetDefaultPropertiesClass: TJvCustomUrlGrabberDefaultPropertiesClass; virtual;
    // This function returns the marker that indicates the protocol in a URL.
    // For instance, for an HTTP grabber, this would return 'http://'
    // It MUST be overriden in the derived classes but cannot be abstract
    // because of BCB compatibility issues (no support for abstract
    // - pure virtual - class functions in the C++ language)
    class function GetSupportedProtocolMarker: string; virtual;
    // this function must return a user displayable string indicating
    // the type of URL that class of grabber supports.
    // It MUST be overriden in the derived classes but cannot be abstract
    // because of BCB compatibility issues (no support for abstract
    // - pure virtual - class functions in the C++ language)
    class function GetSupportedURLName: string; virtual;
    // Splits the given URL into its various parts, if indicated
    // A URL respects this format:
    // protocol [username[:password]@] host [:port] [/filename]
    // When a non compulsory part is missing the exit value of the
    // associated parameter will be an empty string or 0
    procedure ParseUrl(URL: string; Protocol: string; var Host: string; var FileName: string;
      var UserName: string; var Password: string; var Port: Cardinal); virtual;
    // Asks to Start to grab the URL
    procedure Start; virtual;
    // Asks to Stop to grab the URL
    procedure Stop; virtual;
    // The status of the grab
    property Status: TJvGrabberStatus read FStatus;
    // The size of the file being grabbed
    property Size: Int64 read FSize;
    // What has been read so far
    property BytesRead: Int64 read FBytesRead;
    // the Url being grabbed
    property Url: string read FUrl write SetUrl;
    // 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;
    // 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 omFile;
    // The agent to impersonate
    property Agent: string read FAgent write FAgent;
    // A numerical Id, to be freely used by the user of the component
    property Id: Integer read FId write FId;
    // Events
    property OnDoneFile: TJvDoneFileEvent read FOnDoneFile write FOnDoneFile;
    property OnDoneStream: TJvDoneStreamEvent read FOnDoneStream write FOnDoneStream;
    property OnError: TJvErrorEvent read FOnError write FOnError;
    property OnProgress: TJvUrlGrabberProgressEvent read FOnProgress write FOnProgress;
    property OnResolvingName: TNotifyEvent read FOnResolving write FOnResolving;
    property OnNameResolved: 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 OnRequestComplete: TNotifyEvent read FOnRequest write FOnRequest;
    property OnReceivingResponse: TNotifyEvent read FOnReceiving write FOnReceiving;
    property OnResponseReceived: TNotifyEvent read FOnReceived write FOnReceived;
    property OnClosingConnection: TNotifyEvent read FOnClosing write FOnClosing;
    property OnConnectionClosed: TNotifyEvent read FOnClosed write FOnClosed;
    property OnRedirect: TNotifyEvent read FOnRedirect write FOnRedirect;
    property OnStatusChange: TNotifyEvent read FOnStatusChange write FOnStatusChange;
  end;

  // A thread that will grab the given URL in the background
  // this is the ancestor of all the grabber threads, and there
  // should be as many descendants as there are TJvCustomUrlGrabber
  // descendants.
  TJvCustomUrlGrabberThread = class(TThread)
  private
    FErrorText: string; // the error string received from the server
    FStatus: DWORD;
    FContinue: Boolean;
  protected
    FGrabber: TJvCustomUrlGrabber;
    procedure Error;
    procedure Ended;
    procedure UpdateGrabberProgress;
    procedure UpdateGrabberStatus;

    // Procedure used by derived classes to set the value of FStatus
    // which is a private member of TJvCustomUrlGrabber
    procedure SetGrabberStatus(Status: TJvGrabberStatus);

    property ErrorText: string read FErrorText write FErrorText;
    property Continue: Boolean read FContinue write FContinue;
  public
    constructor Create(Grabber: TJvCustomUrlGrabber); virtual;
    procedure DoProgress;
    procedure DoStatus;
    property Status: DWORD read FStatus write FStatus;
  end;

  // A list of instances of TJvUrlGrabber descendants
  // This is used internally by TJvUrlListGrabber to keep track of
  // the objects in charge of every URLs it has to grab
  TJvUrlGrabberList = class(TObjectList)
  private
    function GetItem(Index: Integer): TJvCustomUrlGrabber;
    procedure SetItem(Index: Integer; const AGrabber: TJvCustomUrlGrabber);
  public
    function Add(AGrabber: TJvCustomUrlGrabber): Integer;
    procedure Insert(Index: Integer; AGrabber: TJvCustomUrlGrabber);
    property Items[Index: Integer]: TJvCustomUrlGrabber read GetItem write SetItem; default;
  end;

  TJvCustomUrlGrabberClass = class of TJvCustomUrlGrabber;

  // A list of classes inheriting from TJvCustomUrlGrabber
  // This is the type of list used by the JvUrlGrabberClassList
  // function that returns all the registered classes.
  // This list is then used by TJvUrlListGrabber to determine which
  // class is best suited for handling a given URL
  TJvUrlGrabberClassList = class(TClassList)
  private
    function GetItem(Index: Integer): TJvCustomUrlGrabberClass;
    procedure SetItem(Index: Integer; const AGrabberClass: TJvCustomUrlGrabberClass);
  public
    procedure Populate(DefaultPropertiesList: TJvUrlGrabberDefaultPropertiesList);
    function Add(AGrabberClass: TJvCustomUrlGrabberClass): Integer;
    procedure Insert(Index: Integer; AGrabberClass: TJvCustomUrlGrabberClass);
    function CreateFor(Owner: TComponent; Url: string; DefaultPropertiesList: TJvUrlGrabberDefaultPropertiesList):
      TJvCustomUrlGrabber;
    property Items[Index: Integer]: TJvCustomUrlGrabberClass read GetItem write SetItem; default;
  end;

function JvUrlGrabberClassList: TJvUrlGrabberClassList;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQConsts, JvQResources,
  // JvUrlGrabbers MUST be included here so that the grabbers
  // it contains are registered before any JvUrlListGrabber
  // component reads its properties.
  JvQUrlGrabbers;

var
  // the global object to contain the list of registered
  // url grabber classes
  GJvUrlGrabberClassList: TJvUrlGrabberClassList = nil;

function JvUrlGrabberClassList: TJvUrlGrabberClassList;
begin
  if not Assigned(GJvUrlGrabberClassList) then
    GJvUrlGrabberClassList := TJvUrlGrabberClassList.Create;
  Result := GJvUrlGrabberClassList;
end;

//=== { TJvUrlListGrabber } ==================================================

constructor TJvUrlListGrabber.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDefaultGrabbersProperties := TJvUrlGrabberDefaultPropertiesList.Create(Self);
  FGrabbers := TJvUrlGrabberList.Create(True);
  FURLs := TStringList.Create;
  FURLs.OnChange := URLsChange;
  FDefaultGrabberIndex := -1;
  FCleanupThreshold := 10;
end;

destructor TJvUrlListGrabber.Destroy;
begin
  FURLs.Free;
  FGrabbers.Free;
  FDefaultGrabbersProperties.Free;
  inherited Destroy;
end;

procedure TJvUrlListGrabber.Cleanup;
var
  I: Integer;
begin
  // try to find each created grabber in the string list
  // if not found, mark the object as nil which in turn
  // will delete it
  for I := 0 to FGrabbers.Count - 1 do
    if FURLs.IndexOfObject(FGrabbers[I]) = -1 then
      FGrabbers[I] := nil;
  // pack the list
  FGrabbers.Pack;
end;

function TJvUrlListGrabber.GetGrabbers(const Index: Integer): TJvCustomUrlGrabber;
begin
  Result := TJvCustomUrlGrabber(FURLs.Objects[Index]);
end;

procedure TJvUrlListGrabber.SetDefaultGrabberIndex(const Value: TJvUrlGrabberIndex);
begin
  if Value < -1 then
    FDefaultGrabberIndex := -1
  else
  if Value > JvUrlGrabberClassList.Count - 1 then
    FDefaultGrabberIndex := -1
  else
    FDefaultGrabberIndex := Value;
end;

function TJvUrlListGrabber.GetURLs: TStrings;
begin
  Result := FURLs;
end;

procedure TJvUrlListGrabber.SetURLs(const Value: TStrings);
begin
  FURLs.Assign(Value);
end;

procedure TJvUrlListGrabber.StartAll;
var
  I: Integer;
begin
  for I := 0 to FURLs.Count - 1 do
    Grabbers[I].Start;
end;

procedure TJvUrlListGrabber.StopAll;
var
  I: Integer;
begin
  for I := 0 to FURLs.Count - 1 do
    Grabbers[I].Stop;
end;

procedure TJvUrlListGrabber.URLsChange(Sender: TObject);
var
  I: Integer;
  TmpGrabber: TJvCustomUrlGrabber;
begin
  for I := 0 to FURLs.Count - 1 do
  begin
    if not Assigned(FURLs.Objects[I]) then
    begin
      TmpGrabber := JvUrlGrabberClassList.CreateFor(Self, FURLs[I], FDefaultGrabbersProperties);
      if Assigned(TmpGrabber) then
        FURLs.Objects[I] := TmpGrabber
      else
      if DefaultGrabberIndex > -1 then
        FURLs.Objects[I] := JvUrlGrabberClassList[DefaultGrabberIndex].Create(Self, FURLs[I],
          FDefaultGrabbersProperties.Items[DefaultGrabberIndex])
      else
        raise ENoGrabberForUrl.CreateResFmt(@RsENoGrabberForUrl, [FURLs[I]]);

      // add in the list of owned objects
      FGrabbers.Add(TJvCustomUrlGrabber(FURLs.Objects[I]));
      SetGrabberEvents(TJvCustomUrlGrabber(FURLs.Objects[I]));
      if Cardinal(FGrabbers.Count - FURLs.Count) > FCleanupThreshold then
        Cleanup;
    end;
  end;
end;

procedure TJvUrlListGrabber.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('DefaultGrabbersPropertiesList',
    DefaultGrabbersProperties.Read, DefaultGrabbersProperties.Write, True);
end;

procedure TJvUrlListGrabber.SetGrabberEvents(Grabber: TJvCustomUrlGrabber);
begin
  Grabber.OnClosingConnection := GrabberClosingConnection;
  Grabber.OnConnectedToServer := GrabberConnectedToServer;
  Grabber.OnConnectingToServer := GrabberConnectingToServer;
  Grabber.OnConnectionClosed := GrabberConnectionClosed;
  Grabber.OnNameResolved := GrabberNameResolved;
  Grabber.OnReceivingResponse := GrabberReceivingResponse;
  Grabber.OnRedirect := GrabberRedirect;
  Grabber.OnRequestComplete := GrabberRequestComplete;
  Grabber.OnRequestSent := GrabberRequestSent;
  Grabber.OnResolvingName := GrabberResolvingName;
  Grabber.OnResponseReceived := GrabberResponseReceived;
  Grabber.OnSendingRequest := GrabberSendingRequest;
  Grabber.OnStatusChange := GrabberStatusChange;
  Grabber.OnError := GrabberError;
  Grabber.OnProgress := GrabberProgress;
  Grabber.OnDoneFile := GrabberDoneFile;
  Grabber.OnDoneStream := GrabberDoneStream;
end;

procedure TJvUrlListGrabber.GrabberClosingConnection(Grabber: TObject);
begin
  if Assigned(OnClosingConnection) then
    OnClosingConnection(Self, TJvCustomUrlGrabber(Grabber));
end;

procedure TJvUrlListGrabber.GrabberConnectedToServer(Grabber: TObject);
begin
  if Assigned(OnConnectedToServer) then
    OnConnectedToServer(Self, TJvCustomUrlGrabber(Grabber));
end;

procedure TJvUrlListGrabber.GrabberConnectingToServer(Grabber: TObject);
begin
  if Assigned(OnConnectingToServer) then
    OnConnectingToServer(Self, TJvCustomUrlGrabber(Grabber));
end;