Chip 2001 September/Chip_2001-09_cd1.bin/zkuste/delphi/nastroje/d5/MFTP.ZIP/src/FtpTreeView.pas

Pascal/Delphi Source File | 2001-03-05 | 17.6 KB | 772 lines

unit FtpTreeView;

interface

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

{$i mftp.inc}

type
   TMFtpTreeView = class;

   TMFtpSiteInfo = class(TPersistent)
   private
      FTreeView:                 TMFtpTreeView;
      FCount:                    Integer;

      FRootInfoT:                TStrings;
      FRootInfoP:                TList;
   public
      constructor Create(AOwner: TMFtpTreeView);
      destructor Destroy; override;

      property Count: Integer read FCount;
      property RootInfoP: TList read FRootInfoP;
      property RootInfoT: TStrings read FRootInfoT;

      procedure Add(TopURL: String; TN: TTreeNode);
      procedure Clear;
      procedure Delete(TN: TTreeNode); overload;
      procedure Delete(N: Integer); overload;
   end;

   TMFtpTreeView = class(TCustomTreeView)
   private
      FFtp:                      TMFtp;
      FSiteInfo:                 TMFtpSiteInfo;

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

      FFileDropped:              TStrings;

      SysImageS:                 TImageList;
      MyImage:                   TImageList;

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

      FFileDroppedE:             TNotifyEvent;

      FRoot, FCurrentDir:        TTreeNode;

      Flag:                      Boolean;

      function IsTreeNodeExists(T: TTreeNode; C: String): TTreeNode;
      procedure PreloadDir(S: String; Level: Integer);
      procedure UpdateView(D: 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
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;

      property FileDropped: TStrings read FFileDropped;
      property Root: TTreeNode read FRoot write FRoot;
      property Sites: TMFtpSiteInfo read FSiteInfo;

      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;

      property Anchors;
      property AutoExpand;
      property BiDiMode;
      property BorderWidth;
      property ChangeDelay;
      property Constraints;
      property DragKind;
      property ParentBiDiMode;
      property RowSelect;

      {$ifdef EXPORT_IMAGES}
      property Images;
      property StateImages;
      {$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;

      property OnCustomDraw;
      property OnCustomDrawItem;
      property OnEndDock;
      property OnStartDock;

      {$ifdef DELPHI5}
      property OnAdvancedCustomDraw;
      property OnAdvancedCustomDrawItem;
      property OnContextPopup;
      {$endif}
   end;

implementation

constructor TMFtpTreeView.Create;
var ShInfo:  TSHFileInfo;
    TmpIcon: TIcon;
    TmpBmp:  TBitmap;
begin
   inherited Create(AOwner);

   FFileDropped := TStringList.Create;
   FSiteInfo := TMFtpSiteInfo.Create(Self);

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

   MyImage := TImageList.Create(Self);
   Images := MyImage;

   TmpIcon := TIcon.Create;
   with TmpIcon do
   try
      SHGetFileInfo(PChar(GetWindowsDirectory), 0, ShInfo, SizeOf(ShInfo),
                    SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
      SysImageS.GetIcon(ShInfo.iIcon, TmpIcon);
      MyImage.AddIcon(TmpIcon);
   finally
      Free;
   end;

   TmpIcon := TIcon.Create;
   with TmpIcon do
   try
      SHGetFileInfo(PChar(GetWindowsDirectory), 0, ShInfo, SizeOf(ShInfo),
                    SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
      SysImageS.GetIcon(ShInfo.iIcon, TmpIcon);
      MyImage.AddIcon(TmpIcon);
   finally
      Free;
   end;

   TmpBmp := TBitmap.Create;
   with TmpBmp do
   try
      LoadFromResourceName(HInstance, 'REMOTE_FOLDER');
      MyImage.Add(TmpBmp, nil);
   finally
      Free;
   end;

   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
   Images := nil;
   FreeAndNil(MyImage);

   FreeAndNil(FFileDropped);
   FSiteInfo.Destroy;

   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 = '' then Exit; {Failure}

   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 := FSiteInfo.RootInfoT.IndexOf(S);
      end;

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

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

         FSiteInfo.Add(S, 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);
   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
      if S[1] = '/' then
         System.Delete(S, 1, 1);

      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 := 1;
            SelectedIndex := 0;
            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, c, c1: Integer;
    F: String;
    T: TTreeNode;
    DN, DN1: TStrings;
begin
   if (Level = 0) or (FPreload = False) then Exit;

   DN := TStringList.Create;

   i := Pos('ftp://' + FFtp.Server, S);
   if i = 1 then System.Delete(S, 1, Length('ftp://' + FFtp.Server));

   Locate(S);

   try
      with FFtp do
      begin
         F := GetCacheFilename(Server, UserName, S, Port, True);
      end;

      if FileExists(F) then DN.LoadFromFile(F);
   except
   end;

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

   c1 := DN.Count - 1;

   if c1 > 4 then
   begin
      c := 1;

      DN1 := TStringList.Create;

      repeat
         if (IsTreeNodeExists(FCurrentDir, DN[c]) = nil) then
         begin
            T := Items.AddChild(FCurrentDir, DN[c]);
            with T do
            begin
               ImageIndex := 1;
               SelectedIndex := 0;
               if DN[c + 4] <> '' then
               begin
                  HasChildren := False;
                  {$ifdef OVERLAY_MASK}
                  OverlayIndex := 1;
                  {$endif}
               end
               else
               begin
                  HasChildren := True;
               end;
            end;

            if S = '' then
               DN1.Add(S + DN[c])
            else
               DN1.Add(S + '/' + DN[c]);
         end;
         Inc(c, 8);
      until (c >= c1);

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

      for i := 0 to DN1.Count - 1 do
         PreloadDir(DN1[i], Level - 1);

      FreeAndNil(DN1);
   end;
   FreeAndNil(DN);
end;

procedure TMFtpTreeView.UpdateView;
var i: Integer;
    T: TTreeNode;
begin
   for i := 0 to D.Count - 1 do
   begin
      if IsTreeNodeExists(FCurrentDir, D[i].Filename) = nil then
      begin
         T := Items.AddChild(FCurrentDir, D[i].Filename);
         with T do
         begin
            ImageIndex := 1;
            SelectedIndex := 0;
            if D[i].SymbolLink <> '' then
            begin
               HasChildren := False;
               {$ifdef OVERLAY_MASK}
               OverlayIndex := 1;
               {$endif}
            end
            else
            begin
               HasChildren := True;
            end;
         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;

constructor TMFtpSiteInfo.Create;
begin
   inherited Create;

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

   FTreeView := AOwner;
   FCount := 0;
end;

destructor TMFtpSiteInfo.Destroy;
begin
   FreeAndNil(FRootInfoT);
   FreeAndNil(FRootInfoP);

   inherited Destroy;
end;

procedure TMFtpSiteInfo.Add;
begin
   FRootInfoT.Add(TopURL);
   FRootInfoP.Add(TN);
   Inc(FCount);
end;

procedure TMFtpSiteInfo.Clear;
var i: Integer;
begin
   for i :=0 to FRootInfoP.Count - 1 do
      FTreeView.Items.Delete(FRootInfoP.Items[i]);

   FRootInfoT.Clear;
   FRootInfoP.Clear;
   FCount := 0;
end;

procedure TMFtpSiteInfo.Delete(TN: TTreeNode);
var i: Integer;
begin
   for i := 0 to FRootInfoP.Count - 1 do
   begin
      if FRootInfoP.Items[i] = TN then
      begin
         FTreeView.Items.Delete(TN);
         FRootInfoT.Delete(i);
         FRootInfoP.Delete(i);
         Dec(FCount);
      end;
   end;
end;

procedure TMFtpSiteInfo.Delete(N: Integer);
begin
   FRootInfoT.Delete(N);
   FRootInfoP.Delete(N);
   Dec(FCount);
end;

end.