Create Explorer in ListView

Unit DirWatch.pas

unit DirWatch;

interface

uses
  Windows, Messages, SysUtils, Forms, Classes;

type
  TNotifyFilter = (nfFilename, nfDirname, nfAttrib,
    nfSize, nfLastWrite, nfSecurity);
  TNotifyFilters = set of TNotifyFilter;
  TWatchThread = class; 
  TDirectoryWatch = class(TComponent)
  private
    fWindowHandle: THandle;
    fWatchThread: TWatchThread;
    fWatchSubDirs: boolean;
    fDirectory: string;
    fActive: boolean;
    fNotifyFilters: TNotifyFilters; 
    fOnChangeEvent: TNotifyEvent;
    procedure SetActive(aActive: boolean);
    procedure SetDirectory(aDir: string);
    procedure SetWatchSubDirs(aWatchSubDirs: boolean);
    procedure SetNotifyFilters(aNotifyFilters: TNotifyFilters);
    procedure WndProc(var aMsg: TMessage);
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Directory: string read fDirectory write SetDirectory;
    property NotifyFilters: TNotifyFilters read fNotifyFilters write SetNotifyFilters;
    property WatchSubDirs: boolean read fWatchSubDirs write SetWatchSubDirs;
    property Active: boolean read fActive write SetActive;
    property OnChange: TNotifyEvent read fOnChangeEvent write fOnChangeEvent;
  end;
  TWatchThread = class(TThread)
  private
    fOwnerHdl: Thandle;
    fChangeNotify : THandle;
    fBreakEvent: THandle; 
    fDirectory: string;
    fWatchSubDirs: longbool;
    fNotifyFilters: dword;
    fFinished: boolean; 
  protected
    procedure SetDirectory(const Value: string);
    procedure ProcessFilenameChanges;
    procedure Execute; override;
  public
    constructor Create( OwnerHdl: THandle;
      const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword);
    destructor Destroy; override;
    procedure Terminate;
    property Directory: string write SetDirectory;
  end;

procedure Register;

implementation

const
  NOTIFYCHANGE_MESSAGE = WM_USER + 1;

resourcestring
  sInvalidDir = 'Invalid Directory: ';

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

function DirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

constructor TDirectoryWatch.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  fNotifyFilters := [nfFilename, nfDirname, nfLastWrite];
  fDirectory := 'C:\';
  fWindowHandle := AllocateHWnd(WndProc);
end;

destructor TDirectoryWatch.Destroy;
begin
  Active := false;
  DeallocateHWnd(fWindowHandle);
  inherited Destroy;
end;

procedure TDirectoryWatch.WndProc(var aMsg: TMessage);
begin
  with aMsg do
    if Msg = NOTIFYCHANGE_MESSAGE then
    begin
      if assigned(OnChange) then OnChange(self);
    end else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TDirectoryWatch.SetNotifyFilters(aNotifyFilters: TNotifyFilters);
begin
  if aNotifyFilters = fNotifyFilters then exit;
  fNotifyFilters := aNotifyFilters;
  if assigned(fWatchThread) then
  begin
    Active := false;
    Active := true;
  end;
end;

procedure TDirectoryWatch.SetWatchSubDirs(aWatchSubDirs: boolean);
begin
  if aWatchSubDirs = fWatchSubDirs then exit;
  fWatchSubDirs := aWatchSubDirs;
  if assigned(fWatchThread) then
  begin
    Active := false;
    Active := true;
  end;
end;

procedure TDirectoryWatch.SetDirectory(aDir: string);
begin
  if aDir = '' then
  begin
    Active := false;
    fDirectory := '';
    exit;
  end;
  if (aDir[length(aDir)] <> '\') then aDir := aDir + '\'; 
  if aDir = fDirectory then exit;
  if not (csDesigning in ComponentState) and not DirectoryExists(aDir) then
    raise Exception.Create( sInvalidDir + aDir);
  fDirectory := aDir;
  if assigned(fWatchThread) then
    fWatchThread.Directory := fDirectory;
end;

procedure TDirectoryWatch.SetActive(aActive: boolean);
var
  nf: dword;
begin
  if aActive = fActive then exit;
  fActive := aActive;
  if csDesigning in ComponentState then exit;
  if fActive then
  begin
    if not DirectoryExists(fDirectory) then
    begin
      fActive := false;
      raise Exception.Create(sInvalidDir + fDirectory);
    end;
    nf := 0;
    if nfFilename in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_FILE_NAME;
    if nfDirname in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME;
    if nfAttrib in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES;
    if nfSize in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_SIZE;
    if nfLastWrite in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE;
    if nfSecurity in fNotifyFilters then
      nf := nf or FILE_NOTIFY_CHANGE_SECURITY;
    fWatchThread := TWatchThread.Create(
      fWindowHandle, fDirectory, fWatchSubDirs, nf);
  end else
  begin
    fWatchThread.Terminate;
    fWatchThread := nil;
  end;
end;

constructor TWatchThread.Create(OwnerHdl: THandle;
  const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword);
begin
  inherited Create(True); 
  fOwnerHdl := OwnerHdl;
  if WatchSubDirs then
    cardinal(fWatchSubDirs) := 1 
  else
    fWatchSubDirs := false;
  FreeOnTerminate := true;
  Priority := tpLowest;
  fDirectory := InitialDir;
  fNotifyFilters := NotifyFilters;
  fBreakEvent := windows.CreateEvent(nil, False, False, nil);
  Resume;
end;

destructor TWatchThread.Destroy;
begin
  CloseHandle(fBreakEvent);
  inherited Destroy;
end;

procedure TWatchThread.SetDirectory(const Value: string);
begin
  if (Value = FDirectory) then exit;
  FDirectory := Value;
  SetEvent(fBreakEvent);
end;

procedure TWatchThread.Terminate;
begin
  inherited Terminate;
  SetEvent(fBreakEvent);
  while not fFinished do sleep(10); 
end;

procedure TWatchThread.Execute;
begin
  while (not Terminated) do
  begin
    fChangeNotify := FindFirstChangeNotification(pchar(fDirectory),
      fWatchSubDirs, fNotifyFilters);
    if (fChangeNotify = INVALID_HANDLE_VALUE) then
      WaitForSingleObject(fBreakEvent, INFINITE)
    else
      try
        ProcessFilenameChanges;
      finally
        FindCloseChangeNotification(fChangeNotify);
      end;
  end;
  fFinished := true;
end;

procedure TWatchThread.ProcessFilenameChanges;
var
  WaitResult : DWORD;
  HandleArray : array[0..1] of THandle;
const
  TEN_MSECS = 10;
  HUNDRED_MSECS = 100;
begin
  HandleArray[0] := fBreakEvent;
  HandleArray[1] := fChangeNotify;
  while (not Terminated) do
  begin
    WaitResult := WaitForMultipleObjects(2, @HandleArray, False, INFINITE);
    if (WaitResult = WAIT_OBJECT_0 + 1) then 
    begin
      repeat 
        FindNextChangeNotification(fChangeNotify);
      until Terminated or
        (WaitForSingleObject(fChangeNotify, TEN_MSECS) <> WAIT_OBJECT_0);
      if Terminated then break;
      PostMessage(fOwnerHdl, NOTIFYCHANGE_MESSAGE, 0, 0);
    end else 
    begin 
      while (not Terminated) and
        (WaitForSingleObject(fBreakEvent, HUNDRED_MSECS) = WAIT_OBJECT_0) do;
      break;
    end;
  end;
end;
end.

Unit1 :

uses DirWatch

private
    DirectoryWatch: TDirectoryWatch;
    procedure RefreshView(Sender: TObject);
    
type
  TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM, dtRAM);
    
//

procedure GetDrivesList(strings: TStrings);
var
  DriveNum: Integer;
  DriveStr: array [0..3] of Char;
  DriveBits: set of 0..25;
begin
  DriveStr := '?:\'#0;
  strings.clear;
  Integer(DriveBits) := GetLogicalDrives;
  for DriveNum := 0 to 25 do
  begin
    if not (DriveNum in DriveBits) then Continue;
    DriveStr[0] := Char(DriveNum + Ord('A'));
    if TDriveType(GetDriveType(DriveStr)) = dtFixed then
      strings.Add(DriveStr);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DirectoryWatch := TDirectoryWatch.Create(self);
  DirectoryWatch.OnChange := RefreshView;
  DirectoryWatch.Directory := 'C:\';
  DirectoryWatch.Active := true;
  GetDrivesList(ComboBox1.Items);
  ComboBox1.ItemIndex := 0;
  ComboBox1Change(nil);
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.RefreshView(Sender: TObject);
var
  sr: TSearchRec;
  searchResult: integer;
  lvi: TListitem;
  attr: string;
begin
  ListView1.items.clear;
  screen.Cursor := crHourglass;
  ListView1.Items.BeginUpdate;
  try
    lvi := ListView1.Items.Add;
    lvi.Caption := '..';
    lvi.Data := pointer(-2); 
    lvi.ImageIndex := 2;
    searchResult := FindFirst(DirectoryWatch.Directory+'*.*',faAnyFile,sr);
    while searchResult = 0 do
    begin
      if sr.Name[1] <> '.' then
      begin
        lvi := ListView1.Items.Add;
        if sr.Attr and FILE_ATTRIBUTE_DIRECTORY > 0 then lvi.Data := pointer(-1);
        lvi.Caption := sr.Name;
        if lvi.Data <> nil then 
          lvi.SubItems.Add('') else
          lvi.SubItems.Add(format('%1.0n Kb',[sr.Size/1024]));
        if sr.Time = 0 then
          lvi.SubItems.Add('') else
          lvi.SubItems.Add(formatdatetime(ShortDateFormat + '  ' +
            ShortTimeFormat, FileDateToDateTime(sr.Time)));
        if lvi.Data <> nil then
          lvi.ImageIndex := 1 else
          lvi.ImageIndex := 0;
        if sr.Attr and FILE_ATTRIBUTE_READONLY > 0 then
          attr := 'R' else attr := '';
        if sr.Attr and FILE_ATTRIBUTE_ARCHIVE > 0 then
          attr := attr + 'A';
        if sr.Attr and FILE_ATTRIBUTE_SYSTEM > 0 then
          attr := attr + 'S';
        if sr.Attr and FILE_ATTRIBUTE_HIDDEN > 0 then
          attr := attr + 'H';
        lvi.SubItems.Add(attr);
      end;
      searchResult := FindNext(sr);
    end;
    findClose(sr);
  finally
    ListView1.Items.EndUpdate;
    screen.Cursor := crDefault;
  end;
  Caption := 'Exploring - ' + DirectoryWatch.Directory;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  DirectoryWatch.Directory := ComboBox1.Text;
  RefreshView(nil);
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
  lvi: TListItem;
  i: integer;
begin
  lvi := Listview1.Selected;
  if (lvi = nil) or (lvi.Data = nil) then exit;
  if lvi.Caption = '..' then
  begin
    i := length (DirectoryWatch.Directory)-1;
    if i < 3 then exit;
    while DirectoryWatch.Directory[i] <> '\' do dec(i);
    DirectoryWatch.Directory := copy(DirectoryWatch.Directory,1,i);
  end else
    DirectoryWatch.Directory :=
      DirectoryWatch.Directory + lvi.Caption;
  RefreshView(nil);
end;

procedure TForm1.ListView1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then ListView1DblClick(Sender);
end;

procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
begin
  Compare := integer(Item1.Data) - integer(Item2.Data);
  if Compare <> 0 then exit;
  Compare := CompareText(Item1.Caption, Item2.Caption);
end;