FileExists/FileDate - Auslesen über Netzwerk langsam

[dGeek]

Beides NTFS.

Zur StringList. Ja ich weiß, nicht gut.
Aber auf diese Art und Weise kann ich die Funktion ( GetFilesInDirectory ) mit und ohne Record benutzen:
procedure GetFilesInDirectory(Directory: string; const Mask: string; List: TStrings; WithSubDirs, AsObjectList, ClearList: Boolean); Ich weiß. Der Variablenname ist total missverständlich aber so funktioniert es:

Delphi-Quellcode:

type
 PFileListEntry = ^TFileListEntry;

 TFileListEntry = packed record
  sFileName: string;
  iFileSize: Int64;
  iFileDate: Extended;
 end;

procedure GetFilesInDirectory(Directory: string; const Mask: string; List: TStrings; WithSubDirs, AsObjectList, ClearList: Boolean);
var
 aFileListEntry: PFileListEntry;

  procedure ScanDir(const Directory: string);
  var
   SR: TSearchRec;
  begin
   if FindFirst(Directory + Mask, faAnyFile and not faDirectory, SR) = 0 then
    try
     repeat
      Application.ProcessMessages;

      /// //////////////////////////////////////////////////////////////////////////////////
      if AsObjectList then
       begin
        System.New(aFileListEntry);
        aFileListEntry.sFileName := SR.Name;
        aFileListEntry.iFileSize := SR.Size;
        aFileListEntry.iFileDate := SR.TimeStamp;
        List.AddObject('F_' + SR.Name, Pointer(aFileListEntry));
       end
      else
       begin
        List.Add(SR.Name);
       end;
      /// //////////////////////////////////////////////////////////////////////////////////

     until FindNext(SR) <> 0;
    finally
     FindClose(SR);
    end;

   if WithSubDirs then
    begin
     if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then
      try
       repeat
        Application.ProcessMessages;

        if ((SR.attr and faDirectory) = faDirectory) and (SR.Name <> '.') and (SR.Name <> '..') then
         ScanDir(Directory + SR.Name + '');
       until FindNext(SR) <> 0;
      finally
       FindClose(SR);
      end;
    end;
  end;

begin
  List.BeginUpdate;
  
  try
   if ClearList then
    List.Clear;
  
  if Directory = '\' then
    Exit;

    if Directory[Length(Directory)] <> '\' then
    Directory := Directory + '\';

    ScanDir(Directory);
  finally
   List.EndUpdate;
  end;
end;

function IndexOfListObjects(const s: string; List: TStringList): Integer;
begin
 for Result := 0 to List.Count - 1 do
  if s = PFileListEntry(List.Objects[Result])^.sFileName then
   Exit;

 Result := -1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 freq: Int64;
 startTime: Int64;
 endTime: Int64;

 i, iDestFileIndex: Integer;
 sSourceDir, sDestDir: String;
 slSource, slDest: TStringList;

 aFileListEntrySource, aFileListEntryDest: TFileListEntry;
begin
 QueryPerformanceFrequency(freq);
 QueryPerformanceCounter(startTime);

 slSource := TStringList.Create;
 slDest := TStringList.Create;

 try
  sSourceDir := 'D:\Test1\'; // behinhaltet 10.000 Dateien
  sDestDir := 'D:\Test2\'; // behinhaltet ebenfalls 10.000 Dateien, welche identisch sind

  GetFilesInDirectory(sSourceDir, '*.*', slSource, True, True, False);
  GetFilesInDirectory(sDestDir, '*.*', slDest, True, True, False);

  for i := 0 to slSource.Count - 1 do
   begin
    Application.ProcessMessages;

    aFileListEntrySource := PFileListEntry(slSource.Objects[i])^;

    iDestFileIndex := IndexOfListObjects(aFileListEntrySource.sFileName, slDest);
    if iDestFileIndex > -1 then
     begin
      aFileListEntryDest := PFileListEntry(slDest.Objects[iDestFileIndex])^;

      if aFileListEntrySource.iFileDate > aFileListEntryDest.iFileDate then
       begin
        // Tue was auch immer mit aFileListEntrySource
       end;
     end;
   end; // for
 finally
  for i := 0 to slSource.Count - 1 do
   Dispose(PFileListEntry(slSource.Objects[i]));

  for i := 0 to slDest.Count - 1 do
   Dispose(PFileListEntry(slDest.Objects[i]));

  slSource.Free;
  slDest.Free;
 end;

 QueryPerformanceCounter(endTime);
 showmessage('Die Routine benötigte etwa ' + IntToStr((endTime - startTime) * 1000 div freq) + 'ms');
end;