jvqurllistgrabber.pas

East make Tray Icon in delphi

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

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

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

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

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

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

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

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

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

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

procedure TJvUrlListGrabber.GrabberDoneFile(Grabber: TObject; FileName: string;
  FileSize: Integer; Url: string);
begin
  if Assigned(OnDoneFile) then
    OnDoneFile(Self, TJvCustomUrlGrabber(Grabber), FileName, FileSize, Url);
end;

procedure TJvUrlListGrabber.GrabberDoneStream(Grabber: TObject; Stream: TStream;
  StreamSize: Integer; Url: string);
begin
  if Assigned(OnDoneStream) then
    OnDoneStream(Self, TJvCustomUrlGrabber(Grabber), Stream, StreamSize, Url);
end;

procedure TJvUrlListGrabber.GrabberError(Grabber: TObject; ErrorMsg: string);
begin
  if Assigned(OnError) then
    OnError(Self, TJvCustomUrlGrabber(Grabber), ErrorMsg);
end;

procedure TJvUrlListGrabber.GrabberProgress(Grabber: TObject; Position, TotalSize: Int64;
  Url: string; var Continue: Boolean);
begin
  if Assigned(OnProgress) then
    OnProgress(Self, TJvCustomUrlGrabber(Grabber), Position, TotalSize, Url, Continue);
end;

//=== { TJvCustomUrlGrabber } ================================================

constructor TJvCustomUrlGrabber.Create(AOwner: TComponent; AUrl: string;
  DefaultProperties: TJvCustomUrlGrabberDefaultProperties);
begin
  inherited Create(AOwner);
  FUrlGrabberThread := nil;

  // get values from the default properties
  Agent := DefaultProperties.Agent;
  UserName := DefaultProperties.UserName;
  Password := DefaultProperties.Password;
  FileName := DefaultProperties.FileName;
  OutputMode := DefaultProperties.OutputMode;
  Port := DefaultProperties.Port;

  // Set the URL at the end so that the SetUrl method is called
  // and might setup the various other properties automatically
  Url := AUrl;
end;

constructor TJvCustomUrlGrabber.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  // Set default properties
  Agent := JediAgent;
  Port := 0;
  UserName := '';
  Password := '';
  FileName := DefaultOutputFileName;
  OutputMode := omFile;
end;

destructor TJvCustomUrlGrabber.Destroy;
begin
  Stop;  // Stop grabbing
  inherited Destroy;
end;

class function TJvCustomUrlGrabber.CanGrab(const Url: string): Boolean;
begin
  // useless implementation required for BCB compatibility as
  // C++ doesn't support abstract virtual class methods
  Result := False;
end;

procedure TJvCustomUrlGrabber.SetUrl(Value: string);
var
  ProtocolMarker: string;
  TmpHostName: string;
  TmpFileName: string;
  TmpUserName: string;
  TmpPassword: string;
  TmpPort: Cardinal;
begin
  if Status = gsStopped then
  begin
    // if the given URL contains Port, UserName and Password informations, we set the
    // different properties of the grabber automatically
    ProtocolMarker := GetSupportedProtocolMarker;
    ParseUrl(Value, ProtocolMarker, TmpHostName, TmpFileName, TmpUserName, TmpPassword, TmpPort);
    if TmpUserName <> '' then
      UserName := TmpUserName;
    if TmpPassword <> '' then
      Password := TmpPassword;
    if TmpPort <> 0 then
      Port := TmpPort;

    FUrl := ProtocolMarker;
    if TmpHostName <> '' then
      FUrl := FUrl + TmpHostName + '/';
    if TmpFileName <> '' then
      FUrl := FUrl + TmpFileName;
  end
  else
    raise EGrabberNotStopped.CreateRes(@RsEGrabberNotStopped);
end;

procedure TJvCustomUrlGrabber.DoClosed;
begin
  if Assigned(FOnClosed) then
    FOnClosed(Self);
end;

procedure TJvCustomUrlGrabber.DoEnded;
begin
  Stream.Position := 0;
  if FOutputMode = omStream then
  begin
    if Assigned(FOnDoneStream) then
      FOnDoneStream(Self, Stream, Stream.Size, FUrl);
  end
  else
  begin
    Stream.SaveToFile(FFileName);
    if Assigned(FOnDoneFile) then
      FOnDoneFile(Self, FFileName, Stream.Size, FUrl);
  end;
end;

