Tratar Erros De Api Do Windows: Shellapi

[Geovani]

Olá pessoal!

Estou fazendo um programa de backup automático, estou usando uma função da API do windows que copia arquivos e/ou pastas com as suas subpastas, então, preciso tratar para que se acontecer algum erro, não apareça uma mensagem de erro e aguarde clicar OK para cancelar.

Não sei se existe um tratamento do tipo: se o titulo da mensagem de erro for = "Não foi possivel copiar arquivo ou pasta" então não mostra a mensagem de erro.

alguém sabe se tem como fazer o traramento acima?

Grato!

Geovani

[Geovani]

Valeu!

Vou testar

[Thales Pontes Martins]

Funções CopyDir e CopyArq que mostra progresso em Gauge passado como parametro ->

type
  PProgressData = ^TProgressData;
  TProgressData = record
    LastFile, CurFile : Cardinal;
    Gauge : TGauge;
    Progress, TotalSize, LastProg  : int64;
  end;

function GetFileSizeEx(STFile : String) : int64;
var
  hfile : Cardinal;
begin
  hfile:=FileOpen(STFile,fmopenread or fmShareDenyNone);
  result:=fileseek(hFile,Int64(0),2);
  FileClose(hFile);
end;

function GetDirSize(sc: string) : int64;
var
  res : int64;

function vldir(dr : string) : boolean;
begin
  result:=((trim(dr) <> '..') and (trim(dr) <> '.'));
end;

procedure Search(sor : string);
var
  Rec : TSearchRec;
  s : string;
begin
  if (FindFirst(sor+'\*.*',faReadOnly or faanyfile or favolumeid or faHidden or faSysFile or faDirectory or faArchive,rec)<>0) then
  begin
    FindClose(rec);
    exit;
  end;
  while true do
  begin
    if ((rec.Attr and fadirectory)<>0) then
    begin
      if vldir(rec.Name) then
      Search(sor+'\'+rec.name)
    end else
    begin
      s:=sor+'\'+rec.name;
      res:=res+GetFileSizeEx(s);
    end;
    if (FindNext(rec) <> 0) then
    begin
      FindClose(rec);
      break;
    end;
  end;
end;

begin
  res:=0;
  if (sc[length(sc)] = '\') then delete(sc,length(sc),1);
  if not(directoryexists(sc)) then
  begin
    result:=0;
    exit;
  end;
  Search(sc);
  result:=res;
end;

function CopyProgressRoutine(
   TotalFileSize : int64;
   TotalBytesTransferred : int64;
   StreamSize : int64;
   StreamBytesTransferred : int64;
   dwStreamNumber : DWORD;
   dwCallbackReason : DWORD;
   hSourceFile : Cardinal;
   hDestinationFile : Cardinal;
   lpData : PProgressData
) : DWORD; stdcall;
var
  CBlock : int64;
begin
  if (lpdata^.CurFile <> lpdata^.LastFile) then
  begin
    lpdata^.LastProg:=0;
    lpdata^.LastFile:=lpdata^.CurFile;
  end;
  CBlock:=(TotalBytesTransferred-lpdata^.LastProg);
  lpdata^.LastProg:=TotalBytesTransferred;
  lpdata^.Progress:=lpdata^.Progress+CBlock;
  lpdata^.Gauge.Progress:=integer(lpdata^.Progress shr 7);
end;

function CopyDir(sc, ds : string; Gauge : TGauge) : TStringList;
var
  List : TStringList;
  dat : TProgressData;

function vldir(dr : string) : boolean;
begin
  result:=((trim(dr) <> '..') and (trim(dr) <> '.'));
end;

procedure Search(sor, des : string);
var
  Rec : TSearchRec;
  s,d : string;
  __cancel : BOOL;
  att : cardinal;
begin
  __Cancel := false;
  ForceDirectories(des);
  if (FindFirst(sor+'\*.*',faReadOnly or faanyfile or favolumeid or faHidden or faSysFile or faDirectory or faArchive,rec)<>0) then
  begin
    FindClose(rec);
    exit;
  end;
  while true do
  begin
    if ((rec.Attr and fadirectory)<>0) then
    begin
      if vldir(rec.Name) then
      Search(sor+'\'+rec.name,des+'\'+rec.Name)
    end else
    begin
      s:=sor+'\'+rec.name;
      d:=des+'\'+rec.name;
      inc(dat.CurFile);
      if (fileexists(d)) then
      begin
        att:=filegetattr(d);
        filesetattr(d,0);
      end;
      if (gauge <> nil) then
      begin
        if (cardinal(CopyFileEx(PAnsiChar(s),PAnsiChar(d),@CopyProgressRoutine,@dat,@__cancel,0)) = 0)
        then
        begin
          List.Add(s);
          if (fileexists(d)) then Filesetattr(d,att);
        end;
      end else
      begin
        if (cardinal(CopyFileEx(PAnsiChar(s),PAnsiChar(d),0,0,@__cancel,0)) = 0)
        then
        begin
          List.Add(s);
          if (fileexists(d)) then Filesetattr(d,att);
        end;
      end;
    end;
    if (FindNext(rec) <> 0) then
    begin
      FindClose(rec);
      break;
    end;
  end;
end;

begin
  if (sc[length(sc)] = '\') then delete(sc,length(sc),1);
  if (ds[length(ds)] = '\') then delete(ds,length(ds),1);
  dat.Progress:=0;
  if (gauge <> nil) then
  begin
    dat.TotalSize:=GetDirSize(sc);
    gauge.MinValue:=0;
    gauge.MaxValue:=(dat.TotalSize shr 7);
  end;
  dat.CurFile:=0;
  dat.LastFile:=0;
  dat.Gauge:=gauge;
  if not(directoryexists(sc)) then
  begin
    result:=nil;
    exit;
  end;
  List:=TStringList.Create;
  Search(sc,ds);
  result:=list;
end;

function CopyProgressRoutineArq(
   TotalFileSize : int64;
   TotalBytesTransferred : int64;
   StreamSize : int64;
   StreamBytesTransferred : int64;
   dwStreamNumber : DWORD;
   dwCallbackReason : DWORD;
   hSourceFile : Cardinal;
   hDestinationFile : Cardinal;
   lpData : PProgressData
) : DWORD; stdcall;
begin
  if (lpdata^.LastFile = 1) then
  begin
    lpData^.LastFile:=0;
    lpData^.Gauge.MaxValue:=(TotalFileSize shr 7);
    lpData^.Gauge.MinValue:=0;
  end;
  lpdata^.Gauge.Progress:=integer(TotalBytesTransferred shr 7);
end;

function CopyArq(sc, ds : string; gauge : TGauge) : BOOL;
var
  Dat : TProgressData;
  _cancel : BOOL;
  att : cardinal;
begin
  _Cancel:=false;
  if (fileexists(ds)) then
  begin
    att:=filegetattr(ds);
    FileSetAttr(ds,0);
  end;
  if (Gauge <> nil) then
  begin
    Dat.Gauge:=gauge;
    Dat.LastFile:=1;
    Result:=CopyFileEx(PAnsiChar(sc),PAnsiChar(ds),@CopyProgressRoutineArq,@Dat,@_cancel,0);
  end else
  Result:=CopyFileEx(PAnsiChar(sc),PAnsiChar(ds),0,0,@_cancel,0);
  if not(result) then
  begin
    if (FileExists(ds)) then FileSetAttr(ds,att);
  end;
end;