お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"フォルダの監視スレッド"



  みなさんこんにちは
 
  ,

//////////////////////////////////////
//フォルダの監視ユニット
//フォルダのファイルが変更されるとOnChangeイベントが発生する
/////////////////////////////////////
unit FolderWatchThread;

interface

uses
  Messages, Classes, Windows, SysUtils;

const
dwMillisec = 100;//WaitForSingleObjectのタイムアウト

type

  TFolderWatch = class(TThread)
  private
    { Private 宣言 }
      FdwResult: DWORD;         // 通知で待機の結果を保持
      FNotificationHand: THandle; // 通知オブジェクトのハンドルを保持
      FOnChange: TNotifyEvent;
    procedure CallOnChange;
    procedure DoChange;
  protected
    procedure Execute; override;
  public
    constructor Create(FolderName: string);
    destructor Destroy; override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;

  end;

implementation

{ TFolderWatch }

constructor TFolderWatch.Create(FolderName: string);
begin
  FNotificationHand := FindFirstChangeNotification(PChar(FolderName + #0),
                                         FALSE, //階層化は見ない
                                         FILE_NOTIFY_CHANGE_FILE_NAME);
  inherited Create(True);//Resume メソッドを呼ぶまで実行されない
  FreeOnTerminate := False;
end;

destructor TFolderWatch.Destroy;
begin
   if FNotificationHand <> INVALID_HANDLE_VALUE then
      FindCloseChangeNotification(FNotificationHand);
   inherited Destroy;
end;

procedure TFolderWatch.Execute;
begin
  //ハンドルの取得に成功(INVALID_HANDLE_VALUE)
  if FNotificationHand <> INVALID_HANDLE_VALUE then
  Begin
     While not Terminated do
     begin
       FdwResult := WaitForSingleObject(FNotificationHand, dwMillisec);
       if FdwResult = WAIT_OBJECT_0 then
       begin
         //通知オブジェクトが知らせられたことを示す
         DoChange;
         FindNextChangeNotification(FNotificationHand)
       end;
     end;
  end;
end;

procedure TFolderWatch.CallOnChange;
begin
   FOnChange(Self);
end;

procedure TFolderWatch.DoChange;
begin
   if Assigned(FOnChange) then Synchronize(CallOnChange);
end;

end.

///End of File

//Test File
 
unit UMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs,
  StdCtrls, FileCtrl, ComCtrls, FolderWatchThread;

type
  TMainForm = class(TForm)
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    StatusBar1: TStatusBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
  private
    FFolderWatch: TFolderWatch;
    procedure FolderWatchTerminate(Sender: TObject);
    procedure FolderChange(Sender: TObject);
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  MainForm: TMainForm;

implementation


{$R *.DFM}

procedure TMainForm.Button1Click(Sender: TObject);
begin
   Button2.Enabled := True;
   Button1.Enabled := False;
   FFolderWatch := TFolderWatch.Create(DirectoryListBox1.Directory);
   FFolderWatch.OnTerminate := FolderWatchTerminate;
   FFolderWatch.OnChange := FolderChange;
   FFolderWatch.Resume;
end;

procedure TMainForm.FolderWatchTerminate(Sender: TObject);
begin
  //OnTerminateイベントハンドラ
  ShowMessage('OnTerminate');
end;

procedure TMainForm.FolderChange(Sender: TObject);
begin
 //OnChangeイベントハンドラ 
  Beep;
  FileListBox1.Update;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  Button1.Enabled := True;
  Button2.Enabled := False;
  FFolderWatch.Terminate;
  FFolderWatch.WaitFor;
  FFolderWatch.Free;
  FFolderWatch := Nil;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose:
  Boolean);
begin
//こうゆうやり方は適当でないと思う。
   if FFolderWatch <> Nil then
   Begin
       FFolderWatch.Terminate;
       FFolderWatch.WaitFor;
       FFolderWatch.Free;
       FFolderWatch := Nil;
   End;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
   Button1.Caption := '監視実行';
   Button2.Caption := '中止';
end;

end.

 みなさんからの添削お願いします。

     By かぼちゃの馬車 [ http://hm.aitai.ne.jp/~t_kondo/]

Original document by かぼちゃの馬車  氏 ID:(MXF01374)


ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum