Examples Delphi

This article describes how to monitor a drive and pre-cache small files. This is especially usefull with applications that slowly transport streams, like mp3 players or p2p applications.
This example demonstrates two things:
First: how to monitor a drive using ReadDirectoryChangesW. This will let windows callback the application whenever a change in a file or file attributes is made.
Secondly, a small example of a thread that performs the pre-cache.
Create the stringlists before calling monitordrive or launching the thread.
Monitor a drive with MonitorDrive (Pathname)
type
TTrackInfo = record
H:Integer;
O:TOverLapped;
B:TFNIBuf;
D:String;
end;
TPreCache = class(TThread)
procedure Execute; override;
end;
function Track(I:Integer{TrackIndex}):LongBool;
implementation
var Extensions : array[0..0] of String = ('.mp3');
var Tracks:Array of TTrackInfo;
FFilesOpened, FFilesHistory:TStringList;
FHasNewFileToCache:Boolean=False;
FPrecached:Integer;
FTotPrecached:Int64=0;
FPreCachedFile:String;
CS,css:TCriticalSection;
//Callback routine:
procedure {VOID WINAPI} FileIOCompletionRoutine(
dwErrorCode:Dword; // completion code
dwNumberOfBytesTransfered:DWord; // number of bytes transferred
lpOverlapped:Pointer // pointer to structure with I/O information
); stdcall;
var S,M,V:String;
POverLapped:^TOverLapped;
i,l:Integer;
begin
//Return
POverLapped := lpOverLapped;
// if @OverLapped = POverlapped then log ('ie');
l:=-1;
for i:=0 to high(Tracks) do
if @Tracks[i].O = lpOverlapped then //found corresponding index
begin
l:=i;
break;
end;
if l<0 then //Help, not found!
begin
// Log ('track index not found');
exit;
end;
repeat
if true{Tracks[l].B.Action <> 0} then //ignore repeated writes etc
begin
S:=Tracks[l].B.FileName; //This works because FileName = array of WChar !
SetLength (S, Tracks[l].B.FileNameLength div 2);
S:=Tracks[l].D+S; //Make it full path
{case Tracks[l].B.Action of
FILE_ACTION_ADDED : M:='The file was added to the directory.';
FILE_ACTION_REMOVED : M:='The file was removed from the directory.';
FILE_ACTION_MODIFIED : M:='The file was modified. This can be a change in the time stamp or attributes.';
FILE_ACTION_RENAMED_OLD_NAME : M:='The file was renamed and this is the old name.';
FILE_ACTION_RENAMED_NEW_NAME : M:='The file was renamed and this is the new name.';
end;}
// Log ('Jeempie '+S+' '+M);
//Visualize system activity:
{ //Not!! TO COMPUTING EXTENSIVE
if frmMain.lbxActiveFiles.Items.IndexOf (S+' '+M) < 0 then
begin
frmMain.lbxActiveFiles.Items.Add (S+' '+M);
if frmMain.lbxActiveFiles.Items.Count > 8 then
frmMain.lbxActiveFiles.Items.Delete(0);
end;
}
// v:=lowercase (extractfileext(S));
// for i:=low (Extensions) to high(Extensions) do
// if (Extensions[i]=V) then
begin
//add to queue
if FFilesHistory.IndexOf(S)<0 then
begin
if FFilesHistory.Count>2000 then
FFilesHistory.Clear;
FFilesHistory.Add(S);
CS.Enter;//FileSize getfileattr
FFilesOpened.Add (S);
FHasNewFileToCache := True;
CS.Leave;
end;
// Break; // isfileopen
end;
end;
if Tracks[l].B.NextEntryOf > 0 then
Move (Tracks[l].B.RawData[Tracks[l].B.NextEntryOf], Tracks[l].B.RawData[0], SizeOf(Tracks[l].B)-Tracks[l].B.NextEntryOf);
until Tracks[l].B.NextEntryOf = 0;
//We just call Track again:
Track(l);
end;
function Track(I:Integer{TrackIndex}):LongBool;
begin
//If we
Result:= ReadDirectoryChangesW( Tracks[I].H,
@Tracks[i].B,
DWord(SizeOf(Tracks[i].B)),
LongBool(1),
DWord (
FILE_NOTIFY_CHANGE_FILE_NAME or
FILE_NOTIFY_CHANGE_DIR_NAME or
FILE_NOTIFY_CHANGE_ATTRIBUTES or
FILE_NOTIFY_CHANGE_SIZE or
FILE_NOTIFY_CHANGE_LAST_WRITE or
FILE_NOTIFY_CHANGE_LAST_ACCESS or
FILE_NOTIFY_CHANGE_CREATION or
FILE_NOTIFY_CHANGE_CREATION or
FILE_NOTIFY_CHANGE_SECURITY
),
nil,//@NrBytes,
@Tracks[i].O,
@FileIOCompletionRoutine);
end;
procedure MonitorDrive (Path:String);
//We will set up a ReadDirectoryChangesW (), subtree enabled,
//to monitor all file I/O.
var i:LongBool;
j,l:Integer;
//Buffer contents:
HB:DWord;
LB:LongBool;
NrBytes:Integer;
begin
LB:=True; //Yes, recursive :)))
// for j:=32 downto 0 do
SetLength (Tracks, high(Tracks)+2);
l := high(Tracks);
Tracks[l].D := Path;
begin
HB:=SizeOf(Tracks[l].B);
Tracks[l].H
{hDir}:= CreateFile (
PChar(Path), // pointer to the file name
$1, //FILE_READ_DATA, FILE_LIST_DIRECTORY,
FILE_SHARE_READ or FILE_SHARE_DELETE, // share mode
0, // security descriptor
OPEN_EXISTING, // how to create
FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, // file attributes
0 // file with attributes to copy
);
i:= ReadDirectoryChangesW( Tracks[l].H{hDir},
@Tracks[l].B{Buf},
HB,
LongBool(1),
DWord (
FILE_NOTIFY_CHANGE_FILE_NAME or
FILE_NOTIFY_CHANGE_DIR_NAME or
FILE_NOTIFY_CHANGE_ATTRIBUTES or
FILE_NOTIFY_CHANGE_SIZE or
FILE_NOTIFY_CHANGE_LAST_WRITE or
FILE_NOTIFY_CHANGE_LAST_ACCESS or
FILE_NOTIFY_CHANGE_CREATION or
FILE_NOTIFY_CHANGE_SECURITY
),
nil,//@NrBytes,
@Tracks[l].O{verlapped},
@FileIOCompletionRoutine);
// CloseHandle (hDir); Let's keep the handle, right ?
if i then
begin
// Log ('Track succeeded '+IntToStr(Tracks[l].H))
end
else ;//Log ('Track Failed '+IntToStr(Tracks[l].H{hDir}));
end;
{ HANDLE hDirectory, // handle to the directory to be watched
LPVOID lpBuffer, // pointer to the buffer to receive the read results
DWORD nBufferLength, // length of lpBuffer
BOOL bWatchSubtree, // flag for monitoring directory or directory tree
DWORD dwNotifyFilter, // filter conditions to watch for
LPDWORD lpBytesReturned, // number of bytes returned
LPOVERLAPPED lpOverlapped, // pointer to structure needed for overlapped I/O
LPOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine // pointer to completion routine
}
end;
procedure TPreCache.Execute;
var F:TFileStream;
s,fn:String;
begin
SetLength (s, 262144); //page block size=256K
F:=nil;
while not Terminated do
begin
sleep(2);
if FHasNewFileToCache then
begin
CS.Enter;
if FFilesOpened.Count>0 then
begin
fn:=FFilesOpened[0];
FFilesOpened.Delete(0);
end
else
begin
fn:='';
FHasNewFileToCache := False;
end;
CS.Leave;
end;
if (fn<>'') and not (DirectoryExists(fn)) and FileExists(fn) then
begin
try
F:=TFileStream.Create (fn, fmOpenRead or fmShareDenyNone);
if F.Size < 12 * 1024 * 1024 then //12mB max size
begin
while F.Position < F.Size do
begin
F.Read (S[1], Length(S));
sleep (32); //<2MB/s
end;
inc (FTotPrecached, F.Size);
FPrecached := F.Size;
FreeAndNil (F);
css.Enter;
FPrecachedFile := fn;
css.Leave;
end;
except //probably file failed to open, just ignore
end;
fn := '';
try
if Assigned(F) then
FreeAndNil(F);
except end;
end;
end;
end;
There is one important thing to do. In order to recieve the callback message, the thread must be in alertable state.
This example is ran from the main thread, so we use a timer for that:
procedure TForm1.tmrAlertableStateTimer(Sender: TObject);
begin
SleepEx (2, True);
end;
If you do not call the sleepex() function, the callback routine will not get called.
Set the timer interval reasonable low (200ms or so).
Of course, it would be better to run this inside a thread, this thread would only have to loop sleepex all the time.
we start the whole stuff with this:
procedure TForm1.FormCreate(Sender: TObject);
type TDrives='C'..'Z';
var d:TDrives;
dt:Integer;
p:TPreCache;
begin
FFilesOpened := TStringList.Create;
FFilesHistory := TStringList.Create;
FFilesHistory.Sorted := True;
CS := TCriticalSection.Create;
css := TCriticalSection.Create;
//drive tracks:
for d:=low(TDrives) to high(TDrives) do
begin
dt := GetDriveType(PChar(d+':\'));
if (dt=DRIVE_FIXED) or
(dt=DRIVE_REMOTE) then
MonitorDrive(D+':\');
end;
p:=TPreCache.Create (False);
end;
Just comment in and out the parts as you like.