backup.pas

数据备份与恢复源码,给需要的一个参考,可以直接运行

      if fSaveFileID then FID.add(files[i] + #9 + inttostr(Fileage(Files[i])) + '=' + inttostr(SStr.size));
    finally
      SStr.free;
    end;

  if fSaveFileID then
  try
    GetTempPath(SizeOf(TempFileP), @TempFileP);
    GetTempFileName(TempFileP, 'FID', 0, TempFileP);
    FIDTemp := StrPas(TempFileP);
    FID.savetofile(FIDTemp);
    Files.insert(0, FIDTemp);
    inc(fSizeTotal, length(FID.text));
    FID.free;
  except;
    Continue := false;
    fLastErr := idCantCreateFileID;
  end;

  try
    ArchiveNumber := 1;

    if UseStream then
      TStr := fOutputStream
    else
    begin
      TStr := TFilestream.create(Target, fmCreate);
      TStr.seek(0, 0);
    end;

    fFilesTotal := files.count;
    if fSaveFileID then fFilesTotal := files.count - 1;
    L := length(fBackupTitle);
    TStr.writeBuffer(L, sizeof(L)); //Size of title
    TStr.writeBuffer(PChar(fBackupTitle)^, L); //title
    TStr.writeBuffer(fSizeTotal, sizeof(fSizeTotal)); //Total Size of backup
    TStr.writeBuffer(fFilesTotal, sizeof(fFilesTotal)); //Total file count

    fProgressSize := 0;
    fCompressedTotal := 0;
  except
    fLastErr := idCantwriteArchive;
    Continue := false;
  end;

  for I := 0 to files.count - 1 do
  begin
    if Fileexists(files[i]) and Continue then
    begin
      try
        if fSaveFileID and (I = 0) then
          CurrentFile := 'FILE:LIST'
        else
          CurrentFile := trim(files[i]);
        l := length(CurrentFile);
        TStr.writeBuffer(L, sizeof(L)); //Size of file name
        TStr.writeBuffer(PChar(CurrentFile)^, L); //file name

        CurrentFile := trim(files[i]);
        try
          SStr := TFilestream.create(Currentfile, fmOpenRead or fmShareDenyNone);
          FA := FileGetDate(SStr.handle);
          TStr.writeBuffer(FA, sizeof(FA)); //file age
          Size := SStr.Size;

//                  while (Size > 0) and Continue do BackupFile; //zero file size bug
          if Continue then
            repeat
              BackupFile;
            until (Size <= 0) or (not Continue);

          if (CurrentFile <> FIDTemp) or (not fSaveFileID) then inc(fFilesProcessed);
        except
          continue := false;
          fLastErr := idCantReadfile;
        end;
        if not continue then break;
      finally
        SStr.free;
        if fSetArchiveFlag then FileSetAttr(files[i], FileGetAttr(files[i]) - faArchive);
      end;
    end;
  end;

  if Continue then
  try
    L := 0;
    TStr.writeBuffer(L, sizeof(L)); //end backup
    result := true;
  except
    fLastErr := idCantwriteArchive;
    Continue := false;
  end;
  try
    Files.free;
    if not UseStream then TStr.free;
  except
  end;
  if fSaveFileID and (FIDTemp <> '') and Fileexists(FIDTemp) then Deletefile(FIDTemp);
  if assigned(fOnProgress) then fOnProgress(self, '', 100, Continue);
  IsBusy := false;

  if (fLastErr <> 0) then MessageError(fLastErr);
end;

procedure TBackupFile.MessageError(err: integer);
var
  S: string;
begin
  case err of
    idCantreadFile: S := errCantreadFile;
    idCantwriteFile: S := errCantwriteFile;
    idCantreadArchive: S := errCantreadArchive;
    idCantwriteArchive: S := errCantwriteArchive;
    idInvalidfiletype: S := errInvalidfiletype;
    idCompression: S := errCompression;
    idCantCreateFileID: S := errCantCreateFileID;
  end;
  if assigned(fOnError) then
    fOnError(self, err, S)
  else
    MessageDlg(S, mtError, [mbOK], 0);
end;

function TBackupFile.CompressionRate: integer;
begin
  try
    result := 100 - ((fCompressedTotal * 100) div fSizeTotal);
  except
    result := 0;
  end;
end;

function TBackupFile.RestoreFromStream(Source: TStream; TargetPath: string): boolean;
begin
  result := false;
  if Source <> nil then
  try
    fInputStream := Source;
    Result := Restore(':STREAM', TargetPath);
  except
    result := false;
  end;
end;

function TBackupFile.Restore(Source: string; TargetPath: string): boolean;
var
  L: Integer;
  FA, FAT: integer;
  S, Disk: string;
  SStr: TStream;
  TStr: TFilestream;
  DoRestore: Boolean;
  UseStream: Boolean;
begin
  if (TargetPath <> '') and (TargetPath[length(TargetPath)] <> '\') then TargetPath := TargetPath + '\';
  UseStream := Source = ':STREAM';
  fLastErr := 0;
  result := false;
  fFilesProcessed := 0;
  Continue := true;
  try
    if UseStream then
      SStr := fInputStream
    else
    begin
      if not Fileexists(Source) then exit;
      SStr := TFilestream.create(Source, fmOpenRead or fmShareDenyNone);
      SStr.seek(0, 0);
    end;
    IsBusy := true;

    SStr.readbuffer(L, sizeof(L));
    SetString(S, PChar(nil), L);
    SStr.ReadBuffer(PChar(S)^, L); //Title
    SStr.readbuffer(fSizeTotal, sizeof(fSizeTotal));
    SStr.readbuffer(fFilesTotal, sizeof(fFilesTotal));
    fProgressSize := 0;
  except
    raise Exception.Create(errCantreadArchive);
    IsBusy := false;
    if UseStream then SStr.free;
    exit;
  end;

  DoRestore := true;
  repeat
    SStr.readbuffer(L, sizeof(L)); // File size
    if L > 0 then
    begin
      SetString(S, PChar(nil), L);
      SStr.ReadBuffer(PChar(S)^, L); //File name

      if copy(s, 1, 9) = 'NEXT:DISK' then
      begin
        SStr.free;
        SStr := nil;
        Disk := copy(S, 10, 3);
        while copy(disk, 1, 1) = '0' do
          Disk := copy(Disk, 2, length(Disk) - 1);

        repeat
          if assigned(fOnNeedDisk) then
            fOnNeedDisk(self, strtoint(Disk), Continue)
          else
            Continue := MessageDlg(Format(cInsertDisk, [Disk]), mtInformation, mbOKCancel, 0) = mrOK;
          Source := changeFileext(source, '.' + copy(S, 10, 3));
        until Fileexists(Source) or (not Continue);

        if Continue then
        try
          SStr := TFilestream.create(Source, fmOpenRead or fmShareDenyNone);
          SStr.seek(0, 0);

          if DoRestore then
          begin
            TStr := TFilestream.create(CurrentFile, fmOpenWrite);
            TStr.seek(TStr.size, soFromBeginning);
          end;

          DeCompress(SStr, TStr, DoRestore);
        finally
          if DoRestore then
          begin
            if assigned(fOnFileRestored) then fOnFileRestored(self, CurrentFile, TStr);
            FileSetDate(TStr.handle, FA); //set original file date + time
            TStr.free;
          end;
        end;
      end
      else
      begin
               // Read file.
        SStr.ReadBuffer(FA, sizeof(FA)); //File age

        if TargetPath <> '' then
          CurrentFile := TargetPath + ExtractFileName(S)
        else
          CurrentFile := S;
        if fRestoreFullPath and (TargetPath <> '') then CurrentFile := TargetPath + copy(S, 4, Length(S));

        FAT := FileAge(CurrentFile);
        case fRestoreMode of
          rmAll: DoRestore := true;
          rmNoOverwrite: DoRestore := not Fileexists(CurrentFile);
          rmNewer: DoRestore := not Fileexists(CurrentFile) or (FA > FAT);
          rmExisting: DoRestore := Fileexists(CurrentFile);
          rmExistingNewer: DoRestore := Fileexists(CurrentFile) and (FA > FAT);
        end;

        if S = 'FILE:LIST' then
          DoRestore := false
        else if assigned(fOnRestoreFile) then
          fOnRestoreFile(self, CurrentFile, FA, doRestore);

        if DoRestore then
        begin
          ForceDirectories(extractFileDir(CurrentFile));
          DoRestore := DirectoryExists(extractFileDir(CurrentFile));
        end;
        if DoRestore then
        try
          try
            TStr := TFileStream.create(CurrentFile, fmCreate);
            TStr.seek(0, 0);
            DeCompress(SStr, TStr, true);
            inc(fFilesProcessed);
          except
            fLastErr := idCantReadFile;
            Continue := false;
          end;
        finally
          if assigned(fOnFileRestored) then fOnFileRestored(self, CurrentFile, TStr);
          FileSetDate(TStr.handle, FA); //set original file date + time
          TStr.free;
        end
        else
          DeCompress(SStr, nil, false);
      end;
    end;
  until (L = 0) or (not Continue);

  if not UseStream and (SStr <> nil) then SStr.free;
  result := (fLastErr = 0) and Continue; //sucessful restore !
  if assigned(fOnProgress) then fOnProgress(self, '', 100, Continue);
  IsBusy := false;
  if fLastErr <> 0 then MessageError(fLastErr);
end;

function TBackupFile.Busy: boolean;
begin
  result := IsBusy;
end;

procedure TBackupFile.Stop;
begin
  Continue := false;
end;

function TBackupFile.GetArchiveTitleFromStream(Source: TStream; var Filelist: TStringlist): string;
begin
  if Source <> nil then
  try
    fInputStream := Source;
    Result := GetArchiveTitle(':STREAM', Filelist);
  except
    result := '';
  end;
end;

function TBackupFile.GetArchiveTitle(const Source: string; var Filelist: TStringlist): string;
var
  L: Integer;
  S: string;
  SStr: TFilestream;
  FIDStr: TMemorystream;
  UseStream: Boolean;
begin
  UseStream := Source = ':STREAM';
  result := '';
  fSizeTotal := 0;
  fFilesTotal := 0;
  fFilesProcessed := 0;

  if UseStream then
    SStr := TFileStream(fInputStream)
  else
  begin
    if not Fileexists(Source) then exit;
    try
      SStr := TFilestream.create(Source, fmOpenRead or fmShareDenyNone);
      SStr.seek(0, 0);
    except;
      fLastErr := idCantReadArchive;
      MessageError(fLastErr);
    end;
  end;

  try
    SStr.readbuffer(L, sizeof(L));
    SetString(S, PChar(nil), L);
    SStr.ReadBuffer(PChar(S)^, L); //Title
    Result := S;
    SStr.readbuffer(fSizeTotal, sizeof(fSizeTotal));
    SStr.readbuffer(fFilesTotal, sizeof(fFilesTotal));

    SStr.readbuffer(L, sizeof(L)); // File size
    if (L > 0) and (Filelist <> nil) then
    begin
      SetString(S, PChar(nil), L);
      SStr.ReadBuffer(PChar(S)^, L); //File name
      if S = 'FILE:LIST' then
      begin
        FIDStr := TMemoryStream.create;
        FIDStr.seek(0, 0);
        SStr.ReadBuffer(L, sizeof(L)); //File age, dummy
        Continue := true;
        DeCompress(SStr, FIDStr, true);
        FIDStr.seek(0, 0);
        Filelist.loadfromstream(FIDStr);
        FIDStr.free;
      end;
    end;
  except
    fLastErr := idInvalidFileType;
    MessageError(fLastErr);
  end;
  if not UseStream then SStr.free;
end;

procedure TBackupFile.DeCompress(InStream, OutStream: TStream; DoWrite: Boolean);
var
  InBuffer: array[0..BufferSize - 1] of Byte;
  OutBuffer: array[0..BufferSize - 1] of Byte;
  CompressedSize, UncompressedSize: Integer;
  Sig: array[0..SizeOf(FSignature) - 1] of Char;
  FZRec: TZStreamRec;
  IsCompressed: boolean;
begin
  InStream.ReadBuffer(Sig, SizeOf(FSignature));
  if Sig <> FSignature then raise Exception.Create(errInvalidfiletype);
  CompressedSize := -1;
  while (CompressedSize <> 0) and Continue do
  begin
    InStream.ReadBuffer(CompressedSize, SizeOf(CompressedSize));
    if CompressedSize <> 0 then
    begin
      IsCompressed := CompressedSize > 0;
      CompressedSize := abs(CompressedSize);
      if DoWrite then
      begin
        InStream.Readbuffer(InBuffer, CompressedSize);

        if IsCompressed then
        begin
          FillChar(FZRec, sizeof(FZRec), 0);
          FZRec.zalloc := zlibAllocMem;
          FZRec.zfree := zlibFreeMem;
          FZRec.next_in := @OutBuffer;
          FZRec.avail_in := 0;
          if inflateInit_(FZRec, zlib_version, sizeof(FZRec)) < 0 then
          begin
            fLastErr := idCompression;
            Continue := false;
          end;

          FZRec.next_in := @InBuffer;
          FZRec.avail_in := CompressedSize;
          FZRec.next_out := @OutBuffer;
          FZRec.avail_out := BufferSize;

          if inflate(FZRec, 0) < 0 then
          begin
            fLastErr := idCompression;
            Continue := false;
          end;

          uncompressedSize := FZRec.total_out;
          OutStream.Write(OutBuffer, UnCompressedSize);

          inflateEnd(FZRec);
        end
        else
        begin
          uncompressedSize := CompressedSize;
          OutStream.Write(InBuffer, UnCompressedSize);
        end;
      end
      else
      begin
        InStream.position := InStream.position + CompressedSize;
        UncompressedSize := BufferSize;
      end;
    end;

    Application.processmessages;
    if OutStream is TFilestream then
    begin
      inc(fProgressSize, UnCompressedSize);
      if assigned(fOnProgress) then fOnProgress(self, CurrentFile, (fProgressSize * 100) div fSizeTotal, Continue);
    end;
  end;
end;

procedure Register;
begin
  RegisterComponents('CPUB', [TBackupFile]);
end;

end.