unit U_Connect; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxLookAndFeelPainters, {cxLabel,} StdCtrls, cxButtons, cxControls, cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxButtonEdit, U_BaseCommon, U_BaseConstants, U_BaseSettings, inifiles, siComp, siLngLnk, RzLabel, cxGraphics, cxLookAndFeels, Menus; type TF_Connect = class(TForm) GroupBox1: TGroupBox; Button_Connect: TcxButton; cxButton_Cancel: TcxButton; OpenDialog1: TOpenDialog; ButtonEdit: TcxButtonEdit; lng_Forms: TsiLangLinked; lbConnectParams: TRzLabel; procedure Button_ConnectClick(Sender: TObject); procedure cxButtonEdit1PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure FormShow(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ButtonEditPropertiesChange(Sender: TObject); procedure cxButton_CancelClick(Sender: TObject); procedure lbConnectParamsClick(Sender: TObject); private { Private declarations } GForm: TForm; FReopenOldBaseOnFail: Boolean; public GDBMode: TDBKind; Constructor Create(AOwner: TComponent; AForm: TForm); Destructor Destroy; override; function Execute(ADBMode: TDBKind; AReopenOldBaseOnFail: Boolean): Boolean; end; { var F_Connect: TF_Connect; } implementation Uses Unit_DM_SCS, U_BaseConnectParams, FIBDatabase, pFIBDatabase, U_MAIN, U_ProtectionBase, U_ProtectionCommon; {$R *.dfm} procedure TF_Connect.FormCreate(Sender: TObject); begin case TF_Main(GForm).GDBMode of bkNormBase: Caption := cConnect_Msg1_1; bkProjectManager: Caption := cConnect_Msg1_2; end; GDBMode := TF_Main(GForm).GDBMode; end; procedure TF_Connect.FormShow(Sender: TObject); var BaseForm: TF_Main; begin BaseForm := nil; case GDBMode of bkNormBase: begin Caption := cConnect_Msg2_1; BaseForm := F_NormBase; end; bkProjectManager: begin Caption := cConnect_Msg2_2; BaseForm := F_ProjMan; end; end; if BaseForm.GSCSBase.DBName <> '' then begin if GDatabaseName <> '' then begin ButtonEdit.Text := GDatabaseName; OpenDialog1.InitialDir := GDatabaseName; Button_Connect.Enabled := true; end else begin ButtonEdit.Text := BaseForm.GSCSBase.DBName; OpenDialog1.InitialDir := BaseForm.GSCSBase.DBName; Button_Connect.Enabled := true; end; end else begin if GDatabaseName <> '' then begin ButtonEdit.Text := GDatabaseName; OpenDialog1.InitialDir := GDatabaseName; Button_Connect.Enabled := true; end else begin ButtonEdit.Text := ''; {$if Defined(ES_GRAPH_SC)} OpenDialog1.InitialDir := ExeDir; {$else} OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName); {$ifend} Button_Connect.Enabled := false; end; end; ButtonEdit.SetFocus; end; procedure TF_Connect.cxButtonEdit1PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); begin if OpenDialog1.Execute then begin ButtonEdit.Text := OpenDialog1.FileName; Button_Connect.Enabled := true; end; end; procedure TF_Connect.Button_ConnectClick(Sender: TObject); var CanConnect: Boolean; OldDBName: String; OpenBaseResult: TOpenBaseResult; ini: TIniFile; WasOpenExcept: Boolean; BaseForm: TF_Main; strMessg: String; CheckConnectResult: TCheckConnectResult; ServerName: String; LocalPath: string; OldLicensePath: string; CurrLicensePath: string; begin try if GProtectionType <> ltMultiUser then GProtectionType := ltLocal; if GProtectionType <> ltLocal then begin //if AnsiLowerCase(ButtonEdit.Text) <> AnsiLowerCase(GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, '')) then //begin // if GetStrFromRegistry(pnServerNameNB, '') <> '' then // ButtonEdit.Text := GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, ''); //end; end; ExtractServerName(ButtonEdit.Text, ServerName, LocalPath); WasOpenExcept := false; ModalResult := mrNone; CanConnect := true; strMessg := ''; BaseForm := nil; case GDBMode of bkNormBase: begin BaseForm := F_NormBase; Caption := cConnect_Msg3_1; end; bkProjectManager: begin BaseForm := F_ProjMan; Caption := cConnect_Msg3_2; //*** Закрыть тек-й проект if CloseCurrProject(false, false) = IDCANCEL then CanConnect := false; end; end; if CanConnect then With BaseForm do begin OldDBName := GSCSBase.DBName; if GSCSBase.Active then GSCSBase.Close; OpenBaseResult := obrNoBases; try OpenBaseResult := GSCSBase.Open(ButtonEdit.Text); except WasOpenExcept := true; MessageModal(cConnect_Msg4_1+' "'+ButtonEdit.Text+'" '+cConnect_Msg4_2, cConnect_Msg4_3, MB_ICONERROR or MB_OK); end; {$IF NOT Defined (TRIAL_SCS)} if BaseForm.GDBMode = bkNormBase then //if (GProtectionType <> ltLocal) or (ServerName <> '') then begin OldLicensePath := AnsiLowerCase(GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, '')); CheckConnectResult := CheckProtectionBase(false, ButtonEdit.Text); CurrLicensePath := AnsiLowerCase(GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, '')); if Not (ccrSuccess in CheckConnectResult) then begin CheckConnectResultHandler(CheckConnectResult); Exit; ///// EXIT ///// end; end; {$IFEND} case OpenBaseResult of obrSuccess: begin case BaseForm.GDBMode of bkNormBase: begin GSCSIni.NB.Common.DBPath := GSCSBase.DBName; WriteNBIni(GSCSIni.NB); end; bkProjectManager: begin GSCSIni.PM.Common.DBPath := GSCSBase.DBName; WritePMIni(GSCSIni.PM); end; end; {if FileExists(ExtractFilePath(paramstr(0)) + 'Scs.ini') then begin ini := TIniFile.Create(ExtractFilePath(paramstr(0)) + 'Scs.ini'); case BaseForm.GDBMode of bkNormBase: ini.WriteString('NormBase', 'Path', GSCSBase.DBName); bkProjectManager: ini.WriteString('ProjectManager', 'Path', GSCSBase.DBName); end; FreeAndNil(ini); end;} GConnected := true; Self.ModalResult := mrOk; end; else begin //GSCSBase.Open(OldDBName); Self.ModalResult := mrNone; {strMessg := cConnect_Msg5_1+' "'+ButtonEdit.Text+'".'; case OpenBaseResult of obrNoBases: strMessg := cConnect_Msg5_2+' "'+ButtonEdit.Text+'".'; obrInUse: strMessg := strMessg + #10+#13+ cConnect_Msg5_3; obrNoProperBases: case GDBMode of bkNormBase: strMessg := strMessg + #10+#13+ cConnect_Msg5_4; bkProjectManager: strMessg := strMessg + #10+#13+ cConnect_Msg5_5; end; end; ShowMessageByType(Self.Handle, smtDisplay, strMessg, Application.Title, MB_OK or MB_ICONINFORMATION);} OpenBaseResultHandler(OpenBaseResult, BaseForm, false, false); if FReopenOldBaseOnFail then GSCSBase.Open(OldDBName); //if (Not WasOpenExcept) and (OpenBaseResult = obrRemoteBases) then // MessageModal(Self.Handle, PChar('Нельзя открыть базу "'+ButtonEdit.Text+'" потому, что она находится на сетевом диске.'+ // #13+'Скопируйте базу на локадьный диск и откройте ее оттуда '), // 'Открытие базы данных', MB_ICONERROR or MB_OK); end; end; end; except on E: Exception do AddExceptionToLog('TF_Connect.Button_ConnectClick: '+E.Message); end; end; procedure TF_Connect.FormHide(Sender: TObject); begin // ##### При Следующем вsзове, Отображать эту форму в средине Главной ##### //F_Connect.Position := poMainFormCenter; end; constructor TF_Connect.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; inherited Create(AOwner); end; destructor TF_Connect.Destroy; begin inherited; end; procedure TF_Connect.ButtonEditPropertiesChange(Sender: TObject); begin Button_Connect.Enabled := ButtonEdit.Text <> ''; end; procedure TF_Connect.cxButton_CancelClick(Sender: TObject); begin if GDatabaseName <> '' then {$if Defined(ES_GRAPH_SC)} Application.Terminate; {$else} ExitProcess(0); {$ifend} end; function TF_Connect.Execute(ADBMode: TDBKind; AReopenOldBaseOnFail: Boolean): Boolean; begin Result := false; GDBMode := ADBMode; FReopenOldBaseOnFail := AReopenOldBaseOnFail; if ShowModal = mrOK then Result := true; end; procedure TF_Connect.lbConnectParamsClick(Sender: TObject); var BaseForm: TF_Main; begin BaseForm := nil; case GDBMode of bkNormBase: BaseForm := F_NormBase; bkProjectManager: BaseForm := F_ProjMan; end; if BaseForm <> nil then ShowBaseConnectParams(BaseForm.DM.ConnectParams, GDBMode, true); end; end.