ftpbrowse.pas

局域网搜索 (LAN Explorer) ver 1.6 最好的局域网搜索软件

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

unit FtpBrowse;

interface

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

type
  TFtpBrowseThread=class(TThread)
  private
    { Private declarations }
    FtpHandle, InetHandle: HINTERNET;
    CurData: TWin32FindData;
    FileList: TStringList;
    SizeList: TStringList;
    RootDir: string;
    //CurDir: string;
    ErrCode1, ErrCode2, ErrCode3: DWORD;
    IsRoot: boolean;
    procedure OpenFailed1;
    procedure OpenFailed2;
    procedure OpenFailed3;
    procedure SearchRootFinished;
    //procedure AheadOfBrowse;
    procedure AddFileToRootDir;
    procedure BrowseDir(Dir: string);
    procedure AddToHistory;
    procedure AddRootNode;
  public
    { Public declarations }
    recursive: boolean;
    ProxyName, ProxyPass: LPCSTR;
    FtpSvr, UsrName, PassWord: string;
    HostNode, HomeDirNode: TTreeNode;
    MyTree: TTreeView;
    procedure Execute; override;
    constructor Create(My_Tree: TTreeView; Host_Node: TTreeNode; Proxy_Name,
      Proxy_Pass: LPCSTR; Ftp_Svr, Usr_Name, Pass_Word: string; _recursive: boolean);
    destructor Destroy; override;
  end;

implementation
uses Config;

procedure TFtpBrowseThread.AddToHistory;
var
  HisGroupNode, TemNode: TTreeNode;
  url: string;
  i: integer;
begin

  with MainForm do
  begin
    if MyTree = HistoryTree then exit;
    HisGroupNode := nil;

    for i := 0 to HistoryTree.Items[0].Count - 1 do
    if UpperCase(trim(HistoryTree.Items[0].Item[i].Text)) = 'FTP' then
    begin
      HisGroupNode := HistoryTree.Items[0].Item[i];
    end;

    if HisGroupNode = nil then
    begin
      HisGroupNode := HistoryTree.Items.AddChild(HistoryTree.Items[0], 'FTP');
      HisGroupNode.ImageIndex := 9;
      HisGroupNode.SelectedIndex := 9;
      HistoryTree.Items[0].Expand(false);
    end;

    url := 'ftp://' + FtpSvr;
    for i := 0 to HisGroupNode.Count - 1 do
    if UpperCase(HisGroupNode.Item[i].Text) = UpperCase(url) then exit; //already exist

    TemNode := HistoryTree.Items.AddChild(HisGroupNode, url);
    TemNode.ImageIndex := 114;
    TemNode.SelectedIndex := 114;
    TemNode.Data := nil;

    HisGroupNode.Expand(false);
  end;
  
end;

procedure TFtpBrowseThread.AddFileToRootDir;
var
  TemNode: TTreeNode;
  FileName: string;
  FileSize: DWORD;

  pnode: PFtpNodeType;
  FullFileName: string;
begin

  FileName := CurData.CFileName;
  FileSize := CurData.nFileSizeLow;
    
  if CurData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
  begin
    if (FileName <> '.') and (FileName <> '..') then
    begin
      FileList.Add(FileName + '/');
      SizeList.Add(inttostr(FileSize));

      //if RootDir = '/' then
      FullFileName := 'ftp://' + FtpSvr + '/' + FileName + '/';
      //else FullFileName := 'ftp://' + FtpSvr + RootDir + '/' + FileName + '/';

      MainForm.AllListBox.Items.Insert(0, FullFileName);

      TemNode := MyTree.Items.AddChild(HomeDirNode, FileName);
      new(pnode);
      pnode^.FtpHandle := FtpHandle;

      if RootDir = '/' then pnode^.MyDir := RootDir + FileName
      else pnode^.MyDir := RootDir + '/' + FileName;
      //MainForm.Caption := MainForm.Caption + ':' + pnode^.MyDir; ///

      pnode^.DisplayDir := '/' + FileName;

      pnode^.FtpSvr := FtpSvr;
      TemNode.Data := pnode;
      TemNode.ImageIndex := 115;
      TemNode.SelectedIndex := 115;

      MainForm.CheckFile(FileName, 'ftp://' + FtpSvr, 'ftp', 0, FileSize);
    end;
  end
  else
  begin
    FileList.Add(FileName);
    SizeList.Add(inttostr(FileSize));
    FullFileName := 'ftp://' + FtpSvr + '/' + FileName;
    MainForm.AllListBox.Items.Insert(0, FullFileName);

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

