// ************************  ADOBackUP ******************************
//
// 引用外部控件：   BackUp ------ 可實(shí)現(xiàn)多個(gè)文件壓縮成單一文文件
//                  DialogEx ---- 可預(yù)覽的 Dialog
// 更新功能：
//     2001.3.15
//       包文件的名稱定為Save.dat,后面依次為：Save1.dat,Save2.dat ....
//       增加刪除數(shù)據(jù)選項(xiàng)，可自動(dòng)刪除舊數(shù)據(jù)，也可傳遞通過傳遞SQl刪除。
//       增加數(shù)據(jù)包信息，使用戶可以隨數(shù)據(jù)包傳送文本信息，以便終端識(shí)別。
//
//     2001.2.21
//       備份 Backup  ： 根據(jù)讀取的外部Sql語句，備份數(shù)據(jù)，生成備份文件。
//                       可根據(jù)需要，分割備份文件，可直接用A盤存儲(chǔ)。
//       恢復(fù) Restore ： 選擇備份文件，可自動(dòng)合并在同一目錄的文件。
//                       根據(jù)條件恢復(fù)相關(guān)數(shù)據(jù)。
//       備份、恢復(fù)過程有進(jìn)度提示。
//
//     2001.4.4
//       備份文件格式改變：不再存儲(chǔ) Info.Txt，而是存放于備份文件頭
//
// 注意：作為備份依據(jù)的字段，如果修改，則可能造成數(shù)據(jù)重復(fù)或不能正確入庫(kù)
//
//********************************************************************


unit ADOBackUP;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, ADODB, FileCtrl, Backup, DialogEx;
type
  TFloppyFileHead = record
    ID: array[0..3] of char; //  文件標(biāo)志, 正常為 JSFB 四個(gè)字符
    SerialNo: Double; //  序列號(hào)
    FloppyCount: Smallint; //  磁盤總數(shù)
    CurFloppyNo: Smallint; //  當(dāng)前磁盤號(hào)
    FileSize: integer; //  文件大小
    FileName: string[60]; //  原始文件名
    Information: array[0..43] of char; //  附加信息
  end;

  TErrorType = (etCancel, etError);
  TReturnType = (rtAll, rtTable, rtSql);
  TRatioChangedEvent = procedure(Sender: TObject; Ratio: Integer) of object;

  TADOBackUP = class(TComponent)
  private
    { Private declarations }
    FPackSize: Integer; // 每個(gè)包文件的大小
    FBackUpFileName: string; // 包文件名
    FTempPath, FSavePath, FWorkPath, FOrigPath: string; // 臨時(shí)目錄
    FSourceFile: string; // 含路徑
    FADOConnection: TADOConnection; // 數(shù)據(jù)庫(kù)源
    FSQLStrings: TStrings; // Sql語句
    FDelSQLStrings: TStrings; // 傳遞刪除Sql語句
    FInfo: TStrings; // 附帶信息
    TableMaps: TStrings; // 文件名映射
    FIsDevide: Boolean; // 是否分割文件
    FIsSavetoA: Boolean;
    FRadio: integer; // 拷貝進(jìn)度
    FRatioChanged: TRatioChangedEvent;
    FAutoDel: Boolean; // 是否自動(dòng)刪除數(shù)據(jù)

    FFloppyFileHead: TFloppyFileHead;
    FFileHeadList: array of TFloppyFileHead;
    FErrorType: TErrorType;

    BackupFile: TBackupFile;

    function StartWrong: Boolean;
    function CopyDevide: Boolean; //　拷貝分割文件　　
    function CopyFloopyFile: Boolean; //  將文件進(jìn)行分割
    function MergeFloopyFile: Boolean; // 將文件進(jìn)行合并

    procedure CalFloppyHeadList; //  計(jì)算每包文件頭（分割拷貝前準(zhǔn)備）
    procedure RemoveDir(DirName: string); // 刪除臨時(shí)單層目錄
    function CopyfromAtoTemp: Boolean; // 將文件從A轉(zhuǎn)移至臨時(shí)目錄
    function CopytoTemp(SourcePath: string): Boolean; // 文件轉(zhuǎn)移至臨時(shí)目錄
    function RestoreData: Boolean; // 更新數(shù)據(jù)庫(kù)
    function GetTableName(mSql: TStrings; ReturnType: TReturnType = rtAll): TStrings;
    procedure RebackFiles(mfileName: string); // 恢復(fù)文件

    procedure SetSqlStrings(Value: TStrings);
    procedure SetDelSQLStrings(Value: TStrings);
    procedure SetInfo(Value: TStrings);
    function GenerateTempName(Path: string): string;
    procedure PreviewFile(Sender: TOpenPreviewDialog; FileName: string);
 //   Function CopyFromSource:Boolean;  // 從備份轉(zhuǎn)移文件
  protected
    { Protected declarations }
  public
    { Public declarations }

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Backup(SavePath: string): Boolean;
    function Restore(SourceFile: string): Boolean;
    function GetInfo(SourceFile: string): Boolean; // 是否合法的備份文件
    function BrowseBackFile: string;

  published
    { Published declarations }
    property AutoDel: Boolean read FAutoDel write FAutoDel default True;
    property Info: TStrings read FInfo write SetInfo;
    property PackSize: Integer read FPackSize write FPackSize default 1456000;
    property BackUpFileName: string read FBackUpFileName write FBackUpFileName;
    property ADOConnection: TADOConnection read FADOConnection write FADOConnection;
    property SQLStrings: TStrings read FSQLStrings write SetSqlStrings;
    property DelSQLStrings: TStrings read FDelSQLStrings write SetDelSQLStrings;
    property IsDevide: Boolean read FIsDevide write FIsDevide;
    property Procession: TRatioChangedEvent read FRatioChanged write FRatioChanged;
  end;

