main.pas

这是一套全面的网络组件

unit main;
                                              
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI,
  clDC, clMultiDownLoader, StdCtrls, ComCtrls, ExtCtrls, clDownLoader, registry,
  clNewsChecker, clMultiDC, clDCUtils, clSingleDC, clProgressBar, CommCtrl, Math;

type
  TDownLoaderTest = class(TForm)
    clMultiDownLoader: TclMultiDownLoader;
    PageControl: TPageControl;
    tabTasks: TTabSheet;
    tabDetails: TTabSheet;
    Label1: TLabel;
    Label6: TLabel;
    Label9: TLabel;
    Label4: TLabel;
    edtURL: TEdit;
    edtUser: TEdit;
    edtPassword: TEdit;
    memErrors: TMemo;
    Label5: TLabel;
    Label2: TLabel;
    edtFile: TEdit;
    memPreview: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    ListView: TListView;
    btnAdd: TButton;
    btnDelete: TButton;
    Label3: TLabel;
    memInfo: TMemo;
    tabOptions: TTabSheet;
    Label8: TLabel;
    edtDirectory: TEdit;
    Label7: TLabel;
    edtTimeOut: TEdit;
    edtPreviewCharCount: TEdit;
    Label10: TLabel;
    chkDownLoadNews: TCheckBox;
    edtSiteNewsURL: TEdit;
    btnViewSiteNews: TButton;
    edtPriority: TEdit;
    Label11: TLabel;
    updTimeOut: TUpDown;
    updPreviewCount: TUpDown;
    Bevel1: TBevel;
    Bevel2: TBevel;
    clNewsChecker: TclNewsChecker;
    edtThreadCount: TEdit;
    Label12: TLabel;
    updThreadCount: TUpDown;
    chkPassiveFTPMode: TCheckBox;
    Label13: TLabel;
    Label14: TLabel;
    edtHttpProxy: TEdit;
    edtProxyBypass: TEdit;
    clProgressBar: TclProgressBar;
    Label15: TLabel;
    edtBatchSize: TEdit;
    updBatchSize: TUpDown;
    btnDownLoad: TButton;
    btnStop: TButton;
    btnExit: TButton;
    btnGetInfo: TButton;
    Bevel3: TBevel;
    btnStop1: TButton;
    btnAdd1: TButton;
    btnDownload1: TButton;
    btnCancel: TButton;
    Label16: TLabel;
    edtReconnectAfter: TEdit;
    updReconnectAfter: TUpDown;
    Label17: TLabel;
    edtTryCount: TEdit;
    updTryCount: TUpDown;
    Label18: TLabel;
    edtProxyUser: TEdit;
    Label19: TLabel;
    edtProxyPassword: TEdit;
    Label20: TLabel;
    edtHttpPort: TEdit;
    Label21: TLabel;
    edtFtpProxy: TEdit;
    Label22: TLabel;
    edtFtpPort: TEdit;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnGetInfoClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnDownLoadClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure PageControlChange(Sender: TObject);
    procedure ListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure edtURLChange(Sender: TObject);
    procedure edtFileChange(Sender: TObject);
    procedure edtUserChange(Sender: TObject);
    procedure edtPasswordChange(Sender: TObject);
    procedure edtDirectoryChange(Sender: TObject);
    procedure ListViewDblClick(Sender: TObject);
    procedure edtTimeOutChange(Sender: TObject);
    procedure edtPreviewCharCountChange(Sender: TObject);
    procedure chkDownLoadNewsClick(Sender: TObject);
    procedure btnViewSiteNewsClick(Sender: TObject);
    procedure edtThreadCountChange(Sender: TObject);
    procedure chkPassiveFTPModeClick(Sender: TObject);
    procedure edtHttpProxyChange(Sender: TObject);
    procedure edtProxyBypassChange(Sender: TObject);
    procedure edtBatchSizeChange(Sender: TObject);
    procedure clProgressBarChanged(Sender: TObject);
    procedure clMultiDownLoaderChanged(Sender: TObject;
      Item: TclInternetItem);
    procedure clMultiDownLoaderIsBusyChanged(Sender: TObject);
    procedure clMultiDownLoaderDataItemProceed(Sender: TObject;
      Item: TclInternetItem; ResourceInfo: TclResourceInfo;
      AStateItem: TclResourceStateItem; CurrentData: PAnsiChar;
      CurrentDataSize: Integer);
    procedure clMultiDownLoaderGetResourceInfo(Sender: TObject;
      Item: TclInternetItem; ResourceInfo: TclResourceInfo);
    procedure clMultiDownLoaderError(Sender: TObject;
      Item: TclInternetItem; const Error: String; ErrorCode: Integer);
    procedure clMultiDownLoaderStatusChanged(Sender: TObject;
      Item: TclInternetItem; Status: TclProcessStatus);
    procedure clNewsCheckerChanged(Sender: TObject);
    procedure clNewsCheckerNewsExist(Sender: TObject);
    procedure ListViewAdvancedCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      Stage: TCustomDrawStage; var DefaultDraw: Boolean);
    procedure btnExitClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure edtReconnectAfterChange(Sender: TObject);
    procedure edtTryCountChange(Sender: TObject);
    procedure clMultiDownLoaderDataTextProceed(Sender: TObject;
      Item: TclDownLoadItem; Text: TStrings);
    procedure edtProxyUserChange(Sender: TObject);
    procedure edtProxyPasswordChange(Sender: TObject);
    procedure edtHttpPortChange(Sender: TObject);
    procedure edtFtpProxyChange(Sender: TObject);
    procedure edtFtpPortChange(Sender: TObject);
  private
    FIsLoading: Boolean;
    FcmbPriority: TComboBox;
    FIsNewItem: Boolean;
    function NormalizeName(AName: String): String;
    procedure UpdateControls;
    procedure FillListView;
    procedure FillDetails(AItem: TclInternetItem);
    function GetSelectedItem: TclInternetItem;
    procedure LoadRegistry;
    procedure SaveRegistry;
    procedure DoShowNews(const AFileName: string);
    procedure cmbPriorityChange(Sender: TObject);
    function GetFormattedTime(ATime: Double): string;
    function GetFormattedBytes(ABytes: Double): string;
  end;

