|
Delphi Programming / Object Pascal
  
[掲載 2008年11月16日] [更新 2014年05月29日] Delphi サンプルプログラム集 |
| 774_TIdFTP で FTP サーバのファイルリストとディレクトリツリー |
| 動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Indy 10 (Ver 10.5.7) |
 |
774_Indy_FTPDirFileList.zip [5,692 KB] 2015年05月29日版 (EXE 同梱) |
- 2011年01月21日 (これより前の履歴は省略)
- Delphi 2010, XE, Indy 10.5.7 以降対応のコードに変更
- 日本語ファイル名対応の参考コードを追加
|
| TIdFTP を使用した FTP サーバのファイルリストとディレクトリツリー |
Delphi 附属の Indy コンポーネントである，TIdFTP を使用したサンプルです．FTP サーバ内のファイルのリストと，ディレクトリツリーを表示します．また，これらのコードを元にローカルのフォルダ内のファイある全てを転送したり，ディレクトリごとダウンロードするコードも作成してみました．
以下のサンプルコードでは，TidFTP の Passive プロパティがデフォルトの False になっています．必要に応じて変更してください．
日本語のディレクトリ名とファイル名処理の参考コードがありますが，日本語のファイル名の使用を薦めているわけではありません．むしろ使用すべきではないと考えています． |
|
TIdFTP の Passive プロパティはデフォルトで False になっています．この値，PASV (パッシブ) 転送モードがデフォルトの False だと，サーバによっては，以下のようなエラーが発生して，タイムアウトすることがあります．425 はポートが開けないか，使用できない時の値です． |
425 Can't build data connection: Operation timed out.
425 Unable to build data connection: Connection timed out
| 01_FTP サーバの指定ディレクトリ内のファイルリスト |
| TIdFTP の List メソッドを使用すると，引数の TStrings に現在のディレクトリのファイルのリストとその情報を取得できます．これを利用して，ListBox の Items に情報を取得するサンプルです． |
 |
図1
設計時画面 |
 |
図2
実行画面
- ディレクトリ名は接続前に入力しておく
- 違うディレクトリを表示する時は，切断してから
|
リスト1
FTP サーバ上の指定ディレクトリのファイルリストをリストボックスに表示 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP, IdExplicitTLSClientServerBase;
type
TForm1 = class(TForm)
Panel3: TPanel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
LabeledEdit5: TLabeledEdit;
Button1: TButton;
IdFTP1: TIdFTP;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private 宣言 }
FIniFileName : String;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
IniFiles;
{$R *.dfm}
//=============================================================================
// EditにFTP関係情報をセット
// 1つ上の階層からFTPInfo.iniを読み出してセット
//
// LabelEdit4.textは表示するディレクトリ名
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
LIni : TInifile;
begin
FIniFileName := '..\FTPInfo.ini';
LIni := TIniFile.Create(FIniFileName);
try
if FileExists(FIniFileName) then begin
LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
LabeledEdit4.Text := LIni.ReadString('Others', 'InitDir', '');
end;
finally
FreeAndNil(LIni);
end;
end;
//=============================================================================
// 設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
LIni : TInifile;
begin
LIni := TIniFile.Create(FIniFileName);
try
try
LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
LIni.WriteString('FTPInfo', 'UserID', LabeledEdit2.Text);
LIni.WriteString('FTPInfo', 'PassWord', LabeledEdit3.Text);
LIni.WriteString('Others', 'InitDir', LabeledEdit4.Text);
except
end;
finally
FreeAndNil(LIni);
end;
if IdFTP1.Connected then IdFTP1.Disconnect;
end;
//=============================================================================
// LabledEdit4で指定したディレクトリのリストを作成して表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Enabled := False;
if IdFTP1.Connected then begin
IdFTP1.Disconnect;
end else begin
IdFTP1.Host := LabeledEdit1.Text;
IdFTP1.Username := LabeledEdit2.Text;
IdFTP1.Password := LabeledEdit3.Text;
try
ListBox1.Items.Clear;
IdFTP1.Connect;
try
IdFTP1.ChangeDir(LabeledEdit4.Text);
IdFTP1.List(ListBox1.Items);
except
MessageDlg('存在しないディレクトリです．', mtInformation, [mbOK], 0);
end;
except
MessageDlg('接続に失敗しました．', mtInformation, [mbOK], 0);
end;
end;
if IdFTP1.Connected then begin
Button1.Caption := '切断';
end else begin
Button1.Caption := '接続';
ListBox1.Items.Clear;
end;
Button1.Enabled := True;
end;
end.
エクスプローラのファイルリストのように表示するようにしたサンプルです．少し実用的にしてみました．次の手順で行います．
- (1) List メソッドを実行する
- (2) すると DirectoryListng プロパティにそのディレクトリ内のファイル情報が格納される
- (3) この Item プロパティからファイルの各情報を取出して TListView に表示する
- (4) 情報の取得操作に，OnCreateFTPList, OnCheckListFormat, OnParseCustomListFormat 等のイベントが利用できる
[戻る] ボタンで 1 つ上のディレクトリのファイルをリストします．また，ファイルのパーミッション (アクセス権) の設定機能も実装してみました．[削除] では，空でないディレクトリは削除できません．空でないディレクトリを削除するには，ディレクトリ内のディレクトリとファイルを全て削除するコードを追加する必要があります．
[ローカルへの転送] やエクスプローラからのドラッグ・アンド・ドロップ (またはローカルのファイルリストを同一フォームに表示) 機能を装備すれば，簡単な [FTP 転送アプリ] ができそうです．表示速度を改善するには，仮想リストビュー等の機能を実装する必要があるでしょう．
|
 |
図3
設計時画面 1 |
 |
図4
パーミッション設定フォーム |
 |
図5
実行画面
- 接続するとディレクトリ欄のディレクトリ内を表示
- ディレクトリ欄が空の時はルートディレクトリの指定と同じ
- 表示後 (接続後) のディレクトリ欄入力は無効
- ディレクトリ名のダブルクリックでそのディレクトリ内を表示
|
 |
