TIdFTPについて

なまず 2005-06-29 01:52:48 No: 15982

TIdFTPを使用しての特定のファイル転送はどのようにしたらよいのでしょうか？
（ダウンロードしてくるファイルとアップロード先は固定）

osakana 2005-06-29 04:58:53 No: 15983

既製品に不満があって
FTP転送ソフトほしかったので
今少し遊んだサンプルあげる。

固定転送なら簡単なので自分でつくりましょう。
Getも要領いっしょだから自分でするか誰かに作ってもらうといいです

unit MyftpUnit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, ComCtrls, ShellCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button_Connect: TButton;
    Button_Disconnect: TButton;
    CheckBox1: TCheckBox;
    Edit_Host: TEdit;
    Edit_Pass: TEdit;
    Edit_UserName: TEdit;
    FTPTensou: TButton;
    IdFTP1: TIdFTP;
    Label1: TLabel;
    Label2: TLabel;
    ListBox_FTP: TListBox;
    Memo1: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    ShellListView1: TShellListView;
    Splitter1: TSplitter;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure IdFTP1Disconnected(Sender: TObject);
    procedure IdFTP1AfterClientLogin(Sender: TObject);
    procedure FTPTensouClick(Sender: TObject);
    procedure Button_DisconnectClick(Sender: TObject);
    procedure Button_ConnectClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure FTPListUpdate(SList : TStrings);
  end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses IdFTPCommon;

procedure TForm1.Button_ConnectClick(Sender: TObject);
begin  // 接続
  with IdFTP1 do
  begin
    Host     := Edit_Host.Text;
    Username := Edit_UserName.Text;
    Password := Edit_Pass.Text;
    if Connected then Disconnect;
    try
      Connect;   // 接続
      FTPListUpdate(ListBox_FTP.Items); // ファイルリストの更新
//      List(ListBox_FTP.Items, '*.*' , CheckBox1.Checked);  // FTPのファイルリスト
//               // Trueだと  属性と日付も表示
//    ChangeDir      // フォルダ変更
//    ChangeDirUp    // １階層上のフォルダへ移動
//    CombineFiles   // なんだろう？
//    Get // FTPからもらう
//    Put // FTPに転送
//    MakeDir // FTPにフォルダ作成
//    RemoveDir   // フォルダ削除
//    Rename      // 名前変更
//    RetrieveCurrentDir  // FTPの現在のフォルダ名
    except
      // エラー処理
    end;
  end;
end;

procedure TForm1.Button_DisconnectClick(Sender: TObject);
begin  // 切断処理
  // Quit
  with IdFTP1 do
  if Connected then Disconnect; // 切断
  ListBox_FTP.Items.Clear;
end;

procedure TForm1.FTPListUpdate(SList: TStrings);
begin  // リストの更新
  if Not(IdFTP1.Connected) then
  begin  // 接続されていない。
    ShowMessage('FTPに接続されていません。');
  end
  else
    IdFTP1.List(SList , '*.*' , CheckBox1.Checked);
               // FTPのファイルリスト
               // Trueだと  属性と日付も表示
end;

// FTPへ転送
procedure TForm1.FTPTensouClick(Sender: TObject);
  var
   i:integer;
   FullFileName_FTP, FullFileName_MyPC : string;
begin
  if Not(IdFTP1.Connected) then
  begin  // 接続されていない。
    ShowMessage('FTPに接続されていません。');
    Exit;
  end;

  for i:= 0 to ShellListView1.Items.Count -1 do
  if ShellListView1.Items[i].Selected then
  begin
    with IdFTP1 do
    begin
      //  Putに直接いれていいけど、混乱するといけないのでここで代入。
      FullFileName_FTP :=
          ShellListView1.Folders[i].DisplayName;
      FullFileName_MyPC :=
          ShellListView1.RootFolder.PathName
         +ShellListView1.Folders[i].DisplayName;
      // 転送モード指定
      TransferType := ftBinary;
       // ftBinary ヘルプではどこにあるかわからないので
       // エクスプローラーでsource\Indy10を検索するといい
       // IdFTPCommon.pas  にあるのがわかるので usesに追加する
      // 転送
      Put(FullFileName_MyPC, FullFileName_FTP
          ,False); // FTPに転送
      // Indicates content should be appended to 存在するdataに.
      // 既定値： false
    end;
  end;
  FTPListUpdate(ListBox_FTP.Items);
end;

procedure TForm1.IdFTP1AfterClientLogin(Sender: TObject);
begin
  Memo1.Lines.Add(
    TIdFTP(Sender).Host + #13#10 +
    TIdFTP(Sender).Username + #13#10 +
    'でログインしました。' + #13#10 +
    '現在のフォルダは '+TIdFTP(Sender).RetrieveCurrentDir+' です'
    );
  Memo1.Lines.Add(TIdFTP(Sender).LoginMsg.Text.Text);
  Memo1.Lines.Add(TIdFTP(Sender).ListResult.Text);
end;

procedure TForm1.IdFTP1Disconnected(Sender: TObject);
begin
Memo1.Lines.Add(
'切断しました：' + TIdFTP(Sender).Host );
end;

