main.pas

这是一套全面的网络组件

var
  Item: TclInternetItem;
begin
  if FIsLoading then Exit;
  Item := GetSelectedItem();
  if (Item <> nil) then
  begin
    Item.LocalFile := edtFile.Text;
  end;
end;

procedure TDownLoaderTest.edtUserChange(Sender: TObject);
var
  Item: TclInternetItem;
begin
  if FIsLoading then Exit;
  Item := GetSelectedItem();
  if (Item <> nil) then
  begin
    Item.UserName := edtUser.Text;
  end;
end;

procedure TDownLoaderTest.edtPasswordChange(Sender: TObject);
var
  Item: TclInternetItem;
begin
  if FIsLoading then Exit;
  Item := GetSelectedItem();
  if (Item <> nil) then
  begin
    Item.Password := edtPassword.Text;
  end;
end;

procedure TDownLoaderTest.edtThreadCountChange(Sender: TObject);
var
  Item: TclInternetItem;
begin
  if FIsLoading then Exit;
  Item := GetSelectedItem();
  if (Item <> nil) then
  begin
    Item.ThreadCount := updThreadCount.Position;
  end;
end;

procedure TDownLoaderTest.edtDirectoryChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.LocalFolder := edtDirectory.Text;
end;

procedure TDownLoaderTest.chkPassiveFTPModeClick(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.PassiveFTPMode := chkPassiveFTPMode.Checked;
end;

procedure TDownLoaderTest.edtHttpProxyChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.HttpProxySettings.Server := edtHttpProxy.Text;
end;

procedure TDownLoaderTest.edtProxyBypassChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.ProxyBypass.Text := Trim(edtProxyBypass.Text);
end;

procedure TDownLoaderTest.FormCreate(Sender: TObject);
var
  i: TclProcessPriority;
begin
  FcmbPriority := TDownLoadComboBox.Create(Self);
  FcmbPriority.Parent := edtPriority.Parent;
  FcmbPriority.Left := edtPriority.Left;
  FcmbPriority.Top := edtPriority.Top;
  FcmbPriority.Width := edtPriority.Width;
  FcmbPriority.Height := edtPriority.Height;
  FcmbPriority.TabOrder := edtPriority.TabOrder;
  FcmbPriority.Style := csDropDownList;
  FcmbPriority.OnChange := cmbPriorityChange;
  TDownLoadComboBox(FcmbPriority).OnCloseUp := cmbPriorityChange;
  for i := Low(cDownLoadPriority) to High(cDownLoadPriority) do
  begin
    FcmbPriority.Items.Add(cDownLoadPriority[i]);
  end;
  LoadRegistry();
end;

function TDownLoaderTest.NormalizeName(AName: String): String;
begin
  Result := AName;
  if (Trim(Result) = '') then
  begin
    Result := cUnknown;
  end;
end;

procedure TDownLoaderTest.ListViewDblClick(Sender: TObject);
begin
  FIsLoading := True;
  try
    PageControl.ActivePage := tabDetails;
  finally
    FIsLoading := False;
  end;
  PageControlChange(nil);
end;

procedure TDownLoaderTest.FormDestroy(Sender: TObject);
begin
  SaveRegistry();
end;

procedure TDownLoaderTest.edtTimeOutChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.TimeOut := updTimeOut.Position * 1000;
end;

procedure TDownLoaderTest.edtPreviewCharCountChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.PreviewCharCount := updPreviewCount.Position;
end;

procedure TDownLoaderTest.cmbPriorityChange(Sender: TObject);
var
  Item: TclInternetItem;
begin
  if FIsLoading then Exit;
  Item := GetSelectedItem();
  if (Item <> nil) and (FcmbPriority.ItemIndex > - 1) then
  begin
    Item.Priority := TclProcessPriority(FcmbPriority.ItemIndex);
  end;
end;

procedure TDownLoaderTest.chkDownLoadNewsClick(Sender: TObject);
begin
  UpdateControls();
end;

procedure TDownLoaderTest.LoadRegistry;
var
  reg: TRegistry;
begin
  clMultiDownLoader.ReadRegistry(cRegistryPath);
  reg := TRegistry.Create();
  try
    if (reg.OpenKey(cRegistryPath, False)) and reg.ValueExists(cSiteNewsKey) then
    begin
      chkDownLoadNews.Checked := reg.ReadBool(cSiteNewsKey);
      reg.CloseKey();
    end;
  finally
    reg.Free();
  end;
end;

procedure TDownLoaderTest.SaveRegistry;
var
  reg: TRegistry;
begin
  clMultiDownLoader.WriteRegistry(cRegistryPath);
  reg := TRegistry.Create();
  try
    if (reg.OpenKey(cRegistryPath, True)) then
    begin
      reg.WriteBool(cSiteNewsKey, chkDownLoadNews.Checked);
      reg.CloseKey();
    end;
  finally
    reg.Free();
  end;
end;

procedure TDownLoaderTest.btnViewSiteNewsClick(Sender: TObject);
begin
  clNewsChecker.Start(False);
  if not clNewsChecker.IsNewsExist then
  begin
    DoShowNews(clNewsChecker.LocalFile);
  end;
end;

procedure TDownLoaderTest.DoShowNews(const AFileName: string);
begin
  ShellExecute(0, 'open', PChar(AFileName), nil, nil, SW_RESTORE);
end;

procedure TDownLoaderTest.clMultiDownLoaderChanged(Sender: TObject;
  Item: TclInternetItem);
begin
  FIsNewItem := False;
  FillDetails(Item);
  if FIsLoading then Exit;
  FIsLoading := True;
  try
    edtDirectory.Text := clMultiDownLoader.LocalFolder;
    updTimeOut.Position := clMultiDownLoader.TimeOut div 1000;
    updPreviewCount.Position := clMultiDownLoader.PreviewCharCount;
    chkPassiveFTPMode.Checked := clMultiDownLoader.PassiveFTPMode;
    edtHttpProxy.Text := clMultiDownLoader.HttpProxySettings.Server;
    edtProxyBypass.Text := Trim(clMultiDownLoader.ProxyBypass.Text);
    edtProxyUser.Text := clMultiDownLoader.HttpProxySettings.UserName;
    edtProxyPassword.Text := clMultiDownLoader.HttpProxySettings.Password;
    edtHttpPort.Text := IntToStr(clMultiDownLoader.HttpProxySettings.Port);
    edtFtpProxy.Text := clMultiDownLoader.FtpProxySettings.Server;
    edtFtpPort.Text := IntToStr(clMultiDownLoader.FtpProxySettings.Port);
    updBatchSize.Position := clMultiDownLoader.BatchSize;
    updReconnectAfter.Position := clMultiDownLoader.ReconnectAfter div 1000;
    updTryCount.Position := clMultiDownLoader.TryCount;
  finally
    FIsLoading := False;
  end;
end;

procedure TDownLoaderTest.clMultiDownLoaderIsBusyChanged(Sender: TObject);
begin
  UpdateControls();
end;

procedure TDownLoaderTest.clMultiDownLoaderGetResourceInfo(Sender: TObject;
  Item: TclInternetItem; ResourceInfo: TclResourceInfo);
begin
  FillDetails(Item);
end;

procedure TDownLoaderTest.clMultiDownLoaderError(Sender: TObject;
  Item: TclInternetItem; const Error: String; ErrorCode: Integer);
begin
  FillDetails(Item);
end;

procedure TDownLoaderTest.clNewsCheckerChanged(Sender: TObject);
begin
  edtSiteNewsURL.Text := clNewsChecker.URL;
end;

procedure TDownLoaderTest.clNewsCheckerNewsExist(Sender: TObject);
begin
  DoShowNews((Sender as TclNewsChecker).LocalFile);
end;

procedure TDownLoaderTest.clMultiDownLoaderStatusChanged(Sender: TObject;
  Item: TclInternetItem; Status: TclProcessStatus);
var
  ListItem: TListItem;
  old: Boolean;
begin
  old := FIsLoading;
  FIsLoading := True;
  try
    ListItem := ListView.FindData(- 1, Item, False, False);
    if (ListItem <> nil) then
    begin
      ListItem.SubItems[4] := cDownLoadStatuses[Status];
    end;
  finally
    FIsLoading := old;
  end;
end;

function TDownLoaderTest.GetFormattedTime(ATime: Double): string;
var
  d, h, m, s: WORD;
begin
  m := floor(ATime / 60);
  s := floor(ATime - m * 60);
  h := floor(m / 60);
  m := m - h * 60;
  d := floor(h / 24);
  h := h - d * 24;
  Result := '';
  if (d > 0) then
  begin
    Result := Result + Format('%d d ', [d]);
  end;
  if (d > 0) or (h > 0) then
  begin
    Result := Result + Format('%d h ', [h]);
  end;
  Result := Result + Format('%d m %d s', [m, s]);
end;

function TDownLoaderTest.GetFormattedBytes(ABytes: Double): string;
begin
  if (ABytes < 1024) then
  begin
    Result := Format('%.2n b', [ABytes]);
  end else
  begin
    ABytes := (ABytes / 1024);
    if (ABytes < 1024) then
    begin
      Result := Format('%.2n Kb', [ABytes]);
    end else
    begin
      ABytes := (ABytes / 1024);
      Result := Format('%.2n Mb', [ABytes]);
    end;
  end;
end;

procedure TDownLoaderTest.clMultiDownLoaderDataItemProceed(Sender: TObject;
  Item: TclInternetItem; ResourceInfo: TclResourceInfo;
  AStateItem: TclResourceStateItem; CurrentData: PAnsiChar;
  CurrentDataSize: Integer);
var
  ListItem: TListItem;
  old: Boolean;
  State: TclResourceStateList;
begin
  old := FIsLoading;
  FIsLoading := True;
  try
    ListItem := ListView.FindData(- 1, Item, False, False);
    if (ListItem <> nil) then
    begin
      State := AStateItem.ResourceState;
      ListItem.SubItems[0] := GetFormattedBytes(State.BytesProceed);
      ListItem.SubItems[1] := GetFormattedBytes(State.Speed) + '/s';
      ListItem.SubItems[2] := GetFormattedTime(State.ElapsedTime);
      ListItem.SubItems[4] := GetFormattedTime(State.RemainingTime);
    end;
  finally
    FIsLoading := old;
  end;
end;

procedure TDownLoaderTest.clProgressBarChanged(Sender: TObject);
var
  R: TRect;
  i: Integer;
begin
  for i := 0 to ListView.Items.Count - 1 do
  begin
    ListView_GetSubItemRect(ListView.Handle, i, 4, LVIR_BOUNDS, @R);
    InvalidateRect(ListView.Handle, @R, False);
  end;
end;

procedure TDownLoaderTest.edtBatchSizeChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.BatchSize := updBatchSize.Position;
end;

procedure TDownLoaderTest.ListViewAdvancedCustomDrawSubItem(
  Sender: TCustomListView; Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
var
  R: TRect;
  InternetItem: TclInternetItem;
  ResourceState: TclResourceStateList;
  canvas: TCanvas;
begin
  InternetItem := TclInternetItem(Item.Data);
  if (InternetItem = nil) or (SubItem <> 4) then Exit;
  ResourceState := InternetItem.ResourceState;
  ListView_GetSubItemRect(Item.Handle, Item.Index, SubItem, LVIR_BOUNDS, @R);

  canvas := TControlCanvas.Create();
  try
    TControlCanvas(canvas).Control := Sender;
    clProgressBar.Draw(ResourceState, canvas, R);
  finally
    canvas.Free();
  end;
  DefaultDraw := False;
end;

procedure TDownLoaderTest.btnExitClick(Sender: TObject);
begin
  Close();
end;

procedure TDownLoaderTest.btnCancelClick(Sender: TObject);
begin
  if FIsNewItem then
  begin
    GetSelectedItem().Free();
    ListView.Selected.Free();
    PageControl.ActivePage := tabTasks;
  end;
end;

procedure TDownLoaderTest.edtReconnectAfterChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.ReconnectAfter := updReconnectAfter.Position * 1000;
end;

procedure TDownLoaderTest.edtTryCountChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.TryCount := updTryCount.Position;
end;

procedure TDownLoaderTest.clMultiDownLoaderDataTextProceed(Sender: TObject;
  Item: TclDownLoadItem; Text: TStrings);
begin
  FillDetails(Item);
end;

procedure TDownLoaderTest.edtProxyUserChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.HttpProxySettings.UserName := edtProxyUser.Text;
end;

procedure TDownLoaderTest.edtProxyPasswordChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.HttpProxySettings.Password := edtProxyPassword.Text;
end;

procedure TDownLoaderTest.edtHttpPortChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.HttpProxySettings.Port := StrToInt(edtHttpPort.Text);
end;

procedure TDownLoaderTest.edtFtpProxyChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.FtpProxySettings.Server := edtFtpProxy.Text;
end;

procedure TDownLoaderTest.edtFtpPortChange(Sender: TObject);
begin
  if FIsLoading then Exit;
  clMultiDownLoader.FtpProxySettings.Port := StrToInt(edtFtpPort.Text);
end;

end.