VPF::Загрузить структуру папок FTP в TDirectoryListBox?

Nicholas

Дата 6.9.2016, 11:30 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 436
Регистрация: 30.9.2004

Репутация: нет
Всего: 0

Совсем нет опыта работы с FTP, который день не могу сообразить как сделать диалог выбора папок в FTP клиенте... smile

Вообще в FTP клиенте используется TStringList для обзора содержимого ив се в принципе работает тыкаешь мышкой заходит выходит в папки, пытался по этому примеру сделать с TDirectoryListBox, тупо добавляя в цикле папки

Код


DirectoryListBox1.Items.add(STRUCT_DATA.cFileName)

Код


{ Процедура заполнения диалога выбора папок}
procedure GetFTPFolders( );
var
    STRUCT_DATA : _WIN32_FIND_DATAA;
    FoundFile   : Pointer;
    bFound      : Boolean;
    BeFolder    : boolean;

begin
    BeFolder := False;
    FoundFile := nil;
    bFound := False;

    if PConnexionFTP <> nil then
    begin

       MainPage.DirectoryListBox1.Clear;

       FoundFile := FtpFindFirstFile( PConnexionFTP, PChar('*.*'), STRUCT_DATA, 0, 0 );

       MainPage.DirectoryListBox1.Items.Text :='..';
        
        if FoundFile <> nil then
        repeat
        {    if intToStr(STRUCT_DATA.dwFileAttributes) = '16' then
              Begin
            //ShowMessage('Атрибуты файла: '+ intToStr(STRUCT_DATA.dwFileAttributes));
              ShowMessage('это папка:'+STRUCT_DATA.cFileName);
              end ;     }
              
            if (Trim(STRUCT_DATA.cFileName) <> '..') and (Trim(STRUCT_DATA.cFileName) <> '.'){ and (intToStr(STRUCT_DATA.dwFileAttributes) = '16') }then
            begin
                // длинное или короткое имя ?
                if Trim(STRUCT_DATA.cFileName) <> '' then
                    Begin
                              MainPage.DirectoryListBox1.Items.add(STRUCT_DATA.cFileName);
                    End
                else
                    Begin
                         MainPage.DirectoryListBox1.Items.Add( STRUCT_DATA.cAlternateFileName);
                    End;
             end;

                bFound := InternetFindNextFile( FoundFile, @STRUCT_DATA );

        until not bFound;
         MainPage.DirectoryListBox1.Items.add('');
         InternetCloseHandle( FoundFile );  
         MainPage.FTPPath.Text:='/';

    end;

end;
//------------------ процедура заполнения диалога выбора папок

получилось только сделать список, НО пропали иконки, а организовать перемещение по папкам не получается, один два раза зайдет в папку или выйдет и потом начинают вываливаться ошибки, что за пределами индекса... smile

Подскажите как это реализовать или поделитесь кодом подобного диалога..

Это сообщение отредактировал(а) Nicholas - 6.9.2016, 11:38

Nicholas

Дата 28.9.2016, 08:25 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 436
Регистрация: 30.9.2004

Репутация: нет
Всего: 0

В общем не стал я использовать TDirectoryListBox, а просто создал свою форму.
Может кому пригодиться...

Процедура формирования списка потоке:

Код



{ Опустошить StringGrid }
procedure CleanGrid ( GrilleANettoyer : TStringGrid );
var
    x : integer;
begin
        for x := 1 to GrilleANettoyer.RowCount - 1 do
            GrilleANettoyer.Rows[x].Clear;

    GrilleANettoyer.RowCount  := 2;
    GrilleANettoyer.FixedRows := 1;
end;

{ Ссылка на текущий путь к FTP}
function GetCurrentDirectory( MyHandle: HINTERNET ) : string;
var
    LenS : Cardinal;
    S : string;
begin
    LenS := 0;
    ftpGetCurrentDirectory( MyHandle, PChar(S), LenS );
    SetLength(S, LenS);
    ftpGetCurrentDirectory( MyHandle, PChar(S), LenS );
    Result := Trim(S);
end;

{ Отображает текущую папку каталога ---------------------------------------------}

