delphi的文件夹监控控件,直接封装成可视化的控件,拖一下即可代码。核心为:ReadDirectoryChangesW

网上的代码修改成控件形式了。代码如下:
unit FolderMon;

interface

uses
  SysUtils
  , Classes
  , Windows
  ;

type
  TFolderAction =
    (
      faNew
      , faRemoved
      , faModified
      , faRenamedOld
      , faRenamedNew
    );

const
  FOLDER_ACTION_NAMES: array[TFolderAction] of string =
    ( 'New', 'Removed', 'Modified', 'Old Name', 'New name');

type
  TFolderItemInfo=record
    Name  : string;
    Action: TFolderAction;
  end;

  TChangeType =
    (
      ctFileName
      , ctDirName
      , ctAttr
      , ctSize
      , ctLastWriteTime
      , ctLastAccessTime
      , ctCreationTime
      , ctSecurityAttr
    );

  TChangeTypes = set of TChangeType;
  TFolderMon=class;
  TFolderChangeEvent = procedure (Sender: TFolderMon; AFolderItem: TFolderItemInfo) of object;
  TFolderMon=class (TComponent)
  private
    FFolder: string;
    FWorker: TThread;
    FMonitoredChanges: TChangeTypes;
    FMonitorSubFolders: Boolean;
    FOnFOlderChange: TFolderChangeEvent;
    FOnDeactivated: TNotifyEvent;
    FOnActivated: TNotifyEvent;
    procedure SetFolder(const Value: string);
    function GetIsActive: Boolean;
    procedure SetIsActive(const Value: Boolean);
    procedure SetMonitoredChanges(const Value: TChangeTypes);
    procedure SetMonitorSubFolders(const Value: Boolean);
  published
    destructor Destroy; override;

    procedure Activate;
    procedure Deactivate;

    property Folder: string read FFolder write SetFolder;
    property IsActive: Boolean read GetIsActive write SetIsActive;
    property MonitoredChanges : TChangeTypes read FMonitoredChanges write SetMonitoredChanges;
    property MonitorSubFolders: Boolean read FMonitorSubFolders write SetMonitorSubFolders;
    property OnFolderChange: TFolderChangeEvent read FOnFOlderChange write FOnFolderChange;
    property OnActivated: TNotifyEvent read FOnActivated write FOnActivated;
    property OnDeactivated: TNotifyEvent read FOnDeactivated write FOnDeactivated;
  end;

procedure Register;

implementation

const
  NOTIFY_FILTERS: array[TChangeType] of DWORD =
    (
      FILE_NOTIFY_CHANGE_FILE_NAME     // ctFileName
      , FILE_NOTIFY_CHANGE_DIR_NAME    // ctDirName
      , FILE_NOTIFY_CHANGE_ATTRIBUTES  // ctAttr
      , FILE_NOTIFY_CHANGE_SIZE        // ctSize
      , FILE_NOTIFY_CHANGE_LAST_WRITE  // ctLastWriteTime
      , FILE_NOTIFY_CHANGE_LAST_ACCESS // ctLastAccessTime
      , FILE_NOTIFY_CHANGE_CREATION    // ctCreationTime
      , FILE_NOTIFY_CHANGE_SECURITY    // ctSecurityAttr
    );

type
  TFolderMonWorker=class(TThread)
  private
    Owner: TFolderMon;
    FFolder: THandle;
    FMonFilter: DWord;
    FFolderItemInfo: TFolderItemInfo;
    procedure SetUp;
    procedure TearDown;
    procedure DoFolderItemChange;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner: TFolderMon); reintroduce;
  end;


procedure Register;
begin
  RegisterComponents('Tndsoft', [TFolderMon]);
end;


{ TFolderMon }

procedure TFolderMon.Activate;
begin
  if IsActive then
    Exit;

  if FMonitoredChanges=[] then
    raise Exception.Create('Please specify event(s) to be monitored');
  if not DirectoryExists(FFolder) then
    raise Exception.Create('Please supply valid/existing folder');

  FWorker := TFolderMonWorker.Create(Self);
  if Assigned(FOnActivated) then
    FOnActivated(Self);
end;

procedure TFolderMon.Deactivate;
begin
  if not IsActive then
    Exit;

  with TFolderMonWorker(FWorker) do
  begin
    Owner := nil;
    Terminate;
  end;
  FWorker := nil;
  if Assigned(FOnDeactivated) then
    FOnDeactivated(Self);
end;

destructor TFolderMon.Destroy;
begin
  Deactivate;
  inherited;
end;

function TFolderMon.GetIsActive: Boolean;
begin
  Result := FWorker <> nil;
