[JVCL-Checkins] CVS: dev/JVCL3/run JvBDECheckPasswordForm.dfm,NONE,1.1 JvBDECheckPasswordForm.pas,NO

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 454-5900

Update of /cvsroot/jvcl/dev/JVCL3/run
In directory sc8-pr-cvs1:/tmp/cvs-serv15511/JVCL3/run

Modified Files:
	JvCsvData.pas JvDBControls.pas JvRadioControl.pas JvxCtrls.pas 
Added Files:
	JvBDECheckPasswordForm.dfm JvBDECheckPasswordForm.pas 
	JvBDEExceptionForm.dfm JvBDEExceptionForm.pas JvBDEFilter.pas 
	JvBDEIndex.pas JvBDELists.pas JvBDELoginDialog.pas 
	JvBDEMemTable.pas JvBDEMove.pas JvBDEProgress.pas JvBDEQBE.pas 
	JvBDEQuery.pas JvBDESQLScript.pas JvBDESecurity.pas 
	JvDBLoginForm.pas JvDBLookup.pas JvDBQueryParamsForm.dfm 
	JvDBQueryParamsForm.pas JvDBRemoteLogin.pas 
Removed Files:
	JvAppUtils.pas JvDBExceptionForm.dfm JvDBExceptionForm.pas 
	JvDBFilter.pas JvDBIndex.pas JvDBLists.pas JvDBLoginDialog.pas 
	JvDBMove.pas JvDBProgress.pas JvDBQBE.pas JvDBSecurity.pas 
	JvLoginForm.dfm JvLoginForm.pas JvLookup.pas JvMemTable.pas 
	JvQueryParamsForm.dfm JvQueryParamsForm.pas JvRemoteLogin.pas 
	JvSQLScript.pas JvUtils.pas JvVCLUtils.pas 
Log Message:
-Several changes to package includes
-Renamed BDE units to JvBDEXXXX
-Renamed DB units to JvDBXXXX
-Fixed some warnings in JvCsvData
-Removed units not needed

--- NEW FILE: JvBDECheckPasswordForm.dfm ---
object JvChPswdForm: TJvChPswdForm
  Left = 309
  Top = 149
  ActiveControl = OldPswd
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  ClientHeight = 115
  ClientWidth = 347
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Position = poScreenCenter
  OnCreate = FormCreate
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object OldPswdLabel: TLabel
    Left = 19
    Top = 20
    Width = 94
    Height = 13
    AutoSize = False
  end
  object NewPswdLabel: TLabel
    Left = 19
    Top = 52
    Width = 94
    Height = 13
    AutoSize = False
  end
  object ConfirmLabel: TLabel
    Left = 19
    Top = 84
    Width = 94
    Height = 13
    AutoSize = False
  end
  object OldPswd: TEdit
    Left = 116
    Top = 16
    Width = 117
    Height = 21
    PasswordChar = '*'
    TabOrder = 0
    OnChange = PswdChange
  end
  object NewPswd: TEdit
    Left = 116
    Top = 48
    Width = 117
    Height = 21
    PasswordChar = '*'
    TabOrder = 1
    OnChange = PswdChange
  end
  object ConfirmNewPswd: TEdit
    Left = 116
    Top = 80
    Width = 117
    Height = 21
    PasswordChar = '*'
    TabOrder = 2
    OnChange = PswdChange
  end
  object OkBtn: TButton
    Left = 254
    Top = 16
    Width = 77
    Height = 25
    Caption = 'OK'
    Default = True
    TabOrder = 3
    OnClick = OkBtnClick
  end
  object CancelBtn: TButton
    Left = 254
    Top = 48
    Width = 77
    Height = 25
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 4
  end
end

