unit U_BackUpBase; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, RzTabs, ExtCtrls, RzPanel, RzButton, RzRadChk, Buttons, StdCtrls, Mask, RzEdit, fib, U_BaseCommon, U_BaseConstants, U_Common, U_SCSComponent, siComp, siLngLnk, RzLabel; type //TBackupRestoreFormMode = (fmBackUp, fmRestore); TF_BackUpBase = class(TForm) pcBackUpBase: TRzPageControl; RzGroupBox1: TRzGroupBox; tsBackUp: TRzTabSheet; tsRestore: TRzTabSheet; RzGroupBox2: TRzGroupBox; rbNormBase: TRzRadioButton; rbProjMan: TRzRadioButton; rbOtherBase: TRzRadioButton; pnOtherBase: TRzPanel; edOtherBase: TRzEdit; btSelectOtherBase: TSpeedButton; btOk: TRzBitBtn; btCancel: TRzBitBtn; edNBPath: TRzEdit; edPMPath: TRzEdit; edReservPath: TRzEdit; btSelectReservPath: TSpeedButton; Label1: TLabel; Label2: TLabel; btSelectReservFile: TSpeedButton; edSelectReservFile: TRzEdit; Label3: TLabel; btRestorePath: TSpeedButton; edRestorePath: TRzEdit; lng_Forms: TsiLangLinked; cbIsNixServer: TRzCheckBox; lbConnectParamsToReservFile: TRzLabel; lbConnectParamsToBase: TRzLabel; procedure rbNormBaseClick(Sender: TObject); procedure rbProjManClick(Sender: TObject); procedure rbOtherBaseClick(Sender: TObject); procedure btSelectOtherBaseClick(Sender: TObject); procedure btSelectReservPathClick(Sender: TObject); procedure edReservPathChange(Sender: TObject); procedure edOtherBaseChange(Sender: TObject); procedure btOkClick(Sender: TObject); procedure btSelectReservFileClick(Sender: TObject); procedure btRestorePathClick(Sender: TObject); procedure edSelectReservFileChange(Sender: TObject); procedure edRestorePathChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure lbConnectParamsToBaseClick(Sender: TObject); procedure lbConnectParamsToReservFileClick(Sender: TObject); private GForm: TForm; FFormMode: TBackupRestoreFormMode; FUserChangedReservTrgPath: Boolean; FUserChangedRestoreTrgPath: Boolean; FOtherBaseConnectParams: TBaseConnectParams; FRestoreConnectParams: TBaseConnectParams; function GetCurrSrcPath: String; procedure SetControls; procedure SetDefReservPath(ABasePath: String); procedure SetDefRestorePath(AReservPath: String); public Constructor Create(AOwner: TComponent; AForm: TForm); Destructor Destroy; override; function Execute(AFormMode: TBackupRestoreFormMode; ADefDBMode: TDBKind=bkNone): Boolean; end; //var //F_BackUpBase: TF_BackUpBase; implementation Uses U_Main, Unit_DM_SCS, U_BaseUpdate, U_BaseConnectParams, U_ProtectionCommon; {$R *.dfm} { TForm1 } constructor TF_BackUpBase.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; inherited Create(AOwner); end; destructor TF_BackUpBase.Destroy; begin inherited; end; function TF_BackUpBase.GetCurrSrcPath: String; begin Result := ''; if rbNormBase.Checked then Result := edNBPath.Text else if rbProjMan.Checked then Result := edPMPath.Text else if rbOtherBase.Checked then Result := edOtherBase.Text; end; procedure TF_BackUpBase.SetControls; begin edNBPath.Visible := rbNormBase.Checked; edPMPath.Visible := rbProjMan.Checked; pnOtherBase.Visible := rbOtherBase.Checked; lbConnectParamsToBase.Visible := rbOtherBase.Checked; end; procedure TF_BackUpBase.SetDefReservPath(ABasePath: String); var SavedChange: TNotifyEvent; FileDir: String; ServerName: String; LocalPath: String; begin if Not FUserChangedReservTrgPath then if ABasePath <> '' then begin SavedChange := edReservPath.OnChange; edReservPath.OnChange := nil; try ExtractServerName(ABasePath, ServerName, LocalPath); if LocalPath <> '' then begin // если не Линух путь if LocalPath[1] <> '/' then begin FileDir := ExtractFileDir(ABasePath); if Length(FileDir) > 0 then if FileDir[Length(FileDir)] <> '\' then FileDir := FileDir + '\'; edReservPath.Text := FileDir + FileNameCorrect(ExtractFileNameOnly(ABasePath) +'Reserv_'+ DateTimeToStr(Now))+ '.'+enSbk; end else begin FileDir := ABasePath; // Удалить расширение if Length(FileDir) >= 4 then if FileDir[Length(FileDir)-3] = '.' then Delete(FileDir, Length(FileDir)-3, 4); edReservPath.Text := FileDir + FileNameCorrect('Reserv_'+ DateTimeToStr(Now))+ '.'+enSbk; end; end; finally edReservPath.OnChange := SavedChange; end; end; end; procedure TF_BackUpBase.SetDefRestorePath(AReservPath: String); var SavedChange: TNotifyEvent; FileDir: String; begin if Not FUserChangedRestoreTrgPath then if AReservPath <> '' then begin SavedChange := edRestorePath.OnChange; edRestorePath.OnChange := nil; try FileDir := ExtractFileDir(AReservPath); if Length(FileDir) > 0 then if FileDir[Length(FileDir)] <> '\' then FileDir := FileDir + '\'; edRestorePath.Text := FileDir + FileNameCorrect('Restored_'+ DateTimeToStr(Now))+ '.'+enDat; finally edRestorePath.OnChange := SavedChange; end; end; end; function TF_BackUpBase.Execute(AFormMode: TBackupRestoreFormMode; ADefDBMode: TDBKind=bkNone): Boolean; begin Result := false; FFormMode := AFormMode; case FFormMode of fmBackUp: begin Caption := cBackUpBase_Msg1_1; pcBackUpBase.ActivePage := tsBackUp; FUserChangedReservTrgPath := false; edReservPath.OnChange := nil; edReservPath.Text := ''; edReservPath.OnChange := edReservPathChange; edNBPath.Text := ''; edNBPath.Text := F_NormBase.GSCSBase.DBName; edPMPath.Text := ''; edPMPath.Text := F_ProjMan.GSCSBase.DBName; edOtherBase.Text := ''; if ADefDBMode = bkProjectManager then begin rbProjMan.Checked := false; rbProjMan.Checked := true; end else begin rbNormBase.Checked := false; rbNormBase.Checked := true; end; end; fmRestore: begin Caption := cBackUpBase_Msg1_2; pcBackUpBase.ActivePage := tsRestore; FUserChangedRestoreTrgPath := false; edSelectReservFile.OnChange := nil; edSelectReservFile.Text := ''; edSelectReservFile.OnChange := edSelectReservFileChange; edRestorePath.OnChange := nil; edRestorePath.Text := ''; edRestorePath.OnChange := edRestorePathChange; end; end; if ShowModal = mrOk then begin Result := true; end; end; procedure TF_BackUpBase.rbNormBaseClick(Sender: TObject); begin SetControls; SetDefReservPath(edNBPath.Text); end; procedure TF_BackUpBase.rbProjManClick(Sender: TObject); begin SetControls; SetDefReservPath(edPMPath.Text); end; procedure TF_BackUpBase.rbOtherBaseClick(Sender: TObject); begin SetControls; edOtherBase.SetFocus; SetDefReservPath(edOtherBase.Text); end; procedure TF_BackUpBase.btSelectOtherBaseClick(Sender: TObject); var OpenDialog: TOpenDialog; begin OpenDialog := TOpenDialog.Create(nil); try OpenDialog.Title := cBackUpBase_Msg2; {$if Defined(ES_GRAPH_SC)} OpenDialog.InitialDir := ExeDir; {$else} OpenDialog.InitialDir := ExtractFileDir(Application.ExeName); {$ifend} OpenDialog.DefaultExt := '*.'+enDat; OpenDialog.Filter := GetDialogFilter(exdBase, enDat)+'|'+ GetDialogFilter(exdAll, '*'); OpenDialog.Options := OpenDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if OpenDialog.Execute then begin edOtherBase.Text := OpenDialog.FileName; end; finally OpenDialog.Free; end; end; procedure TF_BackUpBase.btSelectReservPathClick(Sender: TObject); var SaveDialog: TSaveDialog; begin SaveDialog := TSaveDialog.Create(Self); try SaveDialog.Title := cBackUpBase_Msg3; {$if Defined(ES_GRAPH_SC)} SaveDialog.InitialDir := ExeDir; {$else} SaveDialog.InitialDir := ExtractFileDir(Application.ExeName); {$ifend} SaveDialog.DefaultExt := '*.'+enDat; SaveDialog.FileName := ExtractFileName(edReservPath.Text); SaveDialog.Filter := GetDialogFilter(exdSbk, enSbk); SaveDialog.Options := SaveDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if SaveDialog.Execute then edReservPath.Text := SaveDialog.FileName; finally SaveDialog.Free; end; end; procedure TF_BackUpBase.edReservPathChange(Sender: TObject); begin FUserChangedReservTrgPath := true; end; procedure TF_BackUpBase.edOtherBaseChange(Sender: TObject); begin SetDefReservPath(edOtherBase.Text); end; procedure TF_BackUpBase.btSelectReservFileClick(Sender: TObject); var OpenDialog: TOpenDialog; begin OpenDialog := TOpenDialog.Create(Self); try OpenDialog.Title := cBackUpBase_Msg11; if edSelectReservFile.Text <> '' then OpenDialog.InitialDir := ExtractFileDir(edSelectReservFile.Text) else {$if Defined(ES_GRAPH_SC)} OpenDialog.InitialDir := ExeDir; {$else} OpenDialog.InitialDir := ExtractFileDir(Application.ExeName); {$ifend} OpenDialog.DefaultExt := '*.'+enDat; OpenDialog.FileName := ExtractFileName(edSelectReservFile.Text); OpenDialog.Filter := GetDialogFilter(exdSbk, enSbk); OpenDialog.Options := OpenDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if OpenDialog.Execute then edSelectReservFile.Text := OpenDialog.FileName; finally OpenDialog.Free; end; end; procedure TF_BackUpBase.btRestorePathClick(Sender: TObject); var SaveDialog: TSaveDialog; begin SaveDialog := TSaveDialog.Create(nil); try SaveDialog.Title := cBackUpBase_Msg12; if edRestorePath.Text <> '' then SaveDialog.InitialDir := ExtractFileDir(edRestorePath.Text) else {$if Defined(ES_GRAPH_SC)} SaveDialog.InitialDir := ExeDir; {$else} SaveDialog.InitialDir := ExtractFileDir(Application.ExeName); {$ifend} SaveDialog.DefaultExt := '*.'+enDat; SaveDialog.Filter := GetDialogFilter(exdBase, enDat); SaveDialog.Options := SaveDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if SaveDialog.Execute then begin edRestorePath.Text := SaveDialog.FileName; end; finally SaveDialog.Free; end; end; procedure TF_BackUpBase.btOkClick(Sender: TObject); var CurrSrcPath: string; CurrSrcPathUpper: String; SrcServerName: string; SrcLocalPath: string; TrgServerName: string; TrgLocalPath: string; SrcDBMode: TDBKind; OpenedProjects: string; NewDateBackUp: TDateTime; BaseToBackUp: TBase; BaseToRestore: TBase; ErrorStr: String; SelectReservFile: string; RestorePath: string; SCSBaseToRestore: TSCSBase; OtherBaseConnectParams: TBaseConnectParams; ReservBaseConnectParams: TBaseConnectParams; begin try SCSBaseToRestore := nil; if FFormMode = fmBackUp then begin CurrSrcPath := GetCurrSrcPath; CurrSrcPathUpper := AnsiUpperCaseFileName(CurrSrcPath); ExtractServerName(CurrSrcPath, SrcServerName, SrcLocalPath); ExtractServerName(edReservPath.Text, TrgServerName, TrgLocalPath); if SrcServerName <> TrgServerName then begin MessageModal(cBackUpBase_Msg4, ApplicationName, MB_OK or MB_ICONINFORMATION); ModalResult := mrNone; edReservPath.SetFocus; end; if ModalResult <> mrNone then begin SrcDBMode := bkNone; BaseToBackUp := nil; if CurrSrcPathUpper = AnsiUpperCaseFileName(F_NormBase.GSCSBase.DBName) then begin SrcDBMode := bkNormBase; if Not CheckConnectCountNoMoreOneToNB(cBackUpBase_Msg6) then ModalResult := mrNone; if ModalResult = mrOk then begin BaseToBackUp := TBase.Create(F_NormBase.DM.ConnectParams, F_NormBase.DM.Database_SCS); SCSBaseToRestore := F_NormBase.GSCSBase; end; end else //*** Если выбран тек МП, то проверить закрытость всех проектов if CurrSrcPathUpper = AnsiUpperCaseFileName(F_ProjMan.GSCSBase.DBName) then begin SrcDBMode := bkProjectManager; if CheckIsOpenProject(false) then begin MessageModal(cBackUpBase_Msg5, ApplicationName, MB_OK or MB_ICONINFORMATION); ModalResult := mrNone; end else begin OpenedProjects := F_ProjMan.DM.GetProjectsInUseInfoStr; if OpenedProjects <> '' then begin MessageModal(cBackUpBase_Msg5 + #10#13 + OpenedProjects, ApplicationName, MB_OK or MB_ICONINFORMATION); ModalResult := mrNone; end else if Not CheckConnectCountNoMoreOneToPM(cBackUpBase_Msg6) then ModalResult := mrNone; end; if ModalResult = mrOk then begin BaseToBackUp := TBase.Create(F_ProjMan.DM.ConnectParams, F_ProjMan.DM.Database_SCS); SCSBaseToRestore := F_ProjMan.GSCSBase; end; end else begin OtherBaseConnectParams := FOtherBaseConnectParams; if OtherBaseConnectParams.UserName = '' then OtherBaseConnectParams := F_NormBase.DM.ConnectParams; BaseToBackUp := TBase.Create(OtherBaseConnectParams); try BaseToBackUp.Open(CurrSrcPath); except on E:Exception do begin ErrorStr := E.Message; AddExceptionToLogEx('', ErrorStr, true); //MessageModal(ErrorStr, ApplicationName, MB_OK or MB_ICONERROR); end; //on E:EFIBInterBaseError do ; //else // MessageModal(cBackUpBase_Msg7, ApplicationName, MB_OK or MB_ICONERROR); end; ModalResult := mrNone; if BaseToBackUp.DataBase.Connected then begin if GetConnectedCountToDataBase(BaseToBackUp.DataBase) > 1 then MessageModal(cBackUpBase_Msg7, ApplicationName, MB_OK or MB_ICONINFORMATION) else ModalResult := mrOk; end; if ModalResult = mrNone then FreeAndNil(BaseToBackUp); end; if BaseToBackUp <> nil then begin BeginProgress; try SetBusyParamsToBase(BaseToBackUp.QSelect, BaseToBackUp.QOperat, bbmBackUp); try if BaseToBackUp.BackUpBase(CurrSrcPath, edReservPath.Text, BaseToBackUp.ConnectParams) then if CheckFieldInTable(tnSettings, fnBackUpDate, BaseToBackUp.QSelect) then begin //*** Установить тек-ю дату обновления NewDateBackUp := GetBaseNow(BaseToBackUp.QSelect); UpdateTableFieldAllRec(BaseToBackUp.QOperat, tnSettings, fnBackUpDate, NewDateBackUp); end; finally SetBusyParamsToBase(BaseToBackUp.QSelect, BaseToBackUp.QOperat, bbmEmpty); end; finally EndProgress; end; FreeAndNil(BaseToBackUp); if SCSBaseToRestore <> nil then if Not TF_Main(SCSBaseToRestore.ActiveForm).DM.Database_SCS.Connected then begin SCSBaseToRestore.SimpleOpen(true); end; end; end; end else if FFormMode = fmRestore then begin SelectReservFile := edSelectReservFile.Text; RestorePath := edRestorePath.Text; if SelectReservFile <> '' then if SelectReservFile[1] = '\' then begin SelectReservFile := GetFullRemotePath(SelectReservFile); if SelectReservFile <> ''then if SelectReservFile[Length(SelectReservFile)] = '\' then Delete(SelectReservFile, Length(SelectReservFile), 1); end; if RestorePath <> '' then if RestorePath[1] = '\' then begin RestorePath := GetFullRemotePath(RestorePath); if RestorePath <> ''then if RestorePath[Length(RestorePath)] = '\' then Delete(RestorePath, Length(RestorePath), 1); end; if cbIsNixServer.Checked then begin SelectReservFile := ConverPathToNix(SelectReservFile); RestorePath := ConverPathToNix(RestorePath); end; ExtractServerName(SelectReservFile, SrcServerName, SrcLocalPath); ExtractServerName(RestorePath, TrgServerName, TrgLocalPath); if SrcServerName <> TrgServerName then begin MessageModal(cBackUpBase_Msg9, ApplicationName, MB_OK or MB_ICONINFORMATION); ModalResult := mrNone; edRestorePath.SetFocus; end; if ModalResult <> mrNone then begin if SrcServerName = '' then if Not FileExists(SrcLocalPath) then begin MessageModal(cFileOf +' '+ edSelectReservFile.Text +' '+cNoFound, ApplicationName, MB_OK or MB_ICONINFORMATION); ModalResult := mrNone; edSelectReservFile.SetFocus; end; if ModalResult <> mrNone then if TrgServerName = '' then if FileExists(TrgLocalPath) then begin MessageModal(cBackUpBase_Msg10, ApplicationName, MB_OK or MB_ICONINFORMATION); ModalResult := mrNone; edRestorePath.SetFocus; end; if ModalResult <> mrNone then begin ReservBaseConnectParams := FRestoreConnectParams; if ReservBaseConnectParams.UserName = '' then ReservBaseConnectParams := F_NormBase.DM.ConnectParams; BaseToRestore := TBase.Create(ReservBaseConnectParams); try BeginProgress; try BaseToRestore.RestoreBase(SelectReservFile, RestorePath, BaseToRestore.ConnectParams, true); finally EndProgress; end; finally FreeAndNil(BaseToRestore); end; end; end; end; except on E: Exception do AddExceptionToLogEx('TF_BackUpBase.btOkClick', E.Message); end; end; procedure TF_BackUpBase.edSelectReservFileChange(Sender: TObject); begin SetDefRestorePath(edSelectReservFile.Text); end; procedure TF_BackUpBase.edRestorePathChange(Sender: TObject); begin FUserChangedRestoreTrgPath := true; end; procedure TF_BackUpBase.FormCreate(Sender: TObject); begin ZeroMemory(@FOtherBaseConnectParams, SizeOf(TBaseConnectParams)); ZeroMemory(@FRestoreConnectParams, SizeOf(TBaseConnectParams)); end; procedure TF_BackUpBase.lbConnectParamsToBaseClick(Sender: TObject); begin ShowBaseConnectParams(FOtherBaseConnectParams, bkNone, false); end; procedure TF_BackUpBase.lbConnectParamsToReservFileClick(Sender: TObject); begin ShowBaseConnectParams(FRestoreConnectParams, bkNone, false); end; end.