clmultidownloader.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

end;

function TclDownLoadItem.GetLocalFolder(): string;
begin
  Result := GetDownloader().LocalFolder;
end;

function TclDownLoadItem.GetPreviewCharCount(): Integer;
begin
  Result := GetDownloader().PreviewCharCount;
end;

function TclDownLoadItem.GetCorrectResourceTime(): Boolean;
begin
  Result := GetDownLoader().CorrectResourceTime;
end;

procedure TclDownLoadItem.DoDataTextProceed(Text: TStrings);
begin
  GetDownLoader().DoDataTextProceed(Self, Text);
end;

procedure TclDownLoadItem.SetURL(const Value: string);
var
  Corrector: TclUrlCorrector;
  Name: string; 
begin
  if (URL = Value) then Exit;
  inherited SetURL(Value);
  if (csLoading in Control.ComponentState) or (GetLocalFolder() = '') then Exit;
  Corrector := TclUrlCorrector.Create();
  try
    Name := Corrector.GetLocalFileByURL(URL, GetLocalFolder());
    if (Corrector.Extra = '') then
    begin
      LocalFile := Name;
    end else
    begin
      LocalFile := '';
    end;
  finally
    Corrector.Free();
  end;
end;

function TclDownLoadItem.CanDownload(): Boolean;
begin
  Result := not (ResourceState.LastStatus in [psFailed, psTerminated]) and CanProcess();
end;

{$IFDEF DEMO}
{$IFNDEF IDEDEMO}
var
  IsDemoDisplayed: Boolean = False;
{$ENDIF}
{$ENDIF}

