expertcad/SRC/SCSNormBase/U_BackUpBase.pas
2025-05-12 10:07:51 +03:00

649 lines
20 KiB
ObjectPascal
Raw Permalink Blame History

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
// <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
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;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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
//*** <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>-<2D> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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.