procedure TFtpBrowseThread.BrowseDir(Dir: string);
var
  FindHandle : HInternet;
  FindData: TWin32FindData;
  //pnode: PFtpNodeType;

  DirList: TStringList;
  i: integer;
  b, bb: boolean;
  FileName, FullFileName: string;
  FileSize: DWORD;
begin

  if recursive then DirList := TStringList.Create;

  FindHandle := FtpFindFirstFile(FtpHandle, '*.*', FindData, 0, 0);
  if FindHandle <> nil then
  begin
    CurData := FindData;
    
    if IsRoot then
    begin
      synchronize(AddFileToRootDir);
    end;

    if recursive then
    begin
      FileName := CurData.CFileName;
      FileSize := CurData.nFileSizeLow;

      if CurData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
      begin
        if (FileName <> '.') and (FileName <> '..') then
        begin
          DirList.Add(CurData.CFileName);

          if (not IsRoot) then
          begin
            FullFileName := 'ftp://' + FtpSvr + Dir + '/' + FileName + '/';
            MainForm.AllListBox.Items.Insert(0, FullFileName);
            MainForm.CheckFile(FileName, 'ftp://' + FtpSvr + Dir, 'ftp', 0, FileSize);
          end;
          
        end;
      end
      else
      begin
          if (not IsRoot) then
          begin
            FullFileName := 'ftp://' + FtpSvr + Dir + '/' + FileName;
            MainForm.AllListBox.Items.Insert(0, FullFileName);
            MainForm.CheckFile(FileName, 'ftp://' + FtpSvr + Dir, 'ftp', 1, FileSize);
          end;
      end;
      
    end; // if recursive
  end;

  while InternetFindNextFile(FindHandle, @FindData) do
  begin
    CurData := FindData;

    if IsRoot then
    begin
      synchronize(AddFileToRootDir);
    end;

    if recursive then
    begin
      FileName := CurData.CFileName;
      FileSize := CurData.nFileSizeLow;

      if CurData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
      begin
        if (FileName <> '.') and (FileName <> '..') then
        begin
          DirList.Add(CurData.CFileName);

          if (not IsRoot) then
          begin
            FullFileName := 'ftp://' + FtpSvr + Dir + '/' + FileName + '/';
            MainForm.AllListBox.Items.Insert(0, FullFileName);
            MainForm.CheckFile(FileName, 'ftp://' + FtpSvr + Dir, 'ftp', 0, FileSize);
          end;
          
        end;
      end
      else
      begin
          if (not IsRoot) then
          begin
            FullFileName := 'ftp://' + FtpSvr + Dir + '/' + FileName;
            MainForm.AllListBox.Items.Insert(0, FullFileName);
            MainForm.CheckFile(FileName, 'ftp://' + FtpSvr + Dir, 'ftp', 1, FileSize);
          end;
      end;
      
    end; // if recursive
  end;

  if (IsRoot) then synchronize(SearchRootFinished);

  InternetCloseHandle(FindHandle);

  if recursive then
  begin
    IsRoot := false;

    for i:=0 to (DirList.Count-1) do
    begin
      b := false;
      while (not b) do
      b := FtpSetCurrentDirectory(FTPHandle, PChar(DirList.Strings[i]));

      BrowseDir(Trim(Dir) + '/' + DirList.Strings[i]);

      bb := false;
      while (not bb) do
      bb := FtpSetCurrentDirectory(FTPHandle, '..');
    end;

    DirList.Free;
  end;

end;

constructor TFtpBrowseThread.Create(My_Tree: TTreeView; Host_Node: TTreeNode;
  Proxy_Name, Proxy_Pass: LPCSTR; Ftp_Svr, Usr_Name, Pass_Word: string; _recursive: boolean);
