freepascal.ru

Код: Выделить всё

uses
...
,msestream
,msesys
,classes // EFCreateError
,gzio
,msefileutils
;


//---------------------------------

function gzipfile(infile,outfile: msestring): boolean;
var
 fs_in: tmsefilestream;
 f_out: gzFile;
 of_tmp: msestring;
 i1: integer;
begin

 result:= false;
 fs_in := nil;
 f_out := nil;

 try
  // opening the input file
  try
   fs_in:= tmsefilestream.create(infile,fm_read);
  except
   on e:EFCreateError do { showmessage(e.message); } begin
    showmessage('Не удалось архивировать БД-файл: ' + infile,'Ошибка резервного копирования',180);
    exit;
   end; 
  end;
  
// preparing the output file
  of_tmp:= outfile + '.tmp';
  f_out:= gzopen(of_tmp,'w9');
  if f_out = nil then begin
   showmessage('Не удалось создать промежуточный архивный файл: ' + of_tmp,'Ошибка резервного копирования',180);
   exit;
  end;

// commpressing & writting to the oputput file  
  i1:= gzwrite(f_out,pointer(fs_in.readdatastring),fs_in.size);

  if i1 = 0 then begin
   showmessage('Сбой при сжатии промежуточного архивного файла: ' + of_tmp,'Ошибка резервного копирования',180);
   exit;
  end else begin
   gzclose(f_out); // чтобы сработал RENAMEFILE
   f_out := nil; // чтобы сработал IF в FINALLY
   renamefile(of_tmp,outfile); // временный => постоянный
  end;

  result:= true;

 finally
  if fs_in <> nil then fs_in.close;
  if f_out <> nil then gzclose(f_out);
  if findfile(of_tmp) then deletefile(of_tmp); // случайный мусор на диске
 end;


end;

//---------------------------------
function dbbackup(outdir: msestring): boolean;
begin
 result:= 
   gzipfile('db/data/refs.db',outdir + '/refs.db.gz') 
  and
   gzipfile('db/data/data_ss.db',outdir + '/data_ss.db.gz')
  and
   gzipfile('db/data/data_retail.db',outdir + '/data_retail.db.gz');
end;