i'm having touble using SHFileOperation do Copy and delete *.mb and *.db files
the CopyFiles code works great, copy all files and create the folder if needed but when i call DeleteFiles code something strange happens, all files in 'bkp' folder are deleted, but not the folder.
when i try to access the folder it say's "Access denied", after i close my application, folder get deleted ok.
here my procedure :
procedure TForm1.Button1Click(Sender: TObject);
var
shFOS : TShFileOpStruct;
FileNameTemp: string;
sr: TSearchRec;
begin
try
shFOS.Wnd := Application.MainForm.Handle;
shFOS.wFunc := FO_COPY;
shFOS.pFrom := PChar(DBEdit4.text+'\*.db' + #0);
shFOS.pTo := PChar(ExtractFilePath(ParamStr(0))+'bkp'+ #0);
shFOS.fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
SHFileOperation(shFOS);
shFOS.Wnd := Application.MainForm.Handle;
shFOS.wFunc := FO_COPY;
shFOS.pFrom := PChar(DBEdit4.text+'\*.mb' + #0);
shFOS.pTo := PChar(ExtractFilePath(ParamStr(0))+'bkp'+ #0);
shFOS.fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
SHFileOperation(shFOS);
finally
application.ProcessMessages;
//zip copied files
FilenameTemp:=ExtractFilePath(ParamStr(0))+FormatDateTime('dd-mm-yyyy-hh-nn-zzz',now)+'.zip';
ZipForge1.FileName := FilenameTemp;
ZipForge1.OpenArchive(fmCreate);
ZipForge1.BaseDir := ExtractFilePath(ParamStr(0))+'bkp';
ZipForge1.AddFiles('*.*');
ZipForge1.CloseArchive();
end;
// check if any files were copied in order to create the zip file and upload it
// if i skip the FindFirst code works greate
if (FindFirst(ExtractFilePath(ParamStr(0))+'bkp\*.db',faAnyFile,sr)=0) or (FindFirst(ExtractFilePath(ParamStr(0))+'bkp\*.mb',faAnyFile,sr)=0) then
begin
idftp1.Username:=user.Text;
idftp1.Password:=pw.Text;
idftp1.Port:=21;
idFTP1.Passive := false;
try
idftp1.Connect;
except
on E : Exception do
begin
Show;
if (Pos(LowerCase('user cannot'), LowerCase(E.Message)) > 0) and (Pos(LowerCase('log in.'), LowerCase(E.Message)) > 0) then
Application.MessageBox('USUÁRIO OU SENHA INVÁLIDO',Pchar(appCaption),mb_iconError+mb_ok)
else if (Pos(LowerCase('socket error'), LowerCase(E.Message)) > 0) and (Pos(LowerCase('host not found.'), LowerCase(E.Message)) > 0) then
Application.MessageBox('FALHA NA CONEXÃO, VERIFIQUE SUA INTERNET',Pchar(appCaption),mb_iconError+mb_ok)
else if e.Message<>'' then
begin
Application.MessageBox(Pchar('ERRO DESCONHECIDO, FAVOR ENTRAR EM CONTATO COM NOSSO SUPORTE TÉCNICO'
+#13+#10
+#13+#10+'INFORME O SEGUINTE ERRO :'
+#13+#10
+#13+#10+e.Message),Pchar(appCaption),mb_iconError+mb_ok);
end;
exit;
end;
end;
try
idftp1.Put(FileNameTemp,ExtractFileName(FilenameTemp));
finally
//DeleteFiles
idftp1.Disconnect;
ZeroMemory(#shFOS, SizeOf(TShFileOpStruct));
shFOS.Wnd := Application.MainForm.Handle;
shFOS.wFunc := FO_DELETE;
shFOS.pFrom := PChar(ExtractFilePath(ParamStr(0))+'bkp'+#0);
shFOS.fFlags := FOF_NOCONFIRMATION;
SHFileOperation(shFOS); // The error occurs here, files in bkp folder are deleted
//but the folder still exists, and everytime i try to make another backup or remove the
//folder manually through windows the error os "Access denied"
end;
end;
end;
The obvious problem in the updated code is that you call FindFirst, but do not match those with calls to FindClose. Quite possibly the search handles that you fail to close are what blocks the delete operation from completing.
Related
I have a simple function:
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;
When I copy, a confirmation window pops up saying that a file already exists, asking if it should be overwritten.
I would like to avoid this popup and overwrite everything without confirmation.
Add flag FOF_NOCONFIRMATION to eliminate alerts
I'm using TIdFTP (Indy 10.6) for a client application and I need to be able to copy all files from one folder on the server to another. Can this be done?
I know how to rename or move a file, we can use TIdFTP.Rename(Src, Dst).
How about the copy? Would I need to use Get() and Put() with a new path / name, knowing that the number of files in the server can exceed 500,000 files.
In our company, we have some files whose size exceeds 1.5 GB. By using my code, it consumes a lot of memory and the file is not copied from one directory to another: in less code, the source directory is named "Fichiers" and the destination directory is named "Sauvegardes".
Here is my code:
var
S , directory : String;
I: Integer;
FichierFTP : TMemoryStream;
begin
IdFTP1.Passive := True;
idftp1.ChangeDir('/Fichiers/');
IdFTP1.List();
if IdFTP1.DirectoryListing.Count > 0 then begin
IdFTP1.List();
for I := 0 to IdFTP1.DirectoryListing.Count-1 do begin
with IdFTP1.DirectoryListing.Items[I] do begin
if ItemType = ditFile then begin
FichierFTP := TMemoryStream.Create;
S := FileName;
idftp1.Get( FileName , FichierFTP , false );
Application.ProcessMessages
idftp1.ChangeDir('/Sauvegardes/' );
idftp1.Put(FichierFTP , S );
Application.ProcessMessages;
FichierFTP.Free;
end;
end;
end;
IdFTP1.Disconnect;
end;
Does anyone have any experience with this? How can I change my code to resolve this problem?
There are no provisions in the FTP protocol, and thus no methods in TIdFTP, to copy/move multiple files at a time. Only to copy/move individual files one at a time.
Moving a file from one FTP folder to another is easy, that can be done with the TIdFTP.Rename() method. However, copying a file typically requires issuing separate commands to download the file locally first and then re-upload it to the new path.
Some FTP servers support custom commands for copying files, so that you do not need to download/upload them locally. For example, ProFTPD's mod_copy module implements SITE CPFR/CPTO commands for this purpose. If your FTP server supports such commands, you can use the TIdFTP.Site() method, eg:
Item := IdFTP1.DirectoryListing[I];
if Item.ItemType = ditFile then
begin
try
IdFTP1.Site('CPFR ' + Item.FileName);
IdFTP1.Site('CPTO /Sauvegardes/' + Item.FileName);
except
// fallback to another transfer option, see further below...
end;
end;
If that does not work, another possibility to avoid having to copy each file locally is to use a site-to-site transfer between 2 separate TIdFTP connections to the same FTP server. If the server allows this, you can use the TIdFTP.SiteToSiteUpload() and TIdFTP.SiteToSiteDownload() methods to make the server transfer files to itself, eg:
IdFTP2.Connect;
...
Item := IdFTP1.DirectoryListing[I];
if Item.ItemType = ditFile then
begin
try
IdFTP1.SiteToSiteUpload(IdFTP2, Item.FileName, '/Sauvegardes/' + Item.FileName);
except
try
IdFTP2.SiteToSiteDownload(IdFTP1, Item.FileName, '/Sauvegardes/' + Item.FileName);
except
// fallback to another transfer option, see further below...
end;
end;
end;
...
IdFTP2.Disconnect;
But, if using such commands is simply not an option, then you will have to resort to downloading each file locally and then re-uploading it. When copying a large file in this manner, you should use TFileStream (or similar) instead of TMemoryStream. Do not store large files in memory. Not only do you risk a memory error if the memory manager can't allocate enough memory to hold the entire file, but once that memory has been allocated and freed, the memory manager will hold on to it for later reuse, it does not get returned back to the OS. This is why you end up with such high memory usage when you transfer large files, even after all transfers are finished.
If you really want to use a TMemoryStream, use it for smaller files only. You can check each file's size on the server (either via TIdFTPListItem.Size if available, otherwise via TIdFTP.Size()) before downloading the file, and then choose an appropriate TStream-derived class to use for that transfer, eg:
const
MaxMemoryFileSize: Int64 = ...; // for you to choose...
var
...
FichierFTP : TStream;
LocalFileName: string;
RemoteFileSize: Int64;
Item := IdFTP1.DirectoryListing[I];
if Item.ItemType = ditFile then
begin
LocalFileName := '';
if Item.SizeAvail then
RemoteFileSize := Item.Size
else
RemoteFileSize := IdFTP1.Size(Item.FileName);
if (RemoteFileSize >= 0) and (RemoteFileSize <= MaxMemoryFileSize) then
begin
FichierFTP := TMemoryStream.Create;
end else
begin
LocalFileName := MakeTempFilename;
FichierFTP := TFileStream.Create(LocalFileName, fmCreate);
end;
try
IdFTP1.Get(Item.FileName, FichierFTP, false);
IdFTP1.Put(FichierFTP, '/Sauvegardes/' + Item.FileName, False, 0);
finally
FichierFTP.Free;
if LocalFileName <> '' then
DeleteFile(LocalFileName);
end;
end;
There are other optimizations you can make to this, for instance creating a single TMemoryStream with a pre-sized Capacity and then reuse it for multiple transfers that will not exceed that Capacity.
So, putting this all together, you could end up with something like the following:
var
I: Integer;
Item: TIdFTPListItem;
SourceFile, DestFile: string;
IdFTP2: TIdFTP;
CanAttemptRemoteCopy: Boolean;
CanAttemptSiteToSite: Boolean;
function CopyFileRemotely: Boolean;
begin
Result := False;
if CanAttemptRemoteCopy then
begin
try
IdFTP1.Site('CPFR ' + SourceFile);
IdFTP1.Site('CPTO ' + DestFile);
except
CanAttemptRemoteCopy := False;
Exit;
end;
Result := True;
end;
end;
function CopyFileSiteToSite: Boolean;
begin
Result := False;
if CanAttemptSiteToSite then
begin
try
if IdFTP2 = nil then
begin
IdFTP2 := TIdFTP.Create(nil);
IdFTP.Host := IdFTP1.Host;
IdFTP.Port := IdFTP1.Port;
IdFTP.UserName := IdFTP1.UserName;
IdFTP.Password := IdFTP1.Password;
// copy other properties as needed...
IdFTP2.Connect;
end;
try
IdFTP1.SiteToSiteUpload(IdFTP2, SourceFile, DestFile);
except
IdFTP2.SiteToSiteDownload(IdFTP1, SourceFile, DestFile);
end;
except
CanAttemptSiteToSite := False;
Exit;
end;
Result := True;
end;
end;
function CopyFileManually: Boolean;
const
MaxMemoryFileSize: Int64 = ...;
var
FichierFTP: TStream;
LocalFileName: String;
RemoteFileSize: Int64;
begin
Result := False;
try
if Item.SizeAvail then
RemoteFileSize := Item.Size
else
RemoteFileSize := IdFTP1.Size(SourceFile);
if (RemoteFileSize >= 0) and (RemoteFileSize <= MaxMemoryFileSize) then
begin
LocalFileName := '';
FichierFTP := TMemoryStream.Create;
end else
begin
LocalFileName := MakeTempFilename;
FichierFTP := TFileStream.Create(LocalFileName, fmCreate);
end;
try
IdFTP1.Get(SourceFile, FichierFTP, false);
IdFTP1.Put(FichierFTP, DestFile, False, 0);
finally
FichierFTP.Free;
if LocalFileName <> '' then
DeleteFile(LocalFileName);
end;
except
Exit;
end;
Result := True;
end;
begin
CanAttemptRemoteCopy := True;
CanAttemptSiteToSite := True;
IdFTP2 := nil;
try
IdFTP1.Passive := True;
IdFTP1.ChangeDir('/Fichiers/');
IdFTP1.List;
for I := 0 to IdFTP1.DirectoryListing.Count-1 do
begin
Item := IdFTP1.DirectoryListing[I];
if Item.ItemType = ditFile then
begin
SourceFile := Item.FileName;
DestFile := '/Sauvegardes/' + Item.FileName;
if CopyFileRemotely then
Continue;
if CopyFileSiteToSite then
Continue;
if CopyFileManually then
Continue;
// failed to copy file! Do something...
end;
end;
finally
IdFTP2.Free;
end;
IdFTP1.Disconnect;
end;
I created a program to get a file from FTP servers every 5 seconds.
(I'm using Delphi 7)
To do this I did an IdFTP array.
Everything looks like OK, but when the file doesn't exist, the application crashes.
Message: Project FTPGETFIle.exe raised exception class EldProtocolReplyError with message 'File not found'
Creating array from INI file:
IFTP[i] := TIdFTP.Create(nil);
IFTP[i].Host := IniFile.hostn[i];
IFTP[i].Username := IniFile.usern;
IFTP[i].Password := IniFile.password;
IFTP[i].Port := IniFile.FTPPort;
IFTP[i].OnConnected := FTPConnect;
IFTP[i].OnDisconnected := FTPDisconnect;
IFTP[i].OnStatus := FTPStatus;
IFTP[i].Passive := True;
Get file timer:
procedure TfrmMain.Timer1Timer(Sender: TObject);
var
i : Integer;
begin
for i := 1 to IniFile.nftp do
begin
if pingIP(IniFile.hostn[i]) then
begin
if IFTP[i].Connected then
begin
writelog ('Get file '+IniFile.FTPFile[i]+' and save to '+IniFile.OutputF[i]);
try
IFTP[i].Get (IniFile.FTPFile[i],IniFile.OutputF[i],true, false);
except
on E:EIdFileNotFound do
writelog(E.Message);
on E:EIdProtocolReplyError do
writelog(E.Message);
on E:Exception do
writelog(e.Message);
end;
end;
end
else
writelog(IniFile.hostn[i]+' is not recheable!');
end;
end;
Can someone help me to treat this "file not found"?
I'm trying to create a function to check if a folder exists using Overbyte ICS FTP component.Using the DIR command from the icsftp does not display anything in my memo log.
I'm interested in parsing the result of the dir command into a stringlist in order to search for a specific folder.
For the moment I use an indy function like this. How can I make the same thing with ICS?
function exista_textul_in_stringlist(const stringul_pe_care_il_caut:string; stringlistul_in_care_efectuez_cautarea:Tstringlist):boolean;
begin
if stringlistul_in_care_efectuez_cautarea.IndexOf(stringul_pe_care_il_caut) = -1 then
begin
result:=false;
//showmessage('Textul "'+text+'" nu exista!' );
end
else
begin
result:=true;
//showmessage('Textul "'+text+'" exista la pozitia '+ inttostr(ListBox.Items.IndexOf(text)));
end;
end;
function folder_exists_in_ftp(folder_name_to_search_for,ftp_hostname,ftp_port,ftp_username,ftp_password,ftp_root_folder:string;memo_loguri:Tmemo):boolean;
Var
DirList : TStringList;
ftp:Tidftp;
antifreeze:TidAntifreeze;
var i,k:integer;
begin
dateseparator:='-';
Result := False;
DirList := TStringList.Create;
ftp:=tidftp.Create;
antifreeze:=TidAntifreeze.Create;
try
antifreeze.Active:=true;
ftp.Host:=ftp_hostname;
ftp.Port:=strtoint(ftp_port);
ftp.username:=ftp_username;
ftp.password:=ftp_password;
ftp.Passive:=true;
ftp.Connect;
ftp.ChangeDir(ftp_root_folder);
ftp.List(DirList, folder_name_to_search_for, True);
if DirList.Count > 0 then begin
k := DirList.Count;
DirList.Clear; // DIRLIST will hold folders only
for i := 0 to k - 1 do begin
if (ftp.DirectoryListing.Items[i].FileName <> '.') and (ftp.DirectoryListing.Items[i].FileName <> '..') then begin
if ftp.DirectoryListing.Items[i].ItemType = ditDirectory then begin
DirList.Add(ftp.DirectoryListing.Items[i].FileName);
end;
end;
end;
end;
if exista_textul_in_stringlist(folder_name_to_search_for,DIRLIST) then
begin
Result := True;
memo_loguri.Lines.Add(datetimetostr(now)+' - caut folderul "'+folder_name_to_search_for+'" in directorul ftp "'+ftp_root_folder+'" => EXISTS!');
end
ELSE
begin
result:=false;
memo_loguri.Lines.Add(datetimetostr(now)+' - caut folderul "'+folder_name_to_search_for+'" in directorul ftp "'+ftp_root_folder+'" => NOT exists!');
end;
finally
ftp.Free;
antifreeze.Free;
DirList.Free;
end;
end;
I assume you are using the latest released version of OverbyteIcs (ICS-V8.16 (Apr, 2015)).
If you just need to check if a remote directory exists its a good recommendation mentioned in the other answer to avoid a list (it could be a time consuming operation if a lot of files and folders are returned).
I suggest you just try to be "optimistic" and change to the remote dir you wish to investigate using FTP.Cwd. If this call return true the folder of course exists, and if you plan to continue with the same client you have to change back to the original dir. On the other hand, if the call fails, the directory does not exist if the ftp server reponds with code 550.
I have included a simple sample doing the above (however, it does not provide the "change-back-to-original-dir-on-success" feature):
uses
...
OverbyteIcsFtpCli;
function FtpRemoteDirExists(
HostName: String;
UserName: String;
Password: String;
HostDirToCheck : String ) : Boolean;
const
cFtpCode_FileOrDirNotExists = 550;
var
FTP: TFtpClient;
begin
FTP := TFtpClient.Create(nil);
try
FTP.HostName := HostName;
FTP.Passive := True;
FTP.Binary := True;
FTP.Username := UserName;
FTP.Password := Password;
FTP.Port := '21';
if not FTP.Open then
raise Exception.Create('Failed to connect: ' + FTP.ErrorMessage);
if (not FTP.User) or (not FTP.Pass) then
raise Exception.Create('Failed to login: ' + FTP.ErrorMessage);
FTP.HostDirName := HostDirToCheck;
if FTP.Cwd then
Result := True
else
begin
if FTP.StatusCode = cFtpCode_FileOrDirNotExists then
Result := False
else
raise Exception.Create('Failed to change dir: ' + FTP.ErrorMessage);
end;
finally
FTP.Free;
end;
end;
You better use a command like SIZE (TFtpClient.Size) or MLST (TFtpClient.Mlst) to check for file existence.
Using LIST is quite an overkill.
How to delete one directory having some files and some non empty sub directory.
I have tried SHFileOperation Function. It has some compatibility issue in Windows 7.
Then I have tried IFileOperation Interface. But it is not compatible in Windows XP.
Then I have tried the following codes as suggested by David Heffernan :
procedure TMainForm.BitBtn01Click(Sender: TObject);
var
FileAndDirectoryExist: TSearchRec;
ResourceSavingPath : string;
begin
ResourceSavingPath := (GetWinDir) + 'Web\Wallpaper\';
if FindFirst(ResourceSavingPath + '\*', faAnyFile, FileAndDirectoryExist) = 0 then
try
repeat
if (FileAndDirectoryExist.Name <> '.') and (FileAndDirectoryExist.Name <> '..') then
if (FileAndDirectoryExist.Attr and faDirectory) <> 0 then
//it's a directory, empty it
ClearFolder(ResourceSavingPath +'\' + FileAndDirectoryExist.Name, mask, recursive)
else
//it's a file, delete it
DeleteFile(ResourceSavingPath + '\' + FileAndDirectoryExist.Name);
until FindNext(FileAndDirectoryExist) <> 0;
//now that this directory is empty, we can delete it
RemoveDir(ResourceSavingPath);
finally
FindClose(FileAndDirectoryExist);
end;
end;
But it does not get compiled mentioning error as Undeclared Identifier at ClearFolder, mask and recursive. My requirement is to that "If any sub folder exist under WALLPAPER folder it will be deleted". The same sub folder may contain any number of non empty sub folder or files.
Well, for starters, SHFileOperation has no compatibility issues on Windows 7 or Windows 8. Yes, you are now recommended to use IFileOperation instead. But if you want to support older operating systems like XP, then you can and should just call SHFileOperation. It works and will continue to work. It's pefectly fine to use it on Windows 7 and Windows 8 and I'll eat my hat if it's ever removed from Windows. Microsoft go to extraordinary lengths to maintain backwards compatibility. So, SHFileOperation is your best option in my view.
Your FindFirst based approach fails because you need to put it in a separate function in order to allow recursion. And the code I posted in that other answer is incomplete. Here is a complete version:
procedure DeleteDirectory(const Name: string);
var
F: TSearchRec;
begin
if FindFirst(Name + '\*', faAnyFile, F) = 0 then begin
try
repeat
if (F.Attr and faDirectory <> 0) then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
DeleteDirectory(Name + '\' + F.Name);
end;
end else begin
DeleteFile(Name + '\' + F.Name);
end;
until FindNext(F) <> 0;
finally
FindClose(F);
end;
RemoveDir(Name);
end;
end;
This deletes a directory and its contents. You'd want to walk the top level directory and then call this function for each subdirectory that you found.
Finally I have implemented the following Code:
uses
ShellAPI;
...
...
function GetWinDir: string;
var
WindowsDirectory: array[0..MAX_PATH] of Char;
begin
GetWindowsDirectory(WindowsDirectory, MAX_PATH - 1);
SetLength(Result, StrLen(WindowsDirectory));
Result := IncludeTrailingPathDelimiter(WindowsDirectory);
end;
...
...
procedure DeleteDirectory(const DirName: string);
var
FileFolderOperation: TSHFileOpStruct;
begin
FillChar(FileFolderOperation, SizeOf(FileFolderOperation), 0);
FileFolderOperation.wFunc := FO_DELETE;
FileFolderOperation.pFrom := PChar(ExcludeTrailingPathDelimiter(DirName) + #0);
FileFolderOperation.fFlags := FOF_SILENT or FOF_NOERRORUI or FOF_NOCONFIRMATION;
SHFileOperation(FileFolderOperation);
end;
...
...
procedure TMainForm.BitBtn01Click(Sender: TObject);
begin
DeleteDirectory((GetWinDir) + '\Web\Wallpapers\');
end
...
...
Please don't mention anything regarding 'TrailingPathDelimiter', I have intentionally implemented. I works successfully having one problem that the files or folder successfully deleted without going to 'Recycle Bin' in case of Windows XP, but in case of Vista and higher those files goes to 'Recycle Bin' and I don't have any option for directly deletion without sending to 'Recycle Bin' in case of Vista or Higher.
This is a pretty complete function that works both with files and folders.
It allows you to specify the following parameters:
DeleteToRecycle
ShowConfirm
TotalSilence
{---------------------------------------------------------------
DELETE FILE
Deletes a file/folder to RecycleBin.
----------------------------------------------------------------}
function RecycleItem(CONST ItemName: string; CONST DeleteToRecycle: Boolean= TRUE; CONST ShowConfirm: Boolean= TRUE; CONST TotalSilence: Boolean= FALSE): Boolean;
VAR
SHFileOpStruct: TSHFileOpStruct;
begin
FillChar(SHFileOpStruct, SizeOf(SHFileOpStruct), #0);
SHFileOpStruct.wnd := Application.MainForm.Handle; { Others are using 0. But Application.MainForm.Handle is better because otherwise, the 'Are you sure you want to delete' will be hidden under program's window }
SHFileOpStruct.wFunc := FO_DELETE;
SHFileOpStruct.pFrom := PChar(ItemName+ #0);
SHFileOpStruct.pTo := NIL;
SHFileOpStruct.hNameMappings := NIL;
if DeleteToRecycle
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_ALLOWUNDO;
if TotalSilence
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NO_UI
else
if NOT ShowConfirm
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NOCONFIRMATION;
Result:= SHFileOperation(SHFileOpStruct)= 0;
end;