
//////////////////////////////////////////////////
//  Data Access Components
//  Copyright © 1998-2007 Core Lab. All right reserved.
//  ConnectionEditor Editor
//////////////////////////////////////////////////

{$IFNDEF CLR}
{$I Dac.inc}

unit DAConnectionEditor;
{$ENDIF}
interface
uses
{$IFDEF MSWINDOWS}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Mask, ExtCtrls, ComCtrls, Registry, DacVcl, Buttons,
{$ENDIF}
{$IFDEF LINUX}
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls,
  QMask, QExtCtrls, QComCtrls, DacClx, Qt, QButtons,
{$ENDIF}
{$IFDEF DBTOOLS}
  DBToolsClient,
{$ENDIF}
  CREditor, DBAccess, DADesignUtils;

type
  TDAConnectionEditorForm = class(TCREditorForm)
    PageControl: TPageControl;
    shConnect: TTabSheet;
    Panel: TPanel;
    lbUsername: TLabel;
    lbPassword: TLabel;
    lbServer: TLabel;
    edUsername: TEdit;
    edPassword: TMaskEdit;
    edServer: TComboBox;
    btConnect: TButton;
    btDisconnect: TButton;
    shInfo: TTabSheet;
    shAbout: TTabSheet;
    btClose: TButton;
    meInfo: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    lbVersion: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    lbWeb: TLabel;
    lbMail: TLabel;
    lbIDE: TLabel;
    cbLoginPrompt: TCheckBox;
    shRed: TShape;
    shYellow: TShape;
    shGreen: TShape;
    imPeng: TImage;
    lbEdition: TLabel;
    procedure btDisconnectClick(Sender: TObject);
    procedure lbWebClick(Sender: TObject);
    procedure lbMailClick(Sender: TObject);
    procedure cbLoginPromptClick(Sender: TObject);
    procedure lbWebMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure shAboutMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lbMailMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure edUsernameChange(Sender: TObject);
    procedure edPasswordChange(Sender: TObject);
    procedure edServerChange(Sender: TObject);
    procedure btConnectClick(Sender: TObject);
    procedure edServerDropDown(Sender: TObject); virtual;
    procedure PageControlChange(Sender: TObject);
    procedure edServerKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edServerExit(Sender: TObject);

  protected
    FConnection: TCustomDAConnection;
    FInDoInit: boolean;
  {$IFDEF MSWINDOWS}
    FRegistry: TRegistry;
  {$ENDIF}
  {$IFDEF DBTOOLS}
    FInExistingChange: boolean;

    function GetExistingConnectionComboBox: TComboBox; virtual;
    procedure ChooseExistingConnection;
    function GetConnectionCondition: string; virtual;
  {$ENDIF}

    procedure GetServerList(List: TStrings); virtual;
    procedure AddServerToList; virtual;

    procedure ShowState(Yellow: boolean = False); virtual;
    procedure ConnToControls; virtual;
    procedure ControlsToConn; virtual;
    procedure FillInfo; virtual;

    procedure DoInit; override;

    function GetComponent: TComponent; override;
    procedure SetComponent(Value: TComponent); override;

  public
    constructor Create(Owner: TComponent; DADesignUtilsClass: TDADesignUtilsClass); override;
    destructor Destroy; override;

  end;

implementation

uses
  {$IFDEF MSWINDOWS}ShellAPI, HelpUtils,{$ENDIF}
  {$IFDEF VER6P}Variants, {$ENDIF}
  MemData,
  MemUtils;

{$IFDEF IDE}
{$R *.dfm}
{$ENDIF}
{$IFDEF MSWINDOWS}
{$R DAConnectionEditor.dfm}
{$ENDIF}
{$IFDEF LINUX}
{$R *.xfm}
{$ENDIF}

{$I DacVer.inc}

{$IFDEF LINUX}
type
  _TMaskEdit = class (TMaskEdit)
  end;
{$ENDIF}

constructor TDAConnectionEditorForm.Create(Owner: TComponent; DADesignUtilsClass: TDADesignUtilsClass);
begin
  inherited;

