⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 databaseconfigurationf.pas

📁 极具实用价值的文件管理系统
💻 PAS
字号:
{ *********************************************************************** }
{ Unit Name: LoginF
{ Purpose: LoginF
{ Author: Cyclone
{ History:
{         2005-3-19 17:50:24 Create the function
{ *********************************************************************** }

unit DatabaseConfigurationF;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, CycPanel, ExtCtrls, ShellApi, Pubfuns, jpeg,
  CycSpeedButton, BaseF, DB, ADODB, IniFiles, CycLabeledEdit, CycLabel;

type
  TfmDatabaseConfiguration = class(TfmBase)
    pnlTitle: TCycPanel;
    pnlMain: TCycPanel;
    Panel1: TPanel;
    Label3: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    lblWebSite: TLabel;
    lblEmail: TLabel;
    ImgSystem: TImage;
    Label1: TLabel;
    adcLogin: TADOConnection;
    dsSystemUser: TADODataSet;
    dsSystemUserUserId: TWideStringField;
    dsSystemUserPassword: TWideStringField;
    btnLogin: TCycSpeedButton;
    btnExit: TCycSpeedButton;
    edtPassword: TCycLabeledEdit;
    edtUserName: TCycLabeledEdit;
    cbxDatabase: TComboBox;
    CycLabel1: TCycLabel;
    btnConfiguration: TCycSpeedButton;
    procedure pnlTitleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lblWebSiteClick(Sender: TObject);
    procedure lblEmailClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnLoginClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure edtPasswordKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    procedure  MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure  MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    function ConnectDatabase: Boolean;
  public
    { Public declarations }
  end;

var
  fmDatabaseConfiguration: TfmDatabaseConfiguration;

implementation

{$R *.dfm}

procedure TfmDatabaseConfiguration.MouseEnter(var Msg: TMessage);
var
  Obj: TObject;
begin
  Obj := TObject(Msg.LParam);
  if Obj = lblWebSite then
  begin
    Screen.Cursor := crHandPoint;
    lblWebSite.Font.Color := clBlue;
    lblWebSite.Font.Style := lblWebSite.Font.Style + [fsUnderline];
  end
  else if Obj = lblEmail then
  begin
    Screen.Cursor := crHandPoint;
    lblEmail.Font.Color := clBlue;
    lblEmail.Font.Style := lblWebSite.Font.Style + [fsUnderline];
  end;
end;

procedure TfmDatabaseConfiguration.MouseLeave(var Msg: TMessage);
var
  Obj: TObject;
begin
  Obj := TObject(Msg.LParam);
  if Obj = lblWebSite then
  begin
    Screen.Cursor := crDefault;
    lblWebSite.Font.Color := clWindowText;
    lblWebSite.Font.Style := lblWebSite.Font.Style - [fsUnderline];
  end
  else if Obj = lblEmail then
  begin
    Screen.Cursor := crDefault;
    lblEmail.Font.Color := clWindowText;
    lblEmail.Font.Style := lblWebSite.Font.Style - [fsUnderline];
  end;
end;

procedure TfmDatabaseConfiguration.pnlTitleMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TfmDatabaseConfiguration.lblWebSiteClick(Sender: TObject);
begin
  ShellExecute(Handle, 'OPEN', Pchar(lblWebSite.Caption), '', '', SW_SHOWNORMAL);
end;

procedure TfmDatabaseConfiguration.lblEmailClick(Sender: TObject);
begin
  ShellExecute(Handle, 'OPEN', Pchar('MailTo:' + lblEmail.Caption), '', '', SW_SHOWNORMAL);
end;

procedure TfmDatabaseConfiguration.FormCreate(Sender: TObject);
begin
  ReadConnectionInformation;
  pnlTitle.Caption := pSystemName + ' Login';
  lblWebSite.Caption := pCompanyWebSite;
  lblEmail.Caption := pCompanyEmail;
  cbxDatabase.ItemIndex := Ord(pDatabaseType);
  edtUserName.Text := GetLocalComputerName;
end;

{-----------------------------------------------------------------------------
  Procedure: TfmLogin.ConnectDatabase
  Purpose:   Connect Database
  Arguments: None
  Result:    Boolean
  Author:    Cyclone   
  Date:      2005-3-19 16:46:42

-----------------------------------------------------------------------------}
function TfmDatabaseConfiguration.ConnectDatabase: Boolean;
begin
  Result := True;
  if adcLogin.Connected then
    adcLogin.Connected := False;
  if pDatabaseType = dtAccess then
    adcLogin.ConnectionString := GetAccessConnectionString(pAccessFileName)
  else
    adcLogin.ConnectionString := GetSQLServerConnectionString(pDBServerName, pDBName, pDBUserName, pDBPassword);
  try
    adcLogin.Open;
  except
    ShowError('Database Connection Fail!');
    Result := False;
  end;
end;

procedure TfmDatabaseConfiguration.btnLoginClick(Sender: TObject);
begin
  if Trim(edtUserName.Text) = '' then
  begin
    ShowError('User Name Cannot Be Empty!');
    edtUserName.SetFocus;
    Exit;
  end;
  if not ConnectDatabase then
  begin
    //edtServer.SetFocus;
    Exit;
  end;
  with dsSystemUser do
  begin
    Close;
    Parameters.ParamByName('UserId').Value := edtUserName.Text;
    Open;
    if IsEmpty then
    begin
      if edtUserName.Text = GetLocalComputerName then
      begin
        if ShowYesNo('User Name Not Exist, Add This User Name?') then
        begin
          AppendRecord([pSysUserId, Encrypt('888', PassContext)]);
          ShowInformation('Your Initial Password Is: ''888''');
        end
        else
          Exit;
      end else
      begin
        ShowError('User Name Not Exist, Try Again!');
        edtUserName.SelectAll;
        edtUserName.SetFocus;
        Exit;
      end;
    end else
    begin
      if Decrypt(FieldByName('Password').AsString, PassContext) <> edtPassword.Text then
      begin
        ShowError('Password Is Wrong, Try Again!');
        edtPassword.SelectAll;
        edtPassword.SetFocus;
        Exit;
      end; 
    end;
  end;
  pSysUserId := edtUserName.Text;
  ModalResult := mrOK;
end;

procedure TfmDatabaseConfiguration.btnExitClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfmDatabaseConfiguration.edtPasswordKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then
    btnLogin.Click;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -