Oracle Data Access Components Source Code ODAC v.6.70.0.45

源代码在线查看: myconnectform.pas

软件大小: 5061 K
上传用户: babydog00
关键词: Components Oracle Access Source
下载地址: 免注册下载 普通下载 VIP

相关代码

				unit MyConnectForm;
				
				interface
				
				uses
				{$IFDEF LINUX}
				  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls,
				  QComCtrls, QExtCtrls, QGrids, QDBGrids, OdacClx, QButtons, QMask,
				{$ELSE}
				  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
				  StdCtrls, ExtCtrls, Buttons, OdacVcl,
				{$IFNDEF FPC}
				  Mask,
				{$ENDIF}
				{$ENDIF}
				{$IFDEF FPC}
				  LResources,
				{$ENDIF}
				  MemUtils, Ora, OraError;
				
				type
				  TfmMyConnect = class(TForm)
				    Panel: TPanel;
				    lbUsername: TLabel;
				    lbPassword: TLabel;
				    lbServer: TLabel;
				    edUsername: TEdit;
				  {$IFNDEF FPC}
				    edPassword: TMaskEdit;
				  {$ELSE}
				    edPassword: TEdit;
				  {$ENDIF}
				    edServer: TComboBox;
				    btConnect: TBitBtn;
				    btCancel: TBitBtn;
				    Bevel1: TBevel;
				    procedure btConnectClick(Sender: TObject);
				  private
				    FConnectDialog: TConnectDialog;
				    FRetries: integer;
				    FRetry: boolean;
				
				    procedure SetConnectDialog(Value:TConnectDialog);
				
				  protected
				    procedure DoInit; virtual;
				    procedure DoConnect; virtual;
				
				  public
				
				  published
				    property ConnectDialog:TConnectDialog read FConnectDialog write SetConnectDialog;
				
				  end;
				
				var
				  fmMyConnect: TfmMyConnect;
				
				implementation
				
				{$IFNDEF FPC}
				{$IFDEF CLR}
				{$R *.nfm}
				{$ENDIF}
				{$IFDEF WIN32}
				{$R *.dfm}
				{$ENDIF}
				{$IFDEF LINUX}
				{$R *.xfm}
				{$ENDIF}
				{$ENDIF}
				
				procedure TfmMyConnect.DoInit;
				var
				  List: _TStringList;
				begin
				  FRetry := False;
				  FRetries := FConnectDialog.Retries;
				  Caption := FConnectDialog.Caption;
				
				  lbUsername.Caption := FConnectDialog.UsernameLabel;
				  lbPassword.Caption := FConnectDialog.PasswordLabel;
				  lbServer.Caption := FConnectDialog.ServerLabel;
				  btConnect.Caption := FConnectDialog.ConnectButton;
				  btCancel.Caption := FConnectDialog.CancelButton;
				
				  List := _TStringList.Create;
				  try
				    FConnectDialog.GetServerList(List);
				    AssignStrings(List, edServer.Items);
				  finally
				    List.Free;
				  end;
				  edUsername.Text := FConnectDialog.Session.Username;
				  edPassword.Text := FConnectDialog.Session.Password;
				  edServer.Text := FConnectDialog.Session.Server;
				
				  if (edUsername.Text  '') and (edPassword.Text = '') then
				    ActiveControl := edPassword;
				end;
				
				procedure TfmMyConnect.DoConnect;
				begin
				  FConnectDialog.Session.Password := edPassword.Text;
				  FConnectDialog.Session.Server := edServer.Text;
				  FConnectDialog.Session.UserName := edUsername.Text;
				  try
				    FConnectDialog.Connection.PerformConnect(FRetry);
				    ModalResult := mrOk;
				  except
				    on E:EOraError do begin
				      Dec(FRetries);
				      FRetry := True;
				      if FRetries = 0 then
				        ModalResult := mrCancel;
				
				      case E.ErrorCode of
				        1005: ActiveControl := edPassword;
				        1017: if ActiveControl  edUsername then ActiveControl := edPassword;
				        12203,12154: ActiveControl := edServer;
				      end;
				      raise;
				    end
				    else
				      raise;
				  end;
				end;
				
				procedure TfmMyConnect.SetConnectDialog(Value:TConnectDialog);
				begin
				  FConnectDialog := Value;
				  DoInit;
				end;
				
				procedure TfmMyConnect.btConnectClick(Sender: TObject);
				begin
				  DoConnect;
				end;
				
				initialization
				  if GetClass('TfmMyConnect') = nil then
				    Classes.RegisterClass(TfmMyConnect);
				
				{$IFDEF FPC}
				{$I MyConnectForm.lrs}
				{$ENDIF}
				
				end.
							

相关资源