var
  DownLoaderTest: TDownLoaderTest;

implementation

const
  cDownLoadingStopConfirm = 'Downloading is in progress. Do you wish to stop the process?';
  cNoResourceInfoAvailable = 'There are no any info available.';
  cDownLoadStatuses: array[TclProcessStatus] of string = ('Ready', 'Done', 'Failed', 'Warnings', 'Process', 'Stopped');
  cDownLoadPriority: array[TclProcessPriority] of string = ('Lower', 'Normal', 'Higher');
  cUnknown = 'Undefined';
  cRegistryPath = '\Software\CleverComponents\MultiDownLoader';
  cSiteNewsKey = 'News';

{$R *.DFM}

type
  TDownLoadComboBox = class(TComboBox)
  private
    FOnCloseUp: TNotifyEvent;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure DoCloseUp;
  published
    property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
  end;

{ TDownLoadComboBox }

procedure TDownLoadComboBox.CNCommand(var Message: TWMCommand);
begin
  inherited;
  if (Message.NotifyCode = CBN_CLOSEUP) then
  begin
    DoCloseUp();
  end;
end;

procedure TDownLoadComboBox.DoCloseUp;
begin
  if Assigned(FOnCloseUp) then
  begin
    FOnCloseUp(Self);
  end;
end;

{ TDownLoaderTest }

procedure TDownLoaderTest.btnAddClick(Sender: TObject);
var
  ListItem: TListItem;
begin
  ListItem := ListView.Items.Add();
  ListItem.Caption := NormalizeName('');
  ListItem.Data := clMultiDownLoader.DownLoadList.Add();
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add('');
  ListItem.SubItems.Add(cDownLoadStatuses[psUnknown]);
  ListView.Selected := ListItem;
  FIsNewItem := True;
  ListViewDblClick(nil);
end;

procedure TDownLoaderTest.btnDeleteClick(Sender: TObject);
begin
  GetSelectedItem().Free();
  ListView.Selected.Free();
  UpdateControls();
end;

procedure TDownLoaderTest.btnGetInfoClick(Sender: TObject);
begin
  clMultiDownLoader.GetResourceInfo(GetSelectedItem(), True);
  UpdateControls();
end;

procedure TDownLoaderTest.btnStopClick(Sender: TObject);
begin
  clMultiDownLoader.Stop(GetSelectedItem());
  UpdateControls();
end;

procedure TDownLoaderTest.btnDownLoadClick(Sender: TObject);
begin
  clMultiDownLoader.Start(GetSelectedItem(), True);
  UpdateControls();
end;

procedure TDownLoaderTest.FillListView;
var
  i: Integer;
  Item: TclInternetItem;
  ListItem: TListItem;
begin
  ListView.Items.BeginUpdate();
  try
    ListView.Items.Clear();
    for i := 0 to clMultiDownLoader.DownLoadList.Count - 1 do
    begin
      Item := clMultiDownLoader.DownLoadList[i];
      ListItem := ListView.Items.Add();
      ListItem.Caption := NormalizeName(Item.URL);
      ListItem.Data := Item;
      ListItem.SubItems.Add('');
      ListItem.SubItems.Add('');
      ListItem.SubItems.Add('');
      ListItem.SubItems.Add('');
      ListItem.SubItems.Add('');
      ListItem.SubItems.Add(cDownLoadStatuses[psUnknown]);
    end;
  finally
    ListView.Items.EndUpdate();
  end;
end;

procedure TDownLoaderTest.FormShow(Sender: TObject);
begin
  FIsLoading := True;
  try
    PageControl.ActivePage := tabTasks;
    FillListView();
  finally
    FIsLoading := False;
  end;
  UpdateControls();
  if chkDownLoadNews.Checked then
  begin
    clNewsChecker.Start(True);
  end;
