Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#30

AW: Konzeptfrage: Datenhaltung vieler Datei-Infos und deren Darstellg mit schneller S

  Alt 6. Jul 2015, 16:51
Hier mal so ein Minimal-Projekt im Anhang (Source + EXE) - ohne Threading, alles in einem Thread (der Start könnte etwas länger dauern)
Delphi-Quellcode:
unit Model_FileInfo;

interface

uses
  System.Generics.Collections,
  System.SysUtils;

type
  TObjectActionResult<TResult: class> = reference to procedure( AResult: TResult; AException: Exception; var ADispose: Boolean );

  TFileInfo = class
  private
    FFullName: string;
    function GetFileName: string;
    function GetPath: string;
  public
    constructor Create( const AFileName: string );
    property FullName: string read FFullName;
    property FileName: string read GetFileName;
    property Path: string read GetPath;
  end;

  TFileInfoList = class( TObjectList<TFileInfo> )
    procedure Query( APredicate: TPredicate<TFileInfo>; callback: TObjectActionResult<TFileInfoList> );
  end;

implementation

uses
  System.IOUtils;

{ TFileInfoList }

procedure TFileInfoList.Query( APredicate: TPredicate<TFileInfo>; callback: TObjectActionResult<TFileInfoList> );
var
  LItem: TFileInfo;
  LResult: TFileInfoList;
  LDispose, LDummy: Boolean;
begin
  LDispose := True;
  LResult := nil;
  try
    try

      LResult := TFileInfoList.Create( False );
      for LItem in Self do
      begin
        if APredicate( LItem ) then
          LResult.Add( LItem );
      end;

    except
      on E: Exception do
      begin
        callback( nil, E, LDummy );
        Exit;
      end;
    end;
    callback( LResult, nil, LDispose );

  finally
    if LDispose then
      LResult.Free;
  end;
end;

{ TFileInfo }

constructor TFileInfo.Create( const AFileName: string );
begin
  inherited Create;
  FFullName := AFileName;
end;

function TFileInfo.GetFileName: string;
begin
  Result := TPath.GetFileName( FFullName );
end;

function TFileInfo.GetPath: string;
begin
  Result := TPath.GetFullPath( FFullName );
end;

end.
Delphi-Quellcode:
unit Form_Main;

interface

uses
  Model_FileInfo,
  System.Diagnostics,
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class( TForm )
    ListView1: TListView;
    Edit1: TEdit;
    StatusBar1: TStatusBar;
    QueryTimer: TTimer;
    procedure ListView1Data( Sender: TObject; Item: TListItem );
    procedure Edit1Change( Sender: TObject );
    procedure QueryTimerTimer( Sender: TObject );
  private
    FQueryWatch: TStopwatch;

    FAllList: TFileInfoList;
    FHitList: TFileInfoList;
    procedure SetHitList( AHitList: TFileInfoList );
    procedure BuildAllList( );
    procedure QueryCallback( AResult: TFileInfoList; AException: Exception; var ADispose: Boolean );
    procedure QueryData( const QueryStr: string );
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.IOUtils;

{ TForm1 }

procedure TForm1.AfterConstruction;
begin
  inherited;
  BuildAllList;
  QueryData( Edit1.Text );
end;

procedure TForm1.BeforeDestruction;
begin
  inherited;
  SetHitList( nil );
  FreeAndNil( FAllList );
end;

procedure TForm1.BuildAllList;
var
  LPath, LFileName: string;
begin
  FAllList := TFileInfoList.Create( True );

  for LPath in TArray<string>.Create(
    {} TPath.GetPublicPath,
    {} TPath.GetLibraryPath,
    {} TPath.GetDocumentsPath,
    {} TPath.GetDownloadsPath,
    {} TPath.GetPicturesPath,
    {} TPath.GetMusicPath,
    {} TPath.GetMoviesPath ) do
  begin
    for LFileName in TDirectory.GetFiles( LPath, '*.*', TSearchOption.soAllDirectories ) do
    begin
      FAllList.Add( TFileInfo.Create( LFileName ) );
    end;
  end;

end;

procedure TForm1.Edit1Change( Sender: TObject );
begin
  QueryTimer.Enabled := True;
end;

procedure TForm1.ListView1Data( Sender: TObject; Item: TListItem );
var
  LItem: TFileInfo;
begin
  LItem := FHitList[ Item.Index ];
  Item.Caption := LItem.FileName;
  Item.SubItems.Add( LItem.Path );
end;

procedure TForm1.QueryCallback( AResult: TFileInfoList; AException: Exception; var ADispose: Boolean );
begin
  SetHitList( AResult );
  ADispose := False;

  FQueryWatch.Stop;

  if Assigned( AException ) then
    StatusBar1.Panels[ 1 ].Text := AException.ToString( )
  else
    StatusBar1.Panels[ 1 ].Text := string.Format( 'query finished in (%d ms)', [ FQueryWatch.ElapsedMilliseconds ] );

end;

procedure TForm1.QueryData( const QueryStr: string );
var
  LQueryStrArr: TArray<string>;
begin
  StatusBar1.Panels[ 1 ].Text := 'query data...';

  FQueryWatch := TStopwatch.StartNew;

  if QueryStr.Trim( ) = 'then
    FAllList.Query(
      function( AFileInfo: TFileInfo ): Boolean
      begin
        Result := True;
      end, QueryCallback )
  else
  begin
    LQueryStrArr := QueryStr.ToLower( ).Split( [ ' ' ] );
    FAllList.Query(
      function( AFileInfo: TFileInfo ): Boolean
      var
        LQueryStr: string;
      begin
        for LQueryStr in LQueryStrArr do
        begin
          if not AFileInfo.FullName.ToLower.Contains( LQueryStr ) then
            Exit( False );
        end;
        Result := True;
      end, QueryCallback );
  end;
end;

procedure TForm1.QueryTimerTimer( Sender: TObject );
begin
  TTimer( Sender ).Enabled := False;
  QueryData( Edit1.Text );
end;

procedure TForm1.SetHitList( AHitList: TFileInfoList );
begin
  if ( FHitList <> FAllList ) and ( FHitList <> AHitList ) then
    FreeAndNil( FHitList );
  FHitList := AHitList;

  if Assigned( FHitList ) then
  begin
    ListView1.Items.Count := FHitList.Count;
    ListView1.Repaint;
  end
  else
  begin
    ListView1.Items.Count := 0;
  end;

  ListView1.Visible := Assigned( FHitList );

  StatusBar1.Panels[ 0 ].Text := ListView1.Items.Count.ToString( );
end;

end.
Angehängte Dateien
Dateityp: zip dp_185758_minimal.zip (902,6 KB, 15x aufgerufen)
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat