Delphi XE5中的ShFileOperation

时间:2013-12-29 22:34:45

标签: delphi file-io shfileoperation

我正在使用SHFileOperation进行复制并删除* .mb和* .db文件

CopyFiles代码效果很好,复制所有文件并根据需要创建文件夹但是当我调用DeleteFiles代码时会发生奇怪的事情,'bkp'文件夹中的所有文件都会被删除,但不会删除文件夹。

当我尝试访问该文件夹时,它说“拒绝访问”,在我关闭我的应用程序后,文件夹被删除了。

这是我的程序:

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;

1 个答案:

答案 0 :(得分:2)

更新代码中的一个明显问题是您调用FindFirst,但与FindClose调用不匹配。很可能你未能关闭的搜索句柄阻止了删除操作的完成。