end;

function TDownLoaderTest.GetSelectedItem: TclInternetItem;
begin
  if (ListView.Selected <> nil) then
  begin
    Result := TclInternetItem(ListView.Selected.Data);
  end else
  begin
    Result := nil;
  end;
end;

procedure TDownLoaderTest.PageControlChange(Sender: TObject);
begin
  FillDetails(GetSelectedItem());
  UpdateControls();
end;

procedure TDownLoaderTest.UpdateControls;
var
  b: Boolean;
  Item: TclInternetItem;
begin
  Item := GetSelectedItem();
  if (PageControl.ActivePage = tabTasks) then
  begin
    b := (Item <> nil);
    btnDelete.Enabled := b and (not Item.IsBusy);
    btnDownLoad.Enabled := b and (not Item.IsBusy);
    btnStop.Enabled := b and Item.IsBusy;
  end else
  if (PageControl.ActivePage = tabDetails) then
  begin
    b := (Item <> nil);
    btnGetInfo.Enabled := b and (not Item.IsBusy);
    btnStop1.Enabled := b and Item.IsBusy;
    btnDownLoad1.Enabled := b and (not Item.IsBusy);
    btnCancel.Enabled := b and (not Item.IsBusy) and FIsNewItem;
    b := (Item <> nil) and (not Item.IsBusy);
    edtURL.Enabled := b;
    edtFile.Enabled := b;
    edtUser.Enabled := b;
    edtPassword.Enabled := b;
    memInfo.Enabled := b;
    memPreview.Enabled := b;
    memErrors.Enabled := b;
    FcmbPriority.Enabled := b;
    updThreadCount.Enabled := b;
    edtThreadCount.Enabled := b;
  end else
  if (PageControl.ActivePage = tabOptions) then
  begin
    btnViewSiteNews.Enabled := chkDownLoadNews.Checked;
  end;
end;

procedure TDownLoaderTest.ListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
  UpdateControls();
end;

procedure TDownLoaderTest.FillDetails(AItem: TclInternetItem);
begin
  if (PageControl.ActivePage <> tabDetails) or FIsLoading then Exit;
  FIsLoading := True;
  try
    if (AItem <> nil) then
    begin
      edtURL.Text := AItem.URL;
      edtFile.Text := AItem.LocalFile;
      edtUser.Text := AItem.UserName;
      edtPassword.Text := AItem.Password;
      FcmbPriority.ItemIndex := Integer(AItem.Priority);
      updThreadCount.Position := Integer(AItem.ThreadCount);
      memInfo.Lines.Clear();
      if (AItem.ResourceInfo <> nil) then
      begin
        memInfo.Lines.Add('Resource ' + AItem.ResourceInfo.Name);
        memInfo.Lines.Add(Format('Size %n Bytes', [AItem.ResourceInfo.Size / 1]));
        memInfo.Lines.Add('Date ' + DateTimeToStr(AItem.ResourceInfo.Date));
        memInfo.Lines.Add('Type ' + AItem.ResourceInfo.ContentType);
        if AItem.ResourceInfo.Compressed then
        begin
          memInfo.Lines.Add('Compressed');
        end;
      end else
      begin
        memInfo.Lines.Add(cNoResourceInfoAvailable);
      end;
      if (AItem is TclDownLoadItem) then
      begin
        memPreview.Lines.Assign((AItem as TclDownLoadItem).Preview);
      end else
      begin
        memPreview.Lines.Clear();
      end;
      memErrors.Lines.Text := AItem.Errors.Text;
    end else
    begin
      edtURL.Text := '';
      edtFile.Text := '';
      edtUser.Text := '';
      edtPassword.Text := '';
      FcmbPriority.ItemIndex := - 1;
      memInfo.Lines.Clear();
      memPreview.Lines.Clear();
      memErrors.Lines.Clear();
      updThreadCount.Position := 0;
    end;
  finally
    FIsLoading := False;
  end;
end;

procedure TDownLoaderTest.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := not clMultiDownLoader.IsBusy;
  if not CanClose then
  begin
    CanClose := (MessageBox(0, cDownLoadingStopConfirm, 'Warning', MB_OKCANCEL) = IDOK);
    if CanClose then
    begin
      clMultiDownLoader.Stop();
      while clMultiDownLoader.IsBusy do
        Application.ProcessMessages();
    end;
  end;
  if CanClose then
  begin
    clNewsChecker.Stop();
    while clNewsChecker.IsBusy do
      Application.ProcessMessages();
  end;
end;

procedure TDownLoaderTest.edtURLChange(Sender: TObject);
var
  Item: TclInternetItem;
begin
  if FIsLoading then Exit;
  Item := GetSelectedItem();
  if (Item <> nil) then
  begin
    Item.URL := edtURL.Text;
    ListView.Selected.Caption := NormalizeName(Item.URL);
  end;
end;

procedure TDownLoaderTest.edtFileChange(Sender: TObject);