ftptreeview.pas

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

unit FtpTreeView;

interface

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

type
   TMFtpTreeView = class(TCustomTreeView)
   private
      FFtp:                      TMFtp;

      FAccept:                   Boolean;
      FPreload:                  Boolean;
      FWebStyle:                 Boolean;

      FFileDropped:              TStrings;

      SysImageS:                 TImageList;

      HOnDirectoryChanged:       Integer;
      HOnFtpInfo:                Integer;
      HOnListingDone:            Integer;

      FFileDroppedE:             TNotifyEvent;

      FRoot, FCurrentDir:        TTreeNode;
      FRootInfoT:                TStringList;
      FRootInfoP:                TList;

      Flag : Boolean;

      function IsTreeNodeExists(T: TTreeNode; C: String): TTreeNode;
      procedure PreloadDir(S: String; Level: Integer);
      procedure UpdateView(D: TStrings; DI: TMFtpFileInfoList);

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

      procedure NewOnClick(Sender: TObject);
      procedure NewOnCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean);
      procedure NewOnEditing(Sender: TObject; Item: TTreeNode; var AllowEdit: Boolean);
      procedure NewOnExpanding(Sender: TObject; Node: TTreeNode;
                               var AllowExpansion: Boolean);

      procedure NewOnDirectoryChanged(Sender: TObject);
      procedure NewOnFtpInfo(Sender: TObject; info: FtpInfo; addinfo: String);
      procedure NewOnListingDone(Sender: TObject);
   protected
      procedure CreateWnd; override;
      procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
   public
      imgOpenIndex, imgSiteIndex,
      imgCloseIndex:             Integer;

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

      property FileDropped: TStrings read FFileDropped;
      property Root: TTreeNode read FRoot write FRoot;

      property Items;

      function GetTreeNodeName(N: TTreeNode): String;
      procedure Locate(S: String);

      procedure CollapseAll;
      procedure ExpandAll;
   published
      property Accept: Boolean read FAccept write SetAccept;
      property Client: TMFtp read FFtp write SetClient;
      property Preload: Boolean read FPreload write FPreload;

      property WebStyle: Boolean read FWebStyle write SetWebStyle;

      property Align;
      property BorderStyle;
      property Color;
      property Ctl3D;
      property DragCursor;
      property DragMode;
      property Enabled;
      property Font;
      property HideSelection;
      property Indent;
      property ParentColor default False;
      property ParentCtl3D;
      property ParentFont;
      property ParentShowHint;
      property PopupMenu;
      property ReadOnly;
      property RightClickSelect;
      property ShowButtons;
      property ShowHint;
      property ShowLines;
      property ShowRoot;
      property SortType;
      property TabOrder;
      property TabStop default True;
      property Visible;

      {$ifdef VER120}
      property Anchors;
      property AutoExpand;
      property BiDiMode;
      property BorderWidth;
      property ChangeDelay;
      property Constraints;
      property DragKind;
      property ParentBiDiMode;
      property RowSelect;
      {$endif}

      property OnFileDropped: TNotifyEvent read FFileDroppedE write FFileDroppedE;

      property OnChange;
      property OnChanging;
      property OnClick;
      property OnCollapsed;
      property OnCollapsing;
      property OnCompare;
      property OnDblClick;
      property OnDeletion;
      property OnDragDrop;
      property OnDragOver;
      property OnEdited;
      property OnEditing;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnExpanded;
      property OnExpanding;
      property OnGetImageIndex;
      property OnGetSelectedIndex;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnStartDrag;

      {$ifdef VER120}
      property OnCustomDraw;
      property OnCustomDrawItem;
      property OnEndDock;
      property OnStartDock;
      {$endif}
   end;

