source: branches/test1/Client/Forms/UFormLoginProfile.pas

unit UFormLoginProfile;

{$mode delphi}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Spin, SpecializedList, URegistry, Registry;

type
  TConnectProtocol = (cpXMLRPC, cpDirect, cpMySQL, cpINI, cpRegistry, cpSQLLite);

  { TConnectProfile }

  TConnectProfile = class
    Name: string;
    UserName: string;
    HostName: string;
    Protocol: TConnectProtocol;
    Database: string;
    Port: Word;
    constructor Create;
    procedure Assign(Source: TConnectProfile);
  end;

  { TProfileList }

  TProfileList = class(TListObject)
    procedure LoadFromRegistry(ARootKey: HKEY; AKey: string);
    procedure SaveToRegistry(ARootKey: HKEY; AKey: string);
    procedure Assign(Source: TProfileList);
    procedure FillStrings(Strings: TStrings);
  end;

  { TLoginProfileForm }

  TLoginProfileForm = class(TForm)
    ButtonCancel: TButton;
    ButtonAdd: TButton;
    ButtonDelete: TButton;
    ButtonOk: TButton;
    ComboBoxProtocol: TComboBox;
    EditName: TEdit;
    EditDatabase: TEdit;
    EditServer: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    LabelServer: TLabel;
    ListBoxProfiles: TListBox;
    Panel1: TPanel;
    SpinEditPort: TSpinEdit;
    procedure ButtonAddClick(Sender: TObject);
    procedure ButtonDeleteClick(Sender: TObject);
    procedure ButtonOkClick(Sender: TObject);
    procedure ComboBoxProtocolChange(Sender: TObject);
    procedure EditNameChange(Sender: TObject);
    procedure EditDatabaseChange(Sender: TObject);
    procedure EditServerChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListBoxProfilesSelectionChange(Sender: TObject; User: boolean);
    procedure SpinEditPortChange(Sender: TObject);
  private
    SelectedProfile: TConnectProfile;
    ProfileList: TProfileList;
  public
    procedure UpdateInterface;
  end;

resourcestring
  SProfile = 'Profile';
  SProtocolXMLRPC = 'XML-RPC';
  SProtocolMySQL = 'MySQL';
  SProtocolDirect = 'Direct';

var
  LoginProfileForm: TLoginProfileForm;
  ProtocolTypeText: array[TConnectProtocol] of string;

procedure UpdateTranslation;

implementation

{$R *.lfm}

uses
  UCore, UFormMain;

{ TConnectProfile }

constructor TConnectProfile.Create;
begin
  Port := 8090;
  HostName := 'localhost';
  UserName := 'admin';
  Name := SProfile;
  Database := 'database';
end;

procedure TConnectProfile.Assign(Source: TConnectProfile);
begin
  Name := Source.Name;
  UserName := Source.UserName;
  Database := Source.Database;
  Port := Source.Port;
  Protocol := Source.Protocol;
  HostName := Source.HostName;
end;

{ TLoginProfileForm }

procedure TLoginProfileForm.FormCreate(Sender: TObject);
begin
  ProfileList := TProfileList.Create;
end;

procedure TLoginProfileForm.ButtonOkClick(Sender: TObject);
begin
  Core.Profiles.Assign(ProfileList);
  Core.Profiles.SaveToRegistry(Core.RegistryRootKey, Core.RegistryKey);
end;

procedure TLoginProfileForm.ComboBoxProtocolChange(Sender: TObject);
begin
  if Assigned(SelectedProfile) then
    SelectedProfile.Protocol :=
      TConnectProtocol(ComboBoxProtocol.Items.Objects[ComboBoxProtocol.ItemIndex]);
end;

procedure TLoginProfileForm.EditNameChange(Sender: TObject);
begin
  if Assigned(SelectedProfile) then begin
    SelectedProfile.Name := EditName.Text;
    ListBoxProfiles.Items[ListBoxProfiles.ItemIndex] := EditName.Text;
  end;
end;

procedure TLoginProfileForm.EditDatabaseChange(Sender: TObject);
begin
  if Assigned(SelectedProfile) then
    SelectedProfile.Database := EditDatabase.Text;
end;

procedure TLoginProfileForm.EditServerChange(Sender: TObject);
begin
  if Assigned(SelectedProfile) then
    SelectedProfile.HostName := EditServer.Text;
end;

procedure TLoginProfileForm.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  MainForm.PersistentForm.Save(Self);
  Core.Profiles.SaveToRegistry(Core.RegistryRootKey, Core.RegistryKey);
end;

procedure TLoginProfileForm.ButtonAddClick(Sender: TObject);
begin
  ProfileList.AddNew(TConnectProfile.Create);
  ListBoxProfiles.Items.AddObject(TConnectProfile(ProfileList.Last).Name,
    TConnectProfile(ProfileList.Last));
end;

procedure TLoginProfileForm.ButtonDeleteClick(Sender: TObject);
begin
  if ListBoxProfiles.ItemIndex <> - 1 then begin
    ProfileList.Delete(ListBoxProfiles.ItemIndex);
    ListBoxProfiles.Items.Delete(ListBoxProfiles.ItemIndex);
  end;
end;

procedure TLoginProfileForm.FormDestroy(Sender: TObject);
begin
  ProfileList.Free;
end;

procedure TLoginProfileForm.FormShow(Sender: TObject);
var
  I: Integer;
begin
  ComboBoxProtocol.Clear;
  for I := 0 to Integer(High(ProtocolTypeText)) do
    ComboBoxProtocol.Items.AddObject(ProtocolTypeText[TConnectProtocol(I)],
      Pointer(I));

  MainForm.PersistentForm.Load(Self);
  ProfileList.Assign(Core.Profiles);
  ProfileList.FillStrings(ListBoxProfiles.Items);
  if Core.LastProfile < ListBoxProfiles.Count then
    ListBoxProfiles.ItemIndex := Core.LastProfile;
  if (ListBoxProfiles.Items.Count > 0) and
    (ListBoxProfiles.ItemIndex = -1) then ListBoxProfiles.ItemIndex := 0;
  UpdateInterface;
end;

procedure TLoginProfileForm.ListBoxProfilesSelectionChange(Sender: TObject;
  User: boolean);
begin
  if ListBoxProfiles.ItemIndex <> -1 then
  with TConnectProfile(ProfileList[ListBoxProfiles.ItemIndex]) do begin
    SelectedProfile := nil;
    EditServer.Text := HostName;
    EditDatabase.Text := Database;
    ComboBoxProtocol.ItemIndex := ComboBoxProtocol.Items.IndexOfObject(Pointer(Protocol));
    SpinEditPort.Value := Port;
    EditName.Text := Name;
    SelectedProfile := TConnectProfile(ProfileList[ListBoxProfiles.ItemIndex]);
    UpdateInterface;
  end;
end;

procedure TLoginProfileForm.SpinEditPortChange(Sender: TObject);
begin
  if Assigned(SelectedProfile) then
    SelectedProfile.Port := SpinEditPort.Value;
end;

procedure TLoginProfileForm.UpdateInterface;
begin
  EditName.Enabled := ListBoxProfiles.ItemIndex <> -1;
  EditServer.Enabled := ListBoxProfiles.ItemIndex <> -1;
  EditDatabase.Enabled := ListBoxProfiles.ItemIndex <> -1;
  SpinEditPort.Enabled := ListBoxProfiles.ItemIndex <> -1;
  ComboBoxProtocol.Enabled := ListBoxProfiles.ItemIndex <> -1;
end;

procedure TProfileList.LoadFromRegistry(ARootKey: HKEY; AKey: string);
var
  KeyInfo: TRegKeyInfo;
  I: Integer;
begin
  with TRegistryEx.Create do
  try
    RootKey := ARootKey;
    OpenKey(AKey + '\ConnectProfile', True);
    GetKeyInfo(KeyInfo);
    for I := 0 to KeyInfo.NumSubKeys - 1 do
    if KeyExists(AKey + '\ConnectProfile\' + IntToStr(I)) then begin
      OpenKey(AKey + '\ConnectProfile\' + IntToStr(I), True);
      with TConnectProfile(AddNew(TConnectProfile.Create)) do begin
        Name := ReadStringWithDefault('Name', Name);
        HostName := ReadStringWithDefault('HostName', HostName);
        Port := ReadIntegerWithDefault('Port', Port);
        Database := ReadStringWithDefault('Database', Database);
        Protocol := TConnectProtocol(ReadIntegerWithDefault('Protocol', Integer(Protocol)));
        UserName := ReadStringWithDefault('UserName', UserName);
      end;
    end;
  finally
    Free;
  end;
end;

procedure TProfileList.SaveToRegistry(ARootKey: HKEY; AKey: string);
var
  KeyInfo: TRegKeyInfo;
  I: Integer;
begin
  with TRegistryEx.Create do
  try
    RootKey := ARootKey;
    OpenKey(AKey + '\ConnectProfile', True);
    for I := 0 to Count - 1 do begin
      OpenKey(AKey + '\ConnectProfile\' + IntToStr(I), True);
      with TConnectProfile(Items[I]) do begin
        WriteString('Name', Name);
        WriteString('HostName', HostName);
        WriteInteger('Port', Port);
        WriteString('Database', Database);
        WriteInteger('Protocol', Integer(Protocol));
        WriteString('UserName', UserName);
      end;
    end;
  finally
    Free;
  end;
end;

procedure TProfileList.Assign(Source: TProfileList);
var
  I: Integer;
begin
  Clear;
  Count := Source.Count;
  for I := 0 to Source.Count - 1 do begin
    Items[I] := TConnectProfile.Create;
    TConnectProfile(Items[I]).Assign(TConnectProfile(Source.Items[I]));
  end;
end;

procedure TProfileList.FillStrings(Strings: TStrings);
var
  I: Integer;
begin
  Strings.Clear;
  for I := 0 to Count - 1 do
    Strings.AddObject(TConnectProfile(Items[I]).Name, Items[I]);
end;

procedure UpdateTranslation;
begin
  ProtocolTypeText[cpXMLRPC] := SProtocolXMLRPC;
  ProtocolTypeText[cpMySQL] := SProtocolMySQL;
  ProtocolTypeText[cpDirect] := SProtocolDirect;
end;

end.