--- NEW FILE: JvBDECheckPasswordForm.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (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.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvChPswDlg.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Last Modified: 2002-07-04

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

{$I JVCL.INC}

unit JvBDECheckPasswordForm;

interface

uses
  SysUtils,
  Windows,
  Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,
  DBTables, DB;

type
  TChangePasswordEvent = function(UsersTable: TTable;
    const OldPassword, NewPassword: string): Boolean of object;

  TJvChPswdForm = class(TForm)
    OldPswdLabel: TLabel;
    OldPswd: TEdit;
    NewPswdLabel: TLabel;
    NewPswd: TEdit;
    ConfirmLabel: TLabel;
    ConfirmNewPswd: TEdit;
    OkBtn: TButton;
    CancelBtn: TButton;
    procedure OkBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PswdChange(Sender: TObject);
  private
    FAttempt: Integer;
    FEnableEmpty: Boolean;
    procedure ClearEdits;
    procedure OkEnabled;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    Database: TDatabase;
    AttemptNumber: Integer;
    UsersTableName: string;
    UserNameField: string;
    LoginName: string;
    OnChangePassword: TChangePasswordEvent;
  end;

function ChangePasswordDialog(Database: TDatabase; AttemptNumber: Integer;
  const UsersTableName, UserNameField, LoginName: string;
  MaxPwdLen: Integer; EnableEmptyPassword: Boolean;
  ChangePasswordEvent: TChangePasswordEvent): Boolean;

implementation

uses
  Consts,
  JvConsts, JvJVCLUtils;

{$R *.DFM}

function ChangePasswordDialog(Database: TDatabase; AttemptNumber: Integer;
  const UsersTableName, UserNameField, LoginName: string;
  MaxPwdLen: Integer; EnableEmptyPassword: Boolean;
  ChangePasswordEvent: TChangePasswordEvent): Boolean;
var
  Form: TJvChPswdForm;
  SaveCursor: TCursor;
begin
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crDefault;
  try
    Form := TJvChPswdForm.Create(Application);
    try
      Form.Database := Database;
      Form.AttemptNumber := AttemptNumber;
      Form.UsersTableName := UsersTableName;
      Form.UserNameField := UserNameField;
      Form.LoginName := LoginName;
      Form.OldPswd.MaxLength := MaxPwdLen;
      Form.NewPswd.MaxLength := MaxPwdLen;
      Form.ConfirmNewPswd.MaxLength := MaxPwdLen;
      Form.FEnableEmpty := EnableEmptyPassword;
      Form.OnChangePassword := ChangePasswordEvent;
      Result := (Form.ShowModal = mrOk);
    finally
      Form.Free;
    end;
  finally
    Screen.Cursor := SaveCursor;
  end;
end;

procedure TJvChPswdForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
end;

procedure TJvChPswdForm.FormCreate(Sender: TObject);
begin
  Caption := SChangePassword;
  OldPswdLabel.Caption := SOldPasswordLabel;
  NewPswdLabel.Caption := SNewPasswordLabel;
  ConfirmLabel.Caption := SConfirmPasswordLabel;
  OkBtn.Caption := ResStr(SOKButton);
  CancelBtn.Caption := ResStr(SCancelButton);
end;

procedure TJvChPswdForm.ClearEdits;
begin
  OldPswd.Text := '';
  NewPswd.Text := '';
  ConfirmNewPswd.Text := '';
  OkBtn.Enabled := FEnableEmpty;
end;

procedure TJvChPswdForm.OkEnabled;
begin
  OkBtn.Enabled := FEnableEmpty or ((OldPswd.Text <> '') and (NewPswd.Text <> '')
    and (ConfirmNewPswd.Text <> ''));
end;

procedure TJvChPswdForm.OkBtnClick(Sender: TObject);
type
  TChangePasswordError = (peMismatch, peOther);
var
  Table: TTable;
  Ok: Boolean;
  Error: TChangePasswordError;
begin
  Ok := False;
  Inc(FAttempt);
  try
    if not (FAttempt > AttemptNumber) then
    begin
      if UsersTableName <> '' then
        Table := TTable.Create(Self)
      else
        Table := nil;
      try
        Error := peOther;
        if Table <> nil then
        begin
          Table.DatabaseName := Database.DatabaseName;
          {$IFDEF WIN32}
          Table.SessionName := Database.SessionName;
          {$ENDIF}
          Table.TableName := UsersTableName;
          Table.IndexFieldNames := UserNameField;
          Table.Open;
          if Table.FindKey([LoginName]) then
          begin
            if NewPswd.Text <> ConfirmNewPswd.Text then
              Error := peMismatch
            else
            if Assigned(OnChangePassword) then
              Ok := OnChangePassword(Table, OldPswd.Text, NewPswd.Text);
          end;
        end
        else
        begin
          if NewPswd.Text <> ConfirmNewPswd.Text then
            Error := peMismatch
          else
          if Assigned(OnChangePassword) then
            Ok := OnChangePassword(Table, OldPswd.Text, NewPswd.Text);
        end;
        if Ok then
          MessageDlg(SPasswordChanged, mtInformation, [mbOk], 0)
        else
        if Error = peMismatch then
          MessageDlg(SPasswordsMismatch, mtError, [mbOk], 0)
        else
          MessageDlg(SPasswordNotChanged, mtError, [mbOk], 0);
      finally
        if Table <> nil then
          Table.Free;
      end;
    end;
  finally
    if Ok then
      ModalResult := mrOk
    else
    if FAttempt > AttemptNumber then
      ModalResult := mrCancel
    else
      ModalResult := mrNone;
  end;
end;

procedure TJvChPswdForm.FormShow(Sender: TObject);
begin
  ClearEdits;
end;

procedure TJvChPswdForm.PswdChange(Sender: TObject);
begin
  OkEnabled;
end;

end.

--- NEW FILE: JvBDEExceptionForm.dfm ---
object JvBdeErrorDlg: TJvBdeErrorDlg
  Left = 202
  Top = 100
  ActiveControl = OKBtn
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  ClientHeight = 252
  ClientWidth = 380
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = True
  Position = poScreenCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object BasicPanel: TPanel
    Left = 0
    Top = 0
    Width = 288
    Height = 108
    Align = alClient
    BevelOuter = bvNone
    TabOrder = 0
    object ErrorText: TLabel
      Left = 49
      Top = 10
      Width = 231
      Height = 88
      Align = alClient
      WordWrap = True
    end
    object IconPanel: TPanel
      Left = 0
      Top = 10
      Width = 49
      Height = 88
      Align = alLeft
      BevelOuter = bvNone
      TabOrder = 0
      object IconImage: TImage
        Left = 6
        Top = 1
        Width = 34
        Height = 34
      end
    end
    object TopPanel: TPanel
      Left = 0
      Top = 0
      Width = 288
      Height = 10
      Align = alTop
      BevelOuter = bvNone
      TabOrder = 1
    end
    object RightPanel: TPanel
      Left = 280
      Top = 10
      Width = 8
      Height = 88
      Align = alRight
      BevelOuter = bvNone
      TabOrder = 2
    end
    object BottomPanel: TPanel
      Left = 0
      Top = 98
      Width = 288
      Height = 10
      Align = alBottom
      BevelOuter = bvNone
      TabOrder = 3
    end
  end
  object DetailsPanel: TPanel
    Left = 0
    Top = 108
    Width = 380
    Height = 144
    Align = alBottom
    BevelInner = bvLowered
    BevelOuter = bvLowered
    TabOrder = 2
    object BDELabel: TJvLabel
      Left = 87
      Top = 11
      Width = 121
      Height = 13
      Alignment = taRightJustify
      AutoSize = False
    end
    object NativeLabel: TJvLabel
      Left = 87
      Top = 30
      Width = 121
      Height = 13
      Alignment = taRightJustify
      AutoSize = False
    end
    object DbMessageText: TMemo
      Left = 7
      Top = 53
      Width = 366
      Height = 54
      TabStop = False
      Color = clBtnFace
      ReadOnly = True
      TabOrder = 0
      WantReturns = False
    end
    object DbResult: TEdit
      Left = 214
      Top = 8
      Width = 80
      Height = 21
      TabStop = False
      ParentColor = True
      ReadOnly = True
      TabOrder = 1
    end
    object DbCatSub: TEdit
      Left = 293
      Top = 8
      Width = 80
      Height = 21
      TabStop = False
      ParentColor = True
      ReadOnly = True
      TabOrder = 2
    end
    object NativeResult: TEdit
      Left = 214
      Top = 27
      Width = 159
      Height = 21
      TabStop = False
      ParentColor = True
      ReadOnly = True
      TabOrder = 3
    end
    object Back: TButton
      Left = 210
      Top = 112
      Width = 79
      Height = 25
      TabOrder = 4
      OnClick = BackClick
    end
    object Next: TButton
      Left = 294
      Top = 112
      Width = 79
      Height = 25
      TabOrder = 5
      OnClick = NextClick
    end
  end
  object ButtonPanel: TPanel
    Left = 288
    Top = 0
    Width = 92
    Height = 108
    Align = alRight
    BevelOuter = bvNone
    TabOrder = 1
    object DetailsBtn: TButton
      Left = 7
      Top = 65
      Width = 79
      Height = 25
      TabOrder = 1
      OnClick = DetailsBtnClick
    end
    object OKBtn: TButton
      Left = 7
      Top = 12
      Width = 79
      Height = 25
      Cancel = True
      Default = True
      ModalResult = 1
      TabOrder = 0
    end
  end
end

--- NEW FILE: JvBDEExceptionForm.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (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.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDbExcpt.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

TJvBdeErrorDlg based on sample form
   DELPHI\DEMOS\DB\TOOLS\DBEXCEPT.PAS

Last Modified: 2002-07-04

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

{$I JVCL.INC}

unit JvBDEExceptionForm;

interface

uses
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DBTables,
  JvxCtrls, JvLabel, JvComponent;

type
  TDBErrorEvent = procedure(Error: TDBError; var Msg: string) of object;

  TJvBdeErrorDlg = class(TForm)
    BasicPanel: TPanel;
    ErrorText: TLabel;
    IconPanel: TPanel;
    IconImage: TImage;
    TopPanel: TPanel;
    RightPanel: TPanel;
    DetailsPanel: TPanel;
    DbMessageText: TMemo;
    DbResult: TEdit;
    DbCatSub: TEdit;
    NativeResult: TEdit;
    Back: TButton;
    Next: TButton;
    ButtonPanel: TPanel;
    DetailsBtn: TButton;
    OKBtn: TButton;
    BDELabel: TJvLabel;
    NativeLabel: TJvLabel;
    BottomPanel: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure DetailsBtnClick(Sender: TObject);
    procedure BackClick(Sender: TObject);
    procedure NextClick(Sender: TObject);
  private
    CurItem: Integer;
    Details: Boolean;
    DetailsHeight: Integer;
    DbException: EDbEngineError;
    FPrevOnException: TExceptionEvent;
    FOnErrorMsg: TDBErrorEvent;
    procedure GetErrorMsg(Error: TDBError; var Msg: string);
    procedure ShowError;
    procedure SetShowDetails(Value: Boolean);
  public
    procedure ShowException(Sender: TObject; E: Exception);
    property OnErrorMsg: TDBErrorEvent read FOnErrorMsg write FOnErrorMsg;
  end;

const
  DbErrorHelpCtx: THelpContext = 0;

var
  DbEngineErrorDlg: TJvBdeErrorDlg;

procedure DbErrorIntercept;

implementation

uses
  Consts, Windows, BDE, JvConsts;

{$R *.DFM}

procedure DbErrorIntercept;
begin
  if DbEngineErrorDlg <> nil then
    DbEngineErrorDlg.Free;
  DbEngineErrorDlg := TJvBdeErrorDlg.Create(Application);
end;

procedure TJvBdeErrorDlg.ShowException(Sender: TObject; E: Exception);
begin
  Screen.Cursor := crDefault;
  Application.NormalizeTopMosts;
  try
    if (E is EDbEngineError) and (DbException = nil) and
      not Application.Terminated then
    begin
      DbException := EDbEngineError(E);
      try
        ShowModal;
      finally
        DbException := nil;
      end;
    end
    else
    begin
      if Assigned(FPrevOnException) then
        FPrevOnException(Sender, E)
      else
      if NewStyleControls then
        Application.ShowException(E)
      else
        MessageDlg(E.Message + '.', mtError, [mbOk], 0);
    end;
  except
    { ignore any exceptions }
  end;
  Application.RestoreTopMosts;
end;

procedure TJvBdeErrorDlg.ShowError;
var
  BDEError: TDbError;
  S: string;
  I: Integer;
begin
  Back.Enabled := (CurItem > 0);
  Next.Enabled := (CurItem < DbException.ErrorCount - 1);
  BDEError := DbException.Errors[CurItem];
  { Fill BDE error information }
  BDELabel.Enabled := True;
  DbResult.Text := IntToStr(BDEError.ErrorCode);
  DbCatSub.Text := Format('[$%s] [$%s]', [IntToHex(BDEError.Category, 2),
    IntToHex(BDEError.SubCode, 2)]);
  { Fill native error information }
  NativeLabel.Enabled := BDEError.NativeError <> 0;
  if NativeLabel.Enabled then
    NativeResult.Text := IntToStr(BDEError.NativeError)
  else
    NativeResult.Clear;
  { The message text is common to both BDE and native errors }
  S := Trim(BDEError.Message);
  for I := 1 to Length(S) do
    if S[I] < ' ' then
      S[I] := ' ';
  {GetErrorMsg(BDEError, S);}
  DbMessageText.Text := Trim(S);
end;

procedure TJvBdeErrorDlg.SetShowDetails(Value: Boolean);
begin
  DisableAlign;
  try
    if Value then
    begin
      DetailsPanel.Height := DetailsHeight;
      ClientHeight := DetailsPanel.Height + BasicPanel.Height;
      DetailsBtn.Caption := '<< &' + SDetails;
      CurItem := 0;
      ShowError;
    end
    else
    begin
      ClientHeight := BasicPanel.Height;
      DetailsPanel.Height := 0;
      DetailsBtn.Caption := '&' + SDetails + ' >>';
    end;
    DetailsPanel.Enabled := Value;
    Details := Value;
  finally
    EnableAlign;
  end;
end;

procedure TJvBdeErrorDlg.GetErrorMsg(Error: TDBError; var Msg: string);
begin
  if Assigned(FOnErrorMsg) then
  try
    FOnErrorMsg(Error, Msg);
  except
  end;
end;

procedure TJvBdeErrorDlg.FormCreate(Sender: TObject);
begin
  {$IFNDEF WIN32}
  BorderIcons := [];
  {$ENDIF}
  DetailsHeight := DetailsPanel.Height;
  Icon.Handle := LoadIcon(0, IDI_EXCLAMATION);
  IconImage.Picture.Icon := Icon;
  { Load string resources }
  Caption := SDBExceptCaption;
  BDELabel.Caption := SBDEErrorLabel;
  NativeLabel.Caption := SServerErrorLabel;
  Next.Caption := SNextButton + ' >';
  Back.Caption := '< ' + SPrevButton;
  OKBtn.Caption := SOKButton;
  { Set exception handler }
  FPrevOnException := Application.OnException;
  Application.OnException := ShowException;
end;

procedure TJvBdeErrorDlg.FormDestroy(Sender: TObject);
begin
  Application.OnException := FPrevOnException;
end;

procedure TJvBdeErrorDlg.FormShow(Sender: TObject);
var
  S: string;
  ErrNo: Integer;
begin
  if DbException.HelpContext <> 0 then
    HelpContext := DbException.HelpContext
  else
    HelpContext := DbErrorHelpCtx;
  CurItem := 0;
  if (DbException.ErrorCount > 1) and
    (DbException.Errors[1].NativeError <> 0) and
    ((DbException.Errors[0].ErrorCode = DBIERR_UNKNOWNSQL) or
    { General SQL error }
    (DbException.Errors[0].ErrorCode = DBIERR_INVALIDUSRPASS)) then
    { Unknown username or password }
    ErrNo := 1
  else
    ErrNo := 0;
  S := Trim(DbException.Errors[ErrNo].Message);
  GetErrorMsg(DbException.Errors[ErrNo], S);
  ErrorText.Caption := S;
  SetShowDetails(False);
  DetailsBtn.Enabled := DbException.ErrorCount > 0;
end;

procedure TJvBdeErrorDlg.DetailsBtnClick(Sender: TObject);
begin
  SetShowDetails(not Details);
end;

procedure TJvBdeErrorDlg.BackClick(Sender: TObject);
begin
  Dec(CurItem);
  ShowError;
end;

procedure TJvBdeErrorDlg.NextClick(Sender: TObject);
begin
  Inc(CurItem);
  ShowError;
end;

initialization
  DbEngineErrorDlg := nil;

end.

--- NEW FILE: JvBDEFilter.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (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.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBFilter.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Last Modified: 2002-07-04

[...1675 lines suppressed...]
procedure TJvDBFilter.ActiveChanged;
var
  WasActive: Boolean;
begin
  if not FIgnoreDataEvents then
  begin
    WasActive := Active;
    DropFilters;
    if not (csDestroying in ComponentState) then
    begin
      RecreateExprFilter;
      RecreateFuncFilter;
      if WasActive then
        Activate;
    end;
  end;
end;

end.

--- NEW FILE: JvBDEIndex.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (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.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBIndex.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Last Modified: 2002-07-04

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

{$I JVCL.INC}

unit JvBDEIndex;

interface

{$IFDEF WIN32}
uses
  SysUtils, Messages, Classes, Controls,
  Graphics, Menus, StdCtrls, DB, DBTables;
{$ELSE}
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Controls,
  Graphics, Menus, StdCtrls, DB, DBTables;
{$ENDIF}

type
  // (rom) needs Jv prefix
  TIdxDisplayMode = (dmFieldLabels, dmFieldNames, dmIndexName);

  TJvDBIndexCombo = class(TCustomComboBox)
  private
    FDataLink: TDataLink;
    FUpdate: Boolean;
    FNoIndexItem: string;
    FEnableNoIndex: Boolean;
    FChanging: Boolean;
    FDisplayMode: TIdxDisplayMode;
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    function GetIndexFieldName(var AName: string): Boolean;
    procedure SetNoIndexItem(const Value: string);
    function GetNoIndexItem: string;
    procedure SetEnableNoIndex(Value: Boolean);
    procedure SetDisplayMode(Value: TIdxDisplayMode);
    procedure ActiveChanged;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure FillIndexList(List: TStrings);
    procedure Change; override;
    procedure UpdateList; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property NoIndexItem: string read GetNoIndexItem write SetNoIndexItem;
    property EnableNoIndex: Boolean read FEnableNoIndex write SetEnableNoIndex default False;
    property DisplayMode: TIdxDisplayMode read FDisplayMode write SetDisplayMode default dmFieldLabels;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Color;
    property Ctl3D;
    property DropDownCount;
    property Font;
    {$IFDEF COMPILER4_UP}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    {$ENDIF}
    {$IFDEF WIN32}
    {$IFDEF COMPILER3_UP}
    property ImeMode;
    property ImeName;
    {$ENDIF}
    {$ENDIF}
    property ItemHeight;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    {$IFDEF COMPILER5_UP}
    property OnContextPopup;
    {$ENDIF}
    {$IFDEF WIN32}
    property OnStartDrag;
    {$ENDIF}
    {$IFDEF COMPILER4_UP}
    property OnEndDock;
    property OnStartDock;
    {$ENDIF}
  end;

implementation

uses
  {$IFNDEF WIN32}
  DbiErrs, DbiTypes, DbiProcs,
  {$ENDIF}
  JvBdeUtils;

//=== TJvKeyDataLink =========================================================

type
  TJvKeyDataLink = class(TDataLink)
  private
    FCombo: TJvDBIndexCombo;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
  public
    constructor Create(ACombo: TJvDBIndexCombo);
    destructor Destroy; override;
  end;

constructor TJvKeyDataLink.Create(ACombo: TJvDBIndexCombo);
begin
  inherited Create;
  FCombo := ACombo;
end;

destructor TJvKeyDataLink.Destroy;
begin
  FCombo := nil;
  inherited Destroy;
end;

procedure TJvKeyDataLink.ActiveChanged;
begin
  if FCombo <> nil then
    FCombo.ActiveChanged;
end;

procedure TJvKeyDataLink.DataSetChanged;
begin
  if FCombo <> nil then
    FCombo.ActiveChanged;
end;

procedure TJvKeyDataLink.DataSetScrolled(Distance: Integer);
begin
  { ignore this data event }
end;

//=== TJvDBIndexCombo ========================================================

constructor TJvDBIndexCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TJvKeyDataLink.Create(Self);
  Style := csDropDownList;
  FUpdate := False;
  FNoIndexItem := EmptyStr;
  FEnableNoIndex := False;
end;

destructor TJvDBIndexCombo.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  //DisposeStr(FNoIndexItem);
  FNoIndexItem := EmptyStr;
  inherited Destroy;
end;

procedure TJvDBIndexCombo.SetNoIndexItem(const Value: string);
begin
  if Value <> FNoIndexItem then
  begin
    FNoIndexItem := Value;
    if not (csLoading in ComponentState) then
      ActiveChanged;
  end;
end;

procedure TJvDBIndexCombo.SetEnableNoIndex(Value: Boolean);
begin
  if FEnableNoIndex <> Value then
  begin
    FEnableNoIndex := Value;
    if not (csLoading in ComponentState) then
      ActiveChanged;
  end;
end;

procedure TJvDBIndexCombo.SetDisplayMode(Value: TIdxDisplayMode);
begin
  if Value <> FDisplayMode then
  begin
    FDisplayMode := Value;
    if not (csLoading in ComponentState) then
      UpdateList;
  end;
end;

function TJvDBIndexCombo.GetNoIndexItem: string;
begin
  Result := FNoIndexItem;
end;

function TJvDBIndexCombo.GetDataSource: TDataSource;
begin
  if FDataLink <> nil then
    Result := FDataLink.DataSource
  else
    Result := nil;
end;

procedure TJvDBIndexCombo.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  {$IFDEF WIN32}
  if Value <> nil then
    Value.FreeNotification(Self);
  {$ENDIF}
  if not (csLoading in ComponentState) then
    ActiveChanged;
end;

procedure TJvDBIndexCombo.ActiveChanged;
begin
  if not (Enabled and FDataLink.Active and
    FDataLink.DataSet.InheritsFrom(TTable)) then
  begin
    Clear;
    ItemIndex := -1;
  end
  else
    UpdateList;
end;

procedure TJvDBIndexCombo.Loaded;
begin
  inherited Loaded;
  ActiveChanged;
end;

procedure TJvDBIndexCombo.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then
    DataSource := nil;
end;

procedure TJvDBIndexCombo.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if not (csLoading in ComponentState) then
    ActiveChanged;
end;

function TJvDBIndexCombo.GetIndexFieldName(var AName: string): Boolean;
begin
  Result := True;
  if ItemIndex >= 0 then
  begin
    if EnableNoIndex and (Items[ItemIndex] = NoIndexItem) then
      AName := ''
    else
    begin
      AName := TIndexDef(Items.Objects[ItemIndex]).Fields;
      if AName = '' then
      begin
        AName := TIndexDef(Items.Objects[ItemIndex]).Name;
        Result := False;
      end;
    end;
  end
  else
    AName := '';
end;

procedure TJvDBIndexCombo.FillIndexList(List: TStrings);
var
  AFld: string;
  Pos: Integer;
  I: Integer;
begin
  List.Clear;
  if not FDataLink.Active then
    Exit;
  with FDataLink.DataSet as TTable do
  begin
    for I := 0 to IndexDefs.Count - 1 do
      with IndexDefs[I] do
        if not (ixExpression in Options) then
        begin
          if FDisplayMode = dmIndexName then
            AFld := Name
          else
          begin
            AFld := '';
            Pos := 1;
            while Pos <= Length(Fields) do
            begin
              if AFld <> '' then
                AFld := AFld + '; ';
              case FDisplayMode of
                dmFieldLabels:
                  AFld := AFld + FieldByName(ExtractFieldName(Fields, Pos)).DisplayLabel;
                dmFieldNames:
                  AFld := AFld + FieldByName(ExtractFieldName(Fields, Pos)).FieldName;
              end;
            end;
          end;
          if List.IndexOf(AFld) < 0 then
            List.AddObject(AFld, IndexDefs[I]);
        end;
  end;
  if EnableNoIndex then
    if List.IndexOf(NoIndexItem) < 0 then
      List.AddObject(NoIndexItem, nil);
end;

procedure TJvDBIndexCombo.Change;
var
  ABookmark: TBookmark;
  AName: string;
begin
  if Enabled and FDataLink.Active and not FChanging and
    FDataLink.DataSet.InheritsFrom(TTable) and
    not (csLoading in ComponentState) then
  begin
    ABookmark := nil;
    with FDataLink.DataSet as TTable do
    begin
      if Database.IsSQLBased then
        ABookmark := GetBookmark;
      try
        if GetIndexFieldName(AName) then
        begin
          IndexFieldNames := AName;
          if (AName = '') and (IndexDefs.Count > 0) then
            IndexName := '';
        end
        else
        begin
          if AName = '' then
            IndexFieldNames := '';
          IndexName := AName;
        end;
        if (ABookmark <> nil) then
          SetToBookmark(TTable(Self.FDataLink.DataSet), ABookmark);
      finally
        if ABookmark <> nil then
          FreeBookmark(ABookmark);
      end;
    end;
  end;
  inherited Change;
end;

procedure TJvDBIndexCombo.UpdateList;

  function FindIndex(Table: TTable): Integer;
  var
    I: Integer;
    IdxFields: string;
  begin
    Result := -1;
    IdxFields := '';
    if Table.IndexFieldNames <> '' then
      for I := 0 to Table.IndexFieldCount - 1 do
      begin
        if IdxFields <> '' then
          IdxFields := IdxFields + ';';
        IdxFields := IdxFields + Table.IndexFields[I].FieldName;
      end;
    for I := 0 to Items.Count - 1 do
    begin
      if (Items.Objects[I] <> nil) and
        (((IdxFields <> '') and
        (AnsiCompareText(TIndexDef(Items.Objects[I]).Fields, IdxFields) = 0)) or
        ((Table.IndexName <> '') and
        (AnsiCompareText(TIndexDef(Items.Objects[I]).Name, Table.IndexName) = 0))) then
      begin
        Result := I;
        Exit;
      end;
    end;
    if EnableNoIndex and FDataLink.Active then
      if (Table.IndexFieldNames = '') and (Table.IndexName = '') then
        Result := Items.IndexOf(NoIndexItem);
  end;

begin
  if Enabled and FDataLink.Active then
  try
    Items.BeginUpdate;
    try
      if FDataLink.DataSet.InheritsFrom(TTable) then
      begin
        TTable(FDataLink.DataSet).IndexDefs.Update;
        FillIndexList(Items);
        ItemIndex := FindIndex(TTable(FDataLink.DataSet));
        FChanging := True;
      end
      else
        Items.Clear;
    finally
      Items.EndUpdate;
    end;
  finally
    FChanging := False;
  end;
end;

end.

--- NEW FILE: JvBDELists.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (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.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBLists.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Last Modified: 2002-07-04

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

{$I JVCL.INC}

unit JvBDELists;

interface

uses
  SysUtils, Classes, DB, DBTables,
  {$IFDEF WIN32}
  Bde,
  {$ELSE}
  WinTypes, WinProcs, DbiTypes, DbiProcs, DbiErrs,
  {$ENDIF}
  JvDBUtils;

type
  TBDEItemType = (bdDatabases, bdDrivers, bdLangDrivers, bdUsers
    {$IFDEF WIN32}, bdRepositories {$ENDIF});

  TJvCustomBDEItems = class(TBDEDataSet)
  private
    FItemType: TBDEItemType;
    {$IFDEF WIN32}
    FSessionName: string;
    FSessionLink: TDatabase;
    function GetDBSession: TSession;
    procedure SetSessionName(const Value: string);
    {$ENDIF}
    procedure SetItemType(Value: TBDEItemType);
  protected
    {$IFDEF WIN32}
    function GetRecordCount: {$IFNDEF COMPILER3_UP} Longint {$ELSE} Integer; override {$ENDIF};
    procedure OpenCursor {$IFDEF COMPILER3_UP} (InfoQuery: Boolean) {$ENDIF}; override;
    procedure CloseCursor; override;
    {$ENDIF}
    function CreateHandle: HDBICur; override;
    property ItemType: TBDEItemType read FItemType write SetItemType
      default bdDatabases;
  public
    {$IFDEF WIN32}
    {$IFDEF COMPILER3_UP}
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
    {$ENDIF}
    property DBSession: TSession read GetDBSession;
    {$IFNDEF COMPILER3_UP}
    property RecordCount: Longint read GetRecordCount;
    {$ENDIF}
  published
    property SessionName: string read FSessionName write SetSessionName;
    {$ENDIF WIN32}
  end;

  TJvBDEItems = class(TJvCustomBDEItems)
  published
    property ItemType;
  end;

  TJvDBListDataSet = class(TDBDataSet)
  {$IFDEF WIN32}
  protected
    function GetRecordCount: {$IFNDEF COMPILER3_UP} Longint {$ELSE} Integer; override {$ENDIF};
  public
    {$IFDEF COMPILER3_UP}
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
    {$ELSE}
    property RecordCount: Longint read GetRecordCount;
    {$ENDIF}
  {$ENDIF}
  end;

  TDBItemType = (dtTables, dtStoredProcs, dtFiles {$IFDEF WIN32},
    dtFunctions {$ENDIF});

  TJvCustomDatabaseItems = class(TJvDBListDataSet)
  private
    FExtended: Boolean;
    FSystemItems: Boolean;
    FFileMask: string;
    FItemType: TDBItemType;
    procedure SetFileMask(const Value: string);
    procedure SetExtendedInfo(Value: Boolean);
    procedure SetSystemItems(Value: Boolean);
    procedure SetItemType(Value: TDBItemType);
  protected
    function CreateHandle: HDBICur; override;
    function GetItemName: string;
    property ItemType: TDBItemType read FItemType write SetItemType
      default dtTables;
    property ExtendedInfo: Boolean read FExtended write SetExtendedInfo
      default False;
    property FileMask: string read FFileMask write SetFileMask;
    property SystemItems: Boolean read FSystemItems write SetSystemItems
      default False;
  public
    property ItemName: string read GetItemName;
  end;

  TJvDatabaseItems = class(TJvCustomDatabaseItems)
  published
    property ItemType;
    property ExtendedInfo;
    property FileMask;
    property SystemItems;
  end;

  TTabItemType = (dtFields, dtIndices, dtValChecks, dtRefInt,
    dtSecurity, dtFamily);

  TJvCustomTableItems = class(TJvDBListDataSet)
  private
    FTableName: TFileName;
    FItemType: TTabItemType;
    FPhysTypes: Boolean;
    procedure SetTableName(const Value: TFileName);
    procedure SetItemType(Value: TTabItemType);
    procedure SetPhysTypes(Value: Boolean);
  protected
    function CreateHandle: HDBICur; override;
    property ItemType: TTabItemType read FItemType write SetItemType
      default dtFields;
    property PhysTypes: Boolean read FPhysTypes write SetPhysTypes
      default False; { for dtFields only }
  published
    property TableName: TFileName read FTableName write SetTableName;
  end;

  TJvTableItems = class(TJvCustomTableItems)
  published
    property ItemType;
    property PhysTypes;
  end;

  TJvDatabaseDesc = class(TObject)
  private
    FDescription: DBDesc;
  public
    constructor Create(const DatabaseName: string);
    property Description: DBDesc read FDescription;
  end;

  TJvDriverDesc = class(TObject)
  private
    FDescription: DRVType;
  public
    constructor Create(const DriverType: string);
    property Description: DRVType read FDescription;
  end;

{$IFNDEF CBUILDER}
{ Obsolete classes, for backward compatibility only }

type
  TJvDatabaseList = class(TJvCustomBDEItems);

  TJvLangDrivList = class(TJvCustomBDEItems)
    constructor Create(AOwner: TComponent); override;
  end;

  TJvTableList = class(TJvCustomDatabaseItems)
  public
    function GetTableName: string;
  published
    property ExtendedInfo;
    property FileMask;
    property SystemItems;
  end;

  TJvStoredProcList = class(TJvCustomDatabaseItems)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ExtendedInfo;
    property SystemItems;
  end;

  TJvFieldList = class(TJvCustomTableItems);

  TJvIndexList = class(TJvCustomTableItems)
    constructor Create(AOwner: TComponent); override;
  end;

{$ENDIF CBUILDER}

implementation

uses
  DBConsts, BDEConst, JvConsts;

{ Utility routines }

function dsGetRecordCount(DataSet: TBDEDataSet): Longint;
begin
  if DataSet.State = dsInactive then
    _DBError(SDataSetClosed);
  Check(DbiGetRecordCount(DataSet.Handle, Result));
end;

//=== TJvSessionLink =========================================================

{$IFDEF WIN32}

type
  TJvSessionLink = class(TDatabase)
  private
    FList: TJvCustomBDEItems;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

constructor TJvSessionLink.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner <> nil) and (AOwner is TSession) then
    SessionName := TSession(AOwner).SessionName;
  Temporary := True;
  KeepConnection := False;
end;

destructor TJvSessionLink.Destroy;
begin
  if FList <> nil then
  begin
    FList.FSessionLink := nil;
    FList.Close;
  end;
  inherited Destroy;
end;

{$ENDIF}

//=== TJvCustomBDEItems ======================================================

procedure TJvCustomBDEItems.SetItemType(Value: TBDEItemType);
begin
  if ItemType <> Value then
  begin
    CheckInactive;
    FItemType := Value;
  end;
end;

function TJvCustomBDEItems.CreateHandle: HDBICur;
begin
  case FItemType of
    bdDatabases:
      Check(DbiOpenDatabaseList(Result));
    bdDrivers:
      Check(DbiOpenDriverList(Result));
    bdLangDrivers:
      Check(DbiOpenLdList(Result));
    bdUsers:
      Check(DbiOpenUserList(Result));
    {$IFDEF WIN32}
    bdRepositories:
      Check(DbiOpenRepositoryList(Result));
    {$ENDIF}
  end;
end;

{$IFDEF WIN32}

function TJvCustomBDEItems.GetDBSession: TSession;
begin
  Result := Sessions.FindSession(SessionName);
  if Result = nil then
    {$IFDEF COMPILER3_UP}
    Result := DBTables.Session;
    {$ELSE}
    Result := DB.Session;
    {$ENDIF}
end;

procedure TJvCustomBDEItems.SetSessionName(const Value: string);
begin
  CheckInactive;
  FSessionName := Value;
  DataEvent(dePropertyChange, 0);
end;

procedure TJvCustomBDEItems.OpenCursor;
var
  S: TSession;
begin
  S := Sessions.List[SessionName];
  S.Open;
  Sessions.CurrentSession := S;
  FSessionLink := TJvSessionLink.Create(S);
  try
    TJvSessionLink(FSessionLink).FList := Self;
    inherited OpenCursor {$IFDEF COMPILER3_UP} (InfoQuery) {$ENDIF};
  except
    FSessionLink.Free;
    FSessionLink := nil;
    raise;
  end;
end;

procedure TJvCustomBDEItems.CloseCursor;
begin
  inherited CloseCursor;
  if FSessionLink <> nil then
  begin
    TJvSessionLink(FSessionLink).FList := nil;
    FSessionLink.Free;
    FSessionLink := nil;
  end;
end;

function TJvCustomBDEItems.GetRecordCount: {$IFNDEF COMPILER3_UP} Longint {$ELSE} Integer {$ENDIF};
begin
  Result := dsGetRecordCount(Self);
end;

{$ENDIF WIN32}

{$IFDEF COMPILER3_UP}
function TJvCustomBDEItems.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := DataSetLocateThrough(Self, KeyFields, KeyValues, Options);
  if Result then
  begin
    DataEvent(deDataSetChange, 0);
    DoAfterScroll;
  end;
end;
{$ENDIF COMPILER3_UP}

//=== TJvDBListDataSet =======================================================

{$IFDEF COMPILER3_UP}
function TJvDBListDataSet.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := DataSetLocateThrough(Self, KeyFields, KeyValues, Options);
  if Result then
  begin
    DataEvent(deDataSetChange, 0);
    DoAfterScroll;
  end;
end;
{$ENDIF COMPILER3_UP}

{$IFDEF WIN32}
function TJvDBListDataSet.GetRecordCount: {$IFNDEF COMPILER3_UP} Longint {$ELSE} Integer {$ENDIF};
begin
  Result := dsGetRecordCount(Self);
end;
{$ENDIF WIN32}

//=== TJvCustomDatabaseItems =================================================

procedure TJvCustomDatabaseItems.SetItemType(Value: TDBItemType);
begin
  if ItemType <> Value then
  begin
    CheckInactive;
    FItemType := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TJvCustomDatabaseItems.SetFileMask(const Value: string);
begin
  if FileMask <> Value then
  begin
    if Active and (FItemType in [dtTables, dtFiles]) then
    begin
      DisableControls;
      try
        Close;
        FFileMask := Value;
        Open;
      finally
        EnableControls;
      end;
    end
    else
      FFileMask := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TJvCustomDatabaseItems.SetExtendedInfo(Value: Boolean);
begin
  if FExtended <> Value then
  begin
    CheckInactive;
    FExtended := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TJvCustomDatabaseItems.SetSystemItems(Value: Boolean);
begin
  if FSystemItems <> Value then
  begin
    if Active and (FItemType in [dtTables, dtStoredProcs]) then
    begin
      DisableControls;
      try
        Close;
        FSystemItems := Value;
        Open;
      finally
        EnableControls;
      end;
    end
    else
      FSystemItems := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

function TJvCustomDatabaseItems.CreateHandle: HDBICur;
var
  WildCard: PChar;
  Pattern: array [0..DBIMAXTBLNAMELEN] of Char;
begin
  WildCard := nil;
  if FileMask <> '' then
    WildCard := AnsiToNative(DBLocale, FileMask, Pattern, SizeOf(Pattern) - 1);
  case FItemType of
    dtTables:
      Check(DbiOpenTableList(DBHandle, FExtended, FSystemItems, WildCard, Result));
    dtStoredProcs:
      if DataBase.IsSQLBased then
        Check(DbiOpenSPList(DBHandle, FExtended, FSystemItems, nil, Result))
      else
        DatabaseError(SLocalDatabase);
    dtFiles:
      Check(DbiOpenFileList(DBHandle, WildCard, Result));
    {$IFDEF WIN32}
    dtFunctions:
      if DataBase.IsSQLBased then
        Check(DbiOpenFunctionList(DBHandle, DBIFUNCOpts(FExtended), @Result))
      else
        DatabaseError(SLocalDatabase);
    {$ENDIF}
  end;
end;

function TJvCustomDatabaseItems.GetItemName: string;
const
  sObjListNameField = 'NAME';
  sFileNameField = 'FILENAME';
  sTabListExtField = 'EXTENSION';
var
  Temp: string;
  Field: TField;
begin
  Result := '';
  if not Active then
    Exit;
  if FItemType = dtFiles then
    Field := FindField(sFileNameField)
  else
    Field := FindField(sObjListNameField);
  if Field = nil then
    Exit;
  Result := Field.AsString;
  if FItemType in [dtTables, dtFiles] then
  begin
    Field := FindField(sTabListExtField);
    if Field = nil then
      Exit;
    Temp := Field.AsString;
    if Temp <> '' then
    begin
      if Temp[1] <> '.' then
        Temp := '.' + Temp;
      Result := Result + Temp;
    end;
  end;
end;

procedure TJvCustomTableItems.SetItemType(Value: TTabItemType);
begin
  if ItemType <> Value then
  begin
    CheckInactive;
    FItemType := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TJvCustomTableItems.SetPhysTypes(Value: Boolean);
begin
  if Value <> PhysTypes then
  begin
    if Active and (ItemType = dtFields) then
    begin
      DisableControls;
      try
        Close;
        FPhysTypes := Value;
        Open;
      finally
        EnableControls;
      end;
    end
    else
      FPhysTypes := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

procedure TJvCustomTableItems.SetTableName(const Value: TFileName);
begin
  if Value <> FTableName then
  begin
    if Active then
    begin
      DisableControls;
      try
        Close;
        FTableName := Value;
        if FTableName <> '' then
          Open;
      finally
        EnableControls;
      end;
    end
    else
      FTableName := Value;
    DataEvent(dePropertyChange, 0);
  end;
end;

function TJvCustomTableItems.CreateHandle: HDBICur;
var
  STableName: PChar;
begin
  if FTableName = '' then
    _DBError(SNoTableName);
  STableName := StrAlloc(Length(FTableName) + 1);
  try
    AnsiToNative(DBLocale, FTableName, STableName, Length(FTableName));
    case FItemType of
      dtFields:
        while not CheckOpen(DbiOpenFieldList(DBHandle, STableName, nil,
          FPhysTypes, Result)) do {Retry}
          ;
      dtIndices:
        while not CheckOpen(DbiOpenIndexList(DBHandle, STableName, nil,
          Result)) do {Retry}
          ;
      dtValChecks:
        while not CheckOpen(DbiOpenVchkList(DBHandle, STableName, nil,
          Result)) do {Retry}
          ;
      dtRefInt:
        while not CheckOpen(DbiOpenRintList(DBHandle, STableName, nil,
          Result)) do {Retry}
          ;
      dtSecurity:
        while not CheckOpen(DbiOpenSecurityList(DBHandle, STableName, nil,
          Result)) do {Retry}
          ;
      dtFamily:
        while not CheckOpen(DbiOpenFamilyList(DBHandle, STableName, nil,
          Result)) do {Retry}
          ;
    end;
  finally
    StrDispose(STableName);
  end;
end;

//=== TJvDatabaseDesc ========================================================

constructor TJvDatabaseDesc.Create(const DatabaseName: string);
var
  Buffer: PChar;
begin
  inherited Create;
  Buffer := StrPCopy(StrAlloc(Length(DatabaseName) + 1), DatabaseName);
  try
    Check(DbiGetDatabaseDesc(Buffer, @FDescription));
  finally
    StrDispose(Buffer);
  end;
end;

constructor TJvDriverDesc.Create(const DriverType: string);
var
  Buffer: PChar;
begin
  inherited Create;
  Buffer := StrPCopy(StrAlloc(Length(DriverType) + 1), DriverType);
  try
    Check(DbiGetDriverDesc(Buffer, FDescription));
  finally
    StrDispose(Buffer);
  end;
end;

{$IFNDEF CBUILDER}

//=== TJvLangDrivList ========================================================

constructor TJvLangDrivList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItemType := bdLangDrivers;
end;

//=== TJvTableList ===========================================================

function TJvTableList.GetTableName: string;
begin
  Result := ItemName;
end;

constructor TJvStoredProcList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItemType := dtStoredProcs;
end;

//=== TJvIndexList ===========================================================

constructor TJvIndexList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItemType := dtIndices;
end;

{$ENDIF CBUILDER}

end.

--- NEW FILE: JvBDELoginDialog.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (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.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvxLoginDlg.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributor(s):
  Polaris Software

Last Modified: 2002-07-04

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

{$I JVCL.INC}

unit JvBDELoginDialog;

interface

uses
  SysUtils, Classes, Controls, Forms, StdCtrls,
  ExtCtrls, DB, DBTables,
  JvBDELists, JvDBLoginForm;

type
  TCheckUserNameEvent = function(UsersTable: TTable;
    const UserName, Password: string): Boolean of object;

  TDialogMode = (dmAppLogin, dmDBLogin, dmUnlock);

  TJvDBLoginDialog = class(TObject)
  private
    FDialog: TJvLoginForm;
    FMode: TDialogMode;
    FSelectDatabase: Boolean;
    FIniAliasName: string;
    FCheckUserEvent: TCheckUserNameEvent;
    FCheckUnlock: TCheckUnlockEvent;
    FIconDblClick: TNotifyEvent;
    procedure Login(Database: TDatabase; LoginParams: TStrings);
    function GetUserInfo: Boolean;
    function CheckUser(Table: TTable): Boolean;
    function CheckUnlock: Boolean;
    procedure OkBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    function ExecuteAppLogin: Boolean;
    function ExecuteDbLogin(LoginParams: TStrings): Boolean;
    function ExecuteUnlock: Boolean;
  public
    // (rom) better make that properties
    Database: TDatabase;
    AttemptNumber: Integer;
    ShowDBName: Boolean;
    UsersTableName: string;
    UserNameField: string;
    MaxPwdLen: Integer;
    LoginName: string;
    IniFileName: string;
    UseRegistry: Boolean;
    constructor Create(DialogMode: TDialogMode; DatabaseSelect: Boolean);
    destructor Destroy; override;
    function Execute(LoginParams: TStrings): Boolean;
    function GetUserName: string;
    function CheckDatabaseChange: Boolean;
    procedure FillParams(LoginParams: TStrings);
    property Mode: TDialogMode read FMode;
    property SelectDatabase: Boolean read FSelectDatabase;
    property OnCheckUnlock: TCheckUnlockEvent read FCheckUnlock write FCheckUnlock;
    property OnCheckUserEvent: TCheckUserNameEvent read FCheckUserEvent write FCheckUserEvent;
    property OnIconDblClick: TNotifyEvent read FIconDblClick write FIconDblClick;
  end;

procedure OnLoginDialog(Database: TDatabase; LoginParams: TStrings;
  AttemptNumber: Integer; ShowDBName: Boolean);

function LoginDialog(Database: TDatabase; AttemptNumber: Integer;
  const UsersTableName, UserNameField: string; MaxPwdLen: Integer;
  CheckUserEvent: TCheckUserNameEvent; IconDblClick: TNotifyEvent;
  var LoginName: string; const IniFileName: string;
  UseRegistry, SelectDatabase: Boolean): Boolean;

function UnlockDialog(const UserName: string; OnUnlock: TCheckUnlockEvent;
  IconDblClick: TNotifyEvent): Boolean;
function UnlockDialogEx(const UserName: string; OnUnlock: TCheckUnlockEvent;
  IconDblClick: TNotifyEvent; MaxPwdLen, AttemptNumber: Integer): Boolean;

implementation

uses
  Windows, Registry, BDE,
  IniFiles, Graphics,
  JvJVCLUtils, JvConsts;

const
  keyLastLoginUserName = 'LastUser';
  keySelectDatabase = 'SelectDatabase'; { dialog never writes this value }
  keyLastAliasName = 'LastAlias'; { used if SelectDatabase = True  }

constructor TJvDBLoginDialog.Create(DialogMode: TDialogMode; DatabaseSelect: Boolean);
begin
  inherited Create;
  FMode := DialogMode;
  FSelectDatabase := DatabaseSelect;
  FDialog := CreateLoginDialog((FMode = dmUnlock), FSelectDatabase,
    FormShow, OkBtnClick);
  AttemptNumber := 3;
  ShowDBName := True;
end;

destructor TJvDBLoginDialog.Destroy;
begin
  FDialog.Free;
  inherited Destroy;
end;

procedure TJvDBLoginDialog.OkBtnClick(Sender: TObject);
var
  Ok: Boolean;
  SaveLogin: TDatabaseLoginEvent;
  SetCursor: Boolean;
begin
  if FMode = dmUnlock then
  begin
    Ok := False;
    try
      Ok := CheckUnlock;
    except
      Application.HandleException(Self);
    end;
    if Ok then
      FDialog.ModalResult := mrOk
    else
      FDialog.ModalResult := mrCancel;
  end
  else
  if Mode = dmAppLogin then
  begin
    {$IFDEF WIN32}
    SetCursor := GetCurrentThreadID = MainThreadID;
    {$ELSE}
    SetCursor := True;
    {$ENDIF}
    SaveLogin := Database.OnLogin;
    try
      try
        if Database.Connected then
          Database.Close; //Polaris
        if FSelectDatabase then
          Database.AliasName := FDialog.CustomCombo.Text;
        Database.OnLogin := Login;
        if SetCursor then
          Screen.Cursor := crHourGlass;
        try
          Database.Open;
        finally
          if SetCursor then
            Screen.Cursor := crDefault;
        end;
      except
        Application.HandleException(Self);
      end;
    finally
      Database.OnLogin := SaveLogin;
    end;
    if Database.Connected then
    try
      if SetCursor then
        Screen.Cursor := crHourGlass;
      Ok := False;
      try
        Ok := GetUserInfo;
      except
        Application.HandleException(Self);
      end;
      if Ok then
        FDialog.ModalResult := mrOk
      else
      begin
        FDialog.ModalResult := mrNone;
        Database.Close;
      end;
    finally
      if SetCursor then
        Screen.Cursor := crDefault;
    end;
  end
  else { dmDBLogin }
    FDialog.ModalResult := mrOk
end;

procedure TJvDBLoginDialog.FormShow(Sender: TObject);
var
  S: string;
begin
  if (FMode in [dmAppLogin, dmDBLogin]) and FSelectDatabase then
  begin
    with TJvBDEItems.Create(FDialog) do
    try
      {$IFDEF WIN32}
      SessionName := Database.SessionName;
      {$ENDIF}
      ItemType := bdDatabases;
      FDialog.CustomCombo.Items.Clear;
      Open;
      while not Eof do
      begin
        FDialog.CustomCombo.Items.Add(FieldByName('NAME').AsString);
        Next;
      end;
      if FIniAliasName = '' then
        S := Database.AliasName
      else
        S := FIniAliasName;
      with FDialog.CustomCombo do
        ItemIndex := Items.IndexOf(S);
    finally
      Free;
    end;
  end;
end;

function TJvDBLoginDialog.ExecuteAppLogin: Boolean;
var
  Ini: TObject;
begin
  try
    {$IFDEF WIN32}
    if UseRegistry then
    begin
      Ini := TRegIniFile.Create(IniFileName);
      {$IFDEF COMPILER5_UP}
      TRegIniFile(Ini).Access := KEY_READ;
      {$ENDIF}
    end
    else
      Ini := TIniFile.Create(IniFileName);
    {$ELSE}
    Ini := TIniFile.Create(IniFileName);
    {$ENDIF WIN32}
    try
      FDialog.UserNameEdit.Text := IniReadString(Ini, FDialog.ClassName,
        keyLastLoginUserName, LoginName);
      FSelectDatabase := IniReadBool(Ini, FDialog.ClassName,
        keySelectDatabase, FSelectDatabase);
      FIniAliasName := IniReadString(Ini, FDialog.ClassName,
        keyLastAliasName, '');
    finally
      Ini.Free;
    end;
  except
    IniFileName := '';
  end;
  FDialog.SelectDatabase := SelectDatabase;
  Result := (FDialog.ShowModal = mrOk);
  Database.OnLogin := nil;
  if Result then
  begin
    LoginName := GetUserName;
    if IniFileName <> '' then
    begin
      {$IFDEF WIN32}
      if UseRegistry then
        Ini := TRegIniFile.Create(IniFileName)
      else
        Ini := TIniFile.Create(IniFileName);
      {$ELSE}
      Ini := TIniFile.Create(IniFileName);
      {$ENDIF WIN32}
      try
        IniWriteString(Ini, FDialog.ClassName, keyLastLoginUserName, GetUserName);
        IniWriteString(Ini, FDialog.ClassName, keyLastAliasName, Database.AliasName);
      finally
        Ini.Free;
      end;
    end;
  end;
end;

function TJvDBLoginDialog.ExecuteDbLogin(LoginParams: TStrings): Boolean;
{$IFDEF WIN32}
var
  CurrSession: TSession;
{$ENDIF}
begin
  Result := False;
  if (Database = nil) or not Assigned(LoginParams) then
    Exit;
  if ShowDBName then
    FDialog.AppTitleLabel.Caption := Format(SDatabaseName, [Database.DatabaseName]);
  FDialog.UserNameEdit.Text := LoginParams.Values[szUSERNAME];
  {$IFDEF WIN32}
  CurrSession := Sessions.CurrentSession;
  {$ENDIF}
  try
    Result := FDialog.ShowModal = mrOk;
    if Result then
      FillParams(LoginParams)
    else
      SysUtils.Abort;
  finally
    {$IFDEF WIN32}
    Sessions.CurrentSession := CurrSession;
    {$ENDIF}
  end;
end;

function TJvDBLoginDialog.ExecuteUnlock: Boolean;
begin
  with FDialog.UserNameEdit do
  begin
    Text := LoginName;
    ReadOnly := True;
    Font.Color := clGrayText;
  end;
  Result := (FDialog.ShowModal = mrOk);
end;

function TJvDBLoginDialog.Execute(LoginParams: TStrings): Boolean;
var
  SaveCursor: TCursor;
begin
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crDefault;
  try
    if Assigned(FIconDblClick) then
    begin
      with FDialog.AppIcon do
      begin
        OnDblClick := OnIconDblClick;
        Cursor := crHand;
      end;
      with FDialog.KeyImage do
      begin
        OnDblClick := OnIconDblClick;
        Cursor := crHand;
      end;
    end;
    FDialog.PasswordEdit.MaxLength := MaxPwdLen;
    FDialog.AttemptNumber := AttemptNumber;
    case FMode of
      dmAppLogin: Result := ExecuteAppLogin;
      dmDBLogin: Result := ExecuteDbLogin(LoginParams);
      dmUnlock: Result := ExecuteUnlock;
    else
      Result := False;
    end;
    if Result then
      LoginName := GetUserName;
  finally
    Screen.Cursor := SaveCursor;
  end;
end;

function TJvDBLoginDialog.GetUserName: string;
begin
  if CheckDatabaseChange then
    Result := Copy(FDialog.UserNameEdit.Text, 1,
      Pos('@', FDialog.UserNameEdit.Text) - 1)
  else
    Result := FDialog.UserNameEdit.Text;
end;

function TJvDBLoginDialog.CheckDatabaseChange: Boolean;
begin
  Result := (FMode in [dmAppLogin, dmDBLogin]) and
    (Pos('@', Fdialog.UserNameEdit.Text) > 0) and
    ((Database <> nil) and (Database.DriverName <> '') and
    (CompareText(Database.DriverName, szCFGDBSTANDARD) <> 0));
end;

procedure TJvDBLoginDialog.FillParams(LoginParams: TStrings);
begin
  LoginParams.Values[szUSERNAME] := GetUserName;
  LoginParams.Values['PASSWORD'] := FDialog.PasswordEdit.Text;
  if CheckDatabaseChange then
  begin
    LoginParams.Values[szSERVERNAME] := Copy(FDialog.UserNameEdit.Text,
      Pos('@', FDialog.UserNameEdit.Text) + 1, MaxInt)
  end;
end;

procedure TJvDBLoginDialog.Login(Database: TDatabase; LoginParams: TStrings);
begin
  FillParams(LoginParams);
end;

function TJvDBLoginDialog.GetUserInfo: Boolean;
var
  Table: TTable;
begin
  if UsersTableName = '' then
    Result := CheckUser(nil)
  else
  begin
    Result := False;
    // Table := TTable.Create(Database);
    Table := TTable.Create(Application); // Polaris (?)
    try
      try
        Table.DatabaseName := Database.DatabaseName;
        {$IFDEF WIN32}
        Table.Ses...

[truncated message content]

[JVCL-Checkins] CVS: dev/JVCL3/run JvBDECheckPasswordForm.dfm,NONE,1.1 JvBDECheckPasswordForm.pas,NO

JEDI VCL for Delphi