{$IFDEF MSWINDOWS}
  FRegistry := TRegistry.Create;
  if not FRegistry.OpenKey('\SOFTWARE\CoreLab\' + FDADesignUtilsClass.GetProjectName + '\Connect', True) then
    FreeAndNil(FRegistry);
{$ENDIF}
end;

destructor TDAConnectionEditorForm.Destroy;
begin
{$IFDEF MSWINDOWS}
  FreeAndNil(FRegistry);
{$ENDIF}
  inherited;
end;

procedure TDAConnectionEditorForm.DoInit;
var
  IDE: string;
begin
  FInDoInit := True;
  try
    inherited;

  {$IFDEF D3}
    IDE := 'Delphi 3';
  {$ENDIF}
  {$IFDEF D4}
    IDE := 'Delphi 4';
  {$ENDIF}
  {$IFDEF D5}
    IDE := 'Delphi 5';
  {$ENDIF}
  {$IFDEF D6}
    IDE := 'Delphi 6';
  {$ENDIF}
  {$IFDEF D7}
    IDE := 'Delphi 7';
  {$ENDIF}
  {$IFDEF D8}
    IDE := 'Delphi 8';
  {$ENDIF}
  {$IFDEF D9}
    IDE := 'Delphi 2005';
  {$ENDIF}
  {$IFDEF D10}
    IDE := 'Delphi 2006';
  {$ENDIF}
  {$IFDEF D11}
    IDE := 'Delphi 2007';
  {$ENDIF}
  {$IFDEF CB3}
    IDE := 'C++Builder 3';
  {$ENDIF}
  {$IFDEF CB4}
    IDE := 'C++Builder 4';
  {$ENDIF}
  {$IFDEF CB5}
    IDE := 'C++Builder 5';
  {$ENDIF}
  {$IFDEF CB6}
    IDE := 'C++Builder 6';
  {$ENDIF}
  {$IFDEF LINUX}
    IDE := 'Kylix';
  {$ENDIF}
    lbVersion.Caption := DACVersion + ' ';
    lbIDE.Caption := 'for ' + IDE;
    lbIDE.Left := lbVersion.Left + lbVersion.Width;


  {$IFDEF LINUX}
    imPeng.Visible := True;
    imPeng.BringToFront;
    _TMaskEdit(edPassword).EchoMode := emPassword;
  {$ENDIF}

  {$IFDEF DBTOOLS}
    if DADesignUtilsClass.DBToolsAvailable then begin
      GetDBToolsService(DADesignUtilsClass).GetConnections(GetExistingConnectionComboBox.Items, GetConnectionCondition);
      ChooseExistingConnection;
    end;  
  {$ENDIF}
  
    ConnToControls;

    ShowState;
  finally
    FInDoInit := False;
  end;
end;

function TDAConnectionEditorForm.GetComponent: TComponent;
begin
  Result := FConnection;
end;

procedure TDAConnectionEditorForm.SetComponent(Value: TComponent);
begin
  FConnection := Value as TCustomDAConnection;
end;

{$IFDEF DBTOOLS}
function TDAConnectionEditorForm.GetExistingConnectionComboBox: TComboBox;
begin
  Result := nil;
  Assert(False, 'Must be overriden');
end;

procedure TDAConnectionEditorForm.ChooseExistingConnection;
begin
  if not FInExistingChange and DADesignUtilsClass.DBToolsAvailable then
    with GetExistingConnectionComboBox do
      ItemIndex := Items.IndexOf(GetDBToolsService(DADesignUtilsClass).FindConnectionName(FConnection));
end;

function TDAConnectionEditorForm.GetConnectionCondition: string;
begin
  Result := '';
end;
{$ENDIF}

procedure TDAConnectionEditorForm.ConnToControls;
begin
  edUsername.Text := FConnection.Username;
  edPassword.Text := FConnection.Password;
  edServer.Text := FConnection.Server;
  cbLoginPrompt.Checked := FConnection.LoginPrompt;
end;

procedure TDAConnectionEditorForm.ControlsToConn;
begin
  // all parameters are set in controls OnChange event handlers
end;

procedure TDAConnectionEditorForm.ShowState(Yellow: boolean);
begin
  btDisconnect.Enabled := FConnection.Connected;

  shRed.Brush.Color := clBtnFace;
  shYellow.Brush.Color := clBtnFace;
  shGreen.Brush.Color := clBtnFace;

  if Yellow then begin
    shYellow.Brush.Color := clYellow;
    shYellow.Update;
  end
  else
    if FConnection.Connected then begin
      shGreen.Brush.Color := clGreen;
      shYellow.Update;
    end
    else
      shRed.Brush.Color := clRed;
end;

procedure TDAConnectionEditorForm.lbWebClick(Sender: TObject);
begin
{$IFDEF MSWINDOWS}
  OpenUrl('http://' + lbWeb.Caption);
  lbWeb.Font.Color := $FF0000;
{$ENDIF}
end;

procedure TDAConnectionEditorForm.lbMailClick(Sender: TObject);
begin
{$IFDEF MSWINDOWS}
  MailTo(lbMail.Caption);
  lbMail.Font.Color := $FF0000;
{$ENDIF}
end;

procedure TDAConnectionEditorForm.cbLoginPromptClick(Sender: TObject);
begin
  FConnection.LoginPrompt := cbLoginPrompt.Checked;
end;

procedure TDAConnectionEditorForm.lbWebMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  lbWeb.Font.Color := $4080FF;
end;

procedure TDAConnectionEditorForm.lbMailMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  lbMail.Font.Color := $4080FF;
end;

procedure TDAConnectionEditorForm.shAboutMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  lbWeb.Font.Color := $FF0000;
  lbMail.Font.Color := $FF0000;
end;

procedure TDAConnectionEditorForm.edUsernameChange(Sender: TObject);
begin
  if FInDoInit then
    Exit;

  try
    FConnection.Username := edUsername.Text;
  finally
    ShowState;
  end;
end;

procedure TDAConnectionEditorForm.edPasswordChange(Sender: TObject);
begin
  if FInDoInit then
    Exit;

  try
    FConnection.Password := edPassword.Text;
  finally
    ShowState;
  end;
end;

procedure TDAConnectionEditorForm.edServerChange(Sender: TObject);
begin
  if FInDoInit then
    Exit;

  try
    FConnection.Server := edServer.Text;
  finally
    ShowState;
  end;
end;

procedure TDAConnectionEditorForm.btConnectClick(Sender: TObject);
begin
  ShowState(True);
{$IFDEF DBTOOLS}
  ChooseExistingConnection;
{$ENDIF}
  StartWait;
  try
    ControlsToConn;
    FConnection.PerformConnect;
    if FConnection.Connected then
      AddServerToList;
  finally
    StopWait;
    ShowState;
  end;

  ModalResult := mrOk;
end;

procedure TDAConnectionEditorForm.btDisconnectClick(Sender: TObject);
begin
{$IFDEF DBTOOLS}
  ChooseExistingConnection;
{$ENDIF}
  try
    FConnection.Disconnect;
  finally
    ShowState;
  end;
end;

procedure TDAConnectionEditorForm.edServerDropDown(Sender: TObject);
begin
  StartWait;
  try
    GetServerList(edServer.Items);
  finally
    StopWait;
  end;
end;

procedure TDAConnectionEditorForm.GetServerList(List: TStrings);
{$IFDEF MSWINDOWS}
var
  i: integer;
  s: string;
  ValueNames: TStringList;
{$ENDIF}
begin
  List.Clear;
{$IFDEF MSWINDOWS}
  if FRegistry <> nil then begin
    ValueNames := TStringList.Create;
    try
      FRegistry.GetValueNames(ValueNames);
      ValueNames.Sort;
      for i := 0 to ValueNames.Count - 1 do begin
        s := Trim(FRegistry.ReadString(ValueNames[i]));
        if (s <> '') and (List.IndexOf(s) = -1) then
          List.Add(s);
      end;
    finally
      ValueNames.Free;
    end;
  end;
{$ENDIF}
end;

procedure TDAConnectionEditorForm.AddServerToList;
{$IFDEF MSWINDOWS}
var
  i: integer;
  s: string;
  ValueNames, Values: TStringList;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  if FRegistry <> nil then begin
    ValueNames := nil;
    Values := nil;
    try
      ValueNames := TStringList.Create;
      Values := TStringList.Create;

      Values.Add(FConnection.Server); // Add current server at first position

      FRegistry.GetValueNames(ValueNames);
      ValueNames.Sort;

      for i := 0 to ValueNames.Count - 1 do
        if FRegistry.GetDataType(ValueNames[i]) = rdString then begin
          s := Trim(FRegistry.ReadString(ValueNames[i]));
          if (s <> '') and (Values.IndexOf(s) = -1) then
            Values.Add(s);
          FRegistry.DeleteValue(ValueNames[i]); // Clear old list
        end;

      // Store updated list in registry
      for i := 0 to Values.Count - 1 do begin
        s := Format('Server %d', [i]);
        FRegistry.WriteString(s, Values[i]);
      end;

    finally
      ValueNames.Free;
      Values.Free;
    end;
  end;
{$ENDIF}
end;

procedure TDAConnectionEditorForm.FillInfo;
var
  OldLoginPrompt: boolean;

begin
  OldLoginPrompt := FConnection.LoginPrompt;
  try
    FConnection.LoginPrompt := False;

    if not FConnection.Connected then
      try
        ShowState(True);
        FConnection.Connect;
      except
        on E: Exception do
        begin
          // PageControl.ActivePage := shConnect;
          // Application.ShowException(E); - silent exception. Please see CR MyDAC 3443
        end;
      end;
    meInfo.Lines.Clear;
  finally
    FConnection.LoginPrompt := OldLoginPrompt;
    ShowState(False);
  end;
end;

procedure TDAConnectionEditorForm.PageControlChange(Sender: TObject);
begin
  if PageControl.ActivePage = shInfo then
    FillInfo;
end;

procedure TDAConnectionEditorForm.edServerKeyUp(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key ={$IFDEF MSWINDOWS}VK_RETURN{$ELSE}KEY_RETURN{$ENDIF} then
    edServerChange(Sender);
end;

procedure TDAConnectionEditorForm.edServerExit(Sender: TObject);
begin
{$IFDEF DBTOOLS}
  ChooseExistingConnection;
{$ENDIF}
end;

end.
