ftplistview.pas

Monster FTP Client 强大的ftp客户控件,支持Proxy等

unit FtpListView;

interface

uses
   Windows, ShellApi, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, CommCtrl, ComCtrls, Ftp, FtpData, FtpMisc;

{$I mftp.inc}

type TMFtpSortBase = (stNone, stAttrib, stDateTime, stDescription, stName, stSize,
                      stSymbolLink);

type
   TMFtpListView = class(TCustomListView)
   private
      FFtp:                      TMFtp;

      FAccept:                   Boolean;
      FAscending:                Boolean;
      FInc:                      Boolean;
      FWebStyle:                 Boolean;
      FSortBase:                 TMFtpSortBase;

      FFileDropped:              TStrings;

      FFList:                    TStrings;
      FDList:                    TStrings;

      SysImageL, SysImageS:      TImageList;

      HOnListingDone:            Integer;
      HOnIndexFileReceived:      Integer;

      FFileDroppedE:             TNotifyEvent;

      procedure SetAccept(A: Boolean);
      procedure SetClient(NewFtp: TMFtp);
      procedure SetWebStyle(W: Boolean);

      procedure NewOnEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean);
      procedure NewOnIndexFileReceived(Sender: TObject);
      procedure NewOnListingDone(Sender: TObject);

      function GetSelD: TStrings;
      function GetSelF: TStrings;
   protected
      procedure CreateWnd; override;
      procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
   public
      imgCloseIndex:              Integer;

      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;

      property FileDropped: TStrings read FFileDropped;

      property SelectedDirectories: TStrings read GetSelD;
      property SelectedFiles: TStrings read GetSelF;

      property Items;

      procedure SelectAll;
      procedure InvertSelection;
   published
      property Accept: Boolean read FAccept write SetAccept;
      property Ascending: Boolean read FAscending write FAscending default true;
      property Client: TMFtp read FFtp write SetClient;
      property IncrementalDisplay: Boolean read FInc write FInc;
      property SortType: TMFtpSortBase read FSortBase write FSortBase;
      property WebStyle: Boolean read FWebStyle write SetWebStyle;

      property Align;
      property BorderStyle;
      property Color;
      property ColumnClick;
      property HideSelection;
      property IconOptions;
      property MultiSelect;
      property ParentColor default False;
      property ParentFont;
      property ParentShowHint;
      property PopupMenu;
      property ReadOnly;
      property RowSelect;
      property ShowHint;
      property ShowColumnHeaders;
      property TabOrder;
      property TabStop default True;
      property ViewStyle;

      {$ifdef VER120}
      property Anchors;
      property BiDiMode;
      property BorderWidth;
      property Constraints;
      property DragKind;
      property FlatScrollBars;
      property FullDrag;
      property GridLines;
      property OwnerData;
      property OwnerDraw;
      property ParentBiDiMode;
      {$endif}

      property OnFileDropped: TNotifyEvent read FFileDroppedE write FFileDroppedE;

      property OnChange;
      property OnChanging;
      property OnClick;
      property OnColumnClick;
      property OnCompare;
      property OnDblClick;
      property OnDeletion;
      property OnDragDrop;
      property OnDragOver;
      property OnEdited;
      property OnEditing;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnInsert;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnStartDrag;

      {$ifdef VER120}
      property OnCustomDraw;
      property OnCustomDrawItem;
      property OnCustomDrawSubItem;

      property OnData;
      property OnDataFind;
      property OnDataHint;
      property OnDataStateChange;

      property OnDrawItem;
      property OnEndDock;
      property OnGetImageIndex;
      property OnResize;
      property OnSelectItem;
      property OnStartDock;
      {$endif}
   end;

implementation

constructor TMFtpListView.Create;
var ShInfo: TSHFileInfo;
begin
   inherited Create(AOwner);

   FFileDropped := TStringList.Create;

   SysImageL := TImageList.Create(Self);
   with SysImageL do
   begin
      ShareImages := True;
      Handle := SHGetFileInfo('', 0, ShInfo, SizeOf(ShInfo),
                SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
   end;

   SysImageS := TImageList.Create(Self);
   with SysImageS do
   begin
      ShareImages := True;
      Handle := SHGetFileInfo('', 0, ShInfo, SizeOf(TSHFileInfo),
                SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
   end;

   LargeImages := SysImageL;
   SmallImages := SysImageS;

   SHGetFileInfo(PChar(GetWindowsDirectory), 0, ShInfo, SizeOf(ShInfo),
                 SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
   imgCloseIndex := ShInfo.iIcon;

   OnEditing := NewOnEditing;

   FAscending := True;
   FSortBase := stName;

   FFList := TStringList.Create;
   FDList := TStringList.Create;
end;

procedure TMFtpListView.CreateWnd;
begin
   inherited CreateWnd;

   with Columns.Add do
   begin
      Caption := 'Name';
      Width := 128;
   end;

   with Columns.Add do
   begin
      Caption := 'Size';
      Width := 84;
      Alignment := taRightJustify;
   end;

   with Columns.Add do
   begin
      Caption := 'Type';
      Width := 108;
   end;

   with Columns.Add do
   begin
      Caption := 'Modified';
      Width := 108;
   end;

   with Columns.Add do
   begin
      Caption := 'Description';
      Width := 128;
   end;

   SetAccept(True);
   SetWebStyle(True);

   IconOptions.AutoArrange := True;
end;

destructor TMFtpListView.Destroy;
begin
   FFileDropped.Free;

   if Assigned(FDList) then FDList.Free;
   if Assigned(FFList) then FFList.Free;

   inherited Destroy;
end;

procedure TMFtpListView.WMDropFiles;
var DHandle: HDrop;
    i, nb: Integer;
    fn : array[0..254] of char;
begin
   FFileDropped.Clear;

   DHandle := Msg.WParam;
   nb:=DragQueryFile(DHandle, $FFFFFFFF, fn, sizeof(fn));
   for i := 0 to nb - 1 do
   begin
      DragQueryFile(DHandle, i, fn, sizeof(fn));
      FFileDropped.Add(fn);
   end;
   DragFinish(DHandle);

   if Assigned(FFileDroppedE) then FFileDroppedE(Self);
end;

procedure TMFtpListView.SetAccept;
begin
   FAccept := A;

   DragAcceptFiles(Self.Handle, A);
end;

procedure TMFtpListView.SetClient;
begin
   if FFtp = NewFtp then Exit;

   if Assigned(FFtp) then
   begin
      With FFtp do
      begin
         UnRegisterNotifyEvent(10, HOnListingDone);
         UnRegisterNotifyEvent(14, HOnIndexFileReceived);
      end;
   end;

   FFtp := NewFtp;

   if not Assigned(FFtp) then
   begin
      Items.Clear;
      Exit;
   end;

   with FFtp do
   begin
      HOnListingDone := RegisterNotifyEvent(10, NewOnListingDone);
      HOnIndexFileReceived := RegisterNotifyEvent(14, NewOnIndexFileReceived);
   end;

   {refresh}
   if FFtp.Directories.Count + FFtp.Files.Count >0 then NewOnListingDone(Self);
end;

procedure TMFtpListView.SetWebStyle;
begin
   FWebStyle := W;

   if W then
   begin
      HotTrack := True;
      {$ifdef VER120}
      HotTrackStyles := [htHandPoint];
      {$endif}
   end
   else
   begin
      HotTrack := False;
      {$ifdef VER120}
      HotTrackStyles := [];
      {$endif}
   end;
end;

procedure TMFtpListView.NewOnEditing;
begin
   AllowEdit := True;

   with Item do
      if (Caption = 'Parent Directory') and (StateIndex = 1) and
         (ImageIndex = 3) then
            AllowEdit := False;

   inherited;
end;

procedure TMFtpListView.NewOnIndexFileReceived;
var i, n: Integer;
begin
   if OwnerData or OwnerDraw then
   begin
      Repaint;
      Exit;
   end;

   if Items[0].OverlayIndex = 0 then
      n := 0
   else
      n := -1;

   for i := 0 to FFtp.Directories.Count - 1 do
   begin
      {skiping '.' and '..'}
      if (FFtp.Directories[i] <> '.') and (FFtp.Directories[i] <> '..') and
         (FFtp.DirectoriesInfo[i, ItemSymbolLink] <> '.') and
         (FFtp.DirectoriesInfo[i, ItemSymbolLink] <> '..') then
      begin
         Inc(n);
         if n = Items.Count then Break;
         Items[n].SubItems[3] := FFtp.DirectoriesInfo[i, ItemDescription];
      end;
   end;

   for i := 0 to FFtp.Files.Count - 1 do
   begin
      Inc(n);
      if n >= Items.Count then Break;
      Items[n].SubItems[3] := FFtp.FilesInfo[i, ItemDescription];
   end;
end;

procedure TMFtpListView.NewOnListingDone;
var i, b: Integer;
    ShInfo: TSHFileInfo;
begin
   if OwnerData or OwnerDraw then
   begin
      Repaint;
      Exit;
   end;

   Screen.Cursor := crAppStart;

   {Sorting}
   b := -2;   {to make compiler happy :-)}
   if FSortBase <> stNone then
   begin
      case FSortBase of
         stAttrib:        b := ItemAttrib;
         stDateTime:      b := ItemDateTime;
         stDescription:   b := ItemDescription;
         stSize:          b := ItemSize;
         stSymbolLink:    b := ItemSymbolLink;
      end;

      SortLists(FFtp.Directories, FFtp.DirectoriesInfo, b, FAscending);
      SortLists(FFtp.Files, FFtp.FilesInfo, b, FAscending);
   end;

   with Items do
   begin
      Clear;

      {skiping '/'}
      if FFtp.CurrentDirectory <> '/' then
      begin
         with Add do {Add parent directory}
         begin
            Caption := 'Parent Directory';
            ImageIndex := imgCloseIndex;
            OverlayIndex := 0; {strange?}
         end;
      end;

      {adding directories}
      for i := 0 to FFtp.Directories.Count - 1 do
      begin
         {skiping '.' and '..'}
         if (FFtp.Directories[i] <> '.') and (FFtp.Directories[i] <> '..') and
            (FFtp.DirectoriesInfo[i, ItemSymbolLink] <> '.') and
            (FFtp.DirectoriesInfo[i, ItemSymbolLink] <> '..') then
         begin
            with Add do
            begin
                Caption := FFtp.Directories[i];
                ImageIndex := imgCloseIndex;
                if FFtp.DirectoriesInfo[i, ItemSymbolLink] <> '' then OverlayIndex := 1;
                SubItems.Add(FormatFloat('#,##', StrToInt(FFtp.DirectoriesInfo[i, ItemSize])));
                SubItems.Add('File Folder');
                SubItems.Add(FFtp.DirectoriesInfo[i, ItemDateTime]);
                SubItems.Add(FFtp.DirectoriesInfo[i, ItemDescription]);
            end;
          end;
      end;

      {adding files}
      for i := 0 to FFtp.Files.Count - 1 do
      begin
         with Add do
         begin
            Caption := FFtp.Files[i];
            SHGetFileInfo(PChar(Caption), 0, ShInfo, SizeOf(TSHFileInfo),
                          SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
            ImageIndex := ShInfo.iIcon;
            if FFtp.FilesInfo[i, ItemSymbolLink] <> '' then OverlayIndex := 1;
            SubItems.Add(FormatFloat('#,##', StrToInt(FFtp.FilesInfo[i, ItemSize])));
            SubItems.Add(ShInfo.szTypeName);
            SubItems.Add(FFtp.FilesInfo[i, ItemDateTime]);
            SubItems.Add(FFtp.FilesInfo[i, ItemDescription]);
         end;
      end;
   end;

   Screen.Cursor := crDefault;
end;

function TMFtpListView.GetSelD;
var LI: TListItem;
begin
   if Assigned(FDList) then
      FDList.Clear
   else
      FDList := TStringList.Create;

   LI := Selected;
   while LI <> nil do
   begin
      with LI do if ImageIndex = 3 then FDList.Add(Caption);
      LI := GetNextItem(LI, sdAll, [isSelected]);
   end;

   Result := FDList;
end;

function TMFtpListView.GetSelF;
var LI: TListItem;
begin
   if Assigned(FFList) then
      FFList.Clear
   else
      FFList := TStringList.Create;

   LI := Selected;
   while LI <> nil do
   begin
      with LI do if ImageIndex <> 3 then FFList.Add(Caption);
      LI := GetNextItem(LI, sdAll, [isSelected]);
   end;

   Result := FFList;
end;

procedure TMFtpListView.SelectAll;
var C, I: Integer;
begin
   C := Items.Count - 1;
   for I := 0 to C do
      Items[I].Selected := True;
end;

procedure TMFtpListView.InvertSelection;
var C, I: Integer;
begin
   C := Items.Count - 1;
   for I := 0 to C do
      Items[I].Selected := not Items[I].Selected;
end;

end.