BillsEditor/DB/HisRestorePointDM.pas

unit HisRestorePointDM;

interface

uses
  SysUtils, Classes, DB, DBClient, Windows, Provider, ADODB;

type
  TDMHisRestorePoint = class(TDataModule)
    cdsOrgHisPoint: TClientDataSet;
    cdsUnFixedPoint: TClientDataSet;
    cdsFixedPoint: TClientDataSet;
    cdsOrgHisPointID: TIntegerField;
    cdsOrgHisPointFixed: TBooleanField;
    cdsOrgHisPointFileName: TWideStringField;
    cdsOrgHisPointFileDir: TWideStringField;
    cdsUnFixedPointID: TIntegerField;
    cdsUnFixedPointFixed: TBooleanField;
    cdsUnFixedPointFileName: TWideStringField;
    cdsUnFixedPointFileDir: TWideStringField;
    cdsFixedPointID: TIntegerField;
    cdsFixedPointFixed: TBooleanField;
    cdsFixedPointFileName: TWideStringField;
    cdsFixedPointFileDir: TWideStringField;
    cdsUnFixedPointIsExists: TWideStringField;
    cdsFixedPointIsExists: TWideStringField;
    cdsOrgHisPointCreateTime: TDateTimeField;
    cdsUnFixedPointCreateTime: TDateTimeField;
    cdsFixedPointCreateTime: TDateTimeField;
    atHisRestorePoint: TADOTable;
    dspHisRestorePoint: TDataSetProvider;
    procedure DataModuleCreate(Sender: TObject);
    procedure cdsUnFixedPointBeforeDelete(DataSet: TDataSet);
  private
    FFileDir: string;
    FProjectPath: string;
    FProjectName: string;
    function NewPointName(AID: Integer): string;
    function GetPointID(var aNew: Boolean; aFixed: Boolean): Integer;
    procedure DeleteCurFile(aFixed: Boolean);
    procedure SetProjectPath(const Value: string);
    function GetConnection: TADOConnection;
    procedure SetConnection(const Value: TADOConnection);
    procedure SetProjectName(const Value: string);
    procedure Save;
    // Added by GiLi 2012-4-23 获取当前程序路径
    function GetApplicationPath: string;
  public
    procedure SavePoint(aFixed: Boolean = False);
    procedure RefreshPoints;

    function GetCurPointPath(aFixed: Boolean): string;
    procedure DeleteCurPoint(aFixed: Boolean);
    procedure DeleteAllPoints;

    property ProjectPath: string read FProjectPath write SetProjectPath;
    property ProjectName: string read FProjectName write SetProjectName;
    property Connection: TADOConnection read GetConnection write SetConnection;
  end;

implementation

{$R *.dfm}

uses ConstVarUnit, ConstMethodUnit;

{ TDMHisRestorePoint }

procedure TDMHisRestorePoint.DeleteCurFile(aFixed: Boolean);
var
  strPath: string;
begin
  strPath := GetCurPointPath(aFixed);
  if FileExists(strPath) then
    Windows.DeleteFile(PChar(strPath));
end;

procedure TDMHisRestorePoint.DeleteCurPoint(aFixed: Boolean);
begin
  DeleteCurFile(aFixed);
  if aFixed then
    cdsFixedPoint.Delete
  else
    cdsUnFixedPoint.Delete;
end;

function TDMHisRestorePoint.GetCurPointPath(aFixed: Boolean): string;
begin
  if aFixed then
    Result := cdsFixedPointFileDir.Value + cdsFixedPointFileName.Value
  else
    Result := cdsUnFixedPointFileDir.Value + cdsUnFixedPointFileName.Value;
end;

procedure TDMHisRestorePoint.RefreshPoints;
var
  strFileName: string;
begin
  cdsUnFixedPoint.EmptyDataSet;
  cdsFixedPoint.EmptyDataSet;

  cdsOrgHisPoint.First;
  while not cdsOrgHisPoint.Eof do
  begin
    if cdsOrgHisPointFixed.Value then
    begin
      cdsFixedPoint.Append;
      cdsFixedPointID.Value := cdsOrgHisPointID.Value;
      cdsFixedPointFixed.Value := True;
      cdsFixedPointFileName.Value := cdsOrgHisPointFileName.Value;
      cdsFixedPointFileDir.Value := cdsOrgHisPointFileDir.Value;
      cdsFixedPointCreateTime.Value := cdsOrgHisPointCreateTime.Value;
      strFileName := cdsOrgHisPointFileDir.Value + cdsOrgHisPointFileName.Value;
      if FileExists(strFileName) then
        cdsFixedPointIsExists.Value := '存在'
      else
        cdsFixedPointIsExists.Value := '不存在';
      cdsFixedPoint.Post;
    end
    else
    begin
      cdsUnFixedPoint.Append;
      cdsUnFixedPointID.Value := cdsOrgHisPointID.Value;
      cdsUnFixedPointFixed.Value := False;
      cdsUnFixedPointCreateTime.Value := cdsOrgHisPointCreateTime.Value;      
      cdsUnFixedPointFileName.Value := cdsOrgHisPointFileName.Value;
      cdsUnFixedPointFileDir.Value := cdsOrgHisPointFileDir.Value;
      strFileName := cdsOrgHisPointFileDir.Value + cdsOrgHisPointFileName.Value;
      if FileExists(strFileName) then
        cdsUnFixedPointIsExists.Value := '存在'
      else
        cdsUnFixedPointIsExists.Value := '不存在';
      cdsUnFixedPoint.Post;
    end;

    cdsOrgHisPoint.Next;
  end;