implementation

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

   FFileDropped := TStringList.Create;
   FRootInfoT := TStringList.Create;
   FRootInfoP := TList.Create;

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

   Images := SysImageS;

   SHGetFileInfo(PChar(GetWindowsDirectory), 0, ShInfo, SizeOf(ShInfo),
                 SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
   imgOpenIndex := ShInfo.iIcon;;

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

   imgSiteIndex := 17;

   OnEditing := NewOnEditing;

   SortType := stText;
   {$ifdef VER120}
   ChangeDelay := 50;
   {$endif}

   FPreload := True;
end;

procedure TMFtpTreeView.CreateWnd;
begin
   inherited CreateWnd;

   SetAccept(True);
   SetWebStyle(True);

   ShowRoot := False;
end;

destructor TMFtpTreeView.Destroy;
begin
   FFileDropped.Free;
   FRootInfoT.Free;
   FRootInfoP.Free;

   inherited Destroy;
end;

procedure TMFtpTreeView.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 TMFtpTreeView.SetAccept;
begin
   FAccept := A;

   DragAcceptFiles(Self.Handle, A);
end;

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

   if Assigned(FFtp) then
   begin
      With FFtp do
      begin
         UnRegisterInfoEvent(HOnFtpInfo);
         UnRegisterNotifyEvent(1, HOnDirectoryChanged);
         UnRegisterNotifyEvent(10, HOnListingDone);
       end;
   end;

   FFtp := NewFtp;

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

   with FFtp do
   begin
      HOnFtpInfo := RegisterInfoEvent(NewOnFtpInfo);
      HOnDirectoryChanged := RegisterNotifyEvent(1, NewOnDirectoryChanged);
      HOnListingDone := RegisterNotifyEvent(10, NewOnListingDone);
   end;

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

procedure TMFtpTreeView.SetWebStyle;
begin
   FWebStyle := W;

   if W then
   begin
      {$ifdef VER120}
      HotTrack := True;
      {$endif}
      OnClick := NewOnClick;
      OnDblClick := nil;
   end
   else
   begin
      {$ifdef VER120}
      HotTrack := False;
      {$endif}
      OnClick := nil;
      OnDblClick := NewOnClick;
   end;
end;

procedure TMFtpTreeView.NewOnClick;
begin
   if (Selected <> FCurrentDir) and (FFtp.Busy = False) then
   begin
      FFtp.Url := GetTreeNodeName(Selected);
   end;

   inherited;
end;

procedure TMFtpTreeView.NewOnEditing;
begin
   AllowEdit := True;

   if Item = FRoot then AllowEdit := False;

   inherited;
end;

procedure TMFtpTreeView.NewOnCollapsing;
begin
   Flag := True;
end;

procedure TMFtpTreeView.NewOnExpanding;
begin
   if not Flag then
   begin
      Node.Selected := True;

      if (Selected <> FCurrentDir) and (Node.HasChildren = True) and (Node.GetFirstChild = nil) and (FFtp.Busy = False) then
      begin
         FFtp.Url := GetTreeNodeName(Node);
      end;
   end;

   inherited;
end;

procedure TMFtpTreeView.NewOnDirectoryChanged;
var S: String;
begin
   S := FFtp.CurrentDirectory;
   if S[1] = '/' then
   begin
      if S = '/' then
      begin
         FCurrentDir := FRoot;
         FCurrentDir.Selected := True;
         Exit;
      end
      else
      begin
         System.Delete(S, 1, 1);
      end;
   end;

   Locate(S);
   FCurrentDir.Selected := True;
end;

procedure TMFtpTreeView.NewOnFtpInfo;
var t: Integer;
    S: String;
begin
   if info = ftpLoggedIn then
   begin
      with FFtp do
      begin
         S := BuildFTPTopURL(Server, Port, Username, Password);
         t := FRootInfoT.IndexOf(S);
      end;

      if t >= 0 then
      begin
         FRoot := FRootInfoP.Items[t];
         if (FRoot = nil) or (TTreeNode(FRootInfoP.Items[t]).Text = '') then
         begin
            FRootInfoT.Delete(t);
            FRootInfoP.Delete(t);
            t := -1;
         end;
      end;

      if t < 0 then
      begin
         FRoot := Items.AddFirst(nil, 'ftp://' + FFtp.Server + '/');
         with FRoot do
         begin
            ImageIndex := imgSiteIndex;
            SelectedIndex := imgSiteIndex;
            HasChildren := True;
         end;

         FRootInfoT.Add(S);
         FRootInfoP.Add(FRoot);

         Screen.Cursor := crAppStart;
         PreloadDir('/', -1); {no level limitation}
         Screen.Cursor := crDefault;
      end;

      FRoot.Expand(False);
      Locate(FFtp.CurrentDirectory);
      FCurrentDir.Selected := True;

      Flag := False;
      OnCollapsing := NewOnCollapsing;
      OnExpanding := NewOnExpanding;
   end;
end;

procedure TMFtpTreeView.NewOnListingDone;
var P: TTreeNode;
begin
   OnExpanding := nil;
   Locate(FFtp.CurrentDirectory);

   P := FCurrentDir;
   if not FFtp.FromCache then
   begin
      FCurrentDir.DeleteChildren;
      PreloadDir(GetTreeNodeName(FCurrentDir), MAX_PRELOAD_LEVEL);
   end;
   FCurrentDir := P;

   UpdateView(FFtp.Directories, FFtp.DirectoriesInfo);
   if FCurrentDir.GetFirstChild = nil then
      FCurrentDir.HasChildren := False
   else
   begin
      FCurrentDir.HasChildren := True;
      if not Flag then FCurrentDir.Expand(False);
      Flag := False;
   end;
   Locate(FFtp.CurrentDirectory);
   FCurrentDir.Selected := True;
   OnExpanding := NewOnExpanding;
end;

function TMFtpTreeView.GetTreeNodeName;
var T: TTreeNode;
begin
   if N = FRoot then
   begin
      Result := N.Text;
      Exit;
   end;

   if N <> nil then
   begin
      T := N;
      Result := T.Text + '/';
      while T.Parent <> nil do
      begin
         T := T.Parent;
         if T.Text[Length(T.Text)] = '/' then
            Result := T.Text +  Result
         else
            Result := T.Text + '/' + Result;
      end;
      if T = FRoot then Exit;
      if Copy(T.Text, 1, 6) = 'ftp://' then
      begin
//       FRoot.Collapse(True);
         FRoot := T;
         Exit;
      end;
   end;
   Result := '';
end;

procedure TMFtpTreeView.Locate;
var i: Integer;
    T, T1: TTreeNode;
    S1: String;
begin
   T := FRoot;

   while (S <> '/') and (S <> '') do
   begin
      i := Pos('/', S);
      if i = 0 then
      begin
         i := Length(S);
         S1 := Copy(S, 1, i);
      end
      else
         S1 := Copy(S, 1, i - 1);

      if S1 = '' then Exit;

      T1 := IsTreeNodeExists(T, S1);
      if T1 = nil then
      begin
         T := Items.AddChild(T, S1);
         with T do
         begin
            ImageIndex := imgCloseIndex;
            SelectedIndex := imgOpenIndex;
            HasChildren := True;
         end;
      end
      else
         T := T1;
      System.Delete(S, 1, i);
   end;

   FCurrentDir := T;
end;

function TMFtpTreeView.IsTreeNodeExists;
begin
   Result := nil;

   T := T.GetFirstChild;

   while T <> nil do
   begin
      if T.Text = C then
      begin
         Result := T;
         Exit;
      end;
      T := T.GetNextSibling;
   end;
end;

procedure TMFtpTreeView.PreloadDir;
var i: Integer;
    R: Boolean;
    DN: TStrings;
    DI: TMFtpFileInfoList;
begin
   if (Level = 0) or (FPreload = False) then Exit;

   DN := TStringList.Create;
   DI := TMFtpFileInfoList.Create;
   try
      i := Pos('ftp://' + FFtp.Server, S);
      if i = 1 then System.Delete(S, 1, Length('ftp://' + FFtp.Server));

      Locate(S);

      if (LowerCase(FFtp.Username) = 'ftp') or (LowerCase(FFtp.Username) = 'anonymous') then
         R := LoadFromCache(FFtp.Server +  '-' + S + '.cached', DN, DI, 0)
      else
         R := LoadFromCache(FFtp.Server + '(' + FFtp.Username + ')' + '-' + S + '.cached', DN, DI, 0);

      if S = '/' then S := '';

      if R then
      begin
         UpdateView(DN, DI);
         for i := 0 to DN.Count - 1 do
         begin
            {skiping '.' and '..'}
            if (DN[i] <> '.') and (DN[i] <> '..') and
               (DI[i, ItemSymbolLink] <> '.') and
               (DI[i, ItemSymbolLink] <> '..') then
               if S = '' then
                  PreloadDir(S + DN[i], Level - 1)
               else
                  PreloadDir(S + '/' + DN[i], Level - 1);
         end;
      end;
   finally
      DN.Free;
      DI.Free;
   end;
end;

procedure TMFtpTreeView.UpdateView;
var i: Integer;
    T: TTreeNode;
begin
   for i := 0 to D.Count - 1 do
   begin
      {skiping '.' and '..'}
      if (D[i] <> '.') and (D[i] <> '..') and
         (DI[i, ItemSymbolLink] <> '.') and
         (DI[i, ItemSymbolLink] <> '..') and
         (IsTreeNodeExists(FCurrentDir, D[i]) = nil) then
      begin
         T := Items.AddChild(FCurrentDir, D[i]);
         with T do
         begin
            ImageIndex := imgCloseIndex;
            SelectedIndex := imgOpenIndex;
            if DI[i, ItemSymbolLink] <> '' then
            begin
               HasChildren := False;
               OverlayIndex := 1;
            end
            else
               HasChildren := True;
         end;
      end;
   end;

   if FCurrentDir.GetFirstChild = nil then
      FCurrentDir.HasChildren := False
   else
      FCurrentDir.HasChildren := True;
end;

procedure TMFtpTreeView.CollapseAll;
var i: Integer;
begin
   for i := 0 to Items.Count - 1 do
   begin
      if Items[i].Parent = nil then Items[i].Collapse(True);
   end;
end;

procedure TMFtpTreeView.ExpandAll;
var i: Integer;
begin
   Flag := True;
   for i := 0 to Items.Count - 1 do
   begin
      if Items[i].Parent = nil then Items[i].Expand(True);
   end;
   FRoot.Selected := True;   
   Flag := False;
end;

end.