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

Pascal/Delphi Source File | 2001-04-10 | 20.9 KB | 849 lines

unit FtpListView;

interface

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

{$I mftp.inc}

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

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

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

      Directories, Files:        TMFtpFileInfoList;

      FFilter:                   TStrings;
      FFileDropped:              TStrings;
      FFList, FDList:            TStrings;

      {$ifdef VIRTUAL_LISTVIEW}
      LookUp:                    TStrings;
      {$ifdef DISPLAY_PARENT_DIRECTORY}
      FRoot:                     Boolean;
      {$endif}
      {$endif}

      ShInfo:                    TSHFileInfo;
      SysImageL, SysImageS:      TImageList;

      HOnFtpInfo:                Integer;
      HOnListingDone:            Integer;
      HOnIndexFileReceived:      Integer;

      FFileDroppedE:             TNotifyEvent;

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

      {$ifdef VIRTUAL_LISTVIEW}
      {$ifdef DISPLAY_PARENT_DIRECTORY}
      procedure NewOnData2(Sender: TObject; Item: TListItem; RealIndex: Integer);
      {$endif}
      procedure NewOnData(Sender: TObject; Item: TListItem);
      procedure NewOnDataFind(Sender: TObject; Find: TItemFind;
                const FindString: string; const FindPosition: TPoint;
                FindData: Pointer; StartIndex: Integer;
                Direction: TSearchDirection; Wrap: Boolean; var Index: Integer);
      {$endif}
      {$ifdef DELPHI5}
      procedure NewOnColumnClick(Sender: TObject; Column: TListColumn);
      {$endif}

      procedure NewOnFtpInfo(Sender: TObject; info: FtpInfo; addinfo: String);
      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 Columns;
      property Items;

      procedure SelectAll(Flag: Boolean = True);
      procedure InvertSelection;
      procedure Refresh;

      function IsDirectory(LI: TListItem): Boolean;

      {$ifdef VIRTUAL_LISTVIEW}
      property OnData;
      property OnDataFind;
      property OnDataHint;
      property OnDataStateChange;
      {$endif}
   published
      property Accept: Boolean read FAccept write SetAccept;
      property Ascending: Boolean read FAscending write FAscending default true;
      property Filter: TStrings read FFilter write SetFilter;
      property Client: TMFtp read FFtp write SetClient;
      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;

      property Anchors;
      property BiDiMode;
      property BorderWidth;
      property Constraints;
      property DragCursor;
      property DragKind;
      property DragMode;
      property FlatScrollBars;
      property FullDrag;
      property GridLines;
      property OwnerDraw;
      property ParentBiDiMode;

      {$ifdef DELPHI5}
      property ShowWorkAreas;
      {$endif}

      {$ifndef VIRTUAL_LISTVIEW}
      property OwnerData;
      {$endif}

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

      property OnCustomDraw;
      property OnCustomDrawItem;
      property OnCustomDrawSubItem;
      property OnDrawItem;
      property OnEndDock;
      property OnGetImageIndex;
      property OnResize;
      property OnSelectItem;
      property OnStartDock;

      {$ifdef DELPHI5}
      property OnAdvancedCustomDraw;
      property OnAdvancedCustomDrawItem;
      property OnAdvancedCustomDrawSubItem;
      property OnColumnRightClick;
      property OnContextPopup;
      property OnGetSubItemImage;
      property OnInfoTip;
      {$endif}

      {$ifndef VIRTUAL_LISTVIEW}
      property OnData;
      property OnDataFind;
      property OnDataHint;
      property OnDataStateChange;
      {$endif}
   end;

implementation

constructor TMFtpListView.Create;
begin
   inherited Create(AOwner);

   FFilter := TStringList.Create;
   FFileDropped := TStringList.Create;

   Directories := TMFtpFileInfoList.Create;
   Files := TMFtpFileInfoList.Create;

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

   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;

   FAscending := True;
   FSortBase := stName;

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

   {$ifdef VIRTUAL_LISTVIEW}
   LookUp := TStringList.Create;

   OnData := NewOnData;
   OnDataFind := NewOnDataFind;
   OwnerData := True;
   {$endif}

   {$ifdef DELPHI5}
   if not Assigned(OnColumnClick) then
      if not (csDesigning in ComponentState) then
         OnColumnClick := NewOnColumnClick;
   {$endif}
end;

procedure TMFtpListView.CreateWnd;
begin
   inherited CreateWnd;

   with Columns.Add do
   begin
      Caption := 'Name';
      {$ifdef DELPHI5}
      Tag := Ord(stName);
      {$endif}
      Width := 128;
   end;

   with Columns.Add do
   begin
      Alignment := taRightJustify;
      Caption := 'Size';
      {$ifdef DELPHI5}
      Tag := Ord(stSize);
      {$endif}
      Width := 84;
   end;

   with Columns.Add do
   begin
      Caption := 'Type';
      {$ifdef DELPHI5}
      Tag := Ord(stFileType);
      {$endif}
      Width := 108;
   end;

   with Columns.Add do
   begin
      Caption := 'Modified';
      {$ifdef DELPHI5}
      Tag := Ord(stDateTime);
      {$endif}
      Width := 108;
   end;

   with Columns.Add do
   begin
      Caption := 'Attributes';
      {$ifdef DELPHI5}
      Tag := Ord(stAttrib);
      {$endif}
      Width := 80;
   end;

   with Columns.Add do
   begin
      Caption := 'Owner';
      {$ifdef DELPHI5}
      Tag := Ord(stOwner);
      {$endif}
      Width := 80;
   end;

   with Columns.Add do
   begin
      Caption := 'Group';
      {$ifdef DELPHI5}
      Tag := Ord(stGroup);
      {$endif}
      Width := 80;
   end;

   with Columns.Add do
   begin
      Caption := 'Description';
      {$ifdef DELPHI5}
      Tag := Ord(stDescription);
      {$endif}
      Width := 128;
   end;

   SetAccept(FAccept);
   SetWebStyle(FWebStyle);

   IconOptions.AutoArrange := True;
end;

destructor TMFtpListView.Destroy;
begin
   FreeAndNil(FFilter);
   FreeAndNil(FFileDropped);

   Files.MyFree;
   Directories.MyFree;

   {$ifdef VIRTUAL_LISTVIEW}
   FreeAndNil(LookUp);
   {$endif}

   FreeAndNil(FDList);
   FreeAndNil(FFList);

   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
         UnRegisterInfoEvent(HOnFtpInfo);
         UnRegisterNotifyEvent(10, HOnListingDone);
         UnRegisterNotifyEvent(14, HOnIndexFileReceived);
      end;
   end;

   FFtp := NewFtp;

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

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

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

procedure TMFtpListView.SetFilter;
begin
   FFilter.Assign(NewFilter);
end;

procedure TMFtpListView.SetWebStyle;
begin
   FWebStyle := W;

   if W then
   begin
      HotTrack := True;
      HotTrackStyles := [htHandPoint];
   end
   else
   begin
      HotTrack := False;
      HotTrackStyles := [];
   end;
end;

{$ifdef DELPHI5}
procedure TMFtpListView.NewOnColumnClick;
begin
   if SortType = TMFtpSortBase(Column.Tag) then
      FAscending := not FAscending
   else
      SortType := TMFtpSortBase(Column.Tag);
   Refresh;
end;
{$endif}

{$ifdef VIRTUAL_LISTVIEW}
{$ifndef DISPLAY_PARENT_DIRECTORY}
procedure TMFtpListView.NewOnData;
{$else}
procedure TMFtpListView.NewOnData2;
{$endif}
var i: Integer;
    F: Boolean;