procedure Register;

implementation

const
  fn_TableMap = '_TblMap.txt';
  fn_SQLFile = '_SQL.Txt';
  BackupSign = #$AA#$55#0'SWAT';

procedure Register;
begin
  RegisterComponents('FVCL', [TADOBackUP]);
end;

procedure TADOBackUp.SetSqlStrings(Value: TStrings);
begin
  if Assigned(Value) then
    FSqlStrings.Assign(Value);
end;

procedure TADOBackUp.SetDelSQLStrings(Value: TStrings);
begin
  if Assigned(Value) then
    FDelSqlStrings.Assign(Value);
end;

procedure TADOBackup.SetInfo(Value: TStrings);
begin
  if Assigned(Value) then
    FInfo.Assign(Value);
end;

// 在指定路徑(Path)下生成唯一的臨時(shí)文件名

function TADOBackup.GenerateTempName(Path: string): string;
  function IntToBase32(Number: Longint): string;
  const
    Table: array[0..31] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUV';
  var
    I: Integer;
  begin
    Result := '';
    for I := 0 to 4 do
    begin
      Insert(Table[Number and 31], Result, 1);
      Number := Number shr 5;
    end;
  end;
var
  Rand, RandOrig: Longint;
begin
  RandOrig := Random($2000000);
  Rand := RandOrig;
  repeat
    Inc(Rand);
    if Rand > $1FFFFFF then Rand := 0;
    if Rand = RandOrig then
      raise Exception.Create('建立臨時(shí)文件失敗');
    Result := 'Dat' + IntToBase32(Rand);
  until not FileExists(Path + Result);
end;

function TADOBackup.GetInfo(SourceFile: string): Boolean; // 是否合法的備份文件
var
  mReadFile: file of Byte;
  InfoLen: Integer;
  InfoText: string;
begin
  Assignfile(mReadFile, SourceFile);
  InfoText := '';
  Result := False;
  try
    try
      ReSet(mReadFile);
      if not Eof(mReadFile) then
        BlockRead(mReadFile, FFloppyFileHead, Sizeof(TFloppyFileHead));
      if FFloppyFileHead.ID <> 'JSFB' then // 表明不是經(jīng)過處理后的包文件
        ReSet(mReadFile);
      SetLength(InfoText, Length(BackUpSign));
      BlockRead(mReadFile, InfoText[1], Length(BackUpSign));
      if InfoText = BackUpSign then
      begin
        Result := True;
        BlockRead(mReadFile, InfoLen, Sizeof(Integer));
        SetLength(InfoText, InfoLen);
        BlockRead(mReadFile, InfoText[1], InfoLen);
      end;
    finally
      CloseFile(mReadFile);
    end;
  except
  end;
  FInfo.Text := InfoText;
end;

function TADOBackup.GetTableName(mSql: TStrings; ReturnType: TReturnType = rtAll): TStrings;
  function PosStr(substr: string; s: string): Integer; //
  begin
    s := stringReplace(s, substr, '^', [rfIgnoreCase]);
    Result := Pos('^', s);
  end;
var
  i: integer;
  Sqltxt: string;
  posint: integer;
  mtableName, mtablesql: string;
begin
  Result := Tstringlist.Create;
  for i := 0 to mSql.Count - 1 do
  begin
    Sqltxt := mSql[i];
    posint := posstr('from', Sqltxt);
    if posint <> 0 then
    begin
      delete(sqltxt, 1, posint + 4); // 刪去空格
      mtableName := copy(Sqltxt, 1, pos(' ', Sqltxt) - 1);
      posint := posstr('Where', Sqltxt);
      mtablesql := '';
      if posint = 0 then
        mtableName := SqlTxt
      else
      begin
        delete(sqltxt, 1, posint + 5);
        mtablesql := 'Where ' + Copy(Sqltxt, 1, length(Sqltxt));
      end;

      case ReturnType of
        rtAll:
          begin
            if posint <> 0 then
              mtablesql := ',' + mtablesql;
            Result.Add(mtableName + mtablesql);
          end;
        rtTable:
          Result.Add(mtableName);
        rtSql:
          Result.Add(mtablesql);
      end;
    end;
  end;
end;

function TADOBackup.MergeFloopyFile: Boolean;
var
  SFile: string;
  tmpS: string;
  ErrorFlag: Boolean;
  SHandle, THandle: Integer;
  i, j: integer;
  BlockCount, LastBlockSize: integer;
  Buffers: array[0..4095] of char;
  Excursion: Integer;
  TempFileName: string;
begin
  Result := True;
  ErrorFlag := False;
  TempFileName := FOrigPath + FBackUpFileName;

  THandle := FileCreate(TempFileName);

  SHandle := -1;

  SFile := StringReplace(FBackUpFileName, '.', InttoStr(1) + '.', [rfReplaceAll, rfIgnoreCase]);
  SFile := fTempPath + SFile;

  for i := 0 to Length(FFileHeadList) - 1 do
  begin
    TempFileName := ExtractFileName(SFile);
    Excursion := Length(inttostr(i + 1)) + 1; // 計(jì)算.偏移位數(shù)
    if i = 0 then
      SFile := ExtractFilePath(SFile) + Copy(TempFileName, 1, pos('.', TempFileName) - Excursion)
        + ExtractFileExt(SFile)
    else if i = 1 then
      SFile := ExtractFilePath(SFile) + Copy(TempFileName, 1, pos('.', TempFileName) - 1)
        + Inttostr(i + 1) + ExtractFileExt(SFile)
    else
      SFile := ExtractFilePath(SFile) + Copy(TempFileName, 1, pos('.', TempFileName) - Excursion)
        + Inttostr(i + 1) + ExtractFileExt(SFile);
    if FileExists(SFile) then
    begin
      SHandle := FileOpen(SFile, fmOpenRead or fmShareDenyNone);
      if SHandle = -1 then
      begin
        tmpS := '讀備份數(shù)據(jù) ' + IntToStr(i + 1) + ' 號(hào)盤錯(cuò)誤, ';
        ErrorFlag := True;
        Break;
      end;
    end
    else
    begin
      tmpS := '沒有發(fā)現(xiàn)備份數(shù)據(jù) ' + IntToStr(i + 1) + ' 號(hào)盤, ';
      ErrorFlag := True;
      Break;
    end;

    // 設(shè)置讀寫緩沖區(qū)大小
    BlockCount := (FFileHeadList[i].FileSize - Sizeof(TFloppyFileHead)) div 4096;
    LastBlockSize := (FFileHeadList[i].FileSize - Sizeof(TFloppyFileHead)) mod 4096;

    FileSeek(SHandle, Sizeof(TFloppyFileHead), 0);
    for j := 1 to BlockCount do
    begin
      FileRead(SHandle, Buffers, 4096);
      FileWrite(THandle, Buffers, 4096);
    end;
    if LastBlockSize > 0 then
    begin
      FileRead(SHandle, Buffers, LastBlockSize);
      FileWrite(THandle, Buffers, LastBlockSize);
    end;
    FileClose(SHandle);
    DeleteFile(SFile);
  end;
  FileClose(THandle);

  if ErrorFlag then
    Result := False;
end;

procedure TADOBackup.RemoveDir(DirName: string);
var
  FSearchRec: TSearchRec;
  FindResult: integer;
begin
  try
    FindResult := FindFirst(DirName + '*.*', faAnyFile + faHidden + faSysFile, FSearchRec);
    try
      while FindResult = 0 do
      begin
        Deletefile(DirName + FSearchRec.Name);
        FindResult := FindNext(FSearchRec);
      end;
    finally
      FindClose(FSearChRec);
    end;
    rmDir(DirName);
  except
  end;
end;