begin

  ProxyName := Proxy_Name;
  ProxyPass := Proxy_Pass;
  FtpSvr := Ftp_Svr;
  UsrName := Usr_Name;
  PassWord := Pass_Word;
  MyTree := My_Tree;
  HostNode := Host_Node;
  IsRoot := true;
  recursive := _recursive;
  
  FileList := TStringList.Create;
  SizeList := TStringList.Create;
  //FileList.Clear;
  
  FreeOnTerminate := True;
  inherited Create(True);
  
end;

destructor TFtpBrowseThread.Destroy;
begin
  //MainForm.Caption := MainForm.Caption + ':' + inttostr(integer(HomeDirNode.Data)); ///
  FileList.Free;
  SizeList.Free;
end;

procedure TFtpBrowseThread.OpenFailed1;
var
  s: string;
begin
  s := 'ftp error1:' + inttostr(ErrCode1);
  //MessageBox(MainForm.Handle, pchar(s), 'ftp', MB_ICONQUESTION);
  HostNode.ImageIndex := 117;
  HostNode.SelectedIndex := 117;
end;

procedure TFtpBrowseThread.OpenFailed2;
var
  s: string;
begin

  if (ErrCode2 = ERROR_INTERNET_INCORRECT_PASSWORD) or
    (ErrCode2 = ERROR_INTERNET_INCORRECT_USER_NAME) or
    (ErrCode2 = ERROR_INTERNET_LOGIN_FAILURE) then
  begin
    HostNode.ImageIndex := 118; // locked ftp
    HostNode.SelectedIndex := 118;
  end
  else
  begin
    s := 'ftp error2:' + inttostr(ErrCode2);
    //MessageBox(MainForm.Handle, pchar(s), 'ftp', MB_ICONQUESTION);
    HostNode.ImageIndex := 117;
    HostNode.SelectedIndex := 117;
  end;
end;

procedure TFtpBrowseThread.OpenFailed3;
var
  s: string;
begin
  s := 'ftp error3:' + inttostr(ErrCode3);
  //MessageBox(MainForm.Handle, pchar(s), 'ftp', MB_ICONQUESTION);
  if ErrCode3 = ERROR_INTERNET_EXTENDED_ERROR then
  begin
    HostNode.ImageIndex := 117;
    HostNode.SelectedIndex := 117;
  end
  else
  begin
    HostNode.ImageIndex := 119;
    HostNode.SelectedIndex := 119;
  end
end;

procedure TFtpBrowseThread.AddRootNode;
var
  pnode: PFtpNodeType;
begin
  HomeDirNode := MyTree.Items.AddChild(HostNode, {RootDir}'/');
  new(pnode);
  pnode^.FtpHandle := FtpHandle;
  pnode^.MyDir := RootDir;
  pnode^.FtpSvr := FtpSvr;
  pnode^.DisplayDir := '/';
  HomeDirNode.Data := pnode;
  HomeDirNode.ImageIndex := 113;
  HomeDirNode.SelectedIndex := 113;
  AddToHistory;
end;

procedure TFtpBrowseThread.SearchRootFinished;
var
  ListItem      : TListitem;
  ListItemPtr   : PListItem;
  //pnode         : PFtpNodeType;
begin

  HostNode.ImageIndex := 124;
  HostNode.SelectedIndex := 124;

  with MainForm do
  begin
    with ShareListView do
    begin
      ListItem:=Items.Insert(0);
      ListItem.ImageIndex := 113;
      ListItem.Caption := '/'; //RootDir;  /// 05.11.2
      ListItem.SubItems.Add('ftp://' + FtpSvr);
      ListItem.SubItems.Add('ftp');

      new(ListItemPtr);
      ListItemPtr.index := StrListAll.Count;
      StrListAll.AddStrings(FileList);
      SizeListAll.AddStrings(SizeList);
      ListItemPtr.count := FileList.Count;
      ListItemPtr.FtpHandle := FtpHandle;
      ListItemPtr.FtpDir := RootDir; /// 05.11.2
      ListItem.data := ListItemPtr;
      ListItemPtr.PrevDirItem := nil;
      ListItemPtr.NextDirItem := nil;
      ListItemPtr.UpDirItem := nil;

      //new(pnode);
      //pnode^.MyRightListItem := ListItem;
      //HomeDirNode.Data := pnode;
      PFtpNodeType(HomeDirNode.Data)^.MyRightListItem := ListItem;
    end;
  end;
  
  HostNode.Expand(false);
  //HomeDirNode.Expand(false);

end;

procedure TFtpBrowseThread.Execute;
var
  DirLen: DWORD;
  FindHandle : HInternet;
  FindData: TWin32FindData;

  s: string;
  i: integer;
  GuessSucceed: boolean;
begin

  //synchronize(AheadOfBrowse);

  InetHandle := InternetOpen('Ftp', 0, ProxyName, ProxyPass, 0{INTERNET_FLAG_ASYNC});

  if InetHandle = nil then 
  begin
  	synchronize(OpenFailed1);
  	exit;
  end;

  FtpHandle := InternetConnect(InetHandle, PChar(FtpSvr),
        INTERNET_DEFAULT_FTP_PORT,
        PChar(UsrName),
        PChar(PassWord),
        INTERNET_SERVICE_FTP,
        INTERNET_FLAG_PASSIVE, //0,
        0
        );

  if FtpHandle = nil then
  FtpHandle := InternetConnect(InetHandle, PChar(FtpSvr),
        0,
        PChar(UsrName),
        PChar(PassWord),
        INTERNET_SERVICE_FTP,
        0,
        0
        );

  if FtpHandle = nil then
  begin
    //------------------------guess-------------------------
    GuessSucceed := false;

    for i := 0 to ConfigForm.lvFtpMountList.Items.Count-1 do
    begin
      s := ConfigForm.lvFtpMountList.Items[i].Caption;
      if s =  '*' then
      begin
        UsrName := ConfigForm.lvFtpMountList.Items[i].SubItems[0];
        //PassWord := ConfigForm.lvFtpMountList.Items[i].SubItems[1];
        PassWord := ConfigForm.FtpPassList.Strings[i];

        FtpHandle := InternetConnect(InetHandle, PChar(FtpSvr),
          INTERNET_DEFAULT_FTP_PORT,
          PChar(UsrName),
          PChar(PassWord),
          INTERNET_SERVICE_FTP,
          INTERNET_FLAG_PASSIVE, //0,
          0
          );

        if FtpHandle <> nil then
        begin
          GuessSucceed := true;
          break;
        end;

        if FtpHandle = nil then
        FtpHandle := InternetConnect(InetHandle, PChar(FtpSvr),
          0,
          PChar(UsrName),
          PChar(PassWord),
          INTERNET_SERVICE_FTP,
          0,
          0
          );

        if FtpHandle <> nil then
        begin
          GuessSucceed := true;
          break;
        end;
      end;
    end;
    //------------------------------------------------------
    if (not GuessSucceed) then
    begin
      ErrCode2 := GetLastError;
      synchronize(OpenFailed2);
      exit;
    end;
  end;

  if FtpHandle <> nil then
  begin

    DirLen := 0;
    FtpGetCurrentDirectory(FtpHandle, PChar(RootDir), DirLen);
    SetLength(RootDir, DirLen);
    FtpGetCurrentDirectory(FtpHandle, PChar(RootDir), DirLen);
    RootDir := trim(RootDir);
    //Caption := Dir;
    //CurDir := '/';

    //-----------just add root dir-------------
    FindHandle := FtpFindFirstFile(FtpHandle, '*.*', FindData, 0, 0);
    if FindHandle = nil then
    begin
      ErrCode3 := GetLastError;
      synchronize(OpenFailed3);
      exit;
    end;

    synchronize(AddRootNode);

    InternetCloseHandle(FindHandle);
    //-------------------------------------------

    BrowseDir('');

    //-----------------------
    {FindHandle := FtpFindFirstFile(FtpHandle, '*.*', FindData, 0, 0);
    if FindHandle = nil then
    begin
      ErrCode3 := GetLastError;
      synchronize(OpenFailed3);
      exit;
    end;}
    
    //GetFindData(FindData);
    //synchronize(FindFile);
    
    {while InternetFindNextFile(FindHandle,@FindData) do
    begin
          //GetFindData(FindData);
          synchronize(FindFile);
    end;}
    
    //InternetCloseHandle(FindHandle);
    
    //synchronize(EndOfBrowse);
       
  end;

end;

end.