procedure TForm1.IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
Memo1.Lines.Add(AStatusText);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
with IdFTP1 do
if Connected then Disconnect; // 切断
end;

end.

なまず 2005-06-30 22:56:15 No: 15984

osakana さん
サンプルソースありがとうございます
かなり自分にとってはハードルが高いので
少しずつ動きをみてみようとおもいます

なまず 2005-07-08 02:04:42 No: 15985

osakana さんのおかげで
何とか決まったファイルの転送は出来るようになりました

ですが、フォルダの中身全てを決まったフォルダに送信／受信するやり方がまだわかりません
色々試してはいるのですが・・・

どなたかご教授願えませんでしょうか？

ななし 2005-07-08 20:20:49 No: 15986

通常のファイル操作と同じように
ファイルやサブ・フォルダの一覧を再帰的に取得して
１つずつ操作するのではないでしょうか？

なまず 2005-07-09 00:23:25 No: 15987

ななしさん

ありがとうございます
再帰的にですか・・・それはどのようにすればよいのでしょうか？

osakana 2005-07-09 01:33:37 No: 15988

あららまだ解決していなかったのですね

FindFirst とFindNextを使います

ヘルプにも簡単な例がのっています。

ファイル名は、.. .  以外は
フォルダもファイル区別がつかないのでも同じなので
ファイル属性で、ファイルか  フォルダかを判別します。
.  が現在のフォルダ。
..  が一つ上のフォルダです。
FindFirstで返ってきた名前がそういうのだったら
そういうことだと覚えておくといいです。
if sr.name='.' or sr.name='..' then 無視して次へ

ヘルプの例文のまま使うと
sr: TSearchRec;

条件は全部のファイル *.* で
最初の検索属性は、sr := faAnyFile - faVolumeID;でいいと思います。
それで返ってきた属性で処理を振り分けるといいです。

そして
sr.Attr に  属性が戻ってきますので
もしフォルダか判別には、
ビット演算でor（同じビットが１の時どうしのみ）で計算するといいです
(sr.Attr  or faDirectory) だったら faDirectory  の値になります
面倒なので >0 以上  でやっちゃうといいです
if (sr.Attr  or faDirectory) >0 then フォルダです
フォルダだったら、また関数を呼ぶ出すみたいな感じにするといいです。

現在のリストを最初につくるか、みつけながら転送するかは好みで作るといいです。

昨日から DeirectX解読中で忙しいので作ってあげれません

osakana 2005-07-09 01:37:35 No: 15989

確認しないで書いたので
間違いました。☆

ビット演算でor
ではなく and  です  どうもすみません。
(sr.Attr  and faDirectory) だったら faDirectory  の値になります
面倒なので >0 以上  でやっちゃうといいです

if (sr.Attr and faDirectory) >0 then フォルダです

osakana 2005-07-09 06:48:47 No: 15990

またまた  時間がないので
手抜きですけど、
ＰＣのファイルだけ列挙します。
空のフォルダは列挙しませんので自分で改良してみてください
  ExtractFilePath()
  ExtractFileName()
をつかうと簡単に分離します

FTP操作があっちこっちフォルダして複雑にならないように
ファイル名はソートしておくようにしておきました。

あとFTPサーバー側をフォルダ移動して、
適当にファイル名をおいていくだけです。

はりつけて遊ぶとファイル名取得の雰囲気だけわかると思います(^_^)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function GetFileList(Path : string; Kaikensaku:boolean) : TStringList;
  var
   SList : TStringList;
  procedure GetFileNames(Path : string);
    var
      sr: TSearchRec;
      FileAttrs: Integer;
      FindResult : Integer;
  begin
    FileAttrs := faAnyFile - faVolumeID;
    FindResult := FindFirst(Path+'*.*', FileAttrs, sr);
    try
      while (FindResult = 0) do
      begin
        if (sr.Name = '.') or (sr.Name = '..') then
        begin
          FindResult := FindNext(sr);
          Continue;
        end;
        if (sr.Attr and faDirectory) > 0 then
        begin
         if Kaikensaku then  GetFileNames(Path+sr.Name+'\');
        end
        else
          SList.Add(Path+sr.Name);
        FindResult := FindNext(sr);
      end;
    finally
      FindClose(sr);
    end;
  end;
begin
  if Not IsPathDelimiter(Path,Length(Path)) then
    Path := Path + '\';
  SList := TStringList.Create;
  SList.Sorted := True;
  SList.Duplicates := dupIgnore;

if DirectoryExists(Path) then GetFileNames(Path);

Result := SList;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines := GetFileList('c:\windows\temp',true);
// Memoなどのコンポーネントに代入しない場合は、Freeすること
end;

end.

シャチ 2005-07-09 07:07:42 No: 15991

> Memo1.Lines := GetFileList('c:\windows\temp',true);
> // Memoなどのコンポーネントに代入しない場合は、Freeすること
TMemoのLinesに代入した場合はAssignメソッドが働きます。
Assignメソッドは中身をコピーするだけですから、GetFileList関数が
返してきたTStringListのインスタンスは開放されないのではないですか？