lazarus/tools/lazdatadesktop/frmsqlconnect.pp

{
 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************
}
unit frmSQLConnect;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Buttons, ExtCtrls, ComCtrls, ButtonPanel, lazdatadeskstr, dmImages;

type
  TTestConnectionEvent = Procedure (Sender : TObject;Const ADriver : String; Params : TStrings) of object;

  { TSQLConnectionForm }

  TSQLConnectionForm = class(TForm)
    BTest: TBitBtn;
    BPButtons: TButtonPanel;
    ECharset: TEdit;
    EHostName: TEdit;
    EDatabaseName: TEdit;
    EUserName: TEdit;
    EPassword: TEdit;
    LCharset: TLabel;
    LEUserName: TLabel;
    LEPassword: TLabel;
    LEHostName: TLabel;
    LEDatabaseName: TLabel;
    Panel1: TPanel;
    procedure BTestClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FDriver : String;
    FOnTest: TTestConnectionEvent;
    function GetShowHost: Boolean;
    function GetString(Index: integer): String;
    procedure SetOnTest(AValue: TTestConnectionEvent);
    procedure SetShowHost(const AValue: Boolean);
    procedure SetString(Index: integer; const AValue: String);
    procedure TestConnection;
    { private declarations }
  public
    { public declarations }
    Property ShowHost : Boolean Read GetShowHost Write SetShowHost;
    Property HostName : String Index 0 Read GetString Write SetString;
    Property DatabaseName : String Index 1 Read GetString Write SetString;
    Property UserName : String Index 2 Read GetString Write SetString;
    Property Password : String Index 3 Read GetString Write SetString;
    Property Charset : String Index 4 Read GetString Write SetString;
    Property Driver : String Index 5 Read GetString Write SetString;
    Property OnTestConnection : TTestConnectionEvent Read FOnTest Write SetOnTest;
  end; 

var
  SQLConnectionForm: TSQLConnectionForm;

function GetSQLDBConnectString(HostSupported : Boolean; Initial,ADriver : String; OnTest : TTestConnectionEvent = Nil): String;

implementation

{$R *.lfm}

uses fpdatadict, fpddsqldb ,strutils;

function GetSQLDBConnectString(HostSupported : Boolean; Initial,ADriver : String; OnTest : TTestConnectionEvent = Nil): String;

Var
  L: TStringList;

begin
  Result:='';
  With TSQLConnectionForm.Create(Application) do
    try
      ShowHost:=HostSupported;
      L:=TStringList.Create;
      try
        if (Initial<>'') then
          begin
          L.CommaText:=Initial;
          if HostSupported then
            HostName:=L.Values[KeyHostName];
          DatabaseName:=L.Values[KeyDatabaseName];
          UserName:=L.Values[KeyUserName];
          Password:=XorDecode(KeyEncode,L.Values[KeyPassword]);
          Charset:=L.Values[KeyCharset];
          end;
        Driver:=ADriver;
        OnTestConnection:=OnTest;
        if (ShowModal=mrOK) then
          begin
          L.Clear;
          if HostSupported then
            L.Values[KeyHostName]:=HostName;
          L.Values[KeyDatabaseName]:=DatabaseName;
          L.Values[KeyUserName]:=UserName;
          L.Values[KeyPassword]:=XorEncode(KeyEncode,Password);
          L.Values[KeyCharset]:=Charset;
          Result:=L.CommaText;
          end;
      finally
        L.Free;
      end;
    finally
      Free;
    end;
end;

procedure TSQLConnectionForm.FormCreate(Sender: TObject);
begin
  //
  Caption:= Format(sld_Connecttoadatabase,[sld_UnknownType]);
  LEHostName.Caption:= sld_Host;
  LEDatabaseName.Caption:= sld_Database;
  LEUserName.Caption:= sld_Username;
  LEPassword.Caption:= sld_Password;
  LCharset.Caption:= sld_Charset;
  BTest.Caption:=sld_TestConnection;
  //
end;

procedure TSQLConnectionForm.TestConnection;

Var
  P : TStrings;

begin
  if Not Assigned(FOnTest) then
    exit;
  P:=TStringList.Create;
  try
    if ShowHost then
      P.Values[KeyHostName]:=HostName;
    P.Values[KeyDatabaseName]:=DatabaseName;
    P.Values[KeyUserName]:=UserName;
    P.Values[KeyPassword]:=XorEncode(KeyEncode,Password);
    P.Values[KeyCharset]:=CharSet;
    FOnTest(Self,Driver,P);
    // No errors.
    ShowMessage(sld_SuccesConnecting);
  finally
    P.Free;
  end;
end;

procedure TSQLConnectionForm.BTestClick(Sender: TObject);

begin
  TestConnection;
end;

procedure TSQLConnectionForm.FormActivate(Sender: TObject);
begin
  ClientHeight := Panel1.Height + BPButtons.Height + 2*BPButtons.BorderSpacing.Around;
  Constraints.MinHeight := Height;
  Constraints.MaxHeight := Height;
end;

function TSQLConnectionForm.GetShowHost: Boolean;
begin
  Result:=EHostName.Enabled;
end;

function TSQLConnectionForm.GetString(Index: integer): String;
begin
  Case Index of
    0 : Result:=EHostName.Text;
    1 : Result:=EDatabaseName.Text;
    2 : Result:=EUserName.Text;
    3 : Result:=EPassword.Text;
    4 : Result:=ECharSet.Text;
    5 : Result:=FDriver;
  end;
end;

procedure TSQLConnectionForm.SetOnTest(AValue: TTestConnectionEvent);
begin
  if FOnTest=AValue then Exit;
  FOnTest:=AValue;
  BTest.Enabled:=AValue<>Nil;
end;

procedure TSQLConnectionForm.SetShowHost(const AValue: Boolean);
begin
  EHostName.Enabled:=AValue;
end;

procedure TSQLConnectionForm.SetString(Index: integer; const AValue: String);


var
  ADesc, AType: String;
  ACap: TFPDDEngineCapabilities;
begin
  Case Index of
    0 : EHostName.Text:=AValue;
    1 : EDatabaseName.Text:=AValue;
    2 : EUserName.Text:=AValue;
    3 : EPassword.Text:=AValue;
    4 : ECharset.Text:=Avalue;
    5 :
      begin
      FDriver:=AValue;
      if GetDictionaryEngineInfo(AValue,ADesc,AType,ACap) then
        Caption:= Format(sld_Connecttoadatabase,[ADesc]);
      end;
  end;
end;

end.