disqlite3_drive_catalog_db.pas

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

  ParentID, Size: Int64;
  Stmt, Stmt_SelectParent, Stmt_UpdateSize: TDISQLite3Statement;
begin
  { First delete all children. }

  Stmt_Delete := Prepare('DELETE FROM "Files" WHERE "ID"=?;');
  Stmt_DeleteChildFiles := Prepare('DELETE FROM "Files" WHERE "Type"=0 AND "Parent"=?;');
  Stmt_SelectChildFolder := Prepare('SELECT "ID" FROM "Files" WHERE "Type"=1 AND "Parent"=?;');
  try
    DeleteChildren(AID);
  finally
    Stmt_SelectChildFolder.Free;
    Stmt_DeleteChildFiles.Free;
    Stmt_Delete.Free;
  end;

  { Retrieve ParentID and Size of record to delete. }

  Stmt := Prepare('SELECT "Parent", "Size" FROM "Files" WHERE "ID"=?;');
  try
    Stmt.bind_int64(1, AID);
    if Stmt.Step = SQLITE_ROW then
      begin
        Result := Stmt.column_int64(0);
        Size := Stmt.column_int64(1);
      end
    else
      begin
        Result := -1;
        Size := 0;
      end;
  finally
    Stmt.Free;
  end;

  if Result = -1 then Exit;

  { Delete the record itself. }

  Stmt := Prepare('DELETE FROM "Files" WHERE "ID"=?;');
  try
    Stmt.bind_int64(1, AID);
    Stmt.Step;
  finally
    Stmt.Free;
  end;

  { Propagate the size change to the parent records. }

  ParentID := Result;
  Stmt_UpdateSize := Prepare('UPDATE "Files" SET "Size"="Size"-? WHERE "ID"=?;');
  Stmt_SelectParent := Prepare('SELECT "Parent" FROM "Files" WHERE "ID"=?;');
  try
    repeat
      Stmt_UpdateSize.bind_int64(1, Size);
      Stmt_UpdateSize.bind_int64(2, ParentID);
      Stmt_UpdateSize.Step;
      Stmt_UpdateSize.Reset;

      Stmt_SelectParent.bind_int64(1, ParentID);
      if Stmt_SelectParent.Step = SQLITE_ROW then
        begin
          ParentID := Stmt_SelectParent.column_int64(0);
          Stmt_SelectParent.Reset;
        end
      else
        begin
          Break;
        end;
    until False;
  finally
    Stmt_SelectParent.Free;
    Stmt_UpdateSize.Free;
  end;
end;

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

procedure TDriveCatalogDB.DoAfterConnect;
begin
  FFileCache := TFileCache.Create(SizeOf(TFileData), 7681); // 7681 is the first prime > (5120 * 1.5)
  FFileCache.MaxCount := 5120;

  FStmt := Prepare('SELECT "Name", "Size", "Time", "Attr", "Parent" FROM "Files" WHERE "ID"=?;');

  inherited;
end;

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

procedure TDriveCatalogDB.DoAfterCreateDatabase;
begin
  Execute(
    'PRAGMA legacy_file_format=OFF;');

  Execute(
    'CREATE TABLE "Files" (' +
    'ID Integer PRIMARY KEY,' + // Unique identifier.
    'Name Text,' + // Name of the volume, folder or file.
    'Parent Integer,' + // Identifier of parent of 0 if no parent.
    'Type Integer,' + // One of the TYPE_... constants.
    'Size Integer,' + // Size in bytes.
    'Time Double,' + // Date and Time in UTC JulianDate form when the file was last written to.
    'Attr Integer,' + // Attributes (DOS, as in WIN32_FIND_DATA), or NULL.
    'Desc Text,' + // Optional Description.
    'Hash Integer);'); // Optional CRC32 value of the file.

  Execute(
    'CREATE INDEX "Files_Parent_Type" ON "Files" ("Parent","Type");');

  inherited;
end;

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

procedure TDriveCatalogDB.DoBeforeDisconnect;
begin
  FStmt.Free;
  FFileCache.Free;

  inherited;
end;

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

procedure TDriveCatalogDB.DoInitDatabase;
begin
  {$IFNDEF DISQLite3_Personal}
  Check(sqlite3_create_collation(Handle, 'NOCASE', SQLITE_UTF16LE, nil, SQLite3_Compare_User_NoCase_UTF16LE));
  {$ENDIF !DISQLite3_Personal}
end;

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

function TDriveCatalogDB.GetStatementClass: TDISQLite3StatementClass;
begin
  Result := TDriveCatalogStatement;
end;

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

function TDriveCatalogDB.GetVolumeFullPath(AID: Int64; out AVolume, AFullPath: WideString): Boolean;
var
  FileData: PFileData;
  s: WideString;
