AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Algorithmen, Datenstrukturen und Klassendesign Delphi Konzeptfrage: Datenhaltung vieler Datei-Infos und deren Darstellg mit schneller Suche

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

Ein Thema von juergen · begonnen am 4. Jul 2015 · letzter Beitrag vom 12. Jul 2015
Antwort Antwort
Benutzerbild von Sir Rufo
Sir Rufo

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

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

  Alt 6. Jul 2015, 15: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
Antwort Antwort

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:19 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz