jvqurllistgrabber.pas

East make Tray Icon in delphi

  while (I < Count) and not Assigned(Result) do
  begin
    if Items[I].CanGrab(Url) then
      Result := Items[I].Create(Owner, Url, DefaultPropertiesList.Items[I]);
    Inc(I);
  end;
end;

function TJvUrlGrabberClassList.GetItem(Index: Integer): TJvCustomUrlGrabberClass;
begin
  Result := TJvCustomUrlGrabberClass(inherited Items[Index]);
end;

procedure TJvUrlGrabberClassList.Insert(Index: Integer;
  AGrabberClass: TJvCustomUrlGrabberClass);
begin
  inherited Insert(Index, AGrabberClass);
end;

procedure TJvUrlGrabberClassList.Populate(DefaultPropertiesList: TJvUrlGrabberDefaultPropertiesList);
var
  I: Integer;
begin
  DefaultPropertiesList.Clear;
  for I := 0 to Count - 1 do
    DefaultPropertiesList.Add(Items[I].GetDefaultPropertiesClass.Create(DefaultPropertiesList));
end;

procedure TJvUrlGrabberClassList.SetItem(Index: Integer;
  const AGrabberClass: TJvCustomUrlGrabberClass);
begin
  inherited Items[Index] := AGrabberClass;
end;

//=== { TJvCustomUrlGrabberThread } ==========================================

constructor TJvCustomUrlGrabberThread.Create(Grabber: TJvCustomUrlGrabber);
begin
  inherited Create(True);
  FContinue := True;
  FGrabber := Grabber;
end;

procedure TJvCustomUrlGrabberThread.DoProgress;
begin
  Synchronize(UpdateGrabberProgress);
end;

procedure TJvCustomUrlGrabberThread.DoStatus;
begin
  Synchronize(UpdateGrabberStatus);
end;

procedure TJvCustomUrlGrabberThread.Ended;
begin
  FGrabber.DoEnded;
end;

procedure TJvCustomUrlGrabberThread.Error;
begin
  FGrabber.FStatus := gsStopped;
  FGrabber.DoError(FErrorText);
end;

procedure TJvCustomUrlGrabberThread.SetGrabberStatus(
  Status: TJvGrabberStatus);
begin
  FGrabber.FStatus := Status;
end;

procedure TJvCustomUrlGrabberThread.UpdateGrabberProgress;
begin
  FGrabber.DoProgress(FGrabber.BytesRead, FContinue);
end;

procedure TJvCustomUrlGrabberThread.UpdateGrabberStatus;
begin
  FGrabber.DoStatus;
end;

//=== { TJvUrlGrabberDefaultPropertiesList } =================================

constructor TJvUrlGrabberDefaultPropertiesList.Create(AOwner: TJvUrlListGrabber);
begin
  inherited Create;
  FItems := TObjectList.Create(True);
  JvUrlGrabberClassList.Populate(Self);
end;

destructor TJvUrlGrabberDefaultPropertiesList.Destroy;
begin
  FItems.Free;
  inherited Destroy;
end;

procedure TJvUrlGrabberDefaultPropertiesList.Add(Item: TJvCustomUrlGrabberDefaultProperties);
begin
  FItems.Add(Item);
end;

procedure TJvUrlGrabberDefaultPropertiesList.Clear;
begin
  FItems.Clear;
end;

function TJvUrlGrabberDefaultPropertiesList.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TJvUrlGrabberDefaultPropertiesList.GetItems(Index: Integer): TJvCustomUrlGrabberDefaultProperties;
begin
  Result := TJvCustomUrlGrabberDefaultProperties(FItems[Index]);
end;

procedure TJvUrlGrabberDefaultPropertiesList.SetItems(Index: Integer;
  const Value: TJvCustomUrlGrabberDefaultProperties);
begin
  FItems[Index] := Value;
end;

function TJvUrlGrabberDefaultPropertiesList.GetItemsNamed(Name: string): TJvCustomUrlGrabberDefaultProperties;
var
  I: Integer;
begin
  I := 0;
  Result := nil;
  while (I < Count) and (Result = nil) do
  begin
    if Items[I].SupportedURLName = Name then
      Result := Items[I];
    Inc(I);
  end;
end;

//=== { TJvUrlGrabberDefPropEdTrick } ========================================

constructor TJvUrlGrabberDefPropEdTrick.Create(GrabberDefaults: TJvCustomUrlGrabberDefaultProperties);
begin
  if Assigned(GrabberDefaults) then
    FDefaultProperties := GrabberDefaults;
end;

//=== { TDFMPropertiesCollection } ===========================================

type
  // In order to store the Default Properties for every possible
  // grabber class, we have to deal with it ourselves. This is not
  // an easy task because the types of the default property holders
  // are not known while writing this class. Moreover, the streaming
  // system used by Delphi is not really well documented and the
  // only (not so) elegant way I found to stream the list of default
  // properties holder is to use WriteCollection and ReadCollection.
  // To do this, we need a collection but having TJvUrlGrabberDefaultPropertiesList
  // as a TCollection is too problematic because its members are
  // always descendents of TJvCustomUrlGrabberDefaultProperties.
  // So what I do here is to have a TCollection/TCollectionItem couple
  // that will be used to read and write the list from the DFM.
  // It works quite well and shouldn't need much improvement.
  TDFMPropertiesCollectionItem = class(TCollectionItem)
  private
    FOwnValue: Boolean;
    FValue: TJvCustomUrlGrabberDefaultProperties;
    FUrlType: string;
    procedure SetValue(const Value: TJvCustomUrlGrabberDefaultProperties);
    procedure SetUrlType(const Value: string);
  public
    destructor Destroy; override;
    constructor Create(Collection: TCollection); override;
  published
    property UrlType: string read FUrlType write SetUrlType;
    property Value: TJvCustomUrlGrabberDefaultProperties read FValue write SetValue;
  end;

  TDFMPropertiesCollection = class(TCollection)
  public
    constructor Create; reintroduce; overload;
    constructor Create(List: TJvUrlGrabberDefaultPropertiesList); reintroduce; overload;
  end;

constructor TDFMPropertiesCollection.Create;
begin
  inherited Create(TDFMPropertiesCollectionItem);
end;

constructor TDFMPropertiesCollection.Create(List: TJvUrlGrabberDefaultPropertiesList);
var
  I: Integer;
begin
  inherited Create(TDFMPropertiesCollectionItem);
  for I := 0 to List.Count - 1 do
  begin
    Add;
    TDFMPropertiesCollectionItem(Items[Count - 1]).Value := List.Items[I];
  end;
end;

//=== { TDFMPropertiesCollectionItem } =======================================

constructor TDFMPropertiesCollectionItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
end;

destructor TDFMPropertiesCollectionItem.Destroy;
begin
  if FOwnValue then
    FValue.Free;
  inherited Destroy;
end;

procedure TDFMPropertiesCollectionItem.SetValue(const Value: TJvCustomUrlGrabberDefaultProperties);
begin
  FValue := Value;
  FOwnValue := False;
  if Assigned(FValue) then
    FUrlType := FValue.GetSupportedURLName;
end;

procedure TDFMPropertiesCollectionItem.SetUrlType(const Value: string);
var
  I: Integer;
begin
  FUrlType := Value;
  if not Assigned(FValue) then
  begin
    for I := 0 to JvUrlGrabberClassList.Count - 1 do
      if JvUrlGrabberClassList[I].GetSupportedURLName = Value then
      begin
        FOwnValue := True;
        FValue := JvUrlGrabberClassList[I].GetDefaultPropertiesClass.Create(nil);
      end;
  end;
end;

//=== { TJvCustomUrlGrabberDefaultProperties } ===============================

constructor TJvCustomUrlGrabberDefaultProperties.Create(AOwner: TJvUrlGrabberDefaultPropertiesList);
begin
  inherited Create;
  FEditorTrick := TJvUrlGrabberDefPropEdTrick.Create(Self);

  FFileName := DefaultOutputFileName;
  FAgent := JediAgent;
  FUserName := '';
  FPassword := '';
  FFileName := DefaultOutputFileName;
  FOutputMode := omFile;
end;

destructor TJvCustomUrlGrabberDefaultProperties.Destroy;
begin
  FEditorTrick.Free;
  inherited Destroy;
end;

procedure TJvCustomUrlGrabberDefaultProperties.Assign(Source: TPersistent);
begin
  if Source is TJvCustomUrlGrabberDefaultProperties then
    with Source as TJvCustomUrlGrabberDefaultProperties do
    begin
      Self.Agent := Agent;
      Self.Port := Port;
      Self.Password := Password;
      Self.UserName := UserName;
      Self.FileName := FileName;
      Self.OutputMode := OutputMode;
    end
  else
    inherited Assign(Source);
end;

procedure TJvUrlGrabberDefaultPropertiesList.Read(Reader: TReader);
var
  I, J: Integer;
  TmpColl: TDFMPropertiesCollection;
begin
  // WARNING: The call to ReadValue is essential for the collection to
  // be read correctly. Somehow, WriteCollection writes something that
  // ReadCollection won't read on its own.
  Reader.ReadValue;

  TmpColl := TDFMPropertiesCollection.Create;
  try
    Reader.ReadCollection(TmpColl);
    for I := 0 to TmpColl.Count - 1 do
    begin
      for J := 0 to Count - 1 do
        if TDFMPropertiesCollectionItem(TmpColl.Items[I]).Value.GetSupportedURLName = Items[I].GetSupportedURLName then
          Items[I].Assign(TDFMPropertiesCollectionItem(TmpColl.Items[I]).Value);
    end;
  finally
    TmpColl.Free;
  end;
end;

procedure TJvUrlGrabberDefaultPropertiesList.Write(Writer: TWriter);
var
  TmpColl: TDFMPropertiesCollection;
begin
  TmpColl := TDFMPropertiesCollection.Create(Self);
  try
    Writer.WriteCollection(TmpColl);
  finally
    TmpColl.Free;
  end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQUrlListGrabber.pas,v $';
    Revision: '$Revision: 1.22 $';
    Date: '$Date: 2005/02/06 14:06:32 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  FreeAndNil(GJvUrlGrabberClassList);

  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.