begin
  FileData := GetFileData(AID);
  Result := Assigned(FileData);
  if Result then
    begin
      AVolume := '';
      AFullPath := '';
      repeat
        s := FileData^.Name;
        AID := FileData^.Parent;
        if AID <> 0 then
          begin
            Insert(s, AFullPath, 1);
            Insert('\', AFullPath, 1);
          end
        else
          begin
            AVolume := s;
            Break;
          end;
        FileData := GetFileData(AID);
      until not Assigned(FileData);
    end;
end;

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

function TDriveCatalogDB.GetFileData(const AID: Int64): PFileData;
var
  Info: TShFileInfoW;
begin
  Result := FFileCache.GetItem(AID);
  if not Assigned(Result) then
    begin
      Result := FFileCache.AddItem(AID);
      FStmt.bind_int64(1, AID);
      try
        if FStmt.Step = SQLITE_ROW then
          begin
            Result^.Name := FStmt.Column_Str16(0);
            Result^.Size := FStmt.column_int64(1);
            Result^.Time := FStmt.column_double(2);
            Result^.Attri := FStmt.column_int(3);
            Result^.Parent := FStmt.column_int64(4);

            { Is this a file (not a volume or a folder), then get the system icon index. }
            if Result^.Attri and (FILE_ATTRIBUTE_VOLUME or FILE_ATTRIBUTE_DIRECTORY) = 0 then
              if Tnt_SHGetFileInfoW(PWideChar(Result^.Name), FILE_ATTRIBUTE_NORMAL, Info, SizeOf(Info), SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON) <> 0 then
                Result^.IconIdx := Info.iIcon
              else
                Result^.IconIdx := -1;
          end;
      finally
        FStmt.Reset;
      end;
    end;
end;

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

function TDriveCatalogDB.GetIdPath(AID: Int64): TInt64DynArray;
var
  l, s: Integer;
  FileData: PFileData;
  Temp: Int64;
begin
  l := 1;
  SetLength(Result, l);
  Result[0] := AID;

  repeat
    FileData := GetFileData(AID);
    if Assigned(FileData) then
      begin
        AID := FileData^.Parent;
        if AID = 0 then Break;

        Inc(l);
        SetLength(Result, l);
        Result[l - 1] := AID;
      end
    else
      Break;
  until False;

  { Revert. }
  if l > 1 then
    begin
      s := 0;
      Dec(l);
      repeat
        Temp := Result[l];
        Result[l] := Result[s];
        Result[s] := Temp;
        Inc(s); Dec(l);
      until s > l;
    end;
end;

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

procedure TDriveCatalogDB.Invalidate;
begin
  FFileCache.Invalidate;
end;

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

procedure TDriveCatalogDB.Invalidate(const AID: Integer);
begin
  FFileCache.InvalidateItem(AID);
end;

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

procedure TDriveCatalogDB.UpdateName(const AID: Int64; const AName: WideString);
var
  Stmt: TDISQLite3Statement;
begin
  Stmt := Prepare('UPDATE "Files" SET "Name"=? WHERE "ID"=?;');
  try
    Stmt.Bind_Str16(1, AName);
    Stmt.bind_int64(2, AID);
    Stmt.Step;
    Invalidate(AID);
  finally
    Stmt.Free;
  end;
end;

//------------------------------------------------------------------------------
// Utility Routines
//------------------------------------------------------------------------------

function FileAttributesToString(const AFileAttributes: Integer): WideString;
begin
  if AFileAttributes and FILE_ATTRIBUTE_TEMPORARY <> 0 then
    Result := Result + 'T';
  if AFileAttributes and FILE_ATTRIBUTE_SYSTEM <> 0 then
    Result := Result + 'S';
  if AFileAttributes and FILE_ATTRIBUTE_READONLY <> 0 then
    Result := Result + 'R';
  if AFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
    Result := Result + 'H';
  if AFileAttributes and FILE_ATTRIBUTE_ARCHIVE <> 0 then
    Result := Result + 'A';
end;

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

function FileTimeToJulianDate(const AFileTime: TFileTime): TDIJulianDate; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF}
begin
  Result := LARGE_INTEGER(AFileTime).QuadPart / 864000000000 + 2305813.5;
end;

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

function GetSystemTimeAsJulianDate: TDIJulianDate;
var
  ft: TFileTime;
begin
  GetSystemTimeAsFileTime(ft);
  Result := FileTimeToJulianDate(ft);
end;

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

function JulianDateToFileTime(const AJulianDate: TDIJulianDate): TFileTime;
begin
  LARGE_INTEGER(Result).QuadPart := Trunc((AJulianDate - 2305813.5) * 864000000000);
end;

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

function JulianDateToDateTimeString(AJulianDate: TDIJulianDate): AnsiString;
var
  Date, Time: AnsiString;
  l: Integer;
  ft: TFileTime;
  st: TSystemTime;
begin
  FileTimeToLocalFileTime(JulianDateToFileTime(AJulianDate), ft);
  FileTimeToSystemTime(ft, st);

  { Get the date string. }
  l := GetDateFormat(LOCALE_USER_DEFAULT, 0, @st, nil, nil, 0);
  SetString(Date, nil, l - 1);
  GetDateFormat(LOCALE_USER_DEFAULT, 0, @st, nil, Pointer(Date), l);

  { Get the time string. }
  l := GetTimeFormat(LOCALE_USER_DEFAULT, 0, @st, nil, nil, 0);
  SetString(Time, nil, l - 1);
  GetTimeFormat(LOCALE_USER_DEFAULT, 0, @st, nil, Pointer(Time), l);

  Result := Date + #$20 + Time;
end;

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

function JulianDateToSystemTime(const AJulianDate: TDIJulianDate): TSystemTime;
var
  Year, Month, Day, Hour, Minute, Second: Integer;
begin
  DISQLite3Api.JulianDateToYmd(AJulianDate, Year, Month, Day);
  Result.wYear := Year;
  Result.wMonth := Month;
  Result.wDayOfWeek := Trunc(AJulianDate + 1.5) mod 7;
  Result.wDay := Day;

  DISQLite3Api.JulianDateToHms(AJulianDate, Hour, Minute, Second);
  Result.wHour := Hour;
  Result.wMinute := Minute;
  Result.wSecond := Second;
  Result.wMilliSeconds := 0;
end;

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

function SystemTimeToJulianDate(const ASystemTime: TSystemTime): TDIJulianDate;
begin
  with ASystemTime do Result :=
    DISQLite3Api.YmdToJulianDate(wYear, wMonth, wDay) +
      DISQLite3Api.HmsToJulianDate(wHour, wMinute, wSecond);
end;

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

end.