DelFusa Blog 総本山

プログラミングの話題とかです。

NEW | PAGE-SELECT | NEXT

≫ EDIT

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

| スポンサー広告 | --:-- | comments(-) | trackbacks(-) | TOP↑

≫ EDIT

容量デカイの気に食わず TDirectory.GetFilesなどを自前実装した


|   ハイハイハイ
|,,∧∩ サイキン
|Д゚彡  ヒトリボッチ
| ミ′
| ミ    ナ
| U      キガシマス


性格が歪んでいるから、ひとりぼっちなのでしょうか。たぶん、そうですね。

ということで、久しぶりのDelphiの話題っす。

相変わらず、DelphiでEmEditorPluginを作っていまして

Ctrl+Hキーで、C++ファイルと、ヘッダーファイルを行き来できるプラグインを
以前つくっておりました。

SwitchCPPSourceHeader.dll
http://delfusa.main.jp/delfusafloor/download/switchcppsourceheader/readme.html


このブラグインはソース公開はしてなかったですね。


ま。中心となるロジックは簡単です。抜粋。

SwitchCPPSourceHeader.dpr

51:procedure OnCommand(hwnd:HWND);stdcall;
52:var
53: OriginalFilePath: WideString;
54: OpenTargetFilePath: WideString;
55:begin
56://・自分のファイル名を取得
57: OriginalFilePath := EI_GET_FILE_NAMEW_Delphi(hwnd);
58: if not FileExists(OriginalFilePath) then
59: begin
60: OriginalFilePath := EmptyStr;
61: Exit;
62: end;
63:
64://・それが.hか.cppかを判断
65: if CheckFileExt(OriginalFilePath, 'h') then
66: begin
67://・.hなら、.cと.cppと名前を変更してEmEditorで起動
68: OpenTargetFilePath := ChangeFileExt(OriginalFilePath, '.c');
69: OpenTargetEmEditor(OpenTargetFilePath);
70:
71: OpenTargetFilePath := ChangeFileExt(OriginalFilePath, '.cpp');
72: OpenTargetEmEditor(OpenTargetFilePath);
73: end else
74://・.c/.cppなら.hと名前を変更してEmEditorで起動
75: if CheckFileExt(OriginalFilePath, 'c') then
76: begin
77: OpenTargetFilePath := ChangeFileExt(OriginalFilePath, '.h');
78: OpenTargetEmEditor(OpenTargetFilePath);
79: end else
80: if CheckFileExt(OriginalFilePath, 'cpp') then
81: begin
82: OpenTargetFilePath := ChangeFileExt(OriginalFilePath, '.h');
83: OpenTargetEmEditor(OpenTargetFilePath);
84: end else

CheckFileExt関数やOpenTargetEmEditorの内部は、普通に作っています。

で、こいつを、WPF開発でEmEditorでソース開いて使ってて
MainForm.xaml と MainForm.xaml.vb
これを切り替えて開きたいわけですよ。

ついでに、実際には存在しないけど
もし、MainForm.vb というファイルが同じフォルダに存在したら、
同一ファイル名で拡張子だけが異なるファイルを、
Ctrl + H を押すたびにファイルが切り替わるような機能が欲しいなと思いました。

で、ファイル名を列挙する必要がありますよね…

2009/04/18/DelphiでFindFirstとFindCloseの使い方 - くじらぶろぐD
http://d.aoikujira.com/blog/index.php?2009%2F04%2F18%2FDelphiでFindFirstとFindCloseの使い方


詳しく知ることも重要なのですが
FindFirst/FindNext/FindCloseのループ方法を調べてたら、.NETと差がありすぎて悲しくなってきましたので

もう少し書きやすい、.NET類似のVCL TDirectoryクラスを使おうと思いました。
やっぱ、ファイル一覧を得るためにループとやり方を考えるとかってちょっとナンセンス。
.NETの設計はこういう面、すっきりしていて割り切り方も悪くないです。


C++Builder好きの秘密基地
http://d.hatena.ne.jp/A7M/20111113/1321153205

TDirectory.GetFilesでファイル属性を取得する

しかも、無名メソッドバージョンありということで、こいつは便利です!

が…
uses IOUtils …

300KB増!

ありえん!通常なら問題になりませんが、プラグインではちょっと無理な容量なのです。

ということで、全部自前で書きました。

GetFileSystemEntries/GetFiles/GetDirectories
このあたり、再帰も使えるし、無名メソッドも使えるし、
無名メソッド側での途中終了もできるし
(共通関数のGetFileFolders使うけどね)
、容量も少ないし。こんな感じで、VCL超えしても、たまにはいいよね。

どぞ。


(*----------------------------------------
ファイルとフォルダを列挙するユニット
FileListコンポーネントとは別に、匿名メソッドを使えるような
.NET TDirectoryと似た実装で作成してみた。
2011/11/15(火)
・作成
----------------------------------------
使い方

ファイルとフォルダを列挙する関数
IOUtils の TDirectory クラス
GetFileSystemEntries / GetFiles / GetDirectories とほぼ互換

次のように実装すると、ファイルパスを列挙することができる

procedure TForm1.Button1Click(Sender: TObject);
var
 Files: TStringDynArray;
 FolderPath: String;
 I: Integer;
begin
 FolderPath := ExtractFileDir(Application.ExeName);
 Files := GetFileSystemEntries(FolderPath, soAllDirectories,
  function(const Path: string; const SearchRec: TSearchRec): Boolean
  begin
   Result := True;
   if (SearchRec.Attr and faDirectory) > 0 then
   begin
    //ディレクトリを列挙
    Memo1.Lines.Add('Dir:' + Path + PathDelim + SearchRec.Name);
   end else
   begin
    //ファイルを列挙
    Memo1.Lines.Add('File:' + Path + PathDelim + SearchRec.Name);
   end;
  end );
end;

GetFileSystemEntries: ファイルディレクトリ両方
GetFiles: ファイル
GetDirectories: ディレクトリ
各関数の戻り値は文字列配列。
無名関数でTrueを返すと戻り値に値が追加される

リストアップする方法は

 type TGetFileFoldersArgs.SearchOption =
    (soTopDirectoryOnly, soAllDirectories);

で定義されている。
最上位のディレクトリのみか、
再帰的に全部のディレクトリ対象にしたリストアップ方法を選ぶことができる。

途中でリストアップをキャンセルする場合
次のように実装する

procedure TForm1.Button2Click(Sender: TObject);
var
 Files: TStringDynArray;
 FolderPath: String;
 I: Integer;
begin
 FolderPath := ExtractFileDir(Application.ExeName);
 Files := GetFileFolders(FolderPath, ioAny, soAllDirectories,
  procedure(const Path: string; const SearchRec: TSearchRec;
   var ItemAdd: Boolean; var ListupStop: Boolean)
  begin
   if (SearchRec.Attr and faDirectory) > 0 then
   begin
    //ディレクトリを列挙
    Memo1.Lines.Add('Dir:' + Path + PathDelim + SearchRec.Name);
   end else
   begin
    //ファイルを列挙
    Memo1.Lines.Add('File:' + Path + PathDelim + SearchRec.Name);
   end;
   if SearchRec.Name = 'Unit1.dcu' then
   begin
    ItemAdd := False;
    ListupStop := True;
   end;
  end );
end;

ItemAdd: デフォルト:True 項目追加するかどうかを制御
ListupStop: デフォルト:False Trueならリストアップをキャンセルする
//----------------------------------------*)
unit GetFileFoldersUnit;

interface

uses
 SysUtils,
 Types,
end_uses;

type
 TGetFileFoldersArgs = class
  public
   type ItemOption = (ioAny, ioFile, ioDirectory);
   type FilterProcedure = reference to procedure(const Path: string;
    const SearchRec: TSearchRec;
    var ItemAdd: Boolean;
    var ListupStop: Boolean);
   type FilterFunction = reference to function(const Path: string;
    const SearchRec: TSearchRec): Boolean;
   type SearchOption = (soTopDirectoryOnly, soAllDirectories);
 end;

function GetFileFolders(Path: String; ItemOption: TGetFileFoldersArgs.ItemOption;
SearchOption: TGetFileFoldersArgs.SearchOption = soTopDirectoryOnly;
FilterProcedure: TGetFileFoldersArgs.FilterProcedure = nil): TStringDynArray;

function GetFileSystemEntries(Path: String;
SearchOption: TGetFileFoldersArgs.SearchOption = soTopDirectoryOnly;
FilterFunction: TGetFileFoldersArgs.FilterFunction = nil): TStringDynArray;
function GetFiles(Path: string;
SearchOption: TGetFileFoldersArgs.SearchOption = soTopDirectoryOnly;
FilterFunction: TGetFileFoldersArgs.FilterFunction = nil): TStringDynArray;
function GetDirectories(Path: string;
SearchOption: TGetFileFoldersArgs.SearchOption = soTopDirectoryOnly;
FilterFunction: TGetFileFoldersArgs.FilterFunction = nil): TStringDynArray;

implementation

function GetFileFolders(Path: String; ItemOption: TGetFileFoldersArgs.ItemOption;
SearchOption: TGetFileFoldersArgs.SearchOption = soTopDirectoryOnly;
FilterProcedure: TGetFileFoldersArgs.FilterProcedure = nil): TStringDynArray;

var
 StopFlag: Boolean;

  function IsDirecotry(sr: TSearchRec): Boolean;
  begin
   Result := (sr.Attr and faDirectory) > 0;
  end;

  procedure GetFileFoldersCore(Path: string);
  var
   SearchRec: TSearchRec;
   ListUpFlag: Boolean;
   ItemAdd: Boolean;
   ListUpStop: Boolean;
  begin
   if StopFlag then Exit;

   Path := ExcludeTrailingPathDelimiter(Path);
   SetLength(Result, 0);
   if FindFirst(Path + PathDelim + '*.*', faAnyFile, SearchRec) = 0 then try
   repeat
    if (SearchRec.Name = '.') or (SearchRec.Name = '..') then continue;

    ListUpFlag := False;
    if (ItemOption = ioAny) then
    begin
     ListUpFlag := True;
    end else
    if (ItemOption = ioFile) and (not IsDirecotry(SearchRec)) then
    begin
     ListUpFlag := True;
    end else
    if (ItemOption = ioDirectory) and (IsDirecotry(SearchRec)) then
    begin
     ListUpFlag := True;
    end;

    if ListUpFlag then
    begin
     if Assigned(FilterProcedure) then
     begin
      ItemAdd := True;
      ListUpStop := False;
      FilterProcedure(Path, SearchRec, ItemAdd, ListUpStop);
      if ItemAdd then
      begin
       SetLength(Result, Length(Result) + 1);
       Result[Length(Result)-1] := Path + PathDelim + SearchRec.Name;
      end;
      if ListUpStop then
      begin
       StopFlag := True;
       break;
      end else
      begin
       StopFlag := False;
      end;
     end else
     begin
      SetLength(Result, Length(Result) + 1);
      Result[Length(Result)-1] := Path + PathDelim + SearchRec.Name;
     end;
    end;

    if IsDirecotry(SearchRec)
    and (SearchOption = soAllDirectories) then
    begin
     GetFileFoldersCore(Path + PathDelim + SearchRec.Name);
    end;

   until FindNext(SearchRec) <> 0;
   finally FindClose(SearchRec); end;
  end;

begin
 StopFlag := False;
 GetFileFoldersCore(Path);
end;

function _GetFileFolders(Path: String;
ItemOption: TGetFileFoldersArgs.ItemOption;
SearchOption: TGetFileFoldersArgs.SearchOption;
FilterFunction: TGetFileFoldersArgs.FilterFunction): TStringDynArray;
begin
 if Assigned(FilterFunction) then
 begin
  Result := GetFileFolders(Path, ItemOption, SearchOption,
   procedure (const Path: string; const SearchRec: TSearchRec;
    var ItemAdd: Boolean; var ListupStop: Boolean)
   begin
    listupStop := False;
    ItemAdd := FilterFunction(Path, SearchRec);
   end );
 end else
 begin
  Result := GetFileFolders(Path, ItemOption, SearchOption);
 end;
end;

function GetFileSystemEntries(Path: String;
SearchOption: TGetFileFoldersArgs.SearchOption = soTopDirectoryOnly;
FilterFunction: TGetFileFoldersArgs.FilterFunction = nil): TStringDynArray;
begin
 Result := _GetFileFolders(Path, ioAny, SearchOption, FilterFunction);
end;

function GetFiles(Path: string;
SearchOption: TGetFileFoldersArgs.SearchOption = soTopDirectoryOnly;
FilterFunction: TGetFileFoldersArgs.FilterFunction = nil): TStringDynArray;
begin
 Result := _GetFileFolders(Path, ioFile, SearchOption, FilterFunction);
end;

function GetDirectories(Path: string;
SearchOption: TGetFileFoldersArgs.SearchOption = soTopDirectoryOnly;
FilterFunction: TGetFileFoldersArgs.FilterFunction = nil): TStringDynArray;
begin
 Result := _GetFileFolders(Path, ioDirectory, SearchOption, FilterFunction);
end;

end.
スポンサーサイト

| 未分類 | 12:40 | comments:0 | trackbacks(-) | TOP↑

COMMENT















非公開コメント

PREV | PAGE-SELECT | NEXT

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。