procedure TclDownLoadItem.ProcessCompleted(AThreader: TclCustomThreader);
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' +
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end else
{$ENDIF}
  begin
{$IFNDEF IDEDEMO}
    if (not IsDemoDisplayed) and (not IsCertDemoDisplayed)
      and (not IsHttpRequestDemoDisplayed) and (not IsHtmlDemoDisplayed) then
    begin
      IsDemoDisplayed := True;
      IsCertDemoDisplayed := True;
      IsHttpRequestDemoDisplayed := True;
      IsHtmlDemoDisplayed := True;
      MessageBox(0, 'Please visit www.clevercomponents.com to purchase your ' +
        'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    end;
    IsDemoDisplayed := True;
    IsCertDemoDisplayed := True;
    IsHttpRequestDemoDisplayed := True;
    IsHtmlDemoDisplayed := True;
{$ENDIF}
  end;
{$ENDIF}
  if FIsDownloadMode and CanDownload() then
  begin
    FIsDownloadMode := False;
    FIsDownloadProceed := True;
    try
      StartDownload(AThreader.URLParser);
    except
      on E: Exception do
      begin
        DoError(E.Message, 0);
        ResourceState.UpdateStatus(FindStateItem(AThreader), psFailed);
        LastStatusChanged(ResourceState.LastStatus);
        inherited ProcessCompleted(AThreader);
      end;
    end;
  end else
  begin
    if FIsDownloadProceed then
    begin
      FIsDownloadProceed := False;
      DataTextProceed();
    end;
    inherited ProcessCompleted(AThreader);
  end;
end;

procedure TclDownLoadItem.DataTextProceed();
begin
  FPreview.Clear();
  if (GetDataStream() <> nil) then
  begin
    FPreview.Text := GetStreamAsString(GetDataStream(), GetPreviewCharCount(), GetDefaultChar());
  end;
  DoDataTextProceed(FPreview);
end;

function TclDownLoadItem.GetNormThreadCount(): Integer;
begin
  if (GetResourceInfoSize() > 0)
    and ResourceInfo.AllowsRandomAccess
    and (not IsSharedConnection()) then
  begin
    Result := (GetResourceInfoSize() div GetBatchSize());
    if (ThreadCount < Result) then
    begin
      Result := ThreadCount;
    end;
    if (Result < 1) then
    begin
      Result := 1;
    end;
  end else
  begin
    Result := 1;
  end;
end;

procedure TclDownLoadItem.StartDownload(AURLParser: TclUrlParser);
var
  i: Integer;
  Threader: TclCustomThreader;
  Stream: TStream;
  Status: TclProcessStatus;
begin
  Stream := GetDataStream();
  if (Stream <> nil) then
  begin
    Stream.Size := GetResourceInfoSize();
  end;
  Status := ResourceState.LastStatus;
  ResourceState.Init(GetNormThreadCount(), GetResourceInfoSize());
  ResourceState.UpdateStatus(nil, Status);
  for i := 0 to ResourceState.Count - 1 do
  begin
    Threader := AddThreader(ResourceState[i], False);
    Threader.ResourceInfo := ResourceInfo;
    Threader.URLParser := AURLParser;
    Threader.Perform();
  end;
end;

procedure TclDownLoadItem.InternalStart(AIsGetResourceInfo: Boolean);
begin
  FIsDownloadMode := not AIsGetResourceInfo;
  FIsDownloadProceed := False;
  inherited InternalStart(True);
end;

function TclDownLoadItem.CanProcess: Boolean;
begin
  Result := inherited CanProcess();
  if Result and (GetResourceInfoSize() > 0) then
  begin
    Result := CheckSizeValid(GetResourceInfoSize());
  end;
end;

function TclDownLoadItem.GetResourceInfoSize(): Integer;
begin
  if (ResourceInfo <> nil) then
  begin
    Result := ResourceInfo.Size;
  end else
  begin
    Result := 0;
  end;
end;

procedure TclDownLoadItem.LastStatusChanged(Status: TclProcessStatus);
begin
  if FIsDownloadMode and not (Status in [psUnknown, psProcess, {psFailed, }psTerminated]) then
  begin
    Status := psProcess;
  end;
  inherited LastStatusChanged(Status);
end;

function TclDownLoadItem.ExtractFileName(const AContentDisposition: string): string;
begin
  Result := GetHeaderFieldValueItem(AContentDisposition, 'filename=');
end;

procedure TclDownLoadItem.DoGetResourceInfo(AResourceInfo: TclResourceInfo);
var
  Name: string;
begin
  inherited DoGetResourceInfo(AResourceInfo);
  if (AResourceInfo = nil) or TclControlAccess(Control).DoNotGetResourceInfo then Exit;
  if (AResourceInfo.Size = 0) or (not AResourceInfo.AllowsRandomAccess) then
  begin
    ResourceState.Clear();
  end;
  Name := ExtractFileName(AResourceInfo.ContentDisposition);
  if (LocalFile = '') and (Name <> '') and (GetLocalFolder() <> '') then
  begin
    LocalFile := AddTrailingBackSlash(GetLocalFolder()) + Name;
  end;
end;

procedure TclDownLoadItem.DoDestroy;
begin
  FPreview.Free();
  inherited DoDestroy();
  FDataAccessor.Free();
end;

procedure TclDownLoadItem.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if (Source is TclDownLoadItem) then
  begin
    AllowCompression := (Source as TclDownLoadItem).AllowCompression;
  end;
end;

procedure TclDownLoadItem.AssignThreaderParams(AThreader: TclCustomThreader);
begin
  inherited AssignThreaderParams(AThreader);
  AThreader.DataAccessor := FDataAccessor;
  AThreader.AllowCompression := AllowCompression;
end;

{ TclDownLoadList }

function TclDownLoadList.Add: TclDownLoadItem;
begin
  Result := TclDownLoadItem(inherited Add());
  Result.LocalFile := GetFullFileName(Result.LocalFile, DownLoader.LocalFolder);
end;

function TclDownLoadList.GetDownLoader: TclCustomMultiDownLoaderControl;
begin
  Result := (GetOwner() as TclCustomMultiDownLoaderControl);
end;

function TclDownLoadList.GetItem(Index: Integer): TclDownLoadItem;
begin
  Result := TclDownLoadItem(inherited GetItem(Index));
end;

procedure TclDownLoadList.SetItem(Index: Integer; const Value: TclDownLoadItem);
begin
  inherited SetItem(Index, Value);
end;

{ TclCustomMultiDownLoaderControl }

procedure TclCustomMultiDownLoaderControl.AssignSaveToFiles;
var
  i: Integer;
  Item: TclDownLoadItem;
begin
  for i := 0 to DownLoadList.Count - 1 do
  begin
    Item := DownLoadList[i];
    Item.LocalFile := GetFullFileName(Item.LocalFile, FLocalFolder);
  end;
end;

constructor TclCustomMultiDownLoaderControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDownLoadList := TclDownLoadList.Create(Self, TclDownLoadItem);
  FAllowedUrls := TStringList.Create();
  FPreviewCharCount := cPreviewCharCount;
  FCorrectResourceTime := True;
  FIsGrabbing := False;
  GrabOptions := [gaGrabImages];
end;

destructor TclCustomMultiDownLoaderControl.Destroy;
begin
  FAllowedUrls.Free();
  FDownLoadList.Free();
  inherited Destroy();
end;

procedure TclCustomMultiDownLoaderControl.DoDataTextProceed(Item: TclDownLoadItem; Text: TStrings);
begin
  if Assigned(FOnDataTextProceed) then
  begin
    FOnDataTextProceed(Self, Item, Text);
  end;
end;

procedure TclCustomMultiDownLoaderControl.DoCanProcessGrabbedUrl(Item: TclDownLoadItem;
  var CanGrab, Handled: Boolean);
begin
  if Assigned(OnCanProcessGrabbedUrl) then
  begin
    OnCanProcessGrabbedUrl(Self, Item, CanGrab, Handled);
  end;
end;

procedure TclCustomMultiDownLoaderControl.DoExtractUrls(Item: TclDownLoadItem;
  AUrlList: TclUrlList; var Handled: Boolean);
begin
  if Assigned(OnExtractUrls) then
  begin
    OnExtractUrls(Self, Item, AUrlList, Handled);
  end;
end;

procedure TclCustomMultiDownLoaderControl.DoProcessNextUrl(Item: TclDownLoadItem;
  var CanProcess, Handled: Boolean);
begin
  if Assigned(OnProcessNextUrl) then
  begin
    OnProcessNextUrl(Self, Item, CanProcess, Handled);
  end;
end;

function TclCustomMultiDownLoaderControl.CanProcessGrabbedUrl(Item: TclDownLoadItem): Boolean;
var
  handled: Boolean;
begin
  Result := (Item.ResourceState.LastStatus in [psSuccess, psErrors]);
  if not Result then Exit;

  handled := False;
  Result := False;
  DoCanProcessGrabbedUrl(Item, Result, handled);
  if not handled then
  begin
    Result := (Item.ResourceInfo <> nil)
      and (Item.ResourceInfo.StatusCode < HTTP_STATUS_BAD_REQUEST)
      and (system.Pos('html', LowerCase(Item.ResourceInfo.ContentType)) > 0);
  end;
end;

procedure TclCustomMultiDownLoaderControl.ExtractUrls(Item: TclDownLoadItem; AHtml: TStrings; AUrlList: TclUrlList);
var
  i: Integer;
  handled: Boolean;
  parser: TclHtmlParser;
  urlParser: TclUrlParser;
  attr: TclHtmlAttribute;
begin
  handled := False;