trunk/design/IBDSDialogs.pas

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You            }
{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{************************************************************************}

unit IBDSDialogs;

{$mode objfpc}{$H+}

interface

uses
{$IFDEF WINDOWS }
  Windows,
{$ELSE}
  unix,
{$ENDIF}
  SysUtils, Classes, Graphics, Controls, Dialogs,
  Forms, StdCtrls, ExtCtrls, Buttons, IB, IBDialogs;

type
  { TIBDSLCLInterface }

  TIBDSLCLInterface = class(TIBLCLInterface)
  private
    function GetProjectName: string;
    procedure GetDatabaseName(DefaultDBName, DefaultUserName: string; var DBName: string;
      var UserName: string);
    procedure GetServerName(DefaultServerName, DefaultUserName: string;
              var ServerName, UserName: string);
    procedure SaveDatabaseParams(DatabaseName, UserName: string);
    procedure SaveServerParams(ServerName, UserName: string);
 public
    function ServerLoginDialog(var AServerName: string;
                               var AUserName, APassword: string): Boolean;  override;
    function LoginDialogEx(var ADatabaseName: string;
                               var AUserName, APassword: string;
                               NameReadOnly: Boolean): Boolean; override;
  end;

implementation

{$R *.lfm}

uses BaseIDEIntf, LazIDEIntf;

const
  ConfigFile = 'ibx.xml';

type
  { TIBXDSLoginDlg }

  TIBXDSLoginDlg = class(TForm)
    Bevel1: TBevel;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    ProjectName: TLabel;
    SpeedButton1: TSpeedButton;
    TargetCaption: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Password: TEdit;
    UserName: TEdit;
    DatabaseName: TEdit;
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;


{ TIBXDSLoginDlg }

procedure TIBXDSLoginDlg.SpeedButton1Click(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExtractFileDir(DatabaseName.Text);
  if OpenDialog1.Execute then
    DatabaseName.Text := OpenDialog1.FileName;
end;


function TIBDSLCLInterface.GetProjectName: string;
begin
  Result := ChangeFileExt(ExtractFileName(LazarusIDE.ActiveProject.MainFile.FileName),'');
end;

procedure TIBDSLCLInterface.GetDatabaseName(DefaultDBName,
  DefaultUserName: string; var DBName: string; var UserName: string);
begin
  With GetIDEConfigStorage(ConfigFile,True) do
  try
    DBName := GetValue(GetProjectName + '/Database',DefaultDBName);
    UserName := GetValue(GetProjectName + '/UserName',DefaultUserName);
  finally
    Free
  end;
end;

procedure TIBDSLCLInterface.GetServerName(DefaultServerName,
  DefaultUserName: string; var ServerName, UserName: string);
begin
  With GetIDEConfigStorage(ConfigFile,True) do
  try
    ServerName := GetValue(GetProjectName + '/Server',DefaultServerName);
    UserName := GetValue(GetProjectName + '/UserName',DefaultUserName);
  finally
    Free
  end;
end;

procedure TIBDSLCLInterface.SaveDatabaseParams(DatabaseName, UserName: string);
begin
  With GetIDEConfigStorage(ConfigFile,True) do
  try
    SetValue(GetProjectName + '/Database',DatabaseName);
    SetValue(GetProjectName + '/UserName',UserName);
    WriteToDisk;
  finally
    Free
  end;
end;

procedure TIBDSLCLInterface.SaveServerParams(ServerName, UserName: string);
begin
  With GetIDEConfigStorage(ConfigFile,True) do
  try
    SetValue(GetProjectName + '/Server',ServerName);
    SetValue(GetProjectName + '/UserName',UserName);
    WriteToDisk;
  finally
    Free
  end;
end;

function TIBDSLCLInterface.ServerLoginDialog(var AServerName: string;
  var AUserName, APassword: string): Boolean;
begin
  with TIBXDSLoginDlg.Create(nil) do
  try
    Caption := 'Firebird Server Login';
    TargetCaption.Caption := 'Server Name: ';
    GetServerName(AServerName,AUserName,AServerName,AUserName);
    ProjectName.Caption := GetProjectName;
    DatabaseName.Text := AServerName;
    UserName.Text := AUserName;
    Result := False;
    if AUserName = '' then ActiveControl := UserName;
    if ShowModal = mrOk then
    begin
      AServerName :=  DatabaseName.Text;
      AUserName := UserName.Text;
      APassword := Password.Text;
      SaveServerParams(DatabaseName.Text,UserName.Text);
      Result := True;
    end;
  finally
    Free;
  end;
end;

function TIBDSLCLInterface.LoginDialogEx(var ADatabaseName: string;
  var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
begin
 try
  with TIBXDSLoginDlg.Create(Application) do
  try
    ProjectName.Caption := GetProjectName;
    GetDatabaseName(ADatabaseName, AUserName, ADatabaseName,AUserName);
    DatabaseName.Text := ADatabaseName;
    UserName.Text := AUserName;
    Result := False;
    if NameReadOnly then
      UserName.Enabled := False
    else
      if AUserName = '' then ActiveControl := UserName;
    if ShowModal = mrOk then
    begin
      ADatabaseName :=  DatabaseName.Text;
      AUserName := UserName.Text;
      APassword := Password.Text;
      SaveDatabaseParams(DatabaseName.Text,UserName.Text);
      Result := True;
    end
  finally
    Free;
  end;
 except On E:Exception do
   MessageDlg('Unable to Load Login Dialog ' + E.Message,mtError,[mbOK],0);
 end;
end;

end.
Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	7054 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	User	Rev	Content
1	tony	39	{************************************************************************}
2			{ }
3			{ Borland Delphi Visual Component Library }
4			{ InterBase Express core components }
5			{ }
6			{ Copyright (c) 1998-2000 Inprise Corporation }
7			{ }
8			{ InterBase Express is based in part on the product }
9			{ Free IB Components, written by Gregory H. Deatz for }
10			{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
11			{ Free IB Components is used under license. }
12			{ }
13			{ The contents of this file are subject to the InterBase }
14			{ Public License Version 1.0 (the "License"); you may not }
15			{ use this file except in compliance with the License. You }
16			{ may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17			{ Software distributed under the License is distributed on }
18			{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19			{ express or implied. See the License for the specific language }
20			{ governing rights and limitations under the License. }
21			{ The Original Code was created by InterBase Software Corporation }
22			{ and its successors. }
23			{ Portions created by Inprise Corporation are Copyright (C) Inprise }
24			{ Corporation. All Rights Reserved. }
25			{ Contributor(s): Jeff Overcash }
26			{ }
27			{************************************************************************}
28
29			unit IBDSDialogs;
30
31			{$mode objfpc}{$H+}
32
33			interface
34
35			uses
36			{$IFDEF WINDOWS }
37			Windows,
38			{$ELSE}
39			unix,
40			{$ENDIF}
41	tony	45	SysUtils, Classes, Graphics, Controls, Dialogs,
42			Forms, StdCtrls, ExtCtrls, Buttons, IB, IBDialogs;
43	tony	39
44			type
45			{ TIBDSLCLInterface }
46
47			TIBDSLCLInterface = class(TIBLCLInterface)
48			private
49			function GetProjectName: string;
50			procedure GetDatabaseName(DefaultDBName, DefaultUserName: string; var DBName: string;
51			var UserName: string);
52			procedure GetServerName(DefaultServerName, DefaultUserName: string;
53			var ServerName, UserName: string);
54			procedure SaveDatabaseParams(DatabaseName, UserName: string);
55			procedure SaveServerParams(ServerName, UserName: string);
56			public
57			function ServerLoginDialog(var AServerName: string;
58			var AUserName, APassword: string): Boolean; override;
59			function LoginDialogEx(var ADatabaseName: string;
60			var AUserName, APassword: string;
61			NameReadOnly: Boolean): Boolean; override;
62			end;
63
64			implementation
65
66			{$R *.lfm}
67
68			uses BaseIDEIntf, LazIDEIntf;
69
70			const
71			ConfigFile = 'ibx.xml';
72
73			type
74			{ TIBXDSLoginDlg }
75
76			TIBXDSLoginDlg = class(TForm)
77			Bevel1: TBevel;
78			Button1: TButton;
79			Button2: TButton;
80	tony	45	Label1: TLabel;
81			OpenDialog1: TOpenDialog;
82	tony	39	ProjectName: TLabel;
83	tony	45	SpeedButton1: TSpeedButton;
84	tony	39	TargetCaption: TLabel;
85			Label2: TLabel;
86			Label3: TLabel;
87			Password: TEdit;
88			UserName: TEdit;
89			DatabaseName: TEdit;
90	tony	45	procedure SpeedButton1Click(Sender: TObject);
91	tony	39	private
92			{ private declarations }
93			public
94			{ public declarations }
95			end;
96
97
98	tony	45	{ TIBXDSLoginDlg }
99
100			procedure TIBXDSLoginDlg.SpeedButton1Click(Sender: TObject);
101			begin
102			OpenDialog1.InitialDir := ExtractFileDir(DatabaseName.Text);
103			if OpenDialog1.Execute then
104			DatabaseName.Text := OpenDialog1.FileName;
105			end;
106
107
108	tony	39	function TIBDSLCLInterface.GetProjectName: string;
109			begin
110			Result := ChangeFileExt(ExtractFileName(LazarusIDE.ActiveProject.MainFile.FileName),'');
111			end;
112
113			procedure TIBDSLCLInterface.GetDatabaseName(DefaultDBName,
114			DefaultUserName: string; var DBName: string; var UserName: string);
115			begin
116			With GetIDEConfigStorage(ConfigFile,True) do
117			try
118			DBName := GetValue(GetProjectName + '/Database',DefaultDBName);
119			UserName := GetValue(GetProjectName + '/UserName',DefaultUserName);
120			finally
121			Free
122			end;
123			end;
124
125			procedure TIBDSLCLInterface.GetServerName(DefaultServerName,
126			DefaultUserName: string; var ServerName, UserName: string);
127			begin
128			With GetIDEConfigStorage(ConfigFile,True) do
129			try
130			ServerName := GetValue(GetProjectName + '/Server',DefaultServerName);
131			UserName := GetValue(GetProjectName + '/UserName',DefaultUserName);
132			finally
133			Free
134			end;
135			end;
136
137			procedure TIBDSLCLInterface.SaveDatabaseParams(DatabaseName, UserName: string);
138			begin
139			With GetIDEConfigStorage(ConfigFile,True) do
140			try
141			SetValue(GetProjectName + '/Database',DatabaseName);
142			SetValue(GetProjectName + '/UserName',UserName);
143			WriteToDisk;
144			finally
145			Free
146			end;
147			end;
148
149			procedure TIBDSLCLInterface.SaveServerParams(ServerName, UserName: string);
150			begin
151			With GetIDEConfigStorage(ConfigFile,True) do
152			try
153			SetValue(GetProjectName + '/Server',ServerName);
154			SetValue(GetProjectName + '/UserName',UserName);
155			WriteToDisk;
156			finally
157			Free
158			end;
159			end;
160
161			function TIBDSLCLInterface.ServerLoginDialog(var AServerName: string;
162			var AUserName, APassword: string): Boolean;
163			begin
164			with TIBXDSLoginDlg.Create(nil) do
165			try
166			Caption := 'Firebird Server Login';
167			TargetCaption.Caption := 'Server Name: ';
168			GetServerName(AServerName,AUserName,AServerName,AUserName);
169			ProjectName.Caption := GetProjectName;
170			DatabaseName.Text := AServerName;
171			UserName.Text := AUserName;
172			Result := False;
173			if AUserName = '' then ActiveControl := UserName;
174			if ShowModal = mrOk then
175			begin
176			AServerName := DatabaseName.Text;
177			AUserName := UserName.Text;
178			APassword := Password.Text;
179			SaveServerParams(DatabaseName.Text,UserName.Text);
180			Result := True;
181			end;
182			finally
183			Free;
184			end;
185			end;
186
187			function TIBDSLCLInterface.LoginDialogEx(var ADatabaseName: string;
188			var AUserName, APassword: string; NameReadOnly: Boolean): Boolean;
189			begin
190	tony	45	try
191	tony	39	with TIBXDSLoginDlg.Create(Application) do
192			try
193			ProjectName.Caption := GetProjectName;
194			GetDatabaseName(ADatabaseName, AUserName, ADatabaseName,AUserName);
195			DatabaseName.Text := ADatabaseName;
196			UserName.Text := AUserName;
197			Result := False;
198			if NameReadOnly then
199			UserName.Enabled := False
200			else
201			if AUserName = '' then ActiveControl := UserName;
202			if ShowModal = mrOk then
203			begin
204			ADatabaseName := DatabaseName.Text;
205			AUserName := UserName.Text;
206			APassword := Password.Text;
207			SaveDatabaseParams(DatabaseName.Text,UserName.Text);
208			Result := True;
209			end
210			finally
211			Free;
212			end;
213	tony	45	except On E:Exception do
214			MessageDlg('Unable to Load Login Dialog ' + E.Message,mtError,[mbOK],0);
215			end;
216	tony	39	end;
217
218			end.