disqlite3_drive_catalog_db.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 751 行 · 第 1/2 页

{ Main database access unit for the DISQLite3 Drive Catalog example.

  This unit supports both the DISQLite3 Standard and Personal editions.
  However, full Unicode support is not available with DISQLite3 Personal.

  Visit the DISQLite3 Internet site for latest information and updates:

    http://www.yunqa.de/delphi/

  Copyright (c) 2005-2007 Ralf Junker, The Delphi Inspiration <[e-mail]>

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

unit DISQLite3_Drive_Catalog_DB;

{$I DI.inc}
{$I DISQLite3.inc}

interface

uses
  Types, Windows,
  DISQLite3Cache, DISQLite3Api, DISQLite3Database;

type
  TDriveCatalogDB = class;

  //------------------------------------------------------------------------------
  // TFileCache class
  //------------------------------------------------------------------------------

  { Stores node information for the FileTree. }
  TFileData = record
    Name: WideString;
    Size: Int64;
    Time: Double;
    Attri: Integer;
    IconIdx: Integer;
    Parent: Int64;
  end;
  PFileData = ^TFileData;

  { A common cache shared by all trees accessing the Files table. }
  TFileCache = class(TDIAbstractSQLite3Cache)
  protected
    procedure DoInitializeItem(const AItem: Pointer); override;
    procedure DoFinalizeItem(const AItem: Pointer); override;
  end;

  //------------------------------------------------------------------------------
  // TDriveCatalogStatement
  //------------------------------------------------------------------------------

  { }
  TDriveCatalogStatement = class(TDISQLite3Statement)
  public

    { Binds a FileTime structure as a Julian date. }
    procedure Bind_FileTime(
      const AParamIdx: Integer;
      const AFileTime: TFileTime);

  end;

  //------------------------------------------------------------------------------
  // TDriveCatalogDB
  //------------------------------------------------------------------------------

  { Callback function triggered during indexing. }
  TAddVolumeProgressCallback = procedure(
    const AFolder: WideString;
    var AAbort: Boolean) of object;

  { }
  TDriveCatalogDB = class(TDISQLite3Database)
  private
    FFileCache: TFileCache;
    { Prepared statement for frequently used query. }
    FStmt: TDISQLite3Statement;

  protected

    procedure DoAfterConnect; override;

    procedure DoAfterCreateDatabase; override;

    procedure DoBeforeDisconnect; override;

    procedure DoInitDatabase; override;

    function GetStatementClass: TDISQLite3StatementClass; override;

  public

    { Adds a new drive. Returns the new drive's ID. }
    function AddVolume(
      const AName: WideString;
      const ARootFolder: WideString;
      const ACallback: TAddVolumeProgressCallback): Int64;

    { Recursively deletes file / folder with AID.
      Returns the ParentID of the deleted file / folder. }
    function Delete(const AID: Int64): Int64;

    { }
    function GetFileData(const AID: Int64): PFileData;

    { }
    function GetVolumeFullPath(AID: Int64; out AVolume, AFullPath: WideString): Boolean;

    { Returns the full path to AID as an array of IDs. }
    function GetIdPath(AID: Int64): TInt64DynArray;

    { }
    procedure Invalidate; overload;

    { }
    procedure Invalidate(const AID: Integer); overload;

    { Updates the name of the record. }
    procedure UpdateName(const AID: Int64; const AName: WideString);

  end;

  { }
  TInt64Rec = packed record
    case Boolean of
      False: (i64: Int64);
      True: (Lo, Hi: Cardinal);
  end;

  { Returns a string representation of the file attributes. }
function FileAttributesToString(const AFileAttributes: Integer): WideString;

{ Converts a FileTime to a Julian date. }
function FileTimeToJulianDate(const AFileTime: TFileTime): TDIJulianDate; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF}

{ Obtains the current system date and time. The result is a Julian Date
  in Coordinated Universal Time (UTC) format. }
function GetSystemTimeAsJulianDate: TDIJulianDate;

{ Returns a string representation for the given Julian date and time.
  AJulianDate is expected to be in UTC format. The result string
  will be corrected to local time. }
function JulianDateToDateTimeString(AJulianDate: TDIJulianDate): AnsiString;

{ Converts a Julian date to a TSystemTime record. }
function JulianDateToSystemTime(const AJulianDate: TDIJulianDate): TSystemTime;

{ Convertes a TSystemTime record to a Julian date. }
function SystemTimeToJulianDate(const ASystemTime: TSystemTime): TDIJulianDate;

const
  DIALOG_DATABASE_DEFAULTEXT = 'db3';
  DIALOG_DATABASE_FILTER = 'SQLite3 Database (*.db3)|*.db3|Any file (*.*)|*.*';

  { Our volume mark as a file attribute. }
  FILE_ATTRIBUTE_VOLUME = 1 shl 31;

  { If the icon index is not yet known. }
  ICON_INDEX_UNKNOWN = -2;

  TYPE_FILE = 0;
  TYPE_FOLDER = 1;
  TYPE_VOLUME = 2;

implementation

uses
  ShellAPI, SysUtils, Classes, RTLConsts,
  TntWindows, TntSysUtils
  {$IFNDEF DISQLite3_Personal}, DISQLite3Collations{$ENDIF};

//------------------------------------------------------------------------------
// TFileCache class
//------------------------------------------------------------------------------

procedure TFileCache.DoFinalizeItem(const AItem: Pointer);
begin
  Finalize(PFileData(AItem)^);
end;

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

procedure TFileCache.DoInitializeItem(const AItem: Pointer);
begin
  Initialize(PFileData(AItem)^);
end;

//------------------------------------------------------------------------------
// TDriveCatalogStatement class
//------------------------------------------------------------------------------

procedure TDriveCatalogStatement.Bind_FileTime(
  const AParamIdx: Integer;
  const AFileTime: TFileTime);
begin
  bind_double(AParamIdx, FileTimeToJulianDate(AFileTime));
end;

//------------------------------------------------------------------------------
// TDriveCatalogDB class
//------------------------------------------------------------------------------

function TDriveCatalogDB.AddVolume(
  const AName: WideString;
  const ARootFolder: WideString;
  const ACallback: TAddVolumeProgressCallback): Int64;
var
  Stmt_Insert: TDriveCatalogStatement;
  Stmt_Update_Size: TDISQLite3Statement;
  Abort: Boolean;

  function AddFolder(
    const AFolderName: WideString;
    const AParentID: Int64): Int64; // Returns total size of added files.
  var
    FD: TWIN32FindDataW;
    h: THandle;
    NewFolderID: Int64;
    NewFolderSize: Int64;
    Size: TInt64Rec;
    s: WideString;
  begin
    Result := 0;

    if Assigned(ACallback) then
      begin
        ACallback(AFolderName, Abort);
        if Abort then Exit;
      end;

    h := Tnt_FindFirstFileW(PWideChar(AFolderName + '*'), FD);
    if h <> INVALID_HANDLE_VALUE then
      begin
        repeat
          if FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
            begin
              { Add a file. }
              if FD.dwFileAttributes and FILE_ATTRIBUTE_TEMPORARY = 0 then
                begin
                  Stmt_Insert.Bind_Str16(1, FD.cFileName); // Name
                  Stmt_Insert.bind_int64(2, AParentID); // Parent
                  Stmt_Insert.bind_int(3, TYPE_FILE); // Type: File
                  Size.Hi := FD.nFileSizeHigh; Size.Lo := FD.nFileSizeLow;
                  Stmt_Insert.bind_int64(4, Size.i64); // Size
                  Inc(Result, Size.i64);
                  Stmt_Insert.Bind_FileTime(5, FD.ftLastWriteTime); // Time
                  Stmt_Insert.bind_int(6, FD.dwFileAttributes); // Attributes
                  Stmt_Insert.Step;
                  Stmt_Insert.Reset;
                end;
            end
          else
            if (FD.cFileName[0] <> '.') or not (
              (FD.cFileName[1] = #0) or
              (FD.cFileName[1] = '.') and
              (FD.cFileName[2] = #0)) then
              begin
                { Add a folder recursively. }
                s := FD.cFileName;
                Stmt_Insert.Bind_Str16(1, s); // Name
                Stmt_Insert.bind_int64(2, AParentID); // Parent
                Stmt_Insert.bind_int(3, TYPE_FOLDER); // Type: Folder
                // Size: is updated below.
                Stmt_Insert.Bind_FileTime(5, FD.ftLastWriteTime);
                Stmt_Insert.bind_int(6, FD.dwFileAttributes); // Attributes
                Stmt_Insert.Step;
                Stmt_Insert.Reset;

                NewFolderID := LastInsertRowID;
                NewFolderSize := AddFolder(AFolderName + s + '\', NewFolderID);
                { Set size to total file size of all children. }
                Stmt_Update_Size.bind_int64(1, NewFolderSize);
                Stmt_Update_Size.bind_int64(2, NewFolderID);
                Stmt_Update_Size.Step;
                Stmt_Update_Size.Reset;

                Inc(Result, NewFolderSize);
              end;
        until not Tnt_FindNextFileW(h, FD);
        Windows.FindClose(h);
      end;
  end;

var
  FN: WideString;
  Size: Int64;
begin
  StartTransaction;
  try
    Abort := False;

    Stmt_Insert := Prepare(
      'INSERT INTO"Files"("Name","Parent","Type","Size","Time","Attr")VALUES(?,?,?,?,?,?);')
      as TDriveCatalogStatement;
    Stmt_Update_Size := Prepare(
      'UPDATE "Files" SET "Size"=? WHERE "ID"=?;');

    try
      { Add the root with the catalog's name. }
      Stmt_Insert.Bind_Str16(1, AName);
      Stmt_Insert.bind_int64(2, 0);
      Stmt_Insert.bind_int(3, TYPE_VOLUME); // Mark as Volume.
      // Size: is updated below.
      Stmt_Insert.bind_double(5, GetSystemTimeAsJulianDate); // Time the volume was added.
      Stmt_Insert.bind_int(6, FILE_ATTRIBUTE_VOLUME); // Set the folder attribute.

      Stmt_Insert.Step;
      Stmt_Insert.Reset;
      Result := LastInsertRowID;

      { Add the catalog's folders recursively. }
      FN := WideIncludeTrailingPathDelimiter(ARootFolder);
      Size := AddFolder(FN, Result);

      { Update the catalog's total file size. }
      Stmt_Update_Size.bind_int64(1, Size);
      Stmt_Update_Size.bind_int64(2, Result);
      Stmt_Update_Size.Step;
      Stmt_Update_Size.Reset;
    finally
      Stmt_Update_Size.Free;
      Stmt_Insert.Free;
    end;

    if Abort then
      Rollback
    else
      Commit;
  except
    Rollback;
    raise;
  end;
end;

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

function TDriveCatalogDB.Delete(const AID: Int64): Int64;
var
  Stmt_Delete, Stmt_DeleteChildFiles, Stmt_SelectChildFolder: TDISQLite3Statement;

  { This procedure is called recursively. }
  procedure DeleteChildren(const AParentID: Int64);
  var
    ID: Int64;
  begin
    { Delete all child files first. }
    Stmt_DeleteChildFiles.bind_int64(1, AParentID);
    Stmt_DeleteChildFiles.Step;
    Stmt_DeleteChildFiles.Reset;

    { Look for remaining child folders and delete them recursively. }
    repeat
      Stmt_SelectChildFolder.bind_int64(1, AParentID);
      if Stmt_SelectChildFolder.Step = SQLITE_ROW then
        begin
          { Get ID of child folder ... }
          ID := Stmt_SelectChildFolder.column_int64(0);
          Stmt_SelectChildFolder.Reset;
          { ... delete it ... }
          Stmt_Delete.bind_int64(1, ID);
          Stmt_Delete.Step;
          Stmt_Delete.Reset;
          { ... and finally delete its children. }
          DeleteChildren(ID);
        end
      else
        begin
          Stmt_SelectChildFolder.Reset;
          Break;
        end;
    until False;
  end;

var