在Delphi中检测磁盘活动

我正在使用Delphi 2007.

我正在将文件复制到远程驱动器.复制结束时,我关机/待机.可能会发生某些文件无法从缓冲区复制到磁盘,并且远程磁盘断开连接,因此备份未完成.我需要检测该磁盘上的磁盘活动,以便能够在计算机上执行关闭操作.

有没有办法在这种情况下检测磁盘活动？

我不记得它来自哪里,但它确实有效.不幸的是我不知道如何在这里附加东西,所以我不能添加带有图标的dcr.

更新:在torry.net上找到它,还有许多其他组件可以做同样的伎俩:http://www.torry.net/pages.php？id = 252

// ==================== DISC DRIVE MONITOR =====================================
//
// Class and Component to encapsulate the FindXXXXChangeNotification API calls
//
// The FindXXXXChangeNotification API calls set up a disc contents change
// notification handle.  You can set a filter to control which change types
// are notified, the directory which is monitored and set whether subdirectories
// from the monitored directory are monitored as well.
//
//------------------------------------------------------------------------------
// This file contains a class derived from TThread which undertakes the disc
// monitoring and a simple component which encapsulates the thread to make
// a non-visual VCL component.  This component works at design time, monitoring
// and notifying changes live if required.
//
// Version 1.00 - Grahame Marsh 14 January 1997
// Version 1.01 - Grahame Marsh 30 December 1997
//      Bug fix - really a Win 95 bug but only surfaces in D3, not D2
//              - see notes in execute method
// Version 1.02 - Grahame Marsh 30 January 1998
//              - adapted to work with version 2.30 TBrowseDirectoryDlg
//
// Freeware - you get it for free, I take nothing, I make no promises!
//
// Please feel free to contact me: grahame.s.marsh@courtaulds.com

unit DiscMon;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ShlObj;//, BrowseDr, DsgnIntf;

//=== DISC MONITORING THREAD ===================================================
// This thread will monitor a given directory and subdirectories (if required)
// for defined filtered changes.  When a change occurs the OnChange event will
// be fired, if an invalid condition is found (eg non-existent path) then
// the OnInvalid event is fired. Each event is called via the Sychronize method
// and so are VCL thread safe.
//
// The thread is created suspended, so after setting the required properties
// you must call the Resume method.

type
  TDiscMonitorThread = class(TThread)
  private
    FOnChange : TNotifyEvent;
    FOnInvalid : TNotifyEvent;
    FDirectory : string;
    FFilters : integer;
    FDestroyEvent,
    FChangeEvent : THandle;
    FMultipleChanges : boolean;
    FSubTree : boolean;
    procedure InformChange;
    procedure InformInvalid;
    procedure SetDirectory (const Value : string);
    procedure SetFilters (Value : integer);
    procedure SetMultipleChanges (Value : boolean);
    procedure SetSubTree (Value : boolean);
  protected
    procedure Execute; override;
    procedure Update;
  public
    constructor Create;
    destructor Destroy; override;
// The directory to monitor
    property Directory : string read FDirectory write SetDirectory;
// Filter condition, may be any of the FILE_NOTIFY_CHANGE_XXXXXXX constants
// ORed together.  Zero is invalid.
    property Filters : integer read FFilters write SetFilters;
// Event called when change noted in directory
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
// Event called for invalid parameters
    property OnInvalid : TNotifyEvent read FOnInvalid write FOnInvalid;
// Flag multiple times per change, for instance if the Size of a file changes
// then the Time willl change as well; MultipleChanges=true will fire two events
    property MultipleChanges : boolean read FMultipleChanges write SetMultipleChanges;
// Include subdirectories below specified directory.
    property SubTree : boolean read FSubTree write SetSubTree;
  end;

//===================== DISC MONITORING COMPONENT ==============================

// specify directory string as type string so we can have our own property editor
  TDiscMonitorDirStr = type string;

// enumerated type for filter conditions (not directly usable in thread class)
// see the SetFilters procedure for the translation of these filter conditions
// into FILE_NOTIFY_CHANGE_XXXXXX constants.
  TMonitorFilter = (moFilename, moDirName, moAttributes, moSize,
                    moLastWrite, moSecurity);
