end;

end;

procedure TMyFtp.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  if FTP.Busy then

  begin

    FTP.Cancel;

    FTP.Quit;

    while FTP.Busy do

      Application.ProcessMessages;

  end;

end;

function TMyFtp.CreateItem(const FileName, Attributes, Size, Date: Variant): TListItem;

var

  Ext: String;

  ShFileInfo: TSHFILEINFO;

begin

  Result := FileList.Items.Add;

  with Result do

  begin

    Caption := FixCase(Trim(FileName));

    if Size > 0 then

    begin

      if Size div 1024 <> 0 then

      begin

        SubItems.Add(IntToStr(Size div 1024));

        SubItems[0] := SubItems[0] + 'KB';

      end

      else

        SubItems.Add(Size);

    end

    else

      SubItems.Add('');

    if Attributes = '1' then

    begin

      SubItems.Add('File Folder');

      ImageIndex := 3;

    end

    else

    begin

      Ext := ExtractFileExt(FileName);

      ShGetFileInfo(PChar('c:\*' + Ext), 0, SHFileInfo, SizeOf(SHFileInfo),

        SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME);

      if Length(SHFileInfo.szTypeName) = 0 then

      begin

        if Length(Ext) > 0 then

        begin

          System.Delete(Ext, 1, 1);

          SubItems.Add(Ext + ' File');

        end

        else

          SubItems.Add('File');

      end

      else

        SubItems.Add(SHFileInfo.szTypeName);

      ImageIndex := SHFileInfo.iIcon;

    end;

    SubItems.Add(Date);

  end;

end;

procedure TMyFtp.Disconnect;

begin

  FTP.Quit;

  Application.ProcessMessages;

end;

procedure TMyFtp.FormCreate(Sender: TObject);

var

  SHFileInfo: TSHFileInfo;