begin
   with Item do
   begin
      {$ifdef DISPLAY_PARENT_DIRECTORY}
      if RealIndex >= Directories.Count then
      begin
         i := RealIndex - Directories.Count;
         F := True;
      end
      else
      begin
         i := RealIndex;
         F := False;
      end;
      {$else}
      if Index >= Directories.Count then
      begin
         i := Index - Directories.Count;
         F := True;
      end
      else
      begin
         i := Index;
         F := False;
      end;
      {$endif}

      if F then
      begin
         if i >= Files.Count then Exit;

         Caption := Files[i].Filename;
         SHGetFileInfo(PChar(Caption), 0, ShInfo, SizeOf(TSHFileInfo),
                       SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
         ImageIndex := ShInfo.iIcon;
         if ViewStyle <> vsReport then Exit;

         {$ifdef DISPLAY_REAL_SIZE}
         if Files[i].Size = '0' then
            SubItems.Add('0')
         else
            SubItems.Add(FormatFloat('#,##', StrToIntDef(Files[i].Size, 0)));
         {$else}
         if Files[i].Size = '0' then
            SubItems.Add('0KB')
         else
            SubItems.Add(FormatFloat('#,##KB', StrToIntDef(Files[i].Size, 0) / 1024));
         if SubItems[SubItems.Count - 1] = 'KB' then SubItems[SubItems.Count - 1] := '1KB';
         {$endif}

         SubItems.Add(ShInfo.szTypeName);
         SubItems.Add(Files[i].DateTime);
         SubItems.Add(Files[i].Attrib);
         SubItems.Add(Files[i].Owner);
         SubItems.Add(Files[i].Group);
         SubItems.Add(Files[i].Description);
      end
      else
      begin
         if i >= Directories.Count then Exit;

         Caption := Directories[i].Filename;
         ImageIndex := imgCloseIndex;
         if ViewStyle <> vsReport then Exit;

         SubItems.Add(''); // It's a waste of CPU time to display a directory's
                           // size, right?
         SubItems.Add('File Folder');
         SubItems.Add(Directories[i].DateTime);
         SubItems.Add(Directories[i].Attrib);
         SubItems.Add(Directories[i].Owner);
         SubItems.Add(Directories[i].Group);
         SubItems.Add(Directories[i].Description);
      end;
   end;
end;

{$ifdef DISPLAY_PARENT_DIRECTORY}
procedure TMFtpListView.NewOnData;
begin
   if (FRoot) and (Item.Index = 0) then
   begin
      with Item do
      begin
         Caption := 'Parent Directory';
         ImageIndex := imgCloseIndex;
      end;
      Exit;
   end;

   if FRoot then
      NewOnData2(Sender, Item, Item.Index - 1)
   else
      NewOnData2(Sender, Item, Item.Index);
end;
{$endif}

procedure TMFtpListView.NewOnDataFind;
var I: Integer;
    Found: Boolean;
begin
   I := StartIndex;
   if (Find = ifExactString) or (Find = ifPartialString) then
   begin
      repeat
         if (I = LookUp.Count - 1) then
            if Wrap then I := 0 else Exit;
         if (I >= LookUp.Count) or (I < 0) then Exit;
         Found := (Pos(UpperCase(FindString), LookUp[i]) = 1);
         Inc(I);
      until Found or (I = StartIndex);
      if Found then Index := I - 1;
   end;
end;
{$endif}

procedure TMFtpListView.NewOnFtpInfo;
begin
   if info = ftpStartListing then
   begin
//      Items.BeginUpdate;
   end;
end;

procedure TMFtpListView.NewOnIndexFileReceived;
{$ifndef VIRTUAL_LISTVIEW}
var i, n: Integer;
{$endif}
begin
   if OwnerData or OwnerDraw then
   begin
      Repaint;
      Exit;
   end;

   {$ifndef VIRTUAL_LISTVIEW}
   if FFtp.CurrentDirectory = '/' then
      n := 0
   else
      n := -1;

   for i := 0 to Directories.Count - 1 do
   begin
      Inc(n);
      if n = Items.Count then Break;
      Items[n].SubItems[4] := Directories[i].Description;
   end;

   for i := 0 to Files.Count - 1 do
   begin
      Inc(n);
      if n >= Items.Count then Break;
      Items[n].SubItems[4] := Files[i].Description;
   end;
   {$endif}
end;

procedure TMFtpListView.NewOnListingDone;
var i, j, b: Integer;
begin
   Selected := nil;
   Directories.Assign(FFtp.Directories);
   Files.Clear;
   if FFilter.Count > 0 then
   begin
      for i := 0 to FFilter.Count - 1 do
      begin
         Application.ProcessMessages;
         for j := 0 to FFtp.Files.Count - 1 do
         begin
            if Files.IndexOf(FFtp.Files[j].Filename) < 0 then
            begin
               if fnmatch(PChar(FFilter[i]), PChar(FFtp.Files[j].Filename)) then
               begin
                  Files.Add(FFtp.Files[j]);
               end;
            end;
         end;
      end
   end
   else
   begin
      Files.Assign(FFtp.Files);
   end;

   Items.EndUpdate;

   if OwnerDraw then
   begin
      Repaint;
      Exit;
   end;

   {$ifndef VIRTUAL_LISTVIEW}
   if OwnerData then
   begin
      Repaint;
      Exit;
   end;
   {$endif}

   Screen.Cursor := crAppStart;
   Items.BeginUpdate;

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

      Directories.Sort(b, FAscending);
      Files.Sort(b, FAscending);
   end;

   {$ifdef VIRTUAL_LISTVIEW}
   LookUp.Clear;

   Items.Count := Directories.Count + Files.Count;

   for i := 0 to Directories.Count - 1 do
      LookUp.Add(UpperCase(Directories[i].Filename));

   for i := 0 to Files.Count - 1 do
      LookUp.Add(UpperCase(Files[i].Filename));

   {$ifdef DISPLAY_PARENT_DIRECTORY}
   if FFtp.CurrentDirectory <> '/' then
   begin
      FRoot := True;
      Items.Count := Items.Count + 1;
      end
   else
      FRoot := False;
   {$endif}

   Repaint;
   {$else}
   with Items do
   begin
      Clear;

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

      {adding directories}
      for i := 0 to Directories.Count - 1 do
      begin
         with Add do
         begin
             Caption := Directories[i].Filename;
             ImageIndex := imgCloseIndex;
             {$ifdef OVERLAY_MASK}
             if Directories[i].SymbolLink <> '' then OverlayIndex := 1;
             {$endif}
             SubItems.Add('');
             SubItems.Add('File Folder');
             SubItems.Add(Directories[i].DateTime);
             SubItems.Add(Directories[i].Attrib);
             SubItems.Add(Directories[i].Description);
         end;
      end;

      {adding files}
      for i := 0 to Files.Count - 1 do
      begin
         with Add do
         begin
            Caption := Files[i].Filename;
            SHGetFileInfo(PChar(Caption), 0, ShInfo, SizeOf(TSHFileInfo),
                          SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
            ImageIndex := ShInfo.iIcon;
            {$ifdef OVERLAY_MASK}
            if Files[i].SymbolLink <> '' then OverlayIndex := 1;
            {$endif}
            {$ifdef DISPLAY_REAL_SIZE}
            if Files[i].Size = '0' then
               SubItems.Add('0')
            else
               SubItems.Add(FormatFloat('#,##', StrToIntDef(Files[i].Size, 0)));
            {$else}
            if Files[i].Size = '0' then
               SubItems.Add('0KB')
            else
               SubItems.Add(FormatFloat('#,##KB', StrToIntDef(Files[i].Size, 0) / 1024));
            if SubItems[SubItems.Count - 1] = 'KB' then SubItems[SubItems.Count - 1] := '1KB';
            {$endif}
            SubItems.Add(ShInfo.szTypeName);
            SubItems.Add(Files[i].DateTime);
            SubItems.Add(Files[i].Attrib);
            SubItems.Add(Files[i].Description);
         end;
      end;
   end;
   {$endif}

   Screen.Cursor := crDefault;
   Items.EndUpdate;
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 = imgCloseIndex 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 <> imgCloseIndex 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 := Flag;
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;

procedure TMFtpListView.Refresh;
begin
   if Assigned(FFtp) then
      NewOnListingDone(Self);
end;

function TMFtpListView.IsDirectory;
begin
   if Assigned(LI) then
      Result := (LI.ImageIndex = imgCloseIndex)
   else
      Result := False;
end;

end.