end;

procedure TFolderMon.SetFolder(const Value: string);
begin
  if LowerCase(FFolder)=LowerCase(Value) then
    Exit;

  if IsActive then
    raise Exception.Create('Currently still actively monitoring a folder. Please deactivate before changing monitored folder.');

  FFolder := Value;
end;

procedure TFolderMon.SetIsActive(const Value: Boolean);
begin
  if Value then
    Activate
  else
    Deactivate;
end;

procedure TFolderMon.SetMonitoredChanges(const Value: TChangeTypes);
begin
  if FMonitoredChanges = Value then
    Exit;

  if IsActive then
    raise Exception.Create('The monitor must be deactivated before changing the monitored event(s)');
  FMonitoredChanges := Value;
end;

procedure TFolderMon.SetMonitorSubFolders(const Value: Boolean);
begin
  if FMonitorSubFolders=Value then
    Exit;

  if IsActive then
    raise Exception.Create('Please deactivate the monitor first');

  FMonitorSubFolders := Value;
end;

{ TFolderMonWorker }

constructor TFolderMonWorker.Create(AOwner: TFolderMon);
begin
  Owner := AOwner;
  if Owner=nil then
    raise Exception.Create('Reference to TFolderMon instance must be specified');

  inherited Create(False);
  FreeOnTerminate := True;
  SetUp;
end;

const
  FILE_LIST_DIRECTORY = $0001;

type
  _FILE_NOTIFY_INFORMATION=packed record
    NextEntryOffset: DWORD;
    Action: DWORD;
    FileNameLength: DWORD;
    FileName: WideChar;
  end;
  FILE_NOTIFY_INFORMATION = _FILE_NOTIFY_INFORMATION;
  PFILE_NOTIFY_INFORMATION = ^FILE_NOTIFY_INFORMATION;

procedure TFolderMonWorker.DoFolderItemChange;
begin
  if Assigned(Owner) and Assigned(Owner.FOnFolderChange) then
    Owner.FOnFOlderChange(Owner, FFolderItemInfo);
end;

procedure TFolderMonWorker.Execute;
const
  cBufSize = 32 * 1024;  // 32k
var
  B: Pointer;
  vCount: DWord;
  vOffset: DWord;
  vFileInfo: PFILE_NOTIFY_INFORMATION;
begin
  GetMem(B, cBufSize);
  try
    while not Terminated do
    begin
      if Owner=nil then
        Exit;

      if ReadDirectoryChangesW(FFolder
                               , B
                               , cBufSize
                               , Owner.MonitorSubFolders
                               , FMonFilter
                               , @vCount
                               , nil
                               , nil
                              )
         and (vCount > 0) then
      begin
        if Owner=nil then
          Exit;

        vFileInfo := B;
        repeat
          vOffset := vFileInfo.NextEntryOffset;

          FFolderItemInfo.Name := WideCharLenToString(@vFileInfo^.FileName, vFileInfo^.FileNameLength);
          SetLength(FFolderItemInfo.Name, vFileInfo^.FileNameLength div 2);
          case vFileInfo^.Action of
            FILE_ACTION_ADDED           : FFolderItemInfo.Action := faNew;
            FILE_ACTION_REMOVED         : FFolderItemInfo.Action := faRemoved;
            FILE_ACTION_MODIFIED        : FFolderItemInfo.Action := faModified;
            FILE_ACTION_RENAMED_OLD_NAME: FFolderItemInfo.Action := faRenamedOld;
            FILE_ACTION_RENAMED_NEW_NAME: FFolderItemInfo.Action := faRenamedNew;
          end;
          Synchronize(DoFolderItemChange);
          PByte(vFileInfo) := PByte(DWORD(vFileInfo) + vOffset);
        until vOffset=0;
      end;
    end;
  finally
    TearDown;
    FreeMem(B, cBufSize);
  end;
end;

procedure TFolderMonWorker.SetUp;
var
  i: TChangeType;
begin
  FFolder := CreateFile(PChar(Owner.Folder)
                        , FILE_LIST_DIRECTORY or GENERIC_READ
                        , FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE
                        , nil
                        , OPEN_EXISTING
                        , FILE_FLAG_BACKUP_SEMANTICS
                        , 0);

  FMonFilter := 0;
  for i := Low(TChangeType) to High(TChangeType) do
    if i in Owner.MonitoredChanges then
      FMonFilter := FMonFilter or NOTIFY_FILTERS[i];
end;

procedure TFolderMonWorker.TearDown;
begin
  CloseHandle(FFolder);
end;

end.



网上的代码修改成控件形式了>
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值