In my application I need to copy over 1000 small files
Here is the code I am using but it is VERY SLOW
Is there a better way of doing this ?
procedure Tdatafeeds.RestotreTodaysFiles;
var
SearchRec: TSearchRec;
FromFn, ToFn: string;
Begin
if DirectoryExists(BackupPath1) then
begin
try
if FindFirst(BackupPath1 + '\*.*', (faAnyFile AND NOT(faDirectory)), SearchRec) = 0 then
begin
repeat
FromFn := BackupPath1 + '\' + SearchRec.name;
ToFn := DatafeedsPath1 + '\' + SearchRec.name;
CopyFile(Pchar(FromFn), Pchar(ToFn), false);
until FindNext(SearchRec) <> 0;
end;
finally
FindClose(SearchRec);
end;
end;
End;
Definitely go with SHFileOperation() as suggested above, CopyFile is way too slow for that many files. It looks like you are basically restoring an entire folder so the search function may be unnecessary and slow things down further. Something like this may be of help:
uses ShellApi;
function CopyDir(const fromDir, toDir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(#fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
This function will raise a prompt to overwrite existing files though (maybe it can be tweaked to skip that) but the user can select "All" so it's a one-click procedure, much faster, has a progress bar and can be canceled if desired.
You can use the SHFileOperation() API call and use a wildcard in the file name of the struct. That way one call would be used to copy all of the files in one go. There's even the possibility to show the progress (via a callback function) and allow the user to cancel the operation.
I can't test your code right now, but check out this corrected version
// (!) faAnyFile-faDirectory <--- this is wrong
// we don't subtract flag values because the value will be meaningless
if FindFirst(BackupPath1 + '\*.*', faAnyFile, SearchRec) = 0 then
begin
repeat
if not (SearchRec.Attr and faDirectory)
And SearchRec.Name <> "."
And SearchRec.Name <> ".." Then
Begin
FromFn := BackupPath1 + '\' + SearchRec.name;
ToFn := DatafeedsPath1 + '\' + SearchRec.name;
CopyFile(Pchar(FromFn), Pchar(ToFn), false);
End;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
Perhaps you might experiment with reading a bunch of files into memory and then writing them all to disk at once (like XCOPY). That might be nicer on the filesystem.
Related
I have just installed Delphi Community Edition and thought as a newbie I was doing well until I hit the FindFirst() procedure.
What I have is a directory list:
c:\BFUtils\01Utils
\02Utils
\03Utils
\04Utils
Then, to try out FindFirst() to get the subdirectories of BFUtils, I wrote the following code, which I feel is needed to simply count the number of subdirectories:
sStartPath := 'c:\BFUtils';
Result := 0;
res := FindFirst(sStartPath, faDirectory, SearchRec);
if res = 0 then begin
try
while res = 0 do begin
if SearchRec.FindData.dwFileAttributes and faDirectory <> 0 then begin
Name := SearchRec.FindData.cFileName;
if (Name <> '.') and (Name <> '..') then begin
inc(Result);
end;
end;
res := FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
end;
This, as it is, compiles and runs, but it only finds the BFUtils directory.
Searching the Internet, I feel that the file mask (sStartPath) is not correct. So I have tried:
sStartPath + '\'
sStartPath + '\*'
sStartPath + '\*.'
sStartPath + '\*.*
All these options will compile and link without errors, but when the program runs it displays an error:
"'.'" is an Invalid Item.
What else can I try here?
In modnern Delphi versions you don't necessarily need to work with FindFirst, FindNext and FindClose directly anymore!
Add the unit System.IOUtils to a uses section in your unit.
There is, among some others, the record TDirectory:
Contains a large number of static utility methods used in directory manipulations.
TDirectory is a record containing only static methods used to perform
various operations on directories. You should not declare variables of
type TDirectory, since TDirectory has no instance methods or fields.
Possible operations that can be completed using TDirectory include:
Creating, renaming, and deleting directories.
Traversing directories (also recursively).
Manipulating directory attributes and timestamps.
For finding all subdirectories you can then use one of the overloaded GetDirectories methods:
Use GetDirectories to obtain a list of subdirectories in a given
directory. The return value of GetDirectories is a dynamic array of
strings in which each element stores the name of a subdirectory.
There are three forms of the GetDirectories method:
The first form only accepts the path of the directory for which subdirectories are enumerated.
The second form includes a search pattern used when matching subdirectory names.
The third form includes an option specifying whether a recursive mode will be used while enumerating.
So for counting all subdirectories you can simply do the following:
function SubDirCount(const Path: string): integer;
begin
result := Length(TDirectory.GetDirectories(Path));
end;
// somewhere else
ShowMessage(SubDirCount('C:\BFUtils').ToString);
And for your original code use this as a FileMask: sStartPath + '\.*'
You are asking FindFirst() to locate your c:\BFUtils folder itself. To enumerate the contents of that folder, you need to use a wildcard mask instead:
function CountSubDirs(const Path: string): Integer;
var
sMask: string;
SearchRec: TSearchRec;
res: Integer;
begin
Result := 0;
sMask := IncludeTrailingPathDelimiter(Path) + '*'; // or '*.*'
res := FindFirst(sMask, faDirectory, SearchRec);
if res <> 0 then
begin
if res <> ERROR_FILE_NOT_FOUND then
RaiseLastOSError(res);
end else
begin
try
repeat
if (SearchRec.FindData.dwFileAttributes and faDirectory) = faDirectory then
begin
if (StrComp(SearchRec.FindData.cFileName, '.') <> 0) and
(StrComp(SearchRec.FindData.cFileName, '..') <> 0) then
begin
Inc(Result);
end;
end;
res := FindNext(SearchRec);
until res <> 0;
if res <> ERROR_NO_MORE_FILES then
RaiseLastOSError(res);
finally
FindClose(SearchRec);
end;
end;
end;
var NumSubDirs: Integer;
NumSubDirs := CountSubDirs('c:\BFUtils');
That has always worked fine for me. If it is not working for you, then something else is wrong with code you have not shown yet, as there is nothing in the code actually shown that can cause the "'.'" is an Invalid Item error message you claim.
I want to copy only pdf files. I am using this method, if i know file name:
CopyFile(PChar(obPath.CaseTmpPath + '\' + currentCase.patientCase + '\Info_' + currentCase.patientCase + '.cxt'), PChar(obPath.ServerData + currentCase.patientCase + '\Info_' + currentCase.patientCase + '.cxt'), true);
this time, i dont know filenames. There are some files in directory like pdfs, jpegs. I just want to copy pdf files but how ?
If you work with Windows only and you're not interested in code portability you can revert to win api:
uses
ShellApi;
function MultiFileCopy(const ASource, ADest: string): Boolean;
var
FO: TSHFileOpStruct;
begin
FillChar(FO, SizeOf(FO), #0);
FO.Wnd := 0;
FO.wFunc := FO_COPY;
FO.pFrom := PChar(ASource + #0);
FO.pTo := PChar(ADest + #0);
FO.fFlags := FOF_FILESONLY or FOF_NOERRORUI or FOF_NOCONFIRMATION or FOF_SILENT;
Result := (SHFileOperation(FO) = 0)and(not FO.fAnyOperationsAborted);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(BoolToStr(MultiFileCopy('C:\*.pdf', 'X:\'), True));
end;
The code above contains some trick to make method totally silent, please read documentation about SHFileOperation for flags and about SetErrorMode (as David noted SetErrorMode(SEM_FAILCRITICALERRORS) should be called only once during application initialization)
As Remy said in comment #0 are there because double null terminated strings are required.
I need to parse every single file in a directory including the files in sub directories and sub sub directories and ...
I have already successfully done this using the code below :
class function TATDFTPUtility.findAllDirectoryFiles(var ftpClient: TIdFTP; directory: String; deepness: Integer = 0): TidFTPListItems;
var
I: Integer;
localDirectoryListing: TIdFTPListItems;
baseDirectory: string;
begin
Result := TIdFTPListItems.Create;
*// this function uses ftpClient.ChangeDirUp until it reaches the '' directory*
changeUpToDirectory(ftpClient, '');
try
ftpClient.ChangeDir(directory);
ftpClient.List;
Result.Assign(ftpClient.DirectoryListing);
localDirectoryListing := Result;
baseDirectory := ftpClient.RetrieveCurrentDir;
for I := 0 to localDirectoryListing.Count - 1 do
begin
if (localDirectoryListing.Items[i].ItemType = ditDirectory) then
begin
result := addTwoFTPListItems(result, findAllDirectoryFiles(ftpClient, baseDirectory + '/' + localDirectoryListing.Items[i].FileName));
end;
end;
except
end;
end;
class function TATDFTPUtility.addTwoFTPListItems(listA: TIdFTPListItems; listB: TIdFTPListItems): TidFTPListItems;
var
i: integer;
begin
Result := listA;
for I := 0 to listB.Count - 1 do
begin
with Result.Add do
begin
Data := listB.Items[i].data;
Size := listB.Items[i].Size;
ModifiedDate := listB.Items[i].ModifiedDate;
LocalFileName := listB.Items[i].LocalFileName;
FileName := listB.Items[i].FileName;
ItemType := listB.Items[i].ItemType;
SizeAvail := listB.Items[i].SizeAvail;
ModifiedAvail := listB.Items[i].ModifiedAvail;
PermissionDisplay := listB.Items[i].PermissionDisplay;
end;
end;
end;
Now the problem is that this takes about 15-20 minutes !!!
Is there a more efficient way ?
Here is a few fact about this particular case :
1- After i ran the program it found about 12000 files with almost 100-200 directories but the highest deepness was about 7
2- I only need to parse and i do not need to download or upload anything
3- The reason i have used an exception is because inside the FTP there are a few folder which i do not have access and this causes an access violation Error in IdFTP and i used try...except to ignore any directory which can not be accessed.
You are calling ChangeDirUp() (potentially many times?) and then calling ChangeDir() afterwards. If directory is an absolute path, you can just call ChangeDir() one time to jump directly to the target folder and avoid ChangeDirUp() altogether. The recursive loop inside of findAllDirectoryFiles() is using absolute paths from RetrieveCurrentDir(), so the repeated calls to ChangeDirUp() and ChangeDir() are wasted overhead. You can greatly reduce overhead by not navigating up and down the folder tree unnecessarily.
findAllDirectoryFiles() is returning a newly allocated TIdFTPListItems that the caller must free. That in itself is generally a bad design choice, but especially in this case because the recursive loop is not freeing those secondary TIdFTPListItems objects at all, so they are being leaked.
When adding files to the output TIdFTPListItems, you are only adding their filenames and not their paths. What good is recursively searching for files if the caller does not know where each file was found? Or do you only care about the filenames and not the paths?
You are ignoring the deepness parameter completely.
With that said, try something more like this instead:
class procedure TATDFTPUtility.findAllDirectoryFiles(ftpClient: TIdFTP; const directory: String;var files: TIdFTPListItems; deepness: Integer = -1);
var
I: Integer;
baseDirectory: string;
subDirectories: TStringList;
item: TIdFTPListItem;
localDirectoryListing: TIdFTPListItems;
begin
try
if directory <> '' then
ftpClient.ChangeDir(directory);
ftpClient.List;
except
Exit;
end;
baseDirectory := ftpClient.RetrieveCurrentDir;
localDirectoryListing := ftpClient.DirectoryListing;
subDirectories := nil;
try
for I := 0 to localDirectoryListing.Count - 1 do
begin
case localDirectoryListing[i].ItemType of
ditFile: begin
item := files.Add;
item.Assign(localDirectoryListing[i]);
// if you need the full path of each file...
item.FileName := baseDirectory + '/' + item.FileName;
end;
ditDirectory: begin
item := localDirectoryListing[i];
if ((item.FileName <> '.') and (item.FileName <> '..')) and
((deepness = -1) or (deepness > 0)) then
begin
if subDirectories = nil then
subDirectories := TStringList.Create;
subDirectories.Add(baseDirectory + '/' + item.FileName);
end;
end;
end;
end;
if subDirectories <> nil then
begin
if (deepness > 0) then Dec(deepness);
for I := 0 to subDirectories.Count - 1 do begin
findAllDirectoryFiles(ftpClient, subDirectories[I], files, deepness);
end;
end;
finally
subDirectories.Free;
end;
end;
When calling findAllDirectoryFiles() for the first time, you can set directory to either:
a blank string to start searching in the current directory.
a subfolder that is relative to the current directory.
an absolute folder that is relative to the server's root.
And set deepness to either
-1 for endless recursion
>= 0 to specify how deep to recurse.
files := TIdFTPListItems.Create;
try
TATDFTPUtility.findAllDirectoryFiles(ftpClient, 'desired directory', files, desired deepness);
// use files as needed...
finally
files.Free;
end;
I am using the latest version of Lazarus IDE and I have a Memo1 on my TForm1. I have to load a text file in Memo1 and then edit every line of the Memo (I use Memo1.Lines.Strings[i] := ...). At the end I must save the edited memo at a particular path.
Question: I am looking for the faster way between:
Load the whole text inside the memo, edit its content and save into a new file (load all -> edit all -> write all)
Do a while loop (until the end of my *.txt file) that reads the file line by line, edit the content and save it in the new file. (load line -> edit -> write | load -> edit -> write | load line -> edit -> write | ...)
I am pretty new with Delphi developing, and I have also read some pages about TStringLists. My text file is going to have a lot of lines (It could have 5000+ lines) and I don't want that my program loses performance.
Any suggestion? Should I use TStringList or one of the two methods I listed before?
5000 lines isn't a lot, unless the strings are very long.
The easiest way is to use a TStringList. There's no need to use a GUI control unless the user needs to see or edit the content.
var
SL: TStringList;
i: Integer;
begin
SL := TStringList.Create;
try
SL.LoadFromFile(YourFileNameHere);
for i := 0 to SL.Count - 1 do
begin
SL[i] := IntToStr(i) + ' ' + SL[i];
// Do any other processing
end;
SL.SaveToFile(YourFileNameHere);
finally
SL.Free;
end;
end;
If (as you say in a comment above) you need to do this in a TMemo for testing purposes, you can do it the same way:
Memo1.Lines.LoadFromFile(YourFileNameHere);
for i := 0 to Memo1.Lines.Count - 1 do
Memo1.Lines[i] := IntToStr(i) + ' ' + Memo1.Lines[i];
Memo1.Lines.SaveToFile(YourFileNameHere);
Of course, the easiest way to do this would be to write a procedure that accepts a plain TStrings descendent of any sort:
procedure AppendValueToStrings(const SL: TStrings;
StartingValue: Integer);
var
i: Integer;
begin
Assert(Assigned(SL)); // Make sure a valid TStrings has been passed in
for i := 0 to SL.Count - 1 do
begin
SL[i] := IntToStr(StartingValue) + ' ' + SL[i];
Inc(StartingValue);
end;
end;
Then you can call it with either one:
SL := TStringList.Create;
try
SL.LoadFromFile(YourFileNameHere);
AppendValueToStrings(SL, 10);
SL.SaveToFile(YourFileNameHere);
finally
SL.Free;
end;
Memo1.Lines.LoadFromFile(YourFileNameHere);
AppendValueToStrings(Memo1.Lines, 10);
Memo1.Lines.SaveToFile(YourFileNameHere);
I have a small application that is used to process some files made in another program.
I use an older component by Angus Johnson called TDirectoryWatch
On my FormCreate I have the following code
DirectoryWatch := TDirectoryWatch.Create(self);
DirectoryWatch.OnChange := FileAction;
DirectoryWatch.Directory := Folders.Path(dirInput);
DirectoryWatch.Active := True;
If the program is started and there is put a new file in the directory everything fires and runs OK.
But if there is a file in the directory when the program is started nothing happens even if I make a call to FileAction(nil);
FileAction is the name of the procedure that handles the files
I have a call to FileAction from a popupmenu and that handles the files in the directory
So my question is: how to make sure that existing files are handled at program start?
Or is there a better way to handle this problem.
Added code for FileAction
procedure TfrmMain.FileAction(Sender: TObject);
var
MailFile: string;
MailInfo: TMailInfo;
ListAttachments: TstringList;
i: integer;
MailBody: string;
begin
for MailFile in TDirectory.GetFiles(Folders.Path(dirInput), CheckType) do
begin
if FileExists(MailFile) then
begin
MailInfo := TMailInfo.Create(MailFile);
try
if FileProcessing = False then
begin
Logfile.Event('Behandler fil: ' + MailFile);
FileProcessing := True;
MailBody := '';
Settings.Load;
MailInfo.Load;
Settings.Mail.Signature := '';
Settings.Mail.Subject := MailInfo.Subject;
ListAttachments := TStringList.Create;
ListAttachments.Clear;
for i := 1 to MaxEntries do
begin
if (MailInfo.Attachment[i] <> '') and (FileExists(MailInfo.Attachment[i])) then
ListAttachments.Add(MailInfo.Attachment[i]);
end;
for i := 1 to MaxEntries do
begin
MailBody := MailBody + MailInfo.MailBody[i];
end;
try
if MailBody <> '' then
begin
if MailInfo.SenderBcc then
Mailing.Send(MailInfo.SenderMail, MailInfo.Recipient, MailInfo.SenderMail, MailInfo.Subject, MailBody, ListAttachments, True)
else
Mailing.Send(MailInfo.SenderMail, MailInfo.Recipient, MailInfo.Subject, MailBody, ListAttachments, True);
end;
finally
ListAttachments.Free;
end;
FileProcessing := False;
DeleteFile(MailFile);
end;
finally
MailInfo.Free;
end;
end;
end;
end;
The component doesn't notify about changes when your program starts up because at the time your program starts, there haven't been any changes yet.
Your policy appears to be that at the time your program starts up, all existing files are to be considered "new" or "newly changed," so your approach of manually calling the change-notification handler is correct.
The only thing the component does when it detects a change is to call the change-notification handler. If you explicitly call that function, and yet you still observe that "nothing happens," then there are more deep-seated problems in your program that you need to debug; it's not an issue with the component or with the basic approach described here.