📄 databaseconfigurationf.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 + -