unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,DateUtils,ShellAPI;
type
TForm1 =
class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure AlleDateienImVerz(pfad:
string; gefunden:TStrings; MitUnterVerz:Boolean);
//gibt liste aller dateien im verz zurück, wahlweise mit allen in allen unterverz.
var
sr: TWin32FindData;
h: THandle;
begin
if ansilastchar(pfad)<>'
\'
then pfad:=pfad+'
\';
h:=FindFirstFile(PChar(pfad + '
*.*'),sr);
if not (h=INVALID_HANDLE_VALUE)
then
repeat
if DirectoryExists(pfad+sr.cFileName)
then
begin
if not (sr.cFileName[0]='
.')
then if MitUnterVerz
then AlleDateienImVerz(pfad+sr.cFileName,gefunden, True);
end
else
begin
gefunden.add(pfad+sr.cFileName);
end;
until Findnextfile(h,sr)=false;
windows.FindClose(h);
end;
procedure ParseDelimited(
const sl : TStrings;
const value :
string;
const delimiter :
string) ;
var
dx : integer;
ns :
string;
txt :
string;
delta : integer;
begin
delta := Length(delimiter) ;
txt := value + delimiter;
sl.BeginUpdate;
sl.Clear;
try
while Length(txt) > 0
do
begin
dx := Pos(delimiter, txt) ;
ns := Copy(txt,0,dx-1) ;
sl.Add(ns) ;
txt := Copy(txt,dx+delta,MaxInt) ;
end;
finally
sl.EndUpdate;
end;
end;
function RenameFileEx(
const AOldName, ANewName:
string;
ARenameCheck: boolean = false): boolean;
var
sh: TSHFileOpStruct;
begin
sh.Wnd := Application.Handle;
sh.wFunc := fo_Move;
// String muss mit #0#0 Terminiert werden, um das Listenende zu setzen
sh.pFrom := PChar(AOldName + #0);
sh.pTo := PChar(ANewName + #0);
sh.fFlags := fof_Silent
or fof_MultiDestFiles;
if ARenameCheck
then
sh.fFlags := sh.fFlags
or fof_RenameOnCollision;
Result:=ShFileOperation(sh)=0;
end;
Procedure Verschieben(datei:
string; woche:
string; wochentag:integer;
name:
string);
var tag,neuerpfad:
string;
begin
//Namen des Wochentags ermitteln (für Dateipfad)
if wochentag = 1
then
tag := '
Sonntag'
else if wochentag = 2
then
tag := '
Montag'
else if wochentag = 3
then
tag := '
Dienstag'
else if wochentag = 4
then
tag := '
Mittwoch'
else if wochentag = 5
then
tag := '
Donnerstag'
else if wochentag = 6
then
tag := '
Freitag'
else if wochentag = 7
then
tag := '
Samstag';
neuerpfad:='
C:\Doku\ARCHIV\replay\'+woche+'
\'+tag+'
\'+
name;
//neuer Speicherort
RenameFileEx(datei,neuerpfad);
//Datei verschieben
end;
// H I E R G E H T E S R I C H T I G L O S :
procedure TForm1.FormCreate(Sender: TObject);
var dateien,teile,datumselemente:TStringList;
i,currweek,dateweek,wochentag:integer;
pfad,dateiname,datum:
string;
begin
Application.ShowMainForm:=false;
//Kein "Fenster" anzeigen
sleep(5000);
//Abwarten, damit letzte Datei sicher fertig geschrieben ist
dateien:=TStringlist.Create;
teile:=TStringlist.Create;
datumselemente:=TStringlist.Create;
pfad:='
C:\Doku\totalrecorder';
AlleDateienImVerz(pfad, dateien, false);
//Alle Dateien aus pfad in datein laden
for I := 0
to dateien.Count - 1
//Alle Dateien nacheinander durchschleifen
do begin
dateiname:=copy(dateien[i], length(pfad)+2, 100);
//Dateiname aus pfad
ParseDelimited(teile,dateiname,'
_');
//Dateinamen aufspalten und in teile laden
ParseDelimited(datumselemente,teile[0],'
-');
//Datum aufspalten und in datumselemente laden
datum:=datumselemente[2]+'
.'+datumselemente[1]+'
.'+datumselemente[0];
//Datum wieder zusammensetzen (als DD.MM.YYYY)
currweek:=WeekOfTheYear(now);
//Aktuelle Kalenderwoche
dateweek:=WeekOfTheYear(strtodate(datum));
//Kalenderwoche, aus der die Datei stammt
wochentag:=DayOfWeek(strtodate(datum));
//Wochentag, von dem die Datei stammt
//Datei entsprechend ihrer Woche und ihres Wochentags verschieben:
if currweek-dateweek = 0
then begin
Verschieben(dateien[i], '
W_0', wochentag, dateiname)
end
else if currweek-dateweek = 1
then begin
Verschieben(dateien[i], '
W_1', wochentag, dateiname)
end
else if currweek-dateweek = 2
then begin
Verschieben(dateien[i], '
W_2', wochentag, dateiname)
end
else if currweek-dateweek = 3
then begin
Verschieben(dateien[i], '
W_3', wochentag, dateiname)
end
else if currweek-dateweek = 4
then begin
Verschieben(dateien[i], '
W_4', wochentag, dateiname)
end
else if currweek-dateweek = 5
then begin
Verschieben(dateien[i], '
W_5', wochentag, dateiname)
end
else if currweek-dateweek = 6
then begin
Verschieben(dateien[i], '
W_6', wochentag, dateiname)
end
end;
dateien.free;
teile.Free;
datumselemente.free;
Application.Terminate;
end;
end.