// set of filter conditions
  TMonitorFilters = set of TMonitorFilter;

  TDiscMonitor = class(TComponent)
  private
    FActive : boolean;
    FMonitor : TDiscMonitorThread;
    FFilters : TMonitorFilters;
    FOnChange : TNotifyEvent;
    FOnInvalid : TNotifyEvent;
    FShowMsg : boolean;
    function GetDirectory : TDiscMonitorDirStr;
    function GetMultipleChanges : boolean;
    function GetSubTree : boolean;
    procedure SetActive (Value : boolean);
    procedure SetDirectory (Value : TDiscMonitorDirStr);
    procedure SetFilters (Value : TMonitorFilters);
    procedure SetMultipleChanges (Value : boolean);
    procedure SetSubTree (Value : boolean);
  protected
    procedure Change (Sender : TObject);
    procedure Invalid (Sender : TObject);
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
// stop the monitoring thread running
    procedure Close;
// start the monitoring thread running
    procedure Open;
// read-only property to access the thread directly
    property Thread : TDiscMonitorThread read FMonitor;
  published
// the directory to monitor
    property Directory : TDiscMonitorDirStr read GetDirectory write SetDirectory;
// control the appearance of information messages at design time (only)
    property ShowDesignMsg : boolean read FShowMsg write FShowMsg default false;
// event called when a change is notified
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
// event called if an invalid condition is found
    property OnInvalid : TNotifyEvent read FOnInvalid write FOnInvalid;
// notification filter conditions
    property Filters : TMonitorFilters read FFilters write SetFilters default [moFilename];
// Flag multiple times per change, for instance if the Size of a file changes
// then the Time willl change as well; MultipleChanges=true will fire two events
    property MultipleChanges : boolean read GetMultipleChanges write SetMultipleChanges;
// include subdirectories below the specified directory
    property SubTree : boolean read GetSubTree write SetSubTree default true;
// specify if the monitoring thread is active
    property Active : boolean read FActive write SetActive default false;
  end;

procedure Register;

implementation

//=== MONITOR THREAD ===========================================================

// Create the thread suspended.  Create two events, each are created using
// standard security, in the non-signalled state, with auto-reset and without
// names.  The FDestroyEvent will be used to signal the thread that it is to close
// down.  The FChangeEvent will be used to signal the thread when the monitoring
// conditions (directory, filters or sub-directory search) have changed.
// OnTerminate is left as false, so the user must Free the thread.

constructor TDiscMonitorThread.Create;
begin
  inherited Create (true);
  FDestroyEvent := CreateEvent (nil, false, false, nil);
  FChangeEvent := CreateEvent (nil, false, false, nil)
end;

// close OnXXXXX links, signal the thread that it is to close down
destructor TDiscMonitorThread.Destroy;
begin
  FOnChange := nil;
  FOnInvalid := nil;
  SetEvent (FDestroyEvent);
  FDirectory := '';
  inherited Destroy
end;

// called by the Execute procedure via Synchronize.  So this is VCL thread safe
procedure TDiscMonitorThread.InformChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self)
end;

// called by the Execute procedure via Synchronize.  So this is VCL thread safe
procedure TDiscMonitorThread.InformInvalid;
begin
  if Assigned (FOnInvalid) then
    FOnInvalid (Self)
end;

// Change the current directory
procedure TDiscMonitorThread.SetDirectory (const Value : string);
begin
  if Value <> FDirectory then
  begin
    FDirectory := Value;
    Update
  end
end;

// Change the current filters
procedure TDiscMonitorThread.SetFilters (Value : integer);
begin
  if Value <> FFilters then
  begin
    FFilters := Value;
    Update
  end
end;

// Change the current MultipleChanges condition
procedure TDiscMonitorThread.SetMultipleChanges (Value : boolean);
begin
  if Value <> FMultipleChanges then
    FMultipleChanges := Value;
end;

// Change the current sub-tree condition
procedure TDiscMonitorThread.SetSubTree (Value : boolean);
begin
  if Value <> FSubTree then
  begin
    FSubtree := Value;
    Update
  end
end;