図6
パーミッションの設定画面
- ファイルのアクセス権設定
- まだ変更していないので [変更] ボタンは使用不可となっている
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, ImgList, WinInet, Buttons,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,
IdExplicitTLSClientServerBase, IdAllFTPListParsers;
type
TForm1 = class(TForm)
ListView1: TListView;
Panel1: TPanel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
btnConnect: TButton;
StatusBar1: TStatusBar;
IdFTP1: TIdFTP;
btnBackDir: TButton;
btnCreateDir: TButton;
btnDelete: TButton;
btnPermission: TButton;
btnReName: TButton;
procedure btnConnectClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
procedure btnBackDirClick(Sender: TObject);
procedure btnCreateDirClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnPermissionClick(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure ListView1Click(Sender: TObject);
procedure btnReNameClick(Sender: TObject);
private
{ Private 宣言 }
FIniFileName : String;
procedure SetListViewItems;
function GetFileExtIcon(FileName: String; Attrib:Cardinal): Integer;
procedure ChangeDir(DirName: String);
procedure SetButtonsEnabled(Flag: Boolean);
public
{ Public 宣言 }
end;
function ItemsSort(Item1,Item2:TListItem; ParamSort:integer): Integer;stdcall;
var
Form1: TForm1;
implementation
uses
ShellAPI, CommCtrl, IniFiles, IdFTPList, HTTPApp, Math, DateUtils,
IdFTPCommon, PermFormUnit;
var
//ソート関係の変数
//SortColumはソートするカラム番号ごとにソート順を保持
//SortColumnIndexはソートするカラムのインデックス
SortColum : array[0..2] of integer;
SortColumnIndex : Integer;
{$R *.dfm}
//=============================================================================
// ファイル一覧表示用のListView1のカラムの設定
// EditにFTP関係情報をセット(1つ上の階層からFTPInfo.iniを読み出してセット)
//
// LabeledEdit4.Textはファイルのリストを取得するディレクトリ名
// ex. LabeledEdit4.Text := '/mrxray.on.coocan.jp/homepage/Halbow';
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
LIni : TInifile;
LSHFileInfo : TSHFileInfo ;
LImgListHandle : THandle;
i : Integer;
begin
SetButtonsEnabled(False);
btnConnect.Enabled := True;
//行全体を選択する表示とする
ListView1.HideSelection := False;
ListView1.RowSelect := True;
//テストなので複数行選択不可
ListView1.MultiSelect := False;
//同様に直接編集は不可
ListView1.ReadOnly := True;
FIniFileName := '..\FTPInfo.ini';
LIni := TIniFile.Create(FIniFileName);
try
if FileExists(FIniFileName) then begin
LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
LabeledEdit4.Text := LIni.ReadString('Others', 'InitDir', '');
end;
finally
FreeAndNil(LIni);
end;
ListView1.ViewStyle := vsReport;
ListView1.Columns.Add;
ListView1.Columns[0].Caption := 'ファイル名';
ListView1.Columns[0].Width := 190;
ListView1.Columns.Add;
ListView1.Columns[1].Caption := 'サイズ ';
ListView1.Columns[1].Width := 100;
ListView1.Columns[1].Alignment := taRightJustify;
ListView1.Columns.Add;
ListView1.Columns[2].Caption := ' 更新日時';
ListView1.Columns[2].Width := 120;
//システムのイメージリストのハンドルを取得
LImgListHandle := SHGetFileInfo('',
0,
LSHFileInfo,
SizeOf(LSHFileInfo),
SHGFI_SMALLICON or
SHGFI_SYSICONINDEX);
ListView_SetImageList(ListView1.Handle, LImgListHandle, LVSIL_SMALL);
//ソートで使用する配列値に代入
//ソート対象カラムの初期値は0(名前のカラム)
SortColumnIndex := 0;
for i := 0 to Length(SortColum) - 1 do begin
SortColum[i] := 1;
end;
end;
//=============================================================================
// 設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
LIni : TInifile;
begin
LIni := TIniFile.Create(FIniFileName);
try
try
LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
LIni.WriteString('FTPInfo', 'UserID', LabeledEdit2.Text);
LIni.WriteString('FTPInfo', 'PassWord', LabeledEdit3.Text);
LIni.WriteString('Others', 'InitDir', LabeledEdit4.Text);
except
end;
finally
FreeAndNil(LIni);
end;
end;
//=============================================================================
// 接続したらFTPサーバ内の指定ディレクトリの一覧を取得
// ファイルのリスト作成はChangeDirメソッドからSetLiestViewItemsで行う
//=============================================================================
procedure TForm1.btnConnectClick(Sender: TObject);
begin
SetButtonsEnabled(False);
if IdFTP1.Connected then begin
btnConnect.Enabled := True;
IdFTP1.Disconnect;
btnConnect.Caption := '接続';
ListView1.Items.Clear;
end else begin
IdFTP1.Host := LabeledEdit1.Text;
IdFTP1.Username := LabeledEdit2.Text;
IdFTP1.Password := LabeledEdit3.Text;
try
IdFTP1.Connect;
ChangeDir(LabeledEdit4.Text);
except
MessageDlg('接続に失敗しました．', mtInformation, [mbOK], 0);
raise;
end;
if IdFTP1.Connected then begin
btnConnect.Caption := '切断';
end else begin
btnConnect.Caption := '接続';
ListView1.Items.Clear;
end;
end;
SetButtonsEnabled(True);
btnConnect.Enabled := True;
end;
//-----------------------------------------------------------------------------
// ListViewにファイルの情報を表示
// TIdFTPListItemの使用にはusesにIdFTPListが必要
//
// [備考]
// ファイルの種別を区別するTIdFTPListItemのItemTypeプロパティの値
// TIdDirItemType = (ditDirectory, ditFile, ditSymbolicLink);
//-----------------------------------------------------------------------------
procedure TForm1.SetListViewItems;
var
LFileName : String;
LSize : Integer;
i : Integer;
LFTPItem : TIdFTPListItem;
LItem : TListItem;
LFileAttrib : Cardinal;
begin
if not Assigned(IdFTP1.DirectoryListing) then exit;
Screen.Cursor := crHourGlass;
ListView1.Items.BeginUpdate;
ListView1.Items.Clear;
for i := 0 to IdFTP1.DirectoryListing.Count - 1 do begin
LFTPItem := IdFTP1.DirectoryListing.Items[i];
//ファイル名
LFileName := LFTPItem.FileName;
//ファイル名が'.'または'..'の時は除外
if (LFileName = '.') or (LFileName = '..') then Continue;
LItem := ListView1.Items.Add;
//ファイル名
LItem.Caption := LFileName;
//ソートで使用するためにDataプロパティに値を代入
//Dataプロパティのメモリ領域解放はOnDeletionイベントで実行
LItem.Data := LFTPItem;
//ファイルサイズ
LSize := LFTPItem.Size;
if LFTPItem.ItemType = ditDirectory then begin
LItem.SubItems.Add('');
end else begin
LItem.SubItems.Add(FormatFloat('###,##0 KB', LSize));
end;
//ファイルの更新日時
LItem.SubItems.Add(FormatDateTime(' yyyy/mm/dd hh:nn', LFTPItem.ModifiedDate));
//ファイルの拡張子に応じたアイコンを表示
LFileAttrib := 0;
if LFTPItem.ItemType = ditDirectory then begin
LFileAttrib := FILE_ATTRIBUTE_DIRECTORY;
end else
if LFTPItem.ItemType = ditFile then begin
LFileAttrib := FILE_ATTRIBUTE_NORMAL;
end;
LFileName := ExtractFileName(UnixPathToDosPath(LFTPItem.FileName));
LItem.ImageIndex := GetFileExtIcon(LFileName, LFileAttrib);
end;
//ファイル情報を取得したらソート
//ソート対象カラムは現在と同じで昇順降順もそのまま
ListView1.CustomSort(@ItemsSort, 0);
ListView1.Items.EndUpdate;
ListView1.Selected := nil;
ListView1.ItemFocused := nil;
Screen.Cursor := crDefault;
//現在のディレクトリ名を表示
LabeledEdit4.Text := IdFTP1.RetrieveCurrentDir;
end;
//-----------------------------------------------------------------------------
// ファイルの拡張子に関連付けしたシステムイメージアイコンのインデックスを取得
// FileNameはファイルのフルパス(パス部分はなくても可)
// 取得するファイルの属性を引数のAttribに与える
//-----------------------------------------------------------------------------
function TForm1.GetFileExtIcon(FileName: String; Attrib:Cardinal): Integer;
var
LSHFileInfo : TSHFileinfo;
begin
SHGetFileInfo(PChar('*' + ExtractFileExt(Filename)),
Attrib,
LSHFileInfo,SizeOf(TSHFileInfo),
SHGFI_USEFILEATTRIBUTES or
SHGFI_SYSICONINDEX or
SHGFI_SMALLICON);
Result := LSHFileInfo.iIcon;
end;
//=============================================================================
// ListViewのカラムクリックでソートする
// SortColumはソートするカラム番号ごとにソート順を保持(1または-1)
// SortColumnIndexはソートするカラムのインデックス
//=============================================================================
procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
SetButtonsEnabled(False);
if ListView1.Items.Count > 0 then begin
SortColumnIndex:=Column.Index;
//カラムをクリックする度にソート順を逆にする(トグル操作)
SortColum[SortColumnIndex] := - SortColum[SortColumnIndex];
ListView1.CustomSort(@ItemsSort, 0);
end;
ListView1.Selected := nil;
SetButtonsEnabled(True);
end;
//=============================================================================
// [戻る]ボタン
// １つ上の階層のディレクトリに移動
//=============================================================================
procedure TForm1.btnBackDirClick(Sender: TObject);
begin
if not IdFTP1.Connected then exit;
SetButtonsEnabled(False);
IdFTP1.ChangeDirUp;
ChangeDir('');
SetButtonsEnabled(True);
end;
//=============================================================================
// [ディレクトリ作成]ボタン
// 現在のディレクトリ内に新しくディレクトリを作成
// 作成したらリストを再取得して，作成したディレクトリが見えるようにする
// テストなので作成名の入力ダイアログを表示
// 実用的にはItemのキャプションで直接編集がいいだろう
//=============================================================================
procedure TForm1.btnCreateDirClick(Sender: TObject);
var
LDir : String;
LItem : TListItem;
begin
if not IdFTP1.Connected then exit;
if InputQuery('ディレクトリ作成', 'ディレクトリ名', LDir) then begin
if Trim(LDir) <> '' then begin
IdFTP1.MakeDir(LDir);
ChangeDir(IdFTP1.RetrieveCurrentDir);
LItem := ListView1.FindCaption(0, LDir, True, True, True);
if LItem <> nil then begin
ListView1.Items[LItem.Index].MakeVisible(True);
ListView1.ItemIndex := LItem.Index;
end;
end;
end;
end;
//=============================================================================
// [名前変更]
// 名前変更の時はリストの再取得は必要ない
// 必要なデータは全てListViewの各Itemに保持している
// テストなので名前の入力ダイアログを表示
// 実用的にはItemのキャプションで直接編集がいいだろう
//=============================================================================
procedure TForm1.btnReNameClick(Sender: TObject);
var
LOldName : String;
LName : String;
LItem : TListItem;
begin
if not IdFTP1.Connected then exit;
if ListView1.Selected=nil then exit;
LItem := ListView1.Selected;
LOldName := LItem.Caption;
LName := LOldName;
if InputQuery('名前の変更', '変更後の名前', LName) then begin
if Trim(LName) <> '' then begin
IdFTP1.Rename(LOldName, LName);
ListView1.Selected.Caption := LName;
//ListViewのItemのDataプロパティの値も更新
TIdFTPListItem(ListView1.Items[LItem.Index].Data).FileName := LName;
end;
end;
end;
//=============================================================================
// [削除]
// 現在選択中のファイルを削除
// リストの再取得は必要ない
// 必要なデータは全てListViewの各Itemに保持している
// テストで1つしか選択できないようになっているので本コードは1つの場合の処理
//=============================================================================
procedure TForm1.btnDeleteClick(Sender: TObject);
var
LItem : TListItem;
LFTPItem : TIdFTPListItem;
begin
if not IdFTP1.Connected then exit;
if ListView1.Selected = nil then exit;
LItem := ListView1.Selected;
LFTPItem := TIdFTPListItem(ListView1.Items[LItem.Index].Data);
if LFTPItem.ItemType = ditDirectory then begin
try
IdFTP1.RemoveDir(LItem.Caption);
//ListViewの該当Itemを削除
LItem.Delete;
ListView1.Selected := nil;
ListView1.ItemFocused := nil;
except
//実際には削除の権限がない場合もエラー
MessageDlg('ディレクトリが空ではありません．', mtInformation, [mbOK], 0);
end;
end else begin
IdFTP1.Delete(LItem.Caption);
//ListViewの該当Itemを削除
LItem.Delete;
ListView1.Selected := nil;
ListView1.ItemFocused := nil;
end;
end;
//=============================================================================
// [アクセス権]ボタン
// ファイルのアクセス権(パーミッション)の表示と設定
// 設定表示用のフォーム(ダイアログ)を表示
// chmode(Change Modeの意味?)コマンドのファイル名はフルパスでないと失敗する
//
// 複数選択して同時に設定したい場合は，選択中の行数分ループしての処理となる
//=============================================================================
procedure TForm1.btnPermissionClick(Sender: TObject);
var
LItem : TListItem;
LFileName : String;
LCmdStr : String;
LCurrentDir : String;
begin
if not IdFTP1.Connected then exit;
if ListView1.Selected = nil then exit;
PermForm := TPermForm.Create(Self);
try
LItem := ListView1.Selected;
//パーミッション(アクセス権)設定ダイアログを表示
//ここではテストなので選択Itemは1つとして処理
PermForm.FPermStr := TIdFTPListItem(LItem.Data).PermissionDisplay;
if PermForm.ShowModal = mrOk then begin
Update;
//ダイアログで表示した内容をListViewのItemに代入
TIdFTPListItem(LItem.Data).PermissionDisplay := PermForm.FPermStr;
//フルパスファイル名
LCurrentDir := IdFTP1.RetrieveCurrentDir;
LFileName := LCurrentDir + '/' + ListView1.Selected.Caption;
//Siteメソッドで送るコマンド文字列を作成
LCmdStr := 'chmod '+
PermForm.Edit1.Text +
PermForm.Edit2.Text +
PermForm.Edit3.Text +
' ' + LFileName;
try
//変更コマンドを送る
IdFTP1.Site(LCmdStr);
except
MessageDlg('アクセス権の変更に失敗しました．', mtInformation, [mbOK], 0);
end;
end;
finally
FreeAndNil(PermForm);
end;
end;
//=============================================================================
// ListViewのダブルクリックイベント
// Itemをダブルクリックしたらそのフォルダ内のリストを表示
// フォルダでない時は何もしない
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
LFTPItem : TIdFTPListItem;
begin
if not IdFTP1.Connected then exit;
SetButtonsEnabled(False);
LFTPItem := TIdFTPListItem(ListView1.Items[ListView1.Selected.Index].Data);
if LFTPItem.ItemType = ditDirectory then begin
ChangeDir(ListView1.Selected.Caption);
end;
SetButtonsEnabled(True);
end;
//=============================================================================
// ListViewのクリックイベント
// Itemをクリックして，Itemが選択されたらボタン類の使用可否を設定
// このサンプルでは，選択行全体を反転表示するので，実際には一度でもクリックす
// るとファイル数が1以上であればボタン使用可能
//=============================================================================
procedure TForm1.ListView1Click(Sender: TObject);
begin
SetButtonsEnabled(True);
end;
//-----------------------------------------------------------------------------
// ディレクトリ変更専用メソッド
// [接続][戻る]ボタンとダブルクリックでも使用するので関数にした
// ftASCIIの使用にはusesにIdFTPCommonが必要 IdAllFTPListParsers
// *.*とするとファイルのみ(ディレクトリなし)
//-----------------------------------------------------------------------------
procedure TForm1.ChangeDir(DirName: String);
begin
try
if DirName <> '' then IdFTP1.ChangeDir(DirName);
IdFTP1.List;
//ListViewの各Itemに値を代入
SetListViewItems;
except
raise;
MessageDlg('ディレクトリが見つかりません．', mtInformation, [mbOK], 0);
Screen.Cursor := crDefault;
end;
end;
//-----------------------------------------------------------------------------
// ボタン類の使用可否
//-----------------------------------------------------------------------------
procedure TForm1.SetButtonsEnabled(Flag: Boolean);
begin
if Flag then begin
btnConnect.Enabled := Flag;
if IdFTP1.Connected then begin
btnBackDir.Enabled := Flag and (IdFTP1.RetrieveCurrentDir <> '/');
btnReName.Enabled := Flag and (ListView1.Selected <> nil) and
(IdFTP1.RetrieveCurrentDir <> '/');
btnCreateDir.Enabled := Flag and (IdFTP1.RetrieveCurrentDir <> '/');
btnDelete.Enabled := Flag and (ListView1.Selected <> nil) and
(IdFTP1.RetrieveCurrentDir <> '/');
btnPermission.Enabled := Flag and (ListView1.Selected <> nil) and
(IdFTP1.RetrieveCurrentDir <> '/');
end else begin
btnBackDir.Enabled := False;
btnReName.Enabled := False;
btnCreateDir.Enabled := False;
btnDelete.Enabled := False;
btnPermission.Enabled := False;
end;
end else begin
btnConnect.Enabled := Flag;
btnBackDir.Enabled := Flag;
btnReName.Enabled := Flag;
btnCreateDir.Enabled := Flag;
btnDelete.Enabled := Flag;
btnPermission.Enabled := Flag;
end;
end;
//-----------------------------------------------------------------------------
// ListViewのソート関数CustomSortのコールバック関数
// エクスプローラのソートと同じするための工夫をしている
// クリックした列に応じてソートするために
// SortColumnIndex クリックしたカラム番号でグローバル変数
// SortColum[列の番号] カラムごとに昇順降順を保持する配列(1か-1)
// を使用している
//-----------------------------------------------------------------------------
function ItemsSort(Item1, Item2: TListItem; ParamSort: integer): integer;stdcall;
var
LDir1 : Boolean;
LDir2 : Boolean;
LStr1 : String;
LStr2 : String;
LV1 : Integer;
LV2 : Integer;
LDate1 : TDateTime;
LDate2 : TDateTime;
begin
Result := 0;
LDir1 := TIdFTPListItem(Item1.Data).ItemType = ditDirectory;
LDir2 := TIdFTPListItem(Item2.Data).ItemType = ditDirectory;
case SortColumnIndex of
0: //ファイル名
begin
LStr1 := Item1.Caption;
LStr2 := Item2.Caption;
//どちらもフォルダかどちらもフォルダでない場合
if (LDir1 and LDir2) or not(LDir1 or LDir2) then begin
Result := SortColum[SortColumnIndex] * CompareText(LStr1, LStr2);
end else
//どちらもフォルダの場合
if (LDir1 and LDir2) then begin
Result := SortColum[SortColumnIndex] * CompareText(LStr1, LStr2);
end else
//Item1に該当するのがフォルダの場合
if LDir1 then begin
Result := - SortColum[SortColumnIndex];
end else
//Item2に該当するのがフォルダの場合
if LDir2 then begin
Result := SortColum[SortColumnIndex];
end;
end;
1: //ファイルサイズ
begin
LV1 := TIdFTPListItem(Item1.Data).Size;
LV2 := TIdFTPListItem(Item2.Data).Size;
//どちらもフォルダかどちらもフォルダでない場合
if (LDir1 and LDir2) or not(LDir1 or LDir2) then begin
Result := SortColum[SortColumnIndex] * CompareValue(LV1, LV2);
end else
//どちらもフォルダの場合
if (LDir1 and LDir2) then begin
Result := SortColum[SortColumnIndex] * CompareValue(LV1, LV2);
end else
//Item1に該当するのがフォルダの場合
if LDir1 then begin
Result := -SortColum[SortColumnIndex];
end else
//Item2に該当するのがフォルダの場合
if LDir2 then begin
Result := SortColum[SortColumnIndex];
end;
end;
2: //更新日時
begin
LDate1 := TIdFTPListItem(Item1.Data).ModifiedDate;
LDate2 := TIdFTPListItem(Item2.Data).ModifiedDate;
//どちらもフォルダかどちらもフォルダでない場合
if (LDir1 and LDir2) or not(LDir1 or LDir2) then begin
Result := SortColum[SortColumnIndex] * CompareDateTime(LDate1, LDate2);
end else
//どちらもフォルダの場合
if (LDir1 and LDir2) then begin
Result := SortColum[SortColumnIndex] * CompareValue(LDate1, LDate2);
end else
//Item1に該当するのがフォルダの場合
if LDir1 then begin
Result := -SortColum[SortColumnIndex];
end else
//Item2に該当するのがフォルダの場合
if LDir2 then begin
Result := SortColum[SortColumnIndex];
end;
end;
end;
end;
end.
リスト3
パーミッション (アクセス権) 設定ダイアログのコード |
unit PermFormUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,ComCtrls, IdAllFTPListParsers;
type
TPermForm = class(TForm)
btnOK: TButton;
btnCancel: TButton;
GroupBox1: TGroupBox;
ChkBox11: TCheckBox;
ChkBox12: TCheckBox;
ChkBox13: TCheckBox;
Edit1: TEdit;
LabeledEdit1: TLabeledEdit;
GroupBox2: TGroupBox;
ChkBox21: TCheckBox;
ChkBox22: TCheckBox;
ChkBox23: TCheckBox;
Edit2: TEdit;
GroupBox3: TGroupBox;
ChkBox31: TCheckBox;
ChkBox32: TCheckBox;
ChkBox33: TCheckBox;
Edit3: TEdit;
procedure FormShow(Sender: TObject);
procedure GroupBox1Click(Sender: TObject);
procedure GroupBox2Click(Sender: TObject);
procedure GroupBox3Click(Sender: TObject);
private
{ Private 宣言 }
FOldPermStr : String[10];
public
{ Public 宣言 }
FIsShow : Boolean;
FPermStr : String;
end;
var
PermForm: TPermForm;
implementation
uses
IdFTPList;
{$R *.dfm}
//=============================================================================
// 各CheckBoxのTagプロパティに4,2,1の値を設定しておく
//=============================================================================
procedure TPermForm.FormShow(Sender: TObject);
begin
FIsShow := False;
//表示した直後のパーミッションの値を記憶
//PermStrは呼出し側でセット済み
FOldPermStr := FPermStr;
btnOK.Enabled := False;
ChkBox11.Tag := 4;
ChkBox12.Tag := 2;
ChkBox13.Tag := 1;
ChkBox21.Tag := 4;
ChkBox22.Tag := 2;
ChkBox23.Tag := 1;
ChkBox31.Tag := 4;
ChkBox32.Tag := 2;
ChkBox33.Tag := 1;
ChkBox11.Checked := FPermStr[2] = 'r';
ChkBox12.Checked := FPermStr[3] = 'w';
ChkBox13.Checked := FPermStr[4] = 'x';
ChkBox21.Checked := FPermStr[5] = 'r';
ChkBox22.Checked := FPermStr[6] = 'w';
ChkBox23.Checked := FPermStr[7] = 'x';
ChkBox31.Checked := FPermStr[ 8] = 'r';
ChkBox32.Checked := FPermStr[ 9] = 'w';
ChkBox33.Checked := FPermStr[10] = 'x';
FIsShow := True;
GroupBox1Click(nil);
GroupBox2Click(nil);
GroupBox3Click(nil);
end;
//=============================================================================
// 本人(OWner)のパーミッションの表示
//=============================================================================
procedure TPermForm.GroupBox1Click(Sender: TObject);
begin
if FIsShow = False then exit;
Edit1.Text := InttoStr(Integer(ChkBox11.Checked) * ChkBox11.Tag +
Integer(ChkBox12.Checked) * ChkBox12.Tag +
Integer(ChkBox13.Checked) * ChkBox13.Tag);
if ChkBox11.Checked then FPermStr[2] := 'r' else FPermStr[2] := '-';
if ChkBox12.Checked then FPermStr[3] := 'w' else FPermStr[3] := '-';
if ChkBox13.Checked then FPermStr[4] := 'x' else FPermStr[4] := '-';
LabeledEdit1.Text := Copy(FOldPermStr, 2, 10);
btnOK.Enabled := FOldPermStr <> FPermStr;
end;
//=============================================================================
// グループ(Group)のパーミッションの表示
//=============================================================================
procedure TPermForm.GroupBox2Click(Sender: TObject);
begin
if FIsShow = False then exit;
Edit2.Text := InttoStr(Integer(ChkBox21.Checked) * ChkBox21.Tag +
Integer(ChkBox22.Checked) * ChkBox22.Tag +
Integer(ChkBox23.Checked) * ChkBox23.Tag);
if ChkBox21.Checked then FPermStr[5] := 'r' else FPermStr[5] := '-';
if ChkBox22.Checked then FPermStr[6] := 'w' else FPermStr[6] := '-';
if ChkBox23.Checked then FPermStr[7] := 'x' else FPermStr[7] := '-';
LabeledEdit1.Text := Copy(FPermStr, 2, 10);
btnOK.Enabled := FOldPermStr <> FPermStr;
end;
//=============================================================================
// その他の人(Others)のパーミッションの表示
//=============================================================================
procedure TPermForm.GroupBox3Click(Sender: TObject);
begin
if FIsShow = False then exit;
Edit3.Text := InttoStr(Integer(ChkBox31.Checked) * ChkBox31.Tag +
Integer(ChkBox32.Checked) * ChkBox32.Tag +
Integer(ChkBox33.Checked) * ChkBox33.Tag);
if ChkBox31.Checked then FPermStr[ 8] := 'r' else FPermStr[ 8] := '-';
if ChkBox32.Checked then FPermStr[ 9] := 'w' else FPermStr[ 9] := '-';
if ChkBox33.Checked then FPermStr[10] := 'x' else FPermStr[10] := '-';
LabeledEdit1.Text := Copy(FPermStr, 2, 10);
btnOK.Enabled := FOldPermStr <> FPermStr;
end;
end.
| FTP サーバ上のディレクトリをツリー表示するサンプルです． |
 |
図7
設計時画面 |
 |
図8
実行画面
- ディレクトリ欄は表示専用
- 接続直後はルートディレクトリだけ表示
|
リスト4
FTP サーバ上のディレクトリをツリー表示 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,
IdExplicitTLSClientServerBase;
type
TForm1 = class(TForm)
Panel1: TPanel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
btnConnect: TButton;
IdFTP1: TIdFTP;
btnBackDir: TButton;
TreeView1: TTreeView;
procedure btnConnectClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnBackDirClick(Sender: TObject);
procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
procedure TreeView1Collapsed(Sender: TObject; Node: TTreeNode);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
FIniFileName : String;
FRootNode : TTreeNode;
function ChangeDirAndSetTreeItems(ADir: String; Node: TTreeNode;
DirFlag:Boolean): Boolean;
function GetFullPathFromNode(Node: TTreeNode): String;
function GetFolderIcon(OpenFlag:Boolean): Integer;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
ShellAPI, CommCtrl, IniFiles, IdFTPList, IdAllFTPListParsers;
{$R *.dfm}
//=============================================================================
// 各種初期状態の設定
//
// システムイメージではなく，TImageListを使用する場合，背景を目立たない色にし
// ておかないとXP,2000で実行した際にclNoneの黒い色がそのまま表示されてしまう
// 例 ImageList1.BkColor := TreeView1.Color;
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LSHFileInfo : TSHFileInfo ;
LImgListHandle : THandle;
begin
btnConnect.Enabled := True;
//フォーカスがない時も選択ノードを淡く表示
TreeView1.HideSelection := False;
//テストなので複数行選択不可
TreeView1.MultiSelect := False;
//同様に直接編集は不可
TreeView1.ReadOnly := True;
//ディレクトリ名は表示専用
LabeledEdit4.ReadOnly := True;
//戻るボタン
btnBackDir.Enabled := False;
//コモンコントロールのイニシャライズ
InitCommonControls;
//システムのツリービューのハンドルを取得
LImgListHandle := SHGetFileInfo('',
0,
LSHFileInfo,
SizeOf(LSHFileInfo),
SHGFI_SMALLICON or
SHGFI_OPENICON or
SHGFI_SYSICONINDEX);
TreeView_SetImageList(TreeView1.Handle, LImgListHandle, TVSIL_NORMAL);
TreeView1.Items.Clear;
end;
//=============================================================================
// フォーム表示時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
LIni : TInifile;
begin
//Iniファイルからパスワード等を読出して表示
FIniFileName := '..\FTPInfo.ini';
LIni := TIniFile.Create(FIniFileName);
try
if FileExists(FIniFileName) then begin
LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
end;
finally
FreeAndNil(LIni);
end;
end;
//=============================================================================
// 設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
LIni : TInifile;
begin
LIni := TIniFile.Create(FIniFileName);
try
try
LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
LIni.WriteString('FTPInfo', 'UserID', LabeledEdit2.Text);
LIni.WriteString('FTPInfo', 'PassWord', LabeledEdit3.Text);
except
end;
finally
FreeAndNil(LIni);
end;
end;
//=============================================================================
// 接続したらFTPサーバ内の指定ディレクトリの一覧を取得
//=============================================================================
procedure TForm1.btnConnectClick(Sender: TObject);
var
LRootDir : String;
begin
btnConnect.Enabled := False;
if IdFTP1.Connected then begin
IdFTP1.Disconnect;
btnConnect.Caption := '接続';
TreeView1.Items.Clear;
end else begin
IdFTP1.Host := LabeledEdit1.Text;
IdFTP1.Username := LabeledEdit2.Text;
IdFTP1.Password := LabeledEdit3.Text;
try
IdFTP1.Connect;
TreeView1.Items.Clear;
FRootNode := nil;
//ルートノード
LRootDir := '/';
FRootNode := TreeView1.Items.Add(nil, LRootDir);
//FRootNodeのアイコン
FRootNode.ImageIndex := GetFolderIcon(False);
FRootNode.SelectedIndex := GetFolderIcon(True);
//ツリービュー作成
ChangeDirAndSetTreeItems(LRootDir, FRootNode, True);
btnBackDir.Enabled := True;
FRootNode.Expanded := True;
except
MessageDlg('接続に失敗しました．', mtInformation, [mbOK], 0);
end;
if IdFTP1.Connected then begin
btnConnect.Caption := '切断';
end else begin
btnConnect.Caption := '接続';
TreeView1.Items.Clear;
end;
end;
btnConnect.Enabled := True;
end;
//-----------------------------------------------------------------------------
// 引数のADirディレクトリ内のフォルダをリスト
// TIdFTPListItemの使用にはusesにIdFTPListが必要
//-----------------------------------------------------------------------------
function TForm1.ChangeDirAndSetTreeItems(ADir: String; Node: TTreeNode;
DirFlag: Boolean): Boolean;
var
i : Integer;
LCount : Integer;
LFileName : String;
LAddNode : TTreeNode;
LListItem : TIdFTPListItem;
LDirCnt : Integer;
begin
Result := False;
IdFTP1.ChangeDir(ADir);
IdFTP1.List;
LCount := IdFTP1.DirectoryListing.Count;
if LCount > 0 then begin
for i := 0 to LCount - 1 do begin
LListItem := IdFTP1.DirectoryListing[i];
LFileName := LListItem.FileName;
if (LFileName = '.') or (LFileName = '..') then Continue;
if LListItem.ItemType = ditDirectory then begin
LAddNode := TreeView1.Items.AddChild(Node, LFileName);
LAddNode.ImageIndex := GetFolderIcon(False);
LAddNode.SelectedIndex := GetFolderIcon(True);
//TIdFTPListItemのDataプロパティの11から14番目にディレクトリ内に存在
//するディレクトリ数が入っているのでそれを使用
LDirCnt := StrToIntDef(Copy(LListItem.Data, 11, 4), 0) - 2;
if LDirCnt>0 then begin
LAddNode.HasChildren := True;
end;
end;
end;
end;
end;
//-----------------------------------------------------------------------------
// フォルダのアイコンインデックスをシステムイメージリストから取得
// フォルダのみアイコンなので，一回取得すれば，後はそれを利用することも可能
// 開いたアイコンを取得する場合はOpenFlagをTureにする
//-----------------------------------------------------------------------------
function TForm1.GetFolderIcon(OpenFlag: Boolean): Integer;
var
LSHFileInfo : TSHFileinfo;
LuFlags : Cardinal;
begin
LuFlags := SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON;
if OpenFlag then begin
LuFlags := LuFlags or SHGFI_OPENICON;
end;
SHGetFileInfo('*',
FILE_ATTRIBUTE_DIRECTORY,
LSHFileInfo,
SizeOf(TSHFileInfo),
LuFlags);
Result := LSHFileInfo.iIcon;
end;
//=============================================================================
// [戻る]ボタン
// １つ上の階層のディレクトリに移動
//=============================================================================
procedure TForm1.btnBackDirClick(Sender: TObject);
var
LNode : TTreeNode;
begin
if not IdFTP1.Connected then exit;
LNode := TreeView1.Selected;
if LNode = FRootNode then exit;
IdFTP1.ChangeDirUp;
TreeView1.Selected := LNode.Parent;
end;
//=============================================================================
// ノードを展開開始の時のイベント
// 現在のディレクトリ下のディレクトリのリストを作成
//=============================================================================
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
var
LFullDir : String;
begin
if not IdFTP1.Connected then exit;
if Node.HasChildren then begin
if Node.Count = 0 then begin
LFullDir := GetFullPathFromNode(Node);
TreeView1.Items.BeginUpdate;
Screen.Cursor := crHourglass;
ChangeDirAndSetTreeItems(LFullDir, Node, True);
Node.AlphaSort;
TreeView1.Items.EndUpdate;
Screen.Cursor:=crDefault;
end;
end;
end;
//=============================================================================
// OnCollapsed(ノードを閉じた時の)イベント用メソッド
// ノードを展開した時にエクスプローラとは違い，前の展開状態を再現させないため
// 下位ノードを削除．次回ノードを展開時にフォルダ一覧を再取得とする．
// 再展開の時に前回のツリー状態を再現されるのが嫌いな作者好みの仕様
// 再度ノードを展開する時は最新の情報になっている利点もある
//=============================================================================
procedure TForm1.TreeView1Collapsed(Sender: TObject; Node: TTreeNode);
var
LFlag : Boolean;
begin
if not IdFTP1.Connected then exit;
Screen.Cursor := crHourGlass;
TreeView1.Items.BeginUpdate;
LFlag := Node.Count > 0;
Node.DeleteChildren;
TreeView1.Items.EndUpdate;
Node.HasChildren := LFlag;
Screen.Cursor := crDefault;
end;
//=============================================================================
// 選択ノードが変更になったらLabeledEdit4に現在の絶対パスを表示
//=============================================================================
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
LFullDir : String;
begin
LFullDir := GetFullPathFromNode(Node);
IdFTP1.ChangeDir(LFullDir);
LabeledEdit4.Text := IdFTP1.RetrieveCurrentDir;
btnBackDir.Enabled := Node <> FRootNode;
end;
//-----------------------------------------------------------------------------
// ノードから絶対パスを求める
// このようん処理を行わなくてもTreeViewの各ItemのDataプロパティに絶対パスを代
// 入しておく方法もある
//-----------------------------------------------------------------------------
function TForm1.GetFullPathFromNode(Node: TTreeNode): String;
var
LNowNode : TTreeNode;
LSearchDir : String;
begin
LNowNode := Node;
LSearchDir := Node.Text;
while True do begin
if LNowNode = FRootNode then break;
LSearchDir := LNowNode.Parent.Text + '/' + LSearchDir;
LNowNode := LNowNode.Parent;
end;
Result := '/' + LSearchDir;
end;
end.
| 04_FTP サーバのディレクトリツリー ( ファイルも表示 ) |
| 前のサンプルでは，ディレクトリのみをツリー表示しましたが，ファイルも表示するようにしてみました．ノードを展開する際，まず，ディレクトリを検索して追加していき，ディレクトリがなくなったらファイルを検索して追加しています． |
 |
図9
設計時画面 |
 |
図10
実行画面
|
リスト5
FTP サーバ上のディレクトリをファイルも含めてツリー表示 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,
IdExplicitTLSClientServerBase;
type
TForm1 = class(TForm)
Panel1: TPanel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
btnConnect: TButton;
btnBackDir: TButton;
TreeView1: TTreeView;
IdFTP1: TIdFTP;
procedure btnConnectClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnBackDirClick(Sender: TObject);
procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
procedure TreeView1Collapsed(Sender: TObject; Node: TTreeNode);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
FIniFileName : String;
FRootNode : TTreeNode;
function ChangeDirAndSetTreeItems(ADir: String; Node: TTreeNode;
DirFlag:Boolean): Boolean;
function GetFullPathFromNode(Node: TTreeNode): String;
function GetFileExtIcon(FileName: String; Attrib:Cardinal;
OpenFlag:Boolean): Integer;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
ShellAPI, CommCtrl, IniFiles, IdFTPList, IdAllFTPListParsers;
{$R *.dfm}
//=============================================================================
// 各種初期状態の設定
//
// システムイメージではなく，TImageListを使用する場合，背景を目立たない色にし
// ておかないとXP,2000で実行した際にclNoneの黒い色がそのまま表示されてしまう
// 例 ImageList1.BkColor := TreeView1.Color;
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LSHFileInfo : TSHFileInfo ;
LImgListHandle : THandle;
begin
btnConnect.Enabled := True;
//フォーカスがない時も選択ノードを淡く表示
TreeView1.HideSelection := False;
//テストなので複数行選択不可
TreeView1.MultiSelect := False;
//同様に直接編集は不可
TreeView1.ReadOnly := True;
//ディレクトリ名は表示専用
LabeledEdit4.ReadOnly := True;
//戻るボタン
btnBackDir.Enabled := False;
//コモンコントロールのイニシャライズ
InitCommonControls;
//システムのツリービューのハンドルを取得
LImgListHandle := SHGetFileInfo('',
0,
LSHFileInfo,
SizeOf(LSHFileInfo),
SHGFI_SMALLICON or
SHGFI_OPENICON or
SHGFI_SYSICONINDEX);
TreeView_SetImageList(TreeView1.Handle, LImgListHandle, TVSIL_NORMAL);
TreeView1.Items.Clear;
end;
//=============================================================================
// フォーム表示時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
AIni : TInifile;
begin
//Iniファイルからパスワード等を読出して表示
FIniFileName := '..\FTPInfo.ini';
AIni := TIniFile.Create(FIniFileName);
try
if FileExists(FIniFileName) then begin
LabeledEdit1.Text := AIni.ReadString('FTPInfo', 'ServerName', '');
LabeledEdit2.Text := AIni.ReadString('FTPInfo', 'UserID', '');
LabeledEdit3.Text := AIni.ReadString('FTPInfo', 'PassWord', '');
end;
finally
FreeAndNil(AIni);
end;
end;
//=============================================================================
// 設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
AIni : TInifile;
begin
AIni := TIniFile.Create(FIniFileName);
try
try
AIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
AIni.WriteString('FTPInfo', 'UserID', LabeledEdit2.Text);
AIni.WriteString('FTPInfo', 'PassWord', LabeledEdit3.Text);
except
end;
finally
FreeAndNil(AIni);
end;
end;
//=============================================================================
// 接続したらFTPサーバ内の指定ディレクトリの一覧を取得
//=============================================================================
procedure TForm1.btnConnectClick(Sender: TObject);
var
LRootDir : String;
LFileAttrib : Cardinal;
begin
btnConnect.Enabled := False;
if IdFTP1.Connected then begin
IdFTP1.Disconnect;
btnConnect.Caption := '接続';
TreeView1.Items.Clear;
end else begin
IdFTP1.Host := LabeledEdit1.Text;
IdFTP1.Username := LabeledEdit2.Text;
IdFTP1.Password := LabeledEdit3.Text;
try
IdFTP1.Connect;
TreeView1.Items.Clear;
FRootNode := nil;
//ルートノード
LRootDir := '/';
FRootNode := TreeView1.Items.Add(nil, LRootDir);
//FRootNodeのアイコン
LFileAttrib := FILE_ATTRIBUTE_DIRECTORY;
FRootNode.ImageIndex := GetFileExtIcon('', LFileAttrib, False);
FRootNode.SelectedIndex := GetFileExtIcon('', LFileAttrib, True);
//ツリービュー作成
ChangeDirAndSetTreeItems(LRootDir, FRootNode, True);
btnBackDir.Enabled := True;
FRootNode.Expanded := True;
except
MessageDlg('接続に失敗しました．', mtInformation, [mbOK], 0);
end;
if IdFTP1.Connected then begin
btnConnect.Caption := '切断';
end else begin
btnConnect.Caption := '接続';
TreeView1.Items.Clear;
end;
end;
btnConnect.Enabled := True;
end;
//-----------------------------------------------------------------------------
// 引数のADirディレクトリ内のフォルダをリスト
// TIdFTPListItemの使用にはusesにIdFTPListが必要
// ソートはしていないで取得順
//-----------------------------------------------------------------------------
function TForm1.ChangeDirAndSetTreeItems(ADir: String; Node: TTreeNode;
DirFlag: Boolean): Boolean;
var
i : Integer;
LCount : Integer;
LFileName : String;
LAddNode : TTreeNode;
LListItem : TIdFTPListItem;
LDirCnt : Integer;
LFileAttrib : Cardinal;
begin
Result := False;
IdFTP1.ChangeDir(ADir);
IdFTP1.List;
LCount := IdFTP1.DirectoryListing.Count;
if LCount > 0 then begin
//まずディレクトリをツリーに追加していく
for i := 0 to LCount - 1 do begin
LListItem := IdFTP1.DirectoryListing[i];
LFileName := LListItem.FileName;
if (LFileName = '.') or (LFileName = '..') then Continue;
if LListItem.ItemType = ditDirectory then begin
LFileAttrib := FILE_ATTRIBUTE_DIRECTORY;
LAddNode := TreeView1.Items.AddChild(Node,LFileName);
LAddNode.ImageIndex := GetFileExtIcon(LFileName, LFileAttrib, False);
LAddNode.SelectedIndex := GetFileExtIcon(LFileName, LFileAttrib, True);
//TIdFTPListItemのDataプロパティの11から14番目にディレクトリ内に存在
//するディレクトリ数が入っているのでそれを使用
LDirCnt := StrToIntDef(Copy(LListItem.Data, 11, 4), 0) - 2;
//ファイルも表示する場合はADirCnt>0ではなくADirCnt>=0
if LDirCnt >= 0 then begin
LAddNode.HasChildren := True;
end;
end;
end;
//次にファイルのみを追加していく
for i := 0 to LCount - 1 do begin
LListItem := IdFTP1.DirectoryListing[i];
LFileName := LListItem.FileName;
if (LFileName = '.') or (LFileName = '..') then Continue;
if LListItem.ItemType <> ditDirectory then begin
LFileAttrib := FILE_ATTRIBUTE_NORMAL;
LAddNode := TreeView1.Items.AddChild(Node, LFileName);
LAddNode.ImageIndex := GetFileExtIcon(LFileName, LFileAttrib, False);
LAddNode.SelectedIndex := GetFileExtIcon(LFileName, LFileAttrib, True);
end;
end;
end;
end;
//-----------------------------------------------------------------------------
// ファイルの拡張子に関連付けしたシステムイメージアイコンのインデックスを取得
// FileNameはファイルのフルパス(パス部分はなくても可)
// 取得するファイルの属性を引数のAttribに与える
// 開いたアイコンを取得する場合はOpenFlagをTureにする
//-----------------------------------------------------------------------------
function TForm1.GetFileExtIcon(FileName: String; Attrib: Cardinal;
OpenFlag:Boolean ): Integer;
var
LSHFileInfo : TSHFileinfo;
LpszPath : String;
LuFlags : Cardinal;
begin
LuFlags := SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON;
if OpenFlag then begin
LuFlags := LuFlags or SHGFI_OPENICON;
end;
if Attrib=FILE_ATTRIBUTE_DIRECTORY then begin
LpszPath := '*';
end else begin
LpszPath := '*' + ExtractFileExt(Filename);
end;
SHGetFileInfo(PChar(LpszPath),
Attrib,
LSHFileInfo,
SizeOf(TSHFileInfo),
LuFlags);
Result := LSHFileInfo.iIcon;
end;
//=============================================================================
// [戻る]ボタン
// １つ上の階層のディレクトリに移動
//=============================================================================
procedure TForm1.btnBackDirClick(Sender: TObject);
var
LNode : TTreeNode;
begin
if not IdFTP1.Connected then exit;
LNode := TreeView1.Selected;
if LNode = FRootNode then exit;
IdFTP1.ChangeDirUp;
TreeView1.Selected := LNode.Parent;
end;
//=============================================================================
// ノードを展開開始の時のイベント
// 現在のディレクトリ下のディレクトリのリストを作成
//=============================================================================
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
var
LFullDir : String;
begin
if not IdFTP1.Connected then exit;
if Node.HasChildren then begin
if Node.Count = 0 then begin
LFullDir := GetFullPathFromNode(Node);
TreeView1.Items.BeginUpdate;
Screen.Cursor := crHourglass;
ChangeDirAndSetTreeItems(LFullDir, Node, True);
TreeView1.Items.EndUpdate;
Screen.Cursor:=crDefault;
end;
end;
end;
//=============================================================================
// OnCollapsed(ノードを閉じた時の)イベント用メソッド
// ノードを展開した時にエクスプローラとは違い，前の展開状態を再現させないため
// 下位ノードを削除．次回ノードを展開時にフォルダ一覧を再取得とする．
// 再展開の時に前回のツリー状態を再現されるのが嫌いな作者好みの仕様
// 再度ノードを展開する時は最新の情報になっている利点もある
//=============================================================================
procedure TForm1.TreeView1Collapsed(Sender: TObject; Node: TTreeNode);
var
LFlag : Boolean;
begin
if not IdFTP1.Connected then exit;
Screen.Cursor := crHourGlass;
TreeView1.Items.BeginUpdate;
LFlag := Node.Count > 0;
Node.DeleteChildren;
TreeView1.Items.EndUpdate;
Node.HasChildren := LFlag;
Screen.Cursor := crDefault;
end;
//=============================================================================
// 選択ノードが変更になったらLabeledEdit4に現在の絶対パスを表示
//=============================================================================
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
LFullDir : String;
begin
LFullDir := GetFullPathFromNode(Node);
try
IdFTP1.ChangeDir(LFullDir);
except
//ファイルの場合はディレクトリ変更は不可
end;
LabeledEdit4.Text := IdFTP1.RetrieveCurrentDir;
btnBackDir.Enabled := Node <> FRootNode;
end;
//-----------------------------------------------------------------------------
// ノードから絶対パスを求める
// このようん処理を行わなくてもTreeViewの各ItemのDataプロパティに絶対パスを代
// 入しておく方法もある
//-----------------------------------------------------------------------------
function TForm1.GetFullPathFromNode(Node: TTreeNode): String;
var
LNowNode : TTreeNode;
LSearchDir : String;
begin
LNowNode := Node;
LSearchDir := Node.Text;
while True do begin
if LNowNode = FRootNode then break;
LSearchDir := LNowNode.Parent.Text + '/' + LSearchDir;
LNowNode := LNowNode.Parent;
end;
Result := '/' + LSearchDir;
end;
end.
| [773_IdFTP でダウンロードアップロード] のサンプルでは，1 つのファイルしかサーバへアップロード (転送，PUT) できませんが，次のコードは，ローカルマシンの指定フォルダまるごとアップロードする例です．ファイルのリスト，ディレクトリツリーを取得するコードと関係ありますので，こちらに掲載しました． |
 |
図11
設計時画の面
- [キャンセル] の機能を持たせるため
TIdAntiFreeze コンポーネントを配置
|
 |
図12
転送元のファイル構成
|
 |
図13
転送中
- [転送] ボタンで，確認のためフォルダ内のファイルリストを作成してから転送を開始する
- [フォルダ選択] は転送元のフォルダ指定用
|
 |
図14
転送後のサーバ上のファイル構成
- ディレクトリ Delphi の下に，転送元のフォルダと同じ名前の AAA というディレクトリができる
- この図はサンプルの [04] で確認したもの
|
リスト6
FTP サーバへローカルのフォルダ内のファイル全てを転送 (アップロード) |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP,ComCtrls, IdAntiFreezeBase,
IdAntiFreeze, IdExplicitTLSClientServerBase;
type
TForm1 = class(TForm)
Panel1: TPanel;
ProgressBar1: TProgressBar;
Panel2: TPanel;
Panel3: TPanel;
Button2: TButton;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
LabeledEdit5: TLabeledEdit;
Button1: TButton;
Button3: TButton;
IdFTP1: TIdFTP;
ListBox1: TListBox;
IdAntiFreeze1: TIdAntiFreeze;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
procedure IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
private
{ Private 宣言 }
FIniFileName : String;
FSendCount : Integer;
FAbortFlag : Boolean;
procedure GetFilesListAll(APath: String);
function CheckCreateDirectory(AFullPath: String): Boolean;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
IniFiles, IdFTPCommon, FileCtrl, IdURI, HTTPApp, IdAllFTPListParsers;
{$R *.dfm}
//=============================================================================
// EditにFTP関係情報をセット
// 1つ上の階層からFTPInfo.iniを読み出してセット
//
// LabeledEdit4は転送元のフォルダ．このフォルダも含めてフォルダ内の全てのファイ
// ルを転送する
// LabeledEdit5は転送先のディレクトリ．このディレクトリにLabeledEdit4の名前の
// ディレクトリを作成する
//
// LabeledEdit4.Text := 'D:\.....\AAA';
// LabeledEdit5.Text := 'hogehoge.com/homepage/delphi/';
// の場合，転送後のサーバ構成は
// hogehoge.com/homepage/delphi/AAA/
// となる．ディレクトリAAAが存在しない場合は，自動的に作成される
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
LIni : TInifile;
begin
Button3.Enabled := False;
FIniFileName := '..\FTPInfo.ini';
LIni := TIniFile.Create(FIniFileName);
try
if FileExists(FIniFileName) then begin
LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
LabeledEdit4.Text := LIni.ReadString('Others', 'SourceFolder', '');
LabeledEdit5.Text := LIni.ReadString('Others', 'PutDir', '');
end;
finally
FreeAndNil(LIni);
end;
if LabeledEdit4.Text = '' then begin
LabeledEdit4.Text := ExtractFilePath(ParamStr(0)) + 'AAA';
end;
end;
//=============================================================================
// 設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
LIni : TInifile;
begin
LIni := TIniFile.Create(FIniFileName);
try
try
LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
LIni.WriteString('FTPInfo', 'UserID', LabeledEdit2.Text);
LIni.WriteString('FTPInfo', 'PassWord', LabeledEdit3.Text);
LIni.WriteString('Others', 'SourceFolder', LabeledEdit4.Text);
LIni.WriteString('Others', 'PutDir', LabeledEdit5.Text);
except
end;
finally
FreeAndNil(LIni);
end;
if IdFTP1.Connected then begin
IdFTP1.Abort;
IdFTP1.Disconnect;
end;
end;
//=============================================================================
// PUT(転送)するフォルダを選択
// テストなので1つだけとする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LSelFolder : String;
begin
LSelFolder := ExtractFileDir(ParamStr(0));
if SelectDirectory('転送するフォルダを選択', '', LSelFolder) then begin
LabeledEdit4.Text := LSelFolder;
end;
end;
//=============================================================================
// FTPでファイルをアップロードする
//
// LSourceFolder : 転送元のフォルダ(例 D:\....\Delphi\AAA)
// LSourceFile : 転送元のフォルダ内の各々のファイル
// 実際に転送する際にListboxの各Itemから取出す
// LBaseFolder : 転送元のフォルダの1つ上の階層のフォルダ
// LUpLoadDir : 転送先のディレクトリ(例 hogehoge.com/homepage/delphi)
// LDestFile : 転送先のファイルの絶対パス
// 上のUpLoadDirとBaseFolder等から実際の転送時に組みたてる
//
// DosPathToUnixPathの使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LSourceFolder : String;
LSourceFile : String;
LBaseFolder : String;
LUpLoadDir : String;
LDestFile : String;
LIndex : Integer;
i : Integer;
begin
Screen.Cursor := crHourGlass;
Panel2.Caption := '';
Panel2.Update;
ProgressBar1.Position := 0;
IdFTP1.Host := LabeledEdit1.Text;
IdFTP1.Username := LabeledEdit2.Text;
IdFTP1.Password := LabeledEdit3.Text;
LSourceFolder := LabeledEdit4.Text;
LUpLoadDir := LabeledEdit5.Text;
LSourceFolder := IncludeTrailingPathDelimiter(LSourceFolder);
//転送するファイルのフルパス一覧を作成
ListBox1.Items.Clear;
ListBox1.Items.BeginUpdate;
GetFilesListAll(LSourceFolder);
ListBox1.Items.EndUpdate;
try
if IdFTP1.Connected = False then IdFTP1.Connect;
except
Screen.Cursor := crDefault;
IdFTP1.Disconnect;
MessageDlg('サーバの接続に失敗しました．', mtInformation, [mbOK], 0);
exit;
end;
LIndex := Length(LUpLoadDir);
if LUpLoadDir[LIndex] <> '/' then LUpLoadDir := LUpLoadDir + '/';
LBaseFolder := ExtractFilePath(ExcludeTrailingPathDelimiter(LSourceFolder));
FSendCount := 0;
Button3.Enabled := True;
try
for i := 0 to ListBox1.Items.Count - 1 do begin
LSourceFile := ListBox1.Items[i];
LDestFile := LUpLoadDir +
DosPathToUnixPath(StringReplace(LSourceFile,LBaseFolder, '', []));
CheckCreateDirectory(LDestFile);
IdFTP1.Put(LSourceFile, LDestFile);
inc(FSendCount);
end;
except
IdFTP1.Disconnect;
if FAbortFlag then begin
MessageDlg('処理を中断しました．', mtInformation, [mbOK], 0);
end else begin
MessageDlg('転送先のディレクトリが存在しません．', mtInformation, [mbOK], 0);
end;
end;
FAbortFlag := False;
Button3.Enabled := False;
Screen.Cursor := crDefault;
end;
//=============================================================================
// キャンセルボタン
// 転送先のファイルは削除した方がいいかも知れない
// DisConnectは，転送コードのexceptで処理しているので実際には不要
// また，キャンセルの時は切断しなくてもいいかも知れない
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
if IdFTP1.Connected then begin
FAbortFlag := True;
IdFTP1.Abort;
IdFTP1.Disconnect;
end;
Button3.Enabled := False;
end;
//-----------------------------------------------------------------------------
// APathで指定するフォルダ内の全てのファイルを検索するメソッド
// サブフォルダ内も検索
// Listbox1に転送対象のファイルのフルパス一覧を作成する
//-----------------------------------------------------------------------------
procedure TForm1.GetFilesListAll(APath: String);
var
LSearchPath : String;
LSearchRec : TSearchRec;
LListPath : String;
begin
if FindFirst(APath + '*.*', faAnyFile, LSearchRec) = 0 then begin
repeat
if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
if LSearchRec.Attr = faDirectory then begin
LSearchPath := IncludeTrailingPathDelimiter(APath + LSearchRec.Name);
GetFilesListAll(LSearchPath);
end else begin
//LSearchRec.Nameだけにすればファイル名のみ
LListPath := APath + LSearchRec.Name;
ListBox1.Items.Add(LListPath);
end;
end;
until FindNext(LSearchRec) <> 0;
FindClose(LSearchRec);
end;
end;
//-----------------------------------------------------------------------------
// 引数のAFullPathで指定したファイルに必要なディレクトリを再帰的に検索して作
// 成する関数．AFullPahtにはサーバーに置くファイルの絶対パスを与える
//
// [772_IdHTTPを使用したダウンロード]の[01_URL(URI)文字列の分解]参照
// TIdURIにはusesにIdURIが必要
//-----------------------------------------------------------------------------
function TForm1.CheckCreateDirectory(AFullPath: String): Boolean;
var
LURI : TIdURI;
LPath : String;
begin
Result := False;
LURI := TIdURI.Create(AFullPath);
try
LPath := LURI.Path;
if LPath = '/' then exit;
LPath := Copy(LPath, 1, Length(LPath) - 1);
CheckCreateDirectory(LPath);
finally
//ディレクトリ変更不可ならそのディレクトリがないものと解釈する
try
IdFTP1.ChangeDir(LPath);
Result := True;
except
IdFTP1.MakeDir(LPath);
Result := True;
end;
LURI.Free;
end;
end;
//=============================================================================
// IdHTTPのOnWorkBeginイベント
// プログレスバーの最大値をセット
//=============================================================================
procedure TForm1.IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
//Abortメソッドで処理の中断を可能にする
IdAntiFreeze1.Process;
ProgressBar1.Max := ListBox1.Items.Count;
end;
//=============================================================================
// IdFTPのOnWorkイベント
// アップロードの進捗(進行)状況をプログレスバーに表示
//=============================================================================
procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
var
LTheText : String;
begin
ProgressBar1.Position := FSendCount + 1;
LTheText :=IntToStr(ProgressBar1.Max - ProgressBar1.Position);
Panel2.Caption :='残り ' + LTheText + ' ファイル';
Panel2.Update;
end;
end.
| 06_FTP サーバからディレクトリごとダウンロード |
今度は逆に，FTP サーバから指定ディレクトリ内のファイルを全て，ディレクトリ構成まるごとダウンロードします．
ここでは，前のサンプルプログラムで転送したディレクトリを，このサンプルプロジェクトの直下にダウンロードしてみます．このサンプルでは，ダウンロードするディレクトリが固定ですが，サーバのファイルリストを表示し，そこで選択したディレクトリやファイルをダウンロードする様な仕様も考えられます． |
 |
図15
設計時画面
- [キャンセル] の機能を持たせるため
TIdAntiFreeze コンポーネントを配置
- [フォルダ] はダウンロードしたファイルの保存先の指定用
|
 |
図16
実行画面
- [接続] ボタンで指定ディレクトリ内のファイルリストを作成
- [DL開始] ボタンでダウンロード開始
|
 |
図17
ダウンロード中 |
 |
図18
実行結果
|
リスト7
FTP サーバ上の指定ディレクトリからファイルをディレクトリごとまとめてダウンロード |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP,ComCtrls, IdAntiFreezeBase,
IdAntiFreeze, IdExplicitTLSClientServerBase;
type
TForm1 = class(TForm)
Panel1: TPanel;
ProgressBar1: TProgressBar;
Panel2: TPanel;
Panel3: TPanel;
btnConnect: TButton;
btbFolder: TButton;
btnDLStart: TButton;
btnCancell: TButton;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
LabeledEdit5: TLabeledEdit;
IdFTP1: TIdFTP;
ListBox1: TListBox;
IdAntiFreeze1: TIdAntiFreeze;
procedure btnConnectClick(Sender: TObject);
procedure btbFolderClick(Sender: TObject);
procedure btnDLStartClick(Sender: TObject);
procedure btnCancellClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
private
{ Private 宣言 }
FIniFileName : String;
FAbortFlag : Boolean;
procedure GetDirAndFilesList(ADir: String);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
IniFiles, IdFTPCommon, FileCtrl, IdURI, HTTPApp, IdFTPList,
IdAllFTPListParsers;
{$R *.dfm}
//=============================================================================
// EditにFTP関係情報をセット
// 1つ上の階層からFTPInfo.iniを読み出してセット
//
// LabeledEdit4はダウンロード元のディレクトリ．このディレクトリを含めて全ての
// ファイルをローカルにダウンロードする
// LabeledEdit5は受取り側のフォルダ名．このフォルダ下にLabeledEdit4の名前のフ
// ォルを作成してダウンロードする
//
// LabeledEdit4.Text := 'hogehoge.com/homepage/delphi/AAA/'
// LabeledEdit5.Text := 'D:\...\hoge'
// の場合，ダウンロード後のローカルの構成は
// D:\...\hoge\AAA
// となる
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
LIni : TInifile;
begin
btnDLStart.Enabled := False;
btnCancell.Enabled := False;
FIniFileName := '..\FTPInfo.ini';
LIni := TIniFile.Create(FIniFileName);
try
if FileExists(FIniFileName) then begin
LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
LabeledEdit4.Text := LIni.ReadString('Others', 'SourceDir', '');
LabeledEdit5.Text := LIni.ReadString('Others', 'DestFolder', '');
end;
finally
FreeAndNil(LIni);
end;
if LabeledEdit5.Text = '' then begin
LabeledEdit5.Text := ExtractFileDir(ParamStr(0));
end;
end;
//=============================================================================
// 設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
LIni : TInifile;
begin
LIni := TIniFile.Create(FIniFileName);
try
try
LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
LIni.WriteString('FTPInfo', 'UserID', LabeledEdit2.Text);
LIni.WriteString('FTPInfo', 'PassWord', LabeledEdit3.Text);
LIni.WriteString('Others', 'SourceDir', LabeledEdit4.Text);
LIni.WriteString('Others', 'DestFolder', LabeledEdit5.Text);
except
end;
finally
FreeAndNil(LIni);
end;
if IdFTP1.Connected then begin
IdFTP1.Disconnect;
end;
end;
//=============================================================================
// 保存先フォルダの選択
//=============================================================================
procedure TForm1.btbFolderClick(Sender: TObject);
var
LSelFolder : String;
begin
LSelFolder := ExtractFileDir(ParamStr(0));
if SelectDirectory('保存先フォルダを選択', '', LSelFolder) then begin
LabeledEdit5.Text := LSelFolder;
end;
end;
//=============================================================================
// 接続してFTPサーバ内の指定ディレクトリの全てのディレクトリ一覧を取得
//=============================================================================
procedure TForm1.btnConnectClick(Sender: TObject);
var
LBaseDir : String;
begin
btnConnect.Enabled := False;
if IdFTP1.Connected then begin
IdFTP1.Disconnect;
btnConnect.Caption := '接続';
ListBox1.Items.Clear;
end else begin
IdFTP1.Host := LabeledEdit1.Text;
IdFTP1.Username := LabeledEdit2.Text;
IdFTP1.Password := LabeledEdit3.Text;
ProgressBar1.Position := 0;
Panel2.Caption := '';
try
if IdFTP1.Connected = False then IdFTP1.Connect;
//対象となるフォルダ
LBaseDir := LabeledEdit4.Text;
if LBaseDir = '' then LBaseDir := '/';
try
ListBox1.Items.Clear;
ListBox1.Items.BeginUpdate;
//取得対象のディレクトリ内のファイルリスト作成
GetDirAndFilesList(LBaseDir);
ListBox1.Items.EndUpdate;
btnDLStart.Enabled := True;
except
MessageDlg('ディレクトリが存在しません．', mtInformation, [mbOK], 0);
end;
except
MessageDlg('接続に失敗しました．', mtInformation, [mbOK], 0);
end;
if IdFTP1.Connected then begin
btnConnect.Caption := '切断';
end else begin
btnConnect.Caption := '接続';
ListBox1.Items.Clear;
end;
end;
btnConnect.Enabled := True;
end;
//=============================================================================
// FTPでサーバの指定ディレクトリ内のファイルをダウンロードする
// ダウンロードするファイルのリストは，このサンプルでは，接続時にListBox1に取
// 得する
//
// LSourceBaseDir : ダウンロード元のディレクトリの1つ上のディレクトリ
// 例 ..../Delphi/AAA の場合は ..../Delphi
// LDestBaseFoler : 受取り側のローカルのフォルダ
// サーバのAAAというディレクトリ内を取得する場合は，このフォル
// ダにAAAというフォルダを作成する
// LSourceFile : ダウンロード元の実際の絶対パスファイル名
// LDestFile : ダウンロードファイルのフルパス名
// LDestFolder : そのファイルを格納するフォルダ名
//
// TIdURIの使用にはusesに,IdURIが必要
// UnixPathToDosPathの使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.btnDLStartClick(Sender: TObject);
var
LURI : TIdURI;
LSourceBaseDir : String;
LDestBaseFolder : String;
LSourceFile : String;
LDestFile : String;
LDestFolder : String;
LIndex : Integer;
i : Integer;
begin
Screen.Cursor := crHourGlass;
Panel2.Caption := '';
Panel2.Update;
ProgressBar1.Position := 0;
//ディレクトリ名に'/'があったら削除
//最後のディレクトリ名部分を除いたディレクトリの絶対パスを取得
LSourceBaseDir := LabeledEdit4.Text;
LIndex := Length(LSourceBaseDir);
if LSourceBaseDir[LIndex] = '/' then begin
LSourceBaseDir := Copy(LSourceBaseDir, 1, Length(LSourceBaseDir) - 1);
end;
LURI := TIdURI.Create(LSourceBaseDir);
try
LSourceBaseDir := LURI.Path;
finally
LURI.Free;
end;
//受取り側のローカルフォルダ名が空なら現在のフォルダとする
LDestBaseFolder := LabeledEdit5.Text;
if LDestBaseFolder = '' then LDestBaseFolder := ExtractFileDir(ParamStr(0));
LDestBaseFolder := IncludeTrailingPathDelimiter(LDestBaseFolder);
ProgressBar1.Position := 0;
ProgressBar1.Max := ListBox1.Items.Count;
btnCancell.Enabled := True;
FAbortFlag := False;
try
for i := 0 to ListBox1.Items.Count - 1 do begin
//ダウンロード元ファイルの絶対パス名
LSourceFile := ListBox1.Items[i];
//ダウンロードファイル名
LDestFile := LDestBaseFolder +
UnixPathToDosPath(StringReplace(LSourceFile, LSourceBaseDir, '', []));
//ダウンロード先のフォルダ
LDestFolder := ExtractFileDir(LDestFile);
//フォルダがなかったら作成
if not DirectoryExists(LDestFolder) then ForceDirectories(LDestFolder);
//バイナリでもテキストファイルでもftBinaryの指定が必要
IdFTP1.TransferType := ftBinary;
//上書きでダウンロード
IdFTP1.Get(LSourceFile, LDestFile, True);
ProgressBar1.Position := i + 1;
Panel2.Caption := ' 残り ' + IntToStr(ProgressBar1.Max - i - 1) + ' ファイル';
Panel2.Update;
Application.ProcessMessages;
end;
except
IdFTP1.Disconnect;
if FAbortFlag then begin
MessageDlg('処理を中断しました．', mtInformation, [mbOK], 0);
end else begin
MessageDlg('ダウンロードに失敗しました．', mtInformation, [mbOK], 0);
end;
end;
btnCancell.Enabled := False;
FAbortFlag := False;
Screen.Cursor := crDefault;
end;
//=============================================================================
// キャンセルボタン
// 途中まではダウンロードされている
// 別に切断しなくてもいいが，テストなのでいいでしょう
//=============================================================================
procedure TForm1.btnCancellClick(Sender: TObject);
begin
if IdFTP1.Connected then begin
FAbortFlag := True;
IdFTP1.Abort;
IdFTP1.Disconnect;
end;
btnConnect.Caption := '接続';
btnDLStart.Enabled := False;
btnCancell.Enabled := False;
end;
//-----------------------------------------------------------------------------
// 対象となるディレクトリのリストを再帰的に検索してListBoxに追加していく
// このサンプルではテストの時に確認できるようにListBoxにディレクトリ名をリス
// トしているが，実際にはTStringList等でいいだろう
//
// リストを作成しないで，このダウンロードルーチンの中で処理していってもよいが，
// リストを作成すれば処理数などを把握できる．また総バイト数も取得できる
// これらは進行状況の表示に利用可能
//
// 引数のADirは絶対パス名で与える
// TIdFTPListItemの使用にはusesにIdFTPListが必要
//-----------------------------------------------------------------------------
procedure TForm1.GetDirAndFilesList(ADir: String);
var
LFileList : TStringList;
i : Integer;
LCount : Integer;
LListItem : TIdFTPListItem;
LFileName : String;
LDirCnt : Integer;
LCurDir : String;
begin
LFileList := TStringList.Create;
try
try
IdFTP1.ChangeDir(ADir);
except
end;
IdFTP1.List;
//Listメソッドを実行するとDirectoryListingでファイルのリストが取得できる
LCount := IdFTP1.DirectoryListing.Count;
//DirectroyListingは新たにListメソッドを実行すると初期化されてしまう
//したがって再帰処理の場合は利用できないので別リストを作成
LFileList.Clear;
for i := 0 to LCount - 1 do begin
LListItem := IdFTP1.DirectoryListing[i];
LFileName := LListItem.FileName;
if (LFileName = '.') or (LFileName = '..') then Continue;
if LListItem.ItemType = ditDirectory then begin
LCurDir := IdFTP1.RetrieveCurrentDir + '/' + LFileName;
LDirCnt := StrToIntDef(Copy(LListItem.Data, 11, 4), 0) - 2;
//ファイルがあればそのディレクトリ内も検索するのでADirCnt > =0
//ディレクトリだけの検索であればADirCnt > 0でOK
if LDirCnt >= 0 then begin
LFileList.Add(LCurDir);
end;
end else begin
ListBox1.Items.Add(IdFTP1.RetrieveCurrentDir + '/' + LFileName);
end;
end;
//この時点でSLに下層ディレクトリ名だけが絶対パスで入っている
//下層ディレクトリを再帰的に検索してListBoxのItemに追加していく
for i := 0 to LFileList.Count - 1 do begin
GetDirAndFilesList(LFileList[i]);
end;
finally
FreeAndNil(LFileList);
end;
end;
//=============================================================================
// IdFTPのOnWorkイベント
//=============================================================================
procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
//Abortメソッドで処理の中断を可能にする
IdAntiFreeze1.Process;
end;
end.
このページのサンプル [02_FTP サーバのファイルリスト] では，空でないディレクトリを削除することはできませんでした．以下のコードは，指定ディレクトリが空でなくても削除する例です．
前のサンプル同様に確認用のリストを表示していますが，対象となるファイル全てではなく，ディレクトリのみ表示し，実際の削除の時に各ディレクトリ内のファイルを検索しながら削除するようにしてみました． |
 |
図19
設計時画面 |
 |
図20
実行画面
- [接続] すると，指定ディレクトリ内のディレクトリだけを検索して表示
- [削除] で削除開始
|
 |
図21
削除終了 |
リスト8
FTP サーバ上の指定ディレクトリを削除 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,
IdExplicitTLSClientServerBase;
type
TForm1 = class(TForm)
Panel1: TPanel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
btnConnect: TButton;
IdFTP1: TIdFTP;
btnDeleteDir: TButton;
ListBox1: TListBox;
procedure btnConnectClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnDeleteDirClick(Sender: TObject);
private
{ Private 宣言 }
FIniFileName : String;
FBaseDir : String;
procedure ChangeDirAndListDir(ADir: String);
function DeleteDirFiles(Adir: String): Boolean;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
ShellAPI, CommCtrl, IniFiles, IdFTPList, IdAllFTPListParsers;
{$R *.dfm}
//=============================================================================
// フォーム表示時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
LIni : TInifile;
begin
btnConnect.Enabled := True;
//削除ボタン
btnDeleteDir.Enabled := False;
//Iniファイルからパスワード等を読出して表示
FIniFileName := '..\FTPInfo.ini';
LIni := TIniFile.Create(FIniFileName);
try
if FileExists(FIniFileName) then begin
LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
LabeledEdit4.Text := LIni.ReadString('Others', 'DeleteDir', '');
end;
finally
FreeAndNil(LIni);
end;
end;
//=============================================================================
// 設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
LIni : TInifile;
begin
LIni := TIniFile.Create(FIniFileName);
try
try
LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
LIni.WriteString('FTPInfo', 'UserID', LabeledEdit2.Text);
LIni.WriteString('FTPInfo', 'PassWord', LabeledEdit3.Text);
LIni.WriteString('Others', 'DeleteDir', LabeledEdit4.Text);
except
end;
finally
FreeAndNil(LIni);
end;
end;
//=============================================================================
// 接続してFTPサーバ内の指定ディレクトリの全てのサブディレクトリ一覧を取得
//=============================================================================
procedure TForm1.btnConnectClick(Sender: TObject);
begin
btnConnect.Enabled := False;
if IdFTP1.Connected then begin
IdFTP1.Disconnect;
btnConnect.Caption := '接続';
ListBox1.Items.Clear;
end else begin
IdFTP1.Host := LabeledEdit1.Text;
IdFTP1.Username := LabeledEdit2.Text;
IdFTP1.Password := LabeledEdit3.Text;
try
if IdFTP1.Connected=False then IdFTP1.Connect;
try
ListBox1.Items.Clear;
ListBox1.Items.BeginUpdate;
//対象となるフォルダ
FBaseDir := LabeledEdit4.Text;
//削除対象のディレクトリ内の(ディレクトリをほ含む)ファイルリスト作成
ChangeDirAndListDir(FBaseDir);
ListBox1.Items.EndUpdate;
btnDeleteDir.Enabled := True;
except
MessageDlg('ディレクトリが存在しません．', mtInformation, [mbOK], 0);
end;
except
MessageDlg('接続に失敗しました．', mtInformation, [mbOK], 0);
end;
if IdFTP1.Connected then begin
btnConnect.Caption := '切断';
end else begin
btnConnect.Caption := '接続';
ListBox1.Items.Clear;
end;
end;
btnConnect.Enabled := True;
end;
//=============================================================================
// [削除]ボタン
// ListBoxにリストしたディレクトリとその中のファイルを削除
//=============================================================================
procedure TForm1.btnDeleteDirClick(Sender: TObject);
var
i : Integer;
LTheText : String;
begin
if not IdFTP1.Connected then exit;
Screen.Cursor := crHourGlass;
//ディレクトリ内のファイルとディレクトリ自身を削除
//階層の深いディレクトリから削除するので逆順
for i := ListBox1.Items.Count - 1 downto 0 do begin
DeleteDirFiles(ListBox1.Items[i]);
end;
//最後に対象の大元のディレクトリ内のファイルとディレクトリ自身を削除
DeleteDirFiles(FBaseDir);
Screen.Cursor := crDefault;
LTheText := '削除完了しました' + sLineBreak
+ '表示中のディレクトリは既に存在しません';
MessageDlg(LTheText, mtInformation, [mbOK], 0);
end;
//-----------------------------------------------------------------------------
// 削除対象となるディレクトリのリストを再帰的に検索してListBoxに追加していく
// このサンプルではテストの時に確認できるようにListBoxにディレクトリ名をリス
// トしているが，実際にはTStringList等でいいだろう
//
// リストを作成しないで，このルーチンの中で削除していってもよいが，リストを作
// 成すれば削除数などを，(カウントしておけば)削除の警告と共に表示できる
//
// 引数のADirは絶対パス名で与える
// Indy10ではListメソッドの引数は不要
// TIdFTPListItemの使用にはusesにIdFTPListが必要
//-----------------------------------------------------------------------------
procedure TForm1.ChangeDirAndListDir(ADir: String);
var
LFileList : TStringList;
i : Integer;
LCount : Integer;
LListItem : TIdFTPListItem;
LFileName : String;
LDirCnt : Integer;
LCurDir : String;
begin
LFileList := TStringList.Create;
try
IdFTP1.ChangeDir(ADir);
IdFTP1.List(LFileList);
//Listメソッドを実行するとDirectoryListingでファイルのリストが取得できる
LCount := IdFTP1.DirectoryListing.Count;
//DirectroyListingは新たにListメソッドを実行すると初期化されてしまう
//したがって再帰処理の場合は利用できないので別リストを作成
LFileList.Clear;
for i := 0 to LCount - 1 do begin
LListItem := IdFTP1.DirectoryListing[i];
LFileName := LListItem.FileName;
if (LFileName = '.') or (LFileName = '..') then Continue;
if LListItem.ItemType = ditDirectory then begin
LCurDir := IdFTP1.RetrieveCurrentDir + '/' + LFileName;
ListBox1.Items.Add(LCurDir);
LDirCnt := StrToIntDef(Copy(LListItem.Data, 11, 4), 0) - 2;
if LDirCnt > 0 then begin
LFileList.Add(LCurDir);
end;
end;
end;
//この時点でSLに下層ディレクトリ名だけが絶対パスで入っている
//下層ディレクトリを再帰的に検索してListBoxのItemに追加していく
for i := 0 to LFileList.Count - 1 do begin
ChangeDirAndListDir(LFileList[i]);
end;
finally
FreeAndNil(LFileList);
end;
end;
//-----------------------------------------------------------------------------
// 引数で指定するディレクトリ内のファイル全てとそのディレクトリを削除する
//
// 引数のADirは絶対パス名で与える
// Indy10ではListメソッドの引数は不要
//-----------------------------------------------------------------------------
function TForm1.DeleteDirFiles(Adir: String): Boolean;
var
LFileList : TStringList;
i : Integer;
LCount : Integer;
LListItem : TIdFTPListItem;
LFileName : String;
begin
Result := True;
LFileList := TStringList.Create;
try
IdFTP1.ChangeDir(ADir);
IdFTP1.List(LFileList);
finally
FreeAndNil(LFileList);
end;
LCount := IdFTP1.DirectoryListing.Count;
try
for i := 0 to LCount - 1 do begin
LListItem := IdFTP1.DirectoryListing[i];
LFileName := LListItem.FileName;
if (LFileName = '.') or (LFileName = '..') then Continue;
if LListItem.ItemType <> ditDirectory then begin
IdFTP1.Delete(LFileName);
end;
end;
IdFTP1.ChangeDirUp;
IdFTP1.RemoveDir(ADir);
except
Result := False;
end;
end;
end.
Ansi 版の Delphi，すなわち Delphi 2007 以前では，ホスト (サーバ) 側の文字コードが Shift-JIS であれば，日本語のディレクトリ名，ファイル名も文字化けなしで扱うことができました．
Unicode 版の Delphi ではそのままでは正常に扱えません．削除はもちろん，編集もできません．
まず，ホスト側の文字コードページが何であるかを知る必要があります．
例えば，ホスト側の文字コードページが UTF-8 の場合，[02_FTP サーバのファイルリスト] を以下のように変更します．まず，以下のような，文字コードページの変換用の関数を作成します． |
[備考]
ホスト (サーバ) のファイル名等に使用する文字コードは，管理者であれば変更できます．今回のテストでは実際に文字コードを変更して動作確認をしました．
ただし，確認したのは，SHIFT-JIS，EUC，UTF-8N だけです．
確実に言えることは，サーバのディレクトリ名やファイル名には，日本語を使用しない方が無難であるということです．ASCII 文字の範囲にしておけば自分自身も，それらのファイルを使用する人も，ここで説明しているような面倒な作業が必要ありません．
|
//-----------------------------------------------------------------------------
// ホストから取得したUTF-8の日本語文字列をUnicode文字列に変換する関数
//-----------------------------------------------------------------------------
function TForm1.ChangeCodePage_forDISP(S: String): String;
var
i : Integer;
U8 : UTF8String;
begin
SetLength(U8, Length(S));
for i := 1 to Length(S) do begin
//DelphiではUTF-8はAnsiString扱い
U8[i] := AnsiChar(S[i]);
end;
Result := UnicodeString(U8);
end;
//-----------------------------------------------------------------------------
// 日本語文字列をホストが認識する文字列に変換する関数
// 日本語のディレクトリやファイル名をホスト(サーバ)に渡す時に使用
// ただし，このコードはUTF-8の場合
// この関数は，MECSUtilsのMecsStretchElement関数のコードを借用
//-----------------------------------------------------------------------------
function TForm1.ChangeCodePage_forDIR(S: String): String;
var
U8 : UTF8String;
i : Integer;
begin
U8 := UTF8String(S);
SetLength(result, Length(U8));
for i := 1 to Length(U8) do begin
Result[i] := WideChar(U8[i]);
end;
end;
| 次に，SetListViewItems 関数の以下の部分を，上の関数を使用して追加または修正します． |
リスト10
ファイルリストを作成する SetListViewItems の追加または修正 |
//ファイル名
FileName := AFTPItem.FileName;
FileName := ChangeCodePage_forDISP(FileName); //追加
//現在のディレクトリ名を表示
LabeledEdit4.Text := ChangeCodePage_forDISP(IdFTP1.RetrieveCurrentDir); //変更
| ChangeDir 関数の先頭に次のコードを追加します．また，ディレクトリ操作のコードで，必要と思われる部分にも，同じ様な修正をします． |
リスト11
表示ディレクトリを変更する ChangeDir の先頭に追加 |
DirName := ChangeCodePage_forDIR(DirName); //追加
| 他の文字コードページの場合は，次の様な型宣言をした文字列型を，UTF8String の場合と同じように処理します． |
type
SJISString = type AnsiString(932); // Shift-JIS(CP932)
EUCJString = type AnsiString(20932); // EUC-JP(CP20932)
//System.pas内のUTF8Stringのtype宣言
UTF8String = type AnsiString(65001);
PUTF8String = ^UTF8String;
| 09_エクスプローラで FTP サーバのファイルリストを表示 |
| Indy コンポーネントによる操作ではありませんが．FTP サーバのファイルリストは，エクスプローラで表示することができます．エクスプローラで，表示フォルダの指定を下記のいずれかにします． |
ftp://ログイン名@ftpサーバー名.ドメイン名
ftp://ドメイン名@ftpサーバー名 |
| するとログオンダイアログ (ログインダイアログ) が表示されます．以下の図では，エクスプローラを起動してからこの操作した例です．フォルダツリー部は表示されないようです． |
 |
図22
ログオン画面
|
 |
図23
接続直後 |
 |
図24
表示例
- 当サイトの [Delphi] ディレクトリ内の一覧
|
|