begin

  with DirTree do

  begin

    DirTree.Images := SmallImages;

    SmallImages.ResourceLoad(rtBitmap, 'IMAGES', clOlive);

  end;

  with FileList do

  begin

    SmallImages := TImageList.CreateSize(16,16);

    SmallImages.ShareImages := True;

    SmallImages.Handle := ShGetFileInfo('*.*', 0, SHFileInfo,

      SizeOf(SHFileInfo), SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

    LargeImages := TImageList.Create(nil);

    LargeImages.ShareImages := True;

    LargeImages.Handle := ShGetFileInfo('*.*', 0, SHFileInfo,

      SizeOf(SHFileInfo), SHGFI_LARGEICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

  end;

end;

procedure TMyFtp.FTPBusy(Sender: TObject; isBusy: Wordbool);

begin

  if isBusy then

  begin

    Screen.Cursor := crHourGlass;

    FileList.Items.BeginUpdate;

    FileList.Items.Clear;

  end

  else

  begin

    Screen.Cursor := crDefault;

    FileList.Items.EndUpdate;

  end;

end;

function TMyFtp.NodePath(Node: TTreeNode): String;

begin

  if Node = Root then

    Result := '.'

  else

    Result := NodePath(Node.Parent) + '/' + Node.Text;

end;

procedure TMyFtp.DirTreeChange(Sender: TObject; Node: TTreeNode);

var

  NP: String;

begin

  if (FTP.State <> prcConnected) or FTP.Busy then exit;

  if Node <> nil then

  begin

    NP := NodePath(DirTree.Selected);

    FTP.List(NP);

    Label2.Caption := Format('Contents of: ''%s/''',[NP]);

  end;

end;

procedure TMyFtp.RefreshBtnClick(Sender: TObject);

begin

  FTP.List(NodePath(DirTree.Selected));

end;

procedure TMyFtp.DirTreeChanging(Sender: TObject; Node: TTreeNode;

  var AllowChange: Boolean);

begin

  AllowChange := not FTP.Busy;

end;

procedure TMyFtp.FTPStateChanged(Sender: TObject; State: Smallint);

begin

  with FTP, Statusbar.Panels[0] do

    case State of

      prcConnecting   : Text := 'Connecting';

      prcResolvingHost: Text := 'Connecting';

      prcHostResolved : Text := 'Host resolved';

      prcConnected    :

        begin

          Text := 'Connected to: ' + RemoteHost;

          ConnectBtn.Hint := 'Disconnect';

          FileNewItem.Enabled := True;

          ViewLargeItem.Enabled := True;

          ViewSmallItem.Enabled := True;

          ViewListItem.Enabled := True;

          ViewDetailsItem.Enabled := True;

          ViewRefreshItem.Enabled := True;

          ToolsDisconnectItem.Enabled := True;

          LargeBtn.Enabled := True;

          SmallBtn.Enabled := True;

          ListBtn.Enabled := True;

          DetailsBtn.Enabled := True;

          RefreshBtn.Enabled := True;

        end;

      prcDisconnecting: Text := 'Disconnecting';

      prcDisconnected :

        begin

          Text := 'Disconnected';

          ConnectBtn.Hint := 'Connect';

          DirTree.Items.Clear;

          FileNewItem.Enabled := False;

          ViewLargeItem.Enabled := False;

          ViewSmallItem.Enabled := False;

          ViewListItem.Enabled := False;

          ViewDetailsItem.Enabled := False;

          ViewRefreshItem.Enabled := False;

          ToolsDisconnectItem.Enabled := False;

          LargeBtn.Enabled := False;

          SmallBtn.Enabled := False;

          ListBtn.Enabled := False;

          DetailsBtn.Enabled := False;

          RefreshBtn.Enabled := False;

        end;

    end;

end;

procedure TMyFtp.Open1Click(Sender: TObject);

begin

  FTP.Quit;

  DirTree.Items.BeginUpdate;

  try

    DirTree.Items.Clear;

  finally

    DirTree.Items.EndUpdate;

  end;

end;

procedure TMyFtp.FileExitItemClick(Sender: TObject);

begin

  Close;

end;

procedure TMyFtp.FormResize(Sender: TObject);

begin

  Statusbar.Panels[0].Width := Width - 150;

end;

procedure TMyFtp.ViewLargeItemClick(Sender: TObject);

begin

  FileList.ViewStyle := vsIcon;

end;

procedure TMyFtp.ViewSmallItemClick(Sender: TObject);

begin

  FileList.ViewStyle := vsSmallIcon;

end;

procedure TMyFtp.ViewListItemClick(Sender: TObject);

begin

  FileList.ViewStyle := vsList;

end;

procedure TMyFtp.ViewDetailsItemClick(Sender: TObject);

begin

  FileList.ViewStyle := vsReport;

end;

procedure TMyFtp.ViewRefreshItemClick(Sender: TObject);

begin

  DirTreeChange(nil, DirTree.Selected);

end;

procedure TMyFtp.CopyItemClick(Sender: TObject);

begin

  SaveDialog1.FileName := FileList.Selected.Caption;

  if SaveDialog1.Execute then

    FTP.GetFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption,

      SaveDialog1.FileName);

end;

procedure TMyFtp.ToolsDisconnectItemClick(Sender: TObject);

begin

  DisConnect;

end;

procedure TMyFtp.FileNewItemClick(Sender: TObject);

var

  DirName: String;

begin

  if InputQuery('Input Box', 'Prompt', DirName) then

    FTP.CreateDir(NodePath(DirTree.Selected) + '/' + DirName);

end;

procedure TMyFtp.DeleteItemClick(Sender: TObject);

begin

  if ActiveControl = DirTree then

    FTP.DeleteDir(NodePath(DirTree.Selected));

  if ActiveControl = FileList then

    FTP.DeleteFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption);

end;

procedure TMyFtp.PasteFromItemClick(Sender: TObject);

begin

  if OpenDialog1.Execute then

    FTP.PutFile(OpenDialog1.FileName, NodePath(DirTree.Selected));

end;

procedure TMyFtp.FilePopupPopup(Sender: TObject);

begin

  CopyItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

  PasteFromItem.Enabled := (ActiveControl = DirTree) and (DirTree.Selected <> nil);

  DeleteItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

  RenameItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

end;

procedure TMyFtp.FileMenuClick(Sender: TObject);

begin

  FileCopyItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

  FileDeleteItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

  FileRenameItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17