Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 29.10.2023, 10:11   #1
AppData
Форумчанин
 
Регистрация: 20.09.2013
Сообщений: 248
По умолчанию Поиск архива *.rar на сервере ftp

Подскажите как осуществить рекурсивный поиск файлов на сервере FTP, да так чтоб все файлы находил!!!
он находит не все файлы.
в папке несколько rar файлов, а он находит постоянно только определенные. почему , не понятно!


Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, XPMan, Buttons, Math, ShellApi, ImgList, CommCtrl,
  Menus, Unit2, INIFiles, System.ImageList;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    XPManifest1: TXPManifest;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Edit3: TEdit;
    Label3: TLabel;
    GroupBox2: TGroupBox;
    BitBtn1: TBitBtn;
    Edit4: TEdit;
    Label4: TLabel;
    StatusBar1: TStatusBar;
    ListView1: TListView;
    Edit5: TEdit;
    Label5: TLabel;
    ImageList1: TImageList;
    ComboBox1: TComboBox;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListView1DblClick(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  end;

var
  Form1: TForm1;
  flag:boolean;

implementation

{$R *.dfm}

uses
  WinInet;

procedure TForm1.BitBtn1Click(Sender: TObject);

  procedure FindFTPFiles(FConnect: HINTERNET; Dir: String);
  var
    hFileConnection: HINTERNET;
    FindData: TWin32FindData;
    SubDirs: TStringList;
    I: Integer;
    h:DWORD;
    si:SHFILEINFO;
    attr:Cardinal;
  begin
    SubDirs := TStringList.Create;
    try
      FtpSetCurrentDirectory(FConnect, PChar(Dir));
      hFileConnection := FtpFindFirstFile(FConnect, pChar('*.*'), FindData,
        INTERNET_FLAG_NEED_FILE , 0);
      if hFileConnection <> nil then
      try
        ZeroMemory(@FindData, SizeOf(TWin32FindData));
        while InternetFindNextFile(hFileConnection, @FindData) do
        begin
          If Flag=false then break;
          if (StrPas(FindData.cFileName) = '.') or (StrPas(FindData.cFileName) = '..') then Continue;
          if Pos(Edit4.text, StrPas(FindData.cFileName)) <> 0 then begin
              ListView1.AddItem(Dir + String(FindData.cFileName), Form1);
              with ListView1.Items[ListView1.Items.Count-1] do
              begin
                SubItems.Add(FloatToStr(RoundTo(FindData.nFileSizeLow/1024, -2)));
                SubItems.Add(IntToStr(FindData.dwFileAttributes));
                if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then attr:=FILE_ATTRIBUTE_DIRECTORY else attr:=0;
                h:=SHGetFileInfo(FindData.cFileName, attr, si, SizeOf(si),SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
                ImageList1.ShareImages:=true;
                ImageList1.Handle:=h;
                ImageIndex:=si.iIcon;
              end;
          end;
          StatusBar1.Panels[0].Text:=Dir;
          if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
          begin
            SubDirs.Add(Dir + String(FindData.cFileName) + '/');
          end
          else
          Application.ProcessMessages;
        end;

      finally
        InternetCloseHandle(hFileConnection);
      end;

      for I := 0 to SubDirs.Count - 1 do begin
        if flag=true then begin
        FindFTPFiles(FConnect, SubDirs.Strings[I]);
        end;
      end;
     finally
      SubDirs.Free;
    end;
  end;

var
  FSession, FConnect: HINTERNET;
  FHost: String;
  st: integer;
  path:string;

begin
  Caption:='Идет поиск...';
  Flag:= Not Flag;
  ProgressBar1.Visible:=flag;
  If flag=true then begin
    BitBtn1.Kind:=bkIgnore;
    BitBtn1.Caption:='Прервать';
    st:=GetWindowLong(Progressbar1.Handle, GWL_STYLE);
    SetWindowLong(Progressbar1.Handle,GWL_STYLE, st or 8);
    SendMessage(Progressbar1.Handle, (WM_USER+10), 1, 50);
    ListView1.Items.Clear;
  end
  else begin
    BitBtn1.Kind:=bkYes;
    BitBtn1.Caption:='Найти';
    StatusBar1.Panels[0].Text:='Готово';
    Exit;
  end;

  FHost := ComboBox1.Text;
  FSession := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if not Assigned(FSession) then Exit;
  try
    FConnect := InternetConnect(FSession, PChar(FHost),
      INTERNET_DEFAULT_FTP_PORT, PChar(Edit2.Text),
      PChar(Edit3.Text), INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);
    if not Assigned(FConnect) then Exit;
    try
      path:= copy(Edit5.Text, StrLen(pChar(edit5.Text)), 1);
      If path <> '/' then Edit5.Text:=Edit5.Text+'/';
      FindFTPFiles(FConnect, edit5.Text);
      Caption:='Поиск завершен';
      MessageBeep(MB_ICONINFORMATION);
      flag:=false;
      Progressbar1.Visible:=flag;
      BitBtn1.Kind:=bkYes;
      BitBtn1.Caption:='Найти';
    finally
      InternetCloseHandle(FConnect);
    end;
  finally
    InternetCloseHandle(FSession);
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Flag:=false;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 CanClose := False;
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var fname: string;
begin
if LowerCase(Edit2.Text)='anonymous' then
  fname:='ftp://' + Edit2.Text + '@' +  ComboBox1.Text + ListView1.Selected.Caption
else
  fname:='ftp://' + Edit2.Text + ':' + Edit3.Text + '@' +  ComboBox1.Text + ListView1.Selected.Caption;
Shellexecute(handle, 'open', 'explorer', Pchar('/select, ' + fname), '', SW_SHOW);
end;

procedure TForm1.N5Click(Sender: TObject);
begin
Form1.Close;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
Form2.ShowModal;
end;

procedure TForm1.N2Click(Sender: TObject);

begin
ComboBox1.AddItem(InputBox('Добавить сервер', 'Введите адрес сервера', ''), Form1);
ComboBox1.Text:=ComboBox1.Items[ComboBox1.Items.Count-1];
end;

end.
AppData вне форума Ответить с цитированием
Старый 29.10.2023, 17:20   #2
AppData
Форумчанин
 
Регистрация: 20.09.2013
Сообщений: 248
По умолчанию

да почему же не все папки отображает? ((( и не все файлы

Код:
procedure TForm1.FormCreate(Sender: TObject);
  procedure FindFTPFiles(FConnect: HINTERNET; Dir: String);
  var
    hFileConnection: HINTERNET;
    FindData: TWin32FindData;
    SubDirs: TStringList;
    I: Integer;
  begin
    SubDirs := TStringList.Create;
    try
      FtpSetCurrentDirectory(FConnect, PChar(Dir));
      hFileConnection := FtpFindFirstFile(FConnect, pChar('*.*'), FindData,
        INTERNET_FLAG_NEED_FILE , 0);
      if hFileConnection <> nil then
      try
        ZeroMemory(@FindData, SizeOf(TWin32FindData));

        while InternetFindNextFile(hFileConnection, @FindData) do
        begin
          if
            (StrPas(FindData.cFileName) = '.') or
            (StrPas(FindData.cFileName) = '..') then
            Continue;

          if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
          begin
            SubDirs.Add(Dir + String(FindData.cFileName) + '/');
            Memo1.Lines.Add(Dir + String(FindData.cFileName) + '/');
          end
          else
            Memo1.Lines.Add(Dir + String(FindData.cFileName));

          Application.ProcessMessages;
          if Memo1.Lines.Count > 100 then Break;
        end;

      finally
        InternetCloseHandle(hFileConnection);
      end;

      for I := 0 to SubDirs.Count - 1 do
        FindFTPFiles(FConnect, SubDirs.Strings[I]);

    finally
      SubDirs.Free;
    end;
  end;

var
  FSession, FConnect: HINTERNET;
  FHost: String;

begin
  FHost := hostname;
  FSession := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if not Assigned(FSession) then Exit;
  try
    FConnect := InternetConnect(FSession, PChar(FHost),
      INTERNET_DEFAULT_FTP_PORT, PChar(''),
      PChar(''), INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);
    if not Assigned(FConnect) then Exit;
    try
      FindFTPFiles(FConnect, foldername);
      Memo1.Lines.Add('All done');
    finally
      InternetCloseHandle(FConnect);
    end;
  finally
    InternetCloseHandle(FSession);
  end;
end;
AppData вне форума Ответить с цитированием
Старый 30.10.2023, 09:33   #3
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,526
По умолчанию

потому что у папки установлены ещё какие-то атрибуты помимо FILE_ATTRIBUTE_DIRECTORY
и посему
FindData.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY
Код:
... and atribute =atribute
Код:
{001001           <> 001000}
{001001 and 001000 = 001000}
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 30.10.2023, 12:00   #4
AppData
Форумчанин
 
Регистрация: 20.09.2013
Сообщений: 248
По умолчанию

смотрел свойства папки и файла, права одинаковые 1/1

как игнорировать это? как заставить работать?

так?

Код:
attributes:=AttrStr(SearchRec.FindData.dwFileAttributes
не помогло
Код:
if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY and FindData.dwFileAttributes then

Последний раз редактировалось AppData; 30.10.2023 в 12:17.
AppData вне форума Ответить с цитированием
Старый 30.10.2023, 15:03   #5
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,526
По умолчанию

Код:
FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 30.10.2023, 16:31   #6
AppData
Форумчанин
 
Регистрация: 20.09.2013
Сообщений: 248
По умолчанию

не помогло! даже

Код:
if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
// файл
end else begin
// папка
end;
AppData вне форума Ответить с цитированием
Старый 08.11.2023, 20:30   #7
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,814
По умолчанию

в цикле перебором подставлять различные параметры атрибутов (это число) и выводить на экран список каждый раз
неужто ни один параметр атрибута не подойдёт, чтоб вывеси нормально все имеющиеся файлы?
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.
NetSpace вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск файлов на сервере sergei92 C++ Builder 12 02.12.2015 20:32
поиск на сервере Яндекс(Тест) Tolian92 Помощь студентам 1 03.06.2013 20:57
Пароль для SFX-архива. debility Безопасность, Шифрование 3 10.09.2010 11:39
поиск в письмах нас сервере мимо Работа с сетью в Delphi 0 18.01.2010 15:23
Поиск файлов на сервере ugodal Работа с сетью в Delphi 0 24.12.2009 11:33