ftpsubdir.pas

最好的局域网搜索软件

{-------------------------------------------------------------------------------
  Browse FTP files
  This is not a vcl component, it's just a unit, needn't install.
-------------------------------------------------------------------------------}

unit FtpSubDir;

interface

uses
  Windows, WinInet, ComCtrls, Classes, Main, Dialogs, SysUtils;

type
  TFtpSubDirThread=class(TThread)
  private
    { Private declarations }
    //FileList: TStringList;
    FindData : TWin32FindData;
    EverFind: boolean;
    ErrCode1: DWORD;
    procedure OpenFailed;
    procedure EndOfBrowse;
    procedure GetFindData(FindData: TWin32FindData);
    procedure FindFile;
  public
    { Public declarations }
    FtpHandle: HINTERNET;
    FtpSvr, Dir, DisplayDir: string;
    ParentNode: TTreeNode;
    MyTree: TTreeView;
    RListItem: TListItem;
    MyListView: TListView;
    ClickType: OwnerType;
    procedure Execute; override;
    constructor Create;
    destructor Destroy; override;
  end;

implementation

procedure TFtpSubDirThread.GetFindData(FindData: TWin32FindData);
var
  TemNode: TTreeNode;
  FileName: string;
  pnode: PFtpNodeType;
  newListItem   : TListItem;
  fPtr          : pFileItem;
  FullFileName: string;
  FileSize: integer;
begin

  FileName := FindData.CFileName;
  FileSize := FindData.nFileSizeLow;

  if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
  begin
    if (FileName <> '.') and (FileName <> '..') then
    begin
      //FileList.Add(FileName + '/');
      newListItem := MyListView.items.Add;
      newListItem.caption := FileName;
      new(fPtr);
      fPtr.ftype := IsDir;
      fPtr.size := FileSize;
      newListItem.Data := fPtr;
      newListItem.ImageIndex := 0; //GetImgIndex(FileName);

      FullFileName := 'ftp://' + FtpSvr + Dir + '/' + FileName + '/';
      MainForm.AllListBox.Items.Insert(0, FullFileName);
      EverFind := true;

      if ClickType = InTreeView then
      begin
        TemNode := MyTree.Items.AddChild(ParentNode, FileName);
        //TemNode.Data := FtpHandle;
        new(pnode);
        pnode^.FtpHandle := FtpHandle;
        pnode^.FtpSvr := FtpSvr;
        pnode^.MyDir := Dir + '/' + FileName;
        pnode^.DisplayDir := DisplayDir + '/' + FileName;
        TemNode.Data := pnode;
        TemNode.ImageIndex := 115;
        TemNode.SelectedIndex := 115;
      end;

      MainForm.CheckFile(FileName, 'ftp://' + FtpSvr + Dir , 'ftp', 0, FileSize);
    end;
  end
  else
  begin
    //FileList.Add(FileName);
    newListItem := MyListView.items.Add;
    newListItem.caption := FileName;
    if FileSize > 1024 then
      newListItem.SubItems.Add(FormatFloat('#,###" KB"',  FileSize/ 1024))
    else
      newListItem.SubItems.Add(inttostr(FileSize)+'B');
    new(fPtr);
    fPtr.ftype := IsFile;
    fPtr.size := FileSize;
    newListItem.Data := fPtr;
    newListItem.ImageIndex := GetImgIndex(FileName);

    FullFileName := 'ftp://' + FtpSvr + Dir + '/' + FileName;
    MainForm.AllListBox.Items.Insert(0, FullFileName);
    EverFind := true;

    MainForm.CheckFile(FileName, 'ftp://' + FtpSvr + Dir , 'ftp', 1, FileSize);
  end;
   
end;

procedure TFtpSubDirThread.FindFile;
begin
  GetFindData(FindData);
end;

constructor TFtpSubDirThread.Create;
begin

  EverFind := false;
  FreeOnTerminate := True;
  inherited Create(True);
  
end;

destructor TFtpSubDirThread.Destroy;
begin
  //FileList.Free;
end;

procedure TFtpSubDirThread.OpenFailed;
begin

  if ClickType = InTreeView then
  begin
    ParentNode.ImageIndex := 126;
    ParentNode.SelectedIndex := 126;
    //ShowMessage(format('error code:%d',[ErrCode1])); ///
  end;

  RListItem.ImageIndex := 126;

end;

procedure TFtpSubDirThread.EndOfBrowse;
begin

  if ClickType = InTreeView then
  begin
    if EverFind then
    begin
      ParentNode.ImageIndex := 113;
      ParentNode.SelectedIndex := 113;
    end
    else
    begin
      ParentNode.ImageIndex := 127;
      ParentNode.SelectedIndex := 127;
    end;
    //ParentNode.Expand(false);
  end;

  if EverFind then RListItem.ImageIndex := 113 else RListItem.ImageIndex := 127

end;

procedure TFtpSubDirThread.Execute;
var
  //len: DWORD;
  FindHandle : HInternet;
begin

  if FtpHandle <> nil then
  begin
    {
    len := 0;
    FtpGetCurrentDirectory(FtpHandle, PChar(Dir), len);
    SetLength(Dir, len);
    FtpGetCurrentDirectory(FtpHandle, PChar(Dir), len);
    //Caption := Dir;
    }
    
    FtpSetCurrentDirectory(FTPHandle, PChar(Dir)); 

    //-----------------------
    FindHandle := FtpFindFirstFile(FtpHandle, '*.*', FindData, 0, 0);
    if FindHandle = nil then
    begin
      ErrCode1 := GetLastError;
      synchronize(OpenFailed);
      exit;
    end;
    
    //GetFindData(FindData);
    synchronize(FindFile);
    
    while InternetFindNextFile(FindHandle,@FindData) do
    begin
          //GetFindData(FindData);
          synchronize(FindFile);
    end;
    
    InternetCloseHandle(Findhandle); 
    
    synchronize(EndOfBrowse);
       
  end
  else
  begin
    synchronize(OpenFailed);
    //MainForm.Caption := 'here..#';
  end;

end;

end.