De code is nog redelijk standaard, zoals je ziet.
Wat heb ik zelf allemaal ondernomen, wel als eerste heb ik het aantal files in de map naar 2500 gebracht.
Het tweede wat ik heb geprobeerd is het wijzigen van de targetdirectory, maar wat ik ook probeer hij blijft in de map plaatsen van waar alle bestanden zijn, maar dat is niet echt een groot probleem.
Wat voor mij redelijk een functionele functie zou zijn is om bij het toevoegen van bestanden, bij de laatste map wordt door gegaan tot ook die wordt aangevuld tot 2500.
Zelf had ik het idee omdat via een spinedit te doen, ik ben er achter gekomen dat dit het werk is van de functie inc (doet het optellen, als ik het goed begrepen heb).
1
Delphi Code:
unit MFB;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
Counter: integer;
BaseDirectory, TargetDirectory: string;
SearchRec: TSearchRec;
begin
BaseDirectory := IncludeTrailingPathDelimiter('G:\SL\Supertest\');
TargetDirectory := IncludeTrailingPathDelimiter('');
Counter := 0;
if FindFirst(BaseDirectory + '*.*', faAnyFile, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory) <> faDirectory then // faAnyFile geeft ook directories terug, die willen we niet
begin
Inc(Counter); // hou een tellen bij per file
if Counter mod 2500 = 1 then // per 2500
begin
// we hoeven alleen de directory aan te maken als we op een veelvoud van 1000 zitten
TargetDirectory := BaseDirectory + Format('%.3d', [Counter div 2500 + 1]);
if not ForceDirectories(TargetDirectory) then
raise Exception.CreateFmt('Error creating directory: ''%s''', [TargetDirectory]);
end;
// de werkelijke verplaatsing
if not RenameFile(BaseDirectory + SearchRec.Name, TargetDirectory + '\' + SearchRec.Name) then
raise Exception.CreateFmt('Error moving file: ''%s''', [BaseDirectory + SearchRec.Name]);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
end.
Bookmarks