Componentes.Terceros.SDAC/internal/4.10.0.10/1/Source/Design/MSConnectionEditor.pas

//////////////////////////////////////////////////
//  SQL Server Data Access Components
//  Copyright <20> 1998-2007 Core Lab. All right reserved.
//  MSConnection Editor
//////////////////////////////////////////////////

{$IFNDEF CLR}

{$I SDac.inc}

unit MSConnectionEditor;
{$ENDIF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, ExtCtrls, ComCtrls, Buttons,
  DAConnectionEditor, MSAccess, OLEDBAccess;

const
  WM_SETDATABASETEXT = WM_USER + 1;

type
  TMSConnectionEditorForm = class(TDAConnectionEditorForm)
    lbDatabase: TLabel;
    edDatabase: TComboBox;
    rgAuth: TRadioGroup;
    btQueryAnalyzer: TButton;
    btManagementStudio: TButton;
    procedure edDatabaseDropDown(Sender: TObject);
    procedure rgAuthClick(Sender: TObject);
    procedure btQueryAnalyzerClick(Sender: TObject);
    procedure edDatabaseExit(Sender: TObject);
    procedure edDatabaseKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edDatabaseChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btManagementStudioClick(Sender: TObject);
    procedure edServerDropDown(Sender: TObject); override;
  private
    FDataBaseText: string;
    FCurrItemIndex: Integer;
    FListGot: boolean;
    procedure WMSetDataBaseText(var Message: TMessage); message WM_SETDATABASETEXT;
  protected
    function GetConnection: TMSConnection;
    procedure SetConnection(Value: TMSConnection);

    procedure DoInit; override;
    procedure FillInfo; override;

    procedure ConnToControls; override;

    procedure AddServerToList; override;

    procedure GetServerList(List: TStrings); override;
    procedure GetDatabaseList(List: TStrings);
    function IsValidKeyValue(Value: string; Name: string): boolean;
  public
    property Connection: TMSConnection read GetConnection write SetConnection;
  end;

implementation

{$IFDEF IDE}
{$R *.dfm}
{$ENDIF}
{$IFDEF MSWINDOWS}
{$R MSConnectionEditor.dfm}
{$ENDIF}

uses
  DacVcl{$IFDEF SDAC}, MSDesign{$ENDIF}, Registry;

{ TMSConnectionEditorForm }

function TMSConnectionEditorForm.GetConnection: TMSConnection;
begin
  Result := FConnection as TMSConnection;
end;

procedure TMSConnectionEditorForm.SetConnection(Value: TMSConnection);
begin
  FConnection := Value;
end;

procedure TMSConnectionEditorForm.DoInit;
begin
  inherited;
  
  FInDoInit := True;
  try
    lbVersion.Caption := SDACVersion;
  {$IFDEF SDAC}
    btQueryAnalyzer.Visible := IsServerToolInstalled(stQueryAnalyser) and (Connection.Options.Provider <> prCompact);
    btManagementStudio.Visible := IsServerToolInstalled(stManagementStudio) and (Connection.Options.Provider <> prCompact);
  {$ENDIF}
    FCurrItemIndex := -1;
    if Connection.Options.Provider = prCompact then begin
      cbLoginPrompt.Enabled := False;
      rgAuth.Enabled := False;
      lbUsername.Enabled := False;
      edUserName.Enabled := False;
      lbServer.Enabled := False;
      edServer.Enabled := False;
    end;
    FListGot := False;
  finally
    FInDoInit := False;
  end;
end;

procedure TMSConnectionEditorForm.FillInfo;
var
  OldLoginPrompt: boolean;
  OldConnectionTimeout: integer;
  OLEDBConnection: TOLEDBConnection;
  St: string;
begin
  OldLoginPrompt := Connection.LoginPrompt;
  OldConnectionTimeout := Connection.ConnectionTimeout;
  try
    Connection.LoginPrompt := False;
    if not Connection.Connected then
      try
        ShowState(True);
        Connection.ConnectionTimeout := 1;
        Connection.Connect;
      except
        on E: Exception do
        begin         
          //Application.ShowException(E); - silent exception. Please see CR MyDAC 3443
        end;
      end;
    meInfo.Lines.Clear;
    OLEDBConnection := TMSAccessUtils.FIConnection(Connection);
    if OLEDBConnection <> nil then
    begin
      if Connection.Connected then begin
        St := OLEDBConnection.DBMSName + ': ' + OLEDBConnection.DBMSVer;
        if st <> ':' then
          meInfo.Lines.Add(St);
      end;
      St := OLEDBConnection.ProviderFriendlyName + ': ' + OLEDBConnection.ProviderVer;
      if St <> ': ' then
        meInfo.Lines.Add(St);
    end;
  finally
    Connection.LoginPrompt := OldLoginPrompt;
    Connection.ConnectionTimeout := OldConnectionTimeout;
    ShowState(False);
  end;
end;

procedure TMSConnectionEditorForm.ConnToControls;
begin
  inherited;

  edDatabase.Text := Connection.Database;
  rgAuth.ItemIndex := Ord(Connection.Authentication);
end;

procedure TMSConnectionEditorForm.edServerDropDown(Sender: TObject);
begin
  if FListGot then
    Exit;
    
  FListGot := True;
  
  inherited;
end;

procedure TMSConnectionEditorForm.GetServerList(List: TStrings);
begin
  MSAccess.GetServerList(List);
end;

procedure TMSConnectionEditorForm.AddServerToList;
var
  ConnectKey: string;
  ValueNames, Values: TStringList;
  i: integer;
  s: string;
begin
  if Connection.Options.Provider = prCompact then begin
    if FRegistry <> nil then begin
      ValueNames := nil;
      Values := nil;
      ConnectKey := FRegistry.CurrentPath;
      try
        ValueNames := TStringList.Create;
        Values := TStringList.Create;

        Values.Add(Connection.Database); // Add current database at first position

        FRegistry.CloseKey;
        FRegistry.OpenKey(ConnectKey + '\Everywhere', True);
        
        FRegistry.GetValueNames(ValueNames);
        ValueNames.Sort;

        for i := 0 to ValueNames.Count - 1 do 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('Database %d', [i]);
          FRegistry.WriteString(s, Values[i]);
        end;

      finally
        ValueNames.Free;
        Values.Free;
      end;
    end;
  end
  else
    inherited;
end;

procedure TMSConnectionEditorForm.GetDatabaseList(List: TStrings);
var
  ConnectKey: string;
  ValueNames, Values: TStringList;
  i: integer;
begin
  List.Clear;
  if FRegistry <> nil then begin
    ValueNames := nil;
    Values := nil;
    try
      ValueNames := TStringList.Create;
      Values := TStringList.Create;
      ConnectKey := FRegistry.CurrentPath;
      try
        FRegistry.CloseKey;
        if FRegistry.OpenKey(ConnectKey + '\Everywhere', False) then begin
          FRegistry.GetValueNames(ValueNames);
          ValueNames.Sort;
          for i := 0 to ValueNames.Count - 1 do
            if IsValidKeyValue(ValueNames[i], 'Database') then
              List.Add(FRegistry.ReadString(ValueNames[i]));
        end;
      finally
        FRegistry.CloseKey;
        FRegistry.OpenKey(ConnectKey, False);
      end;
    finally
      ValueNames.Free;
      Values.Free;
    end;
  end;
  List.Add('<Browse...>');
end;

function TMSConnectionEditorForm.IsValidKeyValue(Value: string; Name: string): boolean;
var
  p: integer;
begin
  p := Pos(AnsiUpperCase(Name), AnsiUpperCase(Value));
  if p <> 0 then begin
    Inc(p, Length(Name) - 1);
    if p < Length(Value) then
      Inc(p);
    while (Byte(Value[p]) in [$30..$30+9, $20]) and (p <> Length(Value)) do
      Inc(p);
    Result := p = Length(Value);
  end
  else
    Result := False;
end;

procedure TMSConnectionEditorForm.edDatabaseDropDown(Sender: TObject);
var
  List: TStringList;
  OldLoginPrompt: Boolean;
begin
  StartWait;
  try
    if Connection.Options.Provider = prCompact then begin
      GetDatabaseList(edDatabase.Items);
      if edDatabase.Items.Count < 20 then
        edDatabase.DropDownCount := edDatabase.Items.Count
      else
        edDatabase.DropDownCount := 20;
    end
    else begin
      edDatabase.Items.Clear;
      OldLoginPrompt := Connection.LoginPrompt;
      List := TStringList.Create;
      try
        Connection.LoginPrompt := False;
        MSAccess.GetDatabasesList(Connection, List);
        List.Sort;
        edDatabase.Items.Assign(List);
        if edDatabase.Items.Count < 20 then
          edDatabase.DropDownCount := edDatabase.Items.Count
        else
          edDatabase.DropDownCount := 20;
      finally
        edDatabase.Text := Connection.Database;
        List.Free;
        Connection.LoginPrompt := OldLoginPrompt;
      end;
    end;
  finally
    StopWait;
  end;
end;

procedure TMSConnectionEditorForm.rgAuthClick(Sender: TObject);
begin
  try
    Connection.Authentication := TMSAuthentication(rgAuth.ItemIndex);

    case Connection.Authentication of
      auWindows:
      begin
        edUsername.Enabled := False;
        edPassword.Enabled := False;
        lbUsername.Enabled := False;
        lbPassword.Enabled := False;
        cbLoginPrompt.Enabled := False;
      end;
      auServer:
      begin
        edUsername.Enabled := True;
        edPassword.Enabled := True;
        lbUsername.Enabled := True;
        lbPassword.Enabled := True;
        cbLoginPrompt.Enabled := True;
      end;
    end;
  finally
    ShowState;
  end;
end;

procedure TMSConnectionEditorForm.btQueryAnalyzerClick(Sender: TObject);
begin
  SaveControlData;
{$IFDEF SDAC}
  RunServerTool(stQueryAnalyser, Connection);
{$ENDIF}
end;

procedure TMSConnectionEditorForm.btManagementStudioClick(Sender: TObject);
begin
  SaveControlData;
{$IFDEF SDAC}
  RunServerTool(stManagementStudio, Connection);
{$ENDIF}
end;

procedure TMSConnectionEditorForm.edDatabaseExit(Sender: TObject);
begin
  if FInDoInit then
    Exit;

  try
    Connection.Database := edDatabase.Text;
  finally
    ShowState;
  end;
end;

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

procedure TMSConnectionEditorForm.edDatabaseChange(Sender: TObject);
var
  Dialog: TOpenDialog;
  OldConnected: boolean;
begin
  if FInDoInit then
    Exit;
    
  if Connection.Options.Provider <> prCompact then
    Exit;

  try
    if edDatabase.Text = '<Browse...>' then begin
      Dialog := nil;
      try
        Dialog := TOpenDialog.Create(nil);
      {$IFDEF LINUX}
        Dialog.Filter := 'All Files (*)|*';
      {$ELSE}
        Dialog.Filter := 'SQL Server Database Files (*.sdf)|*.sdf|All Files (*.*)|*.*';
      {$ENDIF}
        Dialog.Options := Dialog.Options + [ofPathMustExist];
        if Dialog.Execute then begin
          Connection.Connected := False;
          FDataBaseText := Dialog.FileName;
        {$IFDEF MSWINDOWS}
          PostMessage(Handle, WM_SETDATABASETEXT, 0, 0);
        {$ENDIF}
        end
        else
          edDatabase.ItemIndex := FCurrItemIndex;
      finally
        Dialog.Free;
      end;
    end
    else
      FCurrItemIndex := edDatabase.Items.IndexOf(edDatabase.Text);
    OldConnected := Connection.Connected;
    try
      Connection.Connected := False;
      Connection.Database := edDatabase.Text;
    finally
      Connection.Connected := OldConnected;
    end;
  finally
    ShowState;
  end;
end;

procedure TMSConnectionEditorForm.WMSetDataBaseText(var Message: TMessage);
var
  OldConnected: boolean;
begin
  edDatabase.SetFocus;
  edDatabase.Text := FDataBaseText;
  OldConnected := Connection.Connected;
  try
    Connection.Connected := False;
    Connection.Database := edDatabase.Text;
  finally
    Connection.Connected := OldConnected;
  end;
  edDatabase.SelectAll;
end;

procedure TMSConnectionEditorForm.FormShow(Sender: TObject);
begin
  inherited;
  TMSAccessUtils.SetLockLoginPromt(Connection, True);
end;

procedure TMSConnectionEditorForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  if CanClose then
    TMSAccessUtils.SetLockLoginPromt(Connection, False);
end;

end.