Ich erinnere mich nicht, woher das kam, aber es funktioniert. Leider weiß ich nicht, wie man hier Sachen anbringt, also kann ich das dcr nicht mit einem Icon hinzufügen.
Update: Fand es auf torry.net, zusammen mit vielen anderen Komponenten, die den gleichen Trick: 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: [email protected]
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.
Gibt es bestimmte Festplattenaktivitäten, die Sie erkennen möchten? Ich bin zwar kein Experte, aber ich denke, während des laufenden Programms wird es aus verschiedenen Gründen viel Festplattenzugriff geben (nicht zuletzt die Auslagerungsdatei). Kannst du den Grund dafür erklären? –
Entschuldigung, dies ist neu. Ich antwortete, anstatt zu kommentieren. – Jlouro
Ich kopiere Dateien auf ein Remote-Laufwerk am Ende zu bewältigen I Herunterfahren/Standby der Maschine.Einige Dateien werden nicht vom Puffer auf die Festplatte kopiert, und der Remote-Festplatte wird getrennt, so dass die Sicherung nicht abgeschlossen ist. Ich muss Datenträgeraktivität in a diese Festplatte, um eine Aktion auf der Maschine zu ermöglichen. – Jlouro