Dateiliste gefiltert erstellen

[tomkupitz]

Beispiel mit Kollisionsprüfung (verkettete Liste):

Code:

unit Unit1;

interface

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

type
  THashItem = class(TObject)
  public
    Key: string;

    Next: THashItem;
  end;

  THashList = class(TObject)
  private
    FItems: array of THashItem;

    function GetCount: Integer;
    function GetItem(Index: Integer): THashItem;
  public
    constructor Create(Count: Integer);
    destructor Destroy; override;

    function CreateHash(AKey: string): Integer;

    function Add(AKey: string): Boolean;
    procedure Clear;

    function Find(AKey: string): Integer;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: THashItem read GetItem;
  end;

  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor THashList.Create(Count: Integer);
begin
  inherited Create;

  SetLength(FItems, Count);
end;

destructor THashList.Destroy;
begin
  Clear;

  Finalize(FItems);

  inherited Destroy;
end;

//

function THashList.GetCount: Integer;
begin
  result:=Length(FItems);
end;

function THashList.GetItem(Index: Integer): THashItem;
begin
  if (Index>-1) and (Index<Length(FItems)) then
    result:=FItems[Index]
  else
    result:=nil;
end;

//

function THashList.Add(AKey: string): Boolean;
var i: Integer;

    Item: THashItem;

begin
  i:=CreateHash(AKey);

  if (i>-1) and (i<Length(FItems)) then
  begin
    if FItems[i]=nil then
    begin
      FItems[i]:=THashItem.Create;
      FItems[i].Key:=AKey;
    end;

    Item:=FItems[i];

    while Item.Key<>AKey do
    begin
      if Item.Next=nil then
      begin
        Item.Next:=THashItem.Create;
        Item.Next.Key:=AKey;
      end;

      Item:=Item.Next;
    end;

    if Item.Key=AKey then
    begin
      result:=True;
      Exit;
    end
  end;

  result:=False;
end;

procedure THashList.Clear;
var i: Integer;

    Item, Next: THashItem;

begin
  for i:=0 to High(FItems) do
    if FItems[i]<>nil then
    begin
      Item:=FItems[i];

      while Item<>nil do
      begin
        Next:=Item.Next;

        Item.Free;

        Item:=Next;
      end;

      FItems[i]:=nil;
    end;
end;

//

function THashList.Find(AKey: string): Integer;
var i: Integer;

    Item: THashItem;

begin
  i:=CreateHash(AKey);

  if (i>-1) and (i<Length(FItems)) then
  begin
    Item:=FItems[i];

    while (Item<>nil) and (Item.Key<>AKey) do
      Item:=Item.Next;

    if (Item<>nil) and (Item.Key=AKey) then
    begin
      result:=i;
      Exit;
    end;
  end;

  result:=-1;
end;

//

function THashList.CreateHash(AKey: string): Integer;
var i: Integer;

begin
  result:=-1;

  if Length(AKey)=0 then
    Exit;

  result:=ord(AKey[1]) mod Length(FItems);

  for i:=2 to Length(AKey) do
    result:=(result*128+ord(AKey[i])) mod Length(FItems);
end;

//

var
  hl: THashList;

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;

begin
  hl:=THashList.Create(50);

  //ListeB

  for i:=20 to 30 do
    hl.Add('File'+IntToStr(i));

  //ListeA

  for i:=0 to 100 do
    if hl.Find('File'+IntToStr(i))=-1 then
      ListBox1.Items.Add('File'+IntToStr(i))
    else
      ListBox2.Items.Add('File'+IntToStr(i));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  hl.Free;
end;

end.

###
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 433
  ClientWidth = 622
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Segoe UI'
  Font.Style = []
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  TextHeight = 15
  object Label1: TLabel
    Left = 32
    Top = 24
    Width = 32
    Height = 15
    Caption = 'ListeA'
  end
  object Label2: TLabel
    Left = 247
    Top = 24
    Width = 31
    Height = 15
    Caption = 'ListeB'
  end
  object ListBox1: TListBox
    Left = 32
    Top = 56
    Width = 209
    Height = 329
    ItemHeight = 15
    TabOrder = 0
  end
  object ListBox2: TListBox
    Left = 247
    Top = 56
    Width = 209
    Height = 329
    ItemHeight = 15
    TabOrder = 1
  end
end