procedure TJvCustomUrlGrabber.DoError(ErrorMsg: string);
begin
  if Assigned(FOnError) then
    FOnError(Self, ErrorMsg);
end;

procedure TJvCustomUrlGrabber.DoProgress(Position: Integer; var Continue: Boolean);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self, Position, FSize, Url, Continue);
end;

procedure TJvCustomUrlGrabber.DoStatus;
begin
  if Assigned(FOnStatusChange) then
    FOnStatusChange(Self);
end;

class function TJvCustomUrlGrabber.GetDefaultPropertiesClass: TJvCustomUrlGrabberDefaultPropertiesClass;
begin
  // useless implementation for BCB Compatibility
  Result := nil;
end;

procedure TJvCustomUrlGrabber.Start;
begin
  // Stop the grabbing before restarting
  Stop;

  // Create a new thread
  FUrlGrabberThread := GetGrabberThreadClass.Create(Self);
  FUrlGrabberThread.Resume;
end;

procedure TJvCustomUrlGrabber.Stop;
begin
  if Assigned(FUrlGrabberThread) then
  begin
    // If there is a thread, terminate it and let it destroy
    // itself as we don't need it anymore
    FUrlGrabberThread.FreeOnTerminate := True;
    FUrlGrabberThread.Terminate;
  end;
end;

procedure TJvCustomUrlGrabber.SetSize(Value: Int64);
begin
  FSize := Value;
end;

procedure TJvCustomUrlGrabber.SetBytesRead(Value: Int64);
begin
  FBytesRead := Value;
end;

class function TJvCustomUrlGrabber.GetSupportedProtocolMarker: string;
begin
  // Useless implementation for BCB compatibility
  Result := '';
end;

class function TJvCustomUrlGrabber.GetSupportedURLName: string;
begin
  // Useless implementation for BCB compatibility
  Result := '';
end;

procedure TJvCustomUrlGrabber.ParseUrl(URL: string; Protocol: string;
  var Host: string; var FileName: string; var UserName: string;
  var Password: string; var Port: Cardinal);
begin
  // Default return values
  Host := '';
  FileName := '';
  UserName := '';
  Password := '';
  Port := 0;

  // Remove the protocol part from the given Value
  if Pos(UpperCase(Protocol), UpperCase(URL)) <> 0 then
    URL := Copy(URL, Length(Protocol) + 1, Length(URL));

  // Get the filename, if any
  if Pos('/', URL) <> 0 then
  begin
    Host := Copy(URL, 1, Pos('/', URL) - 1);
    FileName := Copy(URL, Pos('/', URL) + 1, Length(URL));
  end
  else
    Host := URL;

  // Get the username password couple
  if Pos('@', Host) <> 0 then
  begin
    UserName := Copy(Host, 1, Pos('@', Host) - 1);
    Host := Copy(Host, Pos('@', Host) + 1, Length(Host));
    // now, figure out if there is a password
    if Pos(':', UserName) <> 0 then
    begin
      UserName := Copy(UserName, 1, Pos(':', UserName) - 1);
      Password := Copy(UserName, Pos(':', UserName) + 1, Length(UserName));
    end;
  end;

  // Get the port
  if Pos(':', Host) <> 0 then
  begin
    Host := Copy(Host, 1, Pos(':', Host) - 1);
    Port := StrToIntDef(Copy(Host, Pos(':', Host) + 1, Length(Host)), 0);
  end;
end;

//=== { TJvUrlGrabberList } ==================================================

function TJvUrlGrabberList.Add(AGrabber: TJvCustomUrlGrabber): Integer;
begin
  Result := inherited Add(AGrabber);
end;

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

procedure TJvUrlGrabberList.Insert(Index: Integer; AGrabber: TJvCustomUrlGrabber);
begin
  inherited Insert(Index, AGrabber);
end;

procedure TJvUrlGrabberList.SetItem(Index: Integer; const AGrabber: TJvCustomUrlGrabber);
begin
  inherited Items[Index] := AGrabber;
end;

//=== { TJvCustomUrlGrabberClassList } =======================================

function TJvUrlGrabberClassList.Add(AGrabberClass: TJvCustomUrlGrabberClass): Integer;
begin
  Result := inherited Add(AGrabberClass);
end;

function TJvUrlGrabberClassList.CreateFor(Owner: TComponent; Url: string;
  DefaultPropertiesList: TJvUrlGrabberDefaultPropertiesList): TJvCustomUrlGrabber;
var
  I: Integer;
begin
  I := 0;
  Result := nil;