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.