login.pas

仿sql查询分析器

unit Login;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Pub, ADOInt;

type
  TLoginFrm = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    CbxServers: TComboBox;
    Bevel1: TBevel;
    Label2: TLabel;
    RbWinAuth: TRadioButton;
    RbSqlAuth: TRadioButton;
    Label3: TLabel;
    Label4: TLabel;
    EdtUserName: TEdit;
    EdtPassword: TEdit;
    Bevel2: TBevel;
    BtnOK: TButton;
    BtnCancel: TButton;
    Button1: TButton;
    procedure RbWinAuthClick(Sender: TObject);
    procedure RbSqlAuthClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnOKClick(Sender: TObject);
  private
    FConnection: _Connection;

    procedure AuthChanged;
    function GetAuthType: TAuthType;
    function GetPassword: string;
    function GetServer: string;
    function GetUserName: string;
    procedure DoConnect;
    function GetLocalName: string;
  public
    property UserName: string read GetUserName;
    property Password: string read GetPassword;
    property AuthType: TAuthType read GetAuthType;
    property Server: string read GetServer;
    property Connection: _Connection read FConnection;
  end;

var
  LoginFrm: TLoginFrm;

implementation

uses ConnWait, ActiveX;

{$R *.dfm}

const
  ConnStr1 = 'Provider=SQLOLEDB.1;Integrated Security=SSPI;' +
             'Persist Security Info=False;Data Source=%s;Application Name=SQL查询器';

  ConnStr2 = 'Provider=SQLOLEDB.1;Password=%s;' +
             'Persist Security Info=True;User ID=%s;Data Source=%s;' +
             'Application Name=SQL查询器';

type
  TConnectThread = class(TThread)
  private
    FConnection: _Connection;
    FWaitFrm: TForm;
    FConnected: Boolean;
    FErrorMsg: string;
  protected
    procedure Execute; override;
  end;

{ TConnectThread }

procedure TConnectThread.Execute;
begin
  ActiveX.CoInitialize(nil);
  try
    try
      FConnection.Open('', '', '', -1);
      FConnected := True;
    except
      on E: Exception do begin
        FErrorMsg := E.Message;
        FConnected := False;
      end;
    end;
    if FWaitFrm <> nil then Self.Synchronize(FWaitFrm.Close);
  finally
    ActiveX.CoUninitialize;
  end;
end;

{ TLoginFrm }

procedure TLoginFrm.RbWinAuthClick(Sender: TObject);
begin
  AuthChanged;
end;

procedure TLoginFrm.RbSqlAuthClick(Sender: TObject);
begin
  AuthChanged;
end;

procedure TLoginFrm.AuthChanged;
begin
  EdtUserName.Enabled := RbSqlAuth.Checked;
  EdtPassword.Enabled := RbSqlAuth.Checked;
  if RbSqlAuth.Checked then
  begin
    EdtUserName.Enabled := True;
    EdtUserName.Color := clWindow;
    EdtPassword.Enabled := True;
    EdtPassword.Color := clWindow;
  end
  else
  begin
    EdtUserName.Enabled := False;
    EdtUserName.Color := clBtnFace;
    EdtPassword.Enabled := False;
    EdtPassword.Color := clBtnFace;
  end;
end;

procedure TLoginFrm.FormCreate(Sender: TObject);
begin
  AuthChanged;
end;

function TLoginFrm.GetAuthType: TAuthType;
begin
  if RbSqlAuth.Checked then
    Result := atSqlServer
  else
    Result := atWindows;
end;

function TLoginFrm.GetPassword: string;
begin
  Result := EdtPassword.Text;
end;

function TLoginFrm.GetServer: string;
var
  s: string;
begin
  s := CbxServers.Text;
  if (s = '') or (s = '.') or AnsiSameText(s, '(local)') then
    s := GetLocalName;
  Result := s;
end;

function TLoginFrm.GetUserName: string;
begin
  Result := EdtUserName.Text;
end;

procedure TLoginFrm.BtnOKClick(Sender: TObject);
begin
  DoConnect;
end;

function TLoginFrm.GetLocalName: string;
var
  nSize: Cardinal;
begin
  nSize := MAX_COMPUTERNAME_LENGTH + 1;
  SetLength(Result, nSize);
  if GetComputerName(PChar(Result), nSize) then
    SetLength(Result, nSize)
  else
    Result := '';
end;

procedure TLoginFrm.DoConnect;
var
  connStr: string;
  thread: TConnectThread;
  frm: TConnWaitFrm;
  ok: Boolean;
begin
  FConnection := CoConnection.Create;
  if AuthType = atWindows then
    connStr := Format(ConnStr1, [Server])
  else
    connStr := Format(ConnStr2, [Password, UserName, Server]);

  FConnection.CursorLocation := adUseServer;
  FConnection.ConnectionString := connStr;

  thread := TConnectThread.Create(True);
  thread.FConnection := FConnection;
  thread.FreeOnTerminate := False;

  frm := TConnWaitFrm.Create(nil);
  thread.FWaitFrm := frm;
  try
    thread.Resume;
    frm.ShowModal;
  finally
    frm.Free;
    ok := thread.FConnected;
    if thread.FErrorMsg <> '' then
      ShowMessage(thread.FErrorMsg);
    thread.Free;
    if ok then ModalResult := mrOK;
  end;
end;

end.