procedure FilesList( tStringGrid : TStringGrid; OnlyFolders,OnlyFiles:Boolean);
var
    STRUCT_DATA : _WIN32_FIND_DATAA;
    FoundFile   : Pointer;
    bFound      : Boolean;
    BeFolder    : boolean;
    FullSize    : Integer;

begin
    BeFolder := False;
    FoundFile := nil;
    bFound := False;
    FullSize :=0;
    if PConnexionFTP <> nil then
    begin
        ProgressForm.ProgressStatus.Caption := INF_READ_DIR;
        MainPage.FTPselPath.Caption := GetCurrentDirectory( PConnexionFTP );
        CleanGrid( tStringGrid );

        tStringGrid.Cells[1, tStringGrid.RowCount-1] := '..';
        tStringGrid.Cells[2, tStringGrid.RowCount-1] := '---d----';
        tStringGrid.RowCount := tStringGrid.RowCount + 1;

        FoundFile := FtpFindFirstFile( PConnexionFTP, PChar('*.*'), STRUCT_DATA, 0, 0 );

        if FoundFile <> nil then
        repeat

            if (Trim(STRUCT_DATA.cFileName) <> '..') and (Trim(STRUCT_DATA.cFileName) <> '.') then
            begin

            if (OnlyFolders = True)  then
              if  STRUCT_DATA.dwFileAttributes = 16 then
            // если OnlyFolders = true добавим в список только папки
              Begin
                // длинное или короткое имя ?
                if Trim(STRUCT_DATA.cFileName) <> '' then
                  tStringGrid.Cells[1, tStringGrid.RowCount-1] := STRUCT_DATA.cFileName
                else
                  tStringGrid.Cells[1, tStringGrid.RowCount-1] := STRUCT_DATA.cAlternateFileName;
                  tStringGrid.Cells[2, tStringGrid.RowCount-1] := AttributeToStr( STRUCT_DATA.dwFileAttributes );
                  tStringGrid.Cells[3, tStringGrid.RowCount-1] :=                    SizeToStr( STRUCT_DATA.nFileSizeLow );
                  tStringGrid.Cells[4, tStringGrid.RowCount-1] := DateTimeToStr( FileTimeToDateTime( STRUCT_DATA.ftLastWriteTime ) );
                  tStringGrid.RowCount := tStringGrid.RowCount + 1;
               end;

            if (OnlyFolders = False) and (OnlyFiles = false)then
              // если OnlyFolders = false добавим в список файлы и папки
              Begin
                // длинное или короткое имя ?
                if Trim(STRUCT_DATA.cFileName) <> '' then
                  tStringGrid.Cells[1, tStringGrid.RowCount-1] := STRUCT_DATA.cFileName
                else
                  tStringGrid.Cells[1, tStringGrid.RowCount-1] := STRUCT_DATA.cAlternateFileName;
                  tStringGrid.Cells[2, tStringGrid.RowCount-1] := AttributeToStr( STRUCT_DATA.dwFileAttributes );
                  tStringGrid.Cells[3, tStringGrid.RowCount-1] :=  FloatToStr( STRUCT_DATA.nFileSizeLow );
                  FullSize := FullSize +  STRUCT_DATA.nFileSizeLow;
                  tStringGrid.Cells[4, tStringGrid.RowCount-1] := DateTimeToStr( FileTimeToDateTime( STRUCT_DATA.ftLastWriteTime ) );
                  tStringGrid.RowCount := tStringGrid.RowCount + 1;
              End;

               if (OnlyFiles = true)then
              if  STRUCT_DATA.dwFileAttributes <> 16 then
            // если OnlyFiles = true добавим в список только файлы!
              Begin
                // длинное или короткое имя ?
                if Trim(STRUCT_DATA.cFileName) <> '' then
                  tStringGrid.Cells[1, tStringGrid.RowCount-1] := STRUCT_DATA.cFileName
                else
                  tStringGrid.Cells[1, tStringGrid.RowCount-1] := STRUCT_DATA.cAlternateFileName;
                  tStringGrid.Cells[2, tStringGrid.RowCount-1] := AttributeToStr( STRUCT_DATA.dwFileAttributes );
                  tStringGrid.Cells[3, tStringGrid.RowCount-1] :=  FloatToStr( STRUCT_DATA.nFileSizeLow );
                  FullSize := FullSize +  STRUCT_DATA.nFileSizeLow;
                  tStringGrid.Cells[4, tStringGrid.RowCount-1] := DateTimeToStr( FileTimeToDateTime( STRUCT_DATA.ftLastWriteTime ) );
                  tStringGrid.RowCount := tStringGrid.RowCount + 1;
              End;
            end;
                bFound := InternetFindNextFile( FoundFile, @STRUCT_DATA );
                 if KillTread = true then
                  Begin
                    // т.к. прервали уйдем на директорию ниже которую запомнили
                  // в переменной пути
                  EnterToDirectory('/'+MainPage.FTPselPath.Caption);
                  break;
                  end;
        until not bFound;

        InternetCloseHandle( FoundFile );
        tStringGrid.Cells[3, 1] := FloatToStr(FullSize  );
    end;
  end;

