{ Visit the DISQLite3 Internet site for latest information and updates:

    http://www.yunqa.de

  Copyright (c) 2005-2021 Ralf Junker, Yunqa <delphi@yunqa.de>

------------------------------------------------------------------------------ }

unit DISQLite3_Drive_Catalog_Form_Add;

{$I DICompilers.inc}
{$I DISQLite3.inc}

interface

uses
  DISystemCompat, Classes, Controls, Forms, StdCtrls, ShlObj,
  DISHChangeNotify,
  DISQLite3_Drive_Catalog_DB;

type

  { }
  TScanState = (ssReady, ssRunning, ssCancelled);

  { }
  TAutoUpdate = (auNone, auEmpty, auForce);

  //------------------------------------------------------------------------------
  // TfrmAdd Form
  //------------------------------------------------------------------------------

  { }
  TfrmAdd = class(TForm)
    lblRootFolder: TLabel;
    lblName: TLabel;
    btnClose: TButton;
    btnStartStop: TButton;
    btnBrowse: TButton;
    lblProgress: TLabel;
    btnUpdate: TButton;
    edtRootFolder: TEdit;
    edtName: TEdit;
    procedure btnStartStop_Click(Sender: TObject);
    procedure edtRootFolderChange(Sender: TObject);
    procedure Form_Create(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
    procedure edtNameChange(Sender: TObject);
    procedure btnClose_Click(Sender: TObject);
    procedure Form_CloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnUpdateClick(Sender: TObject);
    procedure Form_Destroy(Sender: TObject);
    procedure Form_KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    FDb: TDriveCatalogDB;
    FAutoName: Boolean;
    FNotify: TDISHChangeNotify;
    FState: TScanState;
    procedure AddDriveCallback(
      const AFolder: string;
      var AAbort: Boolean);
    procedure ShChangeNotify(
      const ASender: TDICustomSHChangeNotify;
      const AEvent: Cardinal;
      const APidl1, APidl2: PItemIDList);
  protected
    procedure UpdateName(const AUpdate: TAutoUpdate);
  public
    function GetRootFolder: UnicodeString;
    property DB: TDriveCatalogDB read FDb write FDb;
  end;

implementation

uses
  Windows, SysUtils, FileCtrl, {$IFDEF COMPILER_9_UP}WideStrUtils, {$ENDIF}
  DISQLite3_Drive_Catalog_Form_Main;

{$R *.dfm}

//------------------------------------------------------------------------------
// Helpers
//------------------------------------------------------------------------------

function GetVolumeName(AFolder: string): string;
var
  lpMaximumComponentLength: Cardinal;
  lpFileSystemFlags: Cardinal;
begin
  AFolder := IncludeTrailingPathDelimiter(ExtractFileDrive(AFolder));
  if AFolder <> '' then
    begin
      SetString(Result, nil, MAX_PATH);
      if GetVolumeInformation(
        PChar(AFolder),
        Pointer(Result),
        MAX_PATH,
        nil,
        lpMaximumComponentLength,
        lpFileSystemFlags,
        nil,
        0) then
        begin
          SetLength(Result, StrLen(PChar(Result)));
          Exit;
        end;
    end;
  Result := '';
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.Form_Create(Sender: TObject);
begin
  btnStartStop.Enabled := False;
  FNotify := TDISHChangeNotify.Create(nil);
  FNotify.Events :=
    SHCNE_RMDIR or
    SHCNE_MEDIAINSERTED or
    SHCNE_MEDIAREMOVED or
    SHCNE_DRIVEREMOVED or
    SHCNE_DRIVEADD;
  FNotify.OnNotify := ShChangeNotify;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.Form_Destroy(Sender: TObject);
begin
  FNotify.Free;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.Form_CloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := FState = ssReady;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.Form_KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_F5 then
    UpdateName(auForce);
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.AddDriveCallback(
  const AFolder: string;
  var AAbort: Boolean);
begin
  lblProgress.Caption := AFolder;
  Application.ProcessMessages;
  if FState = ssCancelled then
    AAbort := True;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.btnStartStop_Click(Sender: TObject);
var
  NewID: Int64;
begin
  case FState of

    ssReady:
      try
        FState := ssRunning;
        btnStartStop.Caption := 'Stop';
        btnClose.Enabled := False;
        NewID := FDb.AddVolume(edtName.Text, GetRootFolder, AddDriveCallback);
        if FState = ssCancelled then
          lblProgress.Caption := 'Cancelled'
        else
          begin
            lblProgress.Caption := 'Done';
            if Owner is TfrmMain then
              (Owner as TfrmMain).FolderTree_AddVolume(NewID);
          end;
      finally
        if FState <> ssCancelled then
          FAutoName := True;
        btnStartStop.Caption := 'Start';
        btnClose.Enabled := True;
        FState := ssReady;
      end;

    ssRunning:
      begin
        FState := ssCancelled;
      end;
  end;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.btnClose_Click(Sender: TObject);
begin
  if FState = ssReady then
    ModalResult := mrCancel;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.btnBrowseClick(Sender: TObject);
var
  s: string;
begin
  if SelectDirectory('Select the root Drive or Folder:', '', s) then
    edtRootFolder.Text := s;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.btnUpdateClick(Sender: TObject);
begin
  UpdateName(auForce);
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.edtNameChange(Sender: TObject);
begin
  FAutoName := False;
  UpdateName(auNone);
end;

//------------------------------------------------------------------------------

function TfrmAdd.GetRootFolder: UnicodeString;
begin
  Result := edtRootFolder.Text;
  if Length(Result) = 1 then
    case Result[1] of
      'A'..'Z', 'a'..'z':
        Result := Result + ':';
    end;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.ShChangeNotify(
  const ASender: TDICustomSHChangeNotify;
  const AEvent: Cardinal;
  const APidl1, APidl2: PItemIDList);
begin
  case AEvent of
    SHCNE_RMDIR, SHCNE_MEDIAREMOVED, SHCNE_DRIVEREMOVED:
      UpdateName(auEmpty);
    SHCNE_MEDIAINSERTED, SHCNE_DRIVEADD:
      UpdateName(auEmpty);
  end;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.UpdateName(const AUpdate: TAutoUpdate);
var
  DirExists: Boolean;
  OldErrorMode: Cardinal;
  rf: string;
begin
  rf := GetRootFolder;

  { Suppress the message box which is displayed by GetFileAttributes (called by
    WideDirectoryExists below) on WinNT4 if a removable drive has no media.

    The following explanation is from Win32 Help, GetVolumeInformation:

    If you are attempting to obtain information about a floppy drive that does
    not have a floppy disk or a CD-ROM drive that does not have a compact disc,
    the system displays a message box asking the user to insert a floppy disk or
    a compact disc, respectively. To prevent the system from displaying this
    message box, call the SetErrorMode function with SEM_FAILCRITICALERRORS. }
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    DirExists := {$IFDEF COMPILER_15_UP}SysUtils.{$ENDIF}DirectoryExists(rf);

    if (AUpdate = auForce) or
      ((AUpdate = auEmpty) and (edtName.Text = '')) or
      FAutoName then
      if DirExists then
        begin
          edtName.Text := GetVolumeName(rf);
          FAutoName := True;
        end
      else
        edtName.Text := '';

    btnStartStop.Enabled := DirExists and (edtName.Text <> '')
  finally
    SetErrorMode(OldErrorMode);
  end;
end;

//------------------------------------------------------------------------------

procedure TfrmAdd.edtRootFolderChange(Sender: TObject);
var
  rf: string;
  OldErrorMode: Cardinal;
  OldPidl, NewPidl: PItemIDList;
begin
  OldPidl := FNotify.NotifyPidl;

  rf := GetRootFolder;
  { Check if directory exists first, because PathToPidl can take a long time
    on networks. }
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    if {$IFDEF COMPILER_15_UP}SysUtils.{$ENDIF}DirectoryExists(rf) then
      NewPidl := PathToPIDL(rf)
    else
      NewPidl := nil;
  finally
    SetErrorMode(OldErrorMode);
  end;

  if Assigned(NewPidl) then
    begin
      FNotify.NotifyPidl := NewPidl;
      FNotify.Active := True;
    end
  else
    begin
      FNotify.Active := False;
      FNotify.NotifyPidl := nil;
    end;

  FreePidl(OldPidl);

  UpdateName(auEmpty);
end;

//------------------------------------------------------------------------------

end.

