第１８章 ファイル操作

Delphi のファイル管理・入出力関数のうち System.pas に実装されている

  AssignFile  Reset  Rewrite  Seek  Write  Read  CloseFile

などは、Object Pascal という言語に固有のものであり、いつでも安全に使うことができる｡ ファイルの存在や属性などを取得・変更する関数の多くは SysUtils.pas に実装されている｡ これらの多くの機能は、ＡＰＩレベルの関数を使っても実現できる｡ この章では､ 主にディスクファイルの管理・入出力に関する Win32 ＡＰＩの機能を調べよう｡

１８−０ この章の内容

第１８章 ファイル操作
１８−１ ファイル名の取得・設定
１８−２ コモンダイアログのカプセル化
１８−３ ファイルのコピー・移動・削除
１８−４ ディレクトリ操作
１８−５ ファイルアクセス
１８−６ ファイルビューワ
１８−７ ファイルの書き込み
１８−８ まとめ


| arrw18c.gif 前の章へ | 総目次へ | 次の章へ arrw18d.gif ｜

１８−１ ファイル名の取得・設定

Delphi のコンポーネントパレットの Dialogs ページにある TOpenDialog と TSaveDialog コンポーネントは、Win32 のコモンダイアログの GetOpenFileName( ) 関数と GetSaveFileName( ) 関数の機能をカプセル化したものだ｡ ここでは、この二つの関数を使い方を調べることにしよう｡ これらは、CommDlg.pas に実装されている｡

function GetOpenFileName(var OpenFile: TOpenFilename): Bool; stdcall;
function GetSaveFileName(var OpenFile: TOpenFilename): Bool; stdcall;