{ Открывает каталог }
procedure EnterToDirectory( Directory : string );
var
    CurrentPath : string;
    Temp          : string;
    bSuccess      : LongBool;
begin
      ProgressForm.ProgressStatus.Caption := INF_OPEN_DIR;
    CurrentPath := GetCurrentDirectory( PConnexionFTP );
    if (Trim(CurrentPath) = Trim('/'+Directory))  then
      Begin
        Directory :='';
      End;

    if (Directory = '..')  then
        Temp := ExtractBeforeFolder( CurrentPath )
    else
      Begin
        Temp := SlachFTP(CurrentPath) + Directory;
      End;

    if (LeftStr(Directory,1)='/') then
      Begin
        temp := Directory;
      End;
    // заполним адресную строку в форме выбора папок
    SelectForm.FTPFolders.Cells[1,0]:=Copy(' Текущий путь: /',1,15)+temp;
    bSuccess := FtpSetCurrentDirectory(PConnexionFTP, PChar(Temp));

    if IsConnected = true then
      Begin
      if not bSuccess then
        begin
          MessageBoxA( HandleMain, PChar( 'Не найден указанный путь '+#13+Temp+#13+' на FTP сервере: '+MainPage.EditFTP.text), PChar('Ошибка'), 32 );
          Exit;
        end;
      End
    else
    Begin
       MessageBoxA(HandleMain, PChar('Подключитесь перед использованием этой функции !'), PChar('Подключение ?'), MB_ICONEXCLAMATION);
      Exit;
    End;

end;

procedure TOpenFTPFolderThread.Execute;
var
    Directory : string;
begin

  inherited;
    if  MainPage.IsFolder(SelectForm.FTPFolders) = False then
    begin
        MessageBoxA( Self.Handle, PChar('Можно открыть только папку'), PChar('Ошибка'), 32);
        Exit;
    end;

    Directory := Grid.Cells[1, Grid.selection.Top];
    // если запускаем при старте формы, значит указываем путь
    if path <> '' then
      begin
        Directory := path;
      end;
    EnterToDirectory(Directory);
    FilesList(Grid, True,false);


 // закрываем окно
SendMessage(Progress.ProgressForm.Handle, WM_CLOSE, SW_HIDE, sw_ParentClosing);

end;

Форма выбора папок:

Код


unit SelFolder;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, Outline, DirOutln, ExtCtrls, ImgList;

type
  TSelectForm = class(TForm)
    FTPFolders: TStringGrid;
    BitBtnShowFolders: TBitBtn;
    Ok: TBitBtn;
    ImageList1: TImageList;
    Label1: TLabel;
    Panel1: TPanel;
    Cencel: TBitBtn;
    procedure BitBtnShowFoldersClick(Sender: TObject);
    procedure FTPFoldersDblClick(Sender: TObject);
    procedure FTPFoldersDrawCell(Sender: TObject; ACol, ARow: Integer;
    Rect: TRect; State: TGridDrawState);
    procedure OkClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure CencelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure OpenFTPFolder1Click(Sender: TObject; Path:string);
    Public {declarations }
    SelectedFTPFolder:string;
  end;

var
  SelectForm: TSelectForm;

implementation
uses main,FTP,module,ComObj, ActiveX, ShellApi,ShlObj,Progress;
{$R *.dfm}

  type
  TIconType = (itSmall, itLarge);
 
{ Отображает папки на FTP}
procedure TSelectForm.BitBtnShowFoldersClick(Sender: TObject);
begin
  // запустить подключение в отдельном поток и отображать индикатор ожидания
  Try
    ProgressForm := TProgressForm.create(nil); // создать форму индикатор
    GetFoldersThread:=TGetFoldersThread.Create(false);
    GetFoldersThread.ProgressForm := ProgressForm.Handle;
    GetFoldersThread.Resume;
    ProgressForm.ShowModal(); // показываем модально форму индикатор
    if GetFoldersThread.Terminated = true then // если поток завершен
       ProgressForm.Free;  //очищаем указатель на форму с прогрессом
  Finally
  End;

 Begin
  SelectForm.Close;
end;
end;

{Открывает папку на FTP}
procedure TSelectForm.OpenFTPFolder1Click(Sender: TObject;path:string);
begin
  Try
    ProgressForm := TProgressForm.create(nil); // создать форму индикатор
    OpenFTPFolderThread:=TOpenFTPFolderThread.Create(FTPFolders,'');
    OpenFTPFolderThread.ProgressForm := ProgressForm.Handle;
    OpenFTPFolderThread.Resume;
    ProgressForm.ShowModal(); // показываем модально форму индикатор
    if OpenFTPFolderThread.Terminated = true then // если поток завершен
      ProgressForm.Free;  //очищаем указатель на форму с прогрессом
  Finally
  End;
end;

{Устанавливает выбранную папку в путь}
procedure TSelectForm.OkClick(Sender: TObject);
Var
SelectedPath:String;
begin
  SelectedPath := FTPFolders.Cells[1, FTPFolders.selection.Top];

if (SelectedPath = '..') or (SelectedPath = '') then
  Begin
    SelectedPath := (FTPFolders.Cells[1,0]);
    SelectedPath  :=Copy(SelectedPath,17,Length((SelectedPath)));
    SelectedFTPFolder := SelectedPath;
  end
else
  Begin
    SelectedFTPFolder := SelectedPath;
  End;
  close;
end;

{При двойном шелчке по таблице с папками}
procedure TSelectForm.FTPFoldersDblClick(Sender: TObject);
begin
  if ( Trim(FTPFolders.Cells[2, FTPFolders.selection.Top]) = '' ) then
    begin
      MessageBoxA( Self.Handle, PChar('Выберите правильный путь'), PChar('Ошибка'), 32);
      Exit;
    end;
  if MainPage.IsFolder(FTPFolders) then OpenFTPFolder1Click(self,'') else Begin ShowMessage('Это не папка!!!') end;
end;

{Автоматический подгон по содержимому ширины столбца в таблице}
procedure AutoSizeGridColumn(Grid: TStringGrid;
  column: integer);
var
  i: integer;
  temp: integer;
  max: integer;
begin
  max := 0;
  for i := 0 to (Grid.RowCount - 1) do
  begin
   temp := Grid.Canvas.TextWidth(grid.cells[column, i]);
    if temp > max then
      max := temp;
  end;
  Grid.ColWidths[column] :=max+ Grid.GridLineWidth + 3;
end;

{При прорисовывании ячеек в таблице с папками}
procedure TSelectForm.FTPFoldersDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
img:ticon;
begin
img := Ticon.Create;
if (FTPFolders.Cells[1,ARow] <> '') and (FTPFolders.Cells[1,ARow] <> '..')  then
  Begin
    ImageList1.GetIcon(3,img);
  End
else
  begin
    ImageList1.GetIcon(0,img) ;
  end;
// условие, определяющее нужную ячейку
if ((ACol = 0) and (ARow <> FTPFolders.RowCount-1))and (ARow<>0) then
  begin
  // назначение размера ячейки по ширине и высоте
  FTPFolders.ColWidths[ACol] := img.Width;
  FTPFolders.RowHeights[ARow] := img.Height;
  // вывод рисунка в текущей ячейке
  FTPFolders.Canvas.StretchDraw(Rect, img);
  FTPFolders.ColWidths[1]:=518;
  FTPFolders.ColWidths[2]:=0;
  FTPFolders.ColWidths[3]:=0;
  FTPFolders.ColWidths[4]:=0;
  end;
end;
end.

ProgressForm это просто форма ожидания с индикатором ...

Это сообщение отредактировал(а) Nicholas - 28.9.2016, 08:58

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »