backup.pas

delphi 实现备份

        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;
                  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
     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
                  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
              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 = FOldSignature then
  begin
       DeCompressOldMethod(InStream, OutStream, DoWrite);
       exit;
  end;

  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 TBackupFile.DeCompressOldMethod(InStream, OutStream: TStream; DoWrite: Boolean);
var
    InBuffer, OutBuffer: BufferArray;
    CompressedSize, UnCompressedSize, InSize: LongInt;
begin
  InStream.ReadBuffer(InSize, SizeOf(InSize));
  while (InSize > 0) and Continue do
  begin
    InStream.ReadBuffer(CompressedSize, SizeOf(CompressedSize));
    InStream.ReadBuffer(InBuffer, CompressedSize);
    if DoWrite then
    begin
         UnCompressedSize := DeCompression(@InBuffer, @OutBuffer, CompressedSize);
         OutStream.WriteBuffer(OutBuffer, UnCompressedSize);
    end;
    InSize := InSize - CompressedSize - SizeOf(CompressedSize);

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

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

end.