@wok:
Je hebt helemaal gelijk als dat opgaat for OP.
@chlopik:
Glad to hear you got things sorted out (phun intended).
One question that remains lingering in my head... is this not just a simple filerenamer ? Because the following code will achieve exactly the same thing (without the need for sorting anything):
Code:
program copysortfiles;
{$mode delphi}{$H+}
uses
classes, sysutils, strutils;
const
// Known filename Prefix (letters) table. Their index is used as 'weight'
Prefixes: array[0..11] of string = (
'vvtf',
'vvtr',
'vvt', // very very top
'vh', // very high
'sh', // slightly high
'mh', // medium high
'mc', // middle central view
'sl', // slightly low
'vl', // very low
'b', // bottom
'vb', // very bottom
'vvb' // very very bottom
);
function getPrefixSmart(s: string; var sNum: String; var num: Integer): string;
var.
idx: Byte;
got_prefix: Boolean;
begin
Result := '';
sNum:= '';
got_prefix := false;
for idx:=1 to length(s) do
begin
case s[idx] of
'a'..'z':
begin
if not got_prefix then Result:=Result+s[idx];
end;
'0'..'9':
begin
sNum := sNum+s[idx];
if got_prefix = false then got_prefix := true;
end;
else
got_prefix := true;
end;
end;
if not TryStrToInt(sNum, num) then
writeln('ERROR: sNum:"' +sNum+ '" from '+s);
// showmessage('sNum:"'+sNum+'" from '+s);
end;
// Get the 'weight' of a prefix based on the index of prefixes.
function getPrefixWeight(Prefix: string): integer;
var
idx: integer;
begin
// correction for weight in case non-matching
result := High(Prefixes) + 1;
for idx := low(Prefixes) to High(Prefixes) do
begin
if AnsiStartsStr(Prefixes[idx], Prefix) then
begin
result := idx;
exit;
end;
end;
end;
// snatched somewhere from some forums (c) respective owner (whomever (s)he is)
// do not use in production code unless modified for safety and sanity.
// Just use the delphi copyfile function instead (fpc does not have it by default, but Lazarus does)
function VerySimpleFileCopy(Src, Dst: string; overwrite: boolean): boolean;
var
Buf: TMemoryStream;
begin
result := false;
if not FileExists(Src) then exit;
if FileExists(Dst) then
begin
if not overwrite then exit;
if not DeleteFile(Dst) then exit;
end;
Buf := TmemoryStream.Create;
try
try
Buf.LoadFromFile(Src);
Buf.SaveToFile(Dst);
result := true;
except
end;
finally
Buf.Free;
end;
end;
procedure CopyAndRenameFile(FileName, SrcFolder, DstFolder: string);
var
OldFileName,
NewFilename,
OldFullName,
NewFullName : string;
num : integer;
numStr : string;
Prefix : String;
prefixWeight : integer;
begin
OldFileName := FileName;
Prefix := GetPrefixSmart(OldFileName, NumStr, Num);
PrefixWeight := GetPrefixWeight(Prefix);
NewFileName := Format('%.*d', [2, PrefixWeight]) + '_' + Format('%.*d', [3, Num]) + '_' + OldFileName;
OldFullName := IncludeTrailingPathDelimiter(SrcFolder) + OldFileName;
NewFullname := IncludeTrailingPathDelimiter(DstFolder) + NewFileName;
if FileExists(OldFullName)
then VerySimpleFileCopy(OldFullName, NewFullName, false); // copyfile(OldFullName, NewFullName, false);
end;
procedure CopyDirAndRenameFiles(SrcDir, DstDir: string);
var
SearchRec : TSearchRec;
SearchPath : string;
begin
SearchPath := IncludeTrailingPathDelimiter(SrcDir) + AllFilesMask;
if FindFirst(SearchPath, faAnyFile, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory) = 0
then CopyAndRenameFile(SearchRec.Name, SrcDir, DstDir);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
var
AppFolderName : string;
UnsortedFolderName : string;
SortedFolderName : string;
begin
AppFolderName := ExtractFileDir(ParamStr(0));
UnSortedFolderName := AppFolderName + PathDelim + 'unsorted';
SortedFolderName := AppFolderName + PathDelim + 'sorted';
CopyDirAndRenameFiles(UnsortedFolderName, SortedFolderName);
end.
Bookmarks