両方の関数に使われている TOpenFilename レコードは、以下のように定義されている｡

  POpenFilename = POpenFilenameA;
  TOpenFilenameA = packed record
    lStructSize: DWORD;             //このレコードのサイズ（バイト単位）
    hWndOwner: HWND;                //このダイアログのオーナーウィンドウのハンドル。ゼロも可。
    hInstance: HINST;               //OFN_ENABLETEMPLATE か OFN_ENABLETEMPLATEHANDLEセット時
                                    //のみ必要
    lpstrFilter: PAnsiChar;         //フィルター文字列
    lpstrCustomFilter: PAnsiChar;   //ユーザー定義フィルター文字列
    nMaxCustFilter: DWORD;          //ユーザー定義フィルター文字列のバイトサイズ
    nFilterIndex: DWORD;            //最初に使うフィルターのインデックス（１が最初 ）
    lpstrFile: PAnsiChar;           //最初に使うファイル名を設定、実行後は指定されたファイルが
                                    //設定されている
    nMaxFile: DWORD;                //lpstrFileのバイトサイズ。２６０以上を設定する
    lpstrFileTitle: PAnsiChar;      //Win32では使用しない
    nMaxFileTitle: DWORD;           //Win32では使用しない
    lpstrInitialDir: PAnsiChar;     //最初に開けるディレクトリを指定。nilにするとカレントディレ
                                    //クトリになる
    lpstrTitle: PAnsiChar;          //ダイアログのタイトル文字列を指定する。nilではデフォルト。
    Flags: DWORD;                   //以下に説明するフラグを幾つか設定する
    nFileOffset: Word;              //lpstrFileで設定したパスからファイル名が始まるまでのゼロベ
                                    //ースオフセット
    nFileExtension: Word;           //lpstrFileで設定したパスから拡張子が始まるまでのゼロベース
                                    //オフセット
    lpstrDefExt: PAnsiChar;         //デフォルトの拡張子を指定する（コンマは含まない）
    lCustData: LPARAM;              //フック関数に渡すアプリケーション定義データ
    lpfnHook: function(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT ;stdcall;
    lpTemplateName: PAnsiChar;
  end;
  TOpenFilename = TOpenFilenameA;

これだけフィールド変数が多いといろいろ迷うところであるが、半分近くはゼロまたは nil にしても基本的な機能は利用できる。重要なフィールドについて幾つか調べよう｡

lpstrFilter: PAnsiChar には、ディレクトリのファイルの一覧を表示するときの拡張子によるフィルタを設定する。例えば、'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0#0 と指定すると .pas の拡張子を持つファイルだけが表示される。末尾は二つのヌル文字で指定する。全てのファイルを表示したいときは、'すべて (*.*)'#0+'*.*'#0#0 というふうにする｡ 複数のフィルタを設定するときは 

  lpstrFilter := 'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0+'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
                                                       'すべて (*.*)'#0+'*.*'#0#0;

のように連結する。デフォルトで表示するフィルタは、nFilterIndex に１から始まる番号を指定する。上の例では２を指定すると .dpr の拡張子を持つプロジェクトファイルのみが表示される。

lpstrFile: PAnsiChar には、デフォルトで開くファイル名または保存するファイル名を含んだ MAX_PATH 以上の長さの文字列バッファを指定する。ダイアログ実行後は、ユーザが入力した文字列がフルパス付きで設定されている｡

Flags: DWORD には、以下の定数の組み合わせを指定するか、または戻り値をマスクして検査する。

const
  OFN_READONLY = $00000001;            //読みとり専用のチェックの設定・取得
  OFN_OVERWRITEPROMPT = $00000002;     //重ね書きの確認ダイアログの表示
  OFN_HIDEREADONLY = $00000004;        //読みとり専用チェックボックスを表示しない
  OFN_NOCHANGEDIR = $00000008;         //カレントディレクトリを変更しない
  OFN_SHOWHELP = $00000010;            //ヘルプボタンを表示する
  OFN_ENABLEHOOK = $00000020;          //フック関数を使う
  OFN_ENABLETEMPLATE = $00000040;      //ダイアログテンプレートを使う
  OFN_ENABLETEMPLATEHANDLE = $00000080;//ダイアログテンプレートハンドルを使う
  OFN_NOVALIDATE = $00000100;          //不正ファイル名を許可（フック関数使用時）
  OFN_ALLOWMULTISELECT = $00000200;    //複数ファイルの選択可。パスと各ファイル名は空白で区切られる
  OFN_EXTENSIONDIFFERENT = $00000400;  //ユーザがlpstrDefExtと異なる拡張子を入力した
  OFN_PATHMUSTEXIST = $00000800;       //不正確なパス入力を警告するダイアログを表示する
  OFN_FILEMUSTEXIST = $00001000;       //既存のファイルのみの入力を許す
  OFN_CREATEPROMPT = $00002000;        //新しいファイルを作成するのかを確認する
  OFN_SHAREAWARE = $00004000;          //ネットワークシェア違反のファイル名も許す
  OFN_NOREADONLYRETURN = $00008000;    //返されたファイルは読みとり専用ではない
  OFN_NOTESTFILECREATE = $00010000;    //ネットワーク関連（戻り値）
  OFN_NONETWORKBUTTON = $00020000;     //ネットワークボタンを隠す
  OFN_NOLONGNAMES = $00040000;         //長い名前を使わない
  OFN_EXPLORER = $00080000;            //エクスプローラ風の外観
  OFN_NODEREFERENCELINKS = $00100000;  //ショートカットファイルをそのまま返す
  OFN_LONGNAMES = $00200000;           //長い名前を使う（デフォルト？）

ここまでの知識を使って、とにかくこれらの関数を実行してみよう。

  1. エクスプローラを使って、新しいフォルダを 1801OpenSaveDialog01 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1705GetFromPointer フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで OpenSaveDialog01.dpr という名前で保存する｡
  5. コードエディタで以下のように編集する｡
  6. [F.9]でコンパイルして実行する｡

以下に OpenSaveDialog01.dpr の全リストを示す｡

program OpenSaveDialog01;

uses
  windows,
  messages,
  CommDlg,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  B1,B2,B3,B4: TAPIButton;
  LB: TAPIListBox;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function CountSpace(s: string):integer;
var
  i: integer;
begin
  result := 0;
  for i := 1 to Length(s) do
    if s[i] = ' ' then inc(result);
end;

function GetMultFileName(s:string;SL:TStringArray):integer;
var
  IC,i: integer;
  IL: TIntegerList;
begin
  IC := CountSpace(s);
  if IC = 0 then begin
    SL.Add(AExtractFileName(s));
    result := 1;
  end else begin
    IL := TIntegerList.Create(IC*SizeOf(integer),SizeOf(integer));
    for i := 1 to Length(s) do
      if s[i] = ' ' then IL.Add(i);
    for i := 1 to IC-1 do
      SL.Add(Copy(s,IL[i-1]+1,IL[i]-IL[i-1]-1));
    SL.Add(Copy(s,IL[IC-1]+1,100));
    IL.Free;
    result := IC;
  end;
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure B1Click(var Msg: TMessage);
var
  OFN: TOpenFileName;
  PATH,s: string;
begin
  PATH := 'Default.pas'#0;
  SetLength(PATH,MAX_PATH+5);
  FillChar(OFN,SizeOf(OFN),0);
  with OFN do begin
    lStructSize := 76; // for Delphi6
    hWndOwner := MainWnd.Handle;
    lpstrFilter := 'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0+
                   'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
                   'すべて (*.*)'#0+'*.*'#0#0;
     nFilterIndex := 3;
    lpstrFile := PChar(PATH);
    nMaxFile:= MAX_PATH+5;
    Flags := OFN_FILEMUSTEXIST or OFN_HIDEREADONLY;
  end;

  if GetOpenFileName(OFN) then begin
    LB.Clear;
    LB.AddString(PATH);
    LB.AddString('');
    LB.AddString('nFileOffset = '#9+AIntToStr(OFN.nFileOffset));
    LB.AddString('nFileExtension = '#9+AIntToStr(OFN.nFileExtension));
    s := Copy(PATH,0,OFN.nFileOffset);
    LB.AddString('Path =     '#9+s);
    s := Copy(PATH,OFN.nFileOffset+1,Length(PATH));
    LB.AddString('FileName = '#9+s);
    s := Copy(PATH,OFN.nFileExtension+1,Length(PATH));
    LB.AddString('Extension = '#9+s);
  end;
end;

procedure B2Click(var Msg: TMessage);
var
  OFN: TOpenFileName;
  s: string;
  PATH: array[0..8000] of Char;
  IC,i: integer;
  SA: TStringArray;
begin
  FillChar(PATH,8001,0);
  FillChar(OFN,SizeOf(OFN),0);
  with OFN do begin
    lStructSize := 76; // for Delphi6
    hWndOwner := MainWnd.Handle;
    lpstrFilter := 'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0+
                   'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
                   'すべて (*.*)'#0+'*.*'#0#0;
    nFilterIndex := 3;
    lpstrFile := @PATH;
    nMaxFile:= 8000;
    Flags := OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or
             OFN_ALLOWMULTISELECT or OFN_NONETWORKBUTTON;
  end;

  if GetOpenFileName(OFN) then begin
    SetString(s,PChar(@PATH),lstrlen(@PATH));
    SA := TStringArray.Create;
    IC := GetMultFileName(s,SA);
    LB.Clear;
    LB.AddString(Copy(string(OFN.lpstrFile),0,OFN.nFileOffset-1)+'\');
    LB.AddString('');
    LB.AddString('No. of Selected File = '+AIntToStr(IC));
    LB.AddString('');
    for i := 1 to IC do
      LB.AddString(SA[i-1]);
    LB.AddString('');
    LB.AddString('nFileOffset = '#9+AIntToStr(OFN.nFileOffset));
    LB.AddString('nFileExtension = '#9+AIntToStr(OFN.nFileExtension));
    SA.Free;
  end;
end;

procedure B3Click(var Msg: TMessage);
var
  OFN: TOpenFileName;
  s: string;
  PATH: array[0..8000] of Char;
  IC,i: integer;
  flag: Boolean;
  SA: TStringArray;
begin
  FillChar(PATH,8001,0);
  FillChar(OFN,SizeOf(OFN),0);
  with OFN do begin
    lStructSize := 76; // for Delphi6
    hWndOwner := MainWnd.Handle;
    lpstrFilter := 'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0+
                   'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
                   'すべて (*.*)'#0+'*.*'#0#0;
    nFilterIndex := 3;
    lpstrFile := @PATH;
    nMaxFile:= 8000;
    Flags := OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or
             OFN_ALLOWMULTISELECT or OFN_EXPLORER;
  end;

  if GetOpenFileName(OFN) then begin
    flag := true;
    i := 0;
    while flag do begin
      if PATH[i] = #0 then
        if PATH[i+1] = #0 then flag := false else PATH[i] := ' ';
      inc(i);
    end;
    SetString(s,PChar(@PATH),lstrlen(@PATH));
    SA := TStringArray.Create;
    IC := GetMultFileName(s,SA);
    LB.Clear;
    LB.AddString(Copy(string(OFN.lpstrFile),0,OFN.nFileOffset-1)+'\');
    LB.AddString('');
    LB.AddString('No. of Selected File = '+AIntToStr(IC));
    LB.AddString('');
    for i := 1 to IC do
      LB.AddString(SA[i-1]);
    LB.AddString('');
    LB.AddString('nFileOffset = '#9+AIntToStr(OFN.nFileOffset));
    LB.AddString('nFileExtension = '#9+AIntToStr(OFN.nFileExtension));
    SA.Free;
  end;
end;

procedure B4Click(var Msg: TMessage);
var
  OFN: TOpenFileName;
  PATH,s: string;
begin
  PATH := 'Default.tst'#0;
  SetLength(PATH,MAX_PATH+5);
  FillChar(OFN,SizeOf(OFN),0);
  with OFN do begin
    lStructSize := 76; // for Delphi6
    hWndOwner := MainWnd.Handle;
    lpstrFilter := 'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0+
                   'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
                   'すべて (*.*)'#0+'*.*'#0#0;
    nFilterIndex := 3;
    lpstrFile := PChar(PATH);
    nMaxFile:= MAX_PATH+5;
    lpstrInitialDir := 'C:\';
    Flags := OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY;
  end;

  if GetSaveFileName(OFN) then begin
    LB.Clear;
    LB.AddString(string(OFN.lpstrFile));
    LB.AddString('');
    LB.AddString('nFileOffset = '#9+AIntToStr(OFN.nFileOffset));
    LB.AddString('nFileExtension = '#9+AIntToStr(OFN.nFileExtension));
    s := Copy(PATH,0,OFN.nFileOffset);
    LB.AddString('Path =     '#9+s);
    s := Copy(PATH,OFN.nFileOffset+1,Length(PATH));
    LB.AddString('FileName = '#9+s);
    s := Copy(PATH,OFN.nFileExtension+1,Length(PATH));
    LB.AddString('Extension = '#9+s);
  end;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  B1 := CreateButton(hWindow,10,10,130,30,'Open One',B1Click);
  B2 := CreateButton(hWindow,150,10,130,30,'Open Many',B2Click);
  B3 := CreateButton(hWindow,290,10,130,30,'Open Many Ex',B3Click);
  B4 := CreateButton(hWindow,430,10,130,30,'Save',B4Click);
  LB := CreateListBox(hWindow,10,50,580,240,nil);

  with MainWnd do begin
    ClientWidth := 600;
    ClientHeight := 300;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifOpenSaveDialog01.zip(17.195kB)
OpensaveDialog01_1.gif

実行すると、四つのボタンと一つのリストボックスが作られる。uses 節に、CmmDlg を追加するのを忘れないこと｡ 左端の 'Open One' のボタンを押すと上図のような「ファイルを開く」ダイアログがポップアップされ、マウスでファイルを選択するとその結果がリストボックスに表示される｡ B1Click( ) 手続きを見てみよう｡

procedure B1Click(var Msg: TMessage);
var
  OFN: TOpenFileName;
  PATH,s: string;
begin
  PATH := 'Default.pas'#0;
  SetLength(PATH,MAX_PATH+5);
  FillChar(OFN,SizeOf(OFN),0);
  with OFN do begin
    lStructSize := 76; // for Delphi6
    hWndOwner := MainWnd.Handle;
    lpstrFilter := 'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0+
                   'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
                   'すべて (*.*)'#0+'*.*'#0#0;
     nFilterIndex := 3;
    lpstrFile := PChar(PATH);
    nMaxFile:= MAX_PATH+5;
    Flags := OFN_FILEMUSTEXIST or OFN_HIDEREADONLY;
  end;

  if GetOpenFileName(OFN) then begin
    LB.Clear;
    LB.AddString(PATH);
    LB.AddString('');
    LB.AddString('nFileOffset = '#9+AIntToStr(OFN.nFileOffset));
    LB.AddString('nFileExtension = '#9+AIntToStr(OFN.nFileExtension));
    s := Copy(PATH,0,OFN.nFileOffset);
    LB.AddString('Path =     '#9+s);
    s := Copy(PATH,OFN.nFileOffset+1,Length(PATH));
    LB.AddString('FileName = '#9+s);
    s := Copy(PATH,OFN.nFileExtension+1,Length(PATH));
    LB.AddString('Extension = '#9+s);
  end;
end;

ここでは、選択されたファイル名を受け取る文字列バッファとして PATH を初期化してから、TOpenFileName 型のレコード OFN を最初に全フィールドをゼロにしてから、必要なフィールドに値を代入して組み立てている。Flag フィールドに OFN_FILEMUSTEXIST を設定しているので､ 既存ファイル以外の名前を指定すると、そのことを注意するダイアログが表示される｡ また、OFN_HIDEREADONLY を設定しているので、読みとり専用のチェックボックスが表示されない｡ GetOpenFileName( ) ＡＰＩを実行して成功したら、OFN.nFileOffset と OFN.nFileExtension フィールドを利用して、ファイル名、パス、拡張子を抽出して表示している｡
OpensaveDialog01_2.gif

'Open Many' ボタンを押すと右図のようなダイアログが開き、複数のファイルを選択することができる｡ B2Click( ) ハンドラは、B1Click( ) ハンドラとほぼ同じだが、Flag に OFN_ALLOWMULTISELECT を設定して複数選択ができるようにしている｡ このとき、選択ファイルの文字列を受け取るために８００１バイトのバッファを確保している｡ 約５００個のファイル名を受け取ることができるだろう｡ このダイアログから返される文字列は､ ファイルを一つしか選択しなかったときは、B1Click( ) のときと同じであるが、複数のファイルを選択したときは、パス+’’+ファィル名１+' '+ファイル名２+' '+...+ファイル名ｎ+#0#0 というふうに空白で区切られている。そこでヘルパ関数 GetMultFileName( ) を使って、複数のファイル名を TStringArray クラスのインスタンスを介して受け取っている｡ この場合も､ nFileOffset フィールドは正しい値を返すのでこれを使ってパスを取得できる｡
Opensavedialog01_3.gif

'Open Many Ex' ボタンを押すと右図のようなダイアログが開き、やはり複数のファイルを選択することができる｡ B3Click( ) ハンドラは、B2Click( ) ハンドラとほぼ同じだが、Flag に OFN_EXPLORER を設定しているため外観が異なる｡ この場合、複数選択したときに受け取る文字列は、空白区切りではなく、#0 で区切られているため文字列の終端と区別がつかないため､ すぐに string 型の変数に変換できない。ここでは、以下のコードで #0 を空白に変更してから、B2Click( ) と同じ処理をしている｡

    flag := true;
    i := 0;
    while flag do begin
      if PATH[i] = #0 then
        if PATH[i+1] = #0 then flag := false else PATH[i] := ' ';
      inc(i);
    end;

二番目の if 文では、#0#0 の終端を検出している｡

右端の 'Save' ボタンを押すと「ファイル名を付けて保存」のダイアログが開き、任意のディレクトリに任意の名前で保存できるファイル名を取得できる。Flag に OFN_OVERWRITEPROMPT を設定しているので、既存ファイルと同じ名前を入力すると上書きの確認のダイアログが表示される｡ 「はい」を押すとそのままの名前が返る｡ 「いいえ」を押すと、もう一度ファイル名を入力する機会が与えられる｡

redball.gifこの章の目次へ戻る

１８−２ コモンダイアログのカプセル化

前節で試したファイル名の取得・設定のコモンダイアログ関数をカプセル化して使いやすくしよう｡ ＶＣＬでは、これらはコンポーネントになっているが、コードベースのプログラミングでは、これらの機能をカプセル化したクラスを作成すると、使用する前後でインスタンスの生成と廃棄を行わなくてはならなくなり面倒である｡ したがって、関数としてカプセル化しよう｡ そうすれば、いつでも呼び出すだけで使用できる。

  1. エクスプローラを使って、新しいフォルダを 1802OpenSaveDialog02 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1801OpenSaveDialog01 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで OpenSaveDialog02.dpr という名前で保存する｡
  5. [表示]メニューから[ユニット]を選んで表示されるダイアログから、UtilClass を選ぶ。
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する｡

最初に、UtilClass.pas に関数を実装する。uses 節に Cmmdlg を追加する。次に､ 選択されたファイル名の授受の際に便利なように、新しいレコードを定義する｡ Global Types, Constants and Variables の部分に以下の定義を追加する｡

type
TOpenSave = record
  FullName:string;
  FileName:string;
  Path:string;
  Ext:string;
end;

そして、宣言部の DisplayLogFont( ) 手続きの下に、以下の宣言を追加する｡

function GetOpenFile(hOwner:HWND;defName,Filter,initDir:string;
                     var FLN:TOpenSave):Boolean;

function GetSaveFile(hOwner:HWND;defName,Filter,initDir:string;
                     var FLN:TOpenSave):Boolean;

function GetOpenFileMult(hOwner:HWND;defName,Filter,initDir:string;
                         STL:TStringArray;var NumFile:integer):Boolean;

そして、実装部の対応する部分に以下のコードを追加する。

function GetOpenFile(hOwner:HWND;defName,Filter,initDir:string;
                     var FLN:TOpenSave):Boolean;
var
  OFN: TOpenFileName;
  PATH: string;
begin
  PATH := defName+#0;
  SetLength(PATH,MAX_PATH+5);
  FillChar(OFN,SizeOf(OFN),0);
  with OFN do begin
    lStructSize := 76; // for Delphi6
    hWndOwner := hOwner;
    lpstrFilter := PChar(Filter);
    nFilterIndex := 1;
    lpstrFile := PChar(PATH);
    nMaxFile:= MAX_PATH+5;
    lpstrInitialDir := PChar(initDir);
    Flags := OFN_FILEMUSTEXIST or OFN_HIDEREADONLY;
  end;

  result := Boolean(GetOpenFileName(OFN));
  if result then begin
    FLN.FullName := (OFN.lpstrFile);
    FLN.Path := Copy(PATH,0,OFN.nFileOffset);
    FLN.FileName := Copy(PATH,OFN.nFileOffset+1,Length(PATH));
    FLN.Ext := Copy(PATH,OFN.nFileExtension+1,Length(PATH));
  end;
end;

function GetSaveFile(hOwner:HWND;defName,Filter,initDir:string;
                     var FLN:TOpenSave):Boolean;
var
  OFN: TOpenFileName;
  PATH: string;
begin
  PATH := defName+#0;
  SetLength(PATH,MAX_PATH+5);
  FillChar(OFN,SizeOf(OFN),0);
  with OFN do begin
    lStructSize := 76; // for Delphi6
    hWndOwner := hOwner;
    lpstrFilter := PChar(Filter);
    nFilterIndex := 1;
    lpstrFile := PChar(PATH);
    nMaxFile:= MAX_PATH+5;
    lpstrInitialDir := PChar(initDir);
    Flags := OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY;
  end;

  result := Boolean(GetSaveFileName(OFN));
  if result then begin
    FLN.FullName := (OFN.lpstrFile);
    FLN.Path := Copy(PATH,0,OFN.nFileOffset);
    FLN.FileName := Copy(PATH,OFN.nFileOffset+1,Length(PATH));
    FLN.Ext := Copy(PATH,OFN.nFileExtension+1,Length(PATH));
  end;
end;

function CountSpace(s: string):integer;
var
  i: integer;
begin
  result := 0;
  for i := 1 to Length(s) do
    if s[i] = ' ' then inc(result);
end;

function GetMultFileName(s:string;SL:TStringArray):integer;
var
  IC,i: integer;
  IL: TIntegerList;
begin
  SL.Clear;
  IC := CountSpace(s);
  if IC = 0 then begin
    SL.Add(AExtractDir(s)+'\');
    SL.Add(AExtractFileName(s));
    result := 1;
  end else begin
    IL := TIntegerList.Create(IC*SizeOf(integer),SizeOf(integer));
    for i := 1 to Length(s) do
      if s[i] = ' ' then IL.Add(i);
    SL.Add(Copy(s,1,IL[0]-1));
    if Copy(SL[0],Length(SL[0]),1)<>'\' then
      SL[0]:=SL[0]+'\';
    for i := 1 to IC-1 do
      SL.Add(Copy(s,IL[i-1]+1,IL[i]-IL[i-1]-1));
    SL.Add(Copy(s,IL[IC-1]+1,100));
    IL.Free;
    result := IC;
  end;
end;

function GetOpenFileMult(hOwner:HWND;defName,Filter,initDir:string;
                         STL:TStringArray;var NumFile:integer):Boolean;
var
  OFN: TOpenFileName;
  s: string;
  PATH: array[0..8000] of Char;
  i: integer;
  flag: Boolean;
begin
  FillChar(PATH,8001,0);
  for i := 0 to Length(defName)-1 do PATH[i] := defName[i+1];
  FillChar(OFN,SizeOf(OFN),0);
  with OFN do begin
    lStructSize := 76; // for Delphi6
    hWndOwner := hOwner;
    lpstrFilter := PChar(Filter);
    nFilterIndex := 1;
    lpstrFile := @PATH;
    nMaxFile:= 8000;
    lpstrInitialDir := PChar(initDir);
    Flags := OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or
             OFN_ALLOWMULTISELECT or OFN_EXPLORER;
  end;

  result := Boolean(GetOpenFileName(OFN));
  if result then begin
    flag := true;
    i := 0;
    while flag do begin
      if PATH[i] = #0 then
        if PATH[i+1] = #0 then flag := false else PATH[i] := ' ';
      inc(i);
    end;
    SetString(s,PChar(@PATH),lstrlen(@PATH));
    NumFile := GetMultFileName(s,STL);
  end;
end;

以上で、カプセル化した関数の実装ができたので、プロジェクトファイルにテストプログラムを書こう。以下に全リストを示す｡ 

program OpenSaveDialog02;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  B1,B2,B3: TAPIButton;
  LB: TAPIListBox;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure B1Click(var Msg: TMessage);
var
  OSFN: TOpenSave;
  Flt:string;
begin
  Flt := 'すべて (*.*)'#0+'*.*'#0+
         'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
         'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0#0;
  if GetOpenFile(MainWnd.Handle,'Default.pas',Flt,'C:\',OSFN) then begin
    LB.Clear;
    LB.AddString(OSFN.FullName);
    LB.AddString('');
    LB.AddString(OSFN.Path);
    LB.AddString(OSFN.FileName);
    LB.AddString(OSFN.Ext);
  end else LB.Clear;
end;

procedure B2Click(var Msg: TMessage);
var
  NoFile,i: integer;
  Flt:string;
  SA: TStringArray;
begin
  Flt := 'すべて (*.*)'#0+'*.*'#0+
         'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
         'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0#0;
  SA := TStringArray.Create;
  if GetOpenFileMult(MainWnd.Handle,'def.qqq',Flt,'C:\',
                     SA,NoFile) then begin
    LB.Clear;
    LB.AddString('No. of Selected File = '+AIntToStr(NoFile));
    LB.AddString('');
    LB.AddString(SA[0]);
    LB.AddString('');
    for i := 1 to NoFile do
      LB.AddString(SA[i]);
  end else LB.Clear;
  SA.Free;
end;

procedure B3Click(var Msg: TMessage);
var
  OSFN: TOpenSave;
  Flt:string;
begin
  Flt := 'すべて (*.*)'#0+'*.*'#0+
         'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
         'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0#0;
  if GetSaveFile(MainWnd.Handle,'Default.pas',Flt,'C:\',OSFN) then begin
    LB.Clear;
    LB.AddString(OSFN.FullName);
    LB.AddString('');
    LB.AddString(OSFN.Path);
    LB.AddString(OSFN.FileName);
    LB.AddString(OSFN.Ext);
  end else LB.Clear;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  B1 := CreateButton(hWindow,10,10,130,30,'Open One',B1Click);
  B2 := CreateButton(hWindow,150,10,130,30,'Open Many EX',B2Click);
  B3 := CreateButton(hWindow,290,10,130,30,'Save',B3Click);
  LB := CreateListBox(hWindow,10,50,580,240,nil);

  with MainWnd do begin
    ClientWidth := 600;
    ClientHeight := 300;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifOpenSaveDialog02.zip(17.430kB)
OpenSaveDialog02.gif

これで完成である｡ 右に実行時の様子を示す｡ 三つのボタンを押すと、前節の対応するボタンと同じように動作するのが分かるだろう｡

redball.gifこの章の目次へ戻る

１８−３ ファイルのコピー・移動・削除

ファイル操作・管理に関連するＡＰＩのうち、特定のディレクトリのファイルの一覧を取得したり、ファイルのサイズなどの属性を調べたりするＡＰＩについては、９−３ ファイルの列挙 のところですでに紹介した｡ また、システムに存在するドライブの一覧を取得したり、その各々の属性を調べるＡＰＩについては、１３−３ ドライブコンボボックス のところで説明した｡ ここでは、Delphi の パスカル言語で直接サポートしていない、ファイルのコピー・移動・削除などの機能を実現するＡＰＩについて調べよう｡

Windows.pas には、ファイルのコピー・移動・削除に関するＡＰＩとして以下の関数が宣言されている｡

function CopyFile(lpExistingFileName, 
                       lpNewFileName: PChar; 
                       bFailIfExists: BOOL): BOOL; stdcall;
                       
function MoveFile(lpExistingFileName, 
                       lpNewFileName: PChar): BOOL; stdcall;
                       
function DeleteFile(lpFileName: PChar): BOOL; stdcall;

これらは、今でも十分使える便利な関数である｡ ここでは、エクスプローラを使って操作したときと同じ機能を実現する、ShellAPI.pas に宣言されている SHFileOperation( ) 関数を使うことにしよう｡

function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall;

この関数の唯一のパラメータである TSHFileOpStruct レコード型は以下のようなものだ｡

  PSHFileOpStruct = PSHFileOpStructA;
  TSHFileOpStructA = packed record
    Wnd: HWND;                  //表示されるダイアログのおやウィンドウのハンドル
    wFunc: UINT;                //操作機能を示すフラグ（以下に説明）
    pFrom: PAnsiChar;           //元のファイル名
    pTo: PAnsiChar;             //先のファイル名
    fFlags: FILEOP_FLAGS;       //以下に説明
    fAnyOperationsAborted: BOOL;//操作中止で true になるフラグ
    hNameMappings: Pointer;     //名前付きマッピングオブジェクトへのハンドル
    lpszProgressTitle: PAnsiChar; { only used if FOF_SIMPLEPROGRESS }
  end;
  TSHFileOpStruct = TSHFileOpStructA;

このうち、wFunc フィールドには以下のうちの一つを設定して、ファイル操作を決定する｡

const
  FO_MOVE           = $0001;  //移動
  FO_COPY           = $0002;  //コピー
  FO_DELETE         = $0003;  //削除
  FO_RENAME         = $0004;  //名前変更

pFrom フィールドには、移動元の、あるいはコピーもとの、削除する、名称変更するファイル名をフルパスで指定する。文字列は #0#0 で終了しなければならない｡ 複数のファイルを指定するときは #0 で区切る。
pTo フィールドは、移動先の、あるいはコピー先の、名前変更後のファイル名を設定する。削除のときは nil にしておく｡ pForm と同じように、この文字列は #0#0 で終了しなければならない｡ 複数のファイルを指定するときは #0 で区切る。移動やコピーで存在しないディレクトリを設定すると、その事を確認するダイアログボックスが表示されてユーザに確認させ、ディレクトリを新たに作ることもできる｡

fFlags フィールドには以下の定数の組み合わせを設定する。

const
  FOF_MULTIDESTFILES         = $0001;  //pTo に複数設定するときに指定
  FOF_CONFIRMMOUSE           = $0002;  //設定不可
  FOF_SILENT                 = $0004;  //プログレスダイアログを表示しない
  FOF_RENAMEONCOLLISION      = $0008;  //既存ファイル名との衝突のとき新しい名前にする
  FOF_NOCONFIRMATION         = $0010;  //表示されるダイアログに「すべてはい」と自動的に答える
  FOF_WANTMAPPINGHANDLE      = $0020;  { Fill in SHFILEOPSTRUCT.hNameMappings
                                         Must be freed using SHFreeNameMappings }
  FOF_ALLOWUNDO              = $0040;  //「元に戻す」を有効にする
  FOF_FILESONLY              = $0080;  //ワイルドカード *.* ではファイルのみに操作を限定
  FOF_SIMPLEPROGRESS         = $0100;  //プログレスダイアログにファイル名を表示しない
  FOF_NOCONFIRMMKDIR         = $0200;  //ディレクトリを作るときでも「確認」しない
  FOF_NOERRORUI              = $0400;

SHFileOperation( ) は成功するとゼロ、失敗するとゼロ以外を返す｡

SHFileOperation( ) ＡＰＩの機能を利用して、ファイルのコピー、移動、削除、名前変更を試してみよう｡

  1. エクスプローラを使って、新しいフォルダを 1803FileOperation という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1802OpenSaveDialog02 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで FileOperation.dpr という名前で保存する｡
  5. [表示]メニューから[ユニット]を選んで表示されるダイアログから、UtilClass を選ぶ。
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する｡

最初に、UtilClass.pas に SHFileOperation( ) ＡＰＩの機能を包み込んだ関数を作ろう｡ 前節で作った GetOpenFileMult( ) の宣言の下に以下の宣言を追加する｡

function SHCopyFile(hParent:HWND;NameFrom,NameTo:string):Boolean;
function SHMoveFile(hParent:HWND;NameFrom,NameTo:string):Boolean;
function SHRenameFile(hParent:HWND;NameFrom,NameTo:string):Boolean;
function SHDeleteFile(hParent:HWND;Name:string):Boolean;

そして、実装部の対応するところに以下のコードを追加する。

function SHCopyFile(hParent:HWND;NameFrom,NameTo:string):Boolean;
var
  SFO: TSHFileOpStruct;
begin
  NameFrom := NameFrom+#0#0;
  NameTo := NameTo+#0#0;
  with SFO do begin
    Wnd := hParent;
    wFunc := FO_COPY;
    pFrom := PChar(NameFrom);
    pTo := PChar(NameTo);
    fFlags := FOF_ALLOWUNDO;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
  end;
  Result := not Boolean(SHFileOperation(SFO));
end;

function SHMoveFile(hParent:HWND;NameFrom,NameTo:string):Boolean;
var
  SFO: TSHFileOpStruct;
begin
  NameFrom := NameFrom+#0#0;
  NameTo := NameTo+#0#0;
  with SFO do begin
    Wnd := hParent;
    wFunc := FO_MOVE;
    pFrom := PChar(NameFrom);
    pTo := PChar(NameTo);
    fFlags := FOF_ALLOWUNDO;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
  end;
  Result := not Boolean(SHFileOperation(SFO));
end;

function SHRenameFile(hParent:HWND;NameFrom,NameTo:string):Boolean;
var
  SFO: TSHFileOpStruct;
begin
  NameFrom := NameFrom+#0#0;
  NameTo := NameTo+#0#0;
  with SFO do begin
    Wnd := hParent;
    wFunc := FO_RENAME;
    pFrom := PChar(NameFrom);
    pTo := PChar(NameTo);
    fFlags := FOF_ALLOWUNDO;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
  end;
  Result := not Boolean(SHFileOperation(SFO));
end;

function SHDeleteFile(hParent:HWND;Name:string):Boolean;
var
  SFO: TSHFileOpStruct;
begin
  Name := Name+#0#0;
  with SFO do begin
    Wnd := hParent;
    wFunc := FO_DELETE;
    pFrom := PChar(Name);
    pTo := nil;
    fFlags := FOF_ALLOWUNDO + FOF_NOCONFIRMATION;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
  end;
  Result := not Boolean(SHFileOperation(SFO));
end;

これで、ファイルのコピー、移動、削除、名前変更のための関数ができたので、FileOperation.dpr にテストするプログラムを書こう。以下に全リストを示す｡

program FileOperation;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  LB1,LB2: TAPIListBox;
  Label1: TAPILabel;
  DD1: TAPIDragDrop;
  Btn1,Btn2: TAPIButton;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function DisplayFileList(LB: TAPIListBox; Dir: string):integer;
var
  i: integer;
  SA: TStringArray;
begin
  SA := TStringArray.Create;
  FindAllFiles(Dir,SA);
  LB.Redraw := false;
  LB.Clear;
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do LB.AddString(SA.Items[i]);
  result := SA.Count;
  LB.Redraw := true;
  SA.Free;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure DD1Drop(var Msg:TMessage);
var
  i: integer;
  NFrom,NTo:string;
begin
  for i := 0 to DD1.FileCount-1 do begin
    NFrom := DD1.Files[i];
    NTo := 'C:\Test\From\'+AExtractFileName(NFrom);
    SHCopyFile(MainWnd.Handle,NFrom,NTo);
  end;
  i := DisplayFileList(LB1,'C:\Test\From\');
  Label1.Text := 'There are '+AIntToStr(i)+
                 ' Files in C:\Test\From directory';
  DD1.SetFocus(MainWnd.Handle);
end;

procedure Btn1Click(var Msg:TMessage);
var
  i: integer;
  SA: TStringArray;
begin
  SA := TStringArray.Create;
  FindAllFiles('C:\Test\From\',SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do
      SHMoveFile(MainWnd.Handle,'C:\Test\From\'+SA[i],'C:\Test\To\'+SA[i]);
  SA.Free;
  DisplayFileList(LB1,'C:\Test\From\');
  i := DisplayFileList(LB2,'C:\Test\To\');
  Label1.Text := 'There are '+AIntToStr(i)+
                 ' Files in C:\Test\To directory';
end;

procedure LB2Click(var Msg:TMessage);
var
  NFrom,NTo,ext:string;
begin
  ext := AIntToStr(Random(899)+100);
  NFrom := 'C:\Test\To\'+LB2.SelText;
  NTo := 'C:\Test\To\'+'Renamed.'+ext;
  SHRenameFile(MainWnd.Handle,NFrom,NTo);
  DisplayFileList(LB2,'C:\Test\To\');
end;

procedure Btn2Click(var Msg:TMessage);
var
  i: integer;
  SA: TStringArray;
begin
  SA := TStringArray.Create;
  FindAllFiles('C:\Test\To\',SA);
  if SA.Count > 0 then
    try
    for i := 0 to SA.Count-1 do
      SHDeleteFile(MainWnd.Handle,'C:\Test\To\'+SA[i]);
  finally
  SA.Free;
  end;
  i := DisplayFileList(LB2,'C:\Test\To\');
  Label1.Text := 'There are '+AIntToStr(i)+
                 ' Files in C:\Test\To directory';
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  Label1 := CreateLabel(hWindow,10,10,550,30,'');
  with Label1 do begin
    DrawFrame := true;
    Margin := 5;
  end;

  LB1 := CreateListBox(hWindow,10,50,270,280,nil);
  LB2 := CreateListBox(hWindow,290,50,270,280,LB2Click);

  Btn1 := CreateButton(hWindow,10,340,100,35,'Move All',Btn1Click);
  Btn2 := CreateButton(hWindow,290,340,100,35,'Delete All',Btn2Click);

  DD1 := TAPIDragDrop.Create(LB1.Handle);
  DD1.OnDrop := DD1Drop;

  Randomize;

  with MainWnd do begin
    ClientWidth := 570;
    ClientHeight := 400;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifFileOperation.zip(19.002kB)
FileOperation.gif

実行して、以下の手順にしたがってファイル操作を試してみる。

１）ファイルのコピー
左側のリストボックスにエクスプローラから複数の適当なファイルをドロップすると、新しいフォルダの作成確認のダイアログが表示されるので、「はい」を選択する。すると、C:\Test\Form というフォルダが作成されて、その中にドロップしたファイルがコピーされる。その様子を右図に示した｡

２）ファイルの移動
左下の 'Move All' のボタンを押すと、再び新しいフォルダの作成確認のダイアログが表示されるので、「はい」を選択する。すると、C:\Test\To というフォルダが作成されて、その中に、C:\Test|From フォルダにある全てのファイルが移動する｡

３）ファイルのリネーム
右側のリストボックスに示されている C:\Test\To フォルダにあるファイル名をクリックすると Renamed.XXX というランダムな三桁の数字からなる拡張子を持ったファイルに名前が変更させられる｡

４）ファイルの削除
右下の 'Delete All' のボタンを押すと、C:\Test\To フォルダにあるすべてのファイルが削除される｡

以上の各段階を実際にエクスプローラを使って、フォルダやファイルの様子を確認してみてほしい｡ また、ファイルの削除の際には、FOF_ALLOWUNDO をフラグに設定しているので､ ゴミ箱に削除されたファイルが入っていることも確認してほしい｡

この節で作ったファイル操作の関数は、汎用性があるので多くの場面で使用できるだろう｡

redball.gifこの章の目次へ戻る

１８−４ ディレクトリ操作

ディレクトリ（フォルダ）の作成・削除には、Windows.pas に宣言されている以下のＡＰＩを使う。

function CreateDirectory(lpPathName: PChar;
               lpSecurityAttributes: PSecurityAttributes): BOOL; stdcall;

function RemoveDirectory(lpPathName: PChar): BOOL; stdcall;

作るときの CreateDirectory( ) 関数の lpSecurityAttributes パラメータは、Windows95/98 では nil を指定する｡ この関数では、既存のディレクトリの下に一層だけ新しいディレクトリを作成できる｡ RemoveDirectory( ) は、空のディレクトリだけを一層だけ削除できる｡ このように、これらの関数を使って、深いディレクトリを一度に作成したり、特定のディレクトリをサブディレクトリを含めて一度に削除するには、少し工夫がいる。この節では､ 上記の関数を使ってディレクトリの操作をするためのコードを調べよう｡

特定のディレクトリのファイルの一覧を取得する手続き FindAllFiles( ) は、９−３ ファイルの列挙 のところで UtilClass.pas に作成した｡ ここではこの手続きを見習って、特定のディレクトリのなかのディレクトリの一覧を得る手続きを以下のように作成する。

procedure FindAllDirInDir(dir:string;SL:TStringArray);
var
  s: string;
  hFind: LongInt;
  fd: TWin32FindData;
  Ret: Boolean;
begin
  s := dir + '\*.*';
  hFind := FindFirstFile(PChar(s),fd);

  Ret := true;
  while ( (hFind <> LongInt(INVALID_HANDLE_VALUE)) and Ret ) do begin
    if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then begin
      SetString(s,fd.cFileName,1);
      if s <> '.' then
        SL.Add(string(fd.cFileName));
    end;
    Ret := FindNextFile(hFind,fd);
  end;
  Windows.FindClose(hFind);
end;

これで、特定のディレクトリの中にあるディレクトリの一覧を取得できる｡ つぎに、既存のファイルやディレクトリ（ルートディレクトリ＝ドライブも）の有無を調べる関数を以下のようにして作成する。

function IsFileExist(FN: string):Boolean;
var
  fd: TWin32FindData;
  hH: THandle;
  ret: integer;
begin
  hH := FindFirstFile(PChar(FN),fd);
  if hH = INVALID_HANDLE_VALUE then begin
    ret := GetDriveType(PChar(FN+'\'));
    if (ret = DRIVE_FIXED) or (ret = DRIVE_REMOVABLE) then
      result := true
    else
      result := false;
  end else begin
    result := true;
    FindClose(hH);
  end;
end;

ここの GetDriveType( ) については､ すでに １３−３ ドライブコンボボックス のところで説明した｡ 最後に、上記のディレクトリの作成・削除のための関数をカプセル化する。まず作成のためには、以下のようにする。

function CreateDir(DN:string):Boolean;
var
  s:string;
begin
  s := AExtractDir(DN);
  if IsFileExist(s) then
    result := Boolean(CreateDirectory(PChar(DN),nil))
  else
    if CreateDir(s) then
      result := Boolean(CreateDirectory(PChar(DN),nil))
    else
      result := false;
end;

この関数を使えば、二層以上の深いディレクトリも一度に作成できる｡ コードを見てみよう｡ 最初に、作成しようとするディレクトリの親ディレクトリを AExtractDir( ) で取得し、既存かどうか調べる｡ 既存の場合は､ 単に指定のディレクトリを作成する。既存でないときは、自分自身を呼び出して作成を依頼する。このように、一つ上のディレクトリを見ながらディレクトリを作成していく関数を再帰的に呼び出して、深い階層のディレクトリを一度に作成するわけである｡ このアルゴリズムを利用して､ 深い階層をもつディレクトリを一度に削除する関数を以下のように作ることができる｡

function RemoveDirAll(DN:string):Boolean;
var
  i: integer;
  SA: TStringArray;
begin
  SA := TStringArray.Create;
  FindAllFiles(DN+'\',SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do SHDeleteFile(DN+'\'+SA[i]);
  SA.Clear;

  FindAllDirInDir(DN,SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do RemoveDirAll(DN+'\'+SA[i]);
  result := Boolean(RemoveDirectory(PChar(DN)));
  SA.Free;
end;

RemoveDirAll( ) 関数では､ 最初に、指定されたディレクトリの中にあるファイルの一覧を取得し、全て削除する｡ 次に、ディレクトリの一覧を取得して、自分自身を呼び出して全て削除する。最後に空になった指定ディレクトリを削除する。ここでは、一つ下のディレクトリを削除してから指定ディレクトリを削除する関数を再帰的に呼び出しているわけである｡ さらに、このアルゴリズムを利用して、指定ディレクトリの下にある全てのファイルの一覧を取得する手続きを以下のように作ることができる｡

procedure FindAllFilesWithSubdir(DN:string;SL:TStringArray);
var
  i,j: integer;
  SA,SB: TStringArray;
begin
  SA := TStringArray.Create;
  FindAllFiles(DN+'\',SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do SL.Add(DN+'\'+SA[i]);

  SA.Clear;
  SB := TStringArray.Create;
  FindAllDirInDir(DN,SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do begin
      FindAllFilesWithSubdir(DN+'\'+SA[i],SB);
      if SB.Count > 0 then
        for j := 0 to SB.Count-1 do SL.Add(SB[j]);
      SB.Clear;
    end;
  SA.Free;
  SB.Free;
end;

ここでは、指定ディレクトリのファイル一覧を取得し、さらに一つ下のディレクトリの中のファイル一覧を取得するために、自分自身を呼び出している｡

これらの関数をテストしてみよう｡

  1. エクスプローラを使って、新しいフォルダを 1804DirOperation という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1803FileOperation フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで DirOperation.dpr という名前で保存する｡
  5. [表示]メニューから[ユニット]を選んで表示されるダイアログから、UtilClass を選ぶ。
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する｡

最初に、UtilClass.pas に上記の関数を作成する｡ 宣言部の SHDeleteFile( ) の下に以下の宣言を追加する。

procedure FindAllDirInDir(dir:string;SL:TStringArray);
function IsFileExist(FN: string):Boolean;
function CreateDir(DN:string):Boolean;
function RemoveDirAll(DN:string):Boolean;
procedure FindAllFilesWithSubdir(DN:string;SL:TStringArray);

そして、実装部の対応する場所に以下のコードを追加する。

procedure FindAllDirInDir(dir:string;SL:TStringArray);
var
  s: string;
  hFind: LongInt;
  fd: TWin32FindData;
  Ret: Boolean;
begin
  s := dir + '\*.*';
  hFind := FindFirstFile(PChar(s),fd);

  Ret := true;
  while ( (hFind <> LongInt(INVALID_HANDLE_VALUE)) and Ret ) do begin
    if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then begin
      SetString(s,fd.cFileName,1);
      if s <> '.' then
        SL.Add(string(fd.cFileName));
    end;
    Ret := FindNextFile(hFind,fd);
  end;
  Windows.FindClose(hFind);
end;

function IsFileExist(FN: string):Boolean;
var
  fd: TWin32FindData;
  hH: THandle;
  ret: integer;
begin
  hH := FindFirstFile(PChar(FN),fd);
  if hH = INVALID_HANDLE_VALUE then begin
    ret := GetDriveType(PChar(FN+'\'));
    if (ret = DRIVE_FIXED) or (ret = DRIVE_REMOVABLE) then
      result := true
    else
      result := false;
  end else begin
    result := true;
    FindClose(hH);
  end;
end;

function CreateDir(DN:string):Boolean;
var
  s:string;
begin
  s := AExtractDir(DN);
  if IsFileExist(s) then
    result := Boolean(CreateDirectory(PChar(DN),nil))
  else
    if CreateDir(s) then
      result := Boolean(CreateDirectory(PChar(DN),nil))
    else
      result := false;
end;

function RemoveDirAll(DN:string):Boolean;
var
  i: integer;
  SA: TStringArray;
begin
  SA := TStringArray.Create;
  FindAllFiles(DN+'\',SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do SHDeleteFile(0,DN+'\'+SA[i]);
  SA.Clear;

  FindAllDirInDir(DN,SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do RemoveDirAll(DN+'\'+SA[i]);
  result := Boolean(RemoveDirectory(PChar(DN)));
  SA.Free;
end;

procedure FindAllFilesWithSubdir(DN:string;SL:TStringArray);
var
  i,j: integer;
  SA,SB: TStringArray;
begin
  SA := TStringArray.Create;
  FindAllFiles(DN+'\',SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do SL.Add(DN+'\'+SA[i]);

  SA.Clear;
  SB := TStringArray.Create;
  FindAllDirInDir(DN,SA);
  if SA.Count > 0 then
    for i := 0 to SA.Count-1 do begin
      FindAllFilesWithSubdir(DN+'\'+SA[i],SB);
      if SB.Count > 0 then
        for j := 0 to SB.Count-1 do SL.Add(SB[j]);
      SB.Clear;
    end;
  SA.Free;
  SB.Free;
end;

これでディレクトリを操作する関数ができたので DirOperation.dpr にテストするプログラムを書こう｡ 以下に、全リストを示す｡

program DirOperation;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  LB1: TAPIListBox;
  DD1: TAPIDragDrop;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function DisplayFileList(LB: TAPIListBox; Dir: string):integer;
var
  SA:TStringArray;
  i:integer;
begin
  LB.Clear;
  SA := TStringArray.Create;
  FindAllFilesWithSubdir(Dir,SA);
  if SA.Count > 0 then begin
    LB.Redraw := false;
    for i := 0 to SA.Count-1 do LB1.AddString(SA[i]);
    LB.Redraw := true;
  end;
  result := SA.Count;
  SA.Free;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure DD1Drop(var Msg:TMessage);
var
  i: integer;
  NFrom,NTo:string;
begin
  if DD1.FileCount < 6 then begin
    MessageBox(MainWnd.Handle,'６つ以上ドロップしてください',
               '注意',MB_OK);
    exit;
  end;
  if CreateDir('c:\Test\TST1\TST2\TST3') then begin
    for i := 0 to 1 do begin
      NFrom := DD1.Files[i];
      NTo := 'C:\Test\TST1\'+AExtractFileName(DD1.Files[i]);
      SHCopyFile(MainWnd.Handle,NFrom,NTo);
    end;
    for i := 2 to 3 do begin
      NFrom := DD1.Files[i];
      NTo := 'C:\Test\TST1\TST2\'+AExtractFileName(DD1.Files[i]);
      SHCopyFile(MainWnd.Handle,NFrom,NTo);
    end;
    for i := 4 to DD1.FileCount-1 do begin
      NFrom := DD1.Files[i];
      NTo := 'C:\Test\TST1\TST2\TST3\'+AExtractFileName(DD1.Files[i]);
      SHCopyFile(MainWnd.Handle,NFrom,NTo);
    end;
    DisplayFileList(LB1,'c:\Test');
  end;
  DD1.SetFocus(MainWnd.Handle);
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  LB1 := CreateListBox(hWindow,10,10,580,280,nil);

  DD1 := TAPIDragDrop.Create(LB1.Handle);
  DD1.OnDrop := DD1Drop;

  with MainWnd do begin
    ClientWidth := 600;
    ClientHeight := 300;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  RemoveDirAll('c:\Test\TST1');
  DisplayFileList(LB1,'c:\Test');
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifDirOperation.zip(17.623kB)
DirOperation.gif

実行して、リストボックスの上にエクスプローラから６個以上の数の任意のファイルをドロップする。そのときの様子を上図に示した｡ 'C:\Test\TST1\TST2\TST3' という新しいディレクトリが作られて、各ディレクトリにドロップしたファイルが複数個コピーされている。Test! メニューをクリックすると 'C:\Test\TST1' 以下のファイルとディレクトリが全て消去される｡

【 追記 】 2001/02/15

某ＢＢＳでのやりとりで、サブディレクトリを含めたディレクトリのコピーや削除を SHFileOperation( ) でできることを知りました｡ 以下に、そのとき作った関数を示します。

サブディレクトリを含むディレクトリをファイルごと一括コピーするには、以下の関数を使う｡

function SHCopyDir(hParent:HWND;NameFrom,NameTo:string):Boolean;
var
  SFO: TSHFileOpStruct;
begin
  NameFrom := NameFrom+#0#0;
  NameTo := NameTo+#0#0;
  with SFO do begin
    Wnd := hParent;
    wFunc := FO_COPY;
    pFrom := PChar(NameFrom);
    pTo := PChar(NameTo);
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
  end;
  Result := not Boolean(SHFileOperation(SFO));
end;

例えば、c:\abc ディレクトリ以下を一括して d:\xyz の下にコピーし、d:\xyz\abc とするには、

  SHCopyDir(Handle,'c:\abc','d:\xyz');

のようにする。

また、サブディレクトリを含むすべてのファイルを削除して、ディレクトリを削除するには、以下の関数を使う。

function SHDeleteDir(hParent:HWND;Name:string):Boolean;
var
  SFO: TSHFileOpStruct;
begin
  Name := Name+#0#0;
  with SFO do begin
    Wnd := hParent;
    wFunc := FO_DELETE;
    pFrom := PChar(Name);
    pTo := nil;
    fFlags := FOF_ALLOWUNDO + FOF_NOCONFIRMATION;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
  end;
  Result := not Boolean(SHFileOperation(SFO));
end;

これらの関数を UtilClass.pas に追加しておきます。

redball.gifこの章の目次へ戻る

１８−５ ファイルアクセス

前節までで、特定ファイルの名前を取得したり、ファイルのコピー、移動、削除、名前変更をしたり、任意の深さのディレクトリを作成したり、削除したりできるようになった。本節からは、いよいよファイルの「中身」にアクセスする方法を簡単に探求しよう｡ ファイルをアクセスするには

    function CreateFile(lpFileName: PChar; 
                   dwDesiredAccess, 
                       dwShareMode: Integer;
              lpSecurityAttributes: PSecurityAttributes;
             dwCreationDisposition, 
              dwFlagsAndAttributes: DWORD;
                     hTemplateFile: THandle): THandle; stdcall;

を使う。CreateFile( ) は、ファイルだけでなく、パイプやコミニュケーションポートやコンソールなどのアクセスにも使われるが、ここではディスクファイルのみを対象とする。名前と違って、既存のファイルへのアクセスにもこの関数を使う｡ パラメータは、以下のとおり。

・lpFileName  ファイルの名前

・dwDesiredAccess アクセス方法の指定
   0                          // アクセスせずにデバイス属性だけ取得
   GENERIC_READ  = $80000000; // 読み込み可 
   GENERIC_WRITE = $40000000; // 書き込み可

・dwShareMode  共有方法の指定
   0                             //共有不可
   FILE_SHARE_READ  = $00000001; // 読み込みなら可
   FILE_SHARE_WRITE = $00000002; // 書き込み可

・lpSecurityAttributes セキュリティ属性の指定｡ Win95 では nil に設定する。

・dwCreationDisposition 生成アクションの指定
    CREATE_NEW = 1;       // 新しく作成。既存の場合は失敗。
    CREATE_ALWAYS = 2;    // 新しく作成。既存の場合は上書き。
    OPEN_EXISTING = 3;    // 既存ファイルのオープン。なければ失敗。
    OPEN_ALWAYS = 4;      // 既存ファイルのオープン。なければ作成。
    TRUNCATE_EXISTING = 5;// 既存ファイルを完全に書き換える。

・dwFlagsAndAttributes  ファイル属性とフラグ

  FILE_ATTRIBUTE_READONLY = $00000001; //読み込み専用
  FILE_ATTRIBUTE_HIDDEN   = $00000002; //隠しファイル
  FILE_ATTRIBUTE_SYSTEM   = $00000004; //システムファイル
  FILE_ATTRIBUTE_ARCHIVE  = $00000020; //アーカイブファイル
  FILE_ATTRIBUTE_NORMAL   = $00000080; //他の属性は使用しない
  FILE_ATTRIBUTE_TEMPORARY= $00000100; //一時ファイル

  FILE_FLAG_WRITE_THROUGH = $80000000; //キャッシュを使用しないで書き込み
  FILE_FLAG_OVERLAPPED = $40000000;    //オーバラップ動作
  FILE_FLAG_NO_BUFFERING = $20000000;  //バッファとキャッシュを使用しない
  FILE_FLAG_RANDOM_ACCESS = $10000000; //ランダムアクセスする 
  FILE_FLAG_SEQUENTIAL_SCAN = $8000000;//シークエンシャルアクセスする
  FILE_FLAG_DELETE_ON_CLOSE = $4000000;//ハンドルクローズと同時にメモリから消去
  FILE_FLAG_BACKUP_SEMANTICS = $2000000;// WindowsNT のみ
  FILE_FLAG_POSIX_SEMANTICS = $1000000; // POSIXルールでアクセスする

・hTemplateFile  作成されるファイルのテンプレートファイルにアクセスするハンドルを指定

【戻り値】 成功したらファイルハンドル、失敗なら INVALID_HANDLE_VALUE ( -1 )。

ファイルハンドルが手に入ったら、読み書きができるようになる。最初に、読み書きアクセスする前に､ 他の実行プロセスからのアクセスを制限するために、ファイルをロックする。

      function LockFile(hFile: THandle; 
                       dwFileOffsetLow, 
                      dwFileOffsetHigh: DWORD;
               nNumberOfBytesToLockLow, 
              nNumberOfBytesToLockHigh: DWORD): BOOL; stdcall;

hFile には、ロックするファイルのハンドルを設定する。dwFileOffsetLow と dwFileOffsetHigh にはロックする領域の開始オフセットの下位、上位３２ビット値を、nNumberOfBytesToLockLow と umberOfBytesToLockHigh にはロックするバイト数の下位、上位３２ビット値を設定する。ファイルハンドルから、そのファイルのサイズを取得するには、

    function GetFileSize(hFile: THandle; 
                lpFileSizeHigh: Pointer): DWORD; stdcall;

を使う。hFile には、サイズを取得するファイルのハンドルを設定する｡ lpFileSizeHigh には、４ギガバイト以上のファイルにアクセスするときの６４ビット値の上位３２ビット値を受け取るポインタを設定する。 戻り値は、ファイルのバイトサイズである。失敗すると -1 を返す。したがって、ファイル全体をロックするためには、

    LockFile(hF,0,0,GetFileSize(hF,nil),0);

とすればよい。ファイルをロックしたら、読み書きができるようになる｡ 読み書きするためには、読み書き開始場所を指定しなければならない｡ それには、「ファイルポインタ」を移動（シーク）しなければならない｡

  function SetFilePointer(hFile: THandle; 
                lDistanceToMove: Longint;
           lpDistanceToMoveHigh: Pointer; 
                   dwMoveMethod: DWORD): DWORD; stdcall;

・hFile   GENERIC_READ か GENERIC_WRITE を指定してオープンされたファイルハンドル。

・lDistanceToMove   移動するバイト数。正で前進、負で後退。

・lDistanceToMove   ４Ｇバイト以上の移動距離を指定するとき、64ビット値の上位32ビットへの
                    ポインタを指定する。４Ｇバイト以下なら nil を指定する｡

・dwMoveMethod   移動開始点の指定。以下から一つ

  FILE_BEGIN = 0;   // 先頭
  FILE_CURRENT = 1; // 現在の位置
  FILE_END = 2;     // EOF値（終端）

【戻り値】 成功したら、更新後のファイルポインタの下位３２ビット。失敗は -1 。

ファイルポインタを初期化したのち、ファイルを読み込むには、

  function ReadFile(hFile: THandle; 
                var Buffer; 
     nNumberOfBytesToRead: DWORD;
  var lpNumberOfBytesRead: DWORD; 
             lpOverlapped: POverlapped): BOOL; stdcall; 

・hFile		読み込むファイルのハンドル。

・Buffer		読み込んだデータを格納するバッファ。

・nNumberOfBytesToRead	読み込むバイト数。

・lpNumberOfBytesRead	 実際に読み込んだバイト数。

・lpOverlapped	FILE_FLAG_OVERLAPPED フラグを指定してオープンしたファイルの
          ときだけ TOverlapped レコードへのポインタを指定する｡ このフラグを指定
          しないでオープンされたファイルを読み込むと､ そのバイト数だけファイルポ
          インタが自動的に移動する｡ 通常は、このフラグを指定しないのでこのパラメ
          ータに nil を指定する｡

を使って Buffer に読み込む。書き込みには、

function WriteFile(hFile: THandle; 
                       const Buffer; 
       nNumberOfBytesToWrite: DWORD;
  var lpNumberOfBytesWritten: DWORD; 
                lpOverlapped: POverlapped): BOOL; stdcall;

・Buffer	データを書き込むバッファ。

  これ以外のパラメータは、ReadFile( ) と同様である。

を使う。ファイルを使い終わったら、アンロックする。

 
     function UnlockFile(hFile: THandle; 
               dwFileOffsetLow, 
              dwFileOffsetHigh: DWORD;
     nNumberOfBytesToUnlockLow, 
    nNumberOfBytesToUnlockHigh: DWORD): BOOL; stdcall;

この関数のパラメータは LockFile( ) と同様である。そして、ファイルハンドルを開放する。

     function CloseHandle(hObject: THandle): BOOL; stdcall;

これでファイルのアクセスは終わりである｡ 少しややこしいが一連のシークエンスをまとめると

     CreateFile( )
     GetFileSize( )
     LockFile( )
     ............
     SetFilePointer( )
     ReadFile( )
     WriteFile( )
     ............
     UnlockFile( )
     CloseHandle( )

となる。この章の冒頭で挙げたパスカルの関数を使うより､ これらの関数は、その名前と動作が一致しているので憶えやすいだろう｡

以上のファイルアクセス関数を使ってみよう。最初は、テキストファイルを扱おう｡ １２−４ TAPIMemo クラス において、このクラスのテキストファイルの読み書きをするメソッドには、以下のようなパスカルの関数を使って行っていた｡

procedure TAPIMemo.LoadText(filename:string);
var
  F: file;
  Size,NumRead: Integer;
  P: PChar;
  s:string;
begin
  AssignFile(F,filename);
  Reset(F,1);
  try
    Size := FileSize(F);
    GetMem(P, Size);
    try
      BlockRead(F, P^, Size,NumRead);
    finally
      s := string(p);
      SetLength(s,NumRead);
      Text := s;
      FreeMem(P);
    end;
  finally
    CloseFile(F);
  end;
end;

procedure TAPIMemo.SaveText(filename:string);
var
  f: TextFile;
  Buf: array[0..$1FFF] of Char;
begin
  AssignFile(f,filename);
    SetTextBuf(f,Buf);
    ReWrite(f);
    write(f,Text);
    Flush(f);
  CloseFile(f);
end;

ここでは、本章と前章であつかったＡＰＩを使って、同等の機能を実現してみよう｡

  1. エクスプローラを使って、新しいフォルダを 1805TextFile という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1804DirOperation フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで TextFile.dpr という名前で保存する｡
  5. コードエディタで以下のように編集する｡
  6. [F.9]でコンパイルして実行する｡

以下に、TextFile.dpr の全リストを示す｡

program TextFile;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  MM: TAPIMemo;
  DD: TAPIDragDrop;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainSize(var Msg:TMessage);
begin
  MM.Width := Msg.LParamLo;
  MM.Height := Msg.LParamHi;
end;

procedure DDDrop(var Msg:TMessage);
var
  hF: THandle;
  Size,NumRead: DWORD;
  P: PChar;
begin
  hF := CreateFile(PChar(DD.Files[0]),GENERIC_READ,
                   0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  Size := Windows.GetFileSize(hF,nil);
  if LockFile(hF,0,0,Size,0) then begin
    P := HeapAlloc(GetProcessHeap,0,Size+1);
    ZeroMemory(P,Size+1);
    SetFilePointer(hF,0,nil,FILE_BEGIN);
    ReadFile(hF,P^,Size,NumRead,nil);
    SendMessage(MM.Handle,WM_SETTEXT,0,integer(P));
    UnLockFile(hF,0,0,Size,0);
    CloseHandle(hF);
    HeapFree(GetProcessHeap,0,P);
  end;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  MM := CreateMemo(hWindow,0,0,0,0);
  DD := TAPIDragDrop.Create(hWindow);
  DD.OnDrop := DDDrop;

  with MainWnd do begin
    ClientWidth := 500;
    ClientHeight := 350;
    Center;
    Trap(WM_SIZE,MainSize);
  end;
end;

procedure OnTest(hWindow: HWND);
var
  OSFN: TOpenSave;
  Flt:string;
  hF:THandle;
  Size,NumWrite:DWORD;
  s: string;
begin
  Flt := 'すべて(*.*)'#0+'*.*'#0+
         'ﾃｷｽﾄ(*.txt)'#0+'*.txt'#0#0;
  if GetSaveFile(MainWnd.Handle,'TestText.txt',
                 Flt,'C:\',OSFN) then begin
    hF := CreateFile(PChar(OSFN.FullName),GENERIC_WRITE,0,
                     nil,CREATE_NEW,FILE_ATTRIBUTE_NORMAL,0);
    SetFilePointer(hF,0,nil,FILE_BEGIN);
    Size := MM.TextLength;
    s := MM.Text;
    WriteFile(hF,PChar(s)^,Size,NumWrite,nil);
    CloseHandle(hF);
  end else MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifTextFile.zip(16.342kB)
TextFile.gif

実行するとクライアント領域全体にメモコントロールが作られる。エクスプローラから任意のテキストファイルをドロップするとその内容がメモに示される｡ このときの様子を上図に示した｡ メモのテキストを適当に編集してから、Test! メニューを選ぶと、「ファイル名を付けて保存」のダイアログが表示される。適当なディレクトリに適当な名前をつけて「保存」ボタンを押すと、新しいテキストファイルがディスクに作られる｡ エディタなどに読み込んで、編集したところを確認できる｡

コードを見てみよう。ファイル名をドロップすると DDDrop( ) ハンドラが呼び出される。

procedure DDDrop(var Msg:TMessage);
var
  hF: THandle;
  Size,NumRead: DWORD;
  P: PChar;
begin
  hF := CreateFile(PChar(DD.Files[0]),GENERIC_READ,
                   0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  Size := Windows.GetFileSize(hF,nil);
  if LockFile(hF,0,0,Size,0) then begin
    P := HeapAlloc(GetProcessHeap,0,Size+1);
    ZeroMemory(P,Size+1);
    SetFilePointer(hF,0,nil,FILE_BEGIN);
    ReadFile(hF,P^,Size,NumRead,nil);
    SendMessage(MM.Handle,WM_SETTEXT,0,integer(P));
    UnLockFile(hF,0,0,Size,0);
    CloseHandle(hF);
    HeapFree(GetProcessHeap,0,P);
  end;
end;

ここでは、上で説明したとおりのシークエンスでファイルをオープンし、HeapAlloc( ) で確保したメモリバッファに読み込んでいる｡ そして、SendMessage( ) でメモコントロールに読み込んだ内容をコピーしている｡ ファイルをセーブする OnTest( ) ハンドラを見てみよう｡

procedure OnTest(hWindow: HWND);
var
  OSFN: TOpenSave;
  Flt:string;
  hF:THandle;
  Size,NumWrite:DWORD;
  s: string;
begin
  Flt := 'すべて(*.*)'#0+'*.*'#0+
         'ﾃｷｽﾄ(*.txt)'#0+'*.txt'#0#0;
  if GetSaveFile(MainWnd.Handle,'TestText.txt',
                 Flt,'C:\',OSFN) then begin
    hF := CreateFile(PChar(OSFN.FullName),GENERIC_WRITE,0,
                     nil,CREATE_NEW,FILE_ATTRIBUTE_NORMAL,0);
    SetFilePointer(hF,0,nil,FILE_BEGIN);
    Size := MM.TextLength;
    s := MM.Text;
    WriteFile(hF,PChar(s)^,Size,NumWrite,nil);
    CloseHandle(hF);
  end else MessageBeep($FFFFFFFF);
end;

ここでは、ダイアログから取得したファイル名を使って新しいファイルを書き込み専用でオープンしている｡ そして、メモコントロールの Text プロパティーからテキストを読み込んで、WriteFile( ) でファイルに書き込んでいる｡ ここでは、ロックとアンロックを省略している｡

redball.gifこの章の目次へ戻る

１８−６ ファイルビューワ

あらゆるファイルは､ それに記録されている情報の種類にかかわらずディジタル的に記録されている｡ ファイルをオープンすると、ReadFile( ) で１バイト毎にデータを読み込むことができる｡ この節では､ ファイルを読み込むことの例として、あらゆるファイルを読み込んでバイト毎に数値で表示するプログラムを作ろう｡

  1. エクスプローラを使って、新しいフォルダを 1806FileViewer という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1805TextFile フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで FileViewer.dpr という名前で保存する｡
  5. コードエディタで以下のように編集する｡
  6. [F.9]でコンパイルして実行する｡

以下に FileViewer.dpr の全リストを示す｡

program FileViewer;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  LB: TAPIListBox;
  DD: TAPIDragDrop;
  CF: TAPICFont;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function ByteToStr(buf: array of Char): string;
var
  s: string;
  i: integer;
begin
  SetLength(s,9);
  for i := 0 to 3 do begin
    wsprintf4(PChar(s),'%.2X%.2X %.2X%.2X',
              byte(buf[i*4]),byte(buf[i*4+1]),byte(buf[i*4+2]),byte(buf[i*4+3]));
    result := result+'  '+s;
  end;
end;

function ToStr(buf: array of Char;var DBCSflag: Boolean): string;
var
  c: array[0..16] of Char;
  i: integer;
begin
  if DBCSFlag then begin
    c[0] := ' ';
    DBCSFlag := false;
  end else if (byte(buf[0])>$1F) and (byte(buf[0])<$7F) then
    c[0] := buf[0]
  else if IsDBCSLeadByte(byte(buf[0])) then begin
    c[0] := buf[0];
    DBCSFlag := true;
  end else
    c[0] := '.';

  for i := 1 to 15 do
    if DBCSFlag then begin
      c[i] := buf[i];
      DBCSFlag := false
    end else if (byte(buf[i])>$1F) and (byte(buf[i])<$7F) then
      c[i] := buf[i]
    else if  IsDBCSLeadByte(byte(buf[i])) then begin
      c[i] := buf[i];
      DBCSFlag := true;
    end else
      c[i] := '.';
  if DBCSFlag then c[16] := buf[16] else c[16] := ' ';
  result := string(c);
end;

procedure DisplayFile(FN:string);
var
  FH: THandle;
  NumRead: DWORD;
  cbuf: array[0..16] of Char;
  i,size,icycle: integer;
  s,t: string;
  DBCSflag: Boolean;
begin
  DBCSFlag := false;
  LB.Clear;
  LB.AddString(FN);
  LB.AddString(' ');
  FH := CreateFile(PChar(FN),GENERIC_READ,0,nil,OPEN_EXISTING,
                   FILE_ATTRIBUTE_NORMAL,
                   0);
  size := Windows.GetFileSize(FH,nil);
  icycle := (size div 16);
  SetLength(t,4);
  LockFile(FH,0,0,size,0);
  LB.Redraw := false;
  for i := 0 to icycle do begin
    wsprintf1(PChar(t),'%.4X',i*16);
    if i = icycle then ZeroMemory(@cbuf,17);
    ReadFile(FH,cbuf,17,NumRead,nil);
    s := ByteToStr(cbuf);
    s := t+' '+s+'    '+ ToStr(cbuf,DBCSFlag);
    LB.AddString(s);
    s:= '';
    SetFilePointer(FH,-1,nil,FILE_CURRENT);
  end;
  LB.Redraw := true;
  UnlockFile(FH,0,0,size,0);
  CloseHandle(FH);
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure DDDrop(var AMsg: TMessage);
begin
  DisplayFile(DD.Files[0]);
end;

procedure MainSize(var Msg:TMessage);
begin
  LB.Width := Msg.LParamLo;
  LB.Height := Msg.LParamHi;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  LB := CreateListBox(hWindow,0,0,0,0,nil);
  CF := TAPICFont.Create;
  with CF do begin
    Name := 'ＭＳ ゴシック';
    Size := 10;
    GetHandle;
    SetHandle(LB.Handle);
  end;

  DD := TAPIDragDrop.Create(hWindow);
  DD.OnDrop := DDDrop;

  with MainWnd do begin
    ClientWidth := 630;
    ClientHeight := 400;
    Center;
    Trap(WM_SIZE,MainSize);
  end;
end;

procedure OnTest(hWindow: HWND);
var
  OSFN: TOpenSave;
  Flt:string;
begin
  Flt := 'すべて (*.*)'#0+'*.*'#0+
         'ﾌﾟﾛｼﾞｪｸﾄ (*.dpr)'#0+'*.dpr'#0+
         'ﾕﾆｯﾄ (*.pas)'#0+'*.pas'#0#0;
  if GetOpenFile(MainWnd.Handle,'Default.pas',Flt,'',OSFN) then
    DisplayFile(OSFN.FileName);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  CF.Free;
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifFileViewer.zip(17.487kB)
FileViewer.gif

実行して､ エクスプローラから任意のファイルをドラグドロップすると、１６バイトごとに数値としてリストボックスに表示される｡ また、その右側には文字列として意味のある場合は文字列が表示される。 Test! メニューをクリックして「ファイルを開く」ダイアログから選ぶこともできる｡ Delphi でコンパイルされた実行ファイルをドロップしてみよう｡ 但し､実行中の自分自身のファイルはシステムによってロックされていて読み込めないので注意すること｡ ここでは前節で作った TextFile.exe をドロップしたときの様子を上図に示した｡ *.exe ファイルは、最初の２バイトが MZ という文字に相当する $4D5A で始まっている｡ Delphi でコンパイルされた実行ファイルでは､ これに P の文字に相当する $50 が続いているのが分かるだろう。これは、コンパイラのマークであると思われる｡ 多分、Pascal の頭文字であろう｡ しかし、Borland Ｃ++でコンパイルされたものにも同じマークがついているらしい。また、オフセットアドレスが $0050 から 'This progarm must be run under Win32' というコメントが入っているのに気が付く｡ Delphi でコンパイルされていない実行ファイルの例として Windows ディレクトリのメモ帳の Notepad.exe をドロップしてみよう｡ それぞれ独特のコンパイラマークがあることに気づくだろう。 同じディレクトリにあるビットマップファイル( *.bmp ) をドロップすると、ビットマップファイルは、BM の文字に相当する $424D で始まることが分かるだろう。また、Delphi の Images ディレクトリにあるアイコンファイル( *.ico ) をみてみると、アイコンの模様が数字の配列パターンに反映されているのが分かるだろう｡ 日本語を含むテキストファイルをドロップして見るのも、文字コードと表示文字との対応が分かっておもしろい。

コードを調べよう｡ MainCreate( ) ハンドラではリストボックスを生成して、フォントを設定している｡ これはデフォルトフォントが可変ピッチなのでリストが見にくいため、定ピッチの「ＭＳ ゴシック」にしているのだ。DisplayFile( ) ハンドラが全ての処理をしている｡ ドロップされたファイル名を使って、CreateFile( ) によりオープンし、GetFileSize( ) でファイルサイズを取得している。ファイルをロックしてから、１７バイト毎に読み込み、SetFilePointer( )でポインタを一つ戻している｡ なぜ１７バイト毎に読み込んで１６バイト表示するのかといえば、１６バイト目が日本語の二バイト文字の最初のバイトである場合があるからだ｡ そのような場合は、１７バイト目と結合して一文字として表示しなければならない｡ ToStr( ) ヘルパ関数では、IsDBCSLeadByte( ) ＡＰＩを使って、これを判断している｡ その結果は､ DBCSflag という Boolean 型変数にセットして、次の読み込みシークエンスに受け継がれていく。

  function IsDBCSLeadByte(TestChar: Byte): BOOL; stdcall;

この関数は、TestChar が二バイト文字の最初のバイトのとき true を返す｡ この関数を使うことで､ 二バイト文字を含むファイルも正しく表示できるようになる｡ ByteToStr( ) ヘルパ関数では、１６バイトの Char 配列を受け取り、byte にキャストして､ ２−６ 呼び出し規約と IntToStr( ) のところで作った wsprintf4( ) を使って４バイトごとに書式化して文字列にしている｡ 最後に、ファイルをアンロックしてからクローズしている｡

この例から、どんなファイルでも読み込むことは簡単であることが分かるだろう｡ 例えば、前節で示したように、テキストファイルは､ 領域を適当に確保した PChar 型変数を Buffer に指定して、一度の ReadFile( ) を呼び出すだけで読み出すことができる｡ また、ビットマップファイルのような巨大なレコードと見なせるようなファイルでも、ポインタを適切に移動できれば簡単にフィールド変数を取得できる｡ オープンファイルの書き込みは、読み込みと同様の操作で、ファイルの構造を構築できれば良いのだと推察できるだろう｡ 次節で、レコードの配列の場合を想定してファイルにアクセスすることを考えよう｡

redball.gifこの章の目次へ戻る

１８−７ ファイルの書き込み

オープンファイルのアクセス方法は、前章で調べたメモリアクセスとよく似ている｡ 「ファイルポインタ」を移動して、読み書きする場所を指定するところは全く同じだ。メモリのアクセスでは、ポイタを指定して MoveMemory( ) により読み書きをしたが、それが WriteFile( ) と ReadFile( ) に代わっただけである｡ 違うのは､ これらの関数の最後のパラメータ lpOverlapped に nil を指定すると、読み込みや書き込み動作にともなってポインタが自動的に移動することである。ここでは、プログラマが新たに定義したレコード型の配列を読み書きする練習をしてみよう｡

  1. エクスプローラを使って、新しいフォルダを 1807RecordFile という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 1806FileViewer フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで RecordFile.dpr という名前で保存する｡
  5. コードエディタで以下のように編集する｡
  6. [F.9]でコンパイルして実行する｡

以下に RecordFile.dpr の全リストを示す｡

program RecordFile;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
type
TMyRecord = record
  INT: integer;
  WRD: Word;
  BYT: Byte;
end;

var
  MainWnd: TSDIMainWindow;
  LB: TAPIListBox;

  RA: array[0..100] of TMyRecord;
  CurDir: string;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure InitializeData;
var
  i:integer;
begin
  for i := 0 to 100 do begin
    RA[i].INT := Random(500000)+500000;
    RA[i].WRD := Random(5000)+5000;
    RA[i].BYT := Random(50)+50;
  end;
end;

procedure WriteData;
var
  hF:THandle;
  i:integer;
  NumWrite: DWORD;
begin
  hF := CreateFile(PChar(CurDir+'\MyData.rec'),GENERIC_WRITE,0,
                   nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
  SetFilePointer(hF,0,nil,FILE_BEGIN);
  for i := 0 to 100 do
    WriteFile(hF,RA[i],7,NumWrite,nil);
  CloseHandle(hF);
end;

procedure ReadData;
var
  hF: THandle;
  i: Integer;
  NumRead: DWORD;
  MR: TMyRecord;
begin
  hF := CreateFile(PChar(CurDir+'\MyData.rec'),GENERIC_READ,
                   0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if LockFile(hF,0,0,Windows.GetFileSize(hF,nil),0) then begin
    SetFilePointer(hF,0,nil,FILE_BEGIN);
    LB.Redraw := false;
    LB.Clear;
    LB.AddString(CurDir+'\MyData.rec');
    LB.AddString('');
    for i := 0 to 100 do begin
      ReadFile(hF,MR,7,NumRead,nil);
      LB.AddString(AIntToStr(i));
      LB.AddString(AIntToStr(RA[i].INT)+' = '+AIntToStr(MR.INT));
      LB.AddString(AIntToStr(RA[i].WRD)+' = '+AIntToStr(MR.WRD));
      LB.AddString(AIntToStr(RA[i].BYT)+' = '+AIntToStr(MR.BYT)); 
    end;
    LB.Redraw := true;
    UnLockFile(hF,0,0,Windows.GetFileSize(hF,nil),0);
    CloseHandle(hF);
  end;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainSize(var Msg:TMessage);
begin
  LB.Width := Msg.LParamLo;
  LB.Height := Msg.LParamHi;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
  i: integer;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  LB := CreateListBox(hWindow,0,0,0,0,nil);
  SetLength(CurDir,MAX_PATH);
  i := GetCurrentDirectory(MAX_PATH,PChar(CurDir));
  SetLength(CurDir,i);

  Randomize;
  InitializeData;
  WriteData;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
    Trap(WM_SIZE,MainSize);
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  ReadData;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifRecordFile.zip(15.695kB)
RecordFile.gif

実行して、Test! メニューをクリックすると右図のようになる｡
コードを調べよう｡ グローバルなレコード型として、前章と同じ TMyRecord 型を定義し、その１０１個の配列 RA をグローバル変数としている｡ MainCreate( ) から呼び出される InitializeData と WriteData 手続きにより、この配列にランダムな値を代入し、カレントディレクトリに 'MyData.rec' という名前のファイルを作ってその内容を保存している｡

procedure WriteData;
var
  hF:THandle;
  i,NumWrite:integer;
begin
  hF := CreateFile(PChar(CurDir+'\MyData.rec'),GENERIC_WRITE,0,
                   nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
  SetFilePointer(hF,0,nil,FILE_BEGIN);
  for i := 0 to 100 do
    WriteFile(hF,RA[i],7,NumWrite,nil);
  CloseHandle(hF);
end;

前章でも述べたが、Delphi の Object Pascal の仕様により packed を使わない上記のレコード型の宣言では、TMyRecord 型のサイズは８バイトになる｡ しかし、定義からみて明らかに７バイトであるので、ここではファイルに各要素を書き込むときに SizeOf( ) を使わずに、７という数字で書き込みバイトを指定している｡ 書き込む毎にポインタを移動しなくてよいことは、上述の通りである｡ Test! メニューから呼び出される読み込みハンドラを以下に示す｡ 

procedure ReadData;
var
  hF: THandle;
  i,NumRead: Integer;
  MR: TMyRecord;
begin
  hF := CreateFile(PChar(CurDir+'\MyData.rec'),GENERIC_READ,
                   0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if LockFile(hF,0,0,Windows.GetFileSize(hF,nil),0) then begin
    SetFilePointer(hF,0,nil,FILE_BEGIN);
    LB.Redraw := false;
    LB.Clear;
    LB.AddString(CurDir+'\MyData.rec');
    LB.AddString('');
    for i := 0 to 100 do begin
      ReadFile(hF,MR,7,NumRead,nil);
      LB.AddString(AIntToStr(i));
      LB.AddString(AIntToStr(RA[i].INT)+' = '+AIntToStr(MR.INT));
      LB.AddString(AIntToStr(RA[i].WRD)+' = '+AIntToStr(MR.WRD));
      LB.AddString(AIntToStr(RA[i].BYT)+' = '+AIntToStr(MR.BYT)); 
    end;
    LB.Redraw := true;
    UnLockFile(hF,0,0,Windows.GetFileSize(hF,nil),0);
    CloseHandle(hF);
  end;
end;

ここでは、ファイルを開いて、ポインタを冒頭に初期化してから ReadFile( ) で TMyRexcord のローカル変数 MR に７バイト毎に読み込み、グローバル変数の値との比較をリストボックスに表示している｡ ここでも､ ポインタは自動的に移動する｡ リストボックスの最初に表示されるファイルをエクスプローラで右クリックしてプロパティーを見てみると､ そのサイズが予想通り７０７バイトになっているのが確認できる｡ また、前章で作ったファイルビューワに読み込んでみて数値の構造を確か得ることができる｡ 十六進と十進表示なので直感的には分からないが、７バイト毎に現れる BYT フィールドは、暗算でも確かめることができる｡ インテルプロセッサは、上位バイトと下位バイトを交換して演算する事に注意すること。

redball.gifこの章の目次へ戻る

１８−８ まとめ

本章では､ 「ファイルを開く」と「ファイルに名前を付けて保存」のコモンダイアログの使い方を調べ､ この機能をカプセル化した関数を作成した｡ また、ShellAPI の SHFileOperation( ) ＡＰＩの機能をカプセル化して、ファイルのコピー、移動､ 名前変更、削除のための関数を作成した。さらに、任意の深さのディレクトリの作成及び削除のための関数を作成した｡ そして、ＡＰＩ関数を使って、具体的にファイルの内容にアクセスする方法を調べた。

ここまでのプログラムファイル

  1. Skeleton03.dpr (2 kB)
  2. UtilFunc.pas (11 kB)
  3. UtilClass.pas (46 kB)
  4. GDIObject.pas (21 kB)
  5. APIControl.pas (61 kB)
  6. APIWindow.pas (19 kB)


redball.gifこの章の目次へ戻る