// On any of the above three changes, if the thread is running then
// signal it that a change has occurred.
procedure TDiscMonitorThread.Update;
begin
  if not Suspended then
    SetEvent (FChangeEvent)
end;

// The EXECUTE procedure
//     -------
// Execute needs to:
// 1. Call FindFirstChangeNotification and use the Handle in a WaitFor...
//    to wait until the thread become signalled that a notification has occurred.
//    The OnChange event is called and then the FindNextChangeNotification is
//    the called and Execute loops back to the WaitFor
// 2. If an invalid handle is obtained from the above call, the the OnInvalid
//    event is called and then Execute waits until valid conditions are set.
// 3. If a ChangeEvent is signalled then FindCloseChangeNotification is called,
//    followed by a new FindFirstChangeNotification to use the altered
//    conditions.
// 4. If a DestroyEvent is signalled then FindCloseChangeNotification is
//    called and the two events are closed and the thread terminates.
//
// In practice WaitForMultipleObjects is used to wait for any of the conditions
// to be signalled, and the returned value used to determine which event occurred.

procedure TDiscMonitorThread.Execute;
// There appears to be a bug in win 95 where the bWatchSubTree parameter
// of FindFirstChangeNotification which is a BOOL only accepts values of
// 0 and 1 as valid, rather than 0 and any non-0 value as it should.  In D2
// BOOL was defined as 0..1 so the code worked, in D3 it is 0..-1 so
// fails. The result is FindF... produces and error message.  This fix (bodge) is
// needed to produce a 0,1 bool pair, rather that 0,-1 as declared in D3
const
  R : array [false..true] of BOOL = (BOOL (0), BOOL (1));
var
  A : array [0..2] of THandle; // used to give the handles to WaitFor...
  B : boolean;                 // set to true when the thread is to terminate
begin
  B := false;
  A [0] := FDestroyEvent;      // put DestroyEvent handle in slot 0
  A [1] := FChangeEvent;       // put ChangeEvent handle in slot 1
// make the first call to the change notification system and put the returned
// handle in slot 2.
  A [2] := FindFirstChangeNotification (PChar(FDirectory),R[fSubTree],FFilters);
  repeat

// if the change notification handle is invalid then:
    if A [2] = INVALID_HANDLE_VALUE then
    begin
  // call the OnInvalid event
      Synchronize (InformInvalid);
  // wait until either DestroyEvent or the ChangeEvents are signalled
      case WaitForMultipleObjects(2,PWOHandleArray(@A),false,INFINITE)-WAIT_OBJECT_0 of
  // DestroyEvent - close down by setting B to true
        0 : B := true;
  // try new conditions and loop back to the invalid handle test
        1 : A [2] := FindFirstChangeNotification (PChar(FDirectory),
                                                  R[fSubTree],FFilters)
      end
    end else
// handle is valid so wait for any of the change notification, destroy or
// change events to be signalled
      case WaitForMultipleObjects(3,PWOHandleArray(@A),false,INFINITE)-WAIT_OBJECT_0 of
        0 : begin
  // DestroyEvent signalled so use FindClose... and close down by setting B to true
              FindCloseChangeNotification (A [2]);
              B := true
            end;
        1 : begin
  // ChangeEvent signalled so close old conditions by FindClose... and start
  // off new conditions.  Loop back to invalid test in case new conditions are
  // invalid
              FindCloseChangeNotification (A [2]);
              A [2] := FindFirstChangeNotification (PChar(FDirectory),
                                                    R[fSubTree],FFilters)
            end;
        2 : begin
  // Notification signalled, so fire the OnChange event and then FindNext..
  // loop back to re-WaitFor... the thread
              Synchronize(InformChange);
// changed to prevent multiple notifications for the same change
// old line
              if FMultipleChanges then
                FindNextChangeNotification (A [2])
              else
                begin
                  FindCloseChangeNotification (A [2]);
                  A [2] := FindFirstChangeNotification (PChar(FDirectory),
                                                        R[fSubTree],FFilters);
                end
            end;
      end
  until B;

// closing down so chuck the two events
  CloseHandle (FChangeEvent);
  CloseHandle (FDestroyEvent)
end;

//=== MONITOR COMPONENT ========================================================

// This component encapsulates the above thread.  It has properties for
// directory, sub-directory conditions, filters, whether information messages
// should be given at design time and if the thread is active.
constructor TDiscMonitor.Create (AOwner : TComponent);
begin
  inherited Create (AOwner);
  FMonitor:=TDiscMonitorThread.Create;  // create a monitor thread
  FMonitor.OnChange:=Change;            // hook into its event handlers
  FMonitor.OnInvalid:=Invalid;
  Filters:=[moFilename];                // default filters to moFilename
  MultipleChanges:=false;               // default one event per change
  SubTree:=false                        // default no sub-tree search to on
end;

destructor TDiscMonitor.Destroy;
begin
  FMonitor.Free;                          // chuck the thread
  inherited Destroy
end;

// Change notification from the thread has occurred. Call the component's event
// handler and then, if in design mode, and if desired, put up a simple
// notification message
procedure TDiscMonitor.Change;
begin
  if Assigned (FOnChange) then
    FOnChange (Self)
  else
    if (csDesigning in ComponentState) and FShowMsg then
      ShowMessage ('Change signalled')
end;

// Invalid notification from the thread has occurred. Call the component's event
// handler and then, if in design mode, and if desired, put up a simple
// notification message
procedure TDiscMonitor.Invalid;
begin
  if Assigned (FOnInvalid) then
    FOnInvalid (Self)
  else
    if (csDesigning in ComponentState) and FShowMsg then
      ShowMessage ('Invalid parameter signalled')
end;

// Stop the monitor running
procedure TDiscMonitor.Close;
begin
  Active := false
end;

// Run the monitor
procedure TDiscMonitor.Open;
begin
  Active := true
end;

// Control the thread by using it's resume and suspend methods
procedure TDiscMonitor.SetActive (Value : boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    if Active then
    begin
      FMonitor.Resume;
      FMonitor.Update
    end else
      FMonitor.Suspend
  end
end;

// get the current directory from the thread
function TDiscMonitor.GetDirectory : TDiscMonitorDirStr;
begin
  Result := FMonitor.Directory
end;

// get the current MultipleChanges status from the thread
function TDiscMonitor.GetMultipleChanges : boolean;
begin
  Result := FMonitor.MultipleChanges
end;

// get the current sub-tree status from the thread
function TDiscMonitor.GetSubTree : boolean;
begin
  Result := FMonitor.SubTree
end;

// set the directory to monitor
procedure TDiscMonitor.SetDirectory (Value : TDiscMonitorDirStr);
begin
  FMonitor.Directory := Value
end;

// Change the filter conditions.  The thread uses the raw windows constants
// (FILE_NOTIFY_CHANGE_XXXX) but the components uses a set of enumurated type.
// It is therefore necessary to translate from the component format into
// an integer value for the thread.
procedure TDiscMonitor.SetFilters (Value : TMonitorFilters);
const
  XlatFileNotify : array [moFilename..moSecurity] of integer =
    (FILE_NOTIFY_CHANGE_FILE_NAME,  FILE_NOTIFY_CHANGE_DIR_NAME,
     FILE_NOTIFY_CHANGE_ATTRIBUTES, FILE_NOTIFY_CHANGE_SIZE,
     FILE_NOTIFY_CHANGE_LAST_WRITE, FILE_NOTIFY_CHANGE_SECURITY);
var
  L : TMonitorFilter;
  I : integer;
begin
  if Value <> FFilters then
    if Value = [] then
      ShowMessage ('Some filter condition must be set.')
    else begin
      FFilters := Value;
      I := 0;
      for L := moFilename to moSecurity do
        if L in Value then
          I := I or XlatFileNotify [L];
      FMonitor.Filters := I;
    end
end;

// set the MultipleChanges status in the thread
procedure TDiscMonitor.SetMultipleChanges (Value : boolean);
begin
  FMonitor.MultipleChanges:=Value
end;

// set the sub-tree status in the thread
procedure TDiscMonitor.SetSubTree (Value : boolean);
begin
  FMonitor.SubTree:=Value
end;

procedure Register;
begin
  RegisterComponents ('Samples', [TDiscMonitor]);
end;

end.