end;

procedure TDMHisRestorePoint.SavePoint(aFixed: Boolean);
var
  iID: Integer;
  bNew: Boolean;
  strFile: string;
begin
  iID := GetPointID(bNew, aFixed);
  if bNew then
  begin
    cdsOrgHisPoint.Append;
    cdsOrgHisPointID.Value := iID;
    cdsOrgHisPointFixed.Value := aFixed;
    cdsOrgHisPointCreateTime.Value := Now;
    cdsOrgHisPointFileName.Value := NewPointName(iID);
    cdsOrgHisPointFileDir.Value := FFileDir;
    cdsOrgHisPoint.Post;
  end
  else
  begin
    if cdsOrgHisPoint.Locate(SID, iID, []) then
    begin
      cdsOrgHisPoint.Edit;
      cdsOrgHisPointCreateTime.Value := Now;
      cdsOrgHisPointFileName.Value := NewPointName(iID);
      cdsOrgHisPointFileDir.Value := FFileDir;
      cdsOrgHisPoint.Post;
    end;
  end;
  Save;

  strFile := cdsOrgHisPointFileDir.Value + cdsOrgHisPointFileName.Value;
  if not DirectoryExists(FFileDir) then
    ForceDirectories(FFileDir);
  CopyFile(PChar(FProjectPath), PChar(strFile), False);
end;

procedure TDMHisRestorePoint.DataModuleCreate(Sender: TObject);
begin
  cdsUnFixedPoint.IndexFieldNames := sCreateTime;
  cdsFixedPoint.IndexFieldNames := sCreateTime;
  FFileDir := ExtractFilePath(ParamStr(0));
end;

function TDMHisRestorePoint.GetPointID(var aNew: Boolean; aFixed: Boolean): Integer;
var
  bFlag: Boolean;
  iRefCount, iFirstID: Integer;
begin
  bFlag := False;
  iRefCount := 0;
  if aFixed then Result := 5 else Result := 0;

  cdsOrgHisPoint.First;
  while not cdsOrgHisPoint.Eof do
  begin
    if cdsOrgHisPointFixed.Value = aFixed then
    begin
      if not bFlag then
      begin
        iFirstID := cdsOrgHisPointID.Value;
        bFlag := True;
      end;
      Result := cdsOrgHisPointID.Value;
      Inc(iRefCount);
    end;
    cdsOrgHisPoint.Next;
  end;

  if iRefCount < MaxRPointCount then
  begin
    aNew := True;
    Result := Result + 1;
  end
  else
  begin
    aNew := False;
    Result := iFirstID;
  end;
end;

function TDMHisRestorePoint.NewPointName(AID: Integer): string;
var
  strName: string;
begin
//  DateTimeToString(strName, 'yyyy.m.d.h.m.s', Now);
//  strName := FormatDateTime('yyyy.m.d.h.m.s', Now);
  Result := Format('%s.bak', [IntToStr(AID)]);
end;

procedure TDMHisRestorePoint.SetProjectPath(const Value: string);
begin
  FProjectPath := Value;
//  FProjectName := ExtractFileNameWithoutExt(FProjectPath);
//  FFileDir := Format('%s%s\%s\', [FFileDir, sBackUpFolder, FProjectName]);
end;

procedure TDMHisRestorePoint.cdsUnFixedPointBeforeDelete(
  DataSet: TDataSet);
begin
  if cdsOrgHisPoint.Locate(SID, DataSet.FieldByName(SID).AsInteger, []) then
    cdsOrgHisPoint.Delete;
end;

function TDMHisRestorePoint.GetConnection: TADOConnection;
begin
  Result := atHisRestorePoint.Connection;
end;

procedure TDMHisRestorePoint.SetConnection(const Value: TADOConnection);
begin
  atHisRestorePoint.Connection := Value;
  if Assigned(Value) then
  begin
    cdsOrgHisPoint.Active := True;
    cdsOrgHisPoint.IndexFieldNames := 'CreateTime';
    cdsUnFixedPoint.Active := True;
    cdsFixedPoint.Active := True;
  end;
end;

procedure TDMHisRestorePoint.Save;
begin
  cdsOrgHisPoint.ApplyUpdates(0);
end;

procedure TDMHisRestorePoint.SetProjectName(const Value: string);
begin
  FProjectName := Value;
  FFileDir := Format('%s%s\%s\', [GetApplicationPath, sBackUpFolder, FProjectName]);
end;

function TDMHisRestorePoint.GetApplicationPath: string;
begin
  Result := ExtractFilePath(ParamStr(0));
end;

procedure TDMHisRestorePoint.DeleteAllPoints;
begin
  if not Assigned(cdsOrgHisPoint) then
    Exit;
  if not cdsOrgHisPoint.Active then
    Exit;

  cdsUnFixedPoint.First;
  while not cdsUnFixedPoint.Eof do
  begin
    DeleteCurPoint(False);
    cdsUnFixedPoint.First;
  end;
  cdsFixedPoint.First;
  while not cdsFixedPoint.Eof do
  begin
    DeleteCurPoint(True);
    cdsUnFixedPoint.First;
  end;
  cdsOrgHisPoint.